Haskell 堆栈溢出答案

【问题标题】：Haskell Stack OverflowHaskell 堆栈溢出
【发布时间】：2011-08-22 19:53:53
【问题描述】：

我正在编写一个遗传算法来生成字符串“helloworld”。但是当 n 大于等于 10,000 时，evolve 函数会产生堆栈溢出。

module Genetics where

import Data.List (sortBy)
import Random (randomRIO)
import Control.Monad (foldM)

class Gene g where
    -- How ideal is the gene from 0.0 to 1.0?
    fitness :: g -> Float

    -- How does a gene mutate?
    mutate :: g -> IO g

    -- How many species will be explored?
    species :: [g] -> Int

orderFitness :: (Gene g) => [g] -> [g]
orderFitness = reverse . sortBy (\a b -> compare (fitness a) (fitness b))

compete :: (Gene g) => [g] -> IO [g]
compete pool = do
    let s = species pool
    variants <- (mapM (mapM mutate) . map (replicate s)) pool
    let pool' = (map head . map orderFitness) variants
    return pool'

evolve :: (Gene g) => Int -> [g] -> IO [g]
evolve 0 pool = return pool
evolve n pool = do
    pool' <- compete pool
    evolve (n - 1) pool'

使用species pool = 8，8 个基因库复制到 8 个组。每组变异，每组中最适者被选为进一步进化（回到8个基因）。

GitHub

【问题讨论】：

假设您使用ghc -O2 作为编译器，您的第一个版本在evolve 函数中没有任何堆栈溢出。既然看不到compete的实现，只能这么说。
上面提供的 GitHub 链接 (github.com/mcandre/genetics) 指定了 compete 以及一个确实使用 ghc -O2 的 Makefile。我认为第一个示例中的<- 足以防止堆栈溢出。我不确定问题出在哪里。
>>= 应该等于 do 表示法，没有区别。
正如 dons 所指出的，问题完全出在竞争函数上，毫无疑问，该函数会在彼此之上运行多次，从而构建一个具有一大串 thunk 的数据结构。我确信 github 链接具有必要的数据，但对于那些希望帮助您在此处发布一个完整的工作示例来展示您的问题的人会更有帮助——最好是尽可能减少。与此同时，快速+肮脏的解决方案是在每次递归调用时 rnf 或以其他方式强制您的池。
嗯，他们为什么首先在这里使用 IO monad？看起来丑陋且不习惯。他们可能应该改用随机单子，或者直接向变异函数提供随机数。

标签： memory haskell random stack-overflow genetic-algorithm

【解决方案1】：

如果您对性能感兴趣，我会使用快速随机数生成器，例如：

The mersenne-random package

其次，compete 看起来非常可疑，因为它完全是懒惰的，尽管它建造了一些潜在的大型结构。尝试使用deepseq 锤子将其重写得更严格一些：

import Control.DeepSeq    

compete :: (Gene g, NFData g) => [g] -> IO [g]
compete pool = do
    let s = species pool
    variants <- (mapM (mapM mutate) . map (replicate s)) pool
    let pool' = (map head . map orderFitness) variants
    pool' `deepseq` return pool'

不过，这些东西都不需要在 IO 中（单独的问题）。 Rand monad 之类的东西可能是 more appropriate。

【讨论】：

@Don deepseq 锤子解决了这个问题（赞成）。但是感觉像是在作弊。我想知道堆栈溢出发生在compete 的哪个位置。
一个可能的候选者是使用嵌套的mapM。但是，可以肯定的是：配置文件。像这样：stackoverflow.com/questions/5939630/…
@mcandre 你可能对RWH # space profiling感兴趣
@Don 将(mapM (mapM ... 和(map head ...) 分成两个函数（drift 和compete）并将deepseq 移动到drift 中有效，所以问题出在(mapM (mapM mutate) . map (replicate s)) pool .我相信(mapM (mapM ... 会造成堆栈溢出。
@mcandre - 检查黑线鳕，您使用 pureMT :: Word64 -> PureMT 使用 64 位 int 初始化生成器，它可能来自任何地方，如果您想从时钟播种，则使用 newPureMT。

【解决方案2】：

您可以使用maximumBy 和单个map，而不是使用(map head . map orderFitness)，其中orderFitness 是sortBy。这并没有节省太多（因为您要从 O(n log n) 到 O(n) 并且可能会从消除双重映射中获得另一个两倍），但至少更简单和更有效.你也可以摆脱调用reverse。

我怀疑这是否解决了没有deepseq 的问题，但它应该是一个改进。

编辑：如果标准库和 GHC 是完美的，那么 head . sortBy 将产生与 maximumBy 相同的代码，map head . map sortBy 将产生与 map (head . sortBy) 相同的代码，遗憾的是，这些事情在实践中都不可能是真的. sortBy 会倾向于做一堆额外的内存分配，因为它是一种分而治之的算法。组合地图是您有时会得到的优化，但不应指望。

更重要的是，使用maximumBy 更具声明性。更容易看到代码做了什么以及需要多长时间。在优化中利用它也应该更容易，因为我们知道目标是什么，而不仅仅是我们如何得到它。

【讨论】：

谢谢！它不能解决问题，但我会将您的建议包含在解决方案中。

【解决方案3】：

感谢 Don 的 deepseq 建议，我能够将问题缩小到 mapM mutate，这导致了太多的 thunks。新版本有mutate'，它使用seq来防止thunking。

module Genetics where

import Data.List (maximumBy)
import Random (randomRIO)

class Gene g where
    -- How ideal is the gene from 0.0 to 1.0?
    fitness :: g -> Float

    -- How does a gene mutate?
    mutate :: g -> IO g

    -- How many species will be explored in each round?
    species :: [g] -> Int

best :: (Gene g) => [g] -> g
best = maximumBy (\a b -> compare (fitness a) (fitness b))

-- Prevents stack overflow
mutate' :: (Gene g) => g -> IO g
mutate' gene = do
    gene' <- mutate gene
    gene' `seq` return gene'

drift :: (Gene g) => [[g]] -> IO [[g]]
drift = mapM (mapM mutate')

compete :: (Gene g) => [g] -> IO [g]
compete pool = do
    let islands = map (replicate (species pool)) pool
    islands' <- drift islands
    let representatives = map best islands'
    return representatives

evolve :: (Gene g) => Int -> [g] -> IO [g]
evolve 0 pool = return pool
evolve n pool = compete pool >>= evolve (n - 1)

GitHub

【讨论】：