Rosetta Code

Dominoes

Revision as of 08:41, 19 November 2021 by Wherrera (talk | contribs) (add another layout)

Warning: If you are looking for pizza delivery you have come to the wrong page. Bloody Google (other search engines are available).

Dominoes is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Take a box of dominoes give them a good shuffle and then arrange them in diverse orientations such that they form a rectangle with 7 rows of 8 columns. Make a tableau of the face values e.g. 

       05132231
       05505246
       43036620
       06235126
       11300245
       21433466
       64515414

Now torment your computer by making it identify where each domino is.

Do this for the above tableau and one of your own construction.

Extra credit:

How many ways are there to arrange dominoes in an 8x7 rectangle, first ignoring their values, then considering their values, and finally considering values but ignoring value symmetry, i.e. transposing 5 and 4.

F#

<lang fsharp> // Dominoes: Nigel Galloway. November 17th., 2021. let cP (n:seq<uint64 list * uint64>) g=seq{for y,n in n do for g in g do let l=n^^^g in if n+g=l then yield (g::y,l)} let rec fG n g=match g with h::t->fG(cP n h)t |_->fst(Seq.head n) let solve(N:int[])=let fG=let y=fG [([],0UL)]([for g in 0..47->((N.[g],N.[g+8]),(1UL<<<g)+(1UL<<<g+8))]@[for n in 0..6 do for g in n*8..n*8+6->((N.[g],N.[g+1]),(1UL<<<g)+(1UL<<<g+1))] 

                               |>List.groupBy(fun((n,g),_)->(min n g,max n g))|>List.sort|>List.map(fun(_,n)->n|>List.map(fun(n,g)->g))) in (fun n g->if List.contains((1UL<<<n)+(1UL<<<g)) y then "+" else " ")
                  N|>Array.chunkBySize 8|>Array.iteri(fun n g->let n=n*8 in [0..6]|>List.iter(fun y->printf $"%d{g.[y]}%s{fG(n+y)(n+y+1)}"); printfn $"%d{g.[7]}"; [0..7]|>List.iter(fun g->printf $"%s{fG(n+g)(n+g+8)} "); printfn "")

solve [|0;5;1;3;2;2;3;1; 

       0;5;5;0;5;2;4;6;
       4;3;0;3;6;6;2;0;
       0;6;2;3;5;1;2;6;
       1;1;3;0;0;2;4;5;
       2;1;4;3;3;4;6;6;
       6;4;5;1;5;4;1;4|]

</lang>

Output:
0+5 1+3 2 2+3 1
        +     +
0 5+5 0 5 2+4 6
+     +
4 3 0 3 6+6 2 0
  + +       + +
0 6 2 3+5 1 2 6
+         +
1 1 3 0+0 2 4 5
  + +       + +
2 1 4 3+3 4 6 6
+         +
6 4+5 1+5 4 1+4

<lang fsharp> solve [|5;6;2;0;0;4;1;4; 

       3;6;1;3;0;4;2;2;
       3;5;6;4;3;2;1;1;
       3;5;1;1;3;0;0;5;
       6;0;5;4;3;5;5;2;
       4;4;1;3;6;6;0;2;
       1;2;6;2;6;5;0;4|]

</lang>

Output:
5+6 2+0 0 4 1+4
        + +
3+6 1 3 0 4 2+2
    + +
3 5 6 4 3+2 1 1
+ +         + +
3 5 1+1 3+0 0 5

6 0 5+4 3+5 5+2
+ +
4 4 1+3 6 6+0 2
        +     +
1+2 6+2 6 5+0 4

Julia

<lang julia>const tableau = [ 

   0 5 1 3 2 2 3 1;
   0 5 5 0 5 2 4 6;
   4 3 0 3 6 6 2 0;
   0 6 2 3 5 1 2 6;
   1 1 3 0 0 2 4 5;
   2 1 4 3 3 4 6 6;
   6 4 5 1 5 4 1 4

]

const dominoes = [(i, j) for i in 0:size(tableau)[1]-1, j in 0:size(tableau)[2]-1 if i <= j] sorted(dom) = first(dom) > last(dom) ? reverse(dom) : dom

