IA de jeux, Implémenter un Puissance 4, en Haskell

Voir aussi : video youtube - video peertube - code source

Cet article, de la série “IA de jeux”, aborde l’implémentation d’un Puissance 4, en Haskell. Afin de pouvoir comparer avec l’implémentation C++ des articles précédents, il présente également quelques concepts et structures de données efficaces ainsi que les tests unitaires.

Articles de la séries IA de jeux :

• Introduction
• Implémenter un Puissance 4, en C++
• Implémenter une IA basique, en C++
• Implémenter une IA arborescente, en C++
• Performances de code, en C++
• Implémenter un Puissance 4, en Haskell
• Implémenter une IA basique, en Haskell
• Implémenter une IA arborescente, en Haskell
• Performances de code, en Haskell
• Conclusion

Monade ST

La monade ST (pour State Thread) permet de manipuler des données modifiables en-place, afin d’éviter les copies mémoires, mais sans introduire de problèmes d’accès concurrent (voir la doc du wiki et de hackage).

Fonction pure

En Haskell, on écrit généralement du code pur, c’est-à-dire des expressions sans effet de bord.

-- demo-st.hs

add1 :: Int -> Int
add1 x = x+1

Ce code est ensuite exécuté par le runtime, selon son fonctionnement interne : ordre d’exécution, parallélisme, gestion mémoire…

$ ghci demo-st.hs

*Main> add1 2
3

Principe de la monade ST

Concrètement, il s’agit d’un type paramétrique :

newtype ST s a = ...

où a est le type de la valeur résultat et s correspond au thread. Le type ST s est une monade, ce qui permet de définir des fonctions s’exécutant “dans un contexte ST”.

-- demo-st.hs

mul2 :: Int -> ST s Int
mul2 x = return (x*2)

Pour la fonction mul2 précédente, l’utilisation de ST n’a pas beaucoup d’intérêt mais dans du code plus réaliste, ceci permet de manipuler des données modifiables (références, tableaux…).

Une fonction définie dans ST a également l’intérêt de pouvoir être exécutée dans un contexte pur (avec runST) ou dans le contexte IO (via stToIO).

$ ghci demo-st.hs

*Main> runST (mul2 3)
6

*Main> stToIO (mul2 4)
8

Exemple avec des générateurs de nombres aléatoires

On peut manipuler efficacement des générateurs de nombres aléatoires avec la monade ST. Par exemple, la fonction suivante génère un nombre puis multiplie par 2 et ajoute 1, en utilisant les fonctions précédentes.

-- demo-st.hs

import Control.Monad.ST
import System.Random.MWC

...

randMul2Add1 :: GenST s -> ST s Int
randMul2Add1 gen = do
    x <- uniformR (1, 100) gen
    y <- mul2 x
    let z = add1 y
    return z

-- autre implémentation possible:
-- randMul2Add1 gen = add1 <$> (uniformR (1, 100) gen >>= mul2)

Le type GenST est une référence, dans la monade ST, vers un générateur. Ainsi, le générateur est modifié directement et on n’a pas besoin de retourner le générateur modifié ou de le gérer explicitement via une monade State.

Si on appelle randMul2Add1 plusieurs fois de suite, on vérifie bien que les résultats peuvent varier, et donc que le générateur est bien modifié.

$ ghci demo-st.hs

*Main> gen <- createSystemRandom

*Main> stToIO (randMul2Add1 gen)
169

*Main> stToIO (randMul2Add1 gen)
87

Tableaux

Les tableaux sont une structure de données classiques et particulièrement intéressante pour certains types d’applications (par exemple, les jeux de plateau).

Haskell propose plusieurs bibliothèques de tableaux (Array, Vector, Massiv, etc), qui proposent elles-mêmes plusieurs types d’implémentation (mutable/immutable, boxed/unboxed).

Immutable vector of boxed values

