/* From: prolog tutorial  2.6  Tree data and relations */ 

:- dynamic(parent/2,root/1,is_parent/2,is_root/1).


/* The tree database */ 
:- op(500,xfx,(is_parent)). 
parent(X,Y) :- X is_parent Y.

c is_parent g.     f is_parent l.     j is_parent q. 
c is_parent h.     f is_parent m.     j is_parent r. 
c is_parent i.     h is_parent n.     j is_parent s. 
b is_parent e.    d is_parent j.     i is_parent o.     m is_parent t. 
b is_parent f.    e is_parent k.     i is_parent p. 

ar is_parent cr.

/*
a is_parent b.    c is_parent g.     f is_parent l.     j is_parent q. 
a is_parent c.    c is_parent h.     f is_parent m.     j is_parent r. 
a is_parent d.    c is_parent i.     h is_parent n.     j is_parent s. 
b is_parent e.    d is_parent j.     i is_parent o.     m is_parent t. 
b is_parent f.    e is_parent k.     i is_parent p. 
*/

  
:- op(500,xf,(is_root)).
root(X) :- X is_root.

b is_root.
c is_root.
d is_root. 
ar is_root.

/* X and  Y are siblings  */ 
:- op(500,xfx,'is_sibling_of'). 
X is_sibling_of Y :- Z is_parent X, 
                     Z is_parent Y, 
                     X \== Y. 


:- op(500,xfx,'has_children'). 
X has_children 0 :-	leaf(X).
X has_children Y :- setof(Children, X is_parent Children, Set),
					length(Set,Y).

/* X and Y are on the same level in the tree. */ 
:-op(500,xfx,'is_same_level_as'). 
X is_same_level_as  X .          
X is_same_level_as  Y :- W is_parent X, 
                         Z is_parent Y, 
                         W is_same_level_as Z. 
 
/* Depth of node in the tree. */ 
:- op(500,xfx,'has_depth'). 
X has_depth 0 :- X is_root. 
Node has_depth D :- Parent is_parent Node, 
                    Parent has_depth D1,   
                    D is D1 + 1.
					 
/* Locate node by finding a path from root down to the node. */ 
locate(Node) :- path(Node), 
                write(Node), 
                nl. 
path(X) :-	X is_root.                /* Can start at a root. */ 
path(Node) :- Mother is_parent Node,  /* Choose parent,       */ 
              path(Mother),           /*  find path and then  */ 
              write(Mother), 
              write(' --> '). 
 
/*  Calculate the height of a node, length of longest  path to */ 
/*  a leaf under the node.   */ 
height(N,H) :- setof(Z,ht(N,Z),Set),  /* See section 2.8 for 'setof'.  */ 
               max(Set,0,H). 
 
ht(Node,0) :- leaf(Node). 
ht(Node,H) :- Node is_parent Child, 
              ht(Child,H1), 
              H is H1 +1. 
			  
completeheight(N,0) :-	leaf(N), !.
completeheight(N,H) :- 	N is_parent Child,
						!,
						completeheight(Child,H1),
						H is H1 + 1.
/* Leaf */
leaf(Node) :-	_ is_parent Node, \+ Node is_parent _2.
				 
/* Set are the children on Node */
:- op(500,xfx,'areChildrenOf'). 
[] areChildrenOf Node :- leaf(Node).
Set areChildrenOf Node :-	setof(Child,Node is_parent Child,Set).

:- op(500,xfx,'nodeOfTree'). 
X nodeOfTree Y :-	X == Y.
X nodeOfTree Y :-	C areChildrenOf Y,
					member(Z,C),
					X nodeOfTree Z.

allnodes(List) :-	setof(X,(X nodeOfTree Y, Y is_root),List).

/* Find how many nodes the tree has: */
:-op(500,xfx,'has_nodes').
X has_nodes 1 :-	leaf(X).
X has_nodes Y :-	setof(Child,X is_parent Child, Set),
					lambda(Set,Count), /*Apply for each memeber of Set*/
					sum_list(Count,S),
					Y is S + 1.

/* Return in the second list, the result of the Goal applied to */
/* Each element of the first list */
lambda([],[]).
lambda([X1|X],[Y1|Y]) :- X1 has_nodes Y1,lambda(X,Y).
 
/* Topological Distance: */
:- op(500,xfx,'subtree'). 

T1 subtree T2 :- /*	write(T1),write('-'),write(T2),write('\n'), */
					T1 has_children N1, T2 has_children N2, N1 =< N2,
/*					write('N:'),write(N1),write('-'),write(N2),write('\n'),*/
				/*	write(T1),write('--'),write(T2),write('\n'),*/
					height(T1,H1), height(T2,H2), H1 =< H2,
/*					write('H:'),write(H1),write('-'),write(H2),write('\n'),*/
				/*	write(T1),write('---'),write(T2),write('\n'),*/
					T1 has_nodes To1, T2 has_nodes To2, To1 =< To2,
/*					write('To:'),write(To1),write('-'),write(To2),write('\n'),*/
				/*	write(T1),write('----'),write(T2),write('\n'),*/
					C1 areChildrenOf T1, C2 areChildrenOf T2,
					mapSets(C1,C2).
					
mapSets([],_) :-	true,!.
mapSets(Set1,Set2) :- 	permutation(Set1,P1),permutation(Set2,P2),
						lambda2(P1,P2),
						!.

lambda2([],_).
lambda2([X1|X],[Y1|Y]) :- X1 subtree Y1,lambda2(X,Y).
 
max([],M,M). 
max([X|R],M,A) :- (X > M -> max(R,X,A) ; max(R,M,A)). 

commonSupertree([],_).
commonSupertree([T1|TN],T) :- 	T1 subtree T,
								commonSupertree(TN,T).
								
:- op(500,xfx,'contractionOf'). 
X contractionOf Y :-	X subtree Y,
						X has_nodes NX, Y has_nodes NY, NX < NY.
					
printTree(X) :- write('$'),
				C areChildrenOf X,
				printChildren(C),
				write('^').
				
printChildren([]):- !.
printChildren([H|T]) :- 	printTree(H),
							printChildren(T), !.

sumIs(X,N) :- sumIs(X,N,N).
sumIs([],0,_).
sumIs([X|Y],N,M) :-	for(X,1,M),
					N1 is N-X,
					N1 > -1,
					sumIs(Y,N1,X).

tttest([],[]):-!.
tttest([RX|RY],[X|Y]) :- sumIs(RX,X),tttest(RY,Y).

/*knode([],_).*/
knode(K,H) :- K1 is K-1, H1 is H-1, sumIs(C,K1),
			write([C,H1]),
			aknode(C,H1),
			nl.
			
aknode([],_).
aknode([X|T],H) :- knode(X,H),aknode(T,H),!.

createBalancedTree([],_):- !.
createBalancedTree([RootDegree|DegreeList],Tree) :-
	new_atom(Tree),
	for(_,1,RootDegree),
		createBalancedTree(DegreeList,Child),
		asserta( Tree is_parent Child),
	Tree has_children RootDegree.
	
deleteTree(Tree) :-
	Tree is_parent X,
	retract(Tree is_parent X),
	deleteTree(X).

/*
createSpecialTree(1,Card,Degree,Tree) :-
	Card >=2,
	Card is Card -1,
	Degree =:= Card,
	new_atom(Tree),
	for(_,1,Card),
		new_atom(Child),
		asserta( Tree is_parent Child),
	Tree has_children Card,
	!.
	
createSpecialTree(Height,Card,Degree,Tree) :-
	Card >= Degree*Height,
	Card is Card -1,
	new_atom(Tree),
	for(_,Degree,
*/