IA de jeux, Implémenter une IA basique, en Haskell

Voir aussi : video youtube - video peertube - code source

Cet article, de la série “IA de jeux”, aborde la mise en place d’une intelligence artificielle, en Haskell : bots simples, comparaison, interface utilisateur. Pour cela, on réutilisera le jeu de Puissance 4 présenté dans l’article précédent. Une IA plus évoluée sera présentée dans le prochain article.

Articles de la séries IA de jeux :

Architecture de Bot

Rappel sur le module Game

Pour implémenter le jeu de Puissance 4, on avait écrit le type Game s et les fonctions de signatures suivantes.

-- Game.hs

data Game s = ...

mkGame :: Player -> ST s (Game s)
cloneGame :: Game s -> ST s (Game s)
nextGame :: Game s -> ST s (Game s)
isRunning :: Game s -> Bool
nMovesGame :: Game s -> Int
playK :: Int -> Game s -> ST s (Game s)

Pour rappel, la monade ST permet d’utiliser de la mémoire “en-place” (sans copie). Le paramètre de type s correspond au thread qui effectue le calcul.

Classe de types Bot

On veut pouvoir utiliser différents types de bots (aléatoire, Monte-Carlo, joueur humain, etc) mais de façon homogène. Pour cela, on définit une classe de types Bot, qui contient une fonction genmove permettant de choisir le coup à jouer pour un jeu donné.

-- Bot.hs

class Bot s b where
    genmove :: b -> Game s -> ST s Int

On notera qu’il s’agit d’une classe à deux paramètres. Le paramètre s permet d’accéder au jeu, avec la monade ST. Le paramètre b est le type qui va implémenter le bot proprement dit.

Bot de test

Écrivons un bot très simple, qui choisit toujours le premier coups possible. Pour cela, il suffit de définir un type BotZero qui instancie la classe de types Bot.

-- Bot.hs

data BotZero = BotZero

instance Bot s BotZero where
    genmove _bot _game = return 0

Pour dérouler une partie de jeu avec deux bots donnés, on écrit la fonction playoutBots suivante. Il s’agit simplement de demander au bot concerné de choisir un coup, de jouer ce coup et de recommencer jusqu’à ce que le jeu soit terminé.

-- Bot.hs

playoutBots :: (Bot s b1, Bot s b2) => b1 -> b2 -> Game s -> ST s Status
playoutBots botR botY g0 
    | isRunning g0 =
        let moveFunc = if _currentPlayer g0 == PlayerR then genmove botR
                                                       else genmove botY 
        in moveFunc g0 >>= (`playK` g0) >>= playoutBots botR botY 
    | otherwise = return (_status g0)

On peut alors faire jouer deux BotZero et vérifier les résultats dans des tests unitaires.

-- tests.hs

    describe "BotZero" $ do

        it "genmove 1" $ do
            (g, s) <- stToIO $ do
                        g0 <- mkGame PlayerR
                        s0 <- playoutBots BotZero BotZero g0
                        return (g0, s0)
            s `shouldBe` WinR
            b <- stToIO $ toLists2 <$> freezeS (_cells g)
            b `shouldBe` 
                    [[CellR, CellR, CellR, CellR, CellE, CellE, CellE]
                    ,[CellY, CellY, CellY, CellE, CellE, CellE, CellE]
                    ,[CellR, CellR, CellR, CellE, CellE, CellE, CellE]
                    ,[CellY, CellY, CellY, CellE, CellE, CellE, CellE]
                    ,[CellR, CellR, CellR, CellE, CellE, CellE, CellE]
                    ,[CellY, CellY, CellY, CellE, CellE, CellE, CellE]]

Pour rappel, on utilise la bibliothèque Massiv pour gérer le plateau de jeu. Ceci permet d’avoir des fonctionnalités intéressantes comme les tableaux 2D mutables et la fonction toLists2 pour les convertir en listes faciles à tester.

Interface utilisateur

Afficher et dérouler des jeux

On veut implémenter une interface texte permettant d’afficher le jeu et de faire jouer des IA et des humains. Pour afficher le jeu, on écrit les fonctions suivantes.

-- cli.hs

formatCell :: Cell -> String
formatCell CellE = "."
formatCell CellR = "R"
formatCell CellY = "Y"

