Поиск проблем в мире блоков не хватает места в стеке - PullRequest
3 голосов
/ 02 мая 2020

У меня есть следующий код:

move(state(on(X, NewX), OldY, Z), state(NewX, on(X, OldY), Z)).
move(state(on(X, NewX), Y, OldZ), state(NewX, Y, on(X, OldZ))).

move(state(OldX, on(Y, NewY), Z), state(on(Y, OldX), NewY, Z)).
move(state(X, on(Y, NewY), OldZ), state(X, NewY, on(Y, OldZ))).

move(state(OldX, Y, on(Z, NewZ)), state(on(Z, OldX), Y, NewZ)).
move(state(X, OldY, on(Z, NewZ)), state(X, on(Z, OldY), NewZ)).

path(X,X,[]).
path(X,Y,[Z|ZS]) :- 
    move(X,Z),
    path(Z,Y,ZS).

Где move дает нам возможные движения, которые вы можете использовать, а path должен указывать нам путь, по которому вы должны идти от X к Y.

Проблема в том, что предикат path не работает так, как я хочу, то есть, если я набираю path(state(on(c,on(b,on(a,void))), void, void), state(void, void, on(c,on(a,on(b,void)))), X). Я получил ОШИБКУ: из локального стека, но я хочу, чтобы этот X был

