home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / gofer230.zip / Progs / Gofer / Demos / tree.gs < prev   
Text File  |  1994-06-23  |  2KB  |  53 lines
  1. -- Here are a collection of fairly standard functions for manipulating
  2. -- one form of binary trees
  3.  
  4. data Tree a = Lf a | Tree a :^: Tree a
  5.  
  6. reflect t@(Lf x)  = t
  7. reflect (l:^:r)   = r :^: l
  8.  
  9. mapTree f (Lf x)  = Lf (f x)
  10. mapTree f (l:^:r) = mapTree f l :^: mapTree f r
  11.  
  12. -- Functions to calculate the list of leaves on a tree:
  13.  
  14. leaves, leaves'  :: Tree a -> [a]
  15.  
  16. leaves (Lf l)     = [l]                     -- direct version
  17. leaves (l:^:r)    = leaves l ++ leaves r
  18.  
  19. leaves' t         = leavesAcc t []          -- using an accumulating parameter
  20.                     where leavesAcc (Lf l)  = (l:)
  21.                           leavesAcc (l:^:r) = leavesAcc l . leavesAcc r
  22.  
  23. -- Picturing a tree:
  24.  
  25. drawTree :: Text a => Tree a -> String
  26. drawTree  = unlines . thd3 . pic
  27.  where pic (Lf a)  = (1,1,["-- "++show a])
  28.        pic (l:^:r) = (hl+hr+1, hl+1, top pl ++ mid ++ bot pr)
  29.                      where (hl,bl,pl) = pic l
  30.                            (hr,br,pr) = pic r
  31.                            top        = zipWith (++) (copy (bl-1) "   " ++
  32.                                                       [" ,-"] ++
  33.                                                       copy (hl-bl) " | ")
  34.                            mid        = ["-| "]
  35.                            bot        = zipWith (++) (copy (br-1) " | " ++
  36.                                                       [" `-"] ++
  37.                                                       copy (hr-br) "   ")
  38.  
  39. -- Finally, here is an example due to Richard Bird, which uses lazy evaluation
  40. -- and recursion to create a `cyclic' program which avoids multiple traversals
  41. -- over a data structure:
  42.  
  43. replaceAndMin m (Lf n)  =  (Lf m, n)
  44. replaceAndMin m (l:^:r) =  (rl :^: rr, ml `min` mr)
  45.                            where (rl,ml) = replaceAndMin m l
  46.                                  (rr,mr) = replaceAndMin m r
  47.  
  48. replaceWithMin t = mt where (mt,m) = replaceAndMin m t
  49.  
  50. sample  = (Lf 12 :^: (Lf 23 :^: Lf 13)) :^: Lf 10
  51. sample2 = sample  :^: sample
  52. sample4 = sample2 :^: sample2
  53.