showGame :: Game s -> ST s String
showGame g = do
    cs <- reverse . toLists2 <$> freezeS (_cells g)
    let bb = unlines $ map (concatMap formatCell) cs
    return $ "\n0123456\n" ++ bb 
        ++ "moves: " ++ unwords (map show $ U.toList $ _moves g)
        ++ "\nstatus: " ++ show (_status g) ++ "\n"

La fonction toLists2 permet d’afficher le plateau de jeu facilement (le reverse permet d’avoir les lignes de bas en haut). De même, les coups possibles sont dans un “unboxed vector”, qu’on peut formater facilement, avec U.toList, map et unwords.

Comme les joueurs humains vont saisir leur coup au clavier, la fonction pour choisir le coup à jouer doit permettre de faire des entrées-sorties (IO). On peut implémenter ça simplement en définissant une classe BotIO, similaire à la classe Bot mais fonctionnant dans la monade IO plutôt que ST s.

-- cli.hs

class BotIO b where
    genmoveIO :: b -> Game RealWorld -> IO Int

On peut voir BotIO comme un Bot restreint au contexte IO. Ainsi, comme le type BotZero instancie déjà la classe Bot, il peut également instancier la classe BotIO simplement.

-- cli.hs

instance BotIO BotZero where
    genmoveIO b g = stToIO (genmove b g)

On peut alors écrire une fonction run pour dérouler des parties successives entre deux bots, ainsi qu’un programme principal qui lance cette fonction sur des bots particuliers.

-- cli.hs

run :: (BotIO b1, BotIO b2) => b1 -> b2 -> Game RealWorld -> IO ()
run botR botY g0
    | isRunning g0 = do
        k <- if _currentPlayer g0 == PlayerR then genmoveIO botR g0
                                             else genmoveIO botY g0
        stToIO (playK k g0) >>= run botR botY 
    |otherwise = do
        stToIO (showGame g0) >>= putStrLn
        putStrLn "new game (y/n) ? ";
        r <- getLine
        when (r == "y") $ stToIO (nextGame g0) >>= run botR botY

main :: IO ()
main = do
    game <- stToIO (mkGame PlayerR) 
    let botR = BotZero
    let botY = BotZero
    run botR botY game

Exemple d’exécution :

$ runghc cli.hs 

0123456
YYY....
RRR....
YYY....
RRR....
YYY....
RRRR...
moves: 3 4 5 6
status: WinR

new game (y/n) ? 
y

0123456
RRR....
YYY....
RRR....
YYY....
RRR....
YYYY...
moves: 3 4 5 6
status: WinY

new game (y/n) ? 
n

Joueur humain

Pour implémenter un joueur humain utilisable avec l’interface utilisateur, il suffit de définir un type BotHuman et d’instancier la classe BotIO. Ici la fonction genmoveIO affiche le jeu, saisit au clavier la colonne à jouer et trouve son indice dans le tableau des coups possibles (ou recommence si la saisie n’est pas valide).

-- cli.hs

data BotHuman = BotHuman 

instance BotIO BotHuman where
    genmoveIO b g = do
        stToIO (showGame g) >>= putStrLn
        putStr "j ? "
        hFlush stdout
        line <- getLine
        let mK = do j <- readMaybe line
                    U.elemIndex j (_moves g)
        case mK of
            Just k -> return k
            Nothing -> genmoveIO b g

Exemple d’exécution (BotZero contre BotHuman) :

$ runghc cli.hs 

0123456
.......
.......
.......
.......
.......
R......
moves: 0 1 2 3 4 5 6
status: PlayY

j ? 2

0123456
.......
.......
.......
.......
R......
R.Y....
moves: 0 1 2 3 4 5 6
status: PlayY

j ?

Bot aléatoire

Gestion de l’aléatoire

Comme expliqué dans l’article précédent, la monade ST permet de manipuler facilement des générateurs de nombres aléatoires, par exemple grâce au type GenST et à la fonction uniformR. Ainsi, on peut écrire une fonction randomMove qui choisit aléatoirement un coup possible pour un jeu donné.

-- Bot.hs

randomMove :: GenST s -> Game s -> ST s Int
randomMove gen game = uniformR (0, nMovesGame game - 1) gen

Éventuellement, on peut écrire des tests unitaires pour vérifier la validité, l’espérance et la distribution d’une variable aléatoire.

