12/08/2020 Code (Week 7 Wednesday)
Code (Week 7 Wednesday)
Applicatives ZipList Applicative
data ZList a = Nil
| Cons a (ZList a)
deriving Show
instance Functor ZList where
fmap f Nil = Nil
fmap f (Cons x xs) = Cons (f x) (fmap f xs)
instance Applicative ZList where
pure x = Cons x (pure x)
(Cons f fs) <*> (Cons x xs) = Cons (f x) (fs <*> xs)
_ <*> _ = Nil
Tree Applicative
data Tree a
= Leaf
| Node a (Tree a) (Tree a)
deriving (Show)
instance Functor Tree where
— fmap :: (a -> b) -> Tree a -> Tree b
fmap _ Leaf = Leaf
fmap f (Node v l r) = Node (f v) (fmap f l) (fmap f r)
instance Applicative Tree where — pure :: a -> Tree a pure v = Node v Leaf Leaf
— (<*>) :: Tree (a -> b) -> Tree a -> Tree b Leaf <*> _ = Leaf
_ <*> Leaf = Leaf
(Node f fl fr) <*> (Node x xl xr) =
Node (f x) (fl <*> xl) (fr <*> xr)
www.cse.unsw.edu.au/~cs3141/20T2/Week 07/Wednesday/Code.html
1/4
12/08/2020 Code (Week 7 Wednesday)
Alternate applicative de nition
—
— class Functor f => Applicative f where
— pure :: a -> f a
— tuple :: f a -> f b -> f (a, b)
import Control.Applicative
— fmap f x = f <$> x = pure f <*> x
— Implement using fmap, pure, and <*>
tuple :: Applicative f => f a -> f b -> f (a, b) tuple l r = ((,) <$> l) <*> r
— Implement <*> using fmap, pure, and tuple (<*!>) :: Applicative f => f (a -> b) -> f a -> f b f <*!> x = uncurry ($) <$> tuple f x
— uncurry :: (a -> b -> c) -> (a, b) -> c — uncurry f (l, r) = f l r
Monads Formulas Example
import Control.Monad (ap)
data Variable = A | B | C deriving (Show,Eq)
data Formula v = Var v
| And (Formula v) (Formula v)
| Or (Formula v) (Formula v)
| Not (Formula v)
| Constant Bool
deriving (Eq,Show)
infixr /\
(/\) :: Formula v -> Formula v -> Formula v
a /\ b = And a b
infixr \/
(\/) :: Formula v -> Formula v -> Formula v a \/ b = Or a b
— a \/ b = Not $ (Not a) /\ (Not b)
www.cse.unsw.edu.au/~cs3141/20T2/Week 07/Wednesday/Code.html
2/4
12/08/2020 Code (Week 7 Wednesday)
example :: Formula Variable
example = (Var A /\ Var A) \/ (Not (Var B) /\ Var C)
— Or (And (Var A) (Var A)) (And (Not (Var B)) (Var C))
instance Functor Formula where — fmap is renaming variables — fmap :: (a->b) -> Formula a -> Formula b
fmap f (Var v) = Var $ f v
fmap f (And l r) = And (fmap f l) (fmap f r)
fmap f (Or l r) = Or (fmap f l) (fmap f r)
fmap f (Not x) = Not $ fmap f x
fmap f (Constant b) = Constant b
— try fmap (const B) example
— Applicatives don’t make much sense here, so we can use
— the `ap` function from Control.Monad to implement <*>
— in terms of >>=, which is easier in this case to write than <*>:
instance Applicative Formula where — pure :: a -> Formula a
pure = Var
— (<*>) :: Formula (a -> b) -> Formula a -> Formula b (<*>) = ap
— ap :: Monad m => m (a -> b) -> m a -> m b — ap f x = do
— f’ <- f
-- x' <- x
-- pure $ f' x'
instance Monad Formula where -- >>= is substitution
— (>>=) :: Formula a -> (a -> Formula b) -> Formula b
>>= f) >>= f)
>>= f = f v >>=f=And >>=f=Or >>=f=Not
(Var v)
(And l r)
(Or l r)
(Not x)
(Constant b) >>= f = Constant b
subst A = Constant True
subst B = Constant False
subst C = Constant True
— try `example >>= subst`
(l >>= f) (r (l >>= f) (r $x>>=f
— Evaluate a formula with no variables
evalFormula :: Formula a -> Maybe Bool
evalFormula (Var a) = Nothing
evalFormula (And l r) = (&&) <$> evalFormula l <*> evalFormula r
www.cse.unsw.edu.au/~cs3141/20T2/Week 07/Wednesday/Code.html
3/4
12/08/2020 Code (Week 7 Wednesday)
Alternate monad de nition
—
— class Applicative m => Monad m where — join :: m (m a) -> m a
import Control.Monad
— Implement in terms of >>= join’ :: Monad m => m (m a) -> m a join’ = (>>= id)
— Implement in terms of join
(>>=!) :: Monad m => m a -> (a -> m b) -> m b pre >>=! post = join $ fmap post pre
evalFormula (Or l r) = do
{ l’ <- evalFormula l
; r' <- evalFormula r
; pure $ l' || r'
}
evalFormula (Not x) = not <$> evalFormula x
evalFormula (Constant b) = pure b
www.cse.unsw.edu.au/~cs3141/20T2/Week 07/Wednesday/Code.html
4/4