在 Haskell 中学习递归方案 by TicTacToe
Learning recursion schemes in Haskell by TicTacToe
环顾四周,我注意到递归方案是一个非常笼统的概念,我想通过亲身体验来学习。所以我开始为 TicTacToe 实现极小极大算法。这是一个设置舞台的小片段。随意跳过它,因为它只是完整性的基本实现或阅读 online 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)
并且 minimax 算法表示为我们可以这样写的变形
-- 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
我只是不知道如何用递归方案编写这个函数。有人可以帮我吗?
在 minimax
你有极小极大代数 phi :: GameTreeF Board (MinimaxRating, [Move]) -> (MinimaxRating, [Move])
。
在 computeKITree
中,这将是 cata
,您需要 psi :: GameTreeF Board (GameTree (Board, ..., ...) Move) -> GameTree (Board, ..., ...) Move
。
psi
可以使用 phi
计算 minimax,然后将所有内容包装在 GameTreeF
.
中
我们必须将 psi
的参数转换为 phi
的参数:
adaptPhi :: GameTreeF Board (GameTree (Board, ..., ...) Move) -> GameTreeF Board (..., ...)
看起来不错fmap
! (练习 reader。)
一旦你有了那个...
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)
环顾四周,我注意到递归方案是一个非常笼统的概念,我想通过亲身体验来学习。所以我开始为 TicTacToe 实现极小极大算法。这是一个设置舞台的小片段。随意跳过它,因为它只是完整性的基本实现或阅读 online 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)
并且 minimax 算法表示为我们可以这样写的变形
-- 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
我只是不知道如何用递归方案编写这个函数。有人可以帮我吗?
在 minimax
你有极小极大代数 phi :: GameTreeF Board (MinimaxRating, [Move]) -> (MinimaxRating, [Move])
。
在 computeKITree
中,这将是 cata
,您需要 psi :: GameTreeF Board (GameTree (Board, ..., ...) Move) -> GameTree (Board, ..., ...) Move
。
psi
可以使用 phi
计算 minimax,然后将所有内容包装在 GameTreeF
.
我们必须将 psi
的参数转换为 phi
的参数:
adaptPhi :: GameTreeF Board (GameTree (Board, ..., ...) Move) -> GameTreeF Board (..., ...)
看起来不错fmap
! (练习 reader。)
一旦你有了那个...
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)