map map f [x, y, z] = [f x, f y, f z]
fmap_List :: (a -> b) -> [] a -> [] b
— “[] a” means “[a]” in types.
fmap_List f [] = []
fmap_List f (x:xs) = f x : fmap_List f xs
Maybe
data Maybe a = Nothing | Just a
Maybe fmap_List
fmap_Maybe :: (a -> b) -> Maybe a -> Maybe b
fmap_Maybe f Nothing = Nothing
fmap_Maybe f (Just a) = Just (f a)
Table of Contents
a ti evig I tub )
:eman tnereffid ,.g.e( noitcnuf yrarbil dradnats eht si sihT
: ot suogolana rof noitcnuf a si erehT
.¡±rewsnaehts’ereh¡°dna¡±rewsnaon¡°:seitilibissopowtgnivahsledomtI .1 ro 0 htgnel fo tsil ekil s’tI
:yrarbil dradnats eht morf epyt eht fo noitinfieD sh.MAF ni
.yasse doog-sdnuos a etirw t’nac uoy fi neve ,kniht uoy naht erom dnatsrednu ydaerla uoy ,edoc s’elpoep rehto fo emoctuo eht tciderp dna ,edoc tcerrocni xfi ,edoc tcerroc etirw nac uoy fI .seitreporp ,snoitacilppa ,selpmaxe erom tuo krow dna rof kool oD .¡±?danom a si tahw¡° ot rewsna tcerid a kees t’noD .danom dna ,evitacilppa ,rotcnuf rof tseb si hcaorppa emas ehT
.ecitcarp yletamitlu dna ,seitreporp ,snoitacilppa ,selpmaxe hguorht niaga simehtgninraelrognihcaettatebtsebruoY?esohtrebmemeR.secapsrotcevhtiwesiwekiL
.ecitcarp ybsrebmundenraeluoy,yltsaldnA.evitatummocsinoitiddawohekil)smeroehtdnasmoixa( seitreporp emos ,srebmun htiw krow ot woh ,srebmun esu ot woh ,selpmaxe :yltceridni rewsna uoy spahreP .yltcerid ti rewsna uoy od ron ,taht ksa t’nod yllamron uoY ?rebmun a si tahW
gnimmargorp luftceffe :danoM ,evitacilppA ,rotcnuF
:sevitcepsrep owT
.yad a sruoh 04 .ecitcarP
rotcnuF
dnim fo emarF
Either
data Either e a = Left e | Right a
Maybe
fmap_Either :: (a -> b) -> (Either e) a -> (Either e) b
fmap_Either f (Left e) = Left e
fmap_Either f (Right a) = Right (f a)
(a -> b) -> (F a -> F b) F
class Functor f where
fmap :: (a -> b) -> (f a -> f b)
data BinTree a = BTNil | BTNode a (BinTree a) (BinTree a) deriving Show
instance Functor BinTree where
— fmap :: (a -> b) -> BinTree a -> BinTree b
fmap f BTNil = BTNil
fmap f (BTNode a lt rt) = BTNode (f a) (fmap f lt) (fmap f rt)
fmap
— 1. Functor identity
fmap (\x -> x) xs = xs
— i.e.,
fmap (\x -> x) = \xs -> xs
— i.e.,
fmap id = id
— and to elaborate the types, since there are two “id”s:
fmap (id :: a -> a) = (id :: f a -> f a)
— 2. fmap fusion, fmap is a homomorphism
fmap g (fmap f xs) = fmap (\x -> g (f x)) xs
— i.e.,
fmap g . fmap f = fmap (g . f)
Either
fmap
Table of Contents
dna yltcartsba yrev siht gniyas era smoixa ehT .thgir er’uoy ,stnemele eht ot esiwtnemele
f ylppa dna epahs eht enolc syawla ot smees
,serutcurts atad rof ,taht eciton uoy fI :noissucsiD
rof ssalc a si erehT .epyt dezirtemarap a si
neht dna ,fo kniht nac uoy serutcurts atad tsom …,serutcurts eert ,seiranoitcid ,syarra oslA
:swal/smoixa owt eseht yfsitas dluohs sh.MAF ni
: rof noitcnuf suogolana na si ereht ,ti desseug uoy dnA
.¡±rewsna on¡° yhw rof nosaer fo dnik emos spahrep ,atad artxe seirrac esac ¡±rewsna on¡° eht tub , ekil s’tI
:yrarbil dradnats eht morf epyt eht fo noitinfieD sh.MAF ni
:elpmaxe erutcurts atad A
!taht erehw , :emeht nommoC
.emos sh.MAF ni
fmap
liftA2_List (-) [10,20,30] [1,2,3]
= [10-1, 10-2, 10-3, 20-1, 20-2, 20-3, 30-1, 30-2, 30-3]
= [9,8,7,19,18,17,29,28,27]
liftA2_List :: (a -> b -> c) -> [a] -> [b] -> [c]
liftA2_List f [] _ = []
liftA2_List f (a:as) bs = map (f a) bs ++ liftA2_List f as bs
liftA2_Maybe :: (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
liftA2_Maybe f Nothing _ = Nothing
liftA2_Maybe f (Just a) Nothing = Nothing
liftA2_Maybe f (Just a) (Just b) = Just (f a b)
— The last two lines could be merged into:
— liftA2_Maybe f (Just a) mb = fmap (f a) mb
liftA2_Either :: (a -> b -> c) -> Either e a -> Either e b -> Either e c
liftA2_Either f (Left e) _ = Left e
liftA2_Either f (Right a) (Left e) = Left e
liftA2_Either f (Right a) (Right b) = Right (f a b)
— The last two lines could be merged into:
— liftA2_Either f (Right a) eb = fmap (f a) eb
liftA3_List :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
liftA4_List :: (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
etc.
liftA2_List map
fmap BinTree
Table of Contents
suoucipsnocni eht morf gnidnetxe htiw snigeb yrots ehT . dna morf devired eb nac yeht ,deen oN :tuo snrut tI
:eseht tnaw uoy fi ,.e.I …?ruoF ?stsil eerht dna noitcnuf yra-3 a evah uoy fi tahW :si noitseuq redrah ehT
:siht ekil naem I ?tcudorp naisetrac eht ot noitcnuf yra-2 eht gniylppa ekil ,stsil owt fo stnemele fo sriap lla ot noitcnuf yra-2 a ylppa ot tnaw uoy fi tahW
?hctarcs morf pu dedoc eb ot evah yeht od
:sepyt rehto dna ebyaM rof ylsuogolana dna ,hcum taht pu edoc nac eW
.)…ro ,ebyaM eno ro( tsil eno ot esiwtnemele noitcnuf yranu a ylppa nac
.)!eloh tibbar rehtona( yroeht yrogetac ni tnatropmi ylemertxe si rotcnuF ,dnah rehto eht nO
.)¡±snel¡° :eloh tibbar siht tnaw uoy fi( esu lacitcarp decnavda na sah osla tI .woleb sdohtem danoM dna evitacilppA htiw denibmoc nehw lufesu erom hcum si ti tuB .¡±pamf¡° eman nommoc a gnidivorp morf trapa ,esu lacitcarp cisab hcum evah ton seod nwo sti no rotcnuF
)?woH :esicrexE( .smoixa htob kaerb dluow uoy ,toor ta noitator -tfel a mrofrep ot rof etirw dna ythguan eb ot deirt uoy fI :elpmaxE .yltceridni
sh.MAF ni
evitacilppA
apply :: (a -> b) -> a -> b
apply f a = f a
ap_List :: [a -> b] -> [a] -> [b]
— Example:
— ap_List [f,g] [1,2,3]
— = [f 1, f 2, f 3, g 1, g 2, g 3]
— Can be obtained from liftA2_List
ap_List fs as = liftA2_List (\f a -> f a) fs as
liftA2_List ap_List fmap
— liftA2 can be obtained from ap (and fmap)
liftA2_ListV2 f as bs = ap_List (fmap f as) bs
ap_List (fmap f [i, j]) [x, y]
= ap_List [f i, f j] [x, y]
= [f i x, f i y, f j x, f j y]
= liftA2_List f [i, j] [x, y]
ap_List (fmap
|<--
|<---
as) bs
f
a->(b->c) [a]
[b -> c] [c]
ap_List
–>| [b]
—>|
liftA2_List
liftA3_List
liftA3_List :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
liftA3_List f as bs cs = ap_List (ap_List (fmap f as) bs) cs
ap_List (ap_List (fmap f as) bs) cs
a->(b->c->d) [a]
|<-- [b->(c->d)] –>| [b]
|<--- [c->d]
|<--- [d]
Maybe Either
--->| [c]
—>|
BinTree
Table of Contents
yra-3 rof
.no os dnA .oot ,stsil eerht dna noitcnuf niatbo ot woh stseggus niatbo ot esu nac uoy yaw ehT
:¡±ylppa¡° sezilareneg ti esuaceb evitacilppA dellac s’tI !oot siht rof ssalc a si erehT ). ton yletanutrofnU( . dna rof seirots suogolanA
:sepyt etaidemretni eht era ereh tuB .selpmaxe emos tuo krow :esicrexe ,niagA
:sepyt etaidemretni eht tuo krow ot si hguoht yaw rehtonA
,.g.e ,tuo krow ot si dnatsrednu ot yaw enO sh.MAF ni
🙂 sulp( morf deniatbo eb nac ylesrevnoC sh.MAF ni
:stnemugra fo tsil a dna snoitcnuf fo tsil a ot ti od :ot
sh.MAF ni
class Functor f => Applicative f where
pure :: a -> f a
(<*>) :: f (a -> b) -> f a -> f b — you can call this “ap”
liftA2 :: (a -> b -> c) -> f a -> f b -> f c
— And default implementations because <*> and liftA2 are equivalent.
liftA2 f as bs = fmap f as <*> bs
fs <*> as = liftA2 (\f a -> f a) fs as
— And a couple of other methods with easy default implementations.
pure [] Maybe
— [] version
pure a = [a]
— Maybe version
pure a = Just a
— Either e version
pure a = Right a
pure
Either e
2-ary, liftA2 :: (t1 -> t2 -> a) -> f t1 -> f t2 -> f a
1-ary,
0-ary,
fmap :: (t1 -> a) > f t1
pure :: a
-> f a -> f a
fmap
fmap f xs = pure f <*> xs
pure <*>
— 0. Applicative subsumes Functor
fmap f xs = pure f <*> xs
— 1. Applicative left-identity
pure id <*> xs = xs
— Compare with fmap identity! fmap id xs = xs
— 2. Applicative associativity, composition
gs <*> (fs <*> xs) = ((pure (.) <*> gs) <*> fs) <*> xs
= (liftA2 (.) gs fs) <*> xs
— Analogy: g (f x) = (g . f) x
— It may help to elaborate the types. Assume:
— xs :: f a
— fs :: f (a -> b)
— gs :: f (b -> c)
— (.) :: (b -> c) -> (a -> b) -> (a -> c)
— Try to determine the types of the subexpressions.
— 3. pure fusion, pure is a homomorphism
pure f <*> pure x = pure (f x)
fmap f (pure x) = pure (f x)
— 4. pure interchange, almost right-identity
fs <*> pure x = pure (\f -> f x) <*> fs
= fmap (\f -> f x) fs
Table of Contents
.spleh yllufepoh taht woleb seiralloroc emos wohs lliw I tub ,esret ro tcartsba oot eb yam moixa ytivitaicossa ehT .smoixa gniwollof eht yfsitas dluohs sdohtem evitacilppA ehT
: dna morf devired eb nac
.fo dnik ,stsil 0 dna noitcnuf yra-0 a evah uoy nehw esac etareneged ehT :selor owt syalp
:swollof sa krow dna , , rof
f <*> xs
fmap g (fmap f xs)
= pure g <*> (pure f <*> xs)
= ((pure (.) <*> pure g) <*> pure f) <*> xs
= (pure ((.) g) <*> pure f) <*> xs
= pure ((.) g f) <*> xs
= pure (g . f) <*> xs
= fmap (g . f) xs
liftA3 (\x y z -> g x (f y z)) xs ys zs
(fmap (\x y z -> g x (f y z)) xs <*> ys) <*> zs
= fmap g xs <*> (fmap f ys <*> zs)
f :: Int -> String Maybe []
f 4 :: String
[] Maybe Either e
¡°E String¡±
Int ->
m1, m2 :: Maybe String
in Applicative terms
associativity
pure fusion
pure fusion
infix notation
in Functor terms
f :: Int -> E String
E
f 4 :: E String
liftA2 (++) m1 m2
m1
fm
apTabflexosf C=onptuerntes
dna senibmoc ,.g.E .seno xelpmoc otni smargorp luftceffe cisab gninibmoc ¡ªsevitcennoc era danoM retal dna ,evitacilppA ,rotcnuF fo sdohtem eht ,dnim fo emarf siht nI
.)liaf dluoc :tceffe eht( srewsna gnirts evig taht smargorp owt sa meht fo kniht , fi ,.g.E .srewsna gnirts evig taht smargorp luftceffe fo epyt eht sa ti fo kniht dna )¡± ¡° tuohtiw os( no sucof ot secffius tI
.)yawyna siht tcepxe uoy tub( emit yreve ¡±noitca luftceffe¡° emas eht tsuj daetsni ,emit yreve gnirts emas eht evig ot evah ton seod os , ot sepyt egnahc dna¡ªnoitces siht ni ro ,.g.e¡ª ti tneserper ot epyt deziretemarap a ekam ew ,derised si tceffe fo dnik cfiiceps emos fI .tceffe
tuohtiw ,emit yreve gnirts emas eht si taht snaem lleksaH ni
.semit tnereffid ta srewsna tnereffid gnitteg ot dael owt rettal eht¡ªO/I gnimrofrep ,selbairav etats gnissecca ,srewsna elpitlum ,rewsna on :.g.e ,od tonnac noitcnuf lacitamehtam a sgniht ot srefer ti ,erutluc lleksaH eht nI .aedi eht s’taht ,¡±tceffe-edis a htiw noitcnuf¡° esarhp eht wonk uoy fi tub ,noitinfied esicerp a nevig ton yllausu dna daorb yrev si ¡±tceffE¡°
.serutcurts atad fo sepyt sa syawla ton ,smargorp luftceffe ro stceffe fo sepyt sa , , fo kniht ot uoy tnaw won I
sepyt tceffe sa sepyt ¡±reniatnoc¡° deziretemaraP
.noisrucer yb sniahc gnol gnitnemelpmi dna gnirotcafer ynam rof tnatropmi si sihT .gnipuorg-er yfitsuj swal evitaicossA
.dettimo si )ecnerevesrep suluclac adbmal fo spets 4 dna gnidnirg arbegla fo spets 6( foorp ehT .tnelaviuqe era )T¡ÁS(¡ÁR dna T¡Á)S¡ÁR( stcudorp naisetrac owt eht taht syas ti ,stsil fo esac eht nI .wal ytivitaicossa fo dnik emos evah uoy ,ylevitiutnI .thgir eht ot setaicossa yaw dnoces ehT .tfel eht ot setaicossa ti dna ,wonk ydaerla uoy yaw tsrfi ehT
:syaw tnelaviuqe owt gniwollof eht yb enod eb nac
:noisuf pamf ecuded oT .ytitnedi-tfel evitacilppA morf etaidemmi si ytitnedi rotcnuF .
nevig smoixa rotcnuF eht ylpmi smoixa evitacilppA eht taht si yralloroc tsrfi ehT
taht si yralloroc dnoces ehT
m2
Maybe
foo :: Maybe Int
Just
f :: Int -> String
fmap f foo :: Maybe String
f
pure 4 :: Maybe Int
Maybe
bar :: Maybe Int
liftA2 (+) foo bar :: Maybe Int
Int
Maybe
addRecip
recipMay
bar
Maybe
recipMay :: Double -> Maybe Double
recipMay a | a == 0 = Nothing
| otherwise = Just (1 / a)
addRecipV1 x y =
case recipMay x of
Nothing -> Nothing
Just x_recip -> case recipMay y of
— or: pure (1 / a)
Nothing -> Nothing
Just y_recip -> Just (1/x_recip + 1/y_recip)
addRecipV2 :: Double -> Double -> Maybe Double
addRecipV2 x y = liftA2 (+) (recipMay x) (recipMay y)
Either e e Left
[]
foo :: [Int]
Nothing
foo
foo
f :: Int -> String
Table of Contents
.)eruliaf¡ªsesrevinu 0 spahreP( .srewsna elpitlum rofsesrevinuelpitlumsnwapstahtmargorpcitsinimreted-nonasnaemwon¡± ¡°
.eruliaf rof nosaer eht yrrac ot ) fo epyt dlefi( epyt artxe eht sulp ,ralimis si
sh.MAF ni
ot yrt ot snur taht margorp etisopmoc a snaem won ¡±
).
¡° esoppuS(
).eruliaf fo tceffe s’ sdiova ti taht etoN( .4 snruter dna sdeeccus taht margorp a snaem won ¡±
gnisu ¡°
fi( rewsna eht strevnoc tub , snur taht margorp a snaem won ¡± ).
yb deyevnoc( na nruter dna deeccus yam taht margorp a snaem won ¡±
¡°
). esoppuS(
msinimreted-non ,srewsna elpitlum :
:gnikniht fo yaw wen eht sesu noisrev dnoces yM sh.MAF ni
:dnah yb siht sedoc noisrev tsrfi ym ;eruliaf fo noitapicitna ni gnivlovni niaga ,slacorpicer owt dda ot noitcnuf na etirw ot ti esu neht I .seruliaf dna sesseccus yevnoc ot
esu I ,orez-yb-noisivid eldnah retteb ot tub ,slacorpicer rof noitcnuf a evah I :elpmaxE .mus eht si rewsna llarevo eht ,oot sseccus fi ;esiwekil snur ,sseccus fi ;rebmun a niatbo
esoppuS( .) yb deyevnoc( liaf yam ro ,)
eruliaf ro rewsna eno :
.
gnisu )yna ¡°
.
fmap f foo :: [String]
pure 4 :: [Int]
bar :: [Int]
[]
foo
bar
liftA2 (+) foo bar :: [Int]
foo
liftA2
sqrts :: Double -> [Double]
sqrts a | a < 0 = []
| a == 0 = [0]
| otherwise = [- sqrt a, sqrt a]
addSqrts :: Double -> Double -> [Double]
addSqrts x y = liftA2 (+) (sqrts x) (sqrts y)
liftA2 (+) foo bar bar foo
bind :: E a -> (a -> E b) -> E b
bind foo quaz
quaz quaz
bind_Maybe :: Maybe a -> (a -> Maybe b) -> Maybe b
bind_Maybe Nothing k = Nothing
bind_Maybe (Just a) k = k a
foo bar
bind_Either :: Either e a -> (a -> Either e b) -> Either e b
bind_Either (Left e) _ = Left e
bind_Either (Right a) k = k a
bind_List :: [a] -> (a -> [b]) -> [b]
bind_List xs k = concat (map k xs)
— Explanation: map k xs :: [[b]] is almost there, use concat to flatten
foo
Table of Cofntents
.kcabllac a sa fo kniht yam uoY . ot dessap si ,yna fi ,)s(rewsna sti neht , snur taht margorp etisopmoc a snaem ¡± ¡° os
:ekiL ?od ot tahw gnidiced erofeb margorp tsrfiehtmorfrewsnanatakeepaekatotmargorpdnocesehtwollaottnawuoyfitahW
.)s(rewsna s’ no dneped tonnac nI :noitatimil a evah yeht tub ,seno reggib otni smargorp rellams esopmoc uoy pleh sdohtem evitacilppA dna rotcnuF
)srewsna ynam woh ,.g.e( tceffe ro )s(rewsna s’ ,
: dna gnikniht fo yaw wen eht fo egatnavda gnikat ,y¡Ì ¡À x¡Ì¡À fo seitilibissop lla etupmoc ot noitcnuf a etirw I .)!eruliaf( stoor erauqs laer on sah 0
.srewsna n¡Ám sah margorp etisopmoc eht ,srewsna n sah dna srewsna m sah fI .srewsna fo riap yreve smus dna , snur , snur taht margorp etisopmoc a snaem won ¡± ¡°
).srewsna elpitlum ro eruliaf fo tceffe s’ gnisu sdiova ti taht etoN( .4 rewsna eno si ereht esuaceb esrevinu eno sah tsuj taht margorp a snaem won ¡± ¡°
. gnisu srewsna strevnoc neht , snur taht margorp a snaem won ¡± ¡°
). esoppuS(
sh.MAF ni
danoM
sh.MAF ni
— All permutations of the input.
permsV1 :: Eq a => [a] -> [[a]]
permsV1 xs = permsAddV1 xs []
— Helper: permsAdd xs ys = all permutations of xs prepended to ys
— E.g.,
— permsAdd [1,2] [6,4,7] = [2:1:[6,4,7], 1:2:[6,4,7]]
— permsAdd [] [6,4,7] = [[6,4,7]]
permsAddV1 :: Eq a => [a] -> [a] -> [[a]]
permsAddV1 [] ys = [ys]
permsAddV1 xs ys = bind_List xs (\x -> permsAddV1 (delete x xs) (x : ys))
— For each x in xs, I want to delete x from xs, add x to ys, and recurse.
— OR:
— Non-deterministically choose x from xs, … ditto.
class Applicative f => Monad f where
return :: a -> f a
(>>=) :: f a -> (a -> f b) -> f b
(>>) :: f a -> f b -> f b
— Default implementation: foo >> bar = foo >>= \_ -> bar
— Handy when you don’t need foo’s answer, only its effect.
return
foo :: E X
quaz :: X -> E Y
foo >>= quaz :: E Y
E
quaz
pure
permsV2 :: Eq a => [a] -> [[a]]
permsV2 xs = permsAddV2 xs []
>>=
>>=
return
E quaz
F
>>= foo
permsAddV2 :: Eq a => [a] -> [a] -> [[a]]
permsAddV2 [] ys = return ys
permsAddV2 xs ys = xs >>= \x -> permsAddV2 (delete x xs) (x : ys)
foo
Table of Contents
¡±.uoy llac ll’eW .su ksa t’noD¡° .ydaer si rewsna na revenehw kcabllac ruoy llac yehT .rewsna nagnissecorpdnagniviecerrofkcabllacaedivorpuoY.¡±? morf)s(rewsnaehttcartxeot
woh¡° ksa t’nod uoy oS .yna fi ,rewsna na htiw llac lliw .kcabllac a sa fo knihT .2
.srewsna esoht ot ssecca sah dna rof edam-roliat si tuB .¡±?)s(rewsna s’ s’tahw¡° ksa ot yaw tcerid on si ereht taht os ,epyt tcartsba na sa fo knihT .1
:smoixa eseht sefisitas sdohtem danoM ehT sh.MAF ni
:sdohtem danoM gnisu elpmaxe noitatumrep ehT
dna ,ecnatsni danoM a si esoppuS :)¡±dnib¡° yas nac uoy( rof noitanalpxe eroM
.gnihtynatixetonseod¡±¡°¡ªwofllortnocfosmretniknihttonoD.)tnecer erom si evitacilppA esuaceb( snosaer lacirotsih rof ereh si tI .¡± ¡° sa emas eht snaem ¡± ¡°
!oot taht rof ssalc a si ereht dnA sh.MAF ni
.tsil tupni na fo snoitatumrep lla etupmoC :noitacilppa elpmaxE
— 1L. Monad left identity
return x >>= k = k x
— 1R. Monad right identity
foo >>= \x -> return x = foo
foo >>= return = foo
— 2. >>= associativity
(foo >>= \x -> k1 x) >>= k2 =
(foo >>= k1 ) >>= k2 =
— (x is a fresh variable, i.e., no name clash)
foo >>= (\x -> k1 x >>= k2)
foo >>= (\x -> k1 x >>= k2)
return >>=
fmap f xs = xs >>= (\x -> return (f x))
liftA2 op xs ys = xs >>= (\x -> ys >>= (\y -> return (op x y)))
>>=
>>=
Table of Contents
:elat yriaF .htam / gnimmargorp lanoitcnuf ni etats ekaf ot woh :rO
.tuoba si tahw yltcaxe si hcihw ,skcabllac gniniahc no desab elyts gnimmargorp yna yllareneg ,)srehto dna tpircsavaJ ni sesimorp( ycnerrucnoc ,)QNIL #C( seireuq atad gnirutcurts rof danoM lleksaH morf denrael evah segaugnal rehtO
.woleb stset kcom ,dohtem etalpmet ,noitcejni ycnedneped od lliw ew ,msihpromylop htiw rehtruf pets eno taht gnikaT
.esruoc eht ni retal gnisrap rof elyts siht esu lliw eW
.)sdohtem evitacilppA ,rotcnuF ro( sdohtem danoM gnisu sevitimirp gninibmoc yb smargorp etirw neht sresU .secnatsni danoM rieht gnitnemelpmi dna ,serutaef ro stceffe derised eht tneserper ot sepyt edam-motsuc gningised yb lleksaH nihtiw thgir edam era )¡±segaugnal cfiiceps-niamod deddebme¡°( segaugnal esoprup-laiceps inim ,scitnames rof esu laciteroeht eht yb deripsnI
.segaugnal yot rof sreterpretni yot ekam ew nehw esruoc eht ni retal siht od lliw eW .noitisopmoc laitneuqes stneserper dna ,)woleb ti od ot woh ees lliw ew ,selbairav etats sah egaugnal eht fi ;rehtiE sevlovni ecnatsni danoM eht ,snoitpecxe sah egaugnal eht fi ,.g.e( stceffe eht tneserper ot dengised ylluferac si ecnatsni danoM a ,egaugnal gnimmargorp a rof ledom htam a ekam oT .scitnames egaugnal gnimmargorp dna scitamehtam decnavda htob ni ,yroeht ni tnatropmi yrev si danoM
:rotcnuF dna evitacilppA fo sdohtem eht teg nac ew dna morF :rotcnuF dna evitacilppA semusbus danoM
.noisrucer yb sniahc gnol gnitnemelpmi dna gnirotcafer ynam rof tnatropmi si sihT .gnipuorg-er yfitsuj swal evitaicossA
danoM etatS ehT
:edis lacitcarp eht nO
State s a foo :: State Int String Int
foo
— “get” reads and returns the current value of the state variable.
get :: State s s
— Code shown later.
— “put s1” sets the state variable to s1. It returns the 0-tuple because there
— is no information to return.
put :: s -> State s ()
— Code shown later.
— Bridge from stateful fantasy to mathematical reality! “functionize prog s0”
— runs prog starting with initial state value s0 and gives you the final
— answer. Or, turns prog into a math pure function.
functionize :: State s a -> s -> a
— Code shown later.
c, d, e, f, g]
buildTree [a, b,
State Int
State s
— Recall: data BinTree a = BTNil | BTNode a (BinTree a) (BinTree a)
— buildTreeHelper n: Use n elements from [a] state var to build tree.
— Precondition: n <= length of state var.
buildTreeHelper :: Int -> State [a] (BinTree a)
buildTreeHelper 0 = pure BTNil
buildTreeHelper n =
buildTreeHelper m1
>>= \lt -> get
>>= \(x:xt) -> put xt
>> buildTreeHelper m2
>>= \rt -> pure (BTNode x lt rt) — Put it together, this is my answer.
where
n’ = n – 1
m1 = div n’ 2
m2 = n’ – m1
buildTree :: [a] -> BinTree a
— Make left subtree, m1 elements, call it lt.
— Which elements remaining? Take one for myself.
— Make right subtree, m2 elements, call it rt.
Table of Contents
.rewsna ym s’ti ,edon elddim eht esopmoC .5 .eertbus thgir eht eb lliw siht ,stnemele 2m fo eert dliub :llac evisruceR .4 .edon elddim eht rof eb lliw siht ,rav etats morf tnemele eno tuo ekaT .3 .eertbus tfel eht eb lliw siht ,stnemele 1m fo eert dliub :llac evisruceR .2
.edon elddim eht rof tnemele
1 dna ,ezis eertbus thgir si 2m ,ezis eertbus tfel si 1m ,2m + 1 + 1m = n otni n tilpS .1
:mhtiroglA .eert dliub ot rav etats morf stnemele n tsrfi eht sesu ,n retemarap sekat repleh evisruceR .)lla yllaitini( stnemele desunu sdloh elbairav etatS .)latot emit n gl n esuac dluow( noisrucer ni gnitnuoc-er diovA .ecno tsuj htgnel tnuoC
:ygetarts emit-raenil tub suoivbo-noN .gnivlah rof htgnel tnuoc ot deeN .eertbus thgir ni g,f,e ,eertbus tfel ni c,b,a ylevisrucer ,toor ta d snaem
,.g.E .decnalab ,redroni ,stnemele nevig fo tuo eert yranib a dliuB :esu elpmaxE
.oot snoitarepo cisab pu niahc ot sevitcennoc evah uoy os ,danoM dna ,evitacilppA ,rotcnuF fo ecnatsni na si ¡± ¡° ,eromehtruF .woleb dedivorp era snoitarepo cisab wef A
.etats epyt- na htiw stceffe lufetats stneserper taht epyt a si ¡± ¡° oS .elbairav etats tni na ot ssecca sah ti dna ,rewsna gnirts a sevig snaem ti ,elpmaxe rof fI .¡± ¡° epyt a evah I
buildTree xs = functionize (buildTreeHelper (length xs)) xs
— Whole list for initial state. Use all to build tree.
funtionize
data State s a = MkState (s -> (s, a))
— Unwrap MkState.
deState :: State s a -> s -> (s, a)
deState (MkState stf) = stf
functionize :: State s a -> s -> a
functionize prog s0 = snd (deState prog s0)
get :: State s s
get = MkState (\s0 -> (s0, s0))
— old state = s0, new state = old state = s0, answer s0 too.
put :: s -> State s ()
put s = MkState (\s0 -> (s , ()))
— ignore old state, new state = s, answer the 0-tuple ().
instance Functor (State s) where
— fmap :: (a -> b) -> State s a -> State s b
fmap f (MkState stf) = MkState
(\s0 ->
— Goal: Like stf but use f to convert a to b
— old state = s0, give to stf for new state s1 and answer a
case stf s0 of (s1, a) ->
— overall new state is also s1, but change answer to f a
(s1, f a))
testStateFunctor = deState (fmap length program) 10
where
program :: State Integer String
program = MkState (\s0 -> (s0+2, “hello”))
— should give (12, 5)
instance Applicative (State s) where
— pure :: a -> State s a
— Goal: Give the answer a and try not to have an effect.
— “effect” for State means state change.
pure a = MkState (\s0 -> (s0, a))
— so new state = old state
— liftA2 :: (a -> b -> c) -> State s a -> State s b -> State s c
—
— State transition goal:
— overall old state
— –1st-program–> intermediate state
— –2nd-program–> overall new state
—
— (Why not the other order? Actually would be legitimate, but we usually
— desire liftA2’s order to be consistent with >>=’s order.)
Table of Contents
.rewsna dna etats-wen fo riap ot etats-dlo morf noitcnuf :)a,s(¡ús yllautca oS .rewsna na evig ot ti tnaw osla I tpecxE
.eulav laitini eht ti sdeef taht ) ( noitcnuf retrats emos evah dna ,s¡ús ekil ,daetsni noitcnuf noitisnart etats a evah ot si kcirt ehT
:eurt emoc elat yriaf eht ekam ot woH sh.MAF ni
liftA2 op (MkState stf1) (MkState stf2) = MkState
(\s0 ->
— overall old state = s0, give to stf1
case stf1 s0 of { (s1, a) ->
— intermediate state = s1, give to stf2
case stf2 s1 of { (s2, b) ->
— overall new state = s2
— overall answer = op a b
(s2, op a b) }} )
testStateApplicative = deState (liftA2 (:) prog1 prog2) 10
where
prog1 :: State Integer Char
prog1 = MkState (\s0 -> (s0+2, ‘h’))
prog2 :: State Integer String
prog2 = MkState (\s0 -> (s0*2, “ello”))
— should give (24, “hello”). 24 = (10+2)*2.
instance Monad (State s) where
return = pure
— (>>=) :: State s a -> (a -> State s b) -> State s b
— Goal:
— 1. overall old state –1st-program–> (intermediate state, a)
— 2. give a and intermedate state to 2nd program.
MkState stf1 >>= k = MkState
(\s0 ->
— overall old state = s0, give to stf1
case stf1 s0 of { (s1, a) ->
— k is waiting for the answer a
— and also the intermediate state s1
— technicality: “(k a) s1” is conceptually right but nominally a
— type error because (k a) :: State s b, not s -> (s, b)
— Ah but deState can unwrap! (Or use pattern matching.)
deState (k a) s1 } )
data F1 s a = MkF1 (s -> Maybe (s, a))
data F2 s a = MkF2 (s -> (s, Maybe a))
toyCheckV1 :: IO Bool
toyCheckV1 =
getChar
>>= \c1 -> getChar
>>= \c2 -> getChar
>>= \c3 -> return ([c1, c2, c3] == “AL\n”)
Table of Contents
.dedecrepus eb ot ,1 noisreV .enilwen ,L ,A eb dluohs sretcarahc eerht tsriF :tamrof elfi yot ym rof rekcehc tamrof eliF
gnitset kcoM ,dohtem etalpmeT ,noitcejni ycnednepeD
)?hcihw esu uoy od nehW ?ecnereffid eht s’tahW :esicrexE !ecnereffid citnames evah od yehT(
:fo eno s’ti ,eruliaf dna etats htob niatbo ot ,g.E .esiwrehto yriah eb dluow taht gnihtemos ,lufesu gnihtemos ekam ot srehto htiw euqinhcet siht enibmoc nac uoy ,enod s’ti woh dnatsrednu uoy fi tuB .retemarap a yb ¡±etats¡° ecalper ylisae dluoc uoy esuaceb lufesu yrev eb ton yam es rep danoM etatS ehT
sh.MAF ni
class Monad f => MonadToyCheck f where
toyGetChar :: f Char
— Simplifying assumptions: Enough characters, no failure. A practical version
— should add methods for raising and catching EOF exceptions.
toyCheckV2 :: MonadToyCheck f => f Bool
toyCheckV2 =
toyGetChar
>>= \c1 -> toyGetChar
>>= \c2 -> toyGetChar
>>= \c3 -> return ([c1, c2, c3] == “AL\n”)
toyCheckV2 toyGetChar f toyCheckV2
toyGetChar
instance MonadToyCheck IO where
toyGetChar = getChar
realProgram :: IO Bool
realProgram = toyCheck2
data Feeder a = MkFeeder (String -> (String, a))
— Again, simplifying assumptions etc. But basically like the state monad, with
— the state being what’s not yet consumed in the string.
— Unwrap MkFeeder.
unFeeder :: Feeder a -> String -> (String, a)
unFeeder (MkFeeder sf) = sf
instance Monad Feeder where
return a = MkFeeder (\s -> (s, a))
prog1 >>= k = MkFeeder (\s0 -> case unFeeder prog1 s0 of
getChar
instance MonadToyCheck Feeder where
(s1, a) -> unFeeder (k a) s1)
Table of Contents
.gnitset kcom rofyawrehtona,edocnoitcudorprofyaweno,syawtnereffidowtnietaitnatsninacewwoN
.
llac nac ti si swonk ti llA .si ti tahw wonk neve t’nseod dnA . sesoohc resu esuaceB .gnimmargorp lanoitcnuf ylerup ,sdohtem danom , :od nac sgniht ylnO
:gnitset kcom lanoitcnuf ylerup rof swen ekaF sh.MAF ni
:ssalc epyt taht ni cihpromylop eb dluohs cigol rekcehc ehT sh.MAF ni
:snoitarepo dettimrep ,tnaveler eht rof ssalc epyt nwo ruo enfieD :eno s’ereH .lleksaH ni siht od ot syaw lareveS )?dohtem etalpmeT ti si ro( noitcejni ycnednepeD :rewsnA ?kcab ym dniheb ynnuf gnihton dna ot ti tcirtser I od woh rO/dnA ?siht tset I od woH
:edoc noitcudorp roF
sh.MAF ni
sh.MAF ni
— toyGetChar :: Feeder Char
toyGetChar = MkFeeder (\(c:cs) -> (cs, c))
instance Functor Feeder where
fmap f p = p >>= \a -> return (f a)
instance Applicative Feeder where
pure a = MkFeeder (\s -> (s, a))
pf <*> pa = pf >>= \f -> pa >>= \a -> return (f a)
testToyChecker2 :: String -> Bool
testToyChecker2 str = snd (unFeeder toyCheckV2 str)
toyTest1 = testToyChecker2 “ALhello” — should be False
toyTest2 = testToyChecker2 “AL\nhello” — should be True
Table of Contents
sh.MAF ni