Trying to solve the peg jump puzzle in Prolog

Question

There are 8 pegs in nine holes. At beginning, the four red pegs on the left and the four blue pegs are on the right, and one empty hole between them. The puzzle is to move all the red to the right, and blue pegs to the left(in other opposite). These are the legal moves to do so:

Pegs may only move forward (red may move right and blue left).
A peg may move forward one step into an open position.
A peg may skip over exactly one peg of the opposite color, if the position beyond it is open.

This is what I wrote, but it doesn't work

% Form of board, b for blue, r for red, o for empty.
% [ [r,r,r,r], [o], [b,b,b,b] ]

% jumps 
linjmp([x, x, o | T], [o, o, x | T]).
linjmp([o, x, x | T], [x, o, o | T]).
linjmp([H|T1], [H|T2]) :- linjmp(T1,T2).


% Series of legal boards.
series(From, To, [From, To]) :- jump(From, To).
series(From, To, [From, By | Rest])
        :- jump(From, By), 
           series(By, To, [By | Rest]).

% Print a series of boards.  This puts one board per line and looks a lot
% nicer than the jumble that appears when the system simply beltches out
% a list of boards.  The write_ln predicate is a built-in which always
% succeeds (is always satisfied), but prints as a side-effect.  Therefore
% print_series(Z) will succeed with any list, and the members of the list
% will be printed, one per line, as a side-effect of that success.
print_series_r([]) :- 
    write_ln('*******************************************************').
print_series_r([X|Y]) :- write_ln(X), print_series_r(Y).
print_series(Z) :- 
    write_ln('\n*******************************************************'),
    print_series_r(Z).

% A solution.
solution(L) :- series([[r,r,r,r], [o], [b,b,b,b]],
                   [[b,b,b,b], [o], [r,r,r,r]], L).

% Find a print the first solution.  
solve :- solution(X), print_series(X).

% Find all the solutions.
solveall :- solve, fail.

% This finds each solution with stepping.
solvestep(Z) :- Z = next, solution(X), print_series(X).

It should be like so when it works:

?- consult(linejump).
% linejump compiled 0.00 sec, 3,612 bytes
true.

?- solve.

*******************************************************
[r, r, r, r, o, b, b, b, b]
[r, r, r, o, r, b, b, b, b]
[r, r, r, b, r, o, b, b, b]
[r, r, r, b, r, b, o, b, b]
[r, r, r, b, o, b, r, b, b]
[r, r, o, b, r, b, r, b, b]
[r, o, r, b, r, b, r, b, b]
[r, b, r, o, r, b, r, b, b]
[r, b, r, b, r, o, r, b, b]
[r, b, r, b, r, b, r, o, b]
[r, b, r, b, r, b, r, b, o]
[r, b, r, b, r, b, o, b, r]
[r, b, r, b, o, b, r, b, r]
[r, b, o, b, r, b, r, b, r]
[o, b, r, b, r, b, r, b, r]
[b, o, r, b, r, b, r, b, r]
[b, b, r, o, r, b, r, b, r]
[b, b, r, b, r, o, r, b, r]
[b, b, r, b, r, b, r, o, r]
[b, b, r, b, r, b, o, r, r]
[b, b, r, b, o, b, r, r, r]
[b, b, o, b, r, b, r, r, r]
[b, b, b, o, r, b, r, r, r]
[b, b, b, b, r, o, r, r, r]
[b, b, b, b, o, r, r, r, r]
*******************************************************
true ;

*******************************************************
[r, r, r, r, o, b, b, b, b]
[r, r, r, r, b, o, b, b, b]
[r, r, r, o, b, r, b, b, b]
[r, r, o, r, b, r, b, b, b]
[r, r, b, r, o, r, b, b, b]
[r, r, b, r, b, r, o, b, b]
[r, r, b, r, b, r, b, o, b]
[r, r, b, r, b, o, b, r, b]
[r, r, b, o, b, r, b, r, b]
[r, o, b, r, b, r, b, r, b]
[o, r, b, r, b, r, b, r, b]
[b, r, o, r, b, r, b, r, b]
[b, r, b, r, o, r, b, r, b]
[b, r, b, r, b, r, o, r, b]
[b, r, b, r, b, r, b, r, o]
[b, r, b, r, b, r, b, o, r]
[b, r, b, r, b, o, b, r, r]
[b, r, b, o, b, r, b, r, r]
[b, o, b, r, b, r, b, r, r]
[b, b, o, r, b, r, b, r, r]
[b, b, b, r, o, r, b, r, r]
[b, b, b, r, b, r, o, r, r]
[b, b, b, r, b, o, r, r, r]
[b, b, b, o, b, r, r, r, r]
[b, b, b, b, o, r, r, r, r]
*******************************************************
true .

