LYAHFGG!まとめ(Part2)

前置き

Miran Lipovača氏によるHaskellのチュートリアルLearn You a Haskell for Great Good!は大絶賛に値するのですが、説明が丁寧なだけに、一度理解すれば、何度も読み返すには非効率です。そこで、理解した部分について要点を抽出しようと試みたのが本記事です。

Part1ではI/Oの手前までを扱いました。残りを、このPart2で徐々にまとめます。

  • 少しだけ、順番を入れ替えたりサンプルコードを追加した所があります
  • また、☆の部分は私の独り言です
  • 基本的には、コードを示した後でポイントを箇条書きにする、というスタイルになっています
  • 用語、ghciの使い方、及び関数リファレンスは別ページ「LYAHFGG!まとめ(リファレンス)」に整理します

9.Input and Output

Hello, world!

main = putStrLn "hello, world"
  • Haskell版ハローワールド
  • mainは特別な名前
  • 型宣言しないのが慣例
$ ghc --make helloworld
[1 of 1] Compiling Main             ( helloworld.hs, helloworld.o )
Linking helloworld ...
  • コンパイル
$ ./helloworld
hello, world
$ runhaskell helloworld.hs
hello, world
  • 実行
  • runhaskellで、コンパイルと実行を一気に実施
ghci> :t putStrLn
putStrLn :: String -> IO ()
  • putStrLnはIOアクションを返す
  • Haskellから不純な部分を括り出したのがIOアクション
  • そのIOアクションは、実施されると、引数で指定された文字列を表示する
  • そのIOアクションの結果は()になる(☆本記事では「()型のIOアクション」と表現します)
  • 空のタプル()はunitとも呼ばれる
  • ☆unitは型理論の用語で、値を1つしか持たないような型のこと
  • ☆型が重要で、値はどうでも良い場合に重宝するのかな
  • putStrLnを、「文字列を表示する関数」ではなく「(文字列を表示する)IOアクションを返す関数」と解釈するのが大事
main = do
    putStrLn "Hello, what's your name?"
    yourName <- getLine
    putStrLn ("Hey " ++ yourName ++ ", you rock!")
  • doにより、複数のIOアクションをまとめて、1つのIOアクションとする
  • doの最後に実施されるIOアクションの型が、doの型となる
  • getLineは、String型のIOアクション
  • <- により、①IOアクションを実行し、②その結果をIOアクションから取り出し、③yourNameへバインドする
  • IOアクションから結果を取り出す方法は、<- 以外に無い
  • <- を使える場所は、IOアクションの中に限られる
  • doの最後のIOアクションの結果を名前にバインドすることはできない
  • IOアクションが実施されるのは、①mainにバインドされたときか、②別のIOアクションの中にあるときか、③ghciに入力されたとき
  • ☆こういった性質の多くは、実はMonad型クラスに由来する(IOアクションはMonadのインスタンス)
import Data.Char

main = do
    putStrLn "What's your first name?"
    firstName <- getLine
    putStrLn "What's your last name?"
    lastName <- getLine
    let bigFirstName = map toUpper firstName
        bigLastName = map toUpper lastName
    putStrLn $ "hey " ++ bigFirstName ++ " " ++ bigLastName ++ ", how are you?"
  • doの中ではletが使える(inは不要)
  • doの中の複数のIOアクションや、letの中の複数の名前は、インデントを揃える
main = do
    line <- getLine
    if null line
        then return ()
        else do
            putStrLn $ reverseWords line
            main

reverseWords :: String -> String
reverseWords = unwords . map reverse . words
  • doの中のifは、thenにもelseにもIOアクションが必要
  • ☆doの中の式は、全て、IOアクションでなければならない(letを除き)
  • returnは、何もしないIOアクションで、その結果はreturnの引数に指定された値
  • returnに、(doを終わらせる、みたいな)フロー制御の作用は無い
  • mainも再帰可能
main = do
    a <- return "hell"
    b <- return "yeah!"
    putStrLn $ a ++ " " ++ b
  • returnと<-を使ってletと同じ効果を出せるが、普通はletを使う
putStr :: String -> IO ()
putStr [] = return ()
putStr (x:xs) = do
    putChar x
    putStr xs
  • putCharを使ってputStrを実装
  • ()型のIOアクションを返したいので、return ()したり、doでIOアクションをまとめている
import Control.Monad

main = do
    c <- getChar
    when (c /= ' ') $ do
        putChar c
        main
  • whenを使えば、if xxx then yyy else return ()を簡潔に書ける
main = do
    rs <- sequence [getLine, getLine, getLine]
    print rs
  • sequence :: [IO a] -> IO [a]
  • ☆厳密には、sequence :: Monad m => [m a] -> m [a]
  • print :: Show a => a -> IO ()
$ runhaskell seq.hs
a
b
c
["a","b","c"]
  • sequenceにより、String型のIOアクション3つが、[String]型のIOアクションになった
ghci> sequence (map print [1,2,3,4,5])
1
2
3
4
5
[(),(),(),(),()]
  • map print [1,2,3,4,5]だけではIOアクションにならない(IOアクションのリストになる)
  • sequenceを適用するとIOアクション化できる
  • ghciに入力すると、IOアクションが実施され、結果の[(),(),(),(),()]が表示される
  • ghciは、実施したIOアクションの結果が()以外なら、それを表示する
ghci> mapM print [1,2,3]
1
2
3
[(),(),()]
ghci> mapM_ print [1,2,3]
1
2
3
  • mapMは、mapとsequenceを合成して、sequenceと同じ型のIOアクションを返す
  • mapM_もmapMと同じだが、()型のIOアクションを返す
import Control.Monad

main = do
    colors <- forM [1,2,3,4] (\a -> do
        putStrLn $ "Which color do you associate with the number " ++ show a ++ "?"
        color <- getLine
        return color)
    putStrLn "The colors that you associate with 1, 2, 3 and 4 are: "
    mapM_ putStrLn colors
  • forMはmapMと同じだが、引数の順序が逆
  • リストにmapするIOアクションを(複数行に及ぶような)lambdaで書くとき、mapMよりforMの方が読みやすい

Files and streams

import Data.Char

main = do
    contents <- getContents
    putStr (map toUpper contents)
  • getContentsは、lazyなIO
  • デフォルトでは、行単位でバッファリング
main = interact shortLinesOnly

shortLinesOnly :: String -> String
shortLinesOnly input =
    let allLines = lines input
        shortLines = filter (\line -> length line < 10) allLines
        result = unlines shortLines
    in  result
  • interactは、getContentsして、何か加工して、結果をputStrする
ghci> :module + System.IO
ghci> :t openFile
openFile :: FilePath -> IOMode -> IO Handle
ghci> :info FilePath
type FilePath = String
ghci> :info IOMode
data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
ghci> :info Handle
data Handle = GHC.IO.Handle.Types.FileHandle FilePath
  • openFile、IOMode、Handle
  • IO Modeではない
import System.IO

main = do
    handle <- openFile "girlfriend.txt" ReadMode
    contents <- hGetContents handle
    putStr contents
    hClose handle
  • hGetContentsは、ファイル用のgetContents
import System.IO

main = do
    withFile "girlfriend.txt" ReadMode (\handle -> do
        contents <- hGetContents handle
        putStr contents)
  • withFileで、open/closeを自動化
  • (Handle -> IO a)な関数を渡す
main = do
    withFile "something.txt" ReadMode (\handle -> do
        hSetBuffering handle $ BlockBuffering (Just 2048)
        contents <- hGetContents handle
        putStr contents)
  • hSetBufferingで、バッファリングモードを明示可能
ghci> :info BufferMode
data BufferMode
  = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
  • テキストファイルは、デフォルトでLineBuffering
  • バイナリファイルは、デフォルトでBlockBuffering Nothing
  • Nothingの場合、ブロックサイズはOS依存
import System.IO
import System.Directory
import Data.List

main = do
    handle <- openFile "todo.txt" ReadMode
    (tempName, tempHandle) <- openTempFile "." "temp"
    contents <- hGetContents handle
    let todoTasks = lines contents
        numberedTasks = zipWith (\n line -> show n ++ " - " ++ line) [0..] todoTasks
    putStrLn "These are your TO-DO items:"
    putStr $ unlines numberedTasks
    putStrLn "Which one do you want to delete?"
    numberString <- getLine
    let number = read numberString
        newTodoItems = delete (todoTasks !! number) todoTasks
    hPutStr tempHandle $ unlines newTodoItems
    hClose handle
    hClose tempHandle
    removeFile "todo.txt"
    renameFile tempName "todo.txt"
  • openTempFileで、カレントディレクトリ(.)に、名前がtempで始まる一時ファイルを作成

Command line arguments

import System.Environment
import Data.List

main = do
    args <- getArgs
    progName <- getProgName
    putStrLn "The arguments are:"
    mapM putStrLn args
    putStrLn "The program name is:"
    putStrLn progName

Randomness

ghci> :m + System.Random
ghci> :t random
random :: (RandomGen g, Random a) => g -> (a, g)
ghci> :i RandomGen
class RandomGen g where
  next :: g -> (Int, g)
  split :: g -> (g, g)
  genRange :: g -> (Int, Int)
  • 乱数生成には、RandomGenとRandomが必要
  • Integet、int、Float、Double、Char、BoolがRandomのインスタンス
ghci> random (mkStdGen 100) :: (Int, StdGen)
(-1352021624,651872571 1655838864)
ghci> random (mkStdGen 100) :: (Bool, StdGen)
(True,4041414 40692)
ghci> random (mkStdGen 100) :: (Int, StdGen)
(-1352021624,651872571 1655838864)
  • mkStdGenで、StdGen型のデータを得る
  • StdGenはRandomGenのインスタンス
  • 型注釈により、randomに返して欲しい乱数値の型を指定
  • mkStdGetに渡す種が同じなら、randomが返す乱数値も同じ
threeCoins :: StdGen -> (Bool, Bool, Bool)
threeCoins gen =
    let (firstCoin, newGen) = random gen
        (secondCoin, newGen') = random newGen
        (thirdCoin, newGen'') = random newGen'
    in  (firstCoin, secondCoin, thirdCoin)
  • threeConinsの型を見れば乱数値はBoolと分かるので、random呼び出しに型注釈は不要
  • randomが返したRandomGenを次のrandomの引数に与える
ghci> take 5 $ randoms (mkStdGen 11) :: [Int]
[-1807975507,545074951,-1015194702,-1622477312,-502893664]
  • randomsは乱数の無限リストを作る
  • 無限リストなので、RandomGenを返せない
finiteRandoms :: (RandomGen g, Random a, Num n) => n -> g -> ([a], g)
finiteRandoms 0 gen = ([], gen)
finiteRandoms n gen =
    let (value, newGen) = random gen
        (restOfList, finalGen) = finiteRandoms (n-1) newGen
    in  (value:restOfList, finalGen)
  • 有限リストなら、RandomGenを返せる
ghci> randomR (1,6) (mkStdGen 359353)
(6,1494289578 40692)
  • レンジを指定
import System.Random

main = do
    gen <- getStdGen
    putStrLn $ take 20 (randomRs ('a','z') gen)
    gen' <- newStdGen
    putStr $ take 20 (randomRs ('a','z') gen')
  • getStdGenやnewStdGenなら、種はシステム任せ
  • getStdGenは毎回同じ、newStdGenは毎回違う

Bytestrings

import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString as S
  • ByteStringは、Word8(8bit値)のリスト
  • lazy版とstrict(非lazy)版がある
  • lazy版も、完全にlazyではなく、最大64Kバイトの塊(Chunk)単位で評価する
ghci> B.pack [99,97,110]
Chunk "can" Empty
ghci> B.pack [98..120]
Chunk "bcdefghijklmnopqrstuvwx" Empty
ghci> B.pack [256]
Chunk "\NUL" Empty
ghci> B.pack [336]
Chunk "P" Empty
  • packで、普通のリストをByteString化
  • 255を超える部分は切り捨て
ghci> B.fromChunks [S.pack [40,41,42], S.pack [43,44,45], S.pack [46,47,48]]
Chunk "()*" (Chunk "+,-" (Chunk "./0" Empty))
ghci> foldr B.cons B.empty [50..60]
Chunk "2" (Chunk "3" (Chunk "4" (Chunk "5" (Chunk "6" (Chunk "7" (Chunk "8" (Chunk "9" (Chunk ":" (Chunk ";" (Chunk "<"
Empty))))))))))
ghci> foldr B.cons' B.empty [50..60]
Chunk "23456789:;<" Empty
  • 複数のChunkを連結
  • fromChunksやconsでは個々のChunkが保たれるが、cons'は、内部的に1つのChunkへ統合する
import System.Environment
import qualified Data.ByteString.Lazy as B

main = do
    (fileName1:fileName2:_) <- getArgs
    copyFile fileName1 fileName2

copyFile :: FilePath -> FilePath -> IO ()
copyFile source dest = do
    contents <- B.readFile source
    B.writeFile dest contents
  • lazy版ByteStringを使ってファイルをコピー

Exceptions

  • 例外はIOアクション内でのみキャッチできる
  • 例外よりも、EitherやMaybeで異常系を扱う方がHaskellのスタイル
import System.Environment
import System.IO
import System.IO.Error

main = toTry `catch` handler

toTry :: IO ()
toTry = do (fileName:_) <- getArgs
           contents <- readFile fileName
           putStrLn $ "The file has " ++ show (length (lines contents)) ++ " lines!"

handler :: IOError -> IO ()
handler e = putStrLn "Whoops, had some trouble!"
  • catch関数で例外をキャッチ
  • 例外の型はIOError
  • ハンドラはIO ()を返す
handler :: IOError -> IO ()
handler e
    | isDoesNotExistError e = putStrLn "The file doesn't exist!"
    | otherwise = ioError e
  • ioErrorで再throw
ioError $ userError "remote computer unplugged!"
  • userErrorでIOErrorを生成
handler e
    | isDoesNotExistError e =
        case ioeGetFileName e of Just path -> putStrLn $ "Whoops! File does not exist at: " ++ path
                                 Nothing -> putStrLn "Whoops! File does not exist at unknown location!"
    | otherwise = ioError e
  • ioeGetFileNameで、ファイルパス(Maybe FilePath)を取得
main = do toTry `catch` handler1
          thenTryThis `catch` handler2
          launchRockets
  • 複数のtry部(と、それぞれのcatch)に分けてもOK
  • ☆thenTryThisとlaunchRocketsは自分で書け、ってこと?

10.Functionally Solving Problems

Reverse Polish notation calculator

  • 逆ポーランド記法の計算機
import Data.List

solveRPN :: (Num a, Read a) => String -> a
solveRPN = head . foldl foldingFunction [] . words
    where   foldingFunction (x:y:ys) "*" = (x * y):ys
            foldingFunction (x:y:ys) "+" = (x + y):ys
            foldingFunction (x:y:ys) "-" = (y - x):ys
            foldingFunction xs numberString = read numberString:xs
ghci> solveRPN "10 4 3 + 2 * -"
-4

Heathrow to London

                 A1         A2         A3        A4
       A----50----+---- 5----+----40----+----10----
                  |          |          |         |
START            30         20         25         0    GOAL
                  |          |          |         |
       B----10----+----90----+---- 2----+---- 8----
                 B1         B2         B3        B4
  • STARTからGOALへ至る最短経路を検索する
data Section = Section { getA :: Int, getB :: Int, getC :: Int } deriving (Show)
type RoadSystem = [Section]
  • コの字形を1つのSectionと見なして、3つの所要時間で道路をモデリング
heathrowToLondon :: RoadSystem
heathrowToLondon = [Section 50 10 30, Section 5 90 20, Section 40 2 25, Section 10 8 0]
  • ヒースローからロンドンへの道路
data Label = A | B | C deriving (Show)
type Path = [(Label, Int)]
  • Aが上の通り
  • Bが下の通り
  • Cが、AB間の筋
  • 道路と所要時間のタプルのリストでPathを表現
roadStep :: (Path, Path) -> Section -> (Path, Path)
roadStep (pathA, pathB) (Section a b c) =
    let priceA = sum $ map snd pathA
        priceB = sum $ map snd pathB
        forwardPriceToA = priceA + a
        crossPriceToA = priceB + b + c
        forwardPriceToB = priceB + b
        crossPriceToB = priceA + a + c
        newPathToA = if forwardPriceToA <= crossPriceToA
                        then (A,a):pathA
                        else (C,c):(B,b):pathB
        newPathToB = if forwardPriceToB <= crossPriceToB
                        then (B,b):pathB
                        else (C,c):(A,a):pathA
    in  (newPathToA, newPathToB)
  • 交差点AnまでのPathと交差点BnまでのPathのタプルと、次の(つまりn+1の)Sectionを引数にとり
  • An+1までのPathとBn+1までのPathのタプルを返す
optimalPath :: RoadSystem -> Path
optimalPath roadSystem =
    let (bestAPath, bestBPath) = foldl roadStep ([],[]) roadSystem
    in  if sum (map snd bestAPath) <= sum (map snd bestBPath)
            then reverse bestAPath
            else reverse bestBPath
  • 最短のPathを返す関数
ghci> optimalPath heathrowToLondon
[(B,10),(C,30),(A,5),(C,20),(B,2),(B,8),(C,0)]
  • 解けた!!
groupsOf :: Int -> [a] -> [[a]]
groupsOf 0 _ = undefined
groupsOf _ [] = []
groupsOf n xs = take n xs : groupsOf n (drop n xs)
  • 数字のリストを3つずつに区切る関数
import Data.List

main = do
    contents <- getContents
    let threes = groupsOf 3 (map read $ lines contents)
        roadSystem = map (\[a,b,c] -> Section a b c) threes
        path = optimalPath roadSystem
        pathString = concat $ map (show . fst) path
        pathPrice = sum $ map snd path
    putStrLn $ "The best path to take is: " ++ pathString
    putStrLn $ "The price is: " ++ show pathPrice
  • 数字のリストを読み、
  • Sectionのリスト(つまりRoadSystem)に変換し、
  • 最短ルートを表示する
$ cat paths.txt
50
10
30
5
90
20
40
2
25
10
8
0
$ cat paths.txt | runhaskell heathrow.hs
The best path to take is: BCACBBC
The price is: 75

11.Functors, Applicative Functors and Monoids

Functors redux

main = do line <- fmap reverse getLine
          putStrLn $ "You said " ++ line ++ " backwards!"
          putStrLn $ "Yes, you really said" ++ line ++ " backwards!"
  • Functorとは、mapできるもの
  • IOアクションはFunctor
  • Functorの種は* -> *
  • ☆Functorとは、あるコンテキストを伴った値
  • ☆コンテキストという表現が抽象的だが、そこは具体例を見て理解するしかない
  • ☆fmapは、Functorが収納している値対して関数を適用する関数
  • ☆関数適用後も、以前としてコンテキストは伴ったまま
ghci> :info (->)
data (->) a b   -- Defined in GHC.Prim
  • 関数の型に出てくる -> は、型コンストラクタ
  • 2つの具象型(aとb)を引数にとる
  • 部分適用して((->) r)とすれば、1つの具象型を引数にとり具象型を返す関数
  • ☆なぜか、((->) a)ではなく、((->) r)とする
  • その種は* -> *
  • つまり(fmapを定義すれば)Functorになれる
instance Functor ((->) r) where
    fmap f g = (\x -> f (g x))
  • ((->) r)に対するfmapは、関数合成
ghci> :t (+100)
(+100) :: Num a => a -> a
ghci> fmap (*3) (+100) 1
303
  • ☆(+100)は、「引数に100を足した結果」というコンテキスト
  • ☆そのコンテキストに、fmapで「3をかける」という関数を適用すると
  • ☆「引数に100を足して3をかけた結果」というコンテキストに変わる

Functorのfmapを定義するときは、下記の指針に従うべき。

  • fmap id = id
  • fmap (f . g) = fmap f . fmap g

Applicative functors

class (Functor f) => Applicative f where
    pure :: a -> f a
    (<*>) :: f (a -> b) -> f a -> f b
  • 型クラスApplicative
  • Control.Applicativeモジュールで定義
  • Functorの一種
ghci> pure "Hey" :: [String]
["Hey"]
ghci> pure "Hey" :: Maybe String
Just "Hey"
  • リストもMaybeもApplicative
  • 関数pureは、何かをコンテキストに収納する補助的な関数
  • 必要に応じて型注釈を付ける
  • リストに収納する場合は、シングルトンになる
ghci> Just length <*> Just "abc"
Just 3
ghci> pure length <*> Just "abc"
Just 3
ghci> pure length <*> (pure "abc" :: Maybe String)
Just 3
  • 関数<*>により、Maybeというコンテキストに収納された関数([a] -> Int)を、同じくMaybeコンテキストに収納された値([Char])へ適用
  • <*>の右辺がMaybeなので、左辺のpureには型注釈が要らない
ghci> pure (+) <*> Just 3 <*> Just 5
Just 8
  • 部分適用を利用
  • まず最初の<*>でMaybe (a -> a)を得る
  • それをJust 5へ適用
ghci> length <$> Just "abc"
Just 3
ghci> (++) <$> Just "johntra" <*> Just "volta"
Just "johntravolta"
  • pureと<*>を一気にやってくれるのが、関数<$>
  • fmap length (Just "abc")と同じこと
ghci> [(*0),(+100),(^2)] <*> [1,2,3]
[0,0,0,101,102,103,1,4,9]
ghci> [(+),(*)] <*> [1,2] <*> [3,4]
[4,5,5,6,3,4,6,8]
ghci> (++) <$> ["ha","heh","hmm"] <*> ["?","!","."]
["ha?","ha!","ha.","heh?","heh!","heh.","hmm?","hmm!","hmm."]
  • リストの<*>は、直積で適用
  • リストを、非決定性というコンテキストを持った値と見なす
  • [1,2,3]は、1か2か3のどれか
  • よって、リストの<*>は、全ての非決定性の組み合わせになる
ghci> [ x*y | x <- [2,5,10], y <- [8,10,11]]
[16,20,22,40,50,55,80,100,110]
ghci> (*) <$> [2,5,10] <*> [8,10,11]
[16,20,22,40,50,55,80,100,110]
  • リスト内包で書くのと同じこと
myAction :: IO String
myAction = (++) <$> getLine <*> getLine
  • IOアクションもApplicativeなので<*>できる
instance Applicative ((->) r) where
    pure x = (\_ -> x)
    f <*> g = \x -> f x (g x)
  • ((->) r)もApplicative
ghci> pure 3 "blah"
3
ghci> (+) <$> (+3) <*> (*100) $ 5
508
ghci> (\x y z -> [x,y,z]) <$> (+3) <*> (*2) <*> (/2) $ 5
[8.0,10.0,2.5]
  • pure 3は、「引数を無視して3を結果とする」というコンテキスト
  • Control.Applicativeモジュールをインポートしておくこと
ghci> getZipList $ (+) <$> ZipList [1,2,3] <*> ZipList [100,100,100]
[101,102,103]
ghci> getZipList $ (+) <$> ZipList [1,2,3] <*> pure 100
[101,102,103]
ghci> getZipList $ (,,) <$> ZipList "dog" <*> ZipList "cat" <*> ZipList "rat"
[('d','c','r'),('o','a','a'),('g','t','t')]
  • ZipListはApplicative
  • 普通のリストは、<*>が直積扱いされるが、ZipListはzip扱いされる
  • ZipListのpureは、無限リストを収納する
  • (,,)は、3つの引数をタプル化する関数
ghci> liftA2 (:) (Just 3) (Just [4])
Just [3,4]
ghci> (:) <$> Just 3 <*> Just [4]
Just [3,4]
  • liftA2は、<$>して<*>する
sequenceA :: (Applicative f) => [f a] -> f [a]
sequenceA [] = pure []
sequenceA (x:xs) = (:) <$> x <*> sequenceA xs
  • 複数のApplicativeを結合する関数sequenceA
ghci> sequenceA [Just 3, Just 2, Just 1]
Just [3,2,1]
  • ☆liftA2 (:)の無限個引数バージョンみたいなもの
sequenceA :: (Applicative f) => [f a] -> f [a]
sequenceA = foldr (liftA2 (:)) (pure [])
  • foldrとliftA2でも書ける
ghci> sequenceA [(+3),(+2),(+1)] 3
[6,5,4]
  • 3つの関数を1つの関数に結合
  • その型は、Num a => a -> [a]
  • その関数を引数3へ適用した
ghci> sequenceA [[4,5,6]]
[[4],[5],[6]]
ghci> sequenceA [[1,2,3],[4,5,6]]
[[1,4],[1,5],[1,6],[2,4],[2,5],[2,6],[3,4],[3,5],[3,6]]
  • リストは、非決定性コンテキスト
ghci> map (\f -> f 7) [(>4),(<10),odd]
[True,True,True]
ghci> sequenceA [(>4),(<10),odd] 7
[True,True,True]
  • ある値へ複数の関数を適用し、結果をリストで得る
ghci> sequenceA [getLine, getLine, getLine]
heyh
ho
woo
["heyh","ho","woo"]
  • IOアクションに対してもsequenceAは使える

Applicativeのpureや<*>を定義するときは、下記の指針に従うべき。

  • pure f <*> x = fmap f x
  • pure id <*> v = v
  • pure (.) <*> u <*> v <*> w = u <*> (v <*> w)
  • pure f <*> pure x = pure (f x)
  • u <*> pure y = pure ($ y) <*> u

The newtype keyword

data ZipList a = ZipList { getZipList :: [a] }
  • もし型ZipListを、Record syntaxを使って定義するとしたら、こんな感じ
newtype ZipList a = ZipList { getZipList :: [a] }
  • 実際は、newtypeで定義されている
  • 既存の型をベースにして、別の型を作るのがnewtype
  • dataで定義された型よりも速く、しかもlazy
  • ただし、複数の値コンストラクタや、複数のフィールドを持つ場合は、newtypeは使えない
newtype CharList = CharList { getCharList :: [Char] } deriving (Eq, Show)
  • derivingも使える
newtype Pair b a = Pair { getPair :: (a,b) }
instance Functor (Pair c) where
    fmap f (Pair (x,y)) = Pair (f x, y)
  • newtypeで定義した型でも、(dataと同様に)型クラスのインスタンスにできる
ghci> getPair $ fmap (*100) (Pair (2,3))
(200,3)
  • Pairを、Functorとして使えるようになった
data CoolBool = CoolBool { getCoolBool :: Bool }

helloMe :: CoolBool -> String
helloMe (CoolBool _) = "hello"

newtype CoolBool' = CoolBool' { getCoolBool' :: Bool }

helloMe' :: CoolBool' -> String
helloMe' (CoolBool' _) = "hello"
  • dataで定義したCoolBoolと、newtypeで定義したCoolBool'との比較
  • CoolBool'はlazy
ghci> helloMe undefined
"*** Exception: Prelude.undefined
ghci> helloMe' undefined
"hello"
  • undefinedは、評価されると例外を発生させる値

Monoids

ghci> (3 * 4) * 5
60
ghci> 3 * (4 * 5)
60
  • 数値に対する*には、結合性がある
  • つまり、どちらから先に計算しても結果は同じ
class Monoid m where
    mempty :: m
    mappend :: m -> m -> m
    mconcat :: [m] -> m
    mconcat = foldr mappend mempty
  • Monoidは、Data.Monoidモジュールで定義されている
  • 単位元と結合性を抽象化した型クラス
ghci> [1,2,3] `mappend` [4,5,6]
[1,2,3,4,5,6]
ghci> mempty :: [a]
[]
  • リストはMonoid
newtype Product a =  Product { getProduct :: a }
    deriving (Eq, Ord, Read, Show, Bounded)

instance Num a => Monoid (Product a) where
    mempty = Product 1
    Product x `mappend` Product y = Product (x * y)

newtype Sum a = Sum {getSum :: a}
ghci> getProduct $ Product 3 `mappend` Product 9
27
ghci> getProduct $ Product 3 `mappend` mempty
3
ghci> getSum $ Sum 2 `mappend` Sum 9
11
ghci> getSum $ mempty `mappend` Sum 3
3
ghci> getAny $ Any True `mappend` Any False
True
ghci> getAny $ mempty `mappend` Any True
True
ghci> getAll $ mempty `mappend` All True
True
ghci> LT `mappend` GT
LT
ghci> mempty `mappend` GT
GT
  • Product、Sum、Any、AllはData.Monoidモジュールで定義
  • すべてMonoid

Monoidの関数を定義するときは、下記の指針に従うべき。

  • mempty `mappend` x = x
  • x `mappend` mempty = x
  • (x `mappend` y) `mappend` z = x `mappend` (y `mappend` z)
import Data.Monoid

lengthCompare :: String -> String -> Ordering
lengthCompare x y = (length x `compare` length y) `mappend`
                    (vowels x `compare` vowels y) `mappend`
                    (x `compare` y)
    where vowels = length . filter (`elem` "aeiou")
  • 長さ、母音の数、文字、の順でタイブレークする比較関数
instance Monoid a => Monoid (Maybe a) where
    mempty = Nothing
    Nothing `mappend` m = m
    m `mappend` Nothing = m
    Just m1 `mappend` Just m2 = Just (m1 `mappend` m2)
  • MaybeをMonoid化する
  • 型クラス制約(Monoid a)に注意
ghci> Just LT `mappend` Nothing
Just LT
ghci> Just (Sum 3) `mappend` Just (Sum 4)
Just (Sum {getSum = 7})
  • Maybeの中身もMonoidじゃないとダメ
newtype First a = First { getFirst :: Maybe a }
    deriving (Eq, Ord, Read, Show)

instance Monoid (First a) where
    mempty = First Nothing
    First (Just x) `mappend` _ = First (Just x)
    First Nothing `mappend` x = x
  • 中身がMonoidじゃなくてもOKなバージョンをnewtypeで定義
ghci> getFirst $ First (Just 'a') `mappend` First (Just 'b')
Just 'a'
  • mappendに対しては、単純に、左辺を返す
ghci> import qualified Data.Foldable as F
ghci> F.foldl (+) 2 (Just 9)
11
  • リスト以外の型に対してfold的処理を行うには、Data.Foldableモジュールを使う
instance F.Foldable Tree where
    foldMap f Empty = mempty
    foldMap f (Node x l r) = F.foldMap f l `mappend`
                             f x           `mappend`
                             F.foldMap f r

testTree = Node 5
            (Node 3
                (Node 1 Empty Empty)
                (Node 6 Empty Empty)
            )
            (Node 9
                (Node 8 Empty Empty)
                (Node 10 Empty Empty)
            )
  • Treeを、Foldable型クラスのインスタンスとする
ghci> F.foldl (+) 0 testTree
42
ghci> getAny $ F.foldMap (\x -> Any $ x == 3) testTree
True
ghci> F.foldMap (\x -> [x]) testTree
[1,3,6,5,8,9,10]
  • foldMapの引数に渡す関数は、Monoidを返すこと
  • コンテキストに収納された各情報へ関数を適用し、結果はmappendでfoldする

12.A Fistful of Monads

(>>=) :: (Monad m) => m a -> (a -> m b) -> m b
  • コンテキストに包まれた値m aへ、aを取りm bを返す関数を適用する
  • >>=はbindと発音する

Getting our feet wet with Maybe

The Monad type class

class Monad m where
    return :: a -> m a

    (>>=) :: m a -> (a -> m b) -> m b

    (>>) :: m a -> m b -> m b
    x >> y = x >>= \_ -> y

    fail :: String -> m a
    fail msg = error msg
  • mに型クラス制約(Applicative m) =>とかは付かない
  • なぜなら、ApplicativeはMonadoの後に考案されたので
  • returnはApplicativeのpureと同じ
ghci> return "WHAT" :: Maybe String
Just "WHAT"
ghci> Just 9 >>= \x -> return (x*10)
Just 90

Walk the line

  • 綱渡りの問題
  • バランス棒の左右にとまる鳥の差が3羽を超えると落下
landLeft :: Birds -> Pole -> Pole
landLeft n (left,right) = (left + n,right)

landRight :: Birds -> Pole -> Pole
landRight n (left,right) = (left,right + n)
  • PoleはIntのペア(タプル)
  • 左右の鳥の数
ghci> landLeft 2 (0,0)
(2,0)
  • 左に2羽とまった
x -: f = f x
  • 読みやすくするために関数-:を定義
ghci> (0,0) -: landLeft 1 -: landRight 1 -: landLeft 2
(3,1)
  • こんな風に書ける
ghci> (0,0) -: landLeft 1 -: landRight 4 -: landLeft (-1) -: landRight (-2)
(0,2)
  • 途中で(0,4)になるので落下するはず
landLeft :: Birds -> Pole -> Maybe Pole
landLeft n (left,right)
    | abs ((left + n) - right) < 4 = Just (left + n, right)
    | otherwise                    = Nothing

landRight :: Birds -> Pole -> Maybe Pole
landRight n (left,right)
    | abs (left - (right + n)) < 4 = Just (left, right + n)
    | otherwise                    = Nothing
  • 落下を表現できるよう、Maybeコンテキストで包む
ghci> return (0,0) >>= landLeft 1 >>= landRight 4 >>= landLeft (-1) >>= landRight (-2)
Nothing
  • ここでモナド登場
  • landLeft (-1)のところでNothingになったはず
banana :: Pole -> Maybe Pole
banana _ = Nothing
  • 強制的にNothingにする関数banana
ghci> return (0,0) >>= landLeft 1 >>= banana >>= landRight 1
Nothing
  • バナナで落下
(>>) :: (Monad m) => m a -> m b -> m b
m >> n = m >>= \_ -> n
  • bananaを一般化した関数>>
  • 現在の値mを無視してnを返す
ghci> Nothing >> Just 3
Nothing
ghci> Just 3 >> Just 4
Just 4
ghci> Just 3 >> Nothing
Nothing
  • 基本的には右側のオペランドを返す
  • ただし、Maybeコンテキストなので、左オペランドがNothingならNothingを返す
ghci> return (0,0) >>= landLeft 1 >> Nothing >>= landRight 1
Nothing
  • bananaの代わりに、>> Nothingを使った

do notation

ghci> Just 3 >>= (\x -> Just "!" >>= (\y -> Just (show x ++ y)))
Just "3!"
ghci> let x = 3; y = "!" in show x ++ y
"3!"
  • >>=のネストは、let式と似ている
foo :: Maybe String
foo = Just 3   >>= (\x ->
      Just "!" >>= (\y ->
      Just (show x ++ y)))
  • 同様の処理を関数化してみる
foo :: Maybe String
foo = do
    x <- Just 3
    y <- Just "!"
    Just (show x ++ y)
  • do記法で書く
  • 実はdoは、複数の>>=のネストを1つにまとめる、モナド専用の記法
  • ☆自動的にコンテキストは連鎖する
  • 各ステップの結果が、Just XかNothingかを気にする必要は無い
  • 最後のステップはdoの結果を決めるためのものなので、<-でバインドすることはできない(というかナンセンス)
routine :: Maybe Pole
routine = do
    start <- return (0,0)
    first <- landLeft 2 start
    second <- landRight 2 first
    landLeft 1 second
  • 綱渡りも、こんな風に書ける
routine :: Maybe Pole
routine = do
    start <- return (0,0)
    first <- landLeft 2 start
    Nothing
    second <- landRight 2 first
    landLeft 1 second
  • このNothingのように、<-でバインドしない場合、Nothing >>とするようなもの
  • routineの結果はNothing(☆コンテキストの連鎖は自動だから)
justH :: Maybe Char
justH = do
    (x:xs) <- Just "hello"
    return x
  • <-でパターンマッチさせることも可能
  • doの中でパターンマッチが失敗すると、fail関数の値が使われる
  • これに対し、let式でパターンマッチが失敗すると、errorになる
fail _ = Nothing
  • Maybeのfail関数
wopwop :: Maybe Char
wopwop = do
    (x:xs) <- Just ""
    return x
  • wopwopの結果はNothing

The list monad

instance Monad [] where
    return x = [x]
    xs >>= f = concat (map f xs)
    fail _ = []
  • リストもMonad
ghci> [3,4,5] >>= \x -> [x,-x]
[3,-3,4,-4,5,-5]
  • 各要素へ関数を適用してconcatする
ghci> [] >>= \x -> ["bad","mad","rad"]
[]
ghci> [1,2,3] >>= \x -> []
[]
  • 空リストの場合
ghci> [1,2] >>= \n -> ['a','b'] >>= \ch -> return (n,ch)
[(1,'a'),(1,'b'),(2,'a'),(2,'b')]
  • ネストさせると直積
listOfTuples :: [(Int,Char)]
listOfTuples = do
    n <- [1,2]
    ch <- ['a','b']
    return (n,ch)
  • 同じ処理をdoで書ける
  • このシンタックスシュガーがリスト内包表記
class Monad m => MonadPlus m where
    mzero :: m a
    mplus :: m a -> m a -> m a

instance MonadPlus [] where
    mzero = []
    mplus = (++)

guard :: (MonadPlus m) => Bool -> m ()
guard True = return ()
guard False = mzero
  • リスト内包のフィルタリング条件の正体は、guard関数とMonadPlus型クラス
  • guard関数は、引数が真なら空タプルをコンテキストに包んで返す
ghci> guard (5 > 2) :: Maybe ()
Just ()
ghci> guard (1 > 2) :: Maybe ()
Nothing
ghci> guard (5 > 2) :: [()]
[()]
ghci> guard (1 > 2) :: [()]
[]
  • guardにとっては、Nothingや[]にならないことが大事
  • 非Nothingや非[]な値なら何でも良い
  • そこで、当たり障りの無い空タプル(☆unit)を使う
ghci> [ x | x <- [1..50], '7' `elem` show x ]
[7,17,27,37,47]
ghci> [1..50] >>= (\x -> guard ('7' `elem` show x) >> return x)
[7,17,27,37,47]
  • >>することにより、guardが返す[()]は無視される運命
  • つまり、[()]はダミーの返り値
sevensOnly :: [Int]
sevensOnly = do
    x <- [1..50]
    guard ('7' `elem` show x)
    return x
  • doで書いた
  • もしreturn xを忘れると(しかもsevensOnlyの型宣言を書いてないと)、sevensOnlyは[(), (), (), (), ()]を返す

Monad laws

Monadの関数を定義するときは、下記の指針に従うべき。

  • return x >>= f = f x
  • m >>= return = m
  • (m >>= f) >>= g = m >>= (\x -> f x >>= g)
(<=<) :: (Monad m) => (b -> m c) -> (a -> m b) -> (a -> m c)
f <=< g = (\x -> g x >>= f)
  • 2つの関数を合成
ghci> let f x = [x,-x]
ghci> let g x = [x*3,x*2]
ghci> let h = f <=< g
ghci> h 3
[9,-9,6,-6]

3つの指針を<=<で書き直すと…。

  • f <=< return = f
  • return <=< f = f
  • f <=< (g <=< h) = (f <=< g) <=< h

13.For a Few Monads More

C:\WINDOWS\system32>ghc-pkg list |grep mtl
    mtl-2.0.1.0
  • インストール済みパッケージの一覧
  • パッケージは、モジュールを集めたもの
  • mtlパッケージには、いろんなモナドが定義されている

Writer? I hardly know her!

isBigGang :: Int -> (Bool, String)
isBigGang x = (x > 9, "Compared gang size to 9.")
  • 結果と共に、ログ的な情報を持たせてみた
applyLog :: (a,String) -> (a -> (b,String)) -> (b,String)
applyLog (x,log) f = let (y,newLog) = f x in (y,log ++ newLog)
  • モナドの>>=のような関数applyLogを定義
ghci> (3, "Smallish gang.") `applyLog` isBigGang
(False,"Smallish gang.Compared gang size to 9")
ghci> (30, "A freaking platoon.") `applyLog` isBigGang
(True,"A freaking platoon.Compared gang size to 9")
  • applyLogにより、ログが追記されていく
  • だからWriter
applyLog :: (a,[c]) -> (a -> (b,[c])) -> (b,[c])
  • ログの型を一般化して、リストに変える
applyLog :: (Monoid m) => (a,m) -> (a -> (b,m)) -> (b,m)
applyLog (x,log) f = let (y,newLog) = f x in (y,log `mappend` newLog)
  • さらに一般化して、Monoidに変える
  • Monoidにはmappendがあるので好都合
import Data.Monoid

type Food = String
type Price = Sum Int

addDrink :: Food -> (Food,Price)
addDrink "beans" = ("milk", Sum 25)
addDrink "jerky" = ("whiskey", Sum 99)
addDrink _ = ("beer", Sum 30)
  • Sum IntはMonoid
ghci> ("beans", Sum 10) `applyLog` addDrink
("milk",Sum {getSum = 35})
ghci> ("jerky", Sum 25) `applyLog` addDrink
("whiskey",Sum {getSum = 124})
ghci> ("dogmeat", Sum 5) `applyLog` addDrink
("beer",Sum {getSum = 35})
  • フードに合うドリンクをセットして合計金額を出す
newtype Writer w a = Writer { runWriter :: (a, w) }

instance (Monoid w) => Monad (Writer w) where
    return x = Writer (x, mempty)
    (Writer (x,v)) >>= f = let (Writer (y, v')) = f x in Writer (y, v `mappend` v')
  • Writerは、Control.Monad.Writerモジュールが定義する
  • aが結果
  • wがログ
  • failを実装してないので、doの中で失敗すると例外が発生する
ghci> runWriter (return 3 :: Writer String Int)
(3,"")
ghci> runWriter (return 3 :: Writer (Sum Int) Int)
(3,Sum {getSum = 0})
ghci> runWriter (return 3 :: Writer (Product Int) Int)
(3,Product {getProduct = 1})
  • returnで、ログの初期値が決まる
  • ログに使うMonoidに応じて、ログの初期値が決まる
import Control.Monad.Writer

logNumber :: Int -> Writer [String] Int
logNumber x = Writer (x, ["Got number: " ++ show x])

multWithLog :: Writer [String] Int
multWithLog = do
    a <- logNumber 3
    b <- logNumber 5
    return (a*b)
  • 計算の過程をログに記録しながら、3と5をかける関数
ghci> runWriter multWithLog
(15,["Got number: 3","Got number: 5"])
  • ログが、Stringのリストとして残る
ghci> :info MonadWriter
class (Monoid w, Monad m) => MonadWriter w m | m -> w where
  tell :: w -> m ()
  listen :: m a -> m (a, w)
  pass :: m (a, w -> w) -> m a
  • MonadWriteのtellは、指定したMonoid値をログとして持つWriterを返す
multWithLog :: Writer [String] Int
multWithLog = do
    a <- logNumber 3
    b <- logNumber 5
    tell ["Gonna multiply these two"]
    return (a*b)
  • tellを使って、任意のログを追記できる
ghci> runWriter multWithLog
(15,["Got number: 3","Got number: 5","Gonna multiply these two"])
  • 乗算結果には影響を与えない
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)
  • ログ付きバージョン
ghci> fst $ runWriter (gcd' 8 3)
1
ghci> mapM_ putStrLn $ snd $ runWriter (gcd' 8 3)
8 mod 3 = 2
3 mod 2 = 1
2 mod 1 = 0
Finished with 1
  • ログ部はStringのリストなので、それぞれに、putStrLnをmapして表示
a ++ (b ++ (c ++ (d ++ (e ++ f))))
  • gcd'のログ部は、fで始まって、e、d、c、b、aを、順にヘッドへ付け足す形で作られる
((((a ++ b) ++ c) ++ d) ++ e) ++ f
  • もし、aで始まって、b、c、d、e、fの順にテールへ付け足す形になっていたら、超遅いだろう
import Control.Monad.Writer

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
  • ログの作り方が非効率なバージョン
ghci> mapM_ putStrLn $ snd $ runWriter (gcdReverse 8 3)
Finished with 1
2 mod 1 = 0
3 mod 2 = 1
8 mod 3 = 2
  • ログが逆順に出る
  • これは悪い例(あとで、差分リストを使って改善する)
\xs -> [1, 2, 3] ++ xs
  • 非効率なリストのアペンドを、効率的なヘッドへの付け足しに変えるのが差分リスト
  • 「リスト」と名が付いているが、実体はラムダ
  • リストのヘッドに、別のリストを付け足す関数
listA = \xs -> "dog" ++ xs
listB = \xs -> "meat" ++ xs
listA `append` listB = \xs -> "dog" ++ ("meat" ++ xs)
  • 2つの差分リストをアペンドすることは、関数合成に相当する
newtype DiffList a = DiffList { getDiffList :: [a] -> [a] }

toDiffList :: [a] -> DiffList a
toDiffList xs = DiffList (xs++)

fromDiffList :: DiffList a -> [a]
fromDiffList (DiffList f) = f []

instance Monoid (DiffList a) where
    mempty = DiffList (\xs -> [] ++ xs)
    (DiffList f) `mappend` (DiffList g) = DiffList (\xs -> f (g xs))
  • Monoidとして差分リストDiffListを実装
  • 普通のリストと差分リストの相互変換も実装
ghci> fromDiffList (toDiffList [1,2,3,4] `mappend` toDiffList [1,2,3])
[1,2,3,4,1,2,3]
  • 特に意識しなくても、長いリストのヘッドに、短いリストを付け足す形で連結される
import Control.Monad.Writer

gcd' :: Int -> Int -> Writer (DiffList String) Int
gcd' a b
    | b == 0 = do
        tell (toDiffList ["Finished with " ++ show a])
        return a
    | otherwise = do
        result <- gcd' b (a `mod` b)
        tell (toDiffList [show a ++ " mod " ++ show b ++ " = " ++ show (a `mod` b)])
        return result
  • gcdReverseとソックリだが、[String]の代わりにDiffListを使っている
ghci> mapM_ putStrLn . fromDiffList . snd . runWriter $ gcdReverse 110 34
Finished with 2
8 mod 2 = 0
34 mod 8 = 2
110 mod 34 = 8
  • ログは逆順に出るが、効率は良い
finalCountDown :: Int -> Writer (DiffList String) ()
finalCountDown 0 = do
    tell (toDiffList ["0"])
finalCountDown x = do
    finalCountDown (x-1)
    tell (toDiffList [show x])
  • 効率を比較するための関数
  • DiffListを使用
ghci> mapM_ putStrLn . fromDiffList . snd . runWriter $ finalCountDown 500000
0
1
2
...
  • 普通に出る
finalCountDown :: Int -> Writer [String] ()
finalCountDown 0 = do
    tell ["0"]
finalCountDown x = do
    finalCountDown (x-1)
    tell [show x]
  • [String]を使用したバージョン
ghci> mapM_ putStrLn . snd . runWriter $ finalCountDown 500000
  • 超遅い

Reader? Ugh, not this joke again.

ghci> let f = (+) <$> (*2) <*> (+10)
ghci> f 3
19
  • (->) r はApplicative
  • (*2)と(+10)を、それぞれ3に適用し、その結果へ(+)を適用する
instance Monad ((->) r) where
    return x = \_ -> x
    h >>= f = \w -> f (h w) w
  • (->) r はMonadでもある
import Control.Monad.Instances

addStuff :: Int -> Int
addStuff = do
    a <- (*2)
    b <- (+10)
    return (a+b)
  • 先のコードをdoで書き直した
ghci> addStuff 3
19
  • (*2)も(+10)もMonad
  • どちらも、同じ数(この例では3)に適用される
  • 同じ出所から引数を読むので、reader monadと呼ばれる
  • ☆reader monadは、1引数を取る沢山の関数を同じ値に適用するときに便利?

Tasteful stateful computations

s -> (a,s)
  • 状態を引数に取り、結果と新しい状態を返す
  • ☆本来なら「状態の変更」は副作用だが、これならpure
type Stack = [Int]

pop :: Stack -> (Int,Stack)
pop (x:xs) = (x,xs)

push :: Int -> Stack -> ((),Stack)
push a xs = ((),a:xs)
  • スタックのモデル化
stackManip :: Stack -> (Int, Stack)
stackManip stack = let
    ((),newStack1) = push 3 stack
    (a ,newStack2) = pop newStack1
    in pop newStack2
  • 3をpushして、2回popする
  • ☆(=)の左辺に()を置いてもいい(_ と同じことみたい)
  • Monadを使えば、もっとスッキリ書けるはず
newtype State s a = State { runState :: s -> (a,s) }

instance Monad (State s) where
    return x = State $ \s -> (x,s)
    (State h) >>= f = State $ \s -> let (a, newState) = h s
                                        (State g) = f a
                                    in  g newState
  • Control.Monad.Stateで定義
  • 「状態」を一般化&Monad化
  • ☆実は、Control.Monad.StateでのStateの定義は、上記と異なる
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 :: State Stack Int
stackManip = do
    push 3
    a <- pop
    pop
  • Stateを使ってpop、push、及びstackManipを再定義
get = State $ \s -> (s,s)

put newState = State $ \s -> ((),newState)
  • getとputは、型クラスMonadStateが規定する関数
stackyStack :: State Stack ()
stackyStack = do
    stackNow <- get
    if stackNow == [1,2,3]
        then put [8,3,1]
        else put [9,2,1]
  • 手軽に状態を取り出したり、変更できる
ghci> runState stackyStack [1,2,3,4]
((),[9,2,1])
ghci> runState stackyStack [1,2,3]
((),[8,3,1])
  • 使用例
import System.Random
import Control.Monad.State

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)
  • Stateを使って乱数を扱う
  • ☆randomStの定義でエラーになる(Control.Monad.Stateをimportせずに、前述のStateの定義を使えばOK)
ghci> runState threeCoins (mkStdGen 33)
((True,False,True),680029187 2103410263)
  • 3枚のコインを投げる

Error error on the wall

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)
  • EitherはMonad
  • Control.Monad.Errorで定義
ghci> :t strMsg
strMsg :: (Error a) => String -> a
ghci> strMsg "boom!" :: String
"boom!"
  • strMsgは、StringをError型クラスの型に変換する
  • StringはError型クラスのインスタンス
ghci> Left "boom" >>= \x -> return (x+1)
Left "boom"
ghci> Right 100 >>= \x -> Left "no way!"
Left "no way!"
  • 失敗すると、Left値が返る
ghci> Right 3 >>= \x -> return (x + 100) :: Either String Int
Right 103
  • 成功時はRight値が返る
  • このとき、Left値は使わないが、型を明示するために型注釈が必要
  • 型クラス制約によりLeft値はErrorインスタンスでなければならないので

Some useful monadic functions

liftM :: (Monad m) => (a -> b) -> m a -> m b
  • Monadを使ってfmapと同じことをする関数
ghci> liftM (*3) (Just 8)
Just 24
ghci> fmap (*3) (Just 8)
Just 24
  • Monadは、(文法上はそうではないが)Functorでもあるべき
  • liftMとfmapの結果は同じであるべき
ap :: (Monad m) => m (a -> b) -> m a -> m b
ap mf m = do
    f <- mf
    x <- m
    return (f x)
  • Monadを使って<*>と同じことをする関数
ghci> Just (+3) `ap` Just 4
Just 7
ghci> Just (+3) <*> Just 4
Just 7
  • Monadは、(文法上はそうではないが)Applicativeでもあるべき
  • apと<*>の結果は同じであるべき

新しい型がMonad的だと分かったら:

  • まずMonadとして実装してしまえば、
  • pureをreturnで、<*>をapで実装してApplicative化できるし
  • fmapをliftMで実装してFunctor化できる
join :: (Monad m) => m (m a) -> m a
  • ネストしたMonadを平らにする
ghci> join (Just (Just 9))
Just 9
ghci> join (Just Nothing)
Nothing
ghci> join Nothing
Nothing
ghci> join [[1,2,3],[4,5,6]]
[1,2,3,4,5,6]
ghci> runWriter $ join (Writer (Writer (1,"aaa"),"bbb"))
(1,"bbbaaa")
ghci> join (Right (Right 9)) :: Either String Int
Right 9
ghci> join (Right (Left "error")) :: Either String Int
Left "error"
ghci> join (Left "error") :: Either String Int
Left "error"
  • Monadの中の値がMonadになっていても、joinで展開可能
  • リストならconcatされる
  • Writerならmappendされる
join :: (Monad m) => m (m a) -> m a
join mm = do
    m <- mm
    m
  • joinの実装
  • m >>= f は、join (fmap f m) と同じ
  • つまり、joinを実装すれば、>>= も実装できる
filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
  • Monad向けfilter
keepSmall :: Int -> Writer [String] Bool
keepSmall x
    | x < 4 = do
        tell ["Keeping " ++ show x]
        return True
    | otherwise = do
        tell [show x ++ " is too large, throwing it away"]
        return False
  • リストから、4より小さい数を抽出する関数
  • 抽出過程をwriter monadに記録
ghci> fst $ runWriter $ filterM keepSmall [9,1,5,2,10,3]
[1,2,3]
ghci> mapM_ putStrLn $ snd $ runWriter $ filterM keepSmall [9,1,5,2,10,3]
9 is too large, throwing it away
Keeping 1
5 is too large, throwing it away
Keeping 2
10 is too large, throwing it away
Keeping 3
  • ログ部(ペアの2番目)はStringのリストなので、それぞれに、putStrLnをmapして表示
powerset :: [a] -> [[a]]
powerset xs = filterM (\x -> [True, False]) xs
  • べき集合(部分集合の集合)を得る関数
  • リストの非決定性を利用
ghci> powerset [1,2,3]
[[1,2,3],[1,2],[1,3],[1],[2,3],[2],[3],[]]
  • [1,2,3]の各要素に、True(採用)かFalse(不採用)の非決定性を持った述語を適用
  • その結果も非決定性を持ち、すべての組み合わせがリストアップされる
foldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
  • Monad向けfoldl
binSmalls :: Int -> Int -> Maybe Int
binSmalls acc x
    | x > 9     = Nothing
    | otherwise = Just (acc + x)
  • 右辺が9を超えたら失敗する加算関数
ghci> foldM binSmalls 0 [2,8,3,1]
Just 14
ghci> foldM binSmalls 0 [2,11,3,1]
Nothing
  • 11を足すところで失敗
foldingFunction :: [Double] -> String -> Maybe [Double]
foldingFunction (x:y:ys) "*" = return ((x * y):ys)
foldingFunction (x:y:ys) "+" = return ((x + y):ys)
foldingFunction (x:y:ys) "-" = return ((y - x):ys)
foldingFunction xs numberString = liftM (:xs) (readMaybe numberString)

readMaybe :: (Read a) => String -> Maybe a
readMaybe st = case reads st of [(x,"")] -> Just x
                                _ -> Nothing
  • 文法エラーに対応したsolveRPNを実装してみる
  • foldingFunctionを、[Double]ではなくMaybe [Double]とする
  • readsは、文字列をreadして、結果と残った文字列とのタプルからなるリストを返す関数
import Data.List

solveRPN :: String -> Maybe Double
solveRPN st = do
    [result] <- foldM foldingFunction [] (words st)
    return result
  • 完成形
ghci> solveRPN "1 2 * 4 +"
Just 6.0
ghci> solveRPN "1 2 * 4 + 5 *"
Just 30.0
ghci> solveRPN "1 2 * 4"
Nothing
ghci> solveRPN "1 8 wharglbllargh"
Nothing
  • 文法エラーならNothingを返す
ghci> let f = foldr (.) id [(+1),(*100),(+1)]
ghci> f 1
201
  • 関数のリストをfoldrで1つの関数に合成
  • これをMonad的にやるなら、(.)の代わりに(<=<)を、idの代わりにreturnを使えば良い

Making monads

[(3,0.5),(5,0.25),(9,0.25)]
  • リストの非決定性に、確度を重みとして付ける
ghci> 1%4
1 % 4
ghci> 1%2 + 1%2
1 % 1
ghci> 1%3 + 5%4
19 % 12
  • 小数の演算には誤差が付き物なので、それを避けるため、Data.RatioモジュールのRational型を使う
  • 分数のようなイメージ
ghci> [(3,1%2),(5,1%4),(9,1%4)]
[(3,1 % 2),(5,1 % 4),(9,1 % 4)]
  • Rationalで書き直した
import Data.Ratio

newtype Prob a = Prob { getProb :: [(a,Rational)] } deriving Show
  • 専用の型を設ける
instance Functor Prob where
    fmap f (Prob xs) = Prob $ map (\(x,p) -> (f x,p)) xs
  • Functor化する
ghci> fmap negate (Prob [(3,1%2),(5,1%4),(9,1%4)])
Prob {getProb = [(-3,1 % 2),(-5,1 % 4),(-9,1 % 4)]}
  • fmapが使えるようになった
  • 確度を全て足すと1になる
Prob [
  ( Prob [('a', 1%2), ('b', 1%2)], 1%4 ),
  ( Prob [('c', 1%2), ('d', 1%2)], 3%4 )
  ]
  • Monad化するために、まずjoin方法を考えてみる
flatten :: Prob (Prob a) -> Prob a
flatten (Prob xs) = Prob $ concat $ map multAll xs
    where multAll (Prob innerxs,p) = map (\(x,r) -> (x,p*r)) innerxs
  • 外側の確度を内側の確度に掛ければjoinできる
instance Monad Prob where
    return x = Prob [(x,1%1)]
    m >>= f = flatten (fmap f m)
    fail _ = Prob []
  • Monad化できた
data Coin = Heads | Tails deriving (Show, Eq)

coin :: Prob Coin
coin = Prob [(Heads,1%2),(Tails,1%2)]

loadedCoin :: Prob Coin
loadedCoin = Prob [(Heads,1%10),(Tails,9%10)]
  • 普通のコインと、裏が出やすいコインをモデル化
import Data.List (all)

flipThree :: Prob Bool
flipThree = do
    a <- coin
    b <- coin
    c <- loadedCoin
    return (all (==Tails) [a,b,c])
  • 3枚すべて裏になる確率を得る関数
ghci> getProb flipThree
[(False,1 % 40),(False,9 % 40),(False,1 % 40),(False,9 % 40),
 (False,1 % 40),(False,9 % 40),(False,1 % 40),(True,9 % 40)]
  • 確率は40分の9

14.Zippers

Taking a walk

data Tree a = Empty | Node a (Tree a) (Tree a) deriving (Show)
  • 木構造
freeTree :: Tree Char
freeTree = 
    Node 'P'
        (Node 'O'
            (Node 'L'
                (Node 'N' Empty Empty)
                (Node 'T' Empty Empty)
            )
            (Node 'Y'
                (Node 'S' Empty Empty)
                (Node 'A' Empty Empty)
            )
        )
        (Node 'L'
            (Node 'W'
                (Node 'C' Empty Empty)
                (Node 'R' Empty Empty)
            )
            (Node 'A'
                (Node 'A' Empty Empty)
                (Node 'C' Empty Empty)
            )
        )

--       P
--    /     \
--   O       L
--  / \     / \
-- L   Y   W   A
--N T S A C R A C
  • サンプルツリー
changeToP :: Tree Char -> Tree Char
changeToP (Node x l (Node y (Node _ m n) r)) = Node x l (Node y (Node 'P' m n) r)
  • WをPに変える関数
  • もっと良い方法は無いか…
data Direction = L | R deriving (Show)
type Directions = [Direction]

changeToP :: Directions-> Tree Char -> Tree Char
changeToP (L:ds) (Node x l r) = Node x (changeToP ds l) r
changeToP (R:ds) (Node x l r) = Node x l (changeToP ds r)
changeToP [] (Node _ l r) = Node 'P' l r
  • ツリーを探索する方向を引数で与えることにより一般化した
elemAt :: Directions -> Tree a -> a
elemAt (L:ds) (Node _ l _) = elemAt ds l
elemAt (R:ds) (Node _ _ r) = elemAt ds r
elemAt [] (Node x _ _) = x
  • 特定位置の文字を返す関数
ghci> let newTree = changeToP [R,L] freeTree
ghci> elemAt [R,L] newTree
'P'
  • ちゃんと変わっている
  • ここで、[R,L]は、freeTree内のサブツリーを指すフォーカスの役割を果たしている
  • また[]は、freeTreeそのものを指すフォーカス

A trail of breadcrumbs

type Breadcrumbs = [Direction]

goLeft :: (Tree a, Breadcrumbs) -> (Tree a, Breadcrumbs)
goLeft (Node _ l _, bs) = (l, L:bs)

goRight :: (Tree a, Breadcrumbs) -> (Tree a, Breadcrumbs)
goRight (Node _ _ r, bs) = (r, R:bs)

x -: f = f x
  • ツリー探索の道筋をBreadcrumbsに記録する
ghci> (freeTree, []) -: goRight -: goLeft
(Node 'W' (Node 'C' Empty Empty) (Node 'R' Empty Empty),[L,R])
  • 現時点のサブツリーと、そこへ至る道筋
  • 道筋がスタック的(新しい方がhead側)になっている点に注意
data Crumb a = LeftCrumb a (Tree a) | RightCrumb a (Tree a) deriving (Show)

type Breadcrumbs a = [Crumb a]
  • 「戻る」を可能にするには、LかRかだけでなく、サブツリーをBreadcrumbsに記録する必要がある
goLeft :: (Tree a, Breadcrumbs a) -> (Tree a, Breadcrumbs a)
goLeft (Node x l r, bs) = (l, LeftCrumb x r:bs)

goRight :: (Tree a, Breadcrumbs a) -> (Tree a, Breadcrumbs a)
goRight (Node x l r, bs) = (r, RightCrumb x l:bs)

goUp :: (Tree a, Breadcrumbs a) -> (Tree a, Breadcrumbs a)
goUp (t, LeftCrumb x r:bs) = (Node x t r, bs)
goUp (t, RightCrumb x l:bs) = (Node x l t, bs)
  • 「戻る」に対応した
type Zipper a = (Tree a, Breadcrumbs a)
  • フォーカスされたサブツリーと、その周辺環境とのペアを(☆一般に?)zipperと呼ぶ
modify :: (a -> a) -> Zipper a -> Zipper a
modify f (Node x l r, bs) = (Node (f x) l r, bs)
modify f (Empty, bs) = (Empty, bs)
  • フォーカス部分を変更する関数
ghci> let newFocus = (freeTree,[]) -: goLeft -: goRight -: modify (\_ -> 'P')
ghci> let newFocus2 = newFocus -: goUp -: modify (\_ -> 'X')
  • WをPに変えて、
  • 1つ戻って、LをXに変える
attach :: Tree a -> Zipper a -> Zipper a
attach t (_, bs) = (t, bs)
  • 別のツリーをアタッチする関数
ghci> let farLeft = (freeTree,[]) -: goLeft -: goLeft -: goLeft -: goLeft
ghci> let newFocus = farLeft -: attach (Node 'Z' Empty Empty)
  • Nの先にZがアタッチされた
topMost :: Zipper a -> Zipper a
topMost (t,[]) = (t,[])
topMost z = topMost (goUp z)
  • 先頭へ戻る関数

Focusing on lists

type ListZipper a = ([a],[a])
  • リスト用のzipper
  • ツリーなら進む方向が2つ(LとR)あるが、リストの場合は1つなので、Crumbのような型は不要
goForward :: ListZipper a -> ListZipper a
goForward (x:xs, bs) = (xs, x:bs)

goBack :: ListZipper a -> ListZipper a
goBack (xs, b:bs) = (b:xs, bs)
  • 「進む」と「戻る」
ghci> let xs = [1,2,3,4]
ghci> goForward (xs,[])
([2,3,4],[1])
ghci> goForward ([2,3,4],[1])
([3,4],[2,1])
ghci> goForward ([3,4],[2,1])
([4],[3,2,1])
ghci> goBack ([4],[3,2,1])
([3,4],[2,1])
  • Breadcrumbsは、最初のリストをreverseしたものになる

A very simple file system

type Name = String
type Data = String
data FSItem = File Name Data | Folder Name [FSItem] deriving (Show)
  • 簡易ファイルシステムのモデリング
myDisk :: FSItem
myDisk =
    Folder "root" 
        [ File "goat_yelling_like_man.wmv" "baaaaaa"
        , File "pope_time.avi" "god bless"
        , Folder "pics"
            [ File "ape_throwing_up.jpg" "bleargh"
            , File "watermelon_smash.gif" "smash!!"
            , File "skull_man(scary).bmp" "Yikes!"
            ]
        , File "dijon_poupon.doc" "best mustard"
        , Folder "programs"
            [ File "fartwizard.exe" "10gotofart"
            , File "owl_bandit.dmg" "mov eax, h00t"
            , File "not_a_virus.exe" "really not a virus"
            , Folder "source code"
                [ File "best_hs_prog.hs" "main = print (fix error)"
                , File "random.hs" "main = print 4"
                ]
            ]
        ]
  • サンプルディスク
import Data.List (break)

data FSCrumb = FSCrumb Name [FSItem] [FSItem] deriving (Show)

type FSZipper = (FSItem, [FSCrumb])

fsUp :: FSZipper -> FSZipper
fsUp (item, FSCrumb name ls rs:bs) = (Folder name (ls ++ [item] ++ rs), bs)

fsTo :: Name -> FSZipper -> FSZipper
fsTo name (Folder folderName items, bs) = 
    let (ls, item:rs) = break (nameIs name) items
    in  (item, FSCrumb folderName ls rs:bs)

nameIs :: Name -> FSItem -> Bool
nameIs name (Folder folderName _) = name == folderName
nameIs name (File fileName _) = name == fileName
  • fsUpで、階層を1つ上がる
  • fsToで、特定のファイル/フォルダへフォーカスを当てる
  • breakは、リストを分割する関数
ghci> let newFocus = (myDisk,[]) -: fsTo "pics" -: fsTo "skull_man(scary).bmp"
ghci> fst newFocus
File "skull_man(scary).bmp" "Yikes!"
ghci> let newFocus2 = newFocus -: fsUp -: fsTo "watermelon_smash.gif"
ghci> fst newFocus2
File "watermelon_smash.gif" "smash!!"
  • ディスク探索
fsRename :: Name -> FSZipper -> FSZipper
fsRename newName (Folder name items, bs) = (Folder newName items, bs)
fsRename newName (File name dat, bs) = (File newName dat, bs)

fsNewFile :: FSItem -> FSZipper -> FSZipper
fsNewFile item (Folder folderName items, bs) = 
    (Folder folderName (item:items), bs)
  • 名前を変更する関数
  • 新しいアイテムを追加する関数
ghci> let newFocus = (myDisk,[]) -: fsTo "pics" -: fsRename "cspi" -: fsUp
ghci> let newFocus = (myDisk,[]) -: fsTo "pics" -: fsNewFile (File "heh.jpg" "lol") -: fsUp

Watch your step

goLeft :: Zipper a -> Maybe (Zipper a)
goLeft (Node x l r, bs) = Just (l, LeftCrumb x r:bs)
goLeft (Empty, _) = Nothing

goRight :: Zipper a -> Maybe (Zipper a)
goRight (Node x l r, bs) = Just (r, RightCrumb x l:bs)
goRight (Empty, _) = Nothing

goUp :: Zipper a -> Maybe (Zipper a)
goUp (t, LeftCrumb x r:bs) = Just (Node x t r, bs)
goUp (t, RightCrumb x l:bs) = Just (Node x l t, bs)
goUp (_, []) = Nothing
  • 失敗する可能性を考慮したツリー探索
ghci> let coolTree = Node 1 Empty (Node 3 Empty Empty)
ghci> return (coolTree,[]) >>= goRight
Just (Node 3 Empty Empty,[RightCrumb 1 Empty])
ghci> return (coolTree,[]) >>= goRight >>= goRight
Just (Empty,[RightCrumb 3 Empty,RightCrumb 1 Empty])
ghci> return (coolTree,[]) >>= goRight >>= goRight >>= goRight
Nothing
  • 右に行き過ぎた
Last modified:2012/11/27 16:44:36
Keyword(s):
References:[FP: 関数型プログラミング] [LYAHFGG!まとめ(リファレンス)] [LYAHFGG!まとめ(Part1)]
This page is frozen.