Positive Analogue

Prolog Peg Puzzle Problem

March 12, 2019

Recently I developed a minor obsession over a little solitaire game. This was after a copy of the game was placed on each table at my cousin’s wedding, all made by the groom’s grandfather.

Skip to solving the puzzle or the full solution

puzzle

The game requires a board with 15 short pegs placed in a triangular pattern. To start the game, remove one peg. To remove further pegs an adjacent peg must ‘jump’ over it into an empty position. The aim of the game is to remove as many pegs as possible - leaving the board with just one peg remaining is the ultimate victory.

Try as I may, I could not finish with fewer than two pegs. My father (sitting on a different table) claims he managed it. I was starting to wonder if there was some trick to solving it, maybe I needed to think outside the box. I also started to reminisce on my time learning about Prolog while at university. A language based on logic felt perfectly suited for investigating the properties of the game. A few questions I wished to answer (without searching the internet, in fear I would read too much and spoil my fun):

  • Is it really possible to finish with only one peg remaining?
  • Does it matter which peg is removed first?
  • How many different solutions are there?

It had been a few years since I had written any Prolog and even back then this puzzle would have pushed my understanding of the language. So I first needed to get my books back out and give myself a refresher.

My main takeaway of Prolog is that lets us build an interactive knowledge base. It is an example of a declarative language. In contract to an imperative language, which puts emphasis on writing a series of instructions. The author of a Prolog program instead writes a list of things which are true in a way that the computer can search and validate.

An online interactive Prolog environment can be found at https://swish.swi-prolog.org/ or installed locally with brew install swi-prolog and started with swipl

% Here I state some facts
vegetable(broccoli). vegetable(carrots).

In more common programming languages the above syntax usually means there is a function called vegetable and it is being called twice with the values stored in the symbols broccoli and carrots. This is not the case here. In Prolog the above can be read as: there is a question vegetable where a correct answer is carrots and also broccoli. Alternatively: “carrots and broccoli are vegetables”. No part of the program has been omitted, vegetable, carrots or broccoli have not been defined or created somewhere else.

With this program loaded into a Prolog environment I can then enter some queries and see the response.

% Querying the above program
?- vegetable(carrots).
↳ true.

?- vegetable(broccoli).
↳ true.

% We can also try asking some questions for things
% we have not 'taught' the system
?- vegetable(cabbage).
↳ false.

?- fruit(apple).
ERROR: Undefined procedure: fruit/1 (DWIM could not correct goal)

The above may not seem particular useful, so far it is just spitting back to us the facts we have entered. A slightly more useful query we can get the system to run is to find all the valid answers to a question. This is achieved by entering the question but replacing the desired part of the answer with a placeholder (written as a name starting with a capital letter). Prolog will then attempt to find valid values for the placeholder.

?- vegetable(Veg).Veg = broccoli ;Veg = carrots.

% findall is a built in prolog utility for putting all answers into a list
?- findall(Veg, vegetable(Veg), All_Veg).All_Veg = [broccoli, carrots].

We can build up larger systems by also having rules, Facts that reference other facts.

vegetable(broccoli). vegetable(carrots).

meat(beef). meat(chicken).
dinner([M, V1, V2])  :- meat(M), vegetable(V1), vegetable(V2), V1 \= V2.

Here we have registered beef and chicken as meat. The longer part at the end introduces a lot of new syntax [] :- , \= and can be read as:

  • dinner is made from a list with three items M, V1, V2
  • M must be meat
  • V1 and V2 must be vegetables
  • V1 must not be the same as V2

This can be queried in the same way as before.

?- dinner(Ingredients).Ingredients = [beef, broccoli, carrots] ;Ingredients = [beef, carrots, broccoli] ;Ingredients = [chicken, broccoli, carrots] ;Ingredients = [chicken, carrots, broccoli].

Another way we can add depth to the system is to write rules that reference themselves recursively. For example this is one way to (inefficiently) reverse arbitrarily sized lists.