-- tests.hs

    describe "BotRandom" $ do

        it "random 1" $ do
            gen <- createSystemRandom 
            let n = 100
            xs <- stToIO $ replicateM n $ uniformR (0, 10::Int) gen
            xs  `shouldSatisfy` all (\x -> x>=0 && x<=10)

        it "random 2" $ do
            gen <- createSystemRandom 
            let n = 10000
            xs <- stToIO $ replicateM n $ uniformR (0, 10::Int) gen
            let m = fromIntegral (sum xs) / fromIntegral n
            abs (m - 5.0) `shouldSatisfy` (<0.1)

        it "random 3" $ do
            gen <- createSystemRandom 
            let n = 10000
            xs <- stToIO $ replicateM n $ uniformR (0, 10::Int) gen
            let nD = fromIntegral n
                h = [ fromIntegral (length (filter (==i) xs)) / nD | i <- [0 .. 10] ]
            h `shouldSatisfy` 
                all (\hi -> abs (hi - 0.1) < 0.05)

Bot random

Pour implémenter un bot aléatoire, on écrit un type BotRandom contenant un générateur pseudo-aléatoire et on instancie la classe Bot grâce à la fonction randomMove précédente.

-- Bot.hs

newtype BotRandom s = BotRandom { randomGen :: GenST s }

instance Bot s (BotRandom s) where
    genmove (BotRandom gen) = randomMove gen

Pour tester notre bot aléatoire, on peut faire jouer deux BotRandom et vérifier que chacun gagne à peu près la moitié des parties.

-- tests.hs

        it "genmove 1" $ do
            br <- BotRandom <$> createSystemRandom
            by <- BotRandom <$> createSystemRandom
            let n = 1000
            let go :: Int -> Game RealWorld -> ST RealWorld [Status]
                go 0 _ = return []
                go i g = do
                    gi <- nextGame g 
                    si <- playoutBots br by gi
                    ss <- go (i-1) gi
                    return (si : ss)
            xs <- stToIO (mkGame PlayerY >>= go n)
            let ratio status = fromIntegral (length $ filter (==status) xs) / fromIntegral n
            abs (ratio WinR - 0.5) `shouldSatisfy` (<0.05)
            abs (ratio WinY - 0.5) `shouldSatisfy` (<0.05)
            abs (ratio Tie - 0.0) `shouldSatisfy` (<0.05)

Et comme pour BotZero, on peut utiliser BotRandom dans l’interface utilisateur en instanciant BotIO et en appelant la fonction genmove.

Bot Monte-Carlo

Pour rappel, la méthode de Monte-Carlo consiste à évaluer chaque coup possible en jouant de nombreuses parties aléatoires. On écrit donc une fonction qui joue aléatoirement un jeu jusqu’à la fin.

-- Bot.hs

playoutRandom :: GenST s -> Game s -> ST s Status
playoutRandom gen g0 
    | isRunning g0 = randomMove gen g0 >>= (`playK` g0) >>= playoutRandom gen
    | otherwise = return (_status g0)

On a également besoin d’une fonction qui associe un score au résultat d’une partie (et en fonction du joueur considéré).

-- Bot.hs

computeScore :: Player -> Status -> Double
computeScore PlayerR WinR = 1.0
computeScore PlayerY WinY = 1.0
computeScore _ Tie = 0.5
computeScore _ _ = 0.0

On peut alors écrire une fonction qui évalue un coup donné, selon la méthode de Monte-Carlo. Pour cela, on joue le coup à évaluer puis on effectue des simulations (parties aléatoires) à partir de ce jeu, en accumulant les scores obtenus. On notera qu’on doit cloner manuellement les jeux avant les simulations car notre implémentation utilise un tableau mutable, qui serait donc partagé par toutes les simulations si on ne clonait pas.

-- Bot.hs

evalMove :: Game s -> GenST s -> Int -> Int -> ST s Double
evalMove game0 gen nsims k = do
    let player0 = _currentPlayer game0
    game1 <- cloneGame game0 >>= playK k
    let aux 0 s = return s
        aux i s = do status2 <- cloneGame game1 >>= playoutRandom gen 
                     aux (i - 1) (s + computeScore player0 status2)
    aux nsims 0

On a désormais tout ce qu’il faut pour écrire notre bot. On écrit donc un type BotMc contenant le nombre de simulations Monte-Carlo à effectuer pour évaluer un coup possible et le générateur pseudo-aléatoire à utiliser. Enfin, on instancie la classe Bot où la fonction pour choisir un coup se résume à évaluer tous les coups possibles et à choisir celui qui a le meilleur score.

