- Writerモナド
- Readerモナド
- Stateモナド
- Eitherモナド
class Monad m where
return :: a -> m a
(>>=) :: m a -> (a -> m b) -> m b
...
- モナド則を満たしている
- do記法
- Maybeモナド,リストモナド
isBigGang :: Int -> Bool
isBigGang x = x > 9
これにログをくっつける
isBigGang :: Int -> (Bool, String)
isBigGang x = (x > 9, "Compared gang size to 9.")
ログのついた値,例えば
(3, "Smallish gang.") :: (Int, String)
に isBigGangを食わせたいときにどうすればいいのか?
欲しい型は
(Int, String) -> (Int -> (Bool, String)) -> (Bool, String)
ちょっと一般化して
applyLog :: (a, String) -> (a -> (b, String)) -> (b, String)
とりあえず型を合わせてみる
-- f :: a -> (b, String)
-- x :: a
applyLog (x, log) f = f x
これだと古いログがのこらないので
applyLog (x, log) = let (y, newLog) = f x
in (y, log ++ newLog)
applyLog :: (a, String) -> (a -> (b, String)) -> (b, String)
applyLog (x, log) = let (y, newLog) = f x
in (y, log ++ newLog)
- String は任意の型のリスト [c] にしてもよいのでは?
- ByteString (9章7節)にしても大丈夫そう?
とうことでモノイド(12章)の出番です!
class Monoid m where
mempty :: m
mappend :: m -> m -> m
...
二項演算と単位元があってモノイド則を満たすもの
- リストはモノイド
- mempty = []
- mappend = (++)
- ByteStringはモノイド
モノイドを使うと
applyLog :: (Monoid m) => (a, m) -> (a -> (b, m)) -> (b, m)
applyLog (x, log) = let (y, newLog) = f x
in (y, log `mappend` newLog)
import Data.Monoid
type Food = String
type Price = Sum Int -- mappend = (+) , mempty = 0
addDrink :: Food -> (Food, Price)
addDrink "beans" = ("milk", Sum 25)
addDrink "jerky" = ("whisky", Sum 99)
addDrink _ = ("beer", Sum 30)
Writer w a型がControl.Monad.Writerモジュールにあります
newtype Writer w a = Writer { runWriter :: (a, w) }
instance (Monoid w) => Monad (Writer w) where
-- return :: a -> Writer w a
return x = Writer (x, mempty)
-- (>>=) :: Writer w a -> (a -> Writer w b) -> Writer w b
(Writer (x, v)) >>= f = let (Writer (y, v)) = f x
in Writer (y, v `mappend` v')
import Control.Monad.Writer
logNumber :: Int -> Writer [String] Int
logNumber x = writer (x, ["Got number: " ++ show x])
multWithLog :: Writer [String] Int
multWithLog = do
x <- logNumber 3
y <- logNumber 5
return $ a*b
import Control.Monad.Writer
logNumber :: Int -> Writer [String] Int
logNumber x = writer (x, ["Got number: " ++ show x])
multWithLog :: Writer [String] Int
multWithLog = do
x <- logNumber 3
y <- logNumber 5
tell ["Gonna multiply these two"]
return $ a*b
gcd' :: Int -> Int -> Int
gcd' a b
| b == 0 = a
| otherwise = gcd' b (a `mod` b)
ログを追加してみる
import Control.Monad.Writer
gcd' :: Int -> Int -> Writer [String] Int
gcd' a b
| b == 0 = do
tell ["Finished with " ++ show a]
return a
| otherwise = do
tell [show a ++ " mod " ++ show b ++ " = " ++ show (a `mod` b)]
gcd' b (a` mod` b)
a ++ (b ++ (c ++ (d ++ e))) と (((a ++ b) ++ c) ++ d) ++ e
では効率が全然違う.
-- 0m0.349s
main = putStr $ foldr1 (++) $ map show [1..10000]
-- 0m4.501s
main = putStr $ foldl1 (++) $ map show [1..10000]
gcdReverse :: Int -> Int -> Writer [String] Int
gcdReverse a b
| b == 0 = do
tell ["Finished with " ++ show a]
return a
| otherwise = do
result <- gcdReverse b (a `mod` b)
tell [show a ++ " mod " ++ show b ++ " = " ++ show (a `mod` b)]
return result
[1,2,3] <-> \xs -> [1,2,3] ++ xs
[] <-> \xs -> [] ++ xs
f `append` g = \xs -> f (g xs)
リストではなくリストからリストへの関数
PreludeのShowS型は差分リスト
f = ("dog"++)
g = ("meat"++)
f `append` g = \xs -> "dog" ++ ("meat" ++ xs)
newtype DiffList a = DiffList { getDiffList :: [a] -> [a] }
toDiffList :: [a] -> DiffList a
toDiffList xs = DiffList (xs++)
fromDiffList :: DiffList a -> [a]
fromDiffList f = getDiffList f []
instance Monoid (DiffList a) where
mempty = DiffList (\xs -> [] ++ xs)
f `mappend` g = \xs -> getDiffList f (getDiffList g xs)
よく見ると恒等関数と関数合成になっている
mempty = DiffList id
f `mappend` g = getDiffList f . getDiffList g
finalCountDown :: Int -> Writer (DiffList String) ()
finalCountDown 0 = do
tell $ toDiffList ["0"]
finalCountDown x = do
finalCountDown (x-1)
tell $ toDiffList [show x]
finalCountDown :: Int -> Writer [String] ()
finalCountDown 0 = do
tell ["0"]
finalCountDown x = do
finalCountDown (x-1)
tell [show x]
instance Monad ((->) r) where
-- return :: a -> m a
-- return :: a -> ((->) r a)
-- return :: a -> (r -> a)
return x = \_ -> x
-- (>>=) :: m a -> (a -> m b) -> m b
-- (>>=) :: (->) r a -> (a -> (->) r b) -> ((-> r b))
-- (>>=) :: (r -> a) -> (a -> (r -> b)) -> (r -> b)
-- (>>=) :: (r -> a) -> (a -> r -> b) -> (r -> b)
h >>= f = \w -> f (h w) w
よくわからないのでとりあえず動かしてみる
addStuff :: Int -> Int
addStuff = do
a <- (*2)
b <- (+10)
return $ a + b
書き直すと
addStuff :: Int -> Int
addStuff x = let a = (*2) x
b = (+10) x
in a + b
すべての関数が共通の情報を読むのでReaderモナド
9章で扱った乱数
threeCoins :: StdGen -> (Bool, Bool, Bool)
threeCoins gen = let (firstCoin, newGen) = random gen
(secondCoin, newGen') = random newGen
(thirdCoin, newGen'') = random newGen'
in (firstCoin, secondCoin, thirdCoin)
{-
gen ---> newGen ---> newGen' ---> newGen''
| | |
+-> 1st +-> 2nd +-> 3rd
-}
Haskellでは状態の上書きが出来ない
=> Stateモナドで解決
- Push : スタックのてっぺんに要素を積む
- Pop : スタックのてっぺんの要素を取り除く リストを使って実装してみる
type Stack = [Int]
pop :: Stack -> (Int, Stack)
pop (x:xs) = (x, xs)
push :: Int -> Stack -> ((), Stack)
push a xs = ((), a:xs)
stackManip stack = let
((), newStack1) = push 3 stack
(a, newStack2) = pop newStack1
in pop newStack
Stateモナドを使うとこれが
stackManip = do
push 3
a <- pop
pop
と書ける.
newtype State s a = State { runState :: s -> (a, s) }
-- s -> (a, s)
-- 状態 -- 状態付きの計算 --> (計算結果,新しい状態)
instance Monad (State s) where
-- return :: a -> State s a
return x = State $ \s -> (x, s)
-- (>>=) :: State s a -> (a -> State s b) -> State s b
(State h) >>= f = State $ \s -> let (a, newState) = h s
(State g) = f a
in g newState
import Control.Monad.State
pop :: State Stack Int
pop = state $ \(x:xs) -> (x, xs)
push :: Int -> State Stack ()
push a = state $ \xs -> ((), a:xs)
これを使うと下のように書ける
stackManip = do
push 3
a <- pop
pop
もっと複雑なことも出来る
stackStuff :: State Stack ()
stackStuff = do
a <- pop
if a == 5 then push 5
else do
push 3
push 8
moreStack :: State Stack ()
moreStack = do
a <- stackManip
if a == 100 then stackStuff
else return ()
get :: State s s
get = state $ \s -> (s, s)
put :: s -> State s ()
put newState = state $ \s -> ((), newState)
- get 状態を取得する
- put 状態を設定する
現在のスタックを見たり出来る
stackyStack :: State Stack ()
stackyStack = do
stackNow <- get
if stackNow == [1,2,3]
then put [8,3,1]
else put [9,2,1]
getとputを使ってpopとpush
pop :: State Stack Int
pop = do
(x:xs) <- get
put xs
return x
push :: Int -> State Stack ()
puch x = do
xs <- get
put $ x:xs
冒頭の乱数は
randomSt :: (RandomGen g, Random a) => State g a
randomSt = state random
threeCoins :: State StdGen (Bool, Bool, Bool)
threeCoins = do
a <- randomSt
b <- randomSt
c <- randomSt
return (a, b, c)
- data Either a b = Left a | Right b
- Maybe の強化版
- 失敗した時にメッセージとかを付けれる
instance (Error e) => Monad (Either e) where
return x = Right x
Right x >>= f = f x
Left err >>= f = Left err
fail msg = Left (strMsg msg)
ghci> Left "boom" >>= \x -> return (x+1)
Left "boom"
ghci> Left "boom" >>= \x -> Left "no way!"
Left "no way!"
ghci> Right 100 >>= \x -> Left "no way!"
Left "no way!"
メモ化再帰を用いてフィボナッチ数を求めたいと思います. 以下のプログラムを完成させて下さい.
import Control.Monad.State
import qualified Data.Map as M
type Memo = M.Map Int Integer
-- kの時に値がvになることをメモに追加
add :: Int -> Integer -> State Memo ()
add k v = undefined
-- nがすでにメモに含まれているならばその値を返す
-- nがメモに含まれていない場合はf nを計算し結果をメモ化した後で答えを返す
memo :: (Int -> State Memo Integer) -> Int -> State Memo Integer
memo f n = undefined
fib :: Int -> State Memo Integer
fib 0 = undefined
fib 1 = undefined
fib n = undefined
main = print $ runState (fib 100) M.empty