Rush Hour

Rush Hour from ThinkFun is a nice logic puzzle where you need to move back and forth horizontally or vertically placed cars so that you can move your own car to the exit.

The board is a 6x6 grid; the exit is at the right wall on the 3rd row, i.e., near (6,3). All cars are labeled with a letter, x is yours. The cars labeled o, p, q and r are trucks that occupy three consecutive cells, all other cars cover only two.

The objective is to get x out with a minimal number of car movements. Moving one car 2+ cells forward or backward is regarded as a single move, but cars shouldn’t move more than they need to.

This suggests a breadth-first search solution. Since it is easy to produce the same board with different sets or permutations of moves, it is imperative that we take precautions not to visit the same state twice. This is easily done with dynamic rules, as we will see.

Representation

The state of the board consists of the cars’ positions. Unfortunately cars with the same letter can occur both horizontally or vertically, so we need to store the orientation, as well. A car would be represented by

where Name is a single letter, Orientation is either h or v (for horizontal and vertical, respectively), and Position is an X-Y pair of coordinates describing the anchor position (the topmost/leftmost cell) of the car. For example, car p in the diagram above would be represented by car(p,v,3-4).

The board is a sorted list of cars - sorting is needed because we need to test for equivalence between states.

The solver

:- dynamic(seen/1).

Our main rule first clears seen/1 of remaining data from previous runs, sorts the given board (so the input can be unsorted), and calls the solver. The moves will be accumulated in reverse order, which will be corrected and printed on the screen:

rush(Puzzle) :-
    retractall(seen(_)),
    sort(Puzzle, Board),
    solve([state(Board,[])], Moves),
    reverse(Moves, Solution),
    show(Solution).

The solver takes a queue of state(Board,Moves) structures containing a state of the board and the moves leading to that state, and returns the solution as a (reversed) list of moves:

solve([state(Board,Moves)|_], Moves) :-
    member(car(x,h,5-3), Board).
solve([state(Board,Moves)|Queue], Solution) :-
    findall(state(Board1,[Move|Moves]),
            move(Board, Move, Board1), List),
    append(Queue, List, Queue1),
    solve(Queue1, Solution).

The first rule says that if car x is at (5,3) then we are done. The second rule looks at all possible moves from the first state in the queue, and generates a list of corresponding next states, which are all added to the end of the queue, then recurses.

Moves

The move(Board, Move, Board1) rule is true if Move gets from Board to Board1. For efficiency (and for taking care of cycles in the graph), it does some additional bookkeeping: it only allows moves not seen so far, and also records the new states as seen. (Yes, this harms transparency, but it is much more convenient than the alternatives.)

move(Board, move(Name,Dir,Len), Board1) :-
    member(car(Name,Ort,_), Board),
    direction(Ort, Dir),
    try(1, Board, Name, Dir, Candidates),
    member(Len-Board0, Candidates),
    \+ seen(Board1),
    asserta(seen(Board1)).

First it takes a car from the board with a given orientation (Ort), chooses an applicable direction, and tries to move it. The try/5 rule tries to move the car as far in the given direction as it can, returning a list of candidate length-board pairs. We then take one of these, check if the board is yet unvisited, and then record it in seen.

It may occur to the reader that it would be simpler if the move length was also generated here with between(1, 5, Len), and then try should only check if that concrete move is valid or not. Turns out that this would be more complicated, because intervening steps should be checked in any case.

direction(h, left).
direction(h, right).
direction(v, up).
direction(v, down).

try(N, Board, Name, Dir, [N-Board1|Candidates]) :-
    N < 6, N1 is N + 1,
    select(car(Name,Ort,Pos), Board, Board0),
    step(Pos, Dir, Pos1),
    \+ invalid(Board0, Name, Dir, Pos1),
    sort([car(Name,Ort,Pos1)|Board0], Board1),
    try(N1, Board1, Name, Dir, Candidates), !.
try(_, _, _, _, []).

It takes out the named car from Board, and moves it one place in the given direction. It then checks that the new position is not invalid, adds it to the board (retaining sortedness), and tries to move further. When it cannot, it returns with an empty list of candidates.

step(X-Y, left, X1-Y) :- X1 is X - 1.
step(X-Y, up, X-Y1) :- Y1 is Y - 1.
step(X-Y, right, X1-Y) :- X1 is X + 1.
step(X-Y, down, X-Y1) :- Y1 is Y + 1.

Validity

A single step can be invalid only if the newly occupied position is either (i) outside the board, or (ii) already covered by another car.