X=[state(void, void, on(c,on(a,on(b,void)))),
state(void, on(c,void), on(void(a,on(b,void))),
state(on(a,void), on(c,void), on(b,void)),
state(on(b,on(a,void)), on(c,void), void),
state(on(c,on(b,on(a,void))), void, void)].

Так что я делаю не так?

Ответы [ 2 ]

3 голосов
/ 02 мая 2020

Для первого теста нет необходимости переписывать ваш код. С лета 1972 года 1 . Вместо этого вы можете переформулировать свои запросы экономно.

Вместо того, чтобы просить конкретный ответ, который требует от вашей системы Prolog немного изобретательности, давайте сформулируем ваш ответ как запрос! Я попробовал это и понял, что у вас есть некоторые неприятные синтаксические ошибки в них, и после этого запрос не удался ..

Но есть более дешевый способ! Давайте просто ограничим длину списка и позволим Прологу заполнить остальные . Как долго этот список будет? Мы не знаем (то есть я не знаю). Хорошо, давайте попробуем любой длины ! Также это то, что любит Пролог. Это так же просто, как:

?- length(X,N),  % new
   path(  state(on(c,on(b,on(a,void))), void, void),
          state(void, void, on(c,on(a,on(b,void)))),
          X).
   X = [ state(on(b,on(a,void)),on(c,void),void),
         state(on(a,void),on(c,void),on(b,void)),
         state(void,on(c,void),on(a,on(b,void))),
         state(void,void,on(c,on(a,on(b,void)))) ],
   N = 4
;  ...

Видите, что я сделал? Я только добавил length(X, N) впереди. И вдруг Пролог ответил на короче ответа, чем вы ожидали!

Теперь, действительно ли это лучший способ спросить? В конце концов, многие ответы могут быть простыми циклами, помещающими блок в одно место и обратно ... Есть ли какие-нибудь циклы? Давайте сначала спросим:

... --> [] | [_], ... .

?- length(X,N),
   path( state(on(c,on(b,on(a,void))), void, void),
         state(void, void, on(c,on(a,on(b,void)))),
         X),
   phrase((...,[E],...,[E],...), X).
   X = ...
   N = 6,
   E = state(void,on(c,void),on(a,on(b,void)))
;  ...

О да, есть! Теперь имеет смысл исключать такие пути. Вот простой способ:

alldifferent([]).
alldifferent([X|Xs]) :-
   maplist(dif(X), Xs),
   alldifferent(Xs).

?- alldifferent(X),
   length(X,N),
   path( state(on(c,on(b,on(a,void))), void, void),
         state(void, void, on(c,on(a,on(b,void)))),
         X).

Как далеко вы можете получить с этой формулировкой? В настоящее время я нашел путь длиной 48 ... 55 ... Разве он не должен быть конечным? И: возможно ли исключить такие длинные пути для таких тривиальных проблем? Любой малыш может держать пространство поиска небольшим ... Все это фундаментальные вопросы, но они не зависят от проблемы программирования как таковой.

Или посмотрите на нее под другим углом: множество решений для X довольно большой Итак, если мы исследуем этот набор, с чего нам начать? Что значит быть лучшим решением? Тот, который при загрузке на Utube производит наибольшее количество голосов? Таким образом, то, что мы делаем здесь, это полностью неинформированный поиск . Вам нужно будет сообщить программе, какие у вас предпочтения. Это не может предположить это разумно. Хорошо, одной эвристикой будет термин размер решения. length/2 сделал это.

Обратите внимание, что я не смел трогать ваш чистый код. Да, я мог бы немного улучшить его, скажем, используя path/4, но не намного. Скорее придерживайтесь своего очень чистого стиля и лучше вместо этого делайте больше запросов! В этом превосходство Prolog!

Другие улучшения: используйте список для представления стека, это делает состояние гораздо более привлекательным.


1 Это год, когда Пролог был обнаружен / задуман / доставлен.
2 голосов
/ 02 мая 2020

Ооо ... проблема мира блоков!

Это просто потому, что вы делаете две вещи:

  • Первый поиск по глубине в пространстве состояний.
  • Ошибка проверить, было ли государство уже посещено.

(Кроме того, решение, которое вы даете, не является достижимым состоянием, вторая строка имеет void в неправильной позиции, плюс путь обратный).

Фактически Вы строите путь через путь состояния только для возврата в третьем аргументе здесь: path(X,Y,[Z|ZS]).

У вас есть для проверки каждого расширения состояния, может ли новое состояние уже находиться на пути. В противном случае программа может работать вечно (в зависимости от того, как она достигает предиката, генерирующего движение move/2 ... на самом деле хорошее упражнение - выбрать move/2 вероятностно ... возможно, позже). В приведенном ниже коде проверка выполняется с помощью fail_if_visited/2.

. Кроме того, поиск в глубину в соответствии с приведенным выше позволит найти путь решения, но, скорее всего, не - это короткий путь, а не искомое решение.

Вам действительно нужен поиск в ширину (точнее, Итеративное углубление ). Так как Prolog не позволяет отключить алгоритм поиска (почему бы и нет? Прошло более 40 лет), вы должны запустить его самостоятельно.

Наблюдать:

% ===
% Transform a state into a string
% ===

express(state(A,B,C),S) :- 
   express_pos(A,SA),
   express_pos(B,SB),
   express_pos(C,SC),
   atomic_list_concat(["[",SA,",",SB,",",SC,"]"],S).

express_pos(on(Top,Rest),S) :- 
   express_pos(Rest,S2), 
   atomic_list_concat([Top,S2],S).

express_pos(void,""). 

% ===
% Transform a path into a string
% (The path is given in the reverse order; no matter)
% ===

express_path(Path,PathStr) :-
   express_path_states(Path,StateStrs),
   atomic_list_concat(StateStrs,"<-",PathStr).

express_path_states([S|Ss],[StateStr|SubStateStrs]) :-   
   express_path_states(Ss,SubStateStrs),
   express(S,StateStr).

express_path_states([],[]).

% ===
% For debugging
% ===

debug_proposed(Current,Next,Moved,Path) :-
   express(Current,CurrentStr),
   express(Next,NextStr),
   length(Path,L),
   debug(pather,"...Proposed at path length ~d: ~w -> ~w (~q)",[L,CurrentStr,NextStr,Moved]).

debug_accepted(State) :-
   express(State,StateStr),
   debug(pather,"...Accepted: ~w",[StateStr]).

debug_visited(State) :-
   express(State,StateStr),
   debug(pather,"...Visited: ~w",[StateStr]).

debug_moved(X) :-
   debug(pather,"...Already moved: ~w",[X]).

debug_final(State) :-
   express(State,StateStr),
   debug(pather,"Final state reached: ~w",[StateStr]).

debug_current(State,Path) :-
   express(State,StateStr),
   express_path(Path,PathStr),
   length(Path,L),
   debug(pather,"Now at: ~w with path length ~d and path ~w",[StateStr,L,PathStr]).

debug_path(Path) :-
   express_path(Path,PathStr),
   debug(pather,"Path: ~w",[PathStr]).

% ===
% Moving blocks between three stacks, also recording the move
% ===

move(state(on(X, A), B, C), 
     state(A, on(X, B), C),
     moved(X,"A->B")).

move(state(on(X, A), B, C), 
     state(A, B, on(X, C)),
     moved(X,"A->C")).

move(state(A, on(X, B), C), 
     state(on(X, A), B, C),
     moved(X,"B->A")).

move(state(A, on(X, B), C), 
     state(A, B, on(X, C)),
     moved(X,"B->C")).

move(state(A, B, on(X, C)), 
     state(on(X, A), B, C),
     moved(X,"C->A")).

move(state(A, B, on(X, C)), 
     state(A, on(X, B), C),
     moved(X,"C->B")).

move(_,_,_,_) :- debug(pather,"No more moves",[]).

% ===
% Finding a path from an Initial State I to a Final State F.
% You have to remember the path taken so far to avoid cycles,
% instead of trying to reach the final state while the path-so-far
% is sitting inaccessible on the stack, from whence it can only be
% be reconstructed on return-fro-recursion.
% ===

fail_if_visited(State,Path) :- 
   (memberchk(State,Path) 
   -> (debug_visited(State),fail)
   ; true).

fail_if_moved(moved(X,_),LastMoved) :-
   (LastMoved = moved(X,_)
   -> (debug_moved(X),fail)
   ; true).

path2(F,F,Path,Path,_) :- 
    debug_final(F).

path2(I,F,PathToI,FullPath,LastMoved) :-
    dif(I,F),                          % I,F are sure different (program will block if it can't be sure)
    debug_current(I,PathToI),
    move(I,Next,Moved),                % backtrackably pattern-match yourself an acceptable next state based on I
    ground(Next),                      % fully ground, btw
    debug_proposed(I,Next,Moved,PathToI),
    fail_if_moved(Moved,LastMoved),    % don't want to move the same thing again
    fail_if_visited(Next,PathToI),     % maybe already visited?
    debug_accepted(Next),              % if we are here, not visited
    PathToNext = [Next|PathToI],
    path2(Next,F,PathToNext,FullPath,Moved). % recurse with path-so-far (in reverse) 

% ---
% Top call
% ---

path(I,F,Path) :- 
   PathToI = [I],
   path2(I,F,PathToI,FullPath,[]),     % FullPath will "fish" the full path out of the depth of the stack
   reverse(FullPath,Path),             % don't care about efficiency of reverse/2 at all
   debug_path(Path).

% ===
% Test 
% ===

:- begin_tests(pather).

test(one, true(Path = [state(void, void, on(c,on(a,on(b,void)))),
                       state(void, on(c,void), on(void(a,on(b,void)))),
                       state(on(a,void), on(c,void), on(b,void)),
                       state(on(b,on(a,void)), on(c,void), void),
                       state(on(c,on(b,on(a,void))), void, void)]))

     :- I = state(on(c,on(b,on(a,void))), void, void),
        F = state(void, void, on(c,on(a,on(b,void)))),
        path(I,F,Path).

:- end_tests(pather).

rt :- debug(pather),run_tests(pather).

В конце мы получаем:

% ...Accepted: [c,,ab]
% Now at: [c,,ab] with path length 24 and path [c,,ab]<-[,c,ab]<-[,ac,b]<-[b,ac,]<-[ab,c,]<-[ab,,c]<-[b,a,c]<-[,a,bc]<-[a,,bc]<-[a,b,c]<-[,ab,c]<-[c,ab,]<-[ac,b,]<-[ac,,b]<-[c,a,b]<-[,ca,b]<-[b,ca,]<-[cb,a,]<-[cb,,a]<-[b,c,a]<-[,bc,a]<-[a,bc,]<-[ba,c,]<-[cba,,]
% ...Proposed at path length 24: [c,,ab] -> [,c,ab] (moved(c,"A->B"))
% ...Already moved: c
% ...Proposed at path length 24: [c,,ab] -> [,,cab] (moved(c,"A->C"))
% ...Already moved: c
% ...Proposed at path length 24: [c,,ab] -> [ac,,b] (moved(a,"C->A"))
% ...Visited: [ac,,b]
% ...Proposed at path length 24: [c,,ab] -> [c,a,b] (moved(a,"C->B"))
% ...Visited: [c,a,b]
% ...Proposed at path length 23: [,c,ab] -> [,,cab] (moved(c,"B->C"))
% ...Accepted: [,,cab]
% Final state reached: [,,cab]
% Path: [cba,,]<-[ba,c,]<-[a,bc,]<-[,bc,a]<-[b,c,a]<-[cb,,a]<-[cb,a,]<-[b,ca,]<-[,ca,b]<-[c,a,b]<-[ac,,b]<-[ac,b,]<-[c,ab,]<-[,ab,c]<-[a,b,c]<-[a,,bc]<-[,a,bc]<-[b,a,c]<-[ab,,c]<-[ab,c,]<-[b,ac,]<-[,ac,b]<-[,c,ab]<-[,,cab]
ERROR: /home/homexercises/pather.pl:146:
        test one: wrong answer (compared using =)
ERROR:     Expected: [state(void,void,on(c,on(a,on(b,void)))),state(void,on(c,void),on(void(a,on(b,void)))),state(on(a,void),on(c,void),on(b,void)),state(on(b,on(a,void)),on(c,void),void),state(on(c,on(b,on(a,void))),void,void)]
ERROR:     Got:      [state(on(c,on(b,on(a,void))),void,void),state(on(b,on(a,void)),on(c,void),void),state(on(a,void),on(b,on(c,void)),void),state(void,on(b,on(c,void)),on(a,void)),state(on(b,void),on(c,void),on(a,void)),state(on(c,on(b,void)),void,on(a,void)),state(on(c,on(b,void)),on(a,void),void),state(on(b,void),on(c,on(a,void)),void),state(void,on(c,on(a,void)),on(b,void)),state(on(c,void),on(a,void),on(b,void)),state(on(a,on(c,void)),void,on(b,void)),state(on(a,on(c,void)),on(b,void),void),state(on(c,void),on(a,on(b,void)),void),state(void,on(a,on(b,void)),on(c,void)),state(on(a,void),on(b,void),on(c,void)),state(on(a,void),void,on(b,on(c,void))),state(void,on(a,void),on(b,on(c,void))),state(on(b,void),on(a,void),on(c,void)),state(on(a,on(b,void)),void,on(c,void)),state(on(a,on(b,void)),on(c,void),void),state(on(b,void),on(a,on(c,void)),void),state(void,on(a,on(c,void)),on(b,void)),state(void,on(c,void),on(a,on(b,void))),state(void,void,on(c,on(a,on(b,void))))]
 done
% 1 test failed
% 0 tests passed
false.

Путь длиной 23 успешно достигает конечного состояния, но является "слишком длинным" в соответствии с искомым решением. Даже с heuristi c «не перемещайте блок дважды», выраженным в fail_if_moved/2.

Приложение: вероятности c поиск

Использование рандомизированного алгоритма удивительно полезен:

Вырвите предикат move/3 сверху и замените его на:

move(From,To,Moved) :-
   random_permutation([0,1,2,3,4,5],ONs),  % permute order numbers
   !,                                      % no backtracking past here!
   move_randomly(ONs,From,To,Moved).       % try to match a move 

move_randomly([ON|___],From,To,Moved) :- move(ON,From,To,Moved).
move_randomly([__|ONs],From,To,Moved) :- move_randomly(ONs,From,To,Moved).
move_randomly([],_,_,_)               :- debug(pather,"No more moves",[]).

move(0,state(on(X, A), B, C), 
     state(A, on(X, B), C),
     moved(X,"0: A->B")).

move(1,state(on(X, A), B, C), 
     state(A, B, on(X, C)),
     moved(X,"1: A->C")).

move(2,state(A, on(X, B), C), 
     state(on(X, A), B, C),
     moved(X,"2: B->A")).

move(3,state(A, on(X, B), C), 
     state(A, B, on(X, C)),
     moved(X,"3: B->C")).

move(4,state(A, B, on(X, C)), 
     state(on(X, A), B, C),
     moved(X,"4: C->A")).

move(5,state(A, B, on(X, C)), 
     state(A, on(X, B), C),
     moved(X,"5: C->B")).

Очевидно, что это не парадигма эффективного Пролога, но кого это волнует:

Решение длины 5 было найдено только за 7 попыток!

Path: [cba,,]<-[ba,c,]<-[a,c,b]<-[,c,ab]<-[,,cab] (Length 5)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...