为5x5钉单人纸牌游戏优化Prolog求解器

时间:2018-12-28 21:50:36

标签: prolog

我正在尝试找到从下面的起始板到解决状态的一系列步骤。

[[x,x,x,x,x],
 [x,x,x,x,x],
 [x,x,o,x,x],
 [x,x,x,x,x],
 [x,x,x,x,x]]

但是,这需要很长时间。我已将程序运行5个小时,但仍未找到解决方案。有什么我可以优化的方法吗?

:- use_module(library(clpfd)).

rotate_clock(Xss, Zss) :-
    transpose(Xss, Yss),
    maplist(reverse, Yss, Zss).

rotate_anti(Xss, Zss) :-
    maplist(reverse, Xss, Yss),
    transpose(Yss, Zss).

linjmp([x, x, o | T], [o, o, x | T]).
linjmp([o, x, x | T], [x, o, o | T]).
linjmp([H|T1], [H|T2]) :- linjmp(T1,T2).

horizjmp([A|T],[B|T]) :- linjmp(A,B).
horizjmp([H|T1],[H|T2]) :- horizjmp(T1,T2).

jump(B,A) :- horizjmp(B,A).
jump(B,A) :- rotate_clock(B,BR), horizjmp(BR,BRJ), rotate_anti(BRJ, A).

num_x(A, C) :- count(A, x, C).

count([],X,0).
count([X|T],X,Y):- count(T,X,Z), Y is 1+Z.
count([H|T],X,Z):- dif(H, X), count(T,X,Z).

sum_list([], 0).
sum_list([H|T], Sum) :-
    sum_list(T, Rest),
    Sum is H + Rest.

solved(A) :-
    maplist(num_x, A, B),
    sum_list(B, C),
    C == 1.

jumps([B1, B2 | []]) :-
    jump(B1, B2),
    solved(B2).
jumps([B1, B2 | Bs]) :-
    jump(B1, B2),
    jumps([B2 | Bs]).

?- jumps([[[x,x,x,x,x], [x,x,x,x,x], [x,x,o,x,x], [x,x,x,x,x], [x,x,x,x,x]]|X]), write(X), !.

1 个答案:

答案 0 :(得分:0)

一个不错的难题,二维约束值得尝试,即使我认为what I read中也没有解决方案...

您的代码是一个相当幼稚的暴力求解器。在每个搜索树节点处调用transpose / 2(两次!)只是为了测试垂直模式听起来太过分了。

我将展示我的尝试,从“符号处理”(和像您一样的蛮力)开始为问题建模。

solve_brute_force(S) :-
    build(at(3,3,o),x,I),
    /* uncomment to test...
    I=[[x,x,x,x,x],
       [x,x,x,x,x],
       [x,x,o,x,x],
       [x,x,x,x,x],
       [x,x,x,x,x]],
    */
    % try all...
    % between(1,5,P),between(1,5,Q),build(at(P,Q,x),o,F),
    % or just a specific pattern
    build(at(2,4,x),o,F),
    steps(I,F,S).

steps(F,F,[F]).
steps(A,F,[A|R]) :-
    step(A,B), %show(B),
    steps(B,F,R).

step(A,B) :-
    append(L,[R|Rs],A),
    hmove(R,U),
    append(L,[U|Rs],B).
step(A,B) :-
    append(L,[U0,V0,Z0|Rs],A),
    vmove(U0,V0,Z0, U2,V2,Z2),
    append(L,[U2,V2,Z2|Rs],B).

hmove(R,U) :-
    append(Rl,[x,x,o|Rr],R),
    append(Rl,[o,o,x|Rr],U).
hmove(R,U) :-
    append(Rl,[o,x,x|Rr],R),
    append(Rl,[x,o,o|Rr],U).

vmove(U0,V0,Z0, U2,V2,Z2) :-
    nth0(C,U0,x,U1),nth0(C,V0,x,V1),nth0(C,Z0,o,Z1),!,
    nth0(C,U2,o,U1),nth0(C,V2,o,V1),nth0(C,Z2,x,Z1).
vmove(U0,V0,Z0, U2,V2,Z2) :-
    nth0(C,U0,o,U1),nth0(C,V0,x,V1),nth0(C,Z0,x,Z1),!,
    nth0(C,U2,x,U1),nth0(C,V2,o,V1),nth0(C,Z2,o,Z1).

/*
at_least_2([R|Rs],C,S) :-
    aggregate_all(count,member(S,R),T),
    U is C+T,
    ( U >= 2 -> true ; at_least_2(Rs,U,S) ).

count(B,S,N) :-
    aggregate_all(sum(Xs),
              (member(R,B), aggregate_all(count, member(S,R), Xs)),
              N).
*/

build(Cx,Cy,at(X,Y,A),B,P) :-
    findall(Rs,(between(1,Cy,R),
                findall(S,(between(1,Cx,C),
                          (R=Y,C=X -> S=A ; S=B)), Rs)), P).
build(A_at,B,P) :-
    build(5,5,A_at,B,P).

对不起,它并没有终止……但是它为我们提供了一小部分可用来更好地理解问题的工具。

您是否注意到,每一步钉子都会少一些? 然后,我们可以避免计算钉子,这是到目前为止我进行优化的更好提示。

solve(S,R) :-
    build(at(3,3,o),x,I),
    steps_c(I,24,R,S).

steps_c(F,N,N,[F]).
steps_c(A,C,N,[A|R]) :-
    step(A,B), % to debug... show(B),
    succ(D,C), % or D is C-1,
    steps_c(B,D,N,R).

A,这不会有太大帮助:现在我们可以选择“解决方案”级别:

 ?- time(solve(S,3)),maplist([T]>>(maplist(writeln,T),nl),S).
% 155,322 inferences, 0.110 CPU in 0.111 seconds (99% CPU, 1411851 Lips)
[x,x,x,x,x]
[x,x,x,x,x]
[x,x,o,x,x]
[x,x,x,x,x]
[x,x,x,x,x]

[x,x,x,x,x]
[x,x,x,x,x]
[o,o,x,x,x]
[x,x,x,x,x]
[x,x,x,x,x]

...

让我们评估一些还剩3极的解决方案:

 ?- time(call_nth(solve(S,3),1000)).
% 4,826,178 inferences, 2.913 CPU in 2.914 seconds (100% CPU, 1656701 Lips)
S = [[[x, x, x, x, x], ....

 ?- time(call_nth(solve(S,3),10000)).
% 53,375,354 inferences, 31.968 CPU in 31.980 seconds (100% CPU, 1669646 Lips)
S = [[[x, x, x, x, x],

我们在第3级有大约5K推论/解决方案,但是很明显,有很多推论。因此,尝试?-solve(S,1)是没有希望的。这种蛮力方法行不通...

也许我会尝试使用更好的问题域编码,并使用library(clpfd)进行建模。