reverseList([], []).
reverseList(Result, [FirstItem | RemainingList])
  :- reverseList(RemainingReversed, RestOfList),
     append(RemainingReversed, [FirstItem], Result).

:- reverseList([], []).
:- reverseList([1], [1]).
:- reverseList([2, 1], [1, 2]).

A rule with no left-hand-part, just starting with :- indicates that the right-hand-side should always be true given all the other facts. When the program is loaded Prolog will error if any of them do not hold. They are useful for adding tests along the way and provide examples for the reader

Solving the puzzle

Feeling re-acquainted with Prolog I started trying to describe the puzzle using it. To avoid feeling too overwhelmed I decided to just start writing the most fundamental parts of the game and hope they would build up towards a solution. Step one was registering the set of positions in the board. Each position is represented by an X and Y position.

% position(X, Y).
% X,Y is a position on the board
                             position(1, 1).
                     position(1, 2). position(2, 2).
               position(1, 3). position(2, 3). position(3, 3).
       position(1, 4). position(2, 4). position(3, 4). position(4, 4).
position(1, 5). position(2, 5). position(3, 5). position(4, 5). position(5, 5).

Next I wanted to describe the direction pegs can jump in. Directions are defined using a two item list and should be used like a vector. For example moving from (5, 5) to (3, 3) is a direction of (-1, -1) twice. A directionOf rule helps perform the calculation and also fails if the direction ends up off the edge of the board.

% direction((X, Y)).
% The vector (X, Y) is a direction the pegs can jump in.
% Adding a direction to a position twice will result in the landing position of a jump
direction(( 1,  0)). % east
direction(( 0, -1)). % NE
direction(( 1,  1)). % SE
direction((-1,  0)). % west
direction((-1, -1)). % NW
direction(( 0,  1)). % SW

% directionOf(Direction, To-Position, From-Position).
% Starting in From-Position and moving in Direction results in To-Position
directionOf((DirX, DirY), (X1,Y1), (X2, Y2)) :-
    direction((DirX, DirY)),
    X1 is X2 + DirX,
    Y1 is Y2 + DirY,
    position(X1, Y1).
:- directionOf((0, 1), (1,2), (1,1)).
:- directionOf((-1, -1), (4,4), (5,5)).

We now have a way of describing the board and how we can move around it. The next important part of the puzzle is to capture the current state of the game. Namely which positions have pegs in them, and which ones are empty. I decided to use a list of all the positions, with a boolean true/false value along with each position to represent if there is a peg in that position or not. Again I created some helper rules, this time peg and empty for finding these positions from a given game state.

% pegPosition(PositionState).
% PositionState contains a peg
pegPosition((_, _, true)).

% holePosition(PositionState).
% PositionState has no peg
holePosition((_, _, false)).

% empty(Position, State).
% Given a game State, Position is currently empty
empty((X, Y), State) :-
    member((X, Y, Peg), State),
    holePosition((X, Y, Peg)).
:- empty((1, 2), [(1, 1, true),  (1, 2, false)]).

% peg(Position, State).
% Given a game State, Position currently has a peg
peg((X, Y), State) :-
    member((X, Y, Peg), State),
    pegPosition((X, Y, Peg)).
:- peg((1, 1), [(1, 1, true),  (1, 2, false)]).

So far so good. We now have all the core data structures we’ll need to represent the game. All we need to do now is for Prolog to explore the data in a way that mimics playing the game. Easier said than done. Following the spirit of trying to ignore the fact I do not know how to actually do this in Prolog, I started to define the next smallest aspect of the game in hope it will all come together in the end.

Next up is getting the game started. Having a peg in all but one position and we already know how to get Prolog to pick something from a list. It’s just like picking a vegetable.

?- position(X, Y), FirstPegToRemove = (X, Y).FirstPegToRemove = (1, 1) ;FirstPegToRemove = (1, 2) ;FirstPegToRemove = (2, 2) ;
...

To build up the starting state of the game we can get Prolog to put all the positions into one list, pick a peg to remove and then make a new list that has a copy of all the positions and whether there is peg in that position still.

