/* A problem solver in Prolog

   This program expects the following:

     A predicate => of two arguments such that State1 => State2 is true
     when there is a transition from State1 to State2

     A predicate 'final' of one argument that tells when a state is a solution.

     A predicate 'initial' that defines the initial state.

  There are two solvers in this file:

  solve:  (A depth-first, backtracking, solver)

     Given the above information (and sufficient time and space), calling
     'solve' will print at least one solution if there is one, of the 
     sequence of states from initial to a final state.  It may print multiple 
     solutions.

     The solutions produced by this solve are only minimal in that they don't
     use the same state twice.  However, it is not guaranteed that any solution 
     will be of the shortest length.

  solve_bf:  (A breadth-first solver)

     Calling solve_bf will print (again, with sufficient time and space), one 
     minimal-length solution, if there is a solution at all.

*/

:- op(1050, xfx, '=>').  % symbol for transitions
:- dynamic marked/1.     % predicate for marking

/***************************** depth-first solver *****************************/

solve :-
    retractall(marked(_)),    %% remove all markings
    initial(State),           %% get the initial state
    solve(State, Path),       %% do depth-first search
    show_solution(Path),      %% show the solution
    fail ; true.              %% repeat until exhausted

solve(State1, [State1]) :-    %% solve from State1
    final(State1),            %% done if State1 is final
    !.

solve(State1, Path) :-        %% solve from non-final State1
    \+marked(State1),         %% proceed only if not marked
    assert(marked(State1)),   %% mark it
    (State1 => State2),       %% get a successor State2
    solve(State2, More),      %% solve recursively from State2
    Path = [State1 | More].   %% record the path from State2

/***************************** breadth-first solver *****************************/

solve_bf :-
    retractall(mentor(_, _)),                   %% unmark everything
    new_queue(Queue),                           %% make a queue
    initial(Initial),                           %% get the initial state
    enqueue(Initial, Initial, Queue, NewQueue), %% enqueue the initial state
    (  loop(NewQueue, Final)                    %% do the search
    -> retrace(Final, Initial, Path),           %% retrace successful Path
       show_solution(Path)                      %% show the path
    ;  no_solutions                             %% no solution exists
    ).

loop(Queue, Final) :-                           %% breadth-first search loop
    dequeue(Item, Queue, NewQueue),             %% dequeue an item if possible
    (  final(Item)                              %% are we done?
    -> Final = Item                             %% succeed
    ;  enqueue_successors(Item, NewQueue, NewerQueue),  %% enqueue item's successors
       loop(NewerQueue, Final)                  %% continue
    ).

enqueue_successors(Item, Queue, NewQueue) :-    %% enqueue unmarked successors
    setof1(Successor, ((Item => Successor), \+ X^mentor(Successor, X)), Successors),
    enqueue_each(Successors, Item, Queue, NewQueue).

enqueue_each([], _, Queue, Queue).              %% iterative enqueuing of a list
enqueue_each([Item | Items], Mentor, Queue, FinalQueue) :-
    enqueue(Item, Mentor, Queue, NewQueue),
    enqueue_each(Items, Mentor, NewQueue, FinalQueue).

%% queue routines (using "difference lists")

new_queue(Tail-Tail).                            %% return an empty queue

enqueue(Item, Mentor, H-[Item | T], H-T) :-      %% enqueue item and record mentor
    assert(mentor(Item, Mentor)).

dequeue(Item, [Item | More]-T, More-T).          %% dequeue item

retrace(Final, Initial, Path) :-                 %% retrace a solution
    retrace(Final, Initial, [], Path).      

retrace(Initial, Initial, Acc, [Initial | Acc]). %% retrace auxiliary
retrace(State, Initial, Acc, NewAcc) :-
    mentor(State, Mentor),                       %% go from successor to mentor
    retrace(Mentor, Initial, [State | Acc], NewAcc).

setof1(X, Y, Z) :-                               %% a proper "setof" predicate
    setof(X, Y, Z),                              %% gives as Z the setof X
    !.                                           %% such that Y is true
setof1(_, _, []).

/************************* code common to both solvers **************************/

%% show a solution list, preceded by a length
show_solution(Path) :-
    length(Path, Length),
    Steps is Length-1,
    nl, write('A '), write(Steps), write( ' move solution:'), nl,
    show(Path).

%% show a list, one item per line
show([]).
show([State | States]) :-
    write(State),
    nl,
    show(States).

save :-
  save_program(solver, banner).

banner :- 
  nl,
  write('***************************************************************'), nl,
  write('* Welcome to the Prolog problem solver.                       *'), nl,
  write('* Load your specifications for =>, initial, and final,        *'), nl,
  write('* (by ''compile(Filename).''  (leave off the .pl extension))    *'), nl,
  write('* then type ''solve.'' to see solutions (depth-first)           *'), nl,
  write('* or type ''solve_bf.'' to see minimal solution (breadth-first) *'), nl,
  write('***************************************************************'), nl,
  nl.