L’implémentation de tableau la plus directe, dans un langage fonctionnel pur comme Haskell, est le tableau non-modifiable de références (non-modifiables également).

L’exemple suivant (avec Vector) construit un tableau à partir d’une liste puis applique une fonction à tous les éléments.

Prelude> import Data.Vector as V

Prelude V> V.map (*2) (V.fromList [2, 3] :: V.Vector Int)
[4,6]

Si on regarde la gestion mémoire de cette expression, la fonction fromList crée d’abord un tableau de références vers les éléments “réels” du tableau (boxed value). La fonction map fait ensuite une copie complète du tableau, avec les valeurs modifiées. Enfin, le Garbage Collector libère la mémoire de l’ancien tableau, s’il n’est plus utilisé.

A noter que cette description ne correspond pas tout à fait au fonctionnement réel, de part l’évaluation paresseuse et les optimisations du compilateur.

Immutable vector of unboxed values

Certains types de données, par exemple Int, peuvent être stockés directement dans un tableau. Avec la bibliothèque Vector, il suffit d’utiliser l’implémentation du module Unboxed.

Prelude> import Data.Vector.Unboxed as U

Prelude U> U.map (*2) (U.fromList [2, 3] :: U.Vector Int)
[4,6]

Au niveau de la mémoire, on n’a donc plus les références, ce qui économise la mémoire et les déréférencements. Cependant, le tableau est toujours non-modifiable, donc on a toujours une copie mémoire lors du map.

Vector mutable

Pour éviter les copies mémoires, la bibliothèque Vector propose également des implémentations de tableaux modifiables (boxed et unboxed). Par exemple, le code suivant crée et initialise un tableau de deux entiers et mappe une fonction sur ce tableau (cf les exemples précédents).

Prelude> import Data.Vector.Mutable as M

Prelude M> m1 <- M.new 2 :: IO (M.IOVector Int)

Prelude M> M.write m1 0 2

Prelude M> M.write m1 1 3

Prelude M> M.modify m1 (*2) 0

Prelude M> M.mapM_ print m1
4
3

Au niveau gestion mémoire, la fonction new crée un tableau non-initialisé, puis les appels à write construisent les valeurs “réelles” du tableau. Enfin, map modifie les éléments sans copie mémoire du tableau.

A noter que c’est le tableau qui est modifiable. Selon les implémentations, les zones mémoires référencées peuvent être copiées ou partagées.

Vector mutable dans une monade ST

Un tableau modifiable nécessite un “contexte” particulier, pour pouvoir faire ses modifications. L’exemple précédent utilisait le contexte IO mais généralement il vaut mieux utiliser le contexte ST. En effet, ST peut être être utilisé dans IO, via stToIO, mais également dans un contexte pur, via runST.

-- demo-vector.hs

import Control.Monad.ST
import Data.Vector.Mutable as M

createSTVector :: ST s (M.STVector s Int)
createSTVector = do
    m <- M.new 2
    M.write m 0 2
    M.write m 1 3
    return m

mul2head :: M.STVector s Int -> ST s ()
mul2head m = M.modify m (*2) 0

mySTFunc :: Int -> ST s Int
mySTFunc x = do
    m <- createSTVector
    M.write m 0 x
    mul2head m
    M.read m 0

main :: IO ()
main = do

    m2 <- stToIO createSTVector
    stToIO (mul2head m2)
    M.mapM_ print m2

    let y = runST $ mySTFunc 2
    print y

Dans cet exemple, la fonction createSTVector retourne un tableau modifiable d’entiers (STVector s Int), dans un contexte ST. La fonction mul2head prend un tableau modifiable d’entiers et multiplie par 2 son premier élément, d’indice 0 (attention, rien ne garantit que cet élément existe bien). Ainsi, ces deux fonctions sont définies dans le contexte ST mais sont appelables dans la fonction main, donc un contexte IO, via stToIO.

