关于建立一个列表直到它满足条件

Question

我想使用 Prolog 解决 Dan Finkel 的 "the giant cat army riddle"。

基本上，您从[0] 开始，然后使用以下三种操作之一构建此列表：添加5、添加7 或获取sqrt。当您设法建立一个列表，使2、10 和14 按顺序出现在列表中并且它们之间可以有其他数字时，您就成功完成了游戏。

规则还要求所有元素都是不同的，它们都是<=60，并且都是整数。 例如，从[0] 开始，您可以应用(add5, add7, add5)，这将导致[0, 5, 12, 17]，但由于它没有按顺序排列的2、10、14，因此无法满足游戏要求。

我认为我已经成功地编写了所需的事实，但我不知道如何实际构建列表。我认为使用dcg 是一个不错的选择，但我不知道如何。

这是我的代码：

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

代码发出以下错误，但我没有尝试跟踪它或任何东西，因为我确信我使用 DCG 不正确：

?- phrase(step(L), X).
caught: error(type_error(list,_65),sort/2)

我正在使用 Scryer-Prolog，但我认为所有模块都可以在 swipl 中使用，例如 clpfd 而不是 clpz。

Answer 1

step(Ls) --> [add5(Ls, L)], step(L).

这不符合您的要求。它描述了add5(Ls, L) 形式的列表元素。当你到达这里时，大概Ls 绑定了某个值，但L 没有绑定。如果Ls 是正确形式的非空列表，并且您执行目标add5(Ls, L)，L 将被绑定。但是你没有执行这个目标。您将一个术语存储在列表中。然后，在L 完全未绑定的情况下，期望将其绑定到列表的代码的某些部分将抛出此错误。大概sort/2 调用在all_different/1 内部。

编辑：这里发布了一些令人惊讶的复杂或低效的解决方案。我认为 DCG 和 CLP 在这里都过大了。所以这里有一个相对简单和快速的。为了执行正确的 2/10/14 顺序，这使用了一个 state 参数来跟踪我们以正确的顺序看到了哪些：

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

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

重复的member 调用以确保没有重复构成执行时间的大部分。使用“已访问”表（未显示）可以将此时间缩短到大约 0.25 秒。

编辑：进一步缩减，速度提高了 100 倍：

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

可以预先计算移动表（枚举prev_next/2 的所有解决方案，在动态谓词中断言它们，然后调用它）以获得另一毫秒或两毫秒。使用 CLP(FD) 而不是“直接”算术会使 SWI-Prolog 上的速度相当慢。特别是，Y in 0..60, X #= Y * Y 而不是 nth_integer_root_and_remainder/4 目标最多需要大约 0.027 秒。

Answer 2

鉴于问题似乎已从使用 DCG 转移到解决难题，我想我可能会发布一个更有效的方法。我在 SICStus 上使用 clp(fd)，但我包含了一个修改版本，该版本应该与 Scryer 上的 clpz 一起使用（将 table/2 替换为 my_simple_table/2）。

:- use_module(library(clpfd)).
:- use_module(library(lists)).

move(X,Y):-
    (
      X+5#=Y
    ;
      X+7#=Y
    ;
      X#=Y*Y
    ).

move_table(Table):-
    findall([X,Y],(
            X in 0..60,
            Y in 0..60,
            move(X,Y),
            labeling([], [X,Y])
         ),Table).
      

% Naive version
%%post_move(X,Y):- move(X,Y).
%%
% SICSTUS clp(fd)
%%post_move(X,Y):-
%%  move_table(Table),
%%  table([[X,Y]],Table).
%%
% clpz is mising table/2
post_move(X,Y):-
    move_table(Table),
    my_simple_table([[X,Y]],Table).

my_simple_table([[X,Y]],Table):-
      transpose(Table, [ListX,ListY]),
      element(N, ListX, X),
      element(N, ListY, Y).


post_moves([_]):-!.
post_moves([X,Y|Xs]):-
    post_move(X,Y),
    post_moves([Y|Xs]).

state(N,Xs):-
    length(Xs,N),
    domain(Xs, 0, 60),
    all_different(Xs),
    post_moves(Xs),
    % ordering: 0 is first, 2 comes before 10, and 14 is last.
    Xs=[0|_],
    element(I2, Xs, 2),
    element(I10, Xs, 10),
    I2#<I10,
    last(Xs, 14).

try_solve(N,Xs):-
    state(N, Xs),
    labeling([ffc], Xs).
try_solve(N,Xs):-
    N1 is N+1,
    try_solve(N1,Xs).


solve(Xs):-
    try_solve(1,Xs).

两个有趣的笔记：

• 创建一个包含可能移动的表并使用 table/2 约束比发布约束的析取要高效得多。请注意，我们每次发布表格时都会重新创建表格，但我们不妨创建一次并传递它。
• 这是使用 element/3 约束来查找和约束感兴趣数字的位置（在本例中只有 2 和 10，因为我们可以将 14 固定为最后一个）。同样，这比在解决约束问题后检查顺序作为过滤更有效。

编辑：

这是一个符合赏金限制的更新版本（谓词名称，-希望- SWI 兼容，只创建一次表）：

:- use_module(library(clpfd)).
:- use_module(library(lists)).

generate_move_table(Table):-
    X in 0..60,
    Y in 0..60,
    (    X+5#=Y 
    #\/  X+7#=Y 
    #\/  X#=Y*Y 
    ),
    findall([X,Y],labeling([], [X,Y]),Table).
      
%post_move(X,Y,Table):- table([[X,Y]],Table). %SICStus
post_move(X,Y,Table):- tuples_in([[X,Y]],Table). %swi-prolog
%post_move(X,Y,Table):- my_simple_table([[X,Y]],Table). %scryer

my_simple_table([[X,Y]],Table):- % Only used as a fall back for Scryer prolog
    transpose(Table, [ListX,ListY]),
    element(N, ListX, X),
    element(N, ListY, Y).

post_moves([_],_):-!.
post_moves([X,Y|Xs],Table):-
    post_move(X,Y,Table),
    post_moves([Y|Xs],Table).

puzzle_(Xs):-
    generate_move_table(Table),
    
    N in 4..61, 
    indomain(N),
    length(Xs,N),
    
    %domain(Xs, 0, 60), %SICStus
    Xs ins 0..60, %swi-prolog, scryer
    
    all_different(Xs),
    post_moves(Xs,Table),
    
    % ordering: 0 is first, 2 comes before 10, 14 is last.
    Xs=[0|_],
    element(I2, Xs, 2),
    element(I10, Xs, 10),
    I2#<I10,
    last(Xs, 14).

label_puzzle(Xs):-
    labeling([ffc], Xs).

solve(Xs):-
    puzzle_(Xs),
    label_puzzle(Xs).

我没有安装 SWI-prolog，所以我无法测试效率要求（或者它实际上根本运行），但在我的机器上和使用 SICStus，solve/1 谓词的新版本需要 16 到 31毫秒，而伊莎贝尔的答案 (https://stackoverflow.com/a/65513470/12100620) 中的 puzzle/1 谓词需要 78 到 94 毫秒。

至于优雅，我想这是旁观者的看法。我喜欢这个公式，它相对清晰并且展示了一些非常通用的约束（element/3、table/2、all_different/1），但它的一个缺点是在问题描述中序列的大小（因此FD 变量的数量）不是固定的，所以我们需要生成所有大小，直到一个匹配。有趣的是，似乎所有解决方案都具有相同的长度，并且puzzle_/1 的第一个解决方案会生成正确长度的列表。

Answer 3

仅使用dcg 来构建列表的替代方法。 2,10,14 约束是在构建列表后检查的，所以这不是最优的。

num(X) :- between(0, 60, X).

isqrt(X, Y) :- nth_integer_root_and_remainder(2, X, Y, 0). %SWI-Prolog

% list that ends with an element.
list([0], 0) --> [0].
list(YX, X) --> list(YL, Y), [X], { append(YL, [X], YX), num(X), \+member(X, YL),
                                    (isqrt(Y, X); plus(Y, 5, X); plus(Y, 7, X)) }.
soln(X) :-
    list(X, _, _, _),
    nth0(I2, X, 2), nth0(I10, X, 10), nth0(I14, X, 14),
    I2 < I10, I10 < I14.

?- time(soln(X)).
% 539,187,719 inferences, 53.346 CPU in 53.565 seconds (100% CPU, 10107452 Lips)
X = [0, 5, 12, 17, 22, 29, 36, 6, 11, 16, 4, 2, 9, 3, 10, 15, 20, 25, 30, 35, 42, 49, 7, 14] 

Answer 4

我尝试了一点magic set。谓词 path/2 确实在不给我们路径的情况下搜索路径。因此，我们可以使用 +5 和 +7 的交换性，减少搜索次数：

step1(X, Y) :- N is (60-X)//5, between(0, N, K), H is X+K*5,
         M is (60-H)//7, between(0, M, J), Y is H+J*7.
step2(X, Y) :- nth_integer_root_and_remainder(2, X, Y, 0).

:- table path/2.
path(X, Y) :- step1(X, H), (Y = H; step2(H, J), path(J, Y)).

然后我们使用 path/2 作为 path/4 的魔法集：

step(X, Y) :- Y is X+5, Y =< 60.
step(X, Y) :- Y is X+7, Y =< 60.
step(X, Y) :- nth_integer_root_and_remainder(2, X, Y, 0).

/* without magic set */
path0(X, L, X, L).
path0(X, L, Y, R) :- step(X, H), \+ member(H, L), 
   path0(H, [H|L], Y, R).

/* with magic set */
path(X, L, X, L).
path(X, L, Y, R) :- step(X, H), \+ member(H, L), 
   path(H, Y), path(H, [H|L], Y, R).

这是一个时间比较：

SWI-Prolog (threaded, 64 bits, version 8.3.16)

/* without magic set */
?- time((path0(0, [0], 2, H), path0(2, H, 10, J), path0(10, J, 14, L))), 
   reverse(L, R), write(R), nl.
% 13,068,776 inferences, 0.832 CPU in 0.839 seconds (99% CPU, 15715087 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]

/* with magic set */
?- abolish_all_tables.
true.

?- time((path(0, [0], 2, H), path(2, H, 10, J), path(10, J, 14, L))), 
   reverse(L, R), write(R), nl.
% 2,368,325 inferences, 0.150 CPU in 0.152 seconds (99% CPU, 15747365 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]

注意！

Answer 5

我设法在没有 DCG 的情况下解决了它，在我的机器上解决长度 N=24 大约需要 50 分钟。我怀疑这是因为 order 检查是从头开始对每个列表进行的。

:- use_module(library(lists)).
:- use_module(library(clpz)).
:- use_module(library(dcgs)).
:- use_module(library(time)).

%% integer sqrt
isqrt(X, Y) :- Y #>= 0, X #= Y*Y.

before(X, Y, Z, L) :-
        %% L has a suffix [X|T], and T has a suffix of [Y|_].
        append(_, [X|T], L),
        append(_, [Y|TT], T),
        append(_, [Z|_], TT).

order(L) :- before(2,10,14, L).

game([X],X).
game([H|T], H) :- ((X #= H+5); (X #= H+7); (isqrt(H, X))), X #\= H, H #=< 60, X #=< 60,  game(T, X). % H -> X.

searchN(N, L) :- length(L, N), order(L), game(L, 0).