Как исправить утечку памяти (утечка?) В Haskell?

Question

Я пытаюсь исправить утечку памяти в этом коде. Он не завершается в течение десяти минут на небольших входах и выдает ошибку «недостаточно памяти» при запуске с stack exec. Я думаю, что утечка памяти находится в конструкции newMap. Я думаю, что это может быть утечка, потому что это внутри рекурсивной функции. Я попытался использовать расширение Strict GH C и использовать seq и deepseq и варианты кода ниже.

Я думаю, что утечка здесь:

    !existingPolysets <- get
    let newMap = (List.foldl' (\accumulator coefficient ->
                  let newMonomial = (Monomial coefficient degree)
                      innerMap = addOneMonomialToPolySets newMonomial (PolynomialConstraints x y bound maxDegree) existingPolysets accumulator in
                    Map.union innerMap accumulator) Map.empty [-bound..bound])
    ($!!) modify' (const newMap)

Ниже приведен остальной код:

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE BangPatterns #-}
module Dag where

import Control.Monad.State.Strict
import Control.Monad (liftM, ap)
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import GHC.Generics (Generic)
import Data.Hashable
import Control.DeepSeq

data PolynomialConstraints = PolynomialConstraints Integer Integer Integer Integer
-- x y bound degree
  deriving (Show, Eq, Ord, Generic)

data Index = Index Integer Integer -- degree, output
  deriving (Show, Eq, Ord, Generic)
type MyState = Map.Map Index PolynomialSetWithIdentifier

instance NFData Index
instance NFData Monomial
instance NFData Identifier
instance NFData SubPolynomialSetWithIdentifier
instance NFData PolynomialSetWithIdentifier
instance NFData PolynomialConstraints

instance Hashable Monomial
instance Hashable Identifier
instance Hashable SubPolynomialSetWithIdentifier
instance Hashable PolynomialSetWithIdentifier

data PolynomialSetWithIdentifier = PolynomialSetWithIdentifier [SubPolynomialSetWithIdentifier] Identifier
  deriving (Show, Eq, Ord, Generic)
data SubPolynomialSetWithIdentifier = SubPolynomialSetWithIdentifier Monomial PolynomialSetWithIdentifier Identifier
  deriving (Show, Eq, Ord, Generic)

data Identifier = Identifier Int
  deriving (Show, Eq, Ord, Generic)

type PolynomialsSolutions a = State MyState a

data Monomial = Monomial Integer Integer
-- coeff, degree
  deriving (Show, Eq, Ord, Generic)

emptyPolynomialSetWithID = (PolynomialSetWithIdentifier [] (Identifier $ hash $ getSubPolynomialSetsIdentifiers []))

getSubPolynomialSetsIdentifiers :: [SubPolynomialSetWithIdentifier] -> [Identifier] -- is this good or should it be [Int] ? more typing seems safer
-- returns a list the identifiers of the SubPolynomialSets in subPolynomialSetsWithID
getSubPolynomialSetsIdentifiers = List.map (\(SubPolynomialSetWithIdentifier monomial polynomialSetWithID identifier) -> identifier)

getPolynomialSetIdentifier :: PolynomialSetWithIdentifier -> Identifier
-- returns the identifier of a PolynomialSet
getPolynomialSetIdentifier (PolynomialSetWithIdentifier subPolynomialSets identifier) = identifier

getOutputForOneCoefficient :: Integer -> Integer -> Integer -> Integer -> Integer -> Integer
-- returns the output of the polynomial having coefficient coefficient for monomials from degree maxDegree to degree minDegree
--  and monomials of degree < minDegree having total value computedOutput for x value x
--  minDegree must be <= maxDegree
getOutputForOneCoefficient minDegree maxDegree coefficient x computedOutput 
  = List.foldl' (\total degree -> total + (coefficient * x ^ degree)) computedOutput [minDegree .. maxDegree]

