Solve triangle solitaire puzzle

An IQ Puzzle is a triangle of 15 golf tee's This is typically seen at Cracker Barrel where one tee is missing and the remaining tees jump each other until one tee is left. The fewer tees left the higher the IQ score. peg #1 is the top centre through to the bottom row which are pegs 11 through to 15.

(Note: need ASCII art version of reference picture http://www.joenord.com/puzzles/peggame/)

Task description

Print a solution to solve the puzzle leaving one peg Not implemented variations Start with empty peg in X and solve with one peg in position Y.

D

Translation of: Ruby

<lang d>import std.stdio, std.array, std.string, std.range, std.algorithm;

immutable N = [0,1,1,1,1,1,1,1,1,1,1,1,1,1,1]; immutable 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]];

string b2s(in int[] n) pure @safe {

   static immutable fmt = iota(6)
                          .map!(i => " ".replicate(5 - i) ~ "%d ".replicate(i))
                          .join("\n");
   return fmt.format(n[0], n[1], n[2],  n[3],  n[4],  n[5],  n[6],
                     n[7], n[8], n[9], n[10], n[11], n[12], n[13], n[14]);

}

string solve(in int[] n, in int i, in int[] g) pure @safe {

   if (i == N.length - 1)
       return "\nSolved";
   if (n[g[1]] == 0)
       return null;
   string s;
   if (n[g[0]] == 0) {
       if (n[g[2]] == 0)
           return null;
       s = "\n%d to %d\n".format(g[2], g[0]);
   } else {
       if (n[g[2]] == 1)
           return null;
       s = "\n%d to %d\n".format(g[0], g[2]);
   }

   auto a = n.dup;
   foreach (const gi; g)
       a[gi] = 1 - a[gi];
   string l;
   foreach (const gi; G) {
       l = solve(a, i + 1, gi);
       if (!l.empty)
           break;
   }
   return l.empty ? l : (s ~ b2s(a) ~ l);

}

void main() @safe {

   b2s(N).write;
   string l;
   foreach (const g; G) {
       l = solve(N, 1, g);
       if (!l.empty)
           break;
   }
   writeln(l.empty ? "No solution found." : l);

}</lang>

Output:

J

Prolog

Works with SWI-Prolog and module(lambda).

<lang Prolog>:- use_module(library(lambda)).

iq_puzzle :- iq_puzzle(Moves), display(Moves).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % compute solution % iq_puzzle(Moves) :- play([1], [2,3,4,5,6,7,8,9,10,11,12,13,14,15], [], Moves).

play(_, [_], Lst, Moves) :- reverse(Lst, Moves).

