Memory Haskell堆栈溢出

我正在写一个遗传算法来生成字符串“helloworld”。但是当n等于或大于10000时，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'

模块遗传学在哪里
导入数据列表（排序）
导入随机（randomRIO）
进口管制.单子（foldM）
g类基因在哪里
--从0.0到1.0的基因有多理想？
适合度：：g->Float
--基因是如何变异的？
变异：：g->IO g
--将探索多少物种？
种类：：[g]->Int
顺序适合度：：（基因g）=>[g]->[g]
orderFitness=反向。排序（\a b->比较（适合度a）（适合度b））
竞争：：（基因g）=>[g]->IO[g]
竞争池=做
设s=物种池
变量Int->[g]->IO[g]
演进0池=返回池
进化n池=do
pool'如果您对性能感兴趣，我会使用快速随机数生成器，例如：




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

import Control.DeepSeq
竞争：：（基因g，NFData g）=>[g]->IO[g]
竞争池=做
设s=物种池
变体而不是使用
（map head.map orderFitness）
其中
orderFitness
是
sortBy
您可以使用
maximumBy
和单个
map
。这不会节省太多（因为您将从一个O（n log n）转换为O（n），并且可能会从消除双映射中得到另一个因子2），但至少在某种程度上更简单、更高效。您还可以取消取消呼叫

我怀疑这在没有
deepseq
的情况下解决了问题，但它仍然应该是一种改进

编辑：如果标准库和GHC是完美的，那么
head。sortBy
将生成与
maximumBy
和
地图头相同的代码。map sortBy
将生成与map（head.sortBy）相同的代码
遗憾的是，这两种情况在实践中都不可能是真的
sortBy
将倾向于进行大量额外的内存分配，因为它是一种分而治之的算法。组合地图有时是一种优化，但不应该指望

更重要的是，使用
maximumBy
更具声明性。更容易看到代码的作用以及需要多长时间。在优化中也应该更容易利用它，因为我们知道目标是什么，而不仅仅是如何实现的
 多亏了唐的
deepseq
建议，我才能够将问题缩小到
mapmmutate
，这造成了太多的麻烦。新版本有
mutate'
，它使用
seq
来防止重击

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)

模块遗传学在哪里
导入数据列表（maximumBy）
导入随机（randomRIO）
g类基因在哪里
--从0.0到1.0的基因有多理想？
适合度：：g->Float
--基因是如何变异的？
变异：：g->IO g
--每轮将探索多少物种？
种类：：[g]->Int
最佳：：（基因g）=>[g]->g
最佳=最大值（\a b->比较（适应度a）（适应度b））
--防止堆栈溢出
突变“：：（基因g）=>g->IO g
突变基因=do
基因'[[g]]->IO[[g]]
漂移=mapM（mapM突变'）
竞争：：（基因g）=>[g]->IO[g]
竞争池=做
让岛屿=映射（复制（物种池））池
islands’假设您使用
ghc-O2
作为编译器，您的第一个版本在
evolve
函数中没有任何堆栈溢出。因为我们看不到
compete
的实现，所以只能这样说。上面提供的GitHub链接（）指定了
compete
以及一个确实使用
ghc-O2
的Makefile。我认为，
>>>=应该等于do符号，没有区别。正如dons所指出的，问题完全在于compete函数，它无疑是在构建一个包含大量thunk的数据结构的基础上多次运行的。我相信github链接有必要的数据，但是对于那些希望帮助您在这里发布一个完整的工作示例来演示您的问题的人来说，它会更有帮助，而且最好是尽可能减少。同时，quick+dirty解决方案是在每次递归调用时使用rnf或其他方式强制您的池。嗯，为什么他们首先在这里使用IO monad？看起来很难看也不地道。他们可能应该使用一个随机单元组，或者直接向变异函数提供随机数。@Don
deepseq
hammer解决了这个问题（upvote）。但这感觉像作弊。我想找出
compete
中堆栈溢出发生的位置。一个可能的候选方法是使用嵌套
mapM
。但是，可以肯定的是：配置文件。像这样：@mcandre您可能对@Don将
（mapM…
和
（map head…
）分为两个函数（
drift
和
competite
）并将
deepseq
移动到
drift
工作中感兴趣，因此问题出在
（mapM（mapM mutate）.map（replicate s））池
。我相信
（mapM（mapM…
创建堆栈溢出。@mcandre-检查haddocks，您可以使用
pureMT:：Word64->pureMT
以64位int初始化生成器，该int可能来自任何地方，或者如果您想从时钟开始播种，则使用
newPureMT
。谢谢！这并不能解决问题，但我会在解决方案中包含您的建议.
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)