Search code examples
listprologclpfddcg

About building a list until it meets conditions


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.


Solution

  • 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.