Solve triangle solitaire puzzle: Difference between revisions

m
(10 intermediate revisions by 5 users not shown)
Line 23:
 
Reference picture:   http://www.joenord.com/puzzles/peggame/
<br/>Updated link (June 2021): &nbsp;
https://www.joenord.com/triangle-peg-board-game-solutions-to-amaze-your-friends/
 
 
Line 116 ⟶ 118:
{{out}}
<pre>
 
1
. 3
Line 207 ⟶ 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 374 ⟶ 629:
┃● ● ● ● ●┃
┗━━━━━━━━━┛"
funcproc solve . solution$ .
solution$ = ""
for pos = 1 to len brd$[]
if brd$[pos] = "●"
npegs += 1
for dir in [ -13 -11 2 13 11 -2 ]
if brd$[pos + dir] = "●" and brd$[pos + 2 * dir] = "·"
brd$[pos] = "·"
brd$[pos + dir] = "·"
brd$[pos + 2 * dir] = "●"
call solve solution$
brd$[pos] = "●"
brd$[pos + dir] = "●"
brd$[pos + 2 * dir] = "·"
if solution$ <> ""
solution$ = strjoin brd$[] & solution$
break 3 return
.
.
.
.
.
if npegs = 1
.
solution$ = strjoin brd$[]
if npegs = 1
.
solution$ = strjoin brd$[]
.
.
call solve solution$
print solution$
</syntaxhighlight>
Line 1,118 ⟶ 1,373:
Move 12 = {s=14, j=13, e=12}
Move 13 = {s=11, j=12, e=13}
</pre>
 
=={{header|jq}}==
'''Works with jq, the C implementation of jq'''
 
'''Works with gojq, the Go implementation of jq'''
 
This entry presents functions for handling a triangular solitaire
board of arbitrary size.
 
More specifically, the triples defining the "legal moves" need not be
specified explicitly. These triples are instead computed by the
function `triples($depth)`, which emits the triples [$x, $over, $y]
corresponding to a peg at position $x being potentially able to jump
over a peg (at $over) to position $y, or vice versa, where $x < $over.
 
The `solve` function can be used to generate all solutions, as
illustrated below for the standard-size board.
 
The position of the initial "hole" can also be specified.
 
The holes in the board are numbered sequentially beginning from 1 at
the top of the triangle. Since jq arrays have an index origin of 0,
the array representing the board has a "dummy element" at index 0.
<syntaxhighlight lang="jq">
### General utilities
def array($n): . as $in | [range(0;$n)|$in];
 
def count(s): reduce s as $_ (0; .+1);
 
# Is . equal to the number of items in the (possibly empty) stream?
def countEq(s):
. == count(limit(. + 1; s));
 
def lpad($len): tostring | ($len - length) as $l | (" " * $l) + .;
 
### Solitaire
 
# Emit a stream of the relevant triples for a triangle of the given $height,
# specifically [$x, $over, $y] for $x < $y
def triples($height):
def triples: range(0; length - 2) as $i | .[$i: $i+3];
def stripes($n):
def next:
. as [$r1, $r2, $r3]
| ($r3[-1]+1) as $x
| [$r2, $r3, [range($x; $x + ($r3|length) + 1)]];
limit($n; recurse(next)) ;
 
def lefts:
. as [$r1, $r2, $r3]
| range(0; $r1|length) as $i
| [$r1[$i], $r2[$i], $r3[$i]];
def rights:
. as [$r1, $r2, $r3]
| range(0; $r1|length) as $i
| [$r1[$i], $r2[$i+1], $r3[$i+2]];
 
($height * ($height+1) / 2) as $max
| [[1], [2,3], [4,5,6]] | stripes($height)
| . as [$r1, $r2, $r3]
| ($r1|triples),
(if $r3[-1] <= $max then lefts, rights else empty end) ;
 
# For depth <= 10, use single characters to represent pegs, e.g. A for 10.
# Input: {depth, board}
def drawBoard:
def hex: [if . < 10 then 48 + . else 55 + . end] | implode;
def p: map(. + " ") | add;
# Generate the sequence [$i, $n] for the hole numbers of the left-hand side
def seq: recurse( .[1] += .[0] | .[0] += 1) | .[1] += 1;
 
.depth as $depth
| def tr: if $depth > 11 then lpad(3) elif . == "-" then . else hex end;
[range(0; 1 + ($depth * ($depth + 1) / 2)) as $i | if .board[$i] then $i else "-" end | tr]
| limit($depth; ([1,0] | seq) as [$n, $s] | ((1 + $depth - $n)*" ") + (.[$s:$s+$n] | p )) ;
 
# "All solutions"
# Input: as produced by init($depth; $emptyStart)
def solve:
def solved:
.board as $board
| 1 | countEq($board[] | select(.)) ;
 
