control-monad-queue-0.0.9: tests/BinaryTree.hs

{-# OPTIONS_GHC -O2 -fasm #-}

module BinaryTree where

import Data.Ratio(Ratio, (%), numerator, denominator)


data  Tree a b
   =  Leaf    a
   |  Branch  b (Tree a b) (Tree a b)
      deriving (Eq,Show)

childrenOf :: Tree a b ->  [Tree a b]
childrenOf (Leaf    _      )  =   []
childrenOf (Branch  _ l r  )  =   [l,r]

fold :: (a -> c) -> (b -> c -> c -> c) -> Tree a b -> c
fold leaf branch = loop
    where
       loop (Leaf    a      ) = leaf a
       loop (Branch  b l r  ) = branch b (loop l) (loop r)

labelDisj :: (a -> c) -> (b -> c) -> Tree a b -> c
labelDisj leaf branch (Leaf    a      ) = leaf    a
labelDisj leaf branch (Branch  b _ _  ) = branch  b



fib n = fibs !! (n - 1)
  where
    fibs = Leaf 0 : Leaf 0 : zipWith3 Branch [1..] fibs (tail fibs)

sternBrocot :: Tree a (Ratio Integer)
sternBrocot = loop 0 1 1 0
   where
     loop a b x y
         = Branch (m%n) (loop a b m n) (loop m n x y)
           where
             m  = a + x
             n  = b + y

toTikzString maxdepth branch leaf t = "  \\" ++ loop 0 t ";\n"
  where
    loop n t str
      | n < maxdepth
      = case t of
         (Leaf a) -> "node {" ++ leaf a ++ "}" ++ str
         (Branch b l r) -> "node {" ++ branch b ++ "}\n"
                        ++ replicate (7*n+3) ' ' ++ "child {"
                        ++ loop (n+1) l ("}\n" ++ replicate (7*n+3) ' '
                                         ++ "child {" ++ (loop (n+1) r ("}" ++ str)))
      | otherwise
      = case t of
          (Leaf a) -> "node {" ++ leaf a ++ "}" ++ str
          (Branch b _l _r) -> "node {" ++ branch b ++ "} child {} child {}" ++ str

toFrac x = "$\\frac{" ++ show (numerator x) ++ "}{" ++ show (denominator x) ++ "}$"