Dominoes: Difference between revisions
m (specify a type for vector) |
m (xtra) |
||
Line 200:
2025 layouts found.
</pre>
===Extra credit task ===
<lang julia>""" From https://en.wikipedia.org/wiki/Domino_tiling#Counting_tilings_of_regions
The number of ways to cover an m X n rectangle with m * n / 2 dominoes, calculated
independently by Temperley & Fisher (1961) and Kasteleyn (1961), is given by
"""
function dominotilingcount(m, n)
return BigInt(floor(prod(
[prod(
[big"4.0" * cospi(j / (m + 1)) + 4 * cospi((k / (n + 1))) for k in 1:n÷2]
) for j in 1:m÷2]
)))
end
arrang = dominotilingcount(7, 8)
perms = factorial(big"28")
flips = 2^28
println("Arrangements ignoring values: $arrang")
println("Permutations of 28 dominos: ", perms)
println("Permuted arrangements ignoring flipping dominos: ", arrang * perms)
println("Possible flip configurations: $flips")
println("Possible permuted arrangements with flips: ", flips * arrang * perms)
</lang>{{out}}
<pre>
Arrangements ignoring values: 158862606
Permutations of 28 dominos: 304888344611713860501504000000
Permuted arrangements ignoring flipping dominos: 48435356964042922005589392359424000000
Possible flip configurations: 268435456
Possible permuted arrangements with flips: 13001767133165637372142823086764897337344000000
</pre>
|
Revision as of 04:29, 20 November 2021
Warning: If you are looking for pizza delivery you have come to the wrong page. Bloody Google (other search engines are available).
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 = empty(patterns) 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.000507 seconds (6.06 k allocations: 1.715 MiB) 0.023503 seconds (92.66 k allocations: 35.817 MiB) 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.
Extra credit task
<lang julia>""" From https://en.wikipedia.org/wiki/Domino_tiling#Counting_tilings_of_regions The number of ways to cover an m X n rectangle with m * n / 2 dominoes, calculated independently by Temperley & Fisher (1961) and Kasteleyn (1961), is given by """ function dominotilingcount(m, n)
return BigInt(floor(prod( [prod( [big"4.0" * cospi(j / (m + 1)) + 4 * cospi((k / (n + 1))) for k in 1:n÷2] ) for j in 1:m÷2] )))
end
arrang = dominotilingcount(7, 8) perms = factorial(big"28") flips = 2^28
println("Arrangements ignoring values: $arrang") println("Permutations of 28 dominos: ", perms) println("Permuted arrangements ignoring flipping dominos: ", arrang * perms) println("Possible flip configurations: $flips") println("Possible permuted arrangements with flips: ", flips * arrang * perms)
</lang>
- Output:
Arrangements ignoring values: 158862606 Permutations of 28 dominos: 304888344611713860501504000000 Permuted arrangements ignoring flipping dominos: 48435356964042922005589392359424000000 Possible flip configurations: 268435456 Possible permuted arrangements with flips: 13001767133165637372142823086764897337344000000
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"