% initialPegState(FirstPegToRemove, Position, PositionState).
% PositionState is the starting state for Position given FirstPegToRemove
% should have its peg removed
initialPegState((X, Y),  (X, Y),  (X, Y, false)) :- !.
initialPegState((_, _),  (X, Y),  (X, Y, true)).
:- initialPegState((1, 1),  (1, 1),  (1, 1, false)).
:- initialPegState((5, 5),  (1, 1),  (1, 1, true)).

% startingState(S).
% S is a valid starting game state. i.e. all but one position has a peg
startingState(S) :-
    findall((PX, PY), position(PX, PY), Ps),
    position(X, Y),
    FirstPegToRemove=(X, Y),
    maplist(initialPegState(FirstPegToRemove), Ps, S).

maplist like findall is another built-in rule that Prolog has already pre-defined for us. Prolog also has a form of currying, when we pass the rule initialPegState to maplist we are supplying the first value and omitting the other two, leaving them to be filled in later by maplist.

We can now get Prolog to produce all the possible starting states of the game.

?- startingState(S).S = [(1, 1, false),  (1, 2, true),  (2, 2, true),  (1, 3, true),  (2, 3, true),  (3, 3, true),  (1, 4, true),  (2, ..., ...),  (..., ...)|...] ;S = [(1, 1, true),  (1, 2, false),  (2, 2, true),  (1, 3, true),  (2, 3, true),  (3, 3, true),  (1, 4, true),  (2, ..., ...),  (..., ...)|...] ;S = [(1, 1, true),  (1, 2, true),  (2, 2, false),  (1, 3, true),  (2, 3, true),  (3, 3, true),  (1, 4, true),  (2, ..., ...),  (..., ...)|...] ;
...

What we really need the program to do for us now is to starting jumping pegs, as that is essentially the point of the entire game. A valid jump requires the system to look at the current state, find a peg, pick a direction and then moving in that direction, see another peg and then a hole.

% jump(From-Position, Over-Position, To-Position, State).
% Given a game State, it is currently possible to jump the peg in From-Position,
% over the peg in Over-Position, landing in position To-Position
jump(From, Over, To, State) :-
    peg(From, State),
    direction(DX, DY),
    directionOf((DX, DY), Over, From),
    peg(Over, State),
    directionOf((DX, DY), To, Over),
    empty(To, State).
:- jump((1, 3),  (1, 2),  (1, 1), [(1, 1, false),  (1, 2, true),  (1, 3, true)]).

Testing what I had so far I was able to get Prolog to produce a list of valid jumps given the current state of the board. Truth be told I was getting quite excited at reaching this milestone ☕️.

?- startingState(S), jump(From, Over, To, S).From =  (1, 3),Over =  (1, 2),To =  (1, 1) ;From =  (3, 3),Over =  (2, 2),To =  (1, 1) ;From =  (1, 4),Over =  (1, 3),To =  (1, 2) ;
...

The next part I found the most difficult to suss out. The system could find jumps, but it needed to do this in a loop. Take a state, find a jump, produce the next state and repeat. A key rule of any loop is to tell the system when to stop. This felt like the next smallest piece to bite off.

% remainingPegs(Count, State).
% Count is the number of pegs remaining in the State
remainingPegs(0, []).
remainingPegs(R, [(_, _, true)|T]) :-
    remainingPegs(R2, T),
    R is R2+1.
remainingPegs(R, [(_, _, false)|T]) :-
    remainingPegs(R, T).
:- remainingPegs(0, [(1, 1, false),  (1, 2, false),  (1, 3, false)]).
:- remainingPegs(2, [(1, 1, true),  (1, 2, false),  (1, 3, true)]).

% wonGame(State).
% State is a winning state of the game. With only one peg remaining
wonGame(State) :-
    remainingPegs(1, State).
:- wonGame([(1, 1, false),  (1, 2, false),  (1, 3, true)]).

