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