I wanted to solve "the giant cat army riddle" by Dan Finkel using Prolog.
Basically you start with [0]
, then you build this list by using one of three operations: adding 5
, adding 7
, or taking sqrt
. You successfully complete the game when you have managed to build a list such that 2
,10
and 14
appear on the list, in that order, and there can be other numbers between them.
The rules also require that all the elements are distinct, they're all <=60
and are all only integers.
For example, starting with [0]
, you can apply (add5, add7, add5)
, which would result in [0, 5, 12, 17]
, but since it doesn't have 2,10,14 in that order it doesn't satisfy the game.
I think I have successfully managed to write the required facts, but I can't figure out how to actually build the list. I think using dcg
is a good option for this, but I don't know how.
Here's my code:
:- use_module(library(lists)).
:- use_module(library(clpz)).
:- use_module(library(dcgs)).
% integer sqrt
isqrt(X, Y) :- Y #>= 0, X #= Y*Y.
% makes sure X occurs before Y and Y occurs before Z
before(X, Y, Z) --> ..., [X], ..., [Y], ..., [Z], ... .
... --> [].
... --> [_], ... .
% in reverse, since the operations are in reverse too.
order(Ls) :- phrase(before(14,10,2), Ls).
% rule for all the elements to be less than 60.
lt60_(X) :- X #=< 60.
lt60(Ls) :- maplist(lt60_, Ls).
% available operations
add5([L0|Rs], L) :- X #= L0+5, L = [X, L0|Rs].
add7([L0|Rs], L) :- X #= L0+7, L = [X, L0|Rs].
root([L0|Rs], L) :- isqrt(L0, X), L = [X, L0|Rs].
% base case, the game stops when Ls satisfies all the conditions.
step(Ls) --> { all_different(Ls), order(Ls), lt60(Ls) }.
% building the list
step(Ls) --> [add5(Ls, L)], step(L).
step(Ls) --> [add7(Ls, L)], step(L).
step(Ls) --> [root(Ls, L)], step(L).
The code emits the following error but I haven't tried to trace it or anything because I'm convinced that I'm using DCG incorrectly:
?- phrase(step(L), X).
caught: error(type_error(list,_65),sort/2)
I'm using Scryer-Prolog, but I think all the modules are available in swipl
too, like clpfd
instead of clpz
.
step(Ls) --> [add5(Ls, L)], step(L).
This doesn't do what you want. It describes a list element of the form add5(Ls, L)
. Presumably Ls
is bound to some value when you get here, but L
is not bound. L
would become bound if Ls
were a non-empty list of the correct form, and you executed the goal add5(Ls, L)
. But you are not executing this goal. You are storing a term in a list. And then, with L
completely unbound, some part of the code that expects it to be bound to a list will throw this error. Presumably that sort/2
call is inside all_different/1
.
Edit: There are some surprisingly complex or inefficient solutions posted here. I think both DCGs and CLP are overkill here. So here's a relatively simple and fast one. For enforcing the correct 2/10/14 order this uses a state argument to keep track of which ones we have seen in the correct order:
puzzle(Solution) :-
run([0], seen_nothing, ReverseSolution),
reverse(ReverseSolution, Solution).
run(FinalList, seen_14, FinalList).
run([Head | Tail], State, Solution) :-
dif(State, seen_14),
step(Head, Next),
\+ member(Next, Tail),
state_next(State, Next, NewState),
run([Next, Head | Tail], NewState, Solution).
step(Number, Next) :-
( Next is Number + 5
; Next is Number + 7
; nth_integer_root_and_remainder(2, Number, Next, 0) ),
Next =< 60,
dif(Next, Number). % not strictly necessary, added by request
state_next(State, Next, NewState) :-
( State = seen_nothing,
Next = 2
-> NewState = seen_2
; State = seen_2,
Next = 10
-> NewState = seen_10
; State = seen_10,
Next = 14
-> NewState = seen_14
; NewState = State ).
Timing on SWI-Prolog:
?- time(puzzle(Solution)), writeln(Solution).
% 13,660,415 inferences, 0.628 CPU in 0.629 seconds (100% CPU, 21735435 Lips)
[0,5,12,17,22,29,36,6,11,16,4,2,9,3,10,15,20,25,30,35,42,49,7,14]
Solution = [0, 5, 12, 17, 22, 29, 36, 6, 11|...] .
The repeated member
calls to ensure no duplicates make up the bulk of the execution time. Using a "visited" table (not shown) takes this down to about 0.25 seconds.
Edit: Pared down a bit further and made 100x faster:
prev_next(X, Y) :-
between(0, 60, X),
( Y is X + 5
; Y is X + 7
; X > 0,
nth_integer_root_and_remainder(2, X, Y, 0) ),
Y =< 60.
moves(Xs) :-
moves([0], ReversedMoves),
reverse(ReversedMoves, Xs).
moves([14 | Moves], [14 | Moves]) :-
member(10, Moves).
moves([Prev | Moves], FinalMoves) :-
Prev \= 14,
prev_next(Prev, Next),
( Next = 10
-> member(2, Moves)
; true ),
\+ member(Next, Moves),
moves([Next, Prev | Moves], FinalMoves).
?- time(moves(Solution)), writeln(Solution).
% 53,207 inferences, 0.006 CPU in 0.006 seconds (100% CPU, 8260575 Lips)
[0,5,12,17,22,29,36,6,11,16,4,2,9,3,10,15,20,25,30,35,42,49,7,14]
Solution = [0, 5, 12, 17, 22, 29, 36, 6, 11|...] .
The table of moves can be precomputed (enumerate all solutions of prev_next/2
, assert them in a dynamic predicate, and call that) to gain another millisecond or two. Using a CLP(FD) instead of "direct" arithmetic makes this considerably slower on SWI-Prolog. In particular, Y in 0..60, X #= Y * Y
instead of the nth_integer_root_and_remainder/4
goal takes this up to about 0.027 seconds.