Поиск в ширину (миссионеры и людоеды) на SWI-Prolog

open core, console, list
 
domains
сост = tuple(symbol, integer*, integer*).
путь = сост*.
 
class predicates
поиск_в_ширину: (сост, сост) -> путь determ.
поиск_в_ширину: (путь*, сост*, сост) -> путь determ.
переход: (сост) -> сост nondeterm.
перевезти: (integer, integer*, integer*, integer*, integer*) nondeterm (i,i,i,o,o). 
 
clauses
поиск_в_ширину(X, Y) = поиск_в_ширину([[X]], [X], Y).
 
поиск_в_ширину([[Y | П] | _], _, Y) = [Y | П]:- !.
поиск_в_ширину([[X | П] | Пути], Состояния, Y) = поиск_в_ширину(НовПути, Состояния1, Y):-
    Продолжения = [[Z, X| П] || Z = переход(X), not(isMember(Z, Состояния))],
            НовПути = append(Пути, Продолжения),
            Вершины = [V || [V | _] = getMember_nd(Продолжения)],
            Состояния1 = append(Вершины, Состояния).
 
переход(tuple("л", Л, П)) = tuple("п", Л1, П1):-
    N = std::fromTo(1, 2),
    перевезти(N, Л, П, Л1, П1).
переход(tuple("п", Л, П)) = tuple("л", Л1, П1):-
    N = std::fromTo(1, 2),
    перевезти(N, П, Л, П1, Л1).        
 
перевезти(N, [КДо, МДо], [КПосле, МПосле], [КДо-КЛ, МДо-МЛ], [КПосле+КЛ, МПосле+МЛ]):- 
    КЛ = std::fromTo(0, КДо),
    КЛ <= N, 
    МЛ = N - КЛ,
    МЛ <= МДо,  
    if МДо-МЛ > 0 then КДо-КЛ <= МДо-МЛ end if,
    if МПосле+МЛ > 0 then КПосле+КЛ <= МПосле+МЛ end if.
 
class facts
    счетчик : positive := 0.
 
clauses
    run():- 
        init(),
        Старт = tuple("л", [3, 3], [0, 0]),  
        Цель= tuple("п", [0, 0], [3, 3]), 
        Путь = поиск_в_ширину(Старт, Цель), 
        foreach tuple(Берег, Левый, Правый) = getMember_nd(reverse(Путь)),
                Левый = [КЛ, МЛ], Правый = [КП, МП]
          do 
            writef("%. На левом берегу: % кан. и % мис.; на правом берегу: % кан. и % мис. \n", 
                   счетчик, КЛ, МЛ, КП, МП),
            if Берег = "л" 
               then write("\tлодка отправляется с левого берега на правый\n\n")
               else if not(Левый = [0, 0]) then 
                      write("\tлодка отправляется с правого берега на левый\n\n") end if
             end if,
             счетчик := счетчик + 1
        end foreach,
        !, 
        _ = readLine();
        succeed().

% Константы: [0,0,0]-финиш, [1,3,3]- начало.
go(List,Out):- 
    findall(X,theEnd(List,X),Out), 
    not(Out=[]), !.
go(List,Out):- 
    findall(X,move(List,X),Xl), !, 
    go(Xl,Out).
theEnd(List,[[1,3,3]|A]):- 
    member([[1,3,3]|A],List).
move(List,[[C,Mn,Kn],[A,M,K]|W]):- 
    member([[A,M,K]|W],List), 
    C is 1-A, Z is C-A, d(Dm,Dk), Mn is M+Z*Dm,
    Mn>=0, 3>=Mn, Kn is K+Z*Dk, Kn>=0, 3>=Kn, 
    check(Mn,Kn), not(member([C,Mn,Kn],W)).
 
d(1,0). 
d(2,0). 
d(1,1). 
d(0,1). 
d(0,2).
 
check(M,K):- M=\=0, K>M ,!,fail.
check(M,K):- M=\=3, 3-K>3-M, !,fail.
check(_,_). 
 
member(A,[A|_]).
member(A,[_|B]):- member(A,B).
 
?-go([[[0,0,0]]],X),write(X).