Dominoes: Difference between revisions
Content added Content deleted
m (→Extra credit: added much faster version (trans Wren)) |
|||
Line 236: | Line 236: | ||
Possible permuted arrangements with flips: 105797996085635281181632579889767907328000000 |
Possible permuted arrangements with flips: 105797996085635281181632579889767907328000000 |
||
</pre> |
</pre> |
||
=={{header|Mathematica}}/{{header|Wolfram Language}}== |
|||
<lang Mathematica>ClearAll[VisualizeState] |
|||
VisualizeState[sol_List, tab_List] := Module[{rects}, |
|||
rects = Apply[Rectangle[#1 - {1, 1} 0.5, #2 + {1, 1} 0.5] &, sol[[All, 2]], {1}]; |
|||
Graphics[{FaceForm[], EdgeForm[Black], rects, MapIndexed[Text[Style[#1, 14, Black], #2] &, tab, {2}]}] |
|||
] |
|||
ClearAll[FindSolutions] |
|||
FindSolutions[tab_] := Module[{poss, possshort, possshorti, posssets, posss, sols}, |
|||
poss = Catenate[MapIndexed[#2 &, tab, {2}]]; |
|||
possshort = Thread[poss -> Range[Length[poss]]]; |
|||
possshorti = Thread[Range[Length[poss]] -> poss]; |
|||
posssets = |
|||
Select[Subsets[poss, {2}], Apply[ManhattanDistance]/*EqualTo[1]]; |
|||
posssets = {# /. possshort, Sort[Extract[tab, #]]} & /@ posssets; |
|||
posss = GatherBy[posssets, Last]; |
|||
posss = #[[1, 2]] -> #[[All, 1]] & /@ posss; |
|||
posss //= SortBy[Last/*Length]; |
|||
sols = {}; |
|||
ClearAll[RecursePlaceDomino]; |
|||
RecursePlaceDomino[placed_List, left_List] := |
|||
Module[{newplaced, sortedleft, newleft, next}, |
|||
If[Length[left] == 0, |
|||
AppendTo[sols, placed]; |
|||
, |
|||
sortedleft = SortBy[left, Last/*Length]; |
|||
next = sortedleft[[1]]; |
|||
Do[ |
|||
newplaced = Append[placed, next[[1]] -> n]; |
|||
newleft = Drop[sortedleft, 1]; |
|||
newleft[[All, 2]] = |
|||
newleft[[All, 2]] /. {___, Alternatives @@ n, ___} :> |
|||
Sequence[]; |
|||
If[AnyTrue[newleft[[All, 2]], Length/*EqualTo[0]], Continue[]]; |
|||
RecursePlaceDomino[newplaced, newleft] |
|||
, |
|||
{n, next[[2]]} |
|||
]; |
|||
] |
|||
]; |
|||
RecursePlaceDomino[{}, posss]; |
|||
sols[[All, All, 2]] = sols[[All, All, 2]] /. possshorti; |
|||
sols |
|||
] |
|||
tab = {{6, 2, 1, 0, 4, 0, 0}, {4, 1, 1, 6, 3, 5, 5}, {5, 4, 3, 2, 0, |
|||
5, 1}, {1, 3, 0, 3, 3, 0, 3}, {5, 3, 0, 5, 6, 5, 2}, {4, 4, 2, 1, |
|||
6, 2, 2}, {1, 6, 4, 2, 2, 4, 3}, {4, 6, 5, 6, 0, 6, 1}}; |
|||
sols = FindSolutions[tab]; |
|||
Length[sols] |
|||
VisualizeState[sols[[1]], tab] |
|||
tab = {{6, 4, 4, 1, 2, 1, 6}, {6, 4, 2, 3, 1, 6, 4}, {5, 2, 6, 5, 0, |
|||
2, 2}, {2, 0, 0, 0, 2, 3, 2}, {5, 5, 4, 5, 3, 4, 0}, {3, 3, 0, 6, |
|||
5, 1, 6}, {3, 6, 1, 1, 5, 4, 5}, {4, 3, 1, 0, 1, 3, 0}}; |
|||
sols = FindSolutions[tab]; |
|||
Length[sols] |
|||
VisualizeState[sols[[1]], tab] |
|||
ClearAll[DominoTilingCount] |
|||
DominoTilingCount[m_, n_] := Module[{}, |
|||
Round[Product[ |
|||
4 Cos[(Pi j)/(m + 1)]^2 + 4 Cos[(Pi k)/(n + 1)]^2, {j, |
|||
Ceiling[m/2]}, {k, Ceiling[n/2]}]] |
|||
] |
|||
arrangements = DominoTilingCount[7, 8] // Round; |
|||
permutations = 28!; |
|||
flips = 2^28; |
|||
Print["Arrangements ignoring values: ", arrangements] |
|||
Print["Permutations of 28 dominos: ", permutations] |
|||
Print["Permuted arrangements ignoring flipping dominos: ", arrangements*permutations] |
|||
Print["Possible flip configurations: ", flips] |
|||
Print["Possible permuted arrangements with flips: ", flips*arrangements*permutations]</lang> |
|||
{{out}} |
|||
<pre> |
|||
1 |
|||
[Graphical output of the solution] |
|||
2025 |
|||
[Graphical output of the first solution] |
|||
Arrangements ignoring values: 1292697 |
|||
Permutations of 28 dominos: 304888344611713860501504000000 |
|||
Permuted arrangements ignoring flipping dominos: 394128248414528672328712716288000000 |
|||
Possible flip configurations: 268435456 |
|||
Possible permuted arrangements with flips: 105797996085635281181632579889767907328000000</pre> |
|||
=={{header|Perl}}== |
=={{header|Perl}}== |