优化Haskell函数以防止堆栈溢出

Question

我正在尝试创建一个函数,使用遗传算法递归地播放所有可能的井字游戏,然后返回(胜利,损失,关系)元组.但是,当调用时,下面的函数总是溢出堆栈:

scoreOne :: UnscoredPlayer -> [String] -> ScoredPlayer
scoreOne player boards = ScoredPlayer (token player) (chromosome player) (evaluateG $!             testPlayer player boards)
...
let results = map (\x->scoreOne x boards) players
print (maximum results)

哪里players是染色体列表.只有1名玩家​​不会发生溢出,但有两次发生.

编辑:如果以下列方式调用该函数,它不会溢出堆栈.

let results = map (\player -> evaluateG (testPlayer player boards)) players
print (maximum results)

但是,以下方式会溢出堆栈.

let results = map (\player -> ScoredPlayer (token player) (chromosome player) (evaluateG $! testPlayer player boards)) players

作为参考,ScoredPlayer定义为(字符串是玩家令牌,[Int]是染色体,Float是得分):

data ScoredPlayer = ScoredPlayer String ![Int] !Float deriving (Eq)

根据我所知的Haskell,该playAll'函数不是尾递归的,因为foldl'我正在使用的调用是对函数结果进行进一步处理.但是,我不知道如何消除foldl'呼叫,因为需要确保播放所有可能的游戏.有没有办法重构函数,以便它是尾递归(或至少不溢出堆栈)？

在此先感谢,并为大量代码列表感到抱歉.

playAll' :: (Num a) => UnscoredPlayer -> Bool -> String -> [String] -> (a,a,a) ->    (a,a,a)
playAll' player playerTurn board boards (w,ls,t)= 
    if won == self then (w+1,ls,t) -- I won this game
    else
        if won == enemy then (w,ls+1,t) -- My enemy won this game
        else
            if '_' `notElem` board then (w,ls,t+1) -- It's a tie
            else
                if playerTurn then --My turn; make a move and try all possible combinations for the enemy
                    playAll' player False (makeMove ...) boards (w,ls,t)
                else --Try each possible move against myself
                    (foldl' (\(x,y,z) (s1,s2,s3) -> (x+s1,y+s2,z+s3)) (w,ls,t)
                        [playAll' player True newBoard boards (w,ls,t)| newBoard <- (permute enemy board)])
    where
        won = winning board --if someone has one, who is it?
        enemy = (opposite.token) player --what player is my enemy?
        self = token player --what player am I?

Answer 1

该foldl'函数是尾递归的,问题是它不够严格.这是Don Stewart在评论中提到的问题.

将Haskell数据结构视为惰性框,其中每个新构造函数都创建一个新框.当你有像折叠

foldl' (\(x,y,z) (s1,s2,s3) -> (x+s1,y+s2,z+s3))

元组是一个盒子,其中的每个元素都是另一个盒子.严格性foldl'只能删除最外层的盒子.元组中的每个元素仍然处于惰性框中.

要解决这个问题,您需要更严格地应用以删除额外的框.唐的建议是做

data R = R !Int !Int !Int

foldl' (\(R x y z) (s1,s2,s3) -> R (x+s1) (y+s2) (z+s3))

现在严格性foldl'就足够了.R的各个元素是严格的,因此当移除最外面的框(R构造函数)时,也会评估内部的三个值.

没有看到更多我能提供的代码.我无法运行此列表,所以我不知道这是否解决了问题,或者整个程序中是否还有其他问题.

作为一种风格,if你可能更喜欢以下内容而不是嵌套的:

playAll' player playerTurn board boards (w,ls,t)=
  case () of
    _ | won == self -> (w+1,ls,t) -- I won this game
    _ | won == enemy -> (w,ls+1,t) -- My enemy won this game
    _ | '_' `notElem` board -> (w,ls,t+1) -- It's a tie 
    _ -> ... --code omitted