getLowerBound :: Integer -> PolynomialConstraints -> Integer -> Integer
-- returns the lower bound for the polynomial having sum totalOutput for monomials of degree <= monomialDegree 
--  and polynomial constraints (PolynomialConstraints x y bound maxPolynomialDegree) 
getLowerBound totalOutput (PolynomialConstraints x y bound maxPolynomialDegree) monomialDegree
  | x >= 0 = getOutputForOneCoefficient (monomialDegree + 1) maxPolynomialDegree (-bound) x totalOutput
  | otherwise = List.foldl' (\total degree ->
                              if degree `mod` 2 == 0
                              then total + (-bound) * x ^ degree
                              else total +   bound  * x ^ degree) totalOutput [monomialDegree + 1 .. maxPolynomialDegree]

checkPolynomialSetPossible :: Integer -> PolynomialConstraints -> Integer -> Bool
-- returns False if it is impossible to produce y for PolynomialConstraints polynomialConstraints, Monomial monomial,
--  and total output computed so far Integer totalOutput
checkPolynomialSetPossible totalOutput (PolynomialConstraints x y bound maxPolynomialDegree) monomialDegree
  | monomialDegree < maxPolynomialDegree =
    let lowerBound = getLowerBound totalOutput (PolynomialConstraints x y bound maxPolynomialDegree) monomialDegree
        upperBound = getOutputForOneCoefficient (monomialDegree + 1) maxPolynomialDegree   bound  x totalOutput in
          lowerBound <= y && y <= upperBound
  | otherwise = totalOutput == y

filterPolynomialsByDegree :: Map.Map Index PolynomialSetWithIdentifier -> Integer -> Map.Map Index PolynomialSetWithIdentifier
-- O(n)
-- returns Map Index PolynomialSetWithIdentifier in which all values have degree correctDegree
filterPolynomialsByDegree mapPolynomialSets correctDegree = Map.filterWithKey (\(Index degree output) polynomialSetID -> degree == correctDegree) mapPolynomialSets

mapValues :: Ord a => Map.Map k a -> Set.Set a
mapValues m = Map.foldlWithKey'(\accumulator key value -> Set.insert value accumulator) Set.empty m

addOneMonomialToPolySets :: Monomial -> PolynomialConstraints -> Map.Map Index PolynomialSetWithIdentifier -> Map.Map Index PolynomialSetWithIdentifier -> Map.Map Index PolynomialSetWithIdentifier

addOneMonomialToPolySets (Monomial coefficient degree) (PolynomialConstraints x y bound polynomialDegree) existingMapDegreeMinus1 existingAccumulatorMap =
  let newMonomial = Monomial coefficient degree -- this does get bound way too early, but it's so small... probably something else?
      newMonomialOutput = coefficient * x ^ degree in
        Map.foldlWithKey' (\accumulator (Index existingDegree existingOutput) !existingPolynomialSetWithID ->
                              let !totalOutput = newMonomialOutput + existingOutput in
                                if checkPolynomialSetPossible totalOutput (PolynomialConstraints x y bound polynomialDegree) degree
                                then
                                  case Map.lookup (Index degree totalOutput) accumulator of
                                    Just (PolynomialSetWithIdentifier !subPolynomialSets _) ->
                                      let !newSubPolynomialSetWithID   = SubPolynomialSetWithIdentifier newMonomial existingPolynomialSetWithID (Identifier $ hash (newMonomial, getPolynomialSetIdentifier existingPolynomialSetWithID)) in
                                        let !newSubPolynomialSets      = List.insert newSubPolynomialSetWithID subPolynomialSets in
                                          let !newPolynomialSetWithID  = PolynomialSetWithIdentifier newSubPolynomialSets (Identifier $ hash $ getSubPolynomialSetsIdentifiers newSubPolynomialSets) in
                                            insert (Index degree totalOutput) newPolynomialSetWithID accumulator
                                    Nothing ->
                                      let !newSubPolynomialSetWithID = SubPolynomialSetWithIdentifier newMonomial existingPolynomialSetWithID (Identifier $ hash (newMonomial, getPolynomialSetIdentifier existingPolynomialSetWithID)) in
                                        let !newPolynomialSetWithID  = PolynomialSetWithIdentifier [newSubPolynomialSetWithID] (Identifier $ hash $ getSubPolynomialSetsIdentifiers [newSubPolynomialSetWithID]) in
                                          insert (Index degree totalOutput) newPolynomialSetWithID accumulator
                                else accumulator
                                ) existingAccumulatorMap existingMapDegreeMinus1

