Solve triangle solitaire puzzle: Difference between revisions
m
→{{header|ALGOL 68}}: Notes
m (→{{header|ALGOL 68}}: Notes) |
|||
| (26 intermediate revisions by 8 users not shown) | |||
Line 23:
Reference picture: http://www.joenord.com/puzzles/peggame/
<br/>Updated link (June 2021):
https://www.joenord.com/triangle-peg-board-game-solutions-to-amaze-your-friends/
Line 34 ⟶ 36:
{{trans|Python}}
<
V peg = [‘’] * 16
L(n) 1.<16
Line 112 ⟶ 114:
AddPeg(&board, land)
DrawBoard(board)
print("Peg #. jumped over #. to land on #.\n".format(hex(peg), hex(over), hex(land)))</
{{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>
=={{header|D}}==
{{trans|Ruby}}
<
immutable N = [0,1,1,1,1,1,1,1,1,1,1,1,1,1,1];
Line 263 ⟶ 518:
}
writeln(l.empty ? "No solution found." : l);
}</
{{out}}
<pre>
Line 365 ⟶ 620:
=={{header|EasyLang}}==
<syntaxhighlight lang="text">
brd$[] = strchars "
┏━━━━━━━━━┓
┃ · ┃
Line 423 ⟶ 628:
┃ ● ● ● ● ┃
┃● ● ● ● ●┃
┗━━━━━━━━━┛"
proc 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] = "●"
solve solution$
brd$[pos] = "●"
brd$[pos + dir] = "●"
brd$[pos + 2 * dir] = "·"
if solution$ <> ""
solution$ = strjoin brd$[] & solution$
return
.
.
.
.
.
if npegs = 1
solution$ = strjoin brd$[]
.
.
solve solution$
print solution$
</syntaxhighlight>
=={{header|Elixir}}==
Inspired by Ruby
<
def task(i \\ 0, n \\ 5) do
fmt = Enum.map_join(1..n, fn i ->
Line 470 ⟶ 703:
end
IQ_Puzzle.task</
{{out}}
Line 575 ⟶ 808:
=={{header|Go}}==
{{trans|Kotlin}}
<
import "fmt"
Line 689 ⟶ 922:
fmt.Printf("Peg %X jumped over %X to land on %X\n\n", peg, over, land)
}
}</
{{out}}
Line 697 ⟶ 930:
=={{header|J}}==
<syntaxhighlight lang="j">
NB. This is a direct translation of the python program,
NB. except for the display which by move is horizontal.
Line 879 ⟶ 1,112:
NB. Solution NB. return Solution however Solution is global.
)
</syntaxhighlight>
Example linux session with program in file CrackerBarrel.ijs
<pre>
Line 918 ⟶ 1,151:
Print one possible solution.
<syntaxhighlight lang="java">
import java.util.ArrayList;
import java.util.Arrays;
Line 1,106 ⟶ 1,339:
}
</syntaxhighlight>
{{out}}
<pre>
Line 1,140 ⟶ 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>
=={{header|Julia}}==
{{trans|Raku}}
<
[4, 7, 11], [4, 8, 13], [5, 8, 12], [5, 9, 14], [6, 9, 13], [6, 10, 15],
[7, 8, 9], [8, 9, 10], [11, 12, 13], [12, 13, 14], [13, 14, 15]]
Line 1,180 ⟶ 1,717:
end
end
</
<pre style="height:20lh;overflow:auto>
Starting board:
0
Line 1,283 ⟶ 1,820:
=={{header|Kotlin}}==
{{trans|Python}}
<
data class Solution(val peg: Int, val over: Int, val land: Int)
Line 1,358 ⟶ 1,895:
println("Peg %X jumped over %X to land on %X\n".format(peg, over, land))
}
}</
{{out}}
Line 1,462 ⟶ 1,999:
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<
Showstate[state_List, pos_] := Module[{p, e},
p = {#, FirstPosition[pos, #, Missing[], {2}]} & /@ state;
Line 1,507 ⟶ 2,044:
state = DeleteCases[Range[15], x];
continue = True;
SolvePuzzle[{state, {}}, {y}]</
{{out}}
Outputs a graphical overview, by clicking one can go through the different states.
Line 1,513 ⟶ 2,050:
=={{header|Nim}}==
{{trans|Go}}
<
type
Line 1,588 ⟶ 2,125:
board[land] = true
board.draw()
echo "Peg $1 jumped over $2 to land on $3\n".format(peg.toHex(1), over.toHex(1), land.toHex(1))</
{{out}}
Line 1,691 ⟶ 2,228:
=={{header|Perl}}==
{{trans|Raku}}
<
0
1 1
Line 1,742 ⟶ 2,279:
print $result ? $result : "No solution found";
</syntaxhighlight>
{{out}}
<pre style="height:60ex;overflow:scroll;">Starting with
Line 1,862 ⟶ 2,399:
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).
<!--<
<span style="color: #000080;font-style:italic;">-- demo\rosetta\IQpuzzle.exw</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">moves</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{-</span><span style="color: #000000;">11</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">9</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">11</span><span style="color: #0000FF;">,</span><span style="color: #000000;">9</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">2</span><span style="color: #0000FF;">}</span>
Line 1,892 ⟶ 2,429:
"""</span>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">substitute</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">join_by</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">split</span><span style="color: #0000FF;">(</span><span style="color: #000000;">start</span><span style="color: #0000FF;">&</span><span style="color: #000000;">solve</span><span style="color: #0000FF;">(</span><span style="color: #000000;">start</span><span style="color: #0000FF;">,</span><span style="color: #000000;">14</span><span style="color: #0000FF;">),</span><span style="color: #008000;">'\n'</span><span style="color: #0000FF;">),</span><span style="color: #000000;">5</span><span style="color: #0000FF;">,</span><span style="color: #000000;">7</span><span style="color: #0000FF;">),</span><span style="color: #008000;">"-"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">" "</span><span style="color: #0000FF;">))</span>
<!--</
{{out}}
Line 1,910 ⟶ 2,447:
Adapted to the English game (also in demo\rosetta\IQpuzzle.exw):
<!--<
<span style="color: #008080;">constant</span> <span style="color: #000000;">moves</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{-</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">15</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">15</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">solve</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">board</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">left</span><span style="color: #0000FF;">)</span>
Line 1,945 ⟶ 2,482:
"""</span>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">substitute</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">join_by</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">split</span><span style="color: #0000FF;">(</span><span style="color: #000000;">start</span><span style="color: #0000FF;">&</span><span style="color: #000000;">solve</span><span style="color: #0000FF;">(</span><span style="color: #000000;">start</span><span style="color: #0000FF;">,</span><span style="color: #000000;">32</span><span style="color: #0000FF;">),</span><span style="color: #008000;">'\n'</span><span style="color: #0000FF;">),</span><span style="color: #000000;">7</span><span style="color: #0000FF;">,</span><span style="color: #000000;">8</span><span style="color: #0000FF;">),</span><span style="color: #008000;">"-"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">" "</span><span style="color: #0000FF;">))</span>
<!--</
{{out}}
Line 1,981 ⟶ 2,518:
o . . . o o o o o o o o o o o o o o o o o o o o
</pre>
=={{header|Picat}}==
This version use the constraint solver (cp).
<syntaxhighlight lang="picat">import cp.
go =>
% Solve the puzzle
puzzle(1,N,NumMoves,X,Y),
println("Show the moves (Move from .. over .. to .. ):"),
foreach({From,Over,To} in X)
println([from=From,over=Over,to=To])
end,
nl,
println("Show the list at each move (0 is an empty hole):"),
foreach(Row in Y)
foreach(J in 1..15)
printf("%2d ", Row[J])
end,
nl
end,
nl,
println("And an verbose version:"),
foreach(Move in 1..NumMoves)
if Move > 1 then
printf("Move from %d over %d to %d\n",X[Move-1,1],X[Move-1,2],X[Move-1,3])
end,
nl,
print_board([Y[Move,J] : J in 1..N]),
nl
end,
nl,
% fail, % uncomment to see all solutions
nl.
puzzle(Empty,N,NumMoves,X,Y) =>
N = 15,
% Peg 1 can move over 2 and end at 4, etc
% (for table_in/2)
moves(Moves),
ValidMoves = [],
foreach(From in 1..N)
foreach([Over,To] in Moves[From])
ValidMoves := ValidMoves ++ [{From,Over,To}]
end
end,
NumMoves = N-1,
% which move to make
X = new_array(NumMoves-1,3),
X :: 1..N,
% The board at move Move
Y = new_array(NumMoves,N),
Y :: 0..N,
% Initialize for row
Y[1,Empty] #= 0,
foreach(J in 1..N)
if J != Empty then
Y[1,J] #= J
end
end,
% make the moves
foreach(Move in 2..NumMoves)
sum([Y[Move,J] #=0 : J in 1..N]) #= Move,
table_in({From,Over,To}, ValidMoves),
% Get this move and update the rows
element(To,Y[Move-1],0),
element(From,Y[Move-1],FromVal), FromVal #!= 0,
element(Over,Y[Move-1],OverVal), OverVal #!= 0,
element(From,Y[Move],0),
element(To,Y[Move],To),
element(Over,Y[Move],0),
foreach(J in 1..N)
(J #!= From #/\ J #!= Over #/\ J #!= To) #=>
Y[Move,J] #= Y[Move-1,J]
end,
X[Move-1,1] #= From,
X[Move-1,2] #= Over,
X[Move-1,3] #= To
end,
Vars = Y.vars() ++ X.vars(),
solve($[split],Vars).
%
% The valid moves:
% Peg 1 can move over 2 and end at 4, etc.
%
moves(Moves) =>
Moves = [
[[2,4],[3,6]], % 1
[[4,7],[5,9]], % 2
[[5,8],[6,10]], % 3
[[2,1],[5,6],[7,11],[8,13]], % 4
[[8,12],[9,14]], % 5
[[3,1],[5,4],[9,13],[10,15]], % 6
[[4,2],[8,9]], % 7
[[5,3],[9,10]], % 8
[[5,2],[8,7]], % 9
[[6,3],[9,8]], % 10
[[7,4],[12,13]], % 11
[[8,5],[13,14]], % 12
[[8,4],[9,6],[12,11],[14,15]], % 13
[[9,5],[13,12]], % 14
[[10,6],[14,13]] % 15
].
%
% Print the board:
%
% 1
% 2 3
% 4 5 6
% 7 8 9 10
% 11 12 13 14 15
%
print_board(B) =>
printf(" %2d\n", B[1]),
printf(" %2d %2d\n", B[2],B[3]),
printf(" %2d %2d %2d\n", B[4],B[5],B[6]),
printf(" %2d %2d %2d %2d\n",B[7],B[8],B[9],B[10]),
printf(" %2d %2d %2d %2d %2d\n",B[11],B[12],B[13],B[14],B[15]),
nl.</syntaxhighlight>
{{out}}
<pre>Show the moves (Move from .. over .. to .. ):
[from = 4,over = 2,to = 1]
[from = 6,over = 5,to = 4]
[from = 1,over = 3,to = 6]
[from = 12,over = 8,to = 5]
[from = 14,over = 13,to = 12]
[from = 6,over = 9,to = 13]
[from = 12,over = 13,to = 14]
[from = 15,over = 10,to = 6]
[from = 7,over = 4,to = 2]
[from = 2,over = 5,to = 9]
[from = 6,over = 9,to = 13]
[from = 14,over = 13,to = 12]
[from = 11,over = 12,to = 13]
Show the list at each move (0 is an empty hole):
0 2 3 4 5 6 7 8 9 10 11 12 13 14 15
1 0 3 0 5 6 7 8 9 10 11 12 13 14 15
1 0 3 4 0 0 7 8 9 10 11 12 13 14 15
0 0 0 4 0 6 7 8 9 10 11 12 13 14 15
0 0 0 4 5 6 7 0 9 10 11 0 13 14 15
0 0 0 4 5 6 7 0 9 10 11 12 0 0 15
0 0 0 4 5 0 7 0 0 10 11 12 13 0 15
0 0 0 4 5 0 7 0 0 10 11 0 0 14 15
0 0 0 4 5 6 7 0 0 0 11 0 0 14 0
0 2 0 0 5 6 0 0 0 0 11 0 0 14 0
0 0 0 0 0 6 0 0 9 0 11 0 0 14 0
0 0 0 0 0 0 0 0 0 0 11 0 13 14 0
0 0 0 0 0 0 0 0 0 0 11 12 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 13 0 0
And an verbose version:
0
2 3
4 5 6
7 8 9 10
11 12 13 14 15
Move from 4 over 2 to 1
1
0 3
0 5 6
7 8 9 10
11 12 13 14 15
Move from 6 over 5 to 4
1
0 3
4 0 0
7 8 9 10
11 12 13 14 15
Move from 1 over 3 to 6
0
0 0
4 0 6
7 8 9 10
11 12 13 14 15
Move from 12 over 8 to 5
0
0 0
4 5 6
7 0 9 10
11 0 13 14 15
Move from 14 over 13 to 12
0
0 0
4 5 6
7 0 9 10
11 12 0 0 15
Move from 6 over 9 to 13
0
0 0
4 5 0
7 0 0 10
11 12 13 0 15
Move from 12 over 13 to 14
0
0 0
4 5 0
7 0 0 10
11 0 0 14 15
Move from 15 over 10 to 6
0
0 0
4 5 6
7 0 0 0
11 0 0 14 0
Move from 7 over 4 to 2
0
2 0
0 5 6
0 0 0 0
11 0 0 14 0
Move from 2 over 5 to 9
0
0 0
0 0 6
0 0 9 0
11 0 0 14 0
Move from 6 over 9 to 13
0
0 0
0 0 0
0 0 0 0
11 0 13 14 0
Move from 14 over 13 to 12
0
0 0
0 0 0
0 0 0 0
11 12 0 0 0
Move from 11 over 12 to 13
0
0 0
0 0 0
0 0 0 0
0 0 13 0 0</pre>
=={{header|Prolog}}==
Works with SWI-Prolog and module(lambda).
<
iq_puzzle :-
Line 2,081 ⟶ 2,907:
select(End, Free, F1),
display(Tail, [Start, Middle | F1]).
</syntaxhighlight>
Output :
<pre> ?- iq_puzzle.
Line 2,203 ⟶ 3,029:
=={{header|Python}}==
<syntaxhighlight lang="python">#
# Draw board triangle in ascii
#
Line 2,298 ⟶ 3,124:
AddPeg(board,land) # board order changes!
DrawBoard(board)
print "Peg %X jumped over %X to land on %X\n" % (peg,over,land)</
{{out}}
Line 2,403 ⟶ 3,229:
Oh and there are some useful triangle numbers functions thrown in for free!
<
(define << arithmetic-shift)
(define bwbs? bitwise-bit-set?)
Line 2,481 ⟶ 3,307:
;; Solve #1 missing -> #13 left alone
(for-each display-board (find-path (flip-peg 1 full-board) (flip-peg 13 empty-board)))</
{{out}}
Line 2,568 ⟶ 3,394:
{{trans|Sidef}}
<syntaxhighlight lang="raku" line>
constant @start = <
0
Line 2,618 ⟶ 3,444:
last if $result
};
say $result ?? $result !! "No solution found";</
{{out}}
<pre style="height:60ex;overflow:scroll;">Starting with
Line 2,722 ⟶ 3,548:
=={{header|Ruby}}==
<
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]]
Line 2,736 ⟶ 3,562:
l=false; G.each{|g| l=solve(N,N.inject(:+),g); break if l}
puts l ? l : "No solution found"
</syntaxhighlight>
{{out}}
<pre style="height:64ex;overflow:scroll">
Line 2,841 ⟶ 3,667:
=={{header|Sidef}}==
{{trans|Ruby}}
<
const G = [
Line 2,880 ⟶ 3,706:
var r = ''
G.each {|g| (r = solve(N, 1, g)) && break }
say (r ? r : "No solution found")</
{{out}}
Line 2,987 ⟶ 3,813:
'''Notes:'''
This program uses a brute-force method with a string of 25 characters to internally represent the 15 spots on the peg board. One can set the starting removed peg and intended last remaining peg by editing the header variable declarations named '''''Starting''''' and '''''Target'''''. If one doesn't care which spot the last peg lands on, the '''''Target''''' variable can be set to 0. The constant '''''n''''' can be changed for different sized peg boards, for example with '''''n = 6''''' the peg board would have 21 positions.
<
Imports System, Microsoft.VisualBasic.DateAndTime
Line 3,113 ⟶ 3,939:
If Diagnostics.Debugger.IsAttached Then Console.ReadLine()
End Sub
End Module</
{{out}}
'''A full solution:'''
Line 3,219 ⟶ 4,045:
{{trans|Kotlin}}
{{libheader|Wren-fmt}}
<
var board = List.filled(16, true)
Line 3,298 ⟶ 4,124:
drawBoard.call()
Fmt.print("Peg $X jumped over $X to land on $X\n", peg, over, land)
}</
{{out}}
Line 3,304 ⟶ 4,130:
Same as Kotlin entry.
</pre>
=={{header|Yabasic}}==
{{trans|Phix}}
<syntaxhighlight lang="yabasic">// Rosetta Code problem: http://rosettacode.org/wiki/Solve_triangle_solitare_puzzle
// by Galileo, 04/2022
dim moves$(1)
nmov = token("-11,-9,2,11,9,-2", moves$(), ",")
sub solve$(board$, left)
local i, j, mj, over, tgt, res$
if left = 1 return ""
for i = 1 to len(board$)
if mid$(board$, i, 1) = "1" then
for j = 1 to nmov
mj = val(moves$(j)) : over = i + mj : tgt = i + 2 * mj
if tgt >= 1 and tgt <= len(board$) and mid$(board$, tgt, 1) = "0" and mid$(board$, over, 1) = "1" then
mid$(board$, i, 1) = "0" : mid$(board$, over, 1) = "0" : mid$(board$, tgt, 1) = "1"
res$ = solve$(board$, left - 1)
if len(res$) != 4 return board$+res$
mid$(board$, i, 1) = "1" : mid$(board$, over, 1) = "1" : mid$(board$, tgt, 1) = "0"
end if
next
end if
next
return "oops"
end sub
start$ = "\n\n 0 \n 1 1 \n 1 1 1 \n 1 1 1 1 \n1 1 1 1 1"
print start$, solve$(start$, 14)</syntaxhighlight>
{{out}}
<pre>
0
1 1
1 1 1
1 1 1 1
1 1 1 1 1
1
0 1
0 1 1
1 1 1 1
1 1 1 1 1
1
0 1
1 0 0
1 1 1 1
1 1 1 1 1
0
0 0
1 0 1
1 1 1 1
1 1 1 1 1
0
1 0
0 0 1
0 1 1 1
1 1 1 1 1
0
1 1
0 0 0
0 1 1 0
1 1 1 1 1
0
1 1
0 1 0
0 0 1 0
1 0 1 1 1
0
1 1
0 1 1
0 0 0 0
1 0 0 1 1
0
0 1
0 0 1
0 0 1 0
1 0 0 1 1
0
0 0
0 0 0
0 0 1 1
1 0 0 1 1
0
0 0
0 0 1
0 0 1 0
1 0 0 1 0
0
0 0
0 0 0
0 0 0 0
1 0 1 1 0
0
0 0
0 0 0
0 0 0 0
1 1 0 0 0
0
0 0
0 0 0
0 0 0 0
0 0 1 0 0
---Program done, press RETURN---</pre>
=={{header|zkl}}==
{{trans|D}}
{{Trans|Ruby}}
<
var G=T( T(0,1, 3), T(0,2, 5), T(1,3, 6), T( 1, 4, 8), T( 2, 4, 7), T( 2, 5, 9),
T(3,4, 5), T(3,6,10), T(3,7,12), T( 4, 7,11), T( 4, 8,13), T( 5, 8,12),
Line 3,342 ⟶ 4,287:
reg l;
foreach g in (G){ if(l=solve(N,1,g)) break; }
println(l and l or "No solution found.");</
{{out}}
<pre style="height:32ex;overflow:scroll">
| |||