Cependant, on n’a pas forcément besoin de toutes les fonctionnalités de IO. Par exemple, la fonction mySTFunc prend un entier et retourne un entier. Comme elle utilise un tableau modifiable, elle doit être appelée dans un contexte ST mais pas forcément IO. Ainsi, on peut l’appeler avec runST et juste récupérer le résultat. On peut voir ça comme du code pur ou l’effet de bord “ST” est encapsulé dans l’expression du runST.

Implémentation d’un Puissance 4

On a maintenant toutes les fonctionnalités nécessaires pour implémenter un jeu de Puissance 4. Ici l’architecture de code est simple et on peut s’inspirer de la version C++ présentée dans un précédent article.

Constantes et types de base

Comme pour l’implémentation C++, on définit deux constantes pour la taille de plateau de jeu et quelques types pour représenter différents aspects du jeu.

-- Game.hs

nI, nJ :: Int
(nI, nJ) = (6, 7)

type Board s = MArray s B Ix2 Cell

data Cell = CellE | CellR | CellY deriving (Eq)

data Status = PlayR | PlayY | Tie | WinR | WinY deriving (Eq, Show)

data Player = PlayerR | PlayerY deriving (Eq, Show)

Ici, on utilise MArray de la bibliothèque Massiv. Il s’agit d’un tableau modifiable utilisable dans ST (comme STVector) mais à deux dimensions. Ainsi le type MArray s B Ix2 Cell signifie : tableau modifiable, dans un thread s, à valeurs “boxed” de type Cell et indexées par le type Ix2. Le type Cell définit le contenu des cases du plateau, Status définit l’état du jeu et Player le joueur.

On définit également deux fonctions, pour trouver la case correspondant à un joueur et pour passer au joueur suivant.

player2Cell :: Player -> Cell
player2Cell PlayerR = CellR
player2Cell PlayerY = CellY

nextPlayer :: Player -> Player
nextPlayer PlayerR = PlayerY
nextPlayer PlayerY = PlayerR

Type Game

L’implémentation du jeu proprement dit est similiaire à la version C++ mais on utilise simplement un type enregistrement plutôt qu’une classe.

data Game s = Game
    { _status :: Status
    , _currentPlayer :: Player
    , _firstPlayer :: Player
    , _moves :: U.Vector Int
    , _cells :: Board s
    }

On notera qu’on utilise bien le type Board précédent pour le plateau mais qu’on utilise un tableau non-modifiable à valeur “unboxed” (de la bibliothèque Vector) pour les coups possibles. On notera également que les types Board et Game sont en fait paramétrés (par le thread s) pour pouvoir être utilisés dans un contexte ST.

Pour construire un jeu, on définit la fonction mkGame. Les coups possibles sont initialisés à partir d’une liste et le plateau avec la valeur d’initialisation CellE.

mkGame :: Player -> ST s (Game s)
mkGame p = 
    let status = if p == PlayerR then PlayR else PlayY
    in Game status p p (U.fromList [0 .. nJ-1]) <$> newMArray (Sz2 nI nJ) CellE

On notera que newArray est une action du contexte ST, sur laquelle on “fmappe” le reste de la construction du Game. On aurait pu également implémenter notre fonction avec le code suivant.

mkGame :: Player -> ST s (Game s)
mkGame p = do
    let status = if p == PlayerR then PlayR else PlayY
    b <- newMArray (Sz2 nI nJ) CellE
    return (Game status p p (U.fromList [0 .. nJ-1]) b)

Pour copier un Game, on a besoin de copier explicitement les données mutables (ici le plateau de jeu), sinon la copie partagera ces données avec le Game source. Pour copier le plateau de jeu, on peut créer une copie non-modifiable (freezeS) qu’on convertit ensuite en version modifiable (unsafeThaw).

cloneGame :: Game s -> ST s (Game s)
cloneGame game0 = do
    b1 <- freezeS (_cells game0) >>= unsafeThaw
    return game0 { _cells = b1 }

