另一个 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