play(Free, Occupied, Lst, Moves) :- select(S, Occupied, Oc1), select(O, Oc1, Oc2), select(E, Free, F1), move(S, O, E), play([S, O | F1], [E | Oc2], [move(S,O,E) | Lst], Moves).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % allowed moves % move(S,2,E) :- member([S,E], [[1,4], [4,1]]). move(S,3,E) :- member([S,E], [[1,6], [6,1]]). move(S,4,E):- member([S,E], [[2,7], [7,2]]). move(S,5,E):- member([S,E], [[2,9], [9,2]]). move(S,5,E):- member([S,E], [[3,8], [8,3]]). move(S,6,E):- member([S,E], [[3,10], [10,3]]). move(S,5,E):- member([S,E], [[4,6], [6,4]]). move(S,7,E):- member([S,E], [[4,11], [11,4]]). move(S,8,E):- member([S,E], [[4,13], [13,4]]). move(S,8,E):- member([S,E], [[5,12], [12,5]]). move(S,9,E):- member([S,E], [[5,14], [14,5]]). move(S,9,E):- member([S,E], [[6,13], [13,6]]). move(S,10,E):- member([S,E], [[6,15], [15,6]]). move(S,8,E):- member([S,E], [[9,7], [7,9]]). move(S,9,E):- member([S,E], [[10,8], [8,10]]). move(S,12,E):- member([S,E], [[11,13], [13,11]]). move(S,13,E):- member([S,E], [[12,14], [14,12]]). move(S,14,E):- member([S,E], [[15,13], [13,15]]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % display soluce % display(Sol) :- display(Sol, [1]).

display([], Free) :- numlist(1,15, Lst), maplist(\X^I^(member(X, Free) -> I = 0; I = 1), Lst, [I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15]), format(' ~w ~n', [I1]), format(' ~w ~w ~n', [I2,I3]), format(' ~w ~w ~w ~n', [I4,I5,I6]), format(' ~w ~w ~w ~w ~n', [I7,I8,I9,I10]), format('~w ~w ~w ~w ~w~n', [I11,I12,I13,I14,I15]), writeln(solved).

display([move(Start, Middle, End) | Tail], Free) :- numlist(1,15, Lst), maplist(\X^I^(member(X, Free) -> I = 0; I = 1), Lst, [I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15]), format(' ~w ~n', [I1]), format(' ~w ~w ~n', [I2,I3]), format(' ~w ~w ~w ~n', [I4,I5,I6]), format(' ~w ~w ~w ~w ~n', [I7,I8,I9,I10]), format('~w ~w ~w ~w ~w~n', [I11,I12,I13,I14,I15]), format('From ~w to ~w over ~w~n~n~n', [Start, End, Middle]), select(End, Free, F1), display(Tail, [Start, Middle | F1]). </lang> Output :

 ?- iq_puzzle.
    0        
   1 1      
  1 1 1    
 1 1 1 1  
1 1 1 1 1
From 4 to 1 over 2


    1        
   0 1      
  0 1 1    
 1 1 1 1  
1 1 1 1 1
From 6 to 4 over 5


    1        
   0 1      
  1 0 0    
 1 1 1 1  
1 1 1 1 1
From 1 to 6 over 3


    0        
   0 0      
  1 0 1    
 1 1 1 1  
1 1 1 1 1
From 7 to 2 over 4


    0        
   1 0      
  0 0 1    
 0 1 1 1  
1 1 1 1 1
From 10 to 3 over 6


    0        
   1 1      
  0 0 0    
 0 1 1 0  
1 1 1 1 1
From 12 to 5 over 8


    0        
   1 1      
  0 1 0    
 0 0 1 0  
1 0 1 1 1
From 13 to 6 over 9


    0        
   1 1      
  0 1 1    
 0 0 0 0  
1 0 0 1 1
From 3 to 10 over 6


    0        
   1 0      
  0 1 0    
 0 0 0 1  
1 0 0 1 1
From 2 to 9 over 5


    0        
   0 0      
  0 0 0    
 0 0 1 1  
1 0 0 1 1
From 15 to 6 over 10


    0        
   0 0      
  0 0 1    
 0 0 1 0  
1 0 0 1 0
From 6 to 13 over 9


    0        
   0 0      
  0 0 0    
 0 0 0 0  
1 0 1 1 0
From 14 to 12 over 13


    0        
   0 0      
  0 0 0    
 0 0 0 0  
1 1 0 0 0
From 11 to 13 over 12


    0        
   0 0      
  0 0 0    
 0 0 0 0  
0 0 1 0 0
solved

Bonus : number of solutions :

 ?- setof(L, iq_puzzle(L), LL), length(LL, Len).
LL = [[move(4, 2, 1), move(6, 5, 4), move(1, 3, 6), move(7, 4, 2), move(10, 6, 3), move(12, 8, 5), move(13, 9, 6), move(..., ..., ...)|...], [move(4, 2, 1), move(6, 5, 4), move(1, 3, 6), move(7, 4, 2), move(10, 6, 3), move(12, 8, 5), move(..., ..., ...)|...], [move(4, 2, 1), move(6, 5, 4), move(1, 3, 6), move(7, 4, 2), move(10, 6, 3), move(..., ..., ...)|...], [move(4, 2, 1), move(6, 5, 4), move(1, 3, 6), move(7, 4, 2), move(..., ..., ...)|...], [move(4, 2, 1), move(6, 5, 4), move(1, 3, 6), move(..., ..., ...)|...], [move(4, 2, 1), move(6, 5, 4), move(..., ..., ...)|...], [move(4, 2, 1), move(..., ..., ...)|...], [move(..., ..., ...)|...], [...|...]|...],
Len = 29760.

Python

<lang Python>#

Draw board triangle in ascii

def DrawBoard(board):

 peg = [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
 for n in xrange(1,16):
   peg[n] = '.'
   if n in board:
     peg[n] = "%X" % n
 print "     %s" % peg[1]
 print "    %s %s" % (peg[2],peg[3])
 print "   %s %s %s" % (peg[4],peg[5],peg[6])
 print "  %s %s %s %s" % (peg[7],peg[8],peg[9],peg[10])
 print " %s %s %s %s %s" % (peg[11],peg[12],peg[13],peg[14],peg[15])

remove peg n from board

def RemovePeg(board,n):

 board.remove(n)

Add peg n on board

def AddPeg(board,n):

 board.append(n)

return true if peg N is on board else false is empty position

def IsPeg(board,n):

 return n in board

A dictionary of valid jump moves index by jumping peg
then a list of moves where move has jumpOver and LandAt positions

JumpMoves = { 1: [ (2,4),(3,6) ], # 1 can jump over 2 to land on 4, or jumper over 3 to land on 6

             2: [ (4,7),(5,9)  ],
             3: [ (5,8),(6,10) ],
             4: [ (2,1),(5,6),(7,11),(8,13) ],
             5: [ (8,12),(9,14) ],
             6: [ (3,1),(5,4),(9,13),(10,15) ],
             7: [ (4,2),(8,9)  ],
             8: [ (5,3),(9,10) ],
             9: [ (5,2),(8,7)  ],
            10: [ (9,8) ],
            11: [ (12,13) ],
            12: [ (8,5),(13,14) ],
            13: [ (8,4),(9,6),(12,11),(14,15) ],
            14: [ (9,5),(13,12)  ],
            15: [ (10,6),(14,13) ]
           }

Solution = []

Recursively solve the problem

def Solve(board):

 #DrawBoard(board)
 if len(board) == 1:
   return board # Solved one peg left
 # try a move for each peg on the board
 for peg in xrange(1,16): # try in numeric order not board order
   if IsPeg(board,peg):
     movelist = JumpMoves[peg]
     for over,land in movelist:
       if IsPeg(board,over) and not IsPeg(board,land):
         saveboard = board[:] # for back tracking
         RemovePeg(board,peg)
         RemovePeg(board,over)
         AddPeg(board,land) # board order changes!

         Solution.append((peg,over,land))

         board = Solve(board)
         if len(board) == 1:
           return board
       ## undo move and back track when stuck!
         board = saveboard[:] # back track
         del Solution[-1] # remove last move
 return board

Remove one peg and start solving

def InitSolve(empty):

 board = [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]
 RemovePeg(board,empty_start)
 Solve(board)

empty_start = 1 InitSolve(empty_start)

board = [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15] RemovePeg(board,empty_start) for peg,over,land in Solution:

 RemovePeg(board,peg)
 RemovePeg(board,over)
 AddPeg(board,land) # board order changes!
 DrawBoard(board)
 print "Peg %X jumped over %X to land on %X\n" % (peg,over,land)</lang>

Output:

     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

Racket

This includes the code to generate the list of available hops (other implementations seem to have the table built in)
It produces a full has containing all the possible results from all possible start positions (including ones without valid hops, and unusual starts). It takes no time... and once this is pre-calculated then some of the questions you might want answered about this puzzle can be more easily answered!

Oh and there are some useful triangle numbers functions thrown in for free!

<lang racket>#lang racket (define << arithmetic-shift) (define bwbs? bitwise-bit-set?)

(define (A002024 n) (exact-floor (+ 1/2 (sqrt (* n 2)))))

(define (A002260 n) (+ 1 (A002262 (sub1 n))))

OEIS

A000217: Triangular numbers: a(n) = C(n+1,2) = n(n+1)/2 = 0+1+2+...+n.

(define (tri n) (* n (sub1 n) 1/2))

OEIS

A002262: Triangle read by rows: T(n,k)

(define (A002262 n)

 (define trinv (exact-floor (/ (+ 1 (sqrt (+ 1 (* n 8)))) 2)))
 (- n (/ (* trinv (- trinv 1)) 2)))

(define row-number A002024) (define col-number A002260) (define (r.c->n r c) (and (<= 1 r 5) (<= 1 c r) (+ 1 (tri r) (- c 1))))

(define (available-jumps n) ; takes a peg number, and returns a list of (jumped-peg . landing-site)

 (define r (row-number n))
 (define c (col-number n))
 ;; Six possible directions - although noone gets all six: "J" - landing site, "j" jumped peg
 ;;   Triangle   Row/column (square edge)
 ;;    A . B     A.B
 ;;   . a b      .ab
 ;;  C c X d D   CcXdD
 ;; . . e f      ..ef
 ;;. . E . F     ..E.F
 (define (N+.n+ r+ c+) (cons (r.c->n (+ r (* 2 r+)) (+ c (* 2 c+))) (r.c->n (+ r r+) (+ c c+))))
 (define-values (A.a B.b C.c D.d E.e F.f)
   (values (N+.n+ -1 -1) (N+.n+ -1 0) (N+.n+ 0 -1) (N+.n+ 0 1) (N+.n+ 1 0) (N+.n+ 1 1)))
 (filter car (list A.a B.b C.c D.d E.e F.f)))

(define (available-jumps/bits n0)

 (for/list ((A.a (available-jumps (add1 n0))))
   (match-define (cons (app sub1 A) (app sub1 a)) A.a)
   (list A a (bitwise-ior (<< 1 n0) (<< 1 A) (<< 1 a))))) ; on a hop, these three bits will flip

(define avalable-jumps-list/bits (for/vector #:length 15 ((bit 15)) (available-jumps/bits bit)))

(define paths# (make-hash)) (for* ((board (in-range 0 (expt 2 15)))

      (peg (in-range 15))
      #:when (bwbs? board peg)
      (Jjf (in-list (vector-ref avalable-jumps-list/bits peg)))
      #:when (bwbs? board (second Jjf)) ; need something to jump
      #:unless (bwbs? board (first Jjf))) ; need a clear landing space
 (define board- (bitwise-xor board (third Jjf)))
 (hash-update! paths# board (λ (old) (cons (cons board- Jjf) old)) null))

(define (find-path start end (acc null))

 (if (= start end) (reverse acc)
     (for*/first
         ((hop (hash-ref paths# start null))
          (inr (in-value (find-path (car hop) end (cons hop acc)))) #:when inr) inr)))

(define (display-board board.Jjf)

 (match-define (list board (app add1 J) (app add1 j) _) board.Jjf)
 (printf "~a jumps ~a ->" J j)
 (for* ((r (in-range 1 6))
        (c (in-range 1 (add1 r)))
        (n (in-value (r.c->n r c))))
   (when (= c 1) (printf "~%~a" (make-string (quotient (* 5 (- 5 r)) 2) #\space)))
   (printf "[~a] " (~a #:width 2 #:pad-string " " #:align 'right (if (bwbs? board (sub1 n)) n ""))))
 (newline))

(define (flip-peg p b) (bitwise-xor (<< 1 (sub1 p)) b)) (define empty-board #b000000000000000) (define full-board #b111111111111111)

(for-each display-board (find-path (flip-peg 1 full-board) (flip-peg 13 empty-board)))</lang>

Output:

1 jumps 3 ->
          [ 1] 
       [ 2] [  ] 
     [ 4] [ 5] [  ] 
  [ 7] [ 8] [ 9] [10] 
[11] [12] [13] [14] [15] 
6 jumps 10 ->
          [ 1] 
       [ 2] [  ] 
     [ 4] [ 5] [ 6] 
  [ 7] [ 8] [ 9] [  ] 
[11] [12] [13] [14] [  ] 
10 jumps 9 ->
          [ 1] 
       [ 2] [  ] 
     [ 4] [ 5] [ 6] 
  [ 7] [  ] [  ] [10] 
[11] [12] [13] [14] [  ] 
3 jumps 6 ->
          [ 1] 
       [ 2] [ 3] 
     [ 4] [ 5] [  ] 
  [ 7] [  ] [  ] [  ] 
[11] [12] [13] [14] [  ] 
9 jumps 5 ->
          [ 1] 
       [  ] [ 3] 
     [ 4] [  ] [  ] 
  [ 7] [  ] [ 9] [  ] 
[11] [12] [13] [14] [  ] 
5 jumps 9 ->
          [ 1] 
       [  ] [ 3] 
     [ 4] [ 5] [  ] 
  [ 7] [  ] [  ] [  ] 
[11] [12] [13] [  ] [  ] 
14 jumps 13 ->
          [ 1] 
       [  ] [ 3] 
     [ 4] [ 5] [  ] 
  [ 7] [  ] [  ] [  ] 
[11] [  ] [  ] [14] [  ] 
2 jumps 4 ->
          [ 1] 
       [ 2] [ 3] 
     [  ] [ 5] [  ] 
  [  ] [  ] [  ] [  ] 
[11] [  ] [  ] [14] [  ] 
8 jumps 5 ->
          [ 1] 
       [ 2] [  ] 
     [  ] [  ] [  ] 
  [  ] [ 8] [  ] [  ] 
[11] [  ] [  ] [14] [  ] 
4 jumps 2 ->
          [  ] 
       [  ] [  ] 
     [ 4] [  ] [  ] 
  [  ] [ 8] [  ] [  ] 
[11] [  ] [  ] [14] [  ] 
13 jumps 8 ->
          [  ] 
       [  ] [  ] 
     [  ] [  ] [  ] 
  [  ] [  ] [  ] [  ] 
[11] [  ] [13] [14] [  ] 
12 jumps 13 ->
          [  ] 
       [  ] [  ] 
     [  ] [  ] [  ] 
  [  ] [  ] [  ] [  ] 
[11] [12] [  ] [  ] [  ] 
13 jumps 12 ->
          [  ] 
       [  ] [  ] 
     [  ] [  ] [  ] 
  [  ] [  ] [  ] [  ] 
[  ] [  ] [13] [  ] [  ]

Ruby

<lang ruby># Solitaire Like Puzzle Solver - Nigel Galloway: October 18th., 2014 PEGS = (N = [0,1,1,1,1,1,1,1,1,1,1,1,1,1,1]).inject(:+) 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]] FORMAT = (1..5).map{|i| " "*(5-i)+"%d "*i+"\n"}.join+"\n" def solve n,i,g

 return "Solved" if i == PEGS
 return false unless n[g[1]]==1
 if n[g[0]] == 0
   return false unless n[g[2]]==1
   s =  "#{g[2]} to #{g[0]}\n"
 else
   return false unless n[g[2]]==0
   s = "#{g[0]} to #{g[2]}\n" 
 end
 a = n.clone; g.each{|n| a[n] = 1 - a[n]}
 l=false; G.each{|g| l=solve(a,i+1,g); break if l}
 return l ? s + FORMAT % a + l : l

end puts FORMAT % N l=false; G.each{|g| l=solve(N,1,g); break if l} puts l ? l : "No solution found" </lang>

Output: