performance - 为什么嵌套的 MaybeT 会导致指数分配

Question

我有一个程序。

import Control.Monad
import Control.Monad.Identity
import Control.Monad.Trans.Maybe

import System.Environment

tryR :: Monad m => ([a] -> MaybeT m [a]) -> ([a] -> m [a])
tryR f x = do
  m <- runMaybeT (f x)
  case m of
    Just t -> return t
    Nothing -> return x

check :: MonadPlus m => Int -> m Int
check x = if x `mod` 2 == 0 then return (x `div` 2) else mzero

foo :: MonadPlus m => [Int] -> m [Int]
foo [] = return []
foo (x:xs) = liftM2 (:) (check x) (tryR foo xs)


runFoo :: [Int] -> [Int]
runFoo x = runIdentity $ tryR foo x

main :: IO ()
main = do
  [n_str] <- getArgs
  let n = read n_str :: Int
  print $ runFoo [2,4..n]

这个程序的主要有趣之处在于它可以有许多嵌套的 MaybeT 层。在这里，这样做绝对没有任何目的，但在我遇到此问题的原始程序中确实如此。

想猜一下这个程序的时间复杂度吗？

好的，你通过阅读这个问题的标题作弊了。是的，它是指数级的:

[jkoppel@dhcp-18-189-103-38:~/tmp]$ time ./ExpAlloc 50                                                                                                                                        (03-31 17:15)
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25]
./ExpAlloc 50  8.10s user 0.06s system 99% cpu 8.169 total
[jkoppel@dhcp-18-189-103-38:~/tmp]$ time ./ExpAlloc 52                                                                                                                                        (03-31 17:15)
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26]
./ExpAlloc 52  16.10s user 0.12s system 99% cpu 16.227 total
[jkoppel@dhcp-18-189-103-38:~/tmp]$ time ./ExpAlloc 54                                                                                                                                        (03-31 17:16)
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27]
./ExpAlloc 54  32.32s user 0.23s system 99% cpu 32.561 total

一些进一步的检查表明原因是因为它分配了指数数量的内存，这自然需要指数数量的时间:

[jkoppel@dhcp-18-189-103-38:~/tmp]$ time ./ExpAlloc 40 +RTS -s                                                                                                                                (03-31 17:17)
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20]
     939,634,520 bytes allocated in the heap
       5,382,816 bytes copied during GC
          75,808 bytes maximum residency (2 sample(s))
          66,592 bytes maximum slop
               2 MB total memory in use (0 MB lost due to fragmentation)

                                     Tot time (elapsed)  Avg pause  Max pause
  Gen  0      1796 colls,     0 par    0.008s   0.009s     0.0000s    0.0000s
  Gen  1         2 colls,     0 par    0.000s   0.000s     0.0001s    0.0001s

  INIT    time    0.000s  (  0.000s elapsed)
  MUT     time    0.243s  (  0.246s elapsed)
  GC      time    0.008s  (  0.009s elapsed)
  EXIT    time    0.000s  (  0.000s elapsed)
  Total   time    0.252s  (  0.256s elapsed)

  %GC     time       3.2%  (3.6% elapsed)

  Alloc rate    3,869,930,149 bytes per MUT second

  Productivity  96.8% of total user, 95.3% of total elapsed

./ExpAlloc 40 +RTS -s  0.25s user 0.00s system 98% cpu 0.260 total
[jkoppel@dhcp-18-189-103-38:~/tmp]$ time ./ExpAlloc 42 +RTS -s                                                                                                                                (03-31 17:17)
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21]
   1,879,159,424 bytes allocated in the heap
      10,767,048 bytes copied during GC
          95,504 bytes maximum residency (3 sample(s))
          71,152 bytes maximum slop
               2 MB total memory in use (0 MB lost due to fragmentation)

                                     Tot time (elapsed)  Avg pause  Max pause
  Gen  0      3593 colls,     0 par    0.016s   0.018s     0.0000s    0.0000s
  Gen  1         3 colls,     0 par    0.000s   0.000s     0.0001s    0.0001s

  INIT    time    0.000s  (  0.000s elapsed)
  MUT     time    0.493s  (  0.498s elapsed)
  GC      time    0.016s  (  0.018s elapsed)
  EXIT    time    0.000s  (  0.000s elapsed)
  Total   time    0.510s  (  0.517s elapsed)

  %GC     time       3.1%  (3.5% elapsed)

  Alloc rate    3,810,430,292 bytes per MUT second

  Productivity  96.8% of total user, 95.7% of total elapsed