makePolynomialSetsFast :: PolynomialConstraints -> PolynomialsSolutions ()
makePolynomialSetsFast (PolynomialConstraints x y bound degree) = 
  makePolynomialSetsForMaxDegree (PolynomialConstraints x y bound 0) degree

makePolynomialSetsFastDegreeZero :: PolynomialConstraints -> Integer -> PolynomialsSolutions ()
makePolynomialSetsFastDegreeZero (PolynomialConstraints x y bound degree) maxDegree =
  let newMap = (List.foldl' (\accumulator coefficient ->
                let newMonomial         = (Monomial coefficient degree)
                    newSubPolynomialSet = SubPolynomialSetWithIdentifier newMonomial emptyPolynomialSetWithID (Identifier $ hash (newMonomial, getPolynomialSetIdentifier emptyPolynomialSetWithID))
                    newPolynomialSet    = PolynomialSetWithIdentifier [newSubPolynomialSet] (Identifier $ hash $ getSubPolynomialSetsIdentifiers [newSubPolynomialSet]) in
                  Map.insert (Index degree coefficient) newPolynomialSet accumulator)  Map.empty [-bound .. bound]) in
  modify' (const newMap)

makePolynomialSetsForMaxDegree :: PolynomialConstraints -> Integer -> PolynomialsSolutions ()
makePolynomialSetsForMaxDegree (PolynomialConstraints x y bound degree) maxDegree
  | degree == maxDegree =
    if degree == 0
    then makePolynomialSetsFastDegreeZero (PolynomialConstraints x y bound degree) maxDegree
    else do -- base case
      !existingPolysets <- get only need highest level.
      let finalMap = (List.foldl' (\accumulator coefficient ->
                      let newMonomial = (Monomial coefficient degree) in
                        Map.union (addOneMonomialToPolySets newMonomial (PolynomialConstraints x y bound maxDegree) existingPolysets accumulator) accumulator) Map.empty [-bound .. bound])
      ($!!) modify' (const finalMap) -- definitely needs to be deep-seq'ed
  | degree == 0 = do
    makePolynomialSetsFastDegreeZero (PolynomialConstraints x y bound degree) maxDegree
    makePolynomialSetsForMaxDegree (PolynomialConstraints x y bound (degree +1)) maxDegree
  | otherwise = do
    !existingPolysets <- get
    let newMap = (List.foldl' (\accumulator coefficient ->
                  let newMonomial = (Monomial coefficient degree)
                      innerMap = addOneMonomialToPolySets newMonomial (PolynomialConstraints x y bound maxDegree) existingPolysets accumulator in
                    Map.union innerMap accumulator) Map.empty [-bound..bound])
    ($!!) modify' (const newMap)
    makePolynomialSetsForMaxDegree (PolynomialConstraints x y bound (degree +1)) maxDegree

Как я могу исправить эту утечку памяти?

Answer 1

Одна проблема (возможно, не единственная) заключается в том, что ($!!) modify' (const finalMap) при оценке не усугубляет finalMap. Это потому, что const finalMap является функцией, а deepseq не go прошлых функций. Экземпляр NFData для функций говорит:

Этот экземпляр для удобства и согласованности с seq. Это предполагает, что WHNF эквивалентен NF для функций.

И лямбда-абстракции уже находятся в WHNF .

Например, этот код не дает никакого ошибки в ghci:

Prelude Control.DeepSeq> seq (rnf (const undefined)) ()
()

Вместо ($!!) modify' (const finalMap) я бы go с put $! rnf finalMap. При оценке этого выражения, rnf finalMap вычисляется первым благодаря $! , и это, в свою очередь, вызывает Deepseq.