用Haskell实现TAOCP第4卷分册2的AlgorithmM

Question

我试着执行标题说的话，但由于评估懒惰，我无法取得结果：

data AlgorithmM = AlgorithmM {fm::[Int],fa::[Int],fj::Int,fn::Int}
m1a :: AlgorithmM->(IO (),AlgorithmM)
m1a (AlgorithmM m a j n) = (return (),AlgorithmM (2:m) a j n)

m1b :: AlgorithmM->(IO (),AlgorithmM)
m1b (AlgorithmM m a j n) = (return (),AlgorithmM m (take n $! repeat 0) j n)


m2 algo = (visit False $ fa algo,algo)
  where visit True l =do
             mapM (\z->putStr $ show z) l
             putStr "\n"
    visit False (x:xs) = do
                          mapM (\z->putStr $ show z) xs
                          putStr "\n"
initN :: AlgorithmM->(IO (),AlgorithmM)
initN (AlgorithmM m a j n) = (return (),AlgorithmM m a j ((length m)-1))

m3 :: AlgorithmM->(IO (),AlgorithmM)
m3 (AlgorithmM m a j n) = (return (),AlgorithmM m a n n)


m4 :: AlgorithmM->(IO (),AlgorithmM)
m4 (AlgorithmM m a j n) = if (a !! j) == (m !! j) - 1 then m4 (AlgorithmM m (setajZero a j) (j-1) n) else  (return (),AlgorithmM m a j n)
 where setajZero (x:xs) 0 = 0:xs
       setajZero (x:xs) j = x:(setajZero xs (j-1))

m5 :: AlgorithmM->(IO (),AlgorithmM)
m5 (AlgorithmM m a j n) = if j==0 then (return (),AlgorithmM m a j n) else m2 (AlgorithmM m a j n)

bind :: (IO(),AlgorithmM)->(AlgorithmM->(IO (),AlgorithmM))->(IO(),AlgorithmM)
bind g f = f $! snd g 

testAlgorithmM = m1a (AlgorithmM [2,2,2] [] 0 0) `bind` initN `bind` m1b `bind` m2 `bind` m3 `bind` m4 `bind` m5

main = do
    let (x,y) = testAlgorithmM
    x

当我将上述代码运行到解释器时，我将

例外:序曲。(！！)：索引太大了

我认为m1a中的列表没有展开n+1，因此m4抛出异常

有什么想法吗？谢谢。

Answer 1

就像我上面的海报说的，你把你的名单编入了不正确的索引。将(a !! j) == (m !! j) - 1替换为(a !! (j - 1)) == (m !! (j - 1)) - 1，它就能工作了。

但是，所有多余的return ()语句都不会做任何事情。你似乎误解了monads，特别是IO的角色。您似乎还认为懒惰会使您的代码无法工作；虽然这在技术上是正确的，但问题不是haskell懒惰，而是您没有告诉它您想要计算什么。

我修改了代码以消除所有的return ()语句。请注意，我没有更改代码的执行。它将以与原来完全相同的顺序执行一切。

data AlgorithmM = AlgorithmM {fm::[Int],fa::[Int],fj::Int,fn::Int} deriving Show

m1a :: AlgorithmM -> AlgorithmM
m1a (AlgorithmM m a j n) = AlgorithmM (2:m) a j n

m1b :: AlgorithmM -> AlgorithmM
m1b (AlgorithmM m a j n) = AlgorithmM m (take n $! repeat 0) j n

m2 :: AlgorithmM -> (String, AlgorithmM)
m2 algo = (visit False $ fa algo,algo)
  where visit True l = (concatMap show l) ++ "\n"
        visit False (x:xs) = concatMap show xs ++ "\n"

initN :: AlgorithmM -> AlgorithmM
initN (AlgorithmM m a j n) = AlgorithmM m a j ((length m)-1)

m3 :: AlgorithmM-> AlgorithmM
m3 (AlgorithmM m a j n) = AlgorithmM m a n n


m4 :: AlgorithmM -> AlgorithmM
m4 (AlgorithmM m a j n) = if (a !! (j - 1)) == (m !! (j - 1)) - 1 then m4 (AlgorithmM m (setajZero a j) (j-1) n) else AlgorithmM m a j n
 where setajZero (x:xs) 0 = 0:xs
       setajZero (x:xs) j = x:(setajZero xs (j-1))

m5 :: AlgorithmM -> (String, AlgorithmM)
m5 (AlgorithmM m a j n) = if j==0 then ("", AlgorithmM m a j n) else m2 (AlgorithmM m a j n)

testAlgorithmM = s0
    where (s0, a) = m2 $ m1b $ initN $ m1a (AlgorithmM [2,2,2] [] 0 0)
          b       = m5 $ m4 $ m3 a

如果您检查m2，您会注意到每次都会调用visit False。您可以进一步将其简化为

m2 :: AlgorithmM -> (String, AlgorithmM)
m2 algo = ((\xs -> concatMap show xs ++ "\n") $ tail $  fa algo,algo)

我只需将visit函数替换为对应于False的函数的分支。

然后是testAlgorithmM中发生了什么的问题。同样，执行是相同的(我刚刚删除了严格性属性)。但是请注意，由于testAlgorithmM的值是s0，所以它不会计算m5 $ m4 $ m3 a，因为它的值不需要生成所需的输出。使用原始代码，不可能看到这种情况发生，但是当您删除所有的混淆时，这是非常明显的。

在函数应用程序链的中间创建一个字符串似乎是保存某些中间状态的一种方法。如果是这样的话，您应该查看圣蒙纳德。它所做的事情与IO所做的一样，除了不能print或putStrLn之外。但是，你可以在你做完所有的计算之后再做这些事情。

如果要计算整个算法转换链，则必须执行以下操作：

testAlgorithmM = (b,s0)
    where (s0, a) = m2 $ m1b $ initN $ m1a (AlgorithmM [2,2,2] [] 0 0)
          b       = m5 $ m4 $ m3 a

这也会输出您的中间字符串值，以防您想要看到它。

Answer 2

首先，懒惰永远不应该对纯功能的价值产生明显的影响(除非高度病理状态)。因此，列表索引错误不可能是太多懒惰的结果。

假设我们从面值获取错误消息，并猜测错误来自m4，它直接调用Prelude.!!。让我们使用GHCi调试器

ghci> :break m4
ghci> :step main
ghci> :continue
Stopped at foo.hs:(24,1)-(26,50)
ghci> :step
Stopped at foo.hs:24:27-137
_result :: (IO (), AlgorithmM) = _
a :: [Int] = _
j :: Int = _
m :: [Int] = _
n :: Int = _
ghci> :list
23  m4 :: AlgorithmM->(IO (),AlgorithmM)
24  m4 (AlgorithmM m a j n) =
      if (a !! j) == (m !! j) - 1
         then m4 (AlgorithmM m (setajZero a j) (j-1) n)
         else  (return (),AlgorithmM m a j n)
25   where setajZero (x:xs) 0 = 0:xs
ghci> :force a j m n
a = [0,0,0]
j = 3
m = [2,2,2,2]
n = 3

猜猜接下来会发生什么？

Answer 3

该错误意味着索引已经超过列表的末尾；与懒惰无关。看看实施。

你的实施显然是错误的。也许你只是证明了这是正确的？