./ExpAlloc 42 +RTS -s  0.51s user 0.01s system 99% cpu 0.521 total
[jkoppel@dhcp-18-189-103-38:~/tmp]$ time ./ExpAlloc 44 +RTS -s                                                                                                                                (03-31 17:17)
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22]
   3,758,208,408 bytes allocated in the heap
      21,499,312 bytes copied during GC
         102,056 bytes maximum residency (5 sample(s))
          73,784 bytes maximum slop
               2 MB total memory in use (0 MB lost due to fragmentation)

                                     Tot time (elapsed)  Avg pause  Max pause
  Gen  0      7186 colls,     0 par    0.032s   0.037s     0.0000s    0.0009s
  Gen  1         5 colls,     0 par    0.000s   0.001s     0.0001s    0.0001s

  INIT    time    0.000s  (  0.000s elapsed)
  MUT     time    0.979s  (  0.987s elapsed)
  GC      time    0.033s  (  0.038s elapsed)
  EXIT    time    0.000s  (  0.000s elapsed)
  Total   time    1.013s  (  1.024s elapsed)

  %GC     time       3.2%  (3.7% elapsed)

  Alloc rate    3,840,757,815 bytes per MUT second

  Productivity  96.7% of total user, 95.6% of total elapsed

./ExpAlloc 44 +RTS -s  1.01s user 0.01s system 99% cpu 1.029 total

我终其一生都无法弄清楚它为什么会这样。我很感激人们能对这种情况有所了解。

Answer 1

transformers 包(当前版本为 0.5.4.0)使用 liftM 实现 MonadTrans:

lift :: Monad m => m a -> MaybeT m a
lift = MaybeT . liftM Just

其中 liftM 是一个组合子，定义为

liftM :: Monad m => (a -> b) -> m a -> m b
liftM f m = m >>= \a -> return (f a)

此外，return 被定义为 MaybeT 为

return :: Monad m => a -> MaybeT m a
return a = lift . return

减少定义:

return :: Monad m => a -> MaybeT m a
return a = MaybeT (return a >>= \a -> return (Just a))

其中两个内部 return 以 m 类型实例化。

一次调用 return @(MaybeT m) 两次调用 return @m，因此您观察到的 MaybeT 塔呈指数行为.

这可以通过使用 fmap 而不是 liftM 来解决，但是当 Functor 不是 的父类(super class)时，这是向后不兼容的单子(monad).

编辑:其他转换器没有这个问题，因为 return 不是使用 lift 定义的，它提供了更好的修复。

return = MaybeT . return . Just

---

这是一个更简单的测试用例:

{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
import Control.Monad.Trans.Maybe
import System.Environment

f :: forall m proxy. Monad m => proxy m -> Int -> ()
f _ 0 = (return () :: m ()) `seq` ()
f _ n = f (undefined :: proxy (MaybeT m)) (n - 1)

main = do
  n : _ <- getArgs
  f (undefined :: proxy []) (read n) `seq` return ()

输出

> for i in {18..21} ; time ./b $i
./b $i  0.35s user 0.04s system 99% cpu 0.390 total
./b $i  0.71s user 0.07s system 99% cpu 0.782 total
./b $i  1.38s user 0.18s system 99% cpu 1.565 total
./b $i  2.82s user 0.32s system 100% cpu 3.139 total