Как сложить списки ленивых типов ([IO a])?

Question

Я не знаю, является ли это действительным термином «ленивые типы».Но все-таки IO ленив, поэтому в

import Control.Monad
import Data.List

result :: IO Double
result = foldl1' (liftM2 (+)) $ map return [1..10000000]

result' :: IO Double
result' = return $ foldl1' (+) [1..10000000]

result работает медленно и использует много памяти, в отличие от result'.Как мне сбросить [IO a]?

Answer 1

result создает одно большое значение IO Double без оценки каких-либо промежуточных результатов, что происходит только тогда, когда требуется общий результат, например, для печати. foldl' оценивает промежуточные результаты для слабой головы нормальной формы, то есть для самого внешнего конструктора или лямбды. Поскольку (в GHC), IO a имеет конструктор IO, промежуточные результаты сгиба имеют вид

IO (some computation combined with another)

и выражение под IO усложняется на каждом шаге.

Чтобы избежать этого, вы должны принудительно установить не только промежуточные IO значения, но также и значения, которые они возвращают,

main :: IO ()
main = foldlM' (\a -> fmap (a+)) 0 (map return [1.0 .. 10000000]) >>= print

foldlM' :: Monad m => (a -> b -> m a) -> a -> [b] -> m a
foldlM' foo a [] = return a
foldlM' foo a (b:bs) = do
    c <- foo a b
    c `seq` foldlM' foo c bs

работает для вашего примера.

Answer 2

Проблема в том, что foldl' только уменьшает аккумулятор до WHNF на каждом шаге.В этом случае аккумулятором является действие IO, а оценка действия IO не приводит к принудительному изменению значения, поэтому вы получите типичный огромный поток, который не будет оценен до конца.

Решение состоит в том, чтобы использовать что-то более строгое, чем liftM2, например:

result'' :: IO Double
result'' = foldl1' f $ map return [1..100000]
    where f mx my = do x <- mx; y <- my; return $! x + y

Вот быстрый тест:

import Control.Monad
import Data.List
import Criterion.Main

result :: IO Double
result = foldl1' (liftM2 (+)) $ map return [1..100000]

result' :: IO Double
result' = return $ foldl1' (+) [1..100000]

result'' :: IO Double
result'' = foldl1' f $ map return [1..100000]
  where f mx my = do x <- mx; y <- my; return $! x + y

main = defaultMain [ bench "result" $ whnfIO result
                   , bench "result'" $ whnfIO result'
                   , bench "result''" $ whnfIO result'' ]

Результат:

[...]
benchmarking result
collecting 100 samples, 1 iterations each, in estimated 37.32438 s
mean: 136.3221 ms, lb 131.4504 ms, ub 140.8238 ms, ci 0.950
std dev: 23.92297 ms, lb 22.00429 ms, ub 25.53803 ms, ci 0.950

benchmarking result'
collecting 100 samples, 14 iterations each, in estimated 6.046951 s
mean: 4.349027 ms, lb 4.338121 ms, ub 4.367363 ms, ci 0.950
std dev: 70.96316 us, lb 49.01322 us, ub 113.0399 us, ci 0.950

benchmarking result''
collecting 100 samples, 2 iterations each, in estimated 8.131099 s
mean: 41.89589 ms, lb 40.67513 ms, ub 43.52798 ms, ci 0.950
std dev: 7.194770 ms, lb 5.758892 ms, ub 8.529327 ms, ci 0.950

Как видите, это все еще медленнее, чем чистый код, но не так сильно.

Answer 3

на основе ответа Даниила вариант, который позволяет напрямую реализовать аналог foldl1':

result'' :: IO Double
result'' = foldlM1' (+) (map return [1.0 .. 100000000])

foldlM' :: Monad m => (a -> b -> a) -> m a -> [m b] -> m a
foldlM' foo ma [] = ma
foldlM' foo ma (mb:mbs) = do
    c <- (liftM2 foo) ma mb
    c `seq` foldlM' foo (return c) mbs

foldlM1' foo (x:xs) = foldlM' foo x xs
foldlM1' _ []       = error "Empty list for foldlM1'"