Изучение схем рекурсии в Haskell от TicTacToe - PullRequest
Новая
       56

Изучение схем рекурсии в Haskell от TicTacToe

0 голосов
/ 20 декабря 2018

Оглядываясь вокруг, я заметил, что схемы рекурсии являются довольно общей концепцией, и я хотел узнать, испытав ее на собственном опыте.Поэтому я начал реализовывать минимаксный алгоритм для TicTacToe.Вот небольшой фрагмент, который устанавливает сцену.Не стесняйтесь пропустить это, так как это просто базовая реализация для полноты или чтения в онлайн IDE 

{-# LANGUAGE DeriveFunctor #-}
import Data.Maybe
import Data.Sequence hiding (zip, filter, length)
import Data.Foldable
import Data.Monoid
import Control.Arrow

data Player = Cross | Nought deriving (Eq, Show)
type Cell = Maybe Player
data Board = Board { getPlayer :: Player, getCells :: Seq Cell }
type Move = Int

(!?) :: Seq a -> Move -> a
s !? m = index s m
showCell :: Cell -> String
showCell Nothing = " "
showCell (Just Cross) = "x"
showCell (Just Nought) = "o"
instance Show Board where
    show (Board p cells) = "+---+---+---+\n"
                        ++ "| " ++ showCell (cells !? 0)
                           ++ " | " ++ showCell (cells !? 1)
                               ++ " | " ++ showCell (cells !? 2) ++ " |\n"
                        ++ "+---+---+---+\n"
                        ++ "| " ++ showCell (cells !? 3)
                           ++ " | " ++ showCell (cells !? 4)
                               ++ " | " ++ showCell (cells !? 5) ++ " |\n"
                        ++ "+---+---+---+\n"
                        ++ "| " ++ showCell (cells !? 6)
                           ++ " | " ++ showCell (cells !? 7)
                               ++ " | " ++ showCell (cells !? 8) ++ " |\n"
                        ++ "+---+---+---+\n"
                        ++ "It's " ++ show p ++ "'s turn\n"

other :: Player -> Player
other Cross = Nought
other Nought = Cross

-- decide on a winner. The first found winner is taken, no matter if more exist
decide :: Board -> Maybe Player
decide (Board p cells) = getAlt $
                         isWinner 0 1 2 <> isWinner 3 4 5 <> isWinner 6 7 8 <>
                         isWinner 0 3 6 <> isWinner 1 4 7 <> isWinner 2 5 8 <>
                         isWinner 0 4 8 <> isWinner 2 4 6 where
    sameAs :: Cell -> Cell -> Cell
    sameAs (Just Cross) (Just Cross) = Just Cross
    sameAs (Just Nought) (Just Nought) = Just Nought
    sameAs _ _ = Nothing
    isWinner a b c = Alt $ (cells !? a) `sameAs` (cells !? b) `sameAs` (cells !? c)

initialState :: Board
initialState = (Board Cross (fromList $ map (const Nothing) [0..8]))

findMoves :: Board -> [Move]
findMoves (Board p cells) = map fst $ filter (isNothing . snd) $ zip [0..] $ toList cells

applyMove :: Board -> Move -> Board
applyMove (Board player cells) move = Board (other player) (update move (Just player) cells)

data MinimaxRating = Loss | Draw | Win deriving (Eq, Ord, Show)
invertRating Win = Loss
invertRating Draw = Draw
invertRating Loss = Win

Теперь, для забавных частей.Я придумал следующий тип для определения моего игрового дерева: 

-- a game tree is a tree with a current board
-- and a list of next boards tagged with moves
data GameTreeF b m f = Tree b [(m, f)]
    deriving (Functor)
type GameTree b m = Fix (GameTreeF b m)

и, довольно легко, мы можем использовать анаморфизм для представления расширения игры всеми законными ходами 

fullGameTree :: Board -> GameTree Board Move
fullGameTree = ana phi where
    phi board = Tree board $ map (id &&& applyMove board) (findMoves board)

и алгоритм минимакса представлен в виде катаморфизма, который мы можем записать так: 

-- given a game tree to explore, finds the best rating and a
-- move sequence that results in it
minimax :: GameTree Board Move -> (MinimaxRating, [Move])
minimax = cata phi where
    mergeInMove (m, (r, ms)) = (invertRating r, m:ms)
    compareMoves (m, ms) (n, ns) = compare m n <> compare (length ns) (length ms)
    phi (Tree board []) = (Draw, []) -- no legal moves is a draw
    phi (Tree board moves) = case decide board of
        Just winner | winner == getPlayer board -> (Win, []) -- we win
        Just winner                             -> (Loss, []) -- they win
        Nothing -> maximumBy compareMoves $ map mergeInMove moves

На мой вопрос: теперь я хочу построить GameTree, который пометил бы в каждом узле минимаксный результат.Итак, что я ищу, я считаю, что это функция: 

-- tag each node with the result of minimax for its subtree
computeKITree :: GameTree Board Move -> GameTree (Board, MinimaxRating, [Move]) Move

Я просто не могу понять, как написать эту функцию с рекурсивными схемами.Может ли кто-нибудь помочь мне здесь?

1 Ответ

0 голосов
/ 20 декабря 2018

В minimax у вас есть минимаксная алгебра phi :: GameTreeF Board (MinimaxRating, [Move]) -> (MinimaxRating, [Move]).

В computeKITree, которая будет cata, вам нужно psi :: GameTreeF Board (GameTree (Board, ..., ...) Move) -> GameTree (Board, ..., ...) Move.

psi может использовать phi для вычисления минимакса, а затем обернуть все в GameTreeF.

Мы должны преобразовать аргумент psi в аргумент phi: 

adaptPhi :: GameTreeF Board (GameTree (Board, ..., ...) Move) -> GameTreeF Board (..., ...)

Это выглядит как хороший fmap!(Упражнение для читателя.)

Как только у вас будет это ... 

computeKITree :: GameTree Board Move -> GameTree (Board, MinimaxRating, [Move]) Move
computeKITree = cata psi where
  psi t@(GameTree b ts) =
    let (rating, ms) = phi (adaptPhi t) in
    Fix (GameTree (b, rating, ms) ts)
...