""" `patterns` contains solution(s), each containing a partially completed grid, the dominos used, and steps taken to get to that point in the grid. Proceed via iterating through possible tile placements from upper left to lower right, adding horizontal and vertical tile placements, dropping those that require more than one of the same domino. Consolidate in `patterns`` the newly lengthened layouts each step as moves are added. """ function findlayouts(tab = tableau, doms = dominoes) 

   nrows, ncols = size(tab)
   patterns = [(zero(tab) .- 1, Tuple{Int, Int}[], Int[])]
   while true
       newpat = []
       for (ut, ud, up) in patterns
           pos = findfirst(x -> x == -1, ut)
           pos == nothing && continue
           row, col = Tuple(pos)
           if row < nrows && ut[row + 1, col] == -1 &&
              !(sorted((tab[row, col], tab[row + 1, col])) in ud)
               newut = copy(ut)
               newut[row:row+1, col] .= tab[row:row+1, col]
               push!(newpat, (newut, [ud; sorted((tab[row, col], tab[row + 1, col]))],
                  [up; [row, col, row + 1, col]]))
           end
           if col < ncols && ut[row, col + 1] == -1 &&
              !(sorted((tab[row, col], tab[row, col + 1])) in ud)
               newut = copy(ut)
               newut[row, col:col+1] .= tab[row, col:col+1]
               push!(newpat, (newut, [ud; sorted((tab[row, col], tab[row, col + 1]))],
                  [up; [row, col, row, col + 1]]))
           end
       end
       isempty(newpat) && break
       patterns = newpat
       length(last(first(patterns))) == length(doms) && break
   end
   return patterns

end

function printlayout(pattern) 

   tab, dom, pos = pattern
   bytes = [[UInt8(' ') for _ in 1:(size(tab)[2] * 2 - 1)] for _ in 1:size(tab)[1]*2]
   for idx in 1:4:length(pos)-1
       x1, y1, x2, y2 = pos[idx:idx+3]
       n1, n2 = tab[x1, y1], tab[x2, y2]
       bytes[x1 * 2 - 1][y1 * 2 - 1] = Char(n1 + '0')
       bytes[x2 * 2 - 1][y2 * 2 - 1] = Char(n2 + '0')
       if x1 == x2 # horizontal
           bytes[x1 * 2 - 1][y1 * 2] = Char('+')
       elseif y1 == y2 # vertical
           bytes[x1 * 2][y1 * 2 - 1] = Char('+')
       end
   end
   println(join(String.(bytes), "\n"))

end


for pat in findlayouts() 

   printlayout(pat)

end @time findlayouts()

const t2 = [ 

   6 4 2 2 0 6 5 0;
   1 6 2 3 4 1 4 3;
   2 1 0 2 3 5 5 1;
   1 3 5 0 5 6 1 0;
   4 2 6 0 4 0 1 1;
   4 4 2 0 5 3 6 3;
   6 6 5 2 5 3 3 4

] @time lays = findlayouts(t2, dominoes) printlayout(first(lays)) println(length(lays), " layouts found.")

</lang>

Output:
0+5 1+3 2 2+3 1
        +     +
0 5+5 0 5 2+4 6
+     +
4 3 0 3 6+6 2 0
  + +       + +
0 6 2 3+5 1 2 6
+         +
1 1 3 0+0 2 4 5
  + +       + +
2 1 4 3+3 4 6 6
+         +
6 4+5 1+5 4 1+4

  0.003087 seconds (26.93 k allocations: 2.326 MiB)

  0.062496 seconds (395.91 k allocations: 44.811 MiB, 11.69% gc time)
6 4 2 2 0 6+5 0
+ + + + +     +
1 6 2 3 4 1+4 3

2 1 0 2 3+5 5 1
+ + + +     + +
1 3 5 0 5 6 1 0
        + +
4 2 6 0 4 0 1+1
+ + + +
4 4 2 0 5 3 6 3
        + + + +
6+6 5+2 5 3 3 4
2025 layouts found.

Perl

<lang perl>#!/usr/bin/perl

use strict; # https://rosettacode.org/wiki/Dominoes use warnings;

my $gap = qr/(.{15}) (.{15})/s; my $grid = <<END; 0 5 1 3 2 2 3 1

0 5 5 0 5 2 4 6

4 3 0 3 6 6 2 0

0 6 2 3 5 1 2 6

1 1 3 0 0 2 4 5

2 1 4 3 3 4 6 6

6 4 5 1 5 4 1 4 END eval { find( 0, 0, $grid ) };

$grid = <<END; 0 0 0 1 1 1 0 2

1 2 2 2 0 3 1 3

2 3 3 3 0 4 1 4

2 4 3 4 4 4 0 5

1 5 2 5 3 5 4 5

5 5 0 6 1 6 2 6

3 6 4 6 5 6 6 6 END eval { find( 0, 0, $grid ) };

