哈斯克尔堆栈溢出

Question

我正在写一个遗传算法来生成字符串“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

Answer 1

感谢唐的deepseq的建议，我能够将问题缩小到mapM mutate这使得太多thunk。新版本有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

Answer 2

如果你有兴趣的表现，我会使用一个快速随机数发生器，如：

• 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单子可能是more appropriate。

Answer 3

而不是使用(map head . map orderFitness)其中orderFitness是sortBy你可以使用maximumBy和单一map的。这并不会节省太多（因为你从O（n log n）到O（n），并且可能从消除双映射中获得另一个因子2），但是至少可以更简单和更高效。你也可以摆脱呼叫来撤消。

我怀疑这可以修复这个问题，而不是deepseq，但它应该是一个改进。

编辑：如果标准库和GHC是完美的，那么head . sortBy会产生相同的代码maximumBy和map head . map sortBy会产生对map (head . sortBy)相同的代码黯然没有这些东西很可能在实践中是真实的。 sortBy将倾向于做一堆额外的内存分配，因为它是一个分而治之的算法。结合地图是你有时得到的一种优化，但不应该依靠。

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