Optimisation d'une fonction Haskell pour éviter les débordements de pile

Question

J'essaye de créer une fonction qui joue récursivement tous les jeux possibles de tic-tac-toe en utilisant un algorithme génétique, puis retourne un tuple de (victoires, pertes, liens). Cependant, la fonction ci-dessous la pile toujours déborde lorsqu'il est appelé comme ceci:

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) 

où players une liste des chromosomes. Le débordement ne se produit pas avec seulement 1 joueur, mais avec deux cela arrive.

EDIT: Si la fonction est appelée de la manière suivante, elle ne déborde pas de la pile.

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

Cependant, la façon suivante fait débordement de la pile.

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

Pour référence, ScoredPlayer est défini comme (la chaîne est le jeton de joueur, [Int] est le chromosome, et le flotteur est le score):

D'après ce que je sais de Haskell, la fonction playAll' n'est pas récursive en arrière car l'appel foldl' que j'utilise effectue un traitement supplémentaire sur les résultats de la fonction. Cependant, je n'ai aucune idée de comment éliminer l'appel foldl', car il est nécessaire de s'assurer que tous les jeux possibles sont joués. Est-il possible de restructurer la fonction pour qu'elle soit récursive à la queue (ou au moins ne déborde pas la pile)?

Merci d'avance, et désolé pour la liste de code massive.

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

La fonction foldl' est récursive, le problème est que ce n'est pas assez stricte. C'est le problème que mentionne Don Stewart dans son commentaire. Pensez aux structures de données Haskell comme des boîtes paresseuses, où chaque nouveau constructeur crée une nouvelle boîte. Lorsque vous avez un pli comme

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

les tuples sont une boîte, et chaque élément à l'intérieur est une autre boîte. La rigueur de foldl' supprime uniquement la boîte la plus externe. Chaque élément dans le tuple est toujours dans une boîte paresseuse.

Pour contourner cela, vous devez appliquer une rigueur plus stricte pour enlever les boîtes supplémentaires. La suggestion de Don est de faire maintenant la rigueur de foldl' est suffisante

data R = R !Int !Int !Int 

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

. Les éléments individuels de R sont stricts, donc lorsque la case la plus externe (le constructeur R) est supprimée, les trois valeurs à l'intérieur sont également évaluées.

Sans voir plus de code c'est à peu près tout ce que je peux fournir. Je n'ai pas été en mesure d'exécuter cette liste, donc je ne sais pas si cela résout le problème ou s'il y a d'autres problèmes dans le programme complet.

Comme point de style, au lieu de s if imbriquées de » vous pouvez préférer les éléments suivants:

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