I now needed a rule similar to initialPegState. A rule that could update a position given the jump that is being performed. The rule has four different position cases it matches on

  1. Where the peg is jumping ‘from’, so should now be empty
  2. The middle position the peg is jumping ‘over’, which should now be removed
  3. The final ‘to’ position, which the jumping peg will now occupy
  4. The position is unaffected by the jump and should keep its current state
% nextState(NextState, CurrentState).
% nextState(NextState, CurrentState, From, Over, To).
% Given the CurrentState and the positions to perform a jump From, Over, To.
% NextState will be the resulting state of each position
nextState(N, S) :-
    jump(From, Over, To, S),
    nextState(N, S, From, Over, To).
nextState(NextState, CurrentState, From, Over, To) :-
    maplist(nextState__(From, Over, To), CurrentState, NextState).
nextState__((X, Y), _, _,  (X, Y, true),  (X, Y, false)) :- !.
nextState__(_,  (X, Y), _,  (X, Y, true),  (X, Y, false)) :- !.
nextState__(_, _,  (X, Y),  (X, Y, false),  (X, Y, true)) :- !.
nextState__(_, _, _, P, P) :- !.
:- nextState([(1, 1, false),  (1, 2, false),  (1, 3, true)],
             [(1, 1, true),  (1, 2, true),  (1, 3, false)]).

Last but not least, a rule which keeps calling nextState recurisvely until the game has been won. Putting each game state into one long list so we can follow the solution it found.

% solution(S).
% S is a valid list of game states, from the start of the game through to a winning state
solution(S) :-
    startingState(StartingState),
    solution__(S, [StartingState], StartingState).
solution__(Solution, Acc, State) :-
    wonGame(State), !,
    Solution=Acc.
solution__(Solution, Acc, State) :-
    nextState(NextState, State),
    append([NextState], Acc, NextAcc),
    solution__(Solution, NextAcc, NextState).

By this point I was getting quite nervous. I had never written so much Prolog for one problem before and had absolutely no idea how long it would take to run this. What if it took hours to run, would I just wait…what about days? I entered the query, held my breath and pressed enter. The solution came back in less than one second. I was really impressed. It had searched thousands of possibilities and found a solution in a blink of an eye.

time((solution(_))).342,184 inferences, 0.051 CPU in 0.051 seconds (100% CPU, 6693337 Lips)

Initially I didn’t trust that it had actually worked and looking at the long list of numbers it had spat out it wasn’t easy to tell. So I wrote a few more rules that could print the solution in a human readable form.

printState(S) :-
    maplist(charForPositionState__, S, Chars),
    printState__(Chars).
printState__([A, B, C, D, E, F, G, H, I, J, K, L, M, N, O]) :-
    format('    ~w~n', [A]),
    format('   ~w ~w~n', [B, C]),
    format('  ~w ~w ~w~n', [D, E, F]),
    format(' ~w ~w ~w ~w~n', [G, H, I, J]),
    format('~w ~w ~w ~w ~w\n\n',
           [K, L, M, N, O]).
charForPositionState__((_, _, true), 'X').
charForPositionState__((_, _, false), 'O').

solutionPrint() :-
    solution(G),
    reverse(R, G),
    solutionPrint(R).
solutionPrint([]).
solutionPrint([H|T]) :-
    printState(H),
    solutionPrint(T).
    O
   X X
  X X X
 X X X X
X X X X X

    X
   X O
  X X O
 X X X X
X X X X X

    X
   X X
  X O O
 X O X X
X X X X X

    X
   X X
  X X O
 X O O X
X X X O X

    X
   X X
  X X X
 X O O O
X X X O O

    X
   O X
  X O X
 X O X O
X X X O O

    X
   X X
  O O X
 O O X O
X X X O O

    O
   O X
  X O X
 O O X O
X X X O O

    O
   O O
  X O O
 O O X X
X X X O O

    O
   O O
  X O O
 O X O O
X X X O O

    O
   O O
  X O O
 O X O O
