为什么嵌套的 MaybeT 会导致指数分配
Why do nested MaybeT's cause exponential allocation
我有一个程序。
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
我一辈子都弄不明白为什么会这样。我将不胜感激任何人能对这种情况有所了解。
变形金刚包（当前版本为 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 不是 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
我有一个程序。
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
我一辈子都弄不明白为什么会这样。我将不胜感激任何人能对这种情况有所了解。
变形金刚包（当前版本为 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 不是 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