?-

Did you mean to tag CSS? I think you probably meant something else, but I don't know what that would be. — 4castle, Apr 27 '16 at 03:19
Please state exactly what you expect. That is, which goal shall succeed or fail but doesn't. — false, Apr 27 '16 at 06:28
The number of up votes here caused this post to act as a review audit in the "First Posts" review queue. That's being discussed on Meta: http://meta.stackoverflow.com/questions/323360/failed-fp-audit-due-to-downvote-is-my-mental-rule-for-downvoting-wrong — CubeJockey, May 19 '16 at 13:32
While posting what you did and what is expected (presumably from your assignment) is helpful, you also need to post what went wrong and how it doesn't match the output. Ideally you should highlight where you think your problem is, and why you don't understand what is going wrong. — Yakk - Adam Nevraumont, May 19 '16 at 15:27

score 7 · Answer 1 · edited May 23 '17 at 12:26

A straightforward Prolog code which tries to be the simplest and clearest, and doesn't care about efficiency at all:

start([r,r,r,r,e,b,b,b,b]).  % starting position

% can move from a position P1 to position P2
move(P1,P2):- append(A,[r,e|B],P1), append(A,[e,r|B],P2).
move(P1,P2):- append(A,[e,b|B],P1), append(A,[b,e|B],P2).
move(P1,P2):- append(A,[e,r,b|B],P1), append(A,[b,r,e|B],P2).
move(P1,P2):- append(A,[r,b,e|B],P1), append(A,[e,b,r|B],P2).

solved([b,b,b,b,e,r,r,r,r]).   % the target position to be reached

pegs :- start(P), solve(P, [], R), 
        maplist(writeln, R), nl, nl, fail ; true.

% solve( ?InitialPosition, +PreviousPositionsList, ?ResultingPath)
solve(P, Prev, R):- 
    solved(P) -> reverse([P|Prev], R) ; 
    move(P, Q), \+memberchk(Q, Prev), solve(Q, [P|Prev], R).

Nothing special about it. Takes whole of 0.08 seconds on Ideone to find two solutions, both of 24 moves.

For an N-pegs problem, we only need to modify the start and solved predicates accordingly.

Kudos go to Cary Swoveland from whose answer I took the notation (that's half the solution). A more efficient code, following mat's answer, building the result list in Prolog's characteristic top-down manner (similar to difference-lists technique, cf. tailrecursion-modulo-cons ):

swap([r,e|B],[e,r|B]).
swap([e,b|B],[b,e|B]).
swap([e,r,b|B],[b,r,e|B]).
swap([r,b,e|B],[e,b,r|B]).

move(A,B):- swap(A,B).
move([A|B],[A|C]):- move(B,C).

moves(S,[S]):- solved(S).
moves(S,[S|B]):- move(S,Q), moves(Q,B).

pegs(PS) :- start(P), moves(P, PS), maplist( writeln, PS), nl.

In general, any board game with positions and moves between them can be seen as a search problem in a search space of positions, defined by the valid moves, that is to take us from the start to the end (final) position. Various search strategies can be used, depth first, breadth first, iterative deepening, best-first heuristics ... This views the search space as a graph where nodes are positions (board configurations), and edges are moves; otherwise we can say this is a transitive closure of a move relation.

Sometimes the move relation is defined such that it produces a new legal configuration (like here); sometimes it is easier to define a general move relation and check the produced position for legality (like in N-queens problem). It is also common to maintain the visited nodes list while searching, and check any newly discovered node for being one of those already visited - discarding that path, to avoid getting into a loop.

Breadth first search will explicitly maintain the frontier of the nodes being discovered, and maintain it as a queue while extending it by one move at a time; depth first as a stack. Best first search will reorder this frontier according to some heuristics. Here, moves/2 is depth-first implicitly, because it relies on Prolog search which is itself depth-first.

Sometimes the search space is guaranteed to not have these cycles (i.e. to be a DAG - directed acyclic graph) so the check for uniqueness is not necessary. As for the final node, sometimes it is defined by value (like here), sometimes we're interested in some condition to hold (like e.g. in chess). See this answer for how to enforce this uniqueness with a lazy all_dif/1 predicate upfront. With the predicates defined in it, this problem becomes simply

pegs(Ps):- 
    path( move, Ps, [r,r,r,r,e,b,b,b,b], [b,b,b,b,e,r,r,r,r]).

@false I want to keep it "the simplest and clearest" code. But it's good to have that reference. Thanks. — Will Ness, May 02 '16 at 13:54
@CarySwoveland in regular languages we have `return(x)` but in Prolog we essentially have `return(one_of(x,y,z...))`. So we return the first and go on further along the code; but if that leads to a contradiction, the control gets back to the last choice point and the next possibility is returned. So when we say `move(P,Q)` it makes a move from `P`, gets to `Q` and continues -- but if that led into a dead end, the program "backtracks" and tries another move from `P`. Eventually it gets to the answer--or fails to do so. So it emulates nondeterminism by trial&error. "True" non-det is "by-magic". — Will Ness, May 02 '16 at 21:30
@WillNess: There is no `return`. There is, at best, a `yield`! — false, May 03 '16 at 18:05
@false that depends on the semantics of `one_of`. For a `yield`ing generator to produce its next value, it must be *explicitly* pulled (visibly, in a code); but if `one_of` sets aside a saved failure-contingency continuation, a-la Scheme, before *`return`ing*, then on failure it can be directly reactivated by the "system". that was my thought process behind this metaphor. — Will Ness, May 09 '16 at 10:23

mat · Answer 2 · 2016-05-02T14:36:11.647

4

It is always nice to use a dcg when describing lists.

For example:

initial_state([r,r,r,r,o,b,b,b,b]).

final_state([b,b,b,b,o,r,r,r,r]).

move([E|Es])     --> [E], move(Es).
move([r,o|Ls])   --> [o,r], list(Ls).
move([o,b|Ls])   --> [b,o], list(Ls).
move([o,r,b|Ls]) --> [b,r,o], list(Ls).
move([r,b,o|Ls]) --> [o,b,r], list(Ls).

list([])     --> [].
list([L|Ls]) --> [L], list(Ls).

moves(S)  --> [S], { final_state(S) }.
moves(S0) --> [S0], { phrase(move(S0), S) }, moves(S).

We can use iterative deepening to find a shortest solution:

?- length(Ms, _),
   initial_state(S0),
   phrase(moves(S0), Ms),
   maplist(writeln, Ms).
[r,r,r,r,o,b,b,b,b]
[r,r,r,r,b,o,b,b,b]
[r,r,r,o,b,r,b,b,b]
[r,r,o,r,b,r,b,b,b]
[r,r,b,r,o,r,b,b,b]
[r,r,b,r,b,r,o,b,b]
[r,r,b,r,b,r,b,o,b]
[r,r,b,r,b,o,b,r,b]
[r,r,b,o,b,r,b,r,b]
[r,o,b,r,b,r,b,r,b]
[o,r,b,r,b,r,b,r,b]
[b,r,o,r,b,r,b,r,b]
[b,r,b,r,o,r,b,r,b]
[b,r,b,r,b,r,o,r,b]
[b,r,b,r,b,r,b,r,o]
[b,r,b,r,b,r,b,o,r]
[b,r,b,r,b,o,b,r,r]
[b,r,b,o,b,r,b,r,r]
[b,o,b,r,b,r,b,r,r]
[b,b,o,r,b,r,b,r,r]
[b,b,b,r,o,r,b,r,r]
[b,b,b,r,b,r,o,r,r]
[b,b,b,r,b,o,r,r,r]
[b,b,b,o,b,r,r,r,r]
[b,b,b,b,o,r,r,r,r]

with additional bindings for the lists of moves Ms and the initial state S0.

edited May 02 '16 at 14:36

answered May 02 '16 at 11:49

mat

40,498
3
51
78

`move([r,o|Ls]) --> [o,r|Ls].` is definitely out of scope. It produces an appropriate error in SICStus. – false May 02 '16 at 13:54
That's really too bad. Fixed! Ceterum censeo `list//1` in prologum esse includendum. – mat May 02 '16 at 14:43
Non prorsus; nam `seq//1` necesse est! – false May 02 '16 at 14:47
et `seq//1` bonum. – mat May 02 '16 at 17:14
Imagine, there would be a loop: you would encounter all of them. In particular, loops that go from the final state to itself! – false May 03 '16 at 18:07

score 2 · Answer 3 · edited May 23 '17 at 10:29

2

a purely syntactic variation of Will Ness's answer:

swap(X,P,Q) :- append([L,X,R],P), reverse(X,Y), append([L,Y,R],Q).

solve(P,Prev,R) :-
       solved(P)
    -> reverse([P|Prev], R)
    ;  % move(P, Q)
       phrase( (swap([r,e])|swap([e,b])|swap([e,r,b])|swap([r,b,e])), P, Q),
       \+memberchk(Q, Prev),
       solve(Q, [P|Prev], R).

edited May 23 '17 at 10:29

Community

1
1

answered May 02 '16 at 09:46

CapelliC

59,646
5
47
90

Cary Swoveland · Answer 4 · 2016-05-02T07:26:14.550

I don't know prolog, but here's a recursive solution using Ruby. Even if you don't know Ruby, you should be able to figure out how the recursion works.

A Ruby primer:

a[space_pos-1], a[space_pos] = a[space_pos], a[space_pos-1] uses parallel assignment to swap the values at array indices space_pos-1 and space_pos without the need for a temporary variable.
FINAL, since it begins with a capital letter, is a constant.
a = arr.dup returns a "shallow" copy of the array arr, so swapping elements of a does not effect arr.
If a method contains no return statement, the value computed in the last line is returned by the method (e.g., the array a in red_slide).
soln=[] in def solve(arr, soln = []) assigns soln to an empty array if solve is called solve(arr).
soln + [:red_slide], where soln is an array and [:red_slide] is an array containing a single symbol (indicated by the colon) is a new array comprised of the elements of soln and the element :red_slide.
you can think of && as "and".
nil is returned by solve if the state of the moves given by solve's argument arr does not lead to a solution.

FINAL = [:b, :b, :b, :b, :e, :r, :r, :r, :r]
SIZE = FINAL.size

def red_slide(arr, space_pos)
  a = arr.dup
  a[space_pos-1], a[space_pos] = a[space_pos], a[space_pos-1]
  a
end

def blue_slide(arr, space_pos)
  a = arr.dup
  a[space_pos], a[space_pos+1] = a[space_pos+1], a[space_pos]
  a
end

def red_jump(arr, space_pos)
  a = arr.dup
  a[space_pos-2], a[space_pos] = a[space_pos], a[space_pos-2]   
  a
end

def blue_jump(arr, space_pos)
  a = arr.dup
  a[space_pos+2], a[space_pos] = a[space_pos], a[space_pos+2]   
  a
end

def solve(arr, soln = [])
  return soln if arr == FINAL
  space_pos = arr.index(:e)

  # See if can slide red    
  if space_pos > 0 && arr[space_pos-1] == :r
    ret = solve(red_slide(arr, space_pos), soln + [:red_slide])
    return ret if ret
  end

  # See if can slide blue
  if space_pos < SIZE-1 && arr[space_pos+1] == :b
    ret = solve(blue_slide(arr, space_pos), soln + [:blue_slide])
    return ret if ret
  end

  # See if can jump red over blue
  if space_pos > 1 && arr[space_pos-2] == :r && arr[space_pos-1] == :b 
    ret = solve(red_jump(arr, space_pos), soln + [:red_jump])
    return ret if ret
  end

  # See if can jump blue over red
  if space_pos < SIZE-2 && arr[space_pos+2] == :b && arr[space_pos+1] == :r 
    ret = solve(blue_jump(arr, space_pos), soln + [:blue_jump])
    return ret if ret
  end

  nil
end

solve [:r, :r, :r, :r, :e, :b, :b, :b, :b]
  #=> [:red_slide, :blue_jump, :blue_slide, :red_jump, :red_jump, :red_slide,
  #    :blue_jump, :blue_jump, :blue_jump, :blue_slide, :red_jump, :red_jump, 
  #    :red_jump, :red_jump, :blue_slide, :blue_jump, :blue_jump, :blue_jump, 
  #    :red_slide, :red_jump, :red_jump, :blue_slide, :blue_jump, :red_slide]

I was surprised that it took just a fraction of a second to compute a solution. I guess the number of combinations of moves is not as great as I had imagined.

Note that this solution is for the "N peg problem", not just the "8 peg problem". For example,

FINAL = [:b, :b, :b, :e, :r, :r, :r]
SIZE = FINAL.size
solve [:r, :r, :r, :e, :b, :b, :b]
  #=> [:red_slide, :blue_jump, :blue_slide, :red_jump, :red_jump, :red_slide,
  #    :blue_jump, :blue_jump, :blue_jump, :red_slide, :red_jump, :red_jump,
  #    :blue_slide, :blue_jump, :red_slide]

you first go `[r,r,r,e,r,b,b,b,b]` and then `[r,r,r,e,b,r,b,b,b]` but that's an illegal move. moving `b` legally in the 1st position gets you to `[r,r,r,b,r,e,b,b,b]` ("jumping over `r` into the empty spot"). — Will Ness, May 01 '16 at 11:29
@Will, it did seem a little too easy. How I missed that rule I can't say, but thanks for pointing out.the problem. I'll delete my answer once you've seen this, but will give the problem more thought. — Cary Swoveland, May 01 '16 at 13:53
:) the standard thing is to maintain a list of currently reached positions, and on each step make all possible moves for each current position, flattening the resulting list of lists of current positions back into a list of current positions; then make the next move for each currently reached position, and repeat until one of them is a solution. this emulates non-determinism in an imperative setting. — Will Ness, May 01 '16 at 17:22
@Will, I didn't initially realize that the point of the question was to determine a solution programmatically, as opposed to just implementing a series of moves. I've revised my answer to do what's required. I regret it's not in prolog, but maybe this will give prologers some ideas. — Cary Swoveland, May 02 '16 at 07:26
Thanks. Interesting to compare. The number of possible moves indeed isn't great at each step, and wrong moves quickly lead to dead ends (no more possible moves). — Will Ness, May 02 '16 at 08:16
so, you stop on the first found solution? can you continue the search easily? (in Python, you'd replace `return` with `yield` for that, or something...). I guess you could just replace `return` in `return ret if ret` with some kind of printout, for an exhaustive search. — Will Ness, May 02 '16 at 08:26
@Will, yes, it would be a minor change to either print out all the solutions or store them. Instead of returning when a match is found, just store it and continue. My argument `soln` could be an array of arrays, each inner array a solution. — Cary Swoveland, May 02 '16 at 23:33
Exactly. Store and continue -- or stop temporarily, report to user and ask whether to continue or abort (jump back up through all the layers of recursion). That's what Prolog's interactive prompt is usually doing. Or if your language is lazy, you can store all the solutions, but a separate process will provide them one by one to a user, again with possibility to abort the search early. — Will Ness, May 03 '16 at 07:47

Exiler · Answer 5 · 2016-05-03T18:08:44.250

Board representation is important, here.

% Form of board, b for blue, r for red, o for empty.
% [r, r, r, r, o, b, b, b, b]

% Legal jumps.  
linjmp([r, o | T], [o, r | T]).
linjmp([o, b | T], [b, o | T]).
linjmp([o, r, b | T], [b, r, o | T]).
linjmp([r, b, o | T], [o, b, r | T]).
linjmp([H|T1], [H|T2]) :- linjmp(T1,T2).

% Series of legal boards.
series(From, To, [From, To]) :- linjmp(From, To).
series(From, To, [From, By | Rest])
        :- linjmp(From, By), 
           series(By, To, [By | Rest]).

% Print a series of boards.  This puts one board per line and looks a lot
% nicer than the jumble that appears when the system simply beltches out
% a list of boards.  The write_ln predicate is a built-in which always
% succeeds (is always satisfied), but prints as a side-effect.  Therefore
% print_series(Z) will succeed with any list, and the members of the list
% will be printed, one per line, as a side-effect of that success.
print_series_r([]) :- 
    write_ln('*******************************************************').
print_series_r([X|Y]) :- write_ln(X), print_series_r(Y).
print_series(Z) :- 
    write_ln('\n*******************************************************'),
    print_series_r(Z).

% A solution.
solution(L) :- series([r, r, r, r, o, b, b, b, b],
                   [b, b, b, b, o, r, r, r, r], L).

% Find a print the first solution.  
solve :- solution(X), print_series(X).

% Find all the solutions.
solveall :- solve, fail.

% This finds each solution with stepping.
solvestep(Z) :- Z = next, solution(X), print_series(X).

`[[r, r, r, r], [o], [b, b, b, b]]` and `linjmp([r, o | T], [o, r | T])` use incompatible board representations. — Will Ness, May 03 '16 at 17:49

Trying to solve the peg jump puzzle in Prolog

5 Answers5

Linked