Оптимизация функции 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 - список хромосом. Переполнение не происходит только с одним игроком, но с двумя это происходит.

РЕДАКТИРОВАТЬ: если функция вызывается следующим образом, она не переполняет стек.

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' является хвост-рекурсивной, проблема в том, что она недостаточно строгая. Эту проблему упоминает Дон Стюарт в своем комментарии.

Думайте о структурах данных 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