Enfin, on définit des fonctions pour passer au jeu suivant, tester si le jeu est en cours et connaitre le nombre de coups possibles.

nextGame :: Game s -> ST s (Game s)
nextGame g0 = mkGame (nextPlayer $ _firstPlayer g0)

isRunning :: Game s -> Bool
isRunning (Game status _ _ _ _) = status == PlayR || status == PlayY

nMovesGame :: Game s -> Int
nMovesGame = U.length . _moves

Jouer un coup

Comme pour la version C++, pour détecter les victoires, on définit une fonction lineLength qui compte les pions de la couleur courante (c0) à partir de la nouvelle case jouée (i0 j0) et dans une direction donnée (di dj). On notera la fonction locale aux permettant la classique optimisation de récursivité terminale.

lineLength :: Int -> Int -> Int -> Int -> Cell -> Board s -> ST s Int
lineLength i0 j0 di dj c0 cs = 
    let aux i j n = if not (checkIJ i j) then return n else do
                        c <- readM cs (Ix2 i j)
                        if c /= c0 then return n else aux (i+di) (j+dj) (n+1)
    in aux (i0+di) (j0+dj) 0

checkIJ :: Int -> Int -> Bool
checkIJ i j = i>=0 && i<nI && j>=0 && j<nJ

La fonction checkLine permet de détecter une victoire en parcourant une ligne donnée (dans les deux directions).

checkLine :: Int -> Int -> Int -> Int -> Cell -> Board s -> ST s Bool
checkLine i0 j0 di dj c0 cs = do
    l1 <- lineLength i0 j0 di dj c0 cs
    l2 <- lineLength i0 j0 (-di) (-dj) c0 cs
    return $ l1+l2 >= 3

Enfin, on peut écrire la fonction pour jouer un coup, en utilisant le même algorithme que pour la version C++. A partir du numéro du coup (k), on trouve la colonne correspondante (j0) puis la ligne (i0). On met à jour la case ainsi trouvée et on calcule les coups possibles pour ce plateau de jeu. Enfin, on teste les victoires potentielles dans les différentes directions et on retourne le jeu mis à jour en fonction des victoires détectés et des coups restants.

playK :: Int -> Game s -> ST s (Game s)
playK k g@(Game _ cp _ ms cs) = do

    let j0 = ms U.! k

    -- find and play cell
    let findI 0 = return 0
        findI i = do
            c <- readM cs (Ix2 (i-1) j0)
            if c/=CellE then return i else findI (i-1)
    i0 <- findI nI
    let c0 = player2Cell cp
    writeM cs (Ix2 i0 j0) c0
    let ms1 = if i0/=(nI-1) then ms else U.filter (/=j0) ms

    -- update status/current/moves
    resRow <- checkLine i0 j0 0 1 c0 cs
    resCol <- checkLine i0 j0 1 0 c0 cs
    resDiag1 <- checkLine i0 j0 1 1 c0 cs
    resDiag2 <- checkLine i0 j0 1 (-1) c0 cs
    return $ case (resRow||resCol||resDiag1||resDiag2, U.null ms1) of
        (True, _) -> g { _status = if cp==PlayerR then WinR else WinY
                       , _moves = ms1 }
        (_, True) -> g { _status = Tie, _moves = ms1 }
        _         -> g { _status = if cp==PlayerR then PlayY else PlayR
                       , _currentPlayer = nextPlayer cp
                       , _moves = ms1 }

Tests unitaires

Comme pour la version C++, on peut tester notre module Game avec des tests unitaires, par exemple avec la bibliothèque Hspec. Le code suivant définit une suite de test “Game” contenant tests “mkGame 1” et “nextGame 1”. Ces tests exécutent des scénarios et vérifient, sur les résultats, les assertions données.

-- tests.hs

