Skip to content

Instantly share code, notes, and snippets.

@cojna
Created January 9, 2014 08:55
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save cojna/0918920c7a246961227b to your computer and use it in GitHub Desktop.
Save cojna/0918920c7a246961227b to your computer and use it in GitHub Desktop.

すごいHaskell読書会 in 大阪 #14

本日の内容

  • Writerモナド
  • Readerモナド
  • Stateモナド
  • Eitherモナド

復習

Monad型クラス

class Monad m where
  return :: a -> m a
  (>>=) :: m a -> (a -> m b) -> m b
  ...
  • モナド則を満たしている
  • do記法
  • Maybeモナド,リストモナド

Writerモナド

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を食わせたいときにどうすればいいのか?

applyMaybeと同じように

欲しい型は

(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型

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')

Writerモナドのdo記法

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

tell

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]

Readerモナド

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モナド

Stateモナド

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

と書ける.

Stateモナド

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)

Eitherモナド

  • 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment