1:- module(tree, 
    2	[	print_tree/1
    3	,	print_tree/2
    4	,	empty_tree/2
    5	,	tree_node/2
    6	,	tree_canonical/2
    7	,	maptree/2
    8	,	maptree/3
    9	,	node_label/2
   10	,	node_children/2
   11	,	tree_cursor/2
   12	,	tree_depth/2
   13	,	cursor_node/2
   14	,	cursor_move/3
   15	,	cursor_add_sibling/3
   16	,	cursor_ins_sibling/3
   17	,	cursor_ins_child/3
   18	,	get_node/3
   19	,	set_node/3
   20	]).   21
   22:- meta_predicate maptree(1,?), maptree(2,?,?).

tree(A) ---> node(A, list(tree(A))).

 empty_tree(?N:A, ?T:tree(A)) is det

Unify T with a root node tree containing N.

   40empty_tree(A,node(A,[])).

 tree_node(+T:tree(A), -N:tree(A)) is nondet

Unifies N with all the nodes in a tree.

   45tree_node(T,T).
   46tree_node(node(_,NX),N) :- member(T,NX), tree_node(T,N).

 node_label(+N:tree(A), -X:A) is det

   49node_label(node(A,_),A).

 node_children(+N:tree(A), -C:list(tree(A))) is det

   52node_children(node(_,C),C).

 maptree(P:pred(?(X:A)), ?TA:tree(A)) is nondet

 maptree(P:pred(?(X:A),?(Y:B)), ?TA:tree(A), ?TB:tree(B)) is nondet

Map over tree using unary or binary predicate P.

   59maptree(P,node(A,AX)) :- call(P,A), maplist(maptree(P),AX).
   60maptree(P,node(A,AX),node(B,BX)) :- call(P,A,B), maplist(maptree(P),AX,BX).

 tree_depth(+T1:tree(_), -D:natural) is det

Maximum depth of tree.

   66tree_depth(node(_,[]),0).
   67tree_depth(node(_,[C1|CX]),N) :-
   68	maplist(tree_depth,[C1|CX],DX),
   69	foldl(max,DX,0,M),
   70	succ(M,N).
   71
   72
   73max(L,M,N) :- N is max(L,M).

 tree_canonical(+T1:tree(A), -T2:tree(A)) is det

Construct canonical form of a given trie by sorting all children into standard order.

   77tree_canonical(node(D,CX1),node(D,CX3)) :-
   78	sort(CX1,CX2), maplist(tree_canonical,CX2,CX3).
   79
   80
   81print_node(NA,T,T2) :-
   82	with_output_to(string(AA),print(node(NA))), string_length(AA,L),
   83	with_output_to(string(SA),tab(L)), string_concat(T,SA,T2),
   84	write(AA). 

 print_tree(+T:tree(A)) is det

 print_tree(+Pre:atom, +T:tree(A)) is det

Prints a drawing of the tree. It uses unicode box-drawing characters to draw the edges so your terminal must be set-up correctly to show these properly. A node with data X is labeled with whatever print(node(X)) produces and so can be customised by declaring clauses of portray/1. If the prefix Pre is supplied, the tree is started at the current position in the output stream, but subsequent new lines are prefixed with Pre, to allow arbitrary indenting.

