1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
{-# LANGUAGE RecursiveDo #-}
-- From https://ocharles.org.uk/blog/posts/2014-12-09-recursive-do.html
import Control.Monad.Fix
data RoseTree a = RoseTree a [RoseTree a]
deriving (Show)
exampleTree :: RoseTree Int
exampleTree = RoseTree 5 [RoseTree 4 [], RoseTree 6 []]
pureMax :: Ord a => RoseTree a -> RoseTree (a, a)
pureMax tree =
let (t, largest) = go largest tree
in t
where
go :: Ord a => a -> RoseTree a -> (RoseTree (a, a), a)
go biggest (RoseTree x []) = (RoseTree (x, biggest) [], x)
go biggest (RoseTree x xs) =
let sub = map (go biggest) xs
(xs', largests) = unzip sub
in (RoseTree (x, biggest) xs', max x (maximum largests))
t = pureMax exampleTree
-- ---------------------------------------------------------------------
impureMin :: (MonadFix m, Ord b) => (a -> m b) -> RoseTree a -> m (RoseTree (a, b))
impureMin f tree = do
rec (t, largest) <- go largest tree
return t
where
go smallest (RoseTree x []) = do
b <- f x
return (RoseTree (x, smallest) [], b)
go smallest (RoseTree x xs) = do
sub <- mapM (go smallest) xs
b <- f x
let (xs', bs) = unzip sub
return (RoseTree (x, smallest) xs', min b (minimum bs))
budget :: String -> IO Int
budget "Ada" = return 10 -- A struggling startup programmer
budget "Curry" = return 50 -- A big-earner in finance
budget "Dijkstra" = return 20 -- Teaching is the real reward
budget "Howard" = return 5 -- An frugile undergraduate!
inviteTree = RoseTree "Ada" [ RoseTree "Dijkstra" []
, RoseTree "Curry" [ RoseTree "Howard" []]
]
ti = impureMin budget inviteTree
simplemdo = mdo
return 5
|