sub find 

 {
 my ($x, $y, $try) = @_;
 if( $x > $y )
   {
   $x = 0;
   if( ++$y > 6 ) # solved
     {
     print "\nfound:\n\n", $grid | $try;
     die;
     }
   }
 while( $try =~ /(?=(?|$x$gap$y|$y$gap$x))/g ) # vertical
   {
   my $new = $try;
   substr $new, $-[0], 33, " $1+$2 ";
   find( $x + 1, $y, $new );
   }
 while( $try =~ /(?=$x $y|$y $x)/g ) # horizontal
   {
   my $new = $try;
   substr $new, $-[0], 3, ' + ';
   find( $x + 1, $y, $new );
   }
 }</lang>
Output:

found:

0+5 1+3 2 2+3 1
        +     +
0 5+5 0 5 2+4 6
+     +        
4 3 0 3 6+6 2 0
  + +       + +
0 6 2 3+5 1 2 6
+         +    
1 1 3 0+0 2 4 5
  + +       + +
2 1 4 3+3 4 6 6
+         +    
6 4+5 1+5 4 1+4

found:

0+0 0+1 1+1 0+2
               
1 2+2 2 0+3 1+3
+     +        
2 3+3 3 0 4 1+4
        + +    
2+4 3+4 4 4 0+5
               
1 5 2+5 3+5 4+5
+ +            
5 5 0+6 1+6 2 6
            + +
3+6 4+6 5+6 6 6

Phix

with javascript_semantics

function domino_set()
    sequence set = {}
    for i=0 to 6 do
        for j=i to 6 do
            set = append(set,{i,j})
        end for
    end for
    return set
end function

sequence set = domino_set(),
        used = repeat(repeat(false,7),7),
        tags = shuffle(tagset(length(set))),
        grid

function unpack(sequence s)
    s = split(s,' ')
    s = apply(true,join,{s,'?'})
    s = join(s,"\n? ? ? ? ? ? ? ?\n")
    s = split(s,'\n')
    return s
end function

function clear(integer r, c, sequence s)
    if grid[r][c]!='?' then ?9/0 end if
    grid[r][c]='+'
    sequence res = {{r,c}}
    for i=1 to length(s) do
        {r,c} = s[i]
        if r>=1 and r<=13
        and c>=1 and c<=15 then
            integer prev = grid[r][c]
            if prev='?' then
                grid[r][c] = ' '
                res = append(res,{r,c})
            elsif prev!=' ' then
                ?9/0
            end if
        end if
    end for
    return res
end function

procedure restore(sequence s)
    for i=1 to length(s) do
        integer {r,c} = s[i]
        grid[r][c] = '?'
    end for
end procedure

function rand_grid(integer rem=28)
    if rem=0 then
        for r=1 to 13 by 2 do
            for c=2 to 14 by 2 do
                grid[r][c] = '?'
            end for
        end for
        for r=2 to 12 by 2 do
            for c=1 to 15 by 2 do
                grid[r][c] = '?'
            end for
        end for
        return grid
    end if
    for r=1 to 13 by 2 do
        for c=1 to 15 by 2 do
            bool flat = (c<15 and grid[r,c+1]='?'),
                 vert = (r<13 and grid[r+1,c]='?')
            sequence res = {},
                     opt = {}
            if flat then
                opt = append(opt,{{r,c+2,r,c+1},{{r,c-1},{r,c+3},{r-1,c},{r-1,c+2},{r+1,c},{r+1,c+2}}})
            end if
            if vert then
                opt = append(opt,{{r+2,c,r+1,c},{{r-1,c},{r,c-1},{r+2,c-1},{r,c+1},{r+2,c+1},{r+3,c}}})
            end if
            opt = shuffle(opt)
            for i=1 to length(opt) do
                integer {r2,c2,r3,c3} = opt[i][1]
                sequence tile = shuffle(set[tags[rem]])
                grid[r][c] = tile[1]+'0'
                grid[r2][c2] = tile[2]+'0'
                sequence reset = clear(r3,c3,opt[i][2])
                res = rand_grid(rem-1)
                if length(res) then return res end if
                restore(reset)
            end for
            if flat or vert then
                return {}
            end if
        end for
    end for
    return {}
end function

string soln1 = ""
string solnn = ""

