{- |
chain a sequence of actions such that if one fails, |
all the the remaining ones fail. |
-} |
|
-- the state of a computation action is either OK, in which case the resulting |
-- current state a is passed on, or it fails and Failure is passed on |
data State a = OK a | Failure |
deriving (Show, Eq) |
|
-- an action is a function from state to state |
|
-- examples of actions that result in a state |
myAction :: (Integral a, Eq a) => State a -> State a |
myAction (OK 0) = Failure |
myAction (OK x) = OK (x - 1) |
myaction Failure = Failure |
myaction _ = Failure |
|
myAction2 :: (Integral a, Eq a) => State a -> State (a, String) |
myAction2 (OK 0) = Failure |
myAction2 (OK x) = case x `mod` 2 of |
0 -> OK (x, "Even") |
1 -> OK (x, "Odd") |
myaction2 _ = Failure |
|
-- we chain actions togeter using thenWe, which has infix form `thenWe` |
|
thenWe :: State a -> (State a -> State b) -> State b |
thenWe (OK x) f = f (OK x) |
thenWe Failure _ = Failure |
|
-- try testIt 3 and testIt 0 and testIt 1 |
testIt i = |
-- we need to start an action with an initial state |
OK i `thenWe` |
myAction `thenWe` |
myAction2 |
|
-- compose a function n >= 0 times with itself |
composeN :: Int -> (a -> a) -> (a -> a) |
composeN 0 f = id |
composeN n f = f . (composeN (n-1) f) |
|
-- function actNTimes that creates a new action consisting of |
-- performing action f n times. |
actNTimes :: Int -> (State a -> State a) -> (State a -> State a) |
actNTimes n f = composeN n (`thenWe` f) |
|
testIt' :: Integral a => a -> State (a, String) |
testIt' x = |
(OK x) `thenWe` |
(actNTimes 7 myAction) `thenWe` |
myAction2 |
|
-- return the state the predicate succeeded on, or Failure |
actUntilFound :: (State a -> Bool) -> (State a -> State a) -> State a -> State a |
actUntilFound pred f curState = case curState of |
Failure -> Failure |
_ -> case pred curState of |
True -> curState |
False -> actUntilFound pred f (f curState) |
|
{- Example |
*Main> actUntilFound (\s -> (s == (OK 4) || s == (OK 0) )) myAction (OK 10) |
OK 4 |
*Main> actUntilFound (\s -> (s == (OK 4) || s == (OK 0) )) myAction (OK 3) |
OK 0 |
-} |
|
-- return the state just before the predicate failed |
actUntilFail pred f curState = actUntilFail' pred f Failure curState |
|
{- Example |
*Main> actUntilFail (/= (OK 4)) myAction (OK 20) |
OK 5 |
*Main> actUntilFail (/= (OK 4)) myAction (OK 20) `thenWe` myAction |
OK 4 |
|
*Main> actUntilFail (/= (OK 4)) myAction (OK (2)) |
OK 0 |
*Main> actUntilFail (/= (OK 4)) myAction (OK (2)) `thenWe` myAction |
Failure |
-} |
|
-- recursor helper that has a previous state in addition to the current |
-- satte so that the predicate can fail on the current state. |
|
actUntilFail' :: (State a -> Bool) -> (State a -> State a) -> |
State a -> State a -> State a |
|
actUntilFail' pred f prevState curState = case curState of |
Failure -> prevState |
_ -> case pred curState of |
-- move to next state and recurse |
True -> actUntilFail' pred f curState (f curState) |
-- we failed, return the previous successful state |
False -> prevState |
|
-- version that has the helper defined inside, and thus does not need |
-- to propagate pred or f into the helper through paramaters |
actUntilFail2 pred f curState = actUntilFail2' Failure curState |
where |
actUntilFail2' prevState curState = case curState of |
Failure -> prevState |
_ -> case pred curState of |
-- move to next state and recurse |
True -> actUntilFail2' curState (f curState) |
-- we failed, return the previous successful state |
False -> prevState |
{- |
A ManyTree over type a, is a tree that consists of leaves with values |
of type a, and internal vertices which consist of lists of 0 or more |
ManyTree subtrees. |
-} |
|
data ManyTree a = Leaf a | Internal [ ManyTree a ] |
deriving (Eq, Show) |
|
-- deconstructors, sometimes easier than using a pattern match |
getLeaf (Leaf x) = x |
getSubtrees (Internal subtrees) = subtrees |
|
|
-- example trees |
t1 :: ManyTree Int |
t1 = Internal [ Leaf 1, Leaf 2, Leaf 3] |
|
l2 :: [Int] |
l2 = (map getLeaf (getSubtrees t1)) |
t2 = Internal (map (\x -> Leaf (x *10)) l2) |
|
-- since trees are functional, you can have the same sub tree appearing |
-- in multiple places |
t3 = Internal [t1, t2] |
t4 = Internal [t1, t2, Leaf 42, Internal [t1, t2]] |
|
-- do a depth first left to right traversal of tree t |
dfslr :: ManyTree a -> [a] |
dfslr (Leaf x) = [x] |
dfslr (Internal subTrees) = foldl (++) [] (map dfslr subTrees) |
|
-- do a dfs over the tree, but output the path to each leaf |
|
{- Examples: |
*Main> dfslr t1 |
[1,2,3] |
*Main> dfslr t2 |
[10,20,30] |
*Main> dfslr t3 |
[1,2,3,10,20,30] |
-} |
|
|
-- transforms on trees |
|
-- apply a transform f to each leaf returning a tree of a different type |
mapLeaf :: (a->b) -> (ManyTree a) -> (ManyTree b) |
mapLeaf f (Leaf x) = Leaf (f x) |
mapLeaf f (Internal subTrees) = Internal ( map (mapLeaf f) subTrees ) |
|
{- Examples: |
*Main> mapLeaf (\x -> x * 10 ) t2 |
Internal [Leaf 100,Leaf 200,Leaf 300] |
|
*Main> mapLeaf (* 10 ) t2 |
Internal [Leaf 100,Leaf 200,Leaf 300] |
|
*Main> mapLeaf (\x -> (show x)++"x" ) t2 |
Internal [Leaf "10x",Leaf "20x",Leaf "30x"] |
*Main> mapLeaf (\x -> (show x)++"x" ) t4 |
Internal [Internal [Leaf "1x",Leaf "2x",Leaf "3x"], |
Internal [Leaf "10x",Leaf "20x",Leaf "30x"], |
Leaf "42x",Internal [Internal [Leaf "1x",Leaf "2x",Leaf "3x"], |
Internal [Leaf "10x",Leaf "20x",Leaf "30x"]]] |
-} |
|
-- apply a transform to each internal vertex |
mapInternal :: ([ManyTree a] -> [ManyTree a]) -> ManyTree a -> ManyTree a |
mapInternal f (Leaf x) = Leaf x |
mapInternal f (Internal subTrees) = |
Internal (f (map (mapInternal f) subTrees)) |
|
{- Examples: |
|
*Main> mapInternal (\st -> drop 1 st) t3 |
Internal [Internal [Leaf 20,Leaf 30]] |
|
*Main> mapInternal (drop 1) t3 |
Internal [Internal [Leaf 20,Leaf 30]] |
|
*Main> mapInternal (drop 1) t4 |
Internal [Internal [Leaf 20,Leaf 30],Leaf 42, |
Internal [Internal [Leaf 20,Leaf 30]]] |
-} |