main :: IO ()
main = hspec $ do

    describe "Game" $ do

        it "mkGame 1" $ do
            g <- stToIO $ mkGame PlayerR
            _firstPlayer g `shouldBe` PlayerR
            _status g `shouldBe` PlayR
            _currentPlayer g `shouldBe` PlayerR
            _moves g `shouldBe` U.fromList [0 .. 6]

        it "nextGame 1" $ do
            g <- stToIO (mkGame PlayerR >>= nextGame)
            _status g `shouldBe` PlayY
            _firstPlayer g `shouldBe` PlayerY
            _currentPlayer g `shouldBe` PlayerY
            _moves g `shouldBe` U.fromList [0 .. 6]

De même, on peut tester les fonctions pour détecter les victoires.

        it "lineLength 1" $ do
            l1 <- stToIO (newMArray (Sz2 nI nJ) CellE
                            >>= lineLength 0 1 0 1 CellR)
            l1 `shouldBe` 0

        it "lineLength 2" $ do
            l1 <- stToIO $ do 
                    b0 <- newMArray (Sz2 nI nJ) CellE
                    writeM b0 (Ix2 0 2) CellR
                    writeM b0 (Ix2 0 3) CellR
                    lineLength 0 1 0 1 CellR b0
            l1 `shouldBe` 2

        it "lineLength 3" $ do
            l1 <- stToIO $ do 
                    b0 <- newMArray (Sz2 nI nJ) CellE
                    writeM b0 (Ix2 0 0) CellR
                    writeM b0 (Ix2 0 1) CellR
                    lineLength 0 2 0 (-1) CellR b0
            l1 `shouldBe` 2

Et enfin, la fonction pour jouer en coup.

        it "playK 1" $ do
            g <- stToIO (mkGame PlayerR >>= playK 1)
            _status g `shouldBe` PlayY
            _firstPlayer g `shouldBe` PlayerR
            _currentPlayer g `shouldBe` PlayerY
            _moves g `shouldBe` U.fromList [0 .. 6]

        it "playK 2" $ do
            g <- stToIO (mkGame PlayerR 
                        >>= playK 6 >>= playK 6
                        >>= playK 6 >>= playK 6
                        >>= playK 6 >>= playK 6)
            _status g `shouldBe` PlayR
            _firstPlayer g `shouldBe` PlayerR
            _currentPlayer g `shouldBe` PlayerR
            _moves g `shouldBe` U.fromList [0 .. 5]

        it "playK 3" $ do
            g <- stToIO (mkGame PlayerR 
                        >>= playK 2 >>= playK 4
                        >>= playK 2 >>= playK 4
                        >>= playK 2 >>= playK 4
                        >>= playK 2)
            _status g `shouldBe` WinR
            _firstPlayer g `shouldBe` PlayerR
            _currentPlayer g `shouldBe` PlayerR
            _moves g `shouldBe` U.fromList [0 .. 6]

Il suffit alors de lancer le programme de tests pour réaliser les vérifications.

$ runghc -Wall tests.hs 

Game
  mkGame 1
  nextGame 1
  lineLength 1
  lineLength 2
  lineLength 3
  playK 1
  playK 2
  playK 3

Finished in 0.0025 seconds
8 examples, 0 failures

Conclusion

Implémenter un jeu de Puissance 4 en Haskell est relativement simple. Le code est finalement assez proche de l’implémentation C++ déjà présentée : les classes sont remplacées par des types algébriques et les boucles par des fonctions récursives ou des map/filter/reduce. Haskell propose également des tableaux modifiables efficaces, qu’on doit utiliser dans une monade ST. Ceci peut paraitre contraignant au premier abord mais permet en fait d’expliciter les sections de code concernées, et de le vérifier à la compilation. Enfin, Haskell permet également de faire des tests unitaires facilement, notamment grâce à son côté fonctionnel pur.

Dans le prochain article, on verra comment implémenter, en Haskell, des IA basiques et une interface utilisateur qui utilisent cette implémentation de Puissance 4.