?-use_module(library(lists)).
:- dynamic marked/1, size/2.



/* This is a modification of the jug problem
   using simple depth-first search of a graph.

   The modified water-jug problem is as follows:
      Jug A holds 4 liters, and jug B holds 3 liters.
      There is a pump which can be used to fill either
      jug.  How can you get exactly 2 liters of water
      into the 4-liter jug?   */

not(X) :- \+(X).
?-op(100,yfx,':').  /* define : as a left-associative operator */

/* The major predicate is
  solve(Current_state, Goal_state, Traversed_path, Solution_path).
   where Traversed_path is a list of pourings made so far.     */

solve(Goal, Goal, Path, Path).  /* If the current state is the
          goal state, then output the path to the 4th argument */

solve(Current, Goal, Path, Solution) :-
      edge(Step, Current, New),  /* 'Step' involves either pouring
                                     or filling up from pump */
      not( marked(solve(New, Goal, _, _))),  /* Graph search requires
                    checking whether we've searched this node before */
      solve(New, Goal, Path:Step, Solution). /* Use recursion to do
                  depth-first search.  On failure, backup to 'pour'. */

edge(fill_up_a, A:B, S:B) :- size(a,S), A<S.
edge(fill_up_b, A:B, A:S) :- size(b,S), B<S.
edge(pour_a_down_drain, A:B , 0:B).
edge(pour_b_down_drain, A:B , A:0).
edge(pour_a_into_b, A:B, C:D) :-
      size(b,S), A>0, B<S, T is A+B,
      (T>=S, C is T-S, D=S ; T<S, C=0, D=T) .
edge(pour_b_into_a, A:B, C:D) :-
       size(a,S), B>0, A<S, T is A+B,
       (T>=S, D is T-S, C=S ; T<S, C=T, D=0) .

/*Check whether a node was already searched.  The rule
    marked(X) :- asserta((marked(X):- !)), fail.
causes a node to be marked if it was not marked before, and fails.
The next time it checks this node, it will succeed since that node
had been asserted to be marked.  Reset_marked permits the
depth-first search to be done several times.   */

reset_marked :- retractall(marked(_)),
      asserta( (marked(X) :- asserta((marked(X):- !)), fail) ).

mod_jug_problem(X,Y,Z) :- reset_marked, solve(X,Y,start,Z).

size(a,4).
size(b,3).
?- mod_jug_problem(0:0, 2:_B, Solution), print('4,3 -> 2:B '), print(Solution),nl.

?-retractall(size(_ , _)).

size(a,5).
size(b,2).

?-mod_jug_problem(5:0, _A:1, Solution), print('5,2 -> A:1 '), print(Solution),nl.

breadthFirst(Queue,Goals,Paths) :- 
	breadthFirst2(Queue,Goals,NodeSets,[]), print(NodeSets), nl,
	getPaths(NodeSets,Paths,_).


breadthFirst2(Q,Goals,[Sons],_):- not(Q=[]),
    setof(X,(member(X,Goals),member(X,Q)),Sons), not(Sons=[]).
breadthFirst2(Q,Goals,[GoodParents,GoodSons|Rest],Seen):- not(Q=[]),
     getSons(Q,Seen,Sons),
     append(Seen,Q,NewSeen),
     breadthFirst2(Sons,Goals,[GoodSons|Rest],NewSeen), 
     setof(P,getParents(P,Q,GoodSons),GoodParents). 

getParents(P,Q,Sons):- member(P,Q),member(S,Sons), biedge(_Name,P,S).
getSons(Q,Seen,Sons):- setof(Son, Name^newEdge(Name,Q,Son,Seen),Sons),!. 
getSons(_,_,[]).

getPaths([X,Y],[Name],A):- member(A,X), member(B,Y), biedge(Name,A,B).
getPaths([X|Z],[Name|U],A):- member(A,X),  
      getPaths(Z,U,B), biedge(Name,A,B).


newEdge(Name,Q,Son,Seen):- member(Parent,Q), biedge(Name, Parent,Son), not(member(Son,Q)),
   not(member(Son,Seen)).



/*Allow commutative edges*/
biedge(N,X,Y) :- edge(N,X,Y).
/* biedge(N,X,Y) :- edge(N,Y,X). */

?-retractall(size(_ , _)).
?-nl,nl,print('Breadth first search:'),nl.

jug_problem(X,Y,Ops):- breadthFirst(X,Y,Ops),print(Ops),nl.

size(a,4).
size(b,3).
?- print('4,3 -> 2:B '), nl.
?-jug_problem([0:0],[2:B],Z).

?-retractall(size(_ , _)).

size(a,5).
size(b,2).
?- print('5,2 -> A:1 '), nl.
?-jug_problem([0:0],[A:1],Z).