function solve(integer rem=28)
    if rem=0 then
        solnn = join(grid,'\n')&"\n\n\n"
        if soln1 = "" then soln1 = solnn end if
        return 1
    end if
    for r=1 to 13 by 2 do
        for c=1 to 15 by 2 do
            bool flat = (c<15 and grid[r,c+1]='?'),
                 vert = (r<13 and grid[r+1,c]='?')
            integer count = 0
            if flat then
                integer {R,C} = sort({grid[r][c]-'0'+1,grid[r][c+2]-'0'+1})
                if not used[R][C] then
                    used[R][C] = true
                    sequence reset = clear(r,c+1,{{r,c-1},{r,c+3},{r-1,c},{r-1,c+2},{r+1,c},{r+1,c+2}})
                    count += solve(rem-1)
                    restore(reset)
                    used[R][C] = false
                end if
            end if
            if vert then
                integer {R,C} = sort({grid[r][c]-'0'+1,grid[r+2][c]-'0'+1})
                if not used[R][C] then
                    used[R][C] = true
                    sequence reset = clear(r+1,c,{{r-1,c},{r,c-1},{r+2,c-1},{r,c+1},{r+2,c+1},{r+3,c}})
                    count += solve(rem-1)
                    restore(reset)
                    used[R][C] = false
                end if
            end if
            if flat or vert then
                return count -- (may still be 0)
            end if
        end for
    end for
    return 0
end function

procedure test(sequence g)
    grid = g
    g = {}
    soln1 = ""
    solnn = ""
    atom t0 = time()
    integer n = solve()
    puts(1,soln1)
    if n>1 then
        if n>2 then puts(1,"...\n\n\n") end if
        puts(1,solnn)
    end if
    printf(1,"%d solution%s found (%s)\n\n\n",{n,iff(n=1?"":"s"),elapsed(time()-t0)})
end procedure
test(unpack("05132231 05505246 43036620 06235126 11300245 21433466 64515414"))
test(rand_grid())
Output:
0+5 1+3 2 2+3 1
        +     +
0 5+5 0 5 2+4 6
+     +
4 3 0 3 6+6 2 0
  + +       + +
0 6 2 3+5 1 2 6
+         +
1 1 3 0+0 2 4 5
  + +       + +
2 1 4 3+3 4 6 6
+         +
6 4+5 1+5 4 1+4


1 solution found (0.2s)


6+4 2+2 0+6 5 0
            + +
1+6 2+3 4+1 4 3

2+1 0+2 3+5 5+1

1+3 5+0 5+6 1+0

4+2 6 0 4+0 1+1
    + +
4+4 2 0 5 3+6 3
        +     +
6+6 5+2 5 3+3 4


...


6 4 2 2 0 6+5 0
+ + + + +     +
1 6 2 3 4 1+4 3

2 1 0 2 3+5 5 1
+ + + +     + +
1 3 5 0 5 6 1 0
        + +
4 2 6 0 4 0 1+1
+ + + +
4 4 2 0 5 3 6 3
        + + + +
6+6 5+2 5 3 3 4


2025 solutions found (0.1s)

Note that 2025 is not the maximum number of solutions or anything like that, just a higher than average result.

Extra credit

Pretty dumb brute force approach, dreadfully slow. 

without js -- too slow
enum IGNORE, CONSIDER, NOSYM
function count(integer what, rem=28, doubles=6)
    if rem=0 then
        return 1
    end if
    atom total = 0
    for r=1 to 13 by 2 do
        for c=1 to 15 by 2 do
            bool flat = (c<15 and grid[r,c+1]='?'),
                 vert = (r<13 and grid[r+1,c]='?')
            sequence res = {},
                     opt = {}
            if flat then
                opt = append(opt,{{r,c+2,r,c+1},{{r,c-1},{r,c+3},{r-1,c},{r-1,c+2},{r+1,c},{r+1,c+2}}})
            end if
            if vert then
                opt = append(opt,{{r+2,c,r+1,c},{{r-1,c},{r,c-1},{r+2,c-1},{r,c+1},{r+2,c+1},{r+3,c}}})
            end if
            for i=1 to length(opt) do
                integer {r2,c2,r3,c3} = opt[i][1]
                sequence reset = clear(r3,c3,opt[i][2])
                if what=IGNORE then
                    total += count(what,rem-1)
                elsif what=CONSIDER then
                    if doubles then
                        total += doubles*count(what,rem-1,doubles-1)
                    end if
                    if rem>doubles then
                        total += 2*(rem-doubles)*count(what,rem-1,doubles)
                    end if
                else -- NOSYM
                    total += 2*rem*count(what,rem-1)
                end if
                restore(reset)
            end for
            if flat or vert then
                return total
            end if
        end for
    end for
    return total
end function

atom t0 = time()
printf(1,"Arrangements ignoring values: %,d\n",count(IGNORE))
--printf(1,"Arrangements considering values: %d\n",count(CONSIDER)) -- too slow
printf(1,"Arrangements ignoring symmetry: %g\n",count(NOSYM))
?elapsed(time()-t0)
Output:
Arrangements ignoring values: 1,292,697
Arrangements ignoring symmetry: 1.05798e+44
"2 minutes and 37s"
Retrieved from "https://rosettacode.org/wiki/Dominoes?oldid=317587"