
(** Basic Operations on Trees, Copyright 1990, Wolfram Research, Inc. **)

(* Trees are represented as nested list structures, with each node having
the form {label, child1, child2, ...}. *)

BeginPackage["DiscreteMath`Tree`"]

MakeTree::usage =
	"MakeTree[list] creates a binary tree with each node labeled
	by an element in list."

TreeFind::usage =
	"TreeFind[treelist, x] finds the smallest element larger than x in
	the list from which treelist was constructed."

TreePlot::usage =
	"TreePlot[treelist] generates a graphical representation of a tree."

ExprPlot::usage =
	"ExprPlot[expr] generates a graphical representation of an
	expression, viewed as a tree."

Begin["`private`"]

MakeTree[list_List] := Block[{n, t},
		n = Length[list];
		t = Transpose[{Sort[list], Range[n]}] ;
		MakeTree0[ 1,n ] 
		]

MakeTree0[i_,j_] := Block[{midpoint,diff},
	diff = j-i;
	Which[
	   diff==3, {t[[i+1]],{t[[i]],{},{}},{t[[i+2]],{},{t[[i+3]],{},{}}}},
	   diff==2, {t[[i+1]],{t[[i]],{},{}},{t[[j]],{},{}}},
	   diff==1, {t[[i]],{},{t[[j]],{},{}}},
	   diff==0, {t[[i]],{},{}},
	   True, (
			midpoint = i + Quotient[diff,2];
			{t[[midpoint]], 
				MakeTree0[i,midpoint-1],
				MakeTree0[midpoint+1,j]}
		 )
	   ]]


TreeFind[tree_List, e_] := Block[{found=0, bar=e},
        TreeFind0[tree]; found]

TreeFind0[tree_] :=
        Block[{m, k},
        {m, k} = First[tree] ;
        Which[
              bar < m, TreeFind0[tree[[2]]],
              bar > m, found = k ;TreeFind0[tree[[3]]],
              True, found = k; Return[]
        ]]

TreeFind0[{}] = 1


$TreeWidth = 2.1
$TreeHeight = 0.8

TreePlot[tree_List] :=
	Show[Graphics[TreePlot0[tree, 0, 0]]]

(***

(* Case of binary trees *)

TreePlot0[{lab_, lhs_, rhs_}, x_, y_] :=
	Block[{xl, xr, gl, gr},
		xl = x - $TreeWidth^(-y) ;
		xr = x + $TreeWidth^(-y) ;
		If[lhs =!= {}, gl=TreePlot0[lhs, xl, y+1], gl={}] ;
		If[rhs =!= {}, gr=TreePlot0[rhs, xr, y+1], gr={}] ;
		Join[
			{Line[
				{{xl, y+1}, {xl, y}, {xr, y}, {xr, y+1}}]},
			gl,
			gr
		] 
	]
***)

TreePlot0[{label_, children__}, x_, y_] :=
        Block[{xl, xr, c, xi, gnew, gthis, i, dx},
                xl = x - $TreeWidth^(-y) ; 
                xr = x + $TreeWidth^(-y) ; 
		c = {children} ;
		If[Length[c] != 1, dx = N[(xr - xl)/(Length[c] - 1)]] ;
		gnew = Table[If[c[[i+1]] =!= {} && Length[c]!=1, 
    		    TreePlot0[c[[i+1]], xl + i dx, y+1],
			{} ], 
			{i, 0, Length[c]-1} ] ;
		If[Length[c] != 1,
			gthis = Table[xi = xl + i dx ;
				Line[{{xi, y}, {xi, y+1}}], 
					{i, 0, Length[c]-1}],
			gthis = {}
		] ;
		Flatten[{Line[{{xl, y}, {xr, y}}], gthis, gnew}]
        ]

ExprPlot[expr_] := Show[Graphics[ExprPlot0[expr, 0, 0, 1]]]

ExprPlot0[f_[children__], x_, y_, n_] :=
        Block[{xl, xr, c, xi, gnew, gthis, i, dx},
		c = {children} ; 
                If[Length[c]==1, 
                        Return[
				Flatten[
					{ Line[{{x, y}, {x, y+1}}] ,
					ExprPlot0[First[c], x, y+1, 1] }
				] ] ] ;
                xl = x - $TreeWidth^(-y) 2/n ; 
                xr = x + $TreeWidth^(-y) 2/n ;  
                dx = N[(xr - xl)/(Length[c] - 1)] ;
                gnew = Table[ If[!AtomQ[c[[i+1]]],
                    ExprPlot0[c[[i+1]], xl + i dx, y+1, Length[c]],
                        {} ],  
                        {i, 0, Length[c]-1} ] ; 
                gthis = Table[xi = xl + i dx ; 
                                Line[{{xi, y}, {xi, y+1}}], 
                                        {i, 0, Length[c]-1}] ;
                Flatten[{Line[{{xl, y}, {xr, y}}], gthis, gnew}]
        ]

ExprPlot0[e_, x_, y_, n_] := {}

End[]
EndPackage[]
