home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e032 / 3.ddi / FILES / DISCRETE.PAK / TREE.M < prev   
Encoding:
Text File  |  1992-07-29  |  3.6 KB  |  135 lines
  1.  
  2. (** Basic Operations on Trees, Copyright 1990, Wolfram Research, Inc. **)
  3.  
  4. (* Trees are represented as nested list structures, with each node having
  5. the form {label, child1, child2, ...}. *)
  6.  
  7. BeginPackage["DiscreteMath`Tree`"]
  8.  
  9. MakeTree::usage =
  10.     "MakeTree[list] creates a binary tree with each node labeled
  11.     by an element in list."
  12.  
  13. TreeFind::usage =
  14.     "TreeFind[treelist, x] finds the smallest element larger than x in
  15.     the list from which treelist was constructed."
  16.  
  17. TreePlot::usage =
  18.     "TreePlot[treelist] generates a graphical representation of a tree."
  19.  
  20. ExprPlot::usage =
  21.     "ExprPlot[expr] generates a graphical representation of an
  22.     expression, viewed as a tree."
  23.  
  24. Begin["`private`"]
  25.  
  26. MakeTree[list_List] := Block[{n, t},
  27.         n = Length[list];
  28.         t = Transpose[{Sort[list], Range[n]}] ;
  29.         MakeTree0[ 1,n ] 
  30.         ]
  31.  
  32. MakeTree0[i_,j_] := Block[{midpoint,diff},
  33.     diff = j-i;
  34.     Which[
  35.        diff==3, {t[[i+1]],{t[[i]],{},{}},{t[[i+2]],{},{t[[i+3]],{},{}}}},
  36.        diff==2, {t[[i+1]],{t[[i]],{},{}},{t[[j]],{},{}}},
  37.        diff==1, {t[[i]],{},{t[[j]],{},{}}},
  38.        diff==0, {t[[i]],{},{}},
  39.        True, (
  40.             midpoint = i + Quotient[diff,2];
  41.             {t[[midpoint]], 
  42.                 MakeTree0[i,midpoint-1],
  43.                 MakeTree0[midpoint+1,j]}
  44.          )
  45.        ]]
  46.  
  47.  
  48. TreeFind[tree_List, e_] := Block[{found=0, bar=e},
  49.         TreeFind0[tree]; found]
  50.  
  51. TreeFind0[tree_] :=
  52.         Block[{m, k},
  53.         {m, k} = First[tree] ;
  54.         Which[
  55.               bar < m, TreeFind0[tree[[2]]],
  56.               bar > m, found = k ;TreeFind0[tree[[3]]],
  57.               True, found = k; Return[]
  58.         ]]
  59.  
  60. TreeFind0[{}] = 1
  61.  
  62.  
  63. $TreeWidth = 2.1
  64. $TreeHeight = 0.8
  65.  
  66. TreePlot[tree_List] :=
  67.     Show[Graphics[TreePlot0[tree, 0, 0]]]
  68.  
  69. (***
  70.  
  71. (* Case of binary trees *)
  72.  
  73. TreePlot0[{lab_, lhs_, rhs_}, x_, y_] :=
  74.     Block[{xl, xr, gl, gr},
  75.         xl = x - $TreeWidth^(-y) ;
  76.         xr = x + $TreeWidth^(-y) ;
  77.         If[lhs =!= {}, gl=TreePlot0[lhs, xl, y+1], gl={}] ;
  78.         If[rhs =!= {}, gr=TreePlot0[rhs, xr, y+1], gr={}] ;
  79.         Join[
  80.             {Line[
  81.                 {{xl, y+1}, {xl, y}, {xr, y}, {xr, y+1}}]},
  82.             gl,
  83.             gr
  84.         ] 
  85.     ]
  86. ***)
  87.  
  88. TreePlot0[{label_, children__}, x_, y_] :=
  89.         Block[{xl, xr, c, xi, gnew, gthis, i, dx},
  90.                 xl = x - $TreeWidth^(-y) ; 
  91.                 xr = x + $TreeWidth^(-y) ; 
  92.         c = {children} ;
  93.         If[Length[c] != 1, dx = N[(xr - xl)/(Length[c] - 1)]] ;
  94.         gnew = Table[If[c[[i+1]] =!= {} && Length[c]!=1, 
  95.                 TreePlot0[c[[i+1]], xl + i dx, y+1],
  96.             {} ], 
  97.             {i, 0, Length[c]-1} ] ;
  98.         If[Length[c] != 1,
  99.             gthis = Table[xi = xl + i dx ;
  100.                 Line[{{xi, y}, {xi, y+1}}], 
  101.                     {i, 0, Length[c]-1}],
  102.             gthis = {}
  103.         ] ;
  104.         Flatten[{Line[{{xl, y}, {xr, y}}], gthis, gnew}]
  105.         ]
  106.  
  107. ExprPlot[expr_] := Show[Graphics[ExprPlot0[expr, 0, 0, 1]]]
  108.  
  109. ExprPlot0[f_[children__], x_, y_, n_] :=
  110.         Block[{xl, xr, c, xi, gnew, gthis, i, dx},
  111.         c = {children} ; 
  112.                 If[Length[c]==1, 
  113.                         Return[
  114.                 Flatten[
  115.                     { Line[{{x, y}, {x, y+1}}] ,
  116.                     ExprPlot0[First[c], x, y+1, 1] }
  117.                 ] ] ] ;
  118.                 xl = x - $TreeWidth^(-y) 2/n ; 
  119.                 xr = x + $TreeWidth^(-y) 2/n ;  
  120.                 dx = N[(xr - xl)/(Length[c] - 1)] ;
  121.                 gnew = Table[ If[!AtomQ[c[[i+1]]],
  122.                     ExprPlot0[c[[i+1]], xl + i dx, y+1, Length[c]],
  123.                         {} ],  
  124.                         {i, 0, Length[c]-1} ] ; 
  125.                 gthis = Table[xi = xl + i dx ; 
  126.                                 Line[{{xi, y}, {xi, y+1}}], 
  127.                                         {i, 0, Length[c]-1}] ;
  128.                 Flatten[{Line[{{xl, y}, {xr, y}}], gthis, gnew}]
  129.         ]
  130.  
  131. ExprPlot0[e_, x_, y_, n_] := {}
  132.  
  133. End[]
  134. EndPackage[]
  135.