Lingkaran tak terbatas di prolog? Atau hanya sangat lambat?

SWI-Prolog memungkinkan implementasi yang ringkas ini

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

yang selesai sangat cepat untuk N=15

edit seperti yang disarankan, menyusun daftar secara berurutan akan menghasilkan kode yang lebih baik:

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

sunting

kode di atas menjadi terlalu lambat ketika N bertambah. Saya telah mengubah strategi, dan sekarang mencoba menemukan jalur Hamilton ke dalam grafik yang disebabkan oleh relasi biner. Untuk N=15 sepertinya

(inilah kode untuk menghasilkan skrip 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('}').

)

dan di sini kode untuk mencari jalur

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

Berikut adalah solusi menggunakan Pemrograman Logika Kendala:

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

Contoh pertanyaan dan jawaban:

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

Urutan yang lebih panjang:

?- 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|...] .

Kesalahan utama yang Anda lakukan adalah Anda membuat seluruh daftar sebelum memulai pengujian.

Dua klausa yang memanggil fail tidak ada gunanya. Menghapusnya tidak akan mengubah program. Satu-satunya alasan untuk melakukan itu adalah jika Anda melakukan sesuatu yang memiliki efek samping, seperti hasil pencetakan.

Kode Anda untuk membuat daftar, dan semua permutasi, tampaknya berfungsi, tetapi dapat dilakukan lebih sederhana dengan menggunakan select/3.

Tampaknya Anda tidak memiliki kasus dasar di square_sum_help/1, dan Anda juga tampaknya hanya memeriksa setiap pasangan lainnya, yang akan menyebabkan masalah dalam beberapa tahun atau apa pun ketika program Anda sempat memeriksa urutan yang benar.

Jadi, dengan menyisipkan generasi dan pengujian, seperti ini

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

hasil yang benar dihasilkan dalam waktu sekitar 9 mdetik (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)

Sunting: memperbaiki beberapa kesalahan ketik.

contains/2: klausa contains(_, []):- fail. paling bermasalah dan mubazir.

Anda harus mengetikkan isi !, fail.

Namun hal ini tidak diperlukan karena hal yang tidak dapat dibuktikan tidak boleh disebutkan (asumsi dunia tertutup).

btw contains/2 sebenarnya member/2 (bawaan)