为什么 WriterT State 需要这么多内存?

Why do I need so much memory for WriterT State?

试图掌握我正在尝试使用 WriterT 和 State(它是 advent of code day 15)解决 Haskell 中的练习的概念。出于某种原因,我不明白我最终使用了大量内存,我的笔记本(只有 4G Ram)停止运行。

我的第一个想法是严格使用并在周围洒上刘海 - 但问题仍然存在。

谁能解释一下我哪里做错了?

这里是清理过的代码:

{-# LANGUAGE BangPatterns #-}
module Main where
import Control.Monad.State.Strict
import Control.Monad.Writer.Strict

main = do
  let generators = (Generator 65 16807, Generator 8921 48271)
      res1 = compute generators (4*10^7) 
  putStrLn "Answer 1"
  print res1

data Generator = Generator { _value :: Int
                           , _factor :: Int
                           }
    deriving Show

newtype Value = Value Int
  deriving (Show, Eq)

newtype Counter = Counter Int
  deriving (Show, Eq)

instance Monoid Counter where
  mempty = Counter 0
  mappend (Counter !a) (Counter !b) = Counter (a+b)

generate :: Generator -> (Value, Generator)
generate (Generator v f) = (Value newval, Generator newval f)
  where newval = (v * f) `mod` 2147483647

agree (Value a) (Value b) = (a `mod` mf) == (b `mod` mf)
  where mf = 2^16

oneComp :: State (Generator, Generator) Bool
oneComp = do
  (!ga, !gb) <- get
  let (va, gan) = generate ga
      (vb, gbn) = generate gb
      !ag = agree va vb
  put (gan, gbn)
  pure ag

counterStep :: WriterT Counter (State (Generator, Generator)) ()
counterStep = do
  !ag <- lift oneComp
  when ag $ tell (Counter 1)

afterN :: Int -> WriterT Counter (State (Generator, Generator)) ()
afterN n = replicateM_ n counterStep

compute s0 n = evalState (execWriterT (afterN n)) s0

我用stack编译的。 cabal 文件中的条目是:

executable day15
  hs-source-dirs:      app
  main-is:             day15.hs
  ghc-options:         -threaded -rtsopts -with-rtsopts=-N 
  build-depends:       base
                     , advent
                     , hspec
                     , mtl
  default-language:    Haskell2010

更新

我有更多时间并按照建议使 Generator 严格。但是仍然有一些东西占用了太多内存。

这是我认为可能相关的 prof 文件部分。

            Fri Dec 15 16:28 2017 Time and Allocation Profiling Report  (Final)

       day15 +RTS -N -p -RTS

    total time  =       71.66 secs   (71662 ticks @ 1000 us, 1 processor)
    total alloc = 17,600,423,088 bytes  (excludes profiling overheads)

COST CENTRE    MODULE    SRC                          %time %alloc

afterN         Main      app/day15.hs:79:1-36          41.1   20.0
mappend        Main      app/day15.hs:51:3-51          31.0    3.6
oneComp        Main      app/day15.hs:(64,1)-(71,9)     9.2   49.1
generate.(...) Main      app/day15.hs:55:9-42           8.5   14.5

原因很可能是 WriterT 层。

甚至 "strict" WriterT 在累加器中 完全是惰性的 — 在与累加器无关的另一种意义上它是严格的。

例如,这个程序运行没有错误:

import Data.Monoid
import Control.Monad.Trans.Writer
import Control.Exception

main :: IO ()
main = do
  let (x,_) = runWriter $ do
        tell $ Sum (1::Float)
        tell (throw $ AssertionFailed "oops")
        tell (error "oops")
        tell undefined
        tell (let z = z in z)
        return True
  print x

此外,不可能从 WriterT 中 "strictify" 累加器,因为无法到达它。

对于长时间的计算,thunk 会累积并消耗大量内存。

一种解决方案是将计数器存储在 StateT 层中。严格的 modify' 函数在这里很有用。


使用 StateT 作为仅追加累加器有点不尽如人意。另一种选择是使用 Accum 并明智地定位 BangPatterns。该程序抛出错误:

import Control.Monad.Trans.Accum

main :: IO ()
main = do
  let (x,_) = flip runAccum mempty $ do
        add $ Sum (1::Float)
        add $ error "oops"
        !_ <- look
        return True
  print x

Accum 就像一个 Writer 让你访问累加器。它不让你随意更改,只能添加。但是掌握了它就足以引入严格了。