First we need to compute the newly occupied position from the new anchor position:

front(_, Pos, left, Pos).
front(_, Pos, up, Pos).
front(Name, X-Y, right, X1-Y) :- size(Name, S), X1 is X + S - 1.
front(Name, X-Y, down, X-Y1) :- size(Name, S), Y1 is Y + S - 1.

size(Name, 3) :- member(Name, [o,p,q,r]), !.
size(_, 2).

invalid(Board, Name, Dir, Pos) :-
    front(Name, Pos, Dir, X-Y),
    ( X < 1 ; X > 6 ; Y < 1 ; Y > 6 ;
      member(Car, Board), occupies(Car, X-Y)
    ).

occupies(car(Name,h,X1-Y), X-Y) :-
    size(Name, S), X1 =< X, X =< X1 + S - 1.
occupies(car(Name,v,X-Y1), X-Y) :-
    size(Name, S), Y1 =< Y, Y =< Y1 + S - 1.

Output

We will generate an output similar to the solution on the back of the puzzle cards: a move is shown as the car label followed by an arrow and the number of cells to move. We separate moves by a comma, and conclude the output by a newline:

show([]).
show([move(Name,Dir,Len)|Moves]) :-
    dir_char(Dir, Char),
    write(Name), write(Char), write(Len),
    ( Moves = [] -> nl
    ; write(', ')
    ),
    show(Moves).

dir_char(left, '←').
dir_char(up, '↑').
dir_char(right, '→').
dir_char(down, '↓').

Test runs

The whole program

:- dynamic(seen/1).

rush(Puzzle) :-
    retractall(seen(_)),
    sort(Puzzle, Board),
    solve([state(Board,[])], Moves),
    reverse(Moves, Solution),
    show(Solution).

solve([state(Board,Moves)|_], Moves) :-
    member(car(x,h,5-3), Board).
solve([state(Board,Moves)|Queue], Solution) :-
    findall(state(Board1,[Move|Moves]),
            move(Board, Move, Board1), List),
    append(Queue, List, Queue1),
    solve(Queue1, Solution).

move(Board, move(Name,Dir,Len), Board1) :-
    member(car(Name,Ort,_), Board),
    direction(Ort, Dir),
    try(1, Board, Name, Dir, Candidates),
    member(Len-Board1, Candidates),
    \+ seen(Board1),
    asserta(seen(Board1)).

try(N, Board, Name, Dir, [N-Board1|Candidates]) :-
    N < 6, N1 is N + 1,
    select(car(Name,Ort,Pos), Board, Board0),
    step(Pos, Dir, Pos1),
    \+ invalid(Board0, Name, Dir, Pos1),
    sort([car(Name,Ort,Pos1)|Board0], Board1),
    try(N1, Board1, Name, Dir, Candidates), !.
try(_, _, _, _, []).

direction(h, left).
direction(h, right).
direction(v, up).
direction(v, down).

step(X-Y, left, X1-Y) :- X1 is X - 1.
step(X-Y, up, X-Y1) :- Y1 is Y - 1.
step(X-Y, right, X1-Y) :- X1 is X + 1.
step(X-Y, down, X-Y1) :- Y1 is Y + 1.

invalid(Board, Name, Dir, Pos) :-
    front(Name, Pos, Dir, X-Y),
    ( X < 1 ; X > 6 ; Y < 1 ; Y > 6 ;
      member(Car, Board), occupies(Car, X-Y)
    ).

front(_, Pos, left, Pos).
front(_, Pos, up, Pos).
front(Name, X-Y, right, X1-Y) :- size(Name, S), X1 is X + S - 1.
front(Name, X-Y, down, X-Y1) :- size(Name, S), Y1 is Y + S - 1.

occupies(car(Name,h,X1-Y), X-Y) :-
    size(Name, S), X1 =< X, X =< X1 + S - 1.
occupies(car(Name,v,X-Y1), X-Y) :-
    size(Name, S), Y1 =< Y, Y =< Y1 + S - 1.

size(Name, 3) :- member(Name, [o,p,q,r]), !.
size(_, 2).

show([]).
show([move(Name,Dir,Len)|Moves]) :-
    dir_char(Dir, Char),
    write(Name), write(Char), write(Len),
    ( Moves = [] -> nl
    ; write(', ')
    ),
    show(Moves).

dir_char(left, '←').
dir_char(up, '↑').
dir_char(right, '→').
dir_char(down, '↓').