Solve triangle solitaire puzzle: Difference between revisions
m
→{{header|Phix}}: use pygments, simplified by using reinstate, which also fixes a couple of p2js violations
m (→{{header|Phix}}: use pygments, simplified by using reinstate, which also fixes a couple of p2js violations) |
|||
(6 intermediate revisions by 4 users not shown) | |||
Line 118:
{{out}}
<pre>
1
. 3
Line 209 ⟶ 210:
Peg B jumped over C to land on D
</pre>
=={{header|ALGOL 68}}==
{{Trans|Go|which is a translation of Kotlin}}
Also shows the number of backtracks required for each starting position and simplifies testing for a solution.
<syntaxhighlight lang="algol68">
BEGIN # solve a triangle solitaire puzzle - translation of the Go sample #
MODE SOLUTION = STRUCT( INT peg, over, land );
MODE MOVE = STRUCT( INT from, to );
INT number of pegs = 15;
INT empty start := 1;
[ number of pegs ]BOOL board;
[][]MOVE jump moves
= ( []MOVE( ( 2, 4 ), ( 3, 6 ) )
, []MOVE( ( 4, 7 ), ( 5, 9 ) )
, []MOVE( ( 5, 8 ), ( 6, 10 ) )
, []MOVE( ( 2, 1 ), ( 5, 6 ), ( 7, 11 ), ( 8, 13 ) )
, []MOVE( ( 8, 12 ), ( 9, 14 ) )
, []MOVE( ( 3, 1 ), ( 5, 4 ), ( 9, 13 ), ( 10, 15 ) )
, []MOVE( ( 4, 2 ), ( 8, 9 ) )
, []MOVE( ( 5, 3 ), ( 9, 10 ) )
, []MOVE( ( 5, 2 ), ( 8, 7 ) )
, []MOVE( MOVE( 9, 8 ) )
, []MOVE( MOVE( 12, 13 ) )
, []MOVE( ( 8, 5 ), ( 13, 14 ) )
, []MOVE( ( 8, 4 ), ( 9, 6 ), ( 12, 11 ), ( 14, 15 ) )
, []MOVE( ( 9, 5 ), ( 13, 12 ) )
, []MOVE( ( 10, 6 ), ( 14, 13 ) )
);
[ number of pegs ]SOLUTION solutions;
INT s size := 0;
INT backtracks := 0;
PROC init board = VOID:
BEGIN
FOR i TO number of pegs DO
board[ i ] := TRUE
OD;
board[ empty start ] := FALSE
END; # init board #
PROC init solution = VOID:
BEGIN
s size := 0;
backtracks := 0
END; # init solutions #
PROC split solution = ( REF INT peg, over, land, SOLUTION sol )VOID:
BEGIN
peg := peg OF sol; over := over OF sol; land := land OF sol
END; # split solution #
PROC split move = ( REF INT from, to, MOVE mv )VOID:
BEGIN
from := from OF mv; to := to OF mv
END; # split move #
OP TOHEX = ( INT v )CHAR:
IF v < 10 THEN REPR ( ABS "0" + v ) ELSE REPR ( ABS "A" + ( v - 10 ) ) FI;
PROC draw board = VOID:
BEGIN
PROC println = ( STRING s )VOID: print( ( s, newline ) );
[ number of pegs ]CHAR pegs;
FOR i TO number of pegs DO
pegs[ i ] := IF board[ i ] THEN TOHEX i ELSE "." FI
OD;
println( " " + pegs[ 1 ] );
println( " " + pegs[ 2 ] + " " + pegs[ 3 ] );
println( " " + pegs[ 4 ] + " " + pegs[ 5 ] + " " + pegs[ 6 ] );
println( " " + pegs[ 7 ] + " " + pegs[ 8 ] + " " + pegs[ 9 ] + " " + pegs[ 10 ] );
println( " " + pegs[ 11 ] + " " + pegs[ 12 ] + " " + pegs[ 13 ] + " " + pegs[ 14 ] + " " + pegs[ 15 ] )
END; # draw board #
PROC solved = BOOL: s size = number of pegs - 2;
PROC solve = VOID:
IF NOT solved THEN
BOOL have solution := FALSE;
FOR peg TO number of pegs WHILE NOT have solution DO
IF board[ peg ] THEN
[]MOVE jm = jump moves[ peg ];
FOR mv pos FROM LWB jm TO UPB jm WHILE NOT have solution DO
INT over, land;
split move( over, land, jm[ mv pos ] );
IF board[ over ] AND NOT board[ land ] THEN
[]BOOL save board = board;
board[ peg ] := FALSE;
board[ over ] := FALSE;
board[ land ] := TRUE;
solutions[ s size +:= 1 ] := ( peg, over, land );
solve;
IF NOT ( have solution := solved ) THEN
# not solved - backtrack #
backtracks +:= 1;
board := save board;
s size -:= 1
FI
FI
OD
FI
OD
FI; # solve #
FOR start peg TO number of pegs DO
empty start := start peg;
init board;
init solution;
solve;
IF empty start = 1 THEN
init board;
draw board
FI;
print( ( "Starting with peg ", TOHEX empty start, " removed" ) );
IF empty start = 1 THEN
print( ( newline, newline ) );
FOR pos TO s size DO
SOLUTION solution = solutions[ pos ];
INT peg, over, land;
split solution( peg, over, land, solution );
board[ peg ] := FALSE;
board[ over ] := FALSE;
board[ land ] := TRUE;
draw board;
print( ( "Peg ", TOHEX peg, " jumped over ", TOHEX over, " to land on ", TOHEX land ) );
print( ( newline, newline ) )
OD
FI;
print( ( whole( backtracks, -8 ), " backtracks were required", newline ) )
OD
END
</syntaxhighlight>
{{out}}
<pre style="height:80ex;overflow:scroll">
.
2 3
4 5 6
7 8 9 A
B C D E F
Starting with peg 1 removed
1
. 3
. 5 6
7 8 9 A
B C D E F
Peg 4 jumped over 2 to land on 1
1
. 3
4 . .
7 8 9 A
B C D E F
Peg 6 jumped over 5 to land on 4
.
. .
4 . 6
7 8 9 A
B C D E F
Peg 1 jumped over 3 to land on 6
.
2 .
. . 6
. 8 9 A
B C D E F
Peg 7 jumped over 4 to land on 2
.
2 .
. 5 6
. . 9 A
B . D E F
Peg C jumped over 8 to land on 5
.
2 .
. 5 6
. . 9 A
B C . . F
Peg E jumped over D to land on C
.
2 .
. 5 .
. . . A
B C D . F
Peg 6 jumped over 9 to land on D
.
. .
. . .
. . 9 A
B C D . F
Peg 2 jumped over 5 to land on 9
.
. .
. . .
. . 9 A
B . . E F
Peg C jumped over D to land on E
.
. .
. . 6
. . 9 .
B . . E .
Peg F jumped over A to land on 6
.
. .
. . .
. . . .
B . D E .
Peg 6 jumped over 9 to land on D
.
. .
. . .
. . . .
B C . . .
Peg E jumped over D to land on C
.
. .
. . .
. . . .
. . D . .
Peg B jumped over C to land on D
814 backtracks were required
Starting with peg 2 removed 22221 backtracks were required
Starting with peg 3 removed 12274 backtracks were required
Starting with peg 4 removed 15782 backtracks were required
Starting with peg 5 removed 1948 backtracks were required
Starting with peg 6 removed 71565 backtracks were required
Starting with peg 7 removed 814 backtracks were required
Starting with peg 8 removed 98940 backtracks were required
Starting with peg 9 removed 5747 backtracks were required
Starting with peg A removed 814 backtracks were required
Starting with peg B removed 22221 backtracks were required
Starting with peg C removed 19097 backtracks were required
Starting with peg D removed 814 backtracks were required
Starting with peg E removed 18563 backtracks were required
Starting with peg F removed 10240 backtracks were required
</pre>
Line 553 ⟶ 806:
</pre>
=={{header|F_Sharp|F#}}==
<syntaxhighlight lang="fsharp">
// Solve triangle solitaire puzzle. Nigel Galloway: May 28th., 2024
type hole= O|X
type cand={board:hole[];p2go:int;hist:list<hole[]*int*int*int>}
let G = [0,1,3;0,2,5;1,3,6;1,4,8;2,4,7;2,5,9;3,4,5;3,6,10;3,7,12;4,7,11;4,8,13;5,8,12;5,9,14;6,7,8;7,8,9;10,11,12;11,12,13;12,13,14;3,1,0;5,2,0;6,3,1;8,4,1;7,4,2;9,5,2;5,4,3;10,6,3;12,7,3;11,7,4;13,8,4;12,8,5;14,9,5;8,7,6;9,8,7;12,11,10;13,12,11;14,13,12]
let move n (from,over,To)=let g=Array.copy n.board in g[from]<-O; g[over]<-O; g[To]<-X; {board=g;p2go=n.p2go-1;hist=(n.board,from,over,To)::n.hist}
let moves (p:hole[])=G|>List.fold(fun n g->match g with from,over,To when p[over]=X&&p[from]=X&&p[To]=O->(from,over,To)::n |To,over,from when p[over]=X&&p[from]=X&&p[To]=O->(from,over,To)::n |_->n)[]
let rec fs=function []->None |n::g when n.p2go=0->Some((n.board,-1,-1,-1)::n.hist) |n::g->fs(((moves n.board)|>List.map(fun g->move n g))@g)
let solve n=fs [{board=n; p2go=13; hist=[]}]
let fN(g:hole[])=printfn " %A\n %A %A\n %A %A %A\n %A %A %A %A\n%A %A %A %A %A" g[0] g[1] g[2] g[3] g[4] g[5] g[6] g[7] g[8] g[9] g[10] g[11] g[12] g[13] g[14]
match solve [|O;X;X;X;X;X;X;X;X;X;X;X;X;X;X|] with Some n->n|>List.rev|>List.iter(fun(g,from,over,To)->fN g; if from> -1 then printfn "\nmove from %A over %A to %A\n" from over To) |_->printfn "No solution found"
</syntaxhighlight>
{{out}}
<pre>
O
X X
X X X
X X X X
X X X X X
move from 5 over 2 to 0
X
X O
X X O
X X X X
X X X X X
move from 14 over 9 to 5
X
X O
X X X
X X X O
X X X X O
move from 7 over 8 to 9
X
X O
X X X
X O O X
X X X X O
move from 9 over 5 to 2
X
X X
X X O
X O O O
X X X X O
move from 1 over 4 to 8
X
O X
X O O
X O X O
X X X X O
move from 13 over 8 to 4
X
O X
X X O
X O O O
X X X O O
move from 11 over 12 to 13
X
O X
X X O
X O O O
X O O X O
move from 2 over 4 to 7
X
O O
X O O
X X O O
X O O X O
move from 6 over 3 to 1
X
X O
O O O
O X O O
X O O X O
move from 0 over 1 to 3
O
O O
X O O
O X O O
X O O X O
move from 3 over 7 to 12
O
O O
O O O
O O O O
X O X X O
move from 13 over 12 to 11
O
O O
O O O
O O O O
X X O O O
move from 10 over 11 to 12
O
O O
O O O
O O O O
O O X O O
</pre>
=={{header|Go}}==
{{trans|Kotlin}}
Line 2,146 ⟶ 2,524:
Twee brute-force string-based solution. Backtracks a mere 366 times, whereas starting with the 5th peg missing backtracks 19388 times (all in 0s, obvs).
<!--(phixonline)-->
<syntaxhighlight lang="phix">
-- demo\rosetta\IQpuzzle.exw
with javascript_semantics
function solve(string board, integer left)
if left=1 then return "" end if
for i=1 to length(board) do
if board[i]='1' then
for mj in {-11,-9,2,11,9,-2} do
integer over = i+mj, tgt = i+2*mj
if tgt>=1 and tgt<=length(board)
and board[tgt]='0' and board[over]='1' then
board = reinstate(board,{i,over,tgt},"001")
string res = solve(board,left-1)
if length(res)!=4 then return board&res end if
board = reinstate(board,{i,over,tgt},"110")
end for
end if
end for
return "oops"
end function
sequence start = """
1-1-1-1-1
"""
puts(1,substitute(join_by(split(start&solve(start,14),'\n'),5,7),"-"," "))
</syntaxhighlight>
{{out}}
Line 2,194 ⟶ 2,573:
Adapted to the English game (also in demo\rosetta\IQpuzzle.exw):
function solveE(string board, integer left)
if left=1 then
-- return "" -- (leaves it on the edge)
if board[3*15+8]='.' then return "" end if
return "oops"
end if
for i=1 to length(board) do
if board[i]='.' then
for mj in {-2,15,2,-15} do
integer over = i+mj, tgt = i+2*mj
if tgt>=1 and tgt<=length(board)
and board[tgt]='o' and board[over]='.' then
board = reinstate(board,{i,over,tgt},"oo.")
string res = solveE(board,left-1)
if length(res)!=4 then return board&res end if
board = reinstate(board,{i,over,tgt},"..o")
end if
end for
end if
end for
return "oops"
end function
string estart = """
-----.-.-.----
"""
puts(1,substitute(join_by(split(estart&solveE(estart,32),'\n'),7,8),"-"," "))
</syntaxhighlight>
{{out}}
<pre style="font-size: 12px">
. . . . . . . . . o . . . o o . o o . o o . o .
. . . . o . . o . o o . o o . o o . o o . o o o
|