Бесконечный цикл в прологе? Или просто очень медленно?

SWI-Prolog позволяет эту компактную реализацию

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

который завершается очень быстро для N = 15

редактируйте в соответствии с рекомендациями, построение списка по порядку дает лучший код:

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

изменить

приведенный выше код становится слишком медленным, когда N растет. Я изменил стратегию и теперь пытаюсь найти гамильтонов путь в графе, индуцированный бинарным отношением. Для N=15 это выглядит так

(вот код для создания скрипта Graphviz:

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('}').

)

и здесь код для поиска пути

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

Вот решение, использующее программирование логики ограничений:

squares_chain(N, Cs) :-
        numlist(1, N, Ns),
        phrase(nums_partners(Ns, []), NPs),
        group_pairs_by_key(NPs, Pairs),
        same_length(Ns, Pairs),
        pairs_values(Pairs, Partners),
        maplist(domain, Is0, Partners),
        circuit([D|Is0]),
        labeling([ff], Is0),
        phrase(chain_(D, [_|Is0]), Cs).

chain_(1, _) --> [].
chain_(Pos0, Ls0) --> [Pos],
        { Pos0 #> 1, Pos #= Pos0 - 1,
          element(Pos0, Ls0, E) },
        chain_(E, Ls0).

plus_one(A, B) :- B #= A + 1.

domain(V, Ls0) :-
        maplist(plus_one, Ls0, Ls),
        foldl(union_, Ls, 1, Domain),
        V in Domain.

union_(N, Dom0, Dom0\/N).

nums_partners([], _) --> [].
nums_partners([N|Rs], Ls) -->
        partners(Ls, N), partners(Rs, N),
        nums_partners(Rs, [N|Ls]).

partners([], _) --> [].
partners([L|Ls], N) -->
        (   { L + N #= _^2 } -> [N-L]
        ;   []
        ),
        partners(Ls, N).

Пример запроса и ответов:

?- squares_chain(15, Cs).
Cs = [9, 7, 2, 14, 11, 5, 4, 12, 13|...] ;
Cs = [8, 1, 15, 10, 6, 3, 13, 12, 4|...] ;
false.

Более длинная последовательность:

?- time(squares_chain(100, Cs)).
15,050,570 inferences, 1.576 CPU in 1.584 seconds (99% CPU, 9549812 Lips)
Cs = [82, 87, 57, 24, 97, 72, 28, 21, 60|...] .

Что вы делаете неправильно, так это то, что вы создаете весь список перед началом тестирования.

Два предложения, вызывающие fail, бессмысленны. Их удаление не изменит программу. Единственная причина для этого - если вы делаете что-то побочное, например, вывод на печать.

Ваш код для создания списка и всех перестановок, кажется, работает, но это можно сделать намного проще, используя select/3.

Кажется, у вас нет базового случая в square_sum_help/1, и вы также, похоже, проверяете только каждую другую пару, что привело бы к проблемам через несколько лет или что-то еще, когда ваша программа удосужилась проверить правильный порядок.

Итак, чередуя генерацию и тестирование, вот так

square_sum(Num,List) :-
  upto(Num,[],List0),
  select(X,List0,List1),
  square_sum_helper(X,List1,[],List).

square_sum_helper(X1,Rest0,List0,List) :-
  select(X2,Rest0,Rest),
  Z is X1 + X2,
  is_square(Z,0),
  square_sum_helper(X2,Rest,[X1|List0],List).
square_sum_helper(_,[],List0,List) :- reverse(List0,List).

is_square(Num,S) :-
  Sqr is S * S,
  ( Num =:= Sqr ->
    true
  ; Num > Sqr,
    T is S + 1,
    is_square(Num,T) ).

upto(N,List0,List) :-
  ( N > 0 ->
    M is N - 1,
    upto(M,[N|List0],List)
  ; List = List0 ).

правильный результат получается примерно через 9 мс (SWI Prolog).

?- ( square_sum(15,List), write(List), nl, fail ; true ).
[8,1,15,10,6,3,13,12,4,5,11,14,2,7,9]
[9,7,2,14,11,5,4,12,13,3,6,10,15,1,8]

?- time(square_sum(15,_)).
% 37,449 inferences, 0.009 CPU in 0.009 seconds (100% CPU, 4276412 Lips)

Изменить: исправлены некоторые опечатки.

contains/2: пункт contains(_, []):- fail. содержит ошибки и в лучшем случае избыточен.

вы должны ввести тело !, fail.

Но в этом нет необходимости, потому что нельзя упоминать недоказуемое (предположение о закрытом мире).

кстати contains/2 на самом деле member/2 (встроенный)