Solve triangle solitaire puzzle: Difference between revisions
→{{header|Nim}}
Line 1,398:
Peg B jumped over C to land on D
</pre>
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<lang Mathematica>ClearAll[Showstate]
Showstate[state_List, pos_] := Module[{p, e},
p = {#, FirstPosition[pos, #, Missing[], {2}]} & /@ state;
e = Complement[Flatten[pos], state];
e = {"_", FirstPosition[pos, #, Missing[], {2}]} & /@ e;
p = Join[p, e];
p = DeleteMissing[p, 1, \[Infinity]];
p[[All, 2]] //= Map[Reverse];
p[[All, 2, 2]] *= -1;
p[[All, 2, 1]] += p[[All, 2, 2]] 0.5;
Graphics[Text @@@ p, ImageSize -> 150]
]
pos = TakeList[Range[15], Range[5]];
moves1 = Catenate[If[Length[#] >= 3, Partition[#, 3, 1], {}] & /@ pos];
moves2 = Catenate[If[Length[#] >= 3, Partition[#, 3, 1], {}] & /@ Flatten[pos, {{2}, {1}}]];
moves3 = Catenate[If[Length[#] >= 3, Partition[#, 3, 1], {}] & /@ Flatten[Reverse /@ pos, {{2}, {1}}]];
moves = Join[moves1, moves2, moves3];
moves = Join[moves, Reverse /@ moves];
moves = <|Sort[{#1, #2} -> #3 & @@@ moves]|>;
ClearAll[SolvePuzzle]
SolvePuzzle[{state_List, history_List}, goal_] := Module[{k, newstate},
If[continue,
k = Keys[moves];
k = Select[k, ContainsAll[state, #] &];
k = Select[k, FreeQ[state, moves[#]] &];
k = {#, moves[#]} & /@ k;
Do[
newstate = state;
newstate = DeleteCases[newstate, Alternatives @@ move[[1]]];
AppendTo[newstate, move[[2]]];
If[newstate =!= goal,
SolvePuzzle[{newstate, Append[history, state]}, goal]
,
Print[FlipView[Showstate[#, pos] & /@ Append[Append[history, state], goal]]];
continue = False;
]
,
{move, k}
]
]
]
x = 1;
y = 13;
state = DeleteCases[Range[15], x];
continue = True;
SolvePuzzle[{state, {}}, {y}]</lang>
{{out}}
Outputs a graphical overview, by clicking one can go through the different states.
=={{header|Nim}}==
| |||