52 lines
2 KiB
Text
52 lines
2 KiB
Text
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]
|