If the child list for any node is a frozen variable, the variable is unfrozen.

  100print_tree(T) :- write(' '), print_tree(' ',T), nl. 
  101print_tree(_,V) :- var(V), !, write('_').
  102print_tree(T,node(NA,CX)) :-
  103	print_node(NA,T,T2),
  104	unfreeze_list(CX),
  105	print_subtree(T2,first,CX).
  106
  107print_subtree(_,first,CX) :- var(CX), !, write('\u2500').
  108print_subtree(_,_,Z) :- (var(Z);Z=[]), !.
  109
  110print_subtree(T,first,[C1|CX]) :- 
  111	write_symbols(first,CX),
  112	print_subtree_x(T,C1,CX).
  113
  114print_subtree(T,rest,[C1|CX]) :- 
  115	nl, write(T), write_symbols(rest,CX),
  116	print_subtree_x(T,C1,CX).
  117
  118print_subtree_x(T,C1,CX) :-
  119	list_prefix(CX,T,T2),
  120	print_tree(T2,C1), 
  121	print_subtree(T,rest,CX).
  122
  123write_symbols(first,V) :- nonvar(V), V=[], !, write('\u2500\u2500\u2500').
  124write_symbols(rest,V)  :- nonvar(V), V=[], !, write(' \u2514\u2500').
  125write_symbols(first,_) :- write('\u2500\u252C\u2500').
  126write_symbols(rest,_)  :- write(' \u251C\u2500').
  127
  128list_prefix(V,T,T2) :- (var(V);V=[]), !, atom_concat(T,'   ',T2).
  129list_prefix(_,T,T2) :- atom_concat(T,' \u2502 ',T2).
  130
  131unfreeze_list(X) :- 
  132	frozen(X,G), 
  133	(G=true->true;(X=[_|_];X=[])).

 tree_cursor(+T:tree(A), -C:cursor(A)) is det

Constructs a cursor representing the given tree and a current position within that tree. Uses a zipper-like data type, as described in the functional programming literature. Initial position is the root node.

  140tree_cursor(Root,  cursor(Root,top)).

 get_node(-N:tree(A))// is det

Gets the subtree N at the current cursor position.

  145get_node(N,cursor(N,P),cursor(N,P)).

 set_node(+N:tree(A))// is det

Replaces the subtree at the current cursor with N.

  149set_node(N,cursor(_,P),cursor(N,P)).

 cursor_node(+C:cursor(A), -N:tree(A)) is det

Relation between a cursor and the subtree at the current position.

  154cursor_node(cursor(N,_),N).

 cursor_move(+Dir:oneof([down,up,left,right]), +C1:cursor(A), -C2:cursor(A)) is semidet

Move a cursor around the tree. Dir can be one of:

• up - move to the parent of the current node if not at the root already.
• down - move to the current node's first child if it exists.
• right - move to the current node's next sibling if there is one.
• left - move to the previous sibling if not already the first.

  164cursor_move(down,  cursor(node(D,[C1|CX]),Path),     cursor(C1,point(Path,D,[],CX))).
  165cursor_move(right, cursor(N,point(Up,D,LX,[R|RX])),  cursor(R,point(Up,D,[N|LX],RX))).
  166cursor_move(left,  cursor(N,point(Up,D,[L|LX],RX)),  cursor(L,point(Up,D,LX,[N|RX]))).
  167cursor_move(up,    cursor(N,point(Up,D,Left,Right)), cursor(node(D,CX),Up)) :- 
  168	rev_append(Left,[N|Right],CX).

 cursor_add_sibling(?N:tree(A), +C1:cursor(A), -C2:cursor(A)) is det

Add a N sibling after the current node and move the cursor to it.

  173cursor_add_sibling(M, cursor(N,point(Up,D,LX,RX)), cursor(M,point(Up,D,[N|LX],RX))).

 cursor_ins_sibling(?N:tree(A), +C1:cursor(A), -C2:cursor(A)) is det

Insert a sibling N before the current node and move the cursor to it.

  179cursor_ins_sibling(M, cursor(N,point(Up,D,LX,RX)), cursor(M,point(Up,D,LX,[N|RX]))).

 cursor_ins_child(?N:tree(A), +C1:cursor(A), -C2:cursor(A)) is det

Insert a child of the current node as first in the list of children and move down to the newly inserted node.

  185cursor_ins_child(M,   cursor(node(X,CX),Path),     cursor(M,point(Path,X,[],CX))).
  186
  187rev_append([],RX,RX).
  188rev_append([L|LX],RX,LR) :- rev_append(LX,[L|RX],LR)