X O O X O

    O
   O O
  O O O
 O O O O
X O X X O

    O
   O O
  O O O
 O O O O
X X O O O

    O
   O O
  O O O
 O O O O
O O X O O

One question down, two to go.

  • Is it really possible to finish with only one peg remaining?
  • Does it matter which peg is removed first?
  • How many different solutions are there?
winningFirstPegToRemove(FirstPegToRemove) :-
    findall((X, Y), position(X, Y), Ps),
    maplist(initialPegState(FirstPegToRemove), Ps, StartingState),
    solution__(_, [StartingState], StartingState), !

?- position(X, Y), winningFirstPegToRemove((X, Y)).X = 1, Y = 1 ;X = 1, Y = 2 ;X = 2, Y = 2 ;X = 1, Y = 3 ;X = 2, Y = 3 ;X = 3, Y = 3 ;X = 1, Y = 4 ;X = 2, Y = 4 ;X = 3, Y = 4 ;X = 4, Y = 4 ;X = 1, Y = 5 ;X = 2, Y = 5 ;X = 3, Y = 5 ;X = 4, Y = 5 ;X = 5, Y = 5.
  • Is it really possible to finish with only one peg remaining?
  • Does it matter which peg is removed first?
  • How many different solutions are there?
?- time(aggregate_all(count, solution(S), Count)).
% 7,932,994,328 inferences, 1470.806 CPU in 1475.852 seconds (100% CPU, 5393637 Lips)Count = 438984.
  • Is it really possible to finish with only one peg remaining?
  • Does it matter which peg is removed first?
  • How many different solutions are there?

🎉

Full Solution

% position(PX, PY).
% (PX,PY) is a position on the board
                             position(1, 1).
                     position(1, 2). position(2, 2).
               position(1, 3). position(2, 3). position(3, 3).
       position(1, 4). position(2, 4). position(3, 4). position(4, 4).
position(1, 5). position(2, 5). position(3, 5). position(4, 5). position(5, 5).

% direction(X, Y).
% The vector (X, Y) is a direction the pegs can jump in.
% Adding a direction to a position twice will result in the landing position of a jump
direction(( 1,  0)). % east
direction(( 0, -1)). % north-east
direction(( 1,  1)). % south-east
direction((-1,  0)). % west
direction((-1, -1)). % north-west
direction(( 0,  1)). % south-west

% directionOf(Direction, To-Position, From-Position).
% Starting in From-Position and moving in Direction results in To-Position
directionOf((DirX, DirY),  (X1, Y1),  (X2, Y2)) :-
    direction(DirX, DirY),
    X1 is X2+DirX,
    Y1 is Y2+DirY,
    position(X1, Y1).
:- directionOf((0, 1),  (1, 2),  (1, 1)).
:- directionOf((-1, -1),  (4, 4),  (5, 5)).

% pegPosition(PositionState).
% PositionState contains a peg
pegPosition((_, _, true)).

% holePosition(PositionState).
% PositionState has no peg
holePosition((_, _, false)).

% empty(Position, State).
% Given a game State, Position currently has no peg
empty((X, Y), State) :-
    member((X, Y, Peg), State),
    holePosition((X, Y, Peg)).
:- empty((1, 2), [(1, 1, true),  (1, 2, false)]).

% peg(Position, State).
% Given a game State, Position currently has a peg
peg((X, Y), State) :-
    member((X, Y, Peg), State),
    pegPosition((X, Y, Peg)).
:- peg((1, 1), [(1, 1, true),  (1, 2, false)]).

% initialPegState(FirstPegToRemove, Position, PositionState).
% PositionState is the starting state for Position given FirstPegToRemove
% should have its peg removed
initialPegState((X, Y),  (X, Y),  (X, Y, false)) :- !.
initialPegState((_, _),  (X, Y),  (X, Y, true)).
:- initialPegState((1, 1),  (1, 1),  (1, 1, false)).
:- initialPegState((5, 5),  (1, 1),  (1, 1, true)).

