
/*  Here is a layered/inductive data type definition:
         Tree ::=  leaf  |  node(int, Tree, Tree)

    In ML, it looks like this:
         datatype Tree =  Leaf  |  Node of int * Tree * Tree

    In Prolog, you don't declare the datatype -- you just start
    using  leaf  and  node,  and the prover figures out what you
    are doing.  leaf  and  node  are "functors".
*/

/* makeTree(L, T)  asserts that  T  is an ordered tree of ints
   built from the list of ints, L   */
makeTree([], leaf).
makeTree([N|Rest], Ans) :- makeTree(Rest, T), insert(N, T, Ans).


/*  insert(N, T, U)   asserts that ordered tree  U  consists of
      ordered tree T with N inserted therein:  */
insert(N, leaf,  node(N, leaf, leaf)).

insert(N, node(M, Left, Right),  node(M, Newleft, Right))
                 :- N =< M, insert(N, Left, Newleft).

insert(N, node(M, Left, Right),  node(M, Left, Newright))
                 :- N > M, insert(N, Right, Newright).
 

/* member(N, T)  holds true when  N  is found in tree T.  */
member(N, node(N, _, _)).
member(N, node(_, Left, _)) :- member(N, Left).
member(N, node(_, _, Right)) :- member(N, Right).


/* hasElements(T, L)  asserts that  L  is a list of all
   the values stored in tree T: 
     "find all N such that  member(N, T)  holds
      and save them in list  Ans"  */
hasElements(T, Ans) :- findall(N, member(N, T), Ans).

/* try me:  ?- makeTree([3,1,5,4,2], T), hasElements(T, Elems).  */


/* Here is an ML-style definition:  
   elements(T, L)  holds true when  L  is a list of all the ints
    held within tree  T  */
elements(leaf, []).
elements(node(V, Left, Right), AnsList) :- elements(Left, L),
                                           elements(Right, R),
                                           append(L, [V], Half),
                                           append(Half, R, AnsList).
/* NOTE:  append(L1, L2, M)  is a built-in predicate
   that holds true when  M == L1 @ L2.  */

/* try me:  ?- makeTree([3,1,5,4,2], T), elements(T, Elems).  */


/* Here is an ML-style definition of  member:
   found(M, T)  asserts that  M  is found in ordered tree  T  */
found(M, node(N, Left, Right)) :-  M = N.
found(M, node(N, Left, Right)) :-  M < N, found(M, Left).
found(M, node(N, Left, Right)) :-  M > N, found(M, Right).


