haskell - "inject"Haskell 计算中的进度记录/跟踪？

Question

我正在选择一个特定的任务来说明我在说什么

假设我天真地想找到一个大数的所有因子的总和——通过检查它下面的每个数字是否是一个因子，然后将它们加在一起。

在 IO 和纯计算之间没有分离的命令式编程语言中，您可能会做这样的事情

def sum_of_factors(n):
  sum = 0
  for i between 1 and n:
    if (n % i == 0):
      sum += i
  return sum

但是，如果我的 n很大，我最终会在计算完成之前长时间盯着一个空屏幕。所以我添加了一些日志记录——

def sum_of_factors(n):
  sum = 0
  for i between 1 and n:
    if (i % 1000 == 0):
      print "checking $i..."
    if (n % i == 0):
      print "found factor $i"
      sum += 1
  return sum

真的，这个添加是微不足道的。

现在，如果我要在教科书haskell中这样做，我可能会这样做

sum_of_factors :: Int -> Int
sum_of_factors n = foldl' (+) 0 factors
  where
    factors = filter ((== 0) . (mod n)) [1..n]

我遇到了和以前一样的问题......对于大量数字，我只是盯着空白屏幕一会儿。

但我不知道如何在 Haskell 代码中注入(inject)相同类型的跟踪/日志记录。我不确定，除了可能用显式递归重新实现折叠之外，以获得与命令式不纯代码中相同的跟踪模式/结果。

Haskell 中是否有教员可以做到这一点？一个不需要重构所有东西的？

谢谢

Answer 1

有许多可能的解决方案。

最简单的一种是更改您的函数以返回事件流而不是最终结果。你 sum_of_factors不为我编译，所以我将使用 sum功能为例。这个想法是发送Left message显示进度，并发送 Right result完成后。由于惰性评估，您将在函数工作时看到进度事件:

import Control.Monad

sum' :: [Int] -> [Either String Int]
sum' = go step 0
  where
  step = 10000
  go _ res [] = [Right res]
  go 0 res (x:xs) = Left ("progress: " ++ show x) : go step (res + x) xs
  go c res (x:xs) = go (c - 1) (res + x) xs

main :: IO ()
main = do
  forM_ (sum' [1..1000000]) $ \event ->
    case event of
      Right res -> putStrLn $ "Result: " ++ show res
      Left str -> putStrLn str

其他(从我的角度来看更好)解决方案是使函数单子(monad):

class Monad m => LogM m where
  logMe :: String -> m ()

instance LogM IO where
  logMe = putStrLn

sum' :: LogM m => [Int] -> m Int
sum' = go step 0
  where
  step = 10000
  go _ res [] = return res
  go 0 res (x:xs) = logMe ("progress: " ++ show x) >> go step (res + x) xs
  go c res (x:xs) = go (c - 1) (res + x) xs

main :: IO ()
main = sum' [1..1000000] >>= print

或使用 foldM :

import Control.Monad

sum' :: LogM m => [Int] -> m Int
sum' = liftM snd . foldM go (0, 0)
  where
    step = 10000
    -- `!` forces evaluation and prevents build-up of thunks.
    -- See the BangPatterns language extension.
    go (!c, !res) x = do
        when (c == 0) $ logMe ("progress: " ++ show x)
        return $ ((c + 1) `mod` step, res + x)