% startingState(S).
% S is a valid starting game state. i.e. all but one position has a peg
startingState(S) :-
    findall((PX, PY), position(PX, PY), Ps),
    position(X, Y),
    FirstPegToRemove=(X, Y),
    maplist(initialPegState(FirstPegToRemove), Ps, S).

% jump(From-Position, Over-Position, To-Position, State).
% Given a game State, it is currently possible to jump the peg in From-Position,
% over the peg in Over-Position, landing in position To-Position
jump(From, Over, To, State) :-
    peg(From, State),
    direction(DX, DY),
    directionOf((DX, DY), Over, From),
    peg(Over, State),
    directionOf((DX, DY), To, Over),
    empty(To, State).
:- jump((1, 3),  (1, 2),  (1, 1), [(1, 1, false),  (1, 2, true),  (1, 3, true)]).

% remainingPegs(Count, State).
% Count is the number of pegs remaining in the State
remainingPegs(0, []).
remainingPegs(R, [(_, _, true)|T]) :-
    remainingPegs(R2, T),
    R is R2+1.
remainingPegs(R, [(_, _, false)|T]) :-
    remainingPegs(R, T).
:- remainingPegs(0, [(1, 1, false),  (1, 2, false),  (1, 3, false)]).
:- remainingPegs(2, [(1, 1, true),  (1, 2, false),  (1, 3, true)]).

% wonGame(State).
% State is a winning state of the game. With only one peg remaining
wonGame(State) :-
    remainingPegs(1, State).
:- wonGame([(1, 1, false),  (1, 2, false),  (1, 3, true)]).

% nextState(NextState, CurrentState).
% nextState(NextState, CurrentState, From, Over, To).
% Given the CurrentState and the positions to perform a jump From, Over, To.
% NextState will be the resulting state of each position
nextState(N, S) :-
    jump(From, Over, To, S),
    nextState(N, S, From, Over, To).
nextState(NextState, CurrentState, From, Over, To) :-
    maplist(nextState__(From, Over, To), CurrentState, NextState).
nextState__((X, Y), _, _,  (X, Y, true),  (X, Y, false)) :- !.
nextState__(_,  (X, Y), _,  (X, Y, true),  (X, Y, false)) :- !.
nextState__(_, _,  (X, Y),  (X, Y, false),  (X, Y, true)) :- !.
nextState__(_, _, _, P, P) :- !.
:- nextState([(1, 1, false),  (1, 2, false),  (1, 3, true)],
             [(1, 1, true),  (1, 2, true),  (1, 3, false)]).

% solution(S).
% S is a valid list of game states, from the start of the game through to a winning state
solution(S) :-
    startingState(StartingState),
    solution__(S, [StartingState], StartingState).
solution__(Solution, Acc, State) :-
    wonGame(State), !,
    Solution=Acc.
solution__(Solution, Acc, State) :-
    nextState(NextState, State),
    append([NextState], Acc, NextAcc),
    solution__(Solution, NextAcc, NextState).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  pretty printing solution  %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
printState(S) :-
    maplist(charForPositionState__, S, Chars),
    printState__(Chars).
printState__([A, B, C, D, E, F, G, H, I, J, K, L, M, N, O]) :-
    format('    ~w~n', [A]),
    format('   ~w ~w~n', [B, C]),
    format('  ~w ~w ~w~n', [D, E, F]),
    format(' ~w ~w ~w ~w~n', [G, H, I, J]),
    format('~w ~w ~w ~w ~w\n\n',
           [K, L, M, N, O]).
charForPositionState__((_, _, true), 'X').
charForPositionState__((_, _, false), 'O').

solutionPrint() :-
    solution(G),
    reverse(R, G),
    solutionPrint(R).
solutionPrint([]).
solutionPrint([H|T]) :-
    printState(H),
    solutionPrint(T).

Ashley Claymore

Hi! I'm Ashley Claymore. Like many others, pulling things apart to learn how they work brings me a lot of joy. This site serves as an outlet for these little projects.