[triples(.depth)] as $triples # cache the triples
| def solver:
# move/3 tries in both directions
# It is assumed that .board($over) is true
def move($peg; $over; $source):
if (.board[$peg] == false) and .board[$source]
then .board[$peg] = true
| .board[$source] = false
| .board[$over] = false
| .solutions += [ [$peg, $over, $source] ]
| solver
| if .emit == true then .
else # revert
.solutions |= .[:-1]
| .board[$peg] = false
| .board[$source] = true
| .board[$over] = true
end
end ;
if solved then .emit = true
else
foreach $triples[] as [$x, $over, $y] (.;
if .board[$over]
then move($x; $over; $y),
move($y; $over; $x)
else .
end )
| select(.emit)
end;
solver;
 
# .board[0] is a dummy position
def init($depth; $emptyStart):
{ $depth,
board: (true | array(1 + $depth * (1+$depth) / 2))
}
| .board[0] = false
| .board[$emptyStart] = false;
 
# Display the sequence of moves to a solution
def display($depth):
init($depth; 1)
| . as $init
| drawBoard,
" Original setup\n",
(first(solve) as $solve
| $init
| foreach ($solve.solutions[]) as [$peg, $over, $source] (.;
.board[$peg] = true
| .board[$over] = false
| .board[$source] = false;
drawBoard,
"Peg \($source) jumped over peg \($over) to land on \($peg)\n" ) ) ;
 
display(6),
"\nTotal number of solutions for a board of height 5 is \(init(5; 1) | count(solve))"
</syntaxhighlight>
{{output}}
<pre style="height:20lh;overflow:auto>
-
2 3
4 5 6
7 8 9 A
B C D E F
G H I J K L
Original setup
 
1
- 3
- 5 6
7 8 9 A
B C D E F
G H I J K L
Peg 4 jumped over peg 2 to land on 1
 
1
2 3
- - 6
7 8 - A
B C D E F
G H I J K L
Peg 9 jumped over peg 5 to land on 2
 
-
- 3
4 - 6
7 8 - A
B C D E F
G H I J K L
Peg 1 jumped over peg 2 to land on 4
 
1
- -
4 - -
7 8 - A
B C D E F
G H I J K L
Peg 6 jumped over peg 3 to land on 1
 
1
2 -
- - -
- 8 - A
B C D E F
G H I J K L
Peg 7 jumped over peg 4 to land on 2
 
-
- -
4 - -
- 8 - A
B C D E F
G H I J K L
Peg 1 jumped over peg 2 to land on 4
 
-
- -
4 5 -
- - - A
B - D E F
G H I J K L
Peg 12 jumped over peg 8 to land on 5
 
-
- -
- - 6
- - - A
B - D E F
G H I J K L
Peg 4 jumped over peg 5 to land on 6
 
-
- -
- - 6
7 - - A
- - D E F
- H I J K L
Peg 16 jumped over peg 11 to land on 7
 
-
- -
- - 6
7 - 9 A
- - - E F
- H - J K L
Peg 18 jumped over peg 13 to land on 9
 
-
- -
- - -
7 - - A
- - D E F
- H - J K L
Peg 6 jumped over peg 9 to land on 13
 
-
- -
- - 6
7 - - -
- - D E -
- H - J K L
Peg 15 jumped over peg 10 to land on 6
 
-
- -
- - 6
7 - - -
- - D E -
- H I - - L
Peg 20 jumped over peg 19 to land on 18
 
-
- -
- - 6
7 - - -
- - D E -
- - - J - L
Peg 17 jumped over peg 18 to land on 19
 
-
- -
- - 6
7 8 - -
- - - E -
- - - - - L
Peg 19 jumped over peg 13 to land on 8
 
-
- -
- - 6
- - 9 -
- - - E -
- - - - - L
Peg 7 jumped over peg 8 to land on 9
 
-
- -
- - -
- - - -
- - D E -
- - - - - L
Peg 6 jumped over peg 9 to land on 13
 
-
- -
- - -
- - - -
- - - - F
- - - - - L
Peg 13 jumped over peg 14 to land on 15
 
-
- -
- - -
- - - A
- - - - -
- - - - - -
Peg 21 jumped over peg 15 to land on 10
 
Total number of solutions for a board of depth 5: 13987
</pre>
 
Line 1,159 ⟶ 1,718:
end
</syntaxhighlight>{{out}}
<pre style="height:20lh;overflow:auto>
<pre>
Starting board:
0
Line 3,486 ⟶ 4,045:
{{trans|Kotlin}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="ecmascriptwren">import "./fmt" for Conv, Fmt
 
var board = List.filled(16, true)
3,048

edits