Infinite loop in prolog? Or just very slow?

Question

I'm trying to figure out if I have an infinite loop in my Prolog program, or if I just did a bad job of writing it, so its slow. I'm trying to solve the square sum chains problem from the dailyprogrammer subreddit. Given a number N, find an ordering of the numbers 1-N (inclusive) such that the sum of each pair of adjacent numbers in the ordering is a perfect square. The smallest N that this holds for is 15, with the ordering [8, 1, 15, 10, 6, 3, 13, 12, 4, 5, 11, 14, 2, 7, 9]. This is the code that I'm trying to use to solve the problem:

is_square(Num):- is_square_help(Num, 0).

is_square_help(Num, S):- Num =:= S * S.
is_square_help(Num, S):- 
    Num > S * S,
    T is S+1,
    is_square_help(Num, T).
is_square_help(Num, S):- Num < S * S, fail.

contains(_, []):- fail.
contains(Needle, [Needle|_]).
contains(Needle, [_|Tail]):- contains(Needle, Tail).

nums(0, []).
nums(Num, List) :- length(List, Num), nums_help(Num, List).

nums_help(0, _).
nums_help(Num, List) :- 
    contains(Num, List),
    X is Num - 1,
    nums_help(X, List).

square_sum(Num, List) :- 
    nums(Num, List),
    square_sum_help(List).

square_sum_help([X, Y|T]) :- 
    Z is X + Y,
    is_square(Z),
    square_sum_help(T).

Currently, when I run square_sum(15, List)., the program does not terminate. I've left it alone for about 10 minutes, and it just keeps running. I know that there are problems that take a long time to solve, but others are reportedly generating answers in the order of milliseconds. What am I doing wrong here?

CapelliC CapelliC · Accepted Answer · 2018-01-31T08:20:58

SWI-Prolog allows this compact implementation

square_sum(N,L) :-
    numlist(1,N,T),
    select(D,T,R),
    adj_squares(R,[D],L).

adj_squares([],L,R) :- reverse(L,R).
adj_squares(T,[S|Ss],L) :-
    select(D,T,R),
    float_fractional_part(sqrt(S+D))=:=0,
    adj_squares(R,[D,S|Ss],L).

that completes really fast for N=15

edit as suggested, building the list in order yields better code:

square_sum(N,L) :-
    numlist(1,N,T),
    select(D,T,R),
    adj_squares(R,D,L).

adj_squares([],L,[L]).
adj_squares(T,S,[S|L]) :-
    select(D,T,R),
    float_fractional_part(sqrt(S+D))=:=0,
    adj_squares(R,D,L).

edit

the code above becomes too slow when N grows. I've changed strategy, and attempt now to find an Hamiltonian path into the graph induced by the binary relation. For N=15 it looks like

(here is the code to generate the Graphviz script:

square_pairs(N,I,J) :-
    between(1,N,I),
    I1 is I+1,
    between(I1,N,J),
    float_fractional_part(sqrt(I+J))=:=0.
square_pairs_graph(N) :-
    format('graph square_pairs_N_~d {~n', [N]),
    forall(square_pairs(N,I,J), format(' ~d -- ~d;~n', [I,J])),
    writeln('}').

)

and here the code for lookup a path

hamiltonian_path(N,P) :-
    square_pairs_struct(N,G),
    between(1,N,S),
    extend_front(1,N,G,[S],P).

extend_front(N,N,_,P,P) :- !.
extend_front(Len,Tot,G,[Node|Ins],P) :-
    arg(Node,G,Arcs),
    member(T,Arcs),
    \+memberchk(T,Ins),
    Len1 is Len+1,
    extend_front(Len1,Tot,G,[T,Node|Ins],P).


struct_N_of_E(N,E,S) :-
    findall(E,between(1,N,_),As),
    S=..[graph|As].

square_pairs_struct(N,G) :-
    struct_N_of_E(N,[],G),
    forall(square_pairs(N,I,J), (edge(G,I,J),edge(G,J,I))).
edge(G,I,J) :-
    arg(I,G,A), B=[J|A], nb_setarg(I,G,B).

Infinite loop in prolog? Or just very slow?

4 Answers