misc/monoids.hs

   1 module Monoids where
   2
   3 import Data.Monoid
   4
   5 data Tree a = Empty
   6             | Node (Tree a) a (Tree a)
   7               deriving (Eq, Show)
   8
   9 leaf :: a -> Tree a
  10 leaf x = Node Empty x Empty
  11
  12 treeSize :: Tree a -> Integer
  13 treeSize Empty = 0
  14 treeSize (Node l _ r) = 1 + treeSize l + treeSize r
  15
  16 treeSum :: Tree Integer -> Integer
  17 treeSum Empty = 0
  18 treeSum (Node l x r) = x + treeSum l + treeSum r
  19
  20 treeDepth :: Tree a -> Integer
  21 treeDepth Empty = 0
  22 treeDepth (Node l _ r) = 1 + max (treeDepth l) (treeDepth r)
  23
  24 flatten :: Tree a -> [a]
  25 flatten Empty = []
  26 flatten (Node l x r) = flatten l ++ [x] ++ flatten r
  27
  28 -- treeFold
  29 -- 0. empty case value
  30 -- 1. type of the return value.
  31 -- 2. how to combine the recursive calls.
  32
  33 treeFold :: b -> (b -> a -> b -> b) -> Tree a -> b
  34 treeFold e _ Empty = e
  35 treeFold e f (Node l x r) = f (treeFold e f l) x (treeFold e f r)
  36
  37 treeSize' :: Tree a -> Integer
  38 treeSize' = treeFold 0 (\l _ r -> 1 + l + r)
  39
  40 treeSum' :: Tree Integer -> Integer
  41 treeSum' = treeFold 0 (\l x r -> x + l + r)
  42
  43 treeDepth' :: Tree a -> Integer
  44 treeDepth' = treeFold 0 (\l _ r -> 1 + max l r)
  45
  46 flatten' :: Tree a -> [a]
  47 flatten' = treeFold [] (\l x r -> l ++ [x] ++ r)
  48