(* :Name: DiscreteMath`Tree` *)

(* :Context: DiscreteMath`Tree` *)

(* :Author: Wolfram Research, Inc. *)

(* :Mathematica Version: 2.0 *)

(* :Package Version: 1.1 *)

(* :Title: Basic Operations on Trees *)

(* :Copyright: Copyright 1990-1999,  Wolfram Research, Inc. *)

(* :Summary:
This package introduces functions for creating, searching and
displaying trees represented as nested lists.
*)

(* :Discussion:
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 largest element smaller than or equal to 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[{}] := {}

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[{}, e_] := 0

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[{}] := Show[Graphics[{}]]

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[]