-- Bot.hs

data BotMc s = BotMc
    { mcNsims :: Int
    , mcGen :: GenST s
    }

instance Bot s (BotMc s) where
    genmove (BotMc nsims gen) game =
        let aux ki k s = if ki == nMovesGame game then return k else do
                            si <- evalMove game gen nsims ki
                            if si>s then aux (ki+1) ki si else aux (ki+1) k s
        in aux 0 0 (-1)

Comparer des bots

Pour comparer des bots, on écrit une fonction qui fait jouer deux bots donnés sur un nombre de parties donné. Pour cela, on utilise la fonction playoutBots et on calcule la part de victoires pour chacun des bots et la part d’égalités.

-- Cmp.hs

run :: (Bot s b1, Bot s b2)
    => b1 -> b2 -> Int -> ST s (Double, Double, Double)
run botR botY nGames = 
    let aux 0 r y t _g0 = 
            let nGamesD = fromIntegral nGames
                rD = fromIntegral r
                yD = fromIntegral y
                tD = fromIntegral t
            in return (rD/nGamesD, yD/nGamesD, tD/nGamesD)
        aux n r y t g0 = do
            g1 <- nextGame g0
            s1 <- playoutBots botR botY g1
            case s1 of
                WinR -> aux (n-1) (r+1) y t g1
                WinY -> aux (n-1) r (y+1) t g1
                Tie  -> aux (n-1) r y (t+1) g1
                _ -> error "game not terminated"
    in mkGame PlayerR >>= aux nGames (0::Int) (0::Int) (0::Int)

On écrit également une fonction qui permet de tester l’influence d’un réglage d’un bot (par exemple le nombre de simulations pour BotMc). Pour cela, on prend en paramètre le bot de comparaison, un constructeur de bot et une liste de valeurs permettant de construire les bots à tester. On notera qu’on utilise la fonction timeIt pour mesurer le temps d’exécution d’un test, et qu’on écrit les résultats, par ligne, dans un fichier de type CSV.

-- cmp2.hs

test1 :: (Bot RealWorld b1, Bot RealWorld b2) 
    => String -> Int -> (Int -> Gen RealWorld -> b1) -> b2 -> [Int] -> IO ()
test1 name nGames mkBotR botY values = 
    let filename = "out-test1-" ++ name ++ ".csv"
    in withFile filename WriteMode $ \h -> do
        putStrLn filename
        hPutStrLn h "winR WinY tie ry ryt dt nGames value"
        forM_ values $ \v -> do
            botR <- mkBotR v <$> createSystemRandom
            (dt, (r, y, t)) <- timeItT $ stToIO (run botR botY nGames)
            hPutStrLn h $ unwords (map show [r, y, t, r+y, r+y+t, dt] 
                ++ [show nGames, show v])

Exemple de programme principal comparant différents réglages de BotMc avec BotRandom et avec BotMc à 32 simulations par coup possible :

-- cmp2.hs

main :: IO ()
main = do
    botRandom <- BotRandom <$> createSystemRandom
    botMc32 <- BotMc 32 <$> createSystemRandom
    let nGames = 300
    test1 "McX-Random" nGames BotMc botRandom [1, 2, 4, 8, 16, 32, 64]
    test1 "McX-Mc32" nGames BotMc botMc32 [4, 8, 16, 32, 64]

Si on génère les graphiques correspondant aux fichiers résultats, on vérifie que BotMc est beaucoup plus performant que BotRandom.

Rouge : McX gagne. Jaune : Random gagne. Bleu : égalité.

Et on vérifie également l’évolution caractéristique des performances de Monte-Carlo lorsqu’on augmente le nombre de simulations.

Rouge : McX gagne. Jaune : Mc32 gagne. Bleu : égalité.

Conclusion

Dans cet article, on a vu comment implémenter des bots avec des types algébriques et comment définir des classes de types permettant d’utiliser différents bots de façon homogène, par exemple pour les comparer ou dans une interface utilisateur.

On remarquera qu’on a écrit ici beaucoup de fonctions récursives, alors qu’on aurait parfois pu utiliser des fonctions Haskell de plus haut-niveau. On aurait alors gagner un peu en concision mais au détriment d’un peu de performances. Ceci sera détaillé dans un prochain article, après l’article sur l’IA arborescente.