BeginPackage["CSM`BinaryTree`"]

emptyTree::usage = "emptyTree gives an empty binary tree."
node::usage = "node[info, left, right] gives a binary tree with info at the
	root and given left and right subtrees."
information::usage = "information[tree] gives the information at the root of tree."
leftTree::usage = "leftTree[tree] gives the left subtree."
rightTree::usage = "rightTree[tree] gives the right subtree."

insertTree::usage = "insertTree[tree, info, Key] inserts a node with given information into tree."

searchTree::usage = "searchTree[tree, key, Key] gives the information whose key field is equal to key."

deleteTree::usage = "deleteTree[tree, key, Key] deletes a node
	with given key in tree."

Tree::usage = "Tree[list, Key] builds a tree from the elements of list."

inOrder::usage = "inOrder[tree] gives the list of all information fields in inorder."
preOrder::usage = "preOrder[tree] gives the list of all information fields in preorder."
postOrder::usage = "postOrder[tree] gives the list of all information fields in postorder."

depth::usage = "depth[tree] gives the depth of tree."

plotTree::usage = "plotTree[tree] draws a diagram of tree."

`tree

Begin["`Private`"]

node[info_, left_, right_] := tree[info, left, right]
leftTree[tree[_, left_, _]] := left
rightTree[tree[_, _, right_]] := right
information[tree[info_, _, _]] := info

(* Insertion *)

insertTree[emptyTree, info_, Key_:Identity] :=
        node[info, emptyTree, emptyTree]

insertTree[tree_, info_, Key_:Identity] /;
    Order[Key[info], Key[information[tree]]] == 0 := tree

(* insert into left subtree, if smaller *)

insertTree[tree_, info_, Key_:Identity] /;
    Order[Key[info], Key[information[tree]]] > 0 :=
        node[ information[tree],
              insertTree[leftTree[tree], info, Key],
              rightTree[tree]
            ]

(* else must come right *)

insertTree[tree_, info_, Key_:Identity] :=
        node[ information[tree],
              leftTree[tree],
              insertTree[rightTree[tree], info, Key]
            ]

(* Search, gives Null if not found *)

searchTree[ emptyTree, key_, Key_:Identity ] := Null

searchTree[ tree_, key_, Key_:Identity ] /;
    Order[ Key[information[tree]], key ] == 0 := information[ tree ]

searchTree[ tree_, key_, Key_:Identity ] /;
    Order[ Key[information[tree]], key ] < 0 :=
        searchTree[ leftTree[tree], key, Key ]

searchTree[ tree_, key_, Key_:Identity ] :=
        searchTree[ rightTree[tree], key, Key ]

(* Format[b_tree] := "-binary tree-" *)


(* Traversals *)

inOrder[tree_] :=
    Flatten[ traversal[tree,
        traversal[leftTree[#1], ##2]&,
        information,
        traversal[rightTree[#1], ##2]&
    ]]
preOrder[tree_] :=
    Flatten[ traversal[tree,
        information,
        traversal[leftTree[#1], ##2]&,
        traversal[rightTree[#1], ##2]&
    ]]
postOrder[tree_] :=
   Flatten[ traversal[tree,
        traversal[leftTree[#1], ##2]&,
        traversal[rightTree[#1], ##2]&,
        information
   ]]

traversal[emptyTree, ___] := {}
traversal[tree_, one_, two_, three_] :=
        {  one[tree, one, two, three],
           two[tree, one, two, three],
         three[tree, one, two, three]}

(* Deletion *)

deleteTree[emptyTree, key_, Key_:Identity ] := emptyTree

deleteTree[ tree_, key_, Key_:Identity ] /;
    Order[ Key[information[tree]], key ] < 0 :=
        node[ information[tree],
              deleteTree[leftTree[tree], key, Key],
              rightTree[tree]
        ]

deleteTree[ tree_, key_, Key_:Identity ] /;
    Order[ Key[information[tree]], key ] > 0 :=
        node[ information[tree],
              leftTree[tree],
              deleteTree[rightTree[tree], key, Key]
        ]

(* delete root *)

deleteTree[ tree_, key_, Key_:Identity ] /;
    leftTree[tree] == emptyTree := rightTree[tree]
	
deleteTree[ tree_, key_, Key_:Identity ] /;
    rightTree[tree] == emptyTree := leftTree[tree]

(* general case *)

deleteTree[ tree_, key_, Key_:Identity ] := 
        With[{nextinfo = smallestNode[ rightTree[tree] ]},
             node[ nextinfo,
                   leftTree[tree],
                   deleteTree[rightTree[tree], Key[nextinfo], Key]
             ]
        ]

smallestNode[emptyTree] = Null
smallestNode[tree_] /; leftTree[tree] === emptyTree := information[tree]
smallestNode[tree_] := smallestNode[ leftTree[tree] ]

(* Depth *)

depth[emptyTree] := 0
depth[tree_] := 1 + Max[ depth[leftTree[tree]], depth[rightTree[tree]] ]

Tree[l_List, Key_:Identity] :=
    Fold[ Function[{t, i}, insertTree[t, i, Key]], emptyTree, l ]

(* Graphics *)

diskr = 0.4
maxnode = 7
margin = 0.5
diskbg = 0.85
ys = 1

plot0[ emptyTree, stufe_, nextx_ ] := {nextx, nextx+1, {}}
plot0[ tree_, stufe_, nextx_ ] :=
	Module[{wx, nextl, nextr, wl, wr, gl, gr, g = {}},
		If[ leftTree[tree] =!= emptyTree,
		    {wl, nextl, gl} = plot0[leftTree[tree], stufe-1, nextx];
		     wx = nextl;
		     AppendTo[g, Line[{ {wl, ys(stufe-1)}, {wx, ys stufe} }]];
		     AppendTo[g, gl],
		    (* else *) wx = nextx
		];
		If[ rightTree[tree] =!= emptyTree,
		    {wr, nextr, gr} = plot0[rightTree[tree], stufe-1, wx+1];
		     AppendTo[g, Line[{ {wr, ys(stufe-1)}, {wx, ys stufe} }]];
		     AppendTo[g, gr],
		   (* else *) nextr = wx+1
		];
		g = Join[g,
			{ {GrayLevel[diskbg], Disk[ {wx, ys stufe}, diskr ]},
			  Circle[{wx, ys stufe}, diskr ],
			  Text[ information[tree], {wx, ys stufe} ]
			} ];
		{wx, nextr, g}
	]

plotTree[ tree_, opts___ ] :=
	Module[{wx, nextx, g, x0, x1},
		{wx, nextx, g} = plot0[tree, 0, 0];
		g = Prepend[ g, Line[{{wx, 0}, {wx, ys}}] ];
		If[ nextx > maxnode,
			{x0, x1} = {0, nextx-1},
			{x0, x1} = {0 - (maxnode-(nextx-1))/2,
			            nextx-1 + (maxnode-(nextx-1))/2}];
		Show[ Graphics[g], opts, AspectRatio->Automatic,
		      PlotRange->{{x0-margin, x1+margin}, All} ]
	]

End[]

EndPackage[]
