另一個 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]。理論上，我們可以將它與任何合適的monad轉換器一起使用；在我們的例子中，我們想使用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