Оптимизация решателя Prolog для игры пасьянс 5x5 Peg

Question

Я пытаюсь найти последовательность шагов от стартовой доски ниже до решенного состояния.

[[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), !.

Answer 1

Хорошая головоломка, стоит попробовать 2-мерные ограничения, даже если я думаю, что из того, что я прочитал , не может быть никакого решения ...

Ваш код довольно наивенбрутфорс решатель.Вызов 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).

Увы, это не сильно поможет: теперь мы можем выбрать уровень «решения»:

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

У нас около 5К выводов / решение на уровне 3. Но ясно, что их много.Значит, безнадежно пытаться? - решить (S, 1).Этот метод грубой силы не работает ...

Может быть, я попытаюсь использовать лучшее кодирование проблемной области и моделирование с помощью библиотеки (clpfd).