]> git.rkrishnan.org Git - yorgey.git/blob - misc/monoids.hs
hw12: exercise 4
[yorgey.git] / misc / monoids.hs
1 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
2 module Monoids where
3
4 import Data.Monoid
5
6 data Tree a = Empty
7             | Node (Tree a) a (Tree a)
8               deriving (Eq, Show)
9
10 leaf :: a -> Tree a
11 leaf x = Node Empty x Empty
12
13 treeSize :: Tree a -> Integer
14 treeSize Empty = 0
15 treeSize (Node l _ r) = 1 + treeSize l + treeSize r
16
17 treeSum :: Tree Integer -> Integer
18 treeSum Empty = 0
19 treeSum (Node l x r) = x + treeSum l + treeSum r
20
21 treeDepth :: Tree a -> Integer
22 treeDepth Empty = 0
23 treeDepth (Node l _ r) = 1 + max (treeDepth l) (treeDepth r)
24
25 flatten :: Tree a -> [a]
26 flatten Empty = []
27 flatten (Node l x r) = flatten l ++ [x] ++ flatten r
28
29 -- treeFold
30 -- 0. empty case value
31 -- 1. type of the return value.
32 -- 2. how to combine the recursive calls.
33
34 treeFold :: b -> (b -> a -> b -> b) -> Tree a -> b
35 treeFold e _ Empty = e
36 treeFold e f (Node l x r) = f (treeFold e f l) x (treeFold e f r)
37
38 treeSize' :: Tree a -> Integer
39 treeSize' = treeFold 0 (\l _ r -> 1 + l + r)
40
41 treeSum' :: Tree Integer -> Integer
42 treeSum' = treeFold 0 (\l x r -> x + l + r)
43
44 treeDepth' :: Tree a -> Integer
45 treeDepth' = treeFold 0 (\l _ r -> 1 + max l r)
46
47 flatten' :: Tree a -> [a]
48 flatten' = treeFold [] (\l x r -> l ++ [x] ++ r)
49
50 -- monoids
51 newtype Sum' a = Sum' a
52     deriving (Eq, Num, Ord, Show)
53
54 getSum :: Sum' a -> a
55 getSum (Sum' x) = x
56
57 instance Num a => Monoid (Sum' a) where
58   mempty = 0
59   mappend = (+)
60
61 newtype Prod' a = Prod' a
62     deriving (Eq, Num, Ord, Show)
63
64 getProd :: Prod' a -> a
65 getProd (Prod' x) = x
66
67 instance Num a => Monoid (Prod' a) where
68   mempty = 1
69   mappend = (*)
70
71 lst :: [Integer]
72 lst = [1,5,8,23,423,99]
73
74 prod :: Integer
75 prod = getProd . mconcat . map Prod' $ lst