另一個 Haskell 教程/單子/解決方案
| Haskell | |
|---|---|
| |
| 另一個 Haskell 教程 | |
| 前言 | |
| 介紹 | |
| 入門 | |
| 語言基礎 (解決方案) | |
| 型別基礎 (解決方案) | |
| IO (解決方案) | |
| 模組 (解決方案) | |
| 高階語言 (解決方案) | |
| 高階型別 (解決方案) | |
| 單子 (解決方案) | |
| 高階 IO | |
| 遞迴 | |
| 複雜度 | |
第一個定律是：return a >>= f ≡ f a。在 Maybe 的情況下，我們得到
return a >>= f ==> Just a >>= \x -> f x ==> (\x -> f x) a ==> f a
第二個定律是：f >>= return ≡ f。在這裡，我們得到
f >>= return ==> f >>= \x -> return x ==> f >>= \x -> Just x
此時，根據 f 是否為 Nothing，有兩種情況。在第一種情況下，我們得到
==> Nothing >>= \x -> Just x ==> Nothing ==> f
在第二種情況下，f 是 Just a。然後，我們得到
==> Just a >>= \x -> Just x ==> (\x -> Just x) a ==> Just a ==> f
因此證明了第二個定律。第三個定律指出：f >>= (\x -> g x >>= h) ≡ (f >>= g) >>= h。
如果 f 是 Nothing，則左側顯然簡化為 Nothing。右側簡化為 Nothing >>= h，進而簡化為 Nothing，因此它們是相同的。
假設 f 是 Just a。然後 LHS 簡化為 g a >>= h，而 RHS 簡化為 (Just a >>= \x -> g x) >>= h，進而簡化為 g a >>= h，因此這兩個是相同的。
我們的想法是使用 Left 建構函式來表示錯誤，使用 Right 建構函式來表示成功。這將導致以下例項宣告
instance Monad (Either String) where
return x = Right x
Left s >>= _ = Left s
Right x >>= f = f x
fail s = Left s
如果我們嘗試使用這個單子進行搜尋，我們會得到
示例
Monads> searchAll gr 0 3 :: Either String [Int] Right [0,1,3] Monads> searchAll gr 3 0 :: Either String [Int] Left "no path"
這正是我們想要的。
mplus 的順序實際上決定了搜尋順序。當對 searchAll2 的遞迴呼叫排在前面時，我們正在進行深度優先搜尋。當對 search' 的遞迴呼叫排在前面時，我們正在進行廣度優先搜尋。因此，使用列表單子，我們預計解決方案會以相反的順序出現
示例
MPlus> searchAll3 gr 0 3 :: [[Int]] [[0,2,3],[0,1,3]]
正如我們所預期的那樣。
這是一個非常困難的問題；如果你發現自己立刻卡住了，請只閱讀本解決方案中你需要嘗試的部分。
首先，我們需要定義一個列表轉換器單子。它看起來像這樣
newtype ListT m e = ListT { unListT :: m [e] }
ListT 建構函式簡單地包裝了一個單子操作（在單子 m 中），該操作返回一個列表。
現在我們需要將其變成一個單子
instance Monad m => Monad (ListT m) where
return x = ListT (return [x])
fail s = ListT (return [] )
ListT m >>= k = ListT $ do
l <- m
l' <- mapM (unListT . k) l
return (concat l')
這裡，成功由一個返回單元素列表的單子操作來表示。失敗（就像在標準列表單子中一樣）用空列表表示：當然，它實際上是封閉單子返回的空列表。繫結本質上是透過執行將產生列表 l 的操作來完成的。它具有型別 [e]。現在我們需要將 k 應用於這些元素中的每一個（這將產生型別 ListT m [e2] 的東西）。我們需要去掉周圍的 ListT（透過使用 unListT），然後將它們連線起來形成一個單一列表。
現在，我們需要將其變成 MonadPlus 的例項
instance Monad m => MonadPlus (ListT m) where
mzero = ListT (return [])
ListT m1 `mplus` ListT m2 = ListT $ do
l1 <- m1
l2 <- m2
return (l1 ++ l2)
這裡，零元素是一個返回空列表的單子操作。加法是透過執行這兩個操作並將結果連線起來完成的。
最後，我們需要將其變成 MonadTrans 的例項
instance MonadTrans ListT where
lift x = ListT (do a <- x; return [a])
將操作提升到 ListT 中只需要執行它並獲取值（在本例中為 a），然後返回單元素列表。
一旦我們將所有這些組合在一起，編寫 searchAll6 就相當簡單了
searchAll6 g@(Graph vl el) src dst
| src == dst = do
lift $ putStrLn $
"Exploring " ++ show src ++ " -> " ++ show dst
return [src]
| otherwise = do
lift $ putStrLn $
"Exploring " ++ show src ++ " -> " ++ show dst
search' el
where
search' [] = mzero
search' ((u,v,_):es)
| src == u =
(do path <- searchAll6 g v dst
return (u:path)) `mplus`
search' es
| otherwise = search' es
這裡唯一的變化（除了將遞迴呼叫改為呼叫 searchAll6 而不是 searchAll2 之外）是我們使用適當的引數呼叫 putStrLn，並將它們提升到單子中。
如果我們檢視 searchAll6 的型別，我們會發現結果（即，在應用圖形和兩個整數之後）具有型別 MonadTrans t, MonadPlus (t IO) => t IO [Int])。理論上，我們可以將它與任何合適的單子轉換器一起使用；在我們的例子中，我們想使用 ListT。因此，我們可以透過以下方式執行它
示例
MTrans> unListT (searchAll6 gr 0 3) Exploring 0 -> 3 Exploring 1 -> 3 Exploring 3 -> 3 Exploring 2 -> 3 Exploring 3 -> 3 MTrans> it [[0,1,3],[0,2,3]]
這正是我們想要的。這項練習實際上比之前的練習更簡單。我們所要做的就是將對 putT 和 getT 的呼叫併入 searchAll6，並向 IO 呼叫新增一個額外的提升。這個額外的提升是必需的，因為現在我們在 IO 之上堆疊了兩個轉換器，而不是隻有一個。
searchAll7 g@(Graph vl el) src dst
| src == dst = do
lift $ lift $ putStrLn $
"Exploring " ++ show src ++ " -> " ++ show dst
visited <- getT
putT (src:visited)
return [src]
| otherwise = do
lift $ lift $ putStrLn $
"Exploring " ++ show src ++ " -> " ++ show dst
visited <- getT
putT (src:visited)
if src `elem` visited
then mzero
else search' el
where
search' [] = mzero
search' ((u,v,_):es)
| src == u =
(do path <- searchAll7 g v dst
return (u:path)) `mplus`
search' es
| otherwise = search' es
它的型別已經顯著增長。在應用圖形和兩個整數之後，它具有型別 Monad (t IO), MonadTrans t, MonadPlus (StateT [Int] (t IO)) => StateT [Int] (t IO) [Int]。
本質上這意味著我們得到了一個狀態轉換器，它被包裝在另一個任意轉換器（t）之上，而這個轉換器本身位於 IO 之上。在我們的例子中，t 將是 ListT。因此，我們可以透過以下方式執行這個怪物
示例
MTrans> unListT (evalStateT (searchAll7 gr4 0 3) []) Exploring 0 -> 3 Exploring 1 -> 3 Exploring 3 -> 3 Exploring 0 -> 3 Exploring 2 -> 3 Exploring 3 -> 3 MTrans> it [[0,1,3],[0,2,3]]
它有效，即使在 gr4 上也是如此。
首先，我們編寫一個函式 spaces，它將解析空格
spaces :: Parser () spaces = many (matchChar isSpace) >> return ()
現在，使用它，我們只需在 intList 中散佈對 spaces 的呼叫，即可得到 intListSpace
intListSpace :: Parser [Int]
intListSpace = do
char '['
spaces
intList' `mplus` (char ']' >> return [])
where intList' = do
i <- int
spaces
r <- (char ',' >> spaces >> intList')
`mplus`
(char ']' >> return [])
return (i:r)
我們可以測試它是否有效
示例
Parsing> runParser intListSpace "[1 ,2 , 4 \n\n ,5\n]"
Right ("",[1,2,4,5])
Parsing> runParser intListSpace "[1 ,2 , 4 \n\n ,a\n]"
Left "expecting char, got 'a'"
=== Parsec ===
我們透過用 push 和 pop 函式替換狀態函式來做到這一點
parseValueLet2 :: CharParser (FiniteMap Char [Int]) Int
parseValueLet2 = choice
[ int
, do string "let "
c <- letter
char '='
e <- parseValueLet2
string " in "
pushBinding c e
v <- parseValueLet2
popBinding c
return v
, do c <- letter
fm <- getState
case lookupFM fm c of
Nothing -> unexpected ("variable " ++
show c ++
" unbound")
Just (i:_) -> return i
, between (char '(') (char ')') $ do
e1 <- parseValueLet2
op <- oneOf "+*"
e2 <- parseValueLet2
case op of
'+' -> return (e1 + e2)
'*' -> return (e1 * e2)
]
where
pushBinding c v = do
fm <- getState
case lookupFM fm c of
Nothing -> setState (addToFM fm c [v])
Just l -> setState (addToFM fm c (v:l))
popBinding c = do
fm <- getState
case lookupFM fm c of
Just [_] -> setState (delFromFM fm c)
Just (_:l) -> setState (addToFM fm c l)
這裡的主要區別是，我們沒有呼叫 updateState，而是使用了兩個區域性函式 pushBinding 和 popBinding。pushBinding 函式接受一個變數名和一個值，並將該值新增到狀態 FiniteMap 中指向的列表的開頭。popBinding 函式檢視值，如果堆疊上只有一個元素，它會將堆疊完全從 FiniteMap 中刪除；否則，它只會刪除第一個元素。這意味著，如果某個元素在 FiniteMap 中，堆疊將永遠不會為空。
這使我們能夠稍微修改使用情況；這次，我們只需在需要檢查變數的值時從堆疊中取出頂部的元素即可。
我們可以測試它是否有效
示例
ParsecI> runParser parseValueLet2 emptyFM "stdin"
"((let x=2 in 3+4)*x)"
Left "stdin" (line 1, column 20):
unexpected variable 'x' unbound