Jumping Checkers

A classic problem I found in Boris Kordemsky’s Moscow Puzzles goes like this:

Place 3 white checkers in squares 1, 2, and 3 of the figure, and 3 black ones on squares 5, 6, and 7.

O O O _ X X X
1 2 3 4 5 6 7

Shift the white checkers to the squares occupied by the black ones, and vice versa. You may move a checker forward to the adjacent unoccupied square, if any. You may jump a checker forward over an adjacent checker into the vacant square. The solution requires 15 moves.

It takes little imagination to generalize the problem to N white and N black checkers. Let’s solve this in Prolog!

The general form of the solution is like this:

solution(N, K-X) :-
    setup(N, L),
    Max is 4 * N * N, between(1, Max, K),
    jump(L, K, [], X).

First we setup the initial board with N white and N black checkers, and then we try to solve the problem in K moves, where K goes up from 1 to a theoretical upper bound (no checker can move more than 2N times, and we have 2N checkers, so there will be at most 4N^2 moves).

The jump/4 rule will take the following parameters:

% jump(+State, +MovesLeft, +MovesUntilNow, -Solution)

But first let’s do the setup: we gather N white checkers in W, and N black checkers in B, and append these with the empty square in-between to get the initial state:

setup(N, L) :-
    findall(white, between(1, N, _), W),
    findall(black, between(1, N, _), B),
    append(W, [empty|B], L).

We should also do a test to see if we are done. This is easily done by checking that all elements before the empty square are black, and all elements after the empty square are white:

done(L) :- reverse(L, R), done(L, R).
done([empty|_], [empty|_]) :- !.
done([black|L], [white|R]) :- done(L, R).

Now on to the jump/4 rule. Since we will gather the moves in reverse order, we should reverse the list when we are done:

jump(State, _, Moves, X) :- done(State), reverse(Moves, X).

Next we consider a white step. This requires that the square to the right should be empty; then we swap these two and continue to jump:

jump(State, N, Moves, X) :-
    N > 0, N1 is N - 1,
    append(L, [white,empty|L1], State),
    append(L, [empty,white|L1], State1),
    jump(State1, N1, [white_step|Moves], X).

A jumping move means that there is exactly one checker in-between, otherwise it is very similar:

jump(State, N, Moves, X) :-
    N > 0, N1 is N - 1,
    append(L, [white,C,empty|L1], State),
    append(L, [empty,C,white|L1], State1),
    jump(State1, N1, [white_jump|Moves], X).

And of course the same should be done for black, as well:

jump(State, N, Moves, X) :-
    N > 0, N1 is N - 1,
    append(L, [empty,black|L1], State),
    append(L, [black,empty|L1], State1),
    jump(State1, N1, [black_step|Moves], X).
jump(State, N, Moves, X) :-
    N > 0, N1 is N - 1,
    append(L, [empty,C,black|L1], State),
    append(L, [black,C,empty|L1], State1),
    jump(State1, N1, [black_jump|Moves], X).

And that’s it! Let’s try it on the original problem:

?- solution(3, K-X).
K = 15,
X = [white_step, black_jump, black_step, white_jump,
     white_jump, white_step, black_jump, black_jump,
     black_jump, white_step, white_jump, white_jump,
     black_step, black_jump, white_step]

Better output

The above seems to be OK, but not very user-friendly. Let’s generate a more visual output that prints the move number and the current state after each move.

The easiest way to do this is to save the states instead of the moves. This will actually simplify our jump/4 rule:

jump(State, _, History, X) :- done(State), reverse(History, X).
jump(State, N, History, X) :-
    N > 0, N1 is N - 1,
    ( append(L, [white,empty|L1], State),
      append(L, [empty,white|L1], State1)
    ; append(L, [empty,black|L1], State),
      append(L, [black,empty|L1], State1)
    ; append(L, [white,C,empty|L1], State),
      append(L, [empty,C,white|L1], State1)
    ; append(L, [empty,C,black|L1], State),
      append(L, [black,C,empty|L1], State1)
    ),
    jump(State1, N1, [State1|History], X).

Since we now have a list of states, we should start from a list containing the initial state (not the empty list, as before):

solution(N) :-
    setup(N, L),
    Max is 4 * N * N, between(1, Max, K),
    jump(L, K, [L], X),
    show(X).

The last line calls show/1, which shows the solution:

show(L) :- show(1, L).
show(_, []).
show(N, [X|L]) :-
    N1 is N + 1,
    ( N < 10 -> write(' ') ; true ),
    write(N), write('.'), write_row(X), nl,
    show(N1, L).

The first parameter of show/2 is the line number. When this is less than 10 we print a space for correct alignment; each element of the second parameter is a state, which is printed by write_row/1:

write_row([]).
write_row([empty|L]) :- write(' _'), write_row(L).
write_row([white|L]) :- write(' O'), write_row(L).
write_row([black|L]) :- write(' X'), write_row(L).

Testing it on a larger example:

?- solution(6).
 1. O O O O O O _ X X X X X X
 2. O O O O O _ O X X X X X X
 3. O O O O O X O _ X X X X X
 4. O O O O O X O X _ X X X X
 5. O O O O O X _ X O X X X X
 6. O O O O _ X O X O X X X X
 7. O O O _ O X O X O X X X X
 8. O O O X O _ O X O X X X X
 9. O O O X O X O _ O X X X X
10. O O O X O X O X O _ X X X
11. O O O X O X O X O X _ X X
12. O O O X O X O X _ X O X X
13. O O O X O X _ X O X O X X
14. O O O X _ X O X O X O X X
15. O O _ X O X O X O X O X X
16. O _ O X O X O X O X O X X
17. O X O _ O X O X O X O X X
18. O X O X O _ O X O X O X X
19. O X O X O X O _ O X O X X
20. O X O X O X O X O _ O X X
21. O X O X O X O X O X O _ X
22. O X O X O X O X O X O X _
23. O X O X O X O X O X _ X O
24. O X O X O X O X _ X O X O
25. O X O X O X _ X O X O X O
26. O X O X _ X O X O X O X O
27. O X _ X O X O X O X O X O
28. _ X O X O X O X O X O X O
29. X _ O X O X O X O X O X O
30. X X O _ O X O X O X O X O
31. X X O X O _ O X O X O X O
32. X X O X O X O _ O X O X O
33. X X O X O X O X O _ O X O
34. X X O X O X O X O X O _ O
35. X X O X O X O X O X _ O O
36. X X O X O X O X _ X O O O
37. X X O X O X _ X O X O O O
38. X X O X _ X O X O X O O O
39. X X _ X O X O X O X O O O
40. X X X _ O X O X O X O O O
41. X X X X O _ O X O X O O O
42. X X X X O X O _ O X O O O
43. X X X X O X O X O _ O O O
44. X X X X O X O X _ O O O O
45. X X X X O X _ X O O O O O
46. X X X X _ X O X O O O O O
47. X X X X X _ O X O O O O O
48. X X X X X X O _ O O O O O
49. X X X X X X _ O O O O O O

This gives us an intuition on how to solve it by hand: first create an alternating pattern, gradually reaching the outer checkers (states 1-22), and then work in the reverse direction to build the goal state.

If we look at the number of required moves (3, 8, 15, 24, 35, 48, 63, 80, …), it is easy to see (and probably to prove) that it is (N+1)^2 - 1.

The whole program

solution(N) :-
    setup(N, L),
    Max is 4 * N * N, between(1, Max, K),
    jump(L, K, [L], X),
    show(X).

setup(N, L) :-
    findall(white, between(1, N, _), W),
    findall(black, between(1, N, _), B),
    append(W, [empty|B], L).

done(L) :- reverse(L, R), done(L, R).
done([empty|_], [empty|_]) :- !.
done([black|L], [white|R]) :- done(L, R).

jump(State, _, History, X) :- done(State), reverse(History, X).
jump(State, N, History, X) :-
    N > 0, N1 is N - 1,
    ( append(L, [white,empty|L1], State),
      append(L, [empty,white|L1], State1)
    ; append(L, [empty,black|L1], State),
      append(L, [black,empty|L1], State1)
    ; append(L, [white,C,empty|L1], State),
      append(L, [empty,C,white|L1], State1)
    ; append(L, [empty,C,black|L1], State),
      append(L, [black,C,empty|L1], State1)
    ),
    jump(State1, N1, [State1|History], X).

show(L) :- show(1, L).
show(_, []).
show(N, [X|L]) :-
    N1 is N + 1,
    ( N < 10 -> write(' ') ; true ),
    write(N), write('.'), write_row(X), nl,
    show(N1, L).

write_row([]).
write_row([empty|L]) :- write(' _'), write_row(L).
write_row([white|L]) :- write(' O'), write_row(L).
write_row([black|L]) :- write(' X'), write_row(L).