Compare commits
3 Commits
master
...
monadifica
| Author | SHA1 | Date | |
|---|---|---|---|
| 5efa223d99 | |||
| 1cf4182e1a | |||
| 0833341617 |
@ -1,3 +1,18 @@
|
|||||||
|
Tarotinator
|
||||||
|
===========
|
||||||
|
|
||||||
|
|
||||||
|
Description
|
||||||
|
-----------
|
||||||
|
|
||||||
|
Ce projet est avant tout une librairie afin que des développeurs puissent créer leur propres implémentations d'IA dédiées au Tarot à 5.
|
||||||
|
Une IA est présentée mais est tellement idiote que finalement, la bataille aurait peut-être été plus intéréssante. Ce n'est pas là le cœur du projet.
|
||||||
|
La classe était initialement concue sans monade, puis la monade IO a été rajoutée après, permettant à l'utilisateur de jouer directement une IA, ou d'utiliser d'autres choses (comme de l'aléatoire).
|
||||||
|
|
||||||
|
Une IA est une classe associée à un type, ce type représente un état de l'IA qui devra être initialisé par l'utilisateur. Chaque méthode de la classe renverra une nouvelle IA qui devra être considéré comme «l'état qu'a pris l'IA après avoir envoyé sa valeur».
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Utilisation
|
Utilisation
|
||||||
-----------
|
-----------
|
||||||
|
|
||||||
@ -6,17 +21,26 @@ Vous pouvez utiliser la commande `cabal run [paramètres]` afin de lancer direct
|
|||||||
Si toutefois vous souhaitez seulement le compiler, vous pouvez lancer `cabal build`.
|
Si toutefois vous souhaitez seulement le compiler, vous pouvez lancer `cabal build`.
|
||||||
|
|
||||||
|
|
||||||
|
Notes d'implémentation
|
||||||
|
----------------------
|
||||||
|
|
||||||
|
Normalement, des ensembles devaient être utilisées en lieu et place de liste (type Set). Hélas, par manque de compréhension de Haskell, ce ne sera ajouté que plus tard.
|
||||||
|
|
||||||
|
Pour l'indicage des listes, les conventions ne sont pas claires. L'indice 0 est le premier élément d'une liste, mais aussi le dernier élément ajouté, ce qui, je trouve, n'est pas cohérent avec une structure chainée par exemple pour considérer un pli, il semble logique que le pli soit «construit» petit à petit, mais alors la première carte a un indice 0. C'est pour cela que dans le code, vous verrez des listes écrites element0:element1:element2:[], pour indiquer qu'elles respectent l'ordre «chronologique».
|
||||||
|
|
||||||
|
Les «points» de chaque camp sont multipliés par deux, afin d'éviter l'utilisation inutile de flottants imprécis.
|
||||||
|
|
||||||
|
Dans un soucis de généralité, beaucoup de fonctions sont «moches» puisqu'elle ressemble à elles-même en cinq exemplaires. Cela est dû à la généralité de la librairie qui peut utiliser des types d'IA tous différents, compactés dans un pentuplet.
|
||||||
|
|
||||||
|
|
||||||
Pour aller plus loin
|
Pour aller plus loin
|
||||||
--------------------
|
--------------------
|
||||||
|
|
||||||
(Ceci est une TODO list)
|
(Ceci est une TODO list)
|
||||||
|
|
||||||
Ajouter la possiblité de random l'IA (avec par exemple une classe qui fonctionne avec de IO)
|
|
||||||
|
|
||||||
Faire une HumainIA (fera pareil avec IO).
|
|
||||||
|
|
||||||
Faire en sorte que les imports soient explicites.
|
Faire en sorte que les imports soient explicites.
|
||||||
|
|
||||||
Utiliser Set partout où c'est adéquat.
|
Utiliser Set partout où c'est adéquat.
|
||||||
|
|
||||||
Essayer de trouver un type pour (liste de taille 5), qui permette de rendre les fonctions complètement définies.
|
Essayer de trouver un type pour (liste de taille 5), qui permette de rendre les fonctions complètement définies.
|
||||||
|
|
||||||
|
|||||||
@ -105,14 +105,22 @@ deleteOrError e (h:l)
|
|||||||
| otherwise = h:(deleteOrError e l)
|
| otherwise = h:(deleteOrError e l)
|
||||||
|
|
||||||
-- Appelle la fonction précisée par le second paramètre.
|
-- Appelle la fonction précisée par le second paramètre.
|
||||||
pentuplator :: (j0,j1,j2,j3,j4) -> Int -> ((j0 -> (a,j0)),(j1 -> (a,j1)),(j2 -> (a,j2)),(j3 -> (a,j3)),(j4 -> (a,j4))) -> (a,(j0,j1,j2,j3,j4))
|
pentuplatorM :: Monad m => (j0,j1,j2,j3,j4) -> Int -> ((j0 -> m (a,j0)),(j1 -> m (a,j1)),(j2 -> m (a,j2)),(j3 -> m (a,j3)),(j4 -> m (a,j4))) -> m (a,(j0,j1,j2,j3,j4))
|
||||||
pentuplator (s0,s1,s2,s3,s4) 0 (f0,f1,f2,f3,f4) = let (o,s') = f0 s0 in (o,(s',s1,s2,s3,s4))
|
pentuplatorM (s0,s1,s2,s3,s4) 0 (f0,f1,f2,f3,f4) = do (o,s') <- f0 s0; return (o,(s',s1,s2,s3,s4))
|
||||||
pentuplator (s0,s1,s2,s3,s4) 1 (f0,f1,f2,f3,f4) = let (o,s') = f1 s1 in (o,(s0,s',s2,s3,s4))
|
pentuplatorM (s0,s1,s2,s3,s4) 1 (f0,f1,f2,f3,f4) = do (o,s') <- f1 s1; return (o,(s0,s',s2,s3,s4))
|
||||||
pentuplator (s0,s1,s2,s3,s4) 2 (f0,f1,f2,f3,f4) = let (o,s') = f2 s2 in (o,(s0,s1,s',s3,s4))
|
pentuplatorM (s0,s1,s2,s3,s4) 2 (f0,f1,f2,f3,f4) = do (o,s') <- f2 s2; return (o,(s0,s1,s',s3,s4))
|
||||||
pentuplator (s0,s1,s2,s3,s4) 3 (f0,f1,f2,f3,f4) = let (o,s') = f3 s3 in (o,(s0,s1,s2,s',s4))
|
pentuplatorM (s0,s1,s2,s3,s4) 3 (f0,f1,f2,f3,f4) = do (o,s') <- f3 s3; return (o,(s0,s1,s2,s',s4))
|
||||||
pentuplator (s0,s1,s2,s3,s4) 4 (f0,f1,f2,f3,f4) = let (o,s') = f4 s4 in (o,(s0,s1,s2,s3,s'))
|
pentuplatorM (s0,s1,s2,s3,s4) 4 (f0,f1,f2,f3,f4) = do (o,s') <- f4 s4; return (o,(s0,s1,s2,s3,s'))
|
||||||
|
|
||||||
--pentuplator p0 i p2 = pentuplator p0 (mod i 5) p2 -- Enlevé pour que ça plante et que ce soit mieux détéctable.
|
--pentuplator p0 i p2 = pentuplator p0 (mod i 5) p2 -- Enlevé pour que ça plante et que ce soit mieux détéctable.
|
||||||
|
|
||||||
-- Inverse les paramètres de la fonction.
|
-- Inverse les paramètres de la fonction.
|
||||||
parametinverter :: (a -> b -> c) -> (b -> a -> c)
|
parametinverterM :: Monad m => (a -> b -> m c) -> (b -> a -> m c)
|
||||||
parametinverter f x y = f y x
|
parametinverterM f x y = f y x
|
||||||
|
|
||||||
|
monadCouple :: Monad m => m (a,b) -> (m a, m b)
|
||||||
|
monadCouple mcp = (mcp>>=(return . fst),mcp>>=(return . snd))
|
||||||
|
|
||||||
|
firstTriMonad :: Monad m => m (m a,b,c) -> m (a,b,c)
|
||||||
|
firstTriMonad mcc = mcc >>= ttt
|
||||||
|
where ttt (mx,y,z) = mx >>= (\x -> return (x,y,z))
|
||||||
|
|||||||
@ -25,11 +25,10 @@ main :: HasCallStack => IO ()
|
|||||||
main = do
|
main = do
|
||||||
tasDeCartes <- shuffleM $ Data.Set.toList deck
|
tasDeCartes <- shuffleM $ Data.Set.toList deck
|
||||||
--putStrLn $ show $ distribuer tasDeCartes [1,6,23] 2
|
--putStrLn $ show $ distribuer tasDeCartes [1,6,23] 2
|
||||||
let
|
let states0 = (MonJeu [], MonJeu [], MonJeu [], MonJeu [], MonJeu [])
|
||||||
states0 = (MonJeu [], MonJeu [], MonJeu [], MonJeu [], MonJeu [])
|
|
||||||
|
|
||||||
-- On décide que joueur 3 commence.
|
-- On décide que joueur 3 commence.
|
||||||
(steps,pointsAttaque,attaquant) = jouerPartie states0 tasDeCartes 2 [1,6,23]
|
(steps,pointsAttaque,attaquant) <- jouerPartie states0 tasDeCartes 2 [1,6,23]
|
||||||
|
|
||||||
|
|
||||||
if (Data.List.null steps)
|
if (Data.List.null steps)
|
||||||
|
|||||||
@ -10,21 +10,21 @@ import Safe.Foldable (maximumMay)
|
|||||||
-- Du point de vue du joueur, la position d'un joueur est le nombre de tours que notre joueur a d'avance. Donc le joueur 1 est celui qui joue après nous, 0 est nous-même et 9 est celui qui joue avant nous.
|
-- Du point de vue du joueur, la position d'un joueur est le nombre de tours que notre joueur a d'avance. Donc le joueur 1 est celui qui joue après nous, 0 est nous-même et 9 est celui qui joue avant nous.
|
||||||
class JoueurIA s where
|
class JoueurIA s where
|
||||||
-- Distrib crée l'état initial lorsque les cartes ont été distribuées. l'entier est la position du joueur qui commence par rapport à «moi»
|
-- Distrib crée l'état initial lorsque les cartes ont été distribuées. l'entier est la position du joueur qui commence par rapport à «moi»
|
||||||
distrib :: s -> [Carte] -> Int -> s
|
distrib :: s -> [Carte] -> Int -> IO s
|
||||||
-- Renvoie le type de prise que «je» compte faire après les annonces des autres.
|
-- Renvoie le type de prise que «je» compte faire après les annonces des autres.
|
||||||
prise :: s -> [Maybe TypePrise] -> (Maybe TypePrise, s)
|
prise :: s -> [Maybe TypePrise] -> IO (Maybe TypePrise, s)
|
||||||
-- Renvoie les annonces faites aux autres.
|
-- Renvoie les annonces faites aux autres.
|
||||||
annonce :: s -> ([Annonce],s)
|
annonce :: s -> IO ([Annonce],s)
|
||||||
-- Renvoie la carte appelée pour accompagner l'attaque.
|
-- Renvoie la carte appelée pour accompagner l'attaque.
|
||||||
carte :: s -> (Carte,s)
|
carte :: s -> IO (Carte,s)
|
||||||
-- Si la prise éfféctuée le demande, on envoie le chien, et on demande l'ecart.
|
-- Si la prise éfféctuée le demande, on envoie le chien, et on demande l'ecart.
|
||||||
ecart :: s -> [Carte] -> ([Carte],s)
|
ecart :: s -> [Carte] -> IO ([Carte],s)
|
||||||
-- debutPartie est appelee avant le premier pli. l'entier est la position du joueur qui a pris, le type de sa prise, la carte appelée, le chien si il a été révélé et la liste de toutes les annonces.
|
-- debutPartie est appelee avant le premier pli. l'entier est la position du joueur qui a pris, le type de sa prise, la carte appelée, le chien si il a été révélé et la liste de toutes les annonces.
|
||||||
debutPartie :: s -> Int -> TypePrise -> Carte -> [Carte] -> [[Annonce]] -> s
|
debutPartie :: s -> Int -> TypePrise -> Carte -> [Carte] -> [[Annonce]] -> IO s
|
||||||
-- Jouer indique la carte à jouer à partir des cartes jouees par les joueurs précédents. Si le second parametre est vide, c'est qu'on commence le tour.
|
-- Jouer indique la carte à jouer à partir des cartes jouees par les joueurs précédents. Si le second parametre est vide, c'est qu'on commence le tour.
|
||||||
jouer :: s -> [Carte] -> (Carte, s)
|
jouer :: s -> [Carte] -> IO (Carte, s)
|
||||||
-- finTour informe des cartes qui ont été jouées pendant le tour.
|
-- finTour informe des cartes qui ont été jouées pendant le tour.
|
||||||
finTour :: s -> [Carte] -> s
|
finTour :: s -> [Carte] -> IO s
|
||||||
|
|
||||||
|
|
||||||
data CouleurPli = CCouleur Couleur | CAtout | CExcuse deriving Eq
|
data CouleurPli = CCouleur Couleur | CAtout | CExcuse deriving Eq
|
||||||
@ -136,47 +136,48 @@ calculerJeuPli main etats jeux pli points = (EtatPartie (vraiIndiceGagnant, etat
|
|||||||
-- Cette fonction calcule le prochain pli renvoyé par les joueurs, avec i l'indice du joueur qui commence.
|
-- Cette fonction calcule le prochain pli renvoyé par les joueurs, avec i l'indice du joueur qui commence.
|
||||||
-- Dans cette fonction, jr1 est le premier joueur à JOUER LE PLI, il s'agit en réalité du ième joueur
|
-- Dans cette fonction, jr1 est le premier joueur à JOUER LE PLI, il s'agit en réalité du ième joueur
|
||||||
-- De la même facon, le premier élément du pentuple d'états renvoyé est le nouvel état du premier joueur à jouer le pli.
|
-- De la même facon, le premier élément du pentuple d'états renvoyé est le nouvel état du premier joueur à jouer le pli.
|
||||||
calculerPliJoue :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => int -> (j1,j2,j3,j4,j5) -> ([Carte],(j1,j2,j3,j4,j5))
|
calculerPliJoue :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => Int -> (j1,j2,j3,j4,j5) -> IO ([Carte],(j1,j2,j3,j4,j5))
|
||||||
calculerPliJoue i (jr1,jr2,jr3,jr4,jr5) = (pli,(e1,e2,e3,e4,e5))
|
calculerPliJoue i (jr1,jr2,jr3,jr4,jr5) = do
|
||||||
where
|
(c1,e1) <- jouer jr1 []
|
||||||
(c1,e1) = jouer jr1 []
|
(c2,e2) <- jouer jr2 (c1:[])
|
||||||
(c2,e2) = jouer jr2 (c1:[])
|
(c3,e3) <- jouer jr3 (c2:c1:[])
|
||||||
(c3,e3) = jouer jr3 (c2:c1:[])
|
(c4,e4) <- jouer jr4 (c3:c2:c1:[])
|
||||||
(c4,e4) = jouer jr4 (c3:c2:c1:[])
|
(c5,e5) <- jouer jr5 (c4:c3:c2:c1:[])
|
||||||
(c5,e5) = jouer jr5 (c4:c3:c2:c1:[])
|
let pli = c5:c4:c3:c2:c1:[]
|
||||||
pli = c5:c4:c3:c2:c1:[]
|
return (pli,(e1,e2,e3,e4,e5))
|
||||||
|
|
||||||
|
|
||||||
-- Dans cette fonction, jr1 est le premier joueur de l'index, celui qui commence le pli est le i-ème
|
-- Dans cette fonction, jr1 est le premier joueur de l'index, celui qui commence le pli est le i-ème
|
||||||
-- Cette fonction «change le référentiel» càd que dans les sous-fonctions, les premiers éléments des tuple correspondent aux premier joueurs à jouer le pli.
|
-- Cette fonction «change le référentiel» càd que dans les sous-fonctions, les premiers éléments des tuple correspondent aux premier joueurs à jouer le pli.
|
||||||
-- On est obligé d'écrire les cinq règles différement, parce que
|
-- On est obligé d'écrire les cinq règles différement, parce que
|
||||||
jouerPli :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => (EtatPartie j1 j2 j3 j4 j5) -> (EtatPartie j1 j2 j3 j4 j5, [Carte])
|
jouerPli :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => EtatPartie j1 j2 j3 j4 j5 -> IO ((EtatPartie j1 j2 j3 j4 j5), [Carte])
|
||||||
jouerPli (EtatPartie (0,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = let (pli,(e1,e2,e3,e4,e5))=calculerPliJoue 0 (jr1,jr2,jr3,jr4,jr5) in calculerJeuPli 0 (e1,e2,e3,e4,e5) jeux pli points
|
jouerPli (EtatPartie (0,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = do (pli,(e1,e2,e3,e4,e5)) <- calculerPliJoue 0 (jr1,jr2,jr3,jr4,jr5); return (calculerJeuPli 0 (e1,e2,e3,e4,e5) jeux pli points)
|
||||||
jouerPli (EtatPartie (1,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = let (pli,(e2,e3,e4,e5,e1))=calculerPliJoue 1 (jr2,jr3,jr4,jr5,jr1) in calculerJeuPli 1 (e1,e2,e3,e4,e5) jeux pli points
|
jouerPli (EtatPartie (1,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = do (pli,(e2,e3,e4,e5,e1)) <- calculerPliJoue 1 (jr2,jr3,jr4,jr5,jr1); return (calculerJeuPli 1 (e1,e2,e3,e4,e5) jeux pli points)
|
||||||
jouerPli (EtatPartie (2,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = let (pli,(e3,e4,e5,e1,e2))=calculerPliJoue 2 (jr3,jr4,jr5,jr1,jr2) in calculerJeuPli 2 (e1,e2,e3,e4,e5) jeux pli points
|
jouerPli (EtatPartie (2,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = do (pli,(e3,e4,e5,e1,e2)) <- calculerPliJoue 2 (jr3,jr4,jr5,jr1,jr2); return (calculerJeuPli 2 (e1,e2,e3,e4,e5) jeux pli points)
|
||||||
jouerPli (EtatPartie (3,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = let (pli,(e4,e5,e1,e2,e3))=calculerPliJoue 3 (jr4,jr5,jr1,jr2,jr3) in calculerJeuPli 3 (e1,e2,e3,e4,e5) jeux pli points
|
jouerPli (EtatPartie (3,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = do (pli,(e4,e5,e1,e2,e3)) <- calculerPliJoue 3 (jr4,jr5,jr1,jr2,jr3); return (calculerJeuPli 3 (e1,e2,e3,e4,e5) jeux pli points)
|
||||||
jouerPli (EtatPartie (4,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = let (pli,(e5,e1,e2,e3,e4))=calculerPliJoue 4 (jr5,jr1,jr2,jr3,jr4) in calculerJeuPli 4 (e1,e2,e3,e4,e5) jeux pli points
|
jouerPli (EtatPartie (4,(jr1,jr2,jr3,jr4,jr5),jeux,points)) = do (pli,(e5,e1,e2,e3,e4)) <- calculerPliJoue 4 (jr5,jr1,jr2,jr3,jr4); return (calculerJeuPli 4 (e1,e2,e3,e4,e5) jeux pli points)
|
||||||
|
|
||||||
|
|
||||||
-- «Demande» réellement aux IAs la prise qu'elles comptent effectuer.
|
-- «Demande» réellement aux IAs la prise qu'elles comptent effectuer.
|
||||||
-- Params: Pentuple d'IAs, avec s0 le premier joueur à parler.
|
-- Params: Pentuple d'IAs, avec s0 le premier joueur à parler.
|
||||||
calculerPrisesAux :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => (j1,j2,j3,j4,j5) -> ([Maybe TypePrise],(j1,j2,j3,j4,j5))
|
calculerPrisesAux :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => (j1,j2,j3,j4,j5) -> IO ([Maybe TypePrise],(j1,j2,j3,j4,j5))
|
||||||
calculerPrisesAux (s0,s1,s2,s3,s4) = (prises,(s0',s1',s2',s3',s4'))
|
calculerPrisesAux (s0,s1,s2,s3,s4) = do
|
||||||
where
|
(prise0,s0') <- prise s0 []
|
||||||
(prise0,s0') = prise s0 []
|
(prise1,s1') <- prise s1 (prise0:[])
|
||||||
(prise1,s1') = prise s1 (prise0:[])
|
(prise2,s2') <- prise s2 (prise1:prise0:[])
|
||||||
(prise2,s2') = prise s2 (prise1:prise0:[])
|
(prise3,s3') <- prise s3 (prise2:prise1:prise0:[])
|
||||||
(prise3,s3') = prise s3 (prise2:prise1:prise0:[])
|
(prise4,s4') <- prise s4 (prise3:prise2:prise1:prise0:[])
|
||||||
(prise4,s4') = prise s4 (prise3:prise2:prise1:prise0:[])
|
let prises = prise4:prise3:prise2:prise1:prise0:[]
|
||||||
prises = prise4:prise3:prise2:prise1:prise0:[]
|
return (prises,(s0',s1',s2',s3',s4'))
|
||||||
|
|
||||||
-- «Demande» aux IOs la prise qu'elles comptent effectuer.
|
-- «Demande» aux IOs la prise qu'elles comptent effectuer.
|
||||||
-- Params: Pentuple d'IAs, avec s0 le premier joueur de l'index, le second paramètre est le numéro du joueur qui parle en premier.
|
-- Params: Pentuple d'IAs, avec s0 le premier joueur de l'index, le second paramètre est le numéro du joueur qui parle en premier.
|
||||||
calculerPrises :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => (j1,j2,j3,j4,j5) -> Int -> ([Maybe TypePrise],(j1,j2,j3,j4,j5))
|
calculerPrises :: (JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4, JoueurIA j5) => (j1,j2,j3,j4,j5) -> Int -> IO ([Maybe TypePrise],(j1,j2,j3,j4,j5))
|
||||||
calculerPrises (s0,s1,s2,s3,s4) 0 = let (prises, (s0',s1',s2',s3',s4')) = calculerPrisesAux (s0,s1,s2,s3,s4) in (prises, (s0',s1',s2',s3',s4'))
|
calculerPrises (s0,s1,s2,s3,s4) 0 = do (prises, (s0',s1',s2',s3',s4')) <- calculerPrisesAux (s0,s1,s2,s3,s4) ; return (prises, (s0',s1',s2',s3',s4'))
|
||||||
calculerPrises (s0,s1,s2,s3,s4) 1 = let (prises, (s1',s2',s3',s4',s0')) = calculerPrisesAux (s1,s2,s3,s4,s0) in (prises, (s0',s1',s2',s3',s4'))
|
calculerPrises (s0,s1,s2,s3,s4) 1 = do (prises, (s1',s2',s3',s4',s0')) <- calculerPrisesAux (s1,s2,s3,s4,s0) ; return (prises, (s0',s1',s2',s3',s4'))
|
||||||
calculerPrises (s0,s1,s2,s3,s4) 2 = let (prises, (s2',s3',s4',s0',s1')) = calculerPrisesAux (s2,s3,s4,s0,s1) in (prises, (s0',s1',s2',s3',s4'))
|
calculerPrises (s0,s1,s2,s3,s4) 2 = do (prises, (s2',s3',s4',s0',s1')) <- calculerPrisesAux (s2,s3,s4,s0,s1) ; return (prises, (s0',s1',s2',s3',s4'))
|
||||||
calculerPrises (s0,s1,s2,s3,s4) 3 = let (prises, (s3',s4',s0',s1',s2')) = calculerPrisesAux (s3,s4,s0,s1,s2) in (prises, (s0',s1',s2',s3',s4'))
|
calculerPrises (s0,s1,s2,s3,s4) 3 = do (prises, (s3',s4',s0',s1',s2')) <- calculerPrisesAux (s3,s4,s0,s1,s2) ; return (prises, (s0',s1',s2',s3',s4'))
|
||||||
calculerPrises (s0,s1,s2,s3,s4) 4 = let (prises, (s4',s0',s1',s2',s3')) = calculerPrisesAux (s4,s0,s1,s2,s3) in (prises, (s0',s1',s2',s3',s4'))
|
calculerPrises (s0,s1,s2,s3,s4) 4 = do (prises, (s4',s0',s1',s2',s3')) <- calculerPrisesAux (s4,s0,s1,s2,s3) ; return (prises, (s0',s1',s2',s3',s4'))
|
||||||
|
|
||||||
|
|
||||||
-- Renvoie les points de l'attaquant (la défense a fait les autres)
|
-- Renvoie les points de l'attaquant (la défense a fait les autres)
|
||||||
@ -198,65 +199,82 @@ calculerPointsJoueurs pointsJoueurs attaquant (Just coattaquant) typePrise chien
|
|||||||
-- Cette fonction joue une partie, et ne fait rien si personne ne prend.
|
-- Cette fonction joue une partie, et ne fait rien si personne ne prend.
|
||||||
-- Params: numéro du joueur qui commence, le type de prise éfféctué, le pentuple des IAs, le chien issu de la distribution, la liste des cartes des joueurs dont le premier élément est celui du numéro 1, la liste des prises efféctuées (l'élément le plus profond est la première prise).
|
-- Params: numéro du joueur qui commence, le type de prise éfféctué, le pentuple des IAs, le chien issu de la distribution, la liste des cartes des joueurs dont le premier élément est celui du numéro 1, la liste des prises efféctuées (l'élément le plus profond est la première prise).
|
||||||
vraimentJouerPartie :: (JoueurIA j0, JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4) => (Show j0, Show j1, Show j2, Show j3, Show j4) =>
|
vraimentJouerPartie :: (JoueurIA j0, JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4) => (Show j0, Show j1, Show j2, Show j3, Show j4) =>
|
||||||
Int -> Maybe TypePrise -> (j0, j1, j2, j3, j4) -> [Carte] -> [[Carte]] -> [Maybe TypePrise] -> ([(EtatPartie j0 j1 j2 j3 j4,[Carte])],[Carte],Int)
|
Int -> Maybe TypePrise -> (j0, j1, j2, j3, j4) -> [Carte] -> [[Carte]] -> [Maybe TypePrise] -> IO ([(EtatPartie j0 j1 j2 j3 j4,[Carte])],[Carte],Int)
|
||||||
vraimentJouerPartie _ Nothing _ _ _ _ = ([],[],-1)
|
vraimentJouerPartie _ Nothing _ _ _ _ = return ([],[],-1)
|
||||||
vraimentJouerPartie meneur (Just typePrise) (s20,s21,s22,s23,s24) chien cartesInitiales prises = (steps,pointsAttaque,attaque)
|
vraimentJouerPartie meneur (Just typePrise) (s20,s21,s22,s23,s24) chien cartesInitiales prises = do
|
||||||
where
|
|
||||||
|
let attaque :: Int
|
||||||
attaque = mod (meneur+ 4-(fromJust $ elemIndex (Just typePrise) prises)) 5 -- L'attaque est le numéro du joueur qui a pris la plus grande prise.
|
attaque = mod (meneur+ 4-(fromJust $ elemIndex (Just typePrise) prises)) 5 -- L'attaque est le numéro du joueur qui a pris la plus grande prise.
|
||||||
|
|
||||||
(carteAppelee,(s30,s31,s32,s33,s34)) = pentuplator (s20,s21,s22,s23,s24) attaque (carte,carte,carte,carte,carte) -- Demande juste à l'attaquant la carte qu'il appelle.
|
(carteAppelee,(s30,s31,s32,s33,s34)) <- (pentuplatorM (s20,s21,s22,s23,s24) attaque (carte,carte,carte,carte,carte)) -- Demande juste à l'attaquant la carte qu'il appelle.
|
||||||
|
|
||||||
(ecartEffectue,(s40,s41,s42,s43,s44)) -- Demande juste à l'attaquant de faire son écart, si son type de prise le demande.
|
let ecarteur :: JoueurIA j => j -> IO ([Carte],j)
|
||||||
| faireEcart typePrise = pentuplator (s30,s31,s32,s33,s34) attaque (ecarteur,ecarteur,ecarteur,ecarteur,ecarteur)
|
ecarteur = parametinverterM ecart chien
|
||||||
| otherwise = ([],(s30,s31,s32,s33,s34)) -- Sinon, met le chien à vide.
|
(ecartEffectue,(s40,s41,s42,s43,s44)) <- case (faireEcart typePrise) of { -- Demande juste à l'attaquant de faire son écart, si son type de prise le demande.
|
||||||
where
|
True -> pentuplatorM (s30,s31,s32,s33,s34) attaque (ecarteur,ecarteur,ecarteur,ecarteur,ecarteur);
|
||||||
ecarteur :: JoueurIA j => j -> ([Carte],j)
|
False -> return ([],(s30,s31,s32,s33,s34)); -- Sinon, met le chien à vide.
|
||||||
ecarteur = parametinverter ecart chien
|
}
|
||||||
|
|
||||||
((annonces0,s50),(annonces1,s51),(annonces2,s52),(annonces3,s53),(annonces4,s54)) = (annonce s40, annonce s41, annonce s42, annonce s43, annonce s44)
|
(annonces0,s50)<-annonce s40;(annonces1,s51)<-annonce s41;(annonces2,s52)<-annonce s42;(annonces3,s53)<-annonce s43;(annonces4,s54)<-annonce s44;
|
||||||
|
|
||||||
cartesApresEcart
|
let cartesApresEcart = case (faireEcart typePrise) of {
|
||||||
| faireEcart typePrise = replaceNth cartesInitiales attaque (deleteAllOrError ecartEffectue ((cartesInitiales !! attaque) ++ chien)) -- on ajoute le chien à la main, puis on enlève l'écart.
|
True -> replaceNth cartesInitiales attaque (deleteAllOrError ecartEffectue ((cartesInitiales !! attaque) ++ chien)); -- on ajoute le chien à la main, puis on enlève l'écart.
|
||||||
| otherwise = cartesInitiales
|
False -> cartesInitiales;
|
||||||
|
}
|
||||||
annonces = [annonces0,annonces1,annonces2,annonces3,annonces4]
|
|
||||||
|
let annonces = [annonces0,annonces1,annonces2,annonces3,annonces4]
|
||||||
(s60,s61,s62,s63,s64) = (debutPartieAux s50 0, debutPartieAux s51 1, debutPartieAux s52 2, debutPartieAux s53 3,debutPartieAux s54 4)
|
|
||||||
|
let debutPartieAux :: JoueurIA j => j -> Int -> IO j
|
||||||
|
debutPartieAux s i -- initialise l'IA s avec i le numéro du joueur
|
||||||
|
| faireEcart typePrise = debutPartie s (mod (attaque-i) 5) typePrise carteAppelee chien (rotate i annonces)
|
||||||
|
| otherwise = debutPartie s (mod (attaque-i) 5) typePrise carteAppelee [] (rotate i annonces)
|
||||||
|
|
||||||
|
s60<-debutPartieAux s50 0;s61<-debutPartieAux s51 1;s62<-debutPartieAux s52 2;s63<-debutPartieAux s53 3;s64<-debutPartieAux s54 4;
|
||||||
|
|
||||||
|
let chienOuEcart = case (Data.List.null ecartEffectue) of {
|
||||||
|
True -> chien;
|
||||||
|
False -> ecartEffectue;
|
||||||
|
}
|
||||||
|
|
||||||
|
let etat0 = EtatPartie (meneur,(s60,s61,s62,s63,s64),cartesApresEcart,rotate attaque [chienOuEcart,[],[],[],[]]) -- état initial de la partie, l'écart à défaut le chien est dans les point de l'attaquant.
|
||||||
|
|
||||||
|
let --cartesJouees :: (JoueurIA j0, JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4) => [IO (EtatPartie j0 j1 j2 j3 j4,[Carte])]
|
||||||
|
cartesJouees = iterate (\s -> ((fst $ monadCouple s)>>=jouerPli)) (return (etat0,[]))
|
||||||
|
|
||||||
|
let steps = Prelude.take 15 $ cartesJouees
|
||||||
|
|
||||||
|
(EtatPartie (_,_,_,pointsJoueurs),_) <- last steps
|
||||||
|
|
||||||
|
let coattaquant = findIndex (\l -> elem carteAppelee l) cartesInitiales
|
||||||
|
|
||||||
|
let pointsAttaque = calculerPointsJoueurs pointsJoueurs attaque coattaquant typePrise chien ecartEffectue
|
||||||
|
|
||||||
|
let out = (return (sequence steps,pointsAttaque,attaque)) >>= ttt
|
||||||
where
|
where
|
||||||
debutPartieAux :: JoueurIA j => j -> Int -> j
|
ttt (mx,y,z) = mx >>= (\x -> return (x,y,z))
|
||||||
debutPartieAux s i -- initialise l'IA s avec i le numéro du joueur
|
|
||||||
| faireEcart typePrise = debutPartie s (mod (attaque-i) 5) typePrise carteAppelee chien (rotate i annonces)
|
|
||||||
| otherwise = debutPartie s (mod (attaque-i) 5) typePrise carteAppelee [] (rotate i annonces)
|
|
||||||
|
|
||||||
etat0 = EtatPartie (meneur,(s60,s61,s62,s63,s64),cartesApresEcart,rotate attaque [chienOuEcart,[],[],[],[]]) -- état initial de la partie, l'écart à défaut le chien est dans les point de l'attaquant.
|
|
||||||
where
|
|
||||||
chienOuEcart
|
|
||||||
| Data.List.null ecartEffectue = chien
|
|
||||||
| otherwise = ecartEffectue
|
|
||||||
cartesJouees = iterate (jouerPli . fst) (etat0,[])
|
|
||||||
|
|
||||||
steps = Prelude.take 15 $ cartesJouees
|
|
||||||
|
|
||||||
(EtatPartie (_,_,_,pointsJoueurs),_) = last steps
|
|
||||||
|
|
||||||
coattaquant = findIndex (\l -> elem carteAppelee l) cartesInitiales
|
|
||||||
|
|
||||||
pointsAttaque = calculerPointsJoueurs pointsJoueurs attaque coattaquant typePrise chien ecartEffectue
|
|
||||||
|
|
||||||
|
|
||||||
|
out
|
||||||
|
|
||||||
-- Cette fonction joue une partie.
|
-- Cette fonction joue une partie.
|
||||||
-- Params: pentuple d'IAs, tas de carte à distribuer, numéro du joueur qui commence, les trois nombres entre 1 et 23 à mettre dans le chien.
|
-- Params: pentuple d'IAs, tas de carte à distribuer, numéro du joueur qui commence, les trois nombres entre 1 et 23 à mettre dans le chien.
|
||||||
jouerPartie :: (JoueurIA j0, JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4) => (Show j0, Show j1, Show j2, Show j3, Show j4) =>
|
jouerPartie :: (JoueurIA j0, JoueurIA j1, JoueurIA j2, JoueurIA j3, JoueurIA j4) => (Show j0, Show j1, Show j2, Show j3, Show j4) =>
|
||||||
(j0, j1, j2, j3, j4) -> [Carte] -> Int -> [Int] -> ([(EtatPartie j0 j1 j2 j3 j4,[Carte])],[Carte],Int)
|
(j0, j1, j2, j3, j4) -> [Carte] -> Int -> [Int] -> IO ([(EtatPartie j0 j1 j2 j3 j4,[Carte])],[Carte],Int)
|
||||||
jouerPartie (s00,s01,s02,s03,s04) tasDeCartes meneur indicesChien = vraimentJouerPartie meneur typePriseM (s20,s21,s22,s23,s24) chien cartesInitiales prises
|
jouerPartie (s00,s01,s02,s03,s04) tasDeCartes meneur indicesChien = do
|
||||||
where
|
|
||||||
(cartes,chien) = distribuer tasDeCartes indicesChien meneur
|
let (cartes,chien) = distribuer tasDeCartes indicesChien meneur
|
||||||
cartesInitiales = rotate (mod (-meneur) 5) cartes -- le premier joueur recoit le (5-meneur)-ième tas.
|
let cartesInitiales = rotate (mod (-meneur) 5) cartes -- le premier joueur recoit le (5-meneur)-ième tas.
|
||||||
[cartesJ0,cartesJ1,cartesJ2,cartesJ3,cartesJ4] = cartesInitiales
|
let [cartesJ0,cartesJ1,cartesJ2,cartesJ3,cartesJ4] = cartesInitiales
|
||||||
(s10,s11,s12,s13,s14) = (distrib s00 cartesJ0 (mod (meneur-0) 5), distrib s01 cartesJ1 (mod (meneur-1) 5), distrib s02 cartesJ2 (mod (meneur-2) 5), distrib s03 cartesJ3 (mod (meneur-3) 5), distrib s04 cartesJ4 (mod(meneur-4) 5))
|
|
||||||
(prises,(s20,s21,s22,s23,s24)) = calculerPrises (s10,s11,s12,s13,s14) meneur -- meneur est le premier à annoncer sa prise
|
s10 <- distrib s00 cartesJ0 (mod (meneur-0) 5)
|
||||||
|
s11 <- distrib s01 cartesJ1 (mod (meneur-1) 5)
|
||||||
typePriseM = maximum prises
|
s12 <- distrib s02 cartesJ2 (mod (meneur-2) 5)
|
||||||
|
s13 <- distrib s03 cartesJ3 (mod (meneur-3) 5)
|
||||||
|
s14 <- distrib s04 cartesJ4 (mod (meneur-4) 5)
|
||||||
|
|
||||||
|
(prises,(s20,s21,s22,s23,s24)) <- calculerPrises (s10,s11,s12,s13,s14) meneur -- meneur est le premier à annoncer sa prise
|
||||||
|
|
||||||
|
let typePriseM = maximum prises
|
||||||
|
vraimentJouerPartie meneur typePriseM (s20,s21,s22,s23,s24) chien cartesInitiales prises
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@ -2,6 +2,7 @@ module TarotIAs where
|
|||||||
|
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Set (toList)
|
import Data.Set (toList)
|
||||||
|
import Data.Foldable (for_)
|
||||||
import Safe.Foldable (maximumMay)
|
import Safe.Foldable (maximumMay)
|
||||||
import Cartes
|
import Cartes
|
||||||
import Tarot
|
import Tarot
|
||||||
@ -10,15 +11,121 @@ import Tarot
|
|||||||
data RandomIA = MonJeu ([Carte]) deriving Show
|
data RandomIA = MonJeu ([Carte]) deriving Show
|
||||||
|
|
||||||
instance JoueurIA RandomIA where
|
instance JoueurIA RandomIA where
|
||||||
distrib self cartes pos = MonJeu cartes -- Notre état est les cartes que l'on a, on se fiche de notre passé.
|
distrib self cartes pos = return $ MonJeu cartes -- Notre état est les cartes que l'on a, on se fiche de notre passé.
|
||||||
prise (MonJeu cartes) prises -- On ne prend que si on a le 21 d'atout et que personne n'a fait plus qu'une garde.
|
prise (MonJeu cartes) prises -- On ne prend que si on a le 21 d'atout et que personne n'a fait plus qu'une garde.
|
||||||
| (elem (Atout(21)) cartes) && ((maximumMay prises) < Just (Just Garde)) = (Just Garde, (MonJeu cartes))
|
| (elem (Atout(21)) cartes) && ((maximumMay prises) < Just (Just Garde)) = return (Just Garde, (MonJeu cartes))
|
||||||
| otherwise = (Nothing, (MonJeu cartes))
|
| otherwise = return (Nothing, (MonJeu cartes))
|
||||||
carte (MonJeu(cartes)) = (maximum $ filter (\x -> not (estAtout x)) $ filter (\x -> not (elem x cartes)) $ (toList deck), MonJeu(cartes))
|
carte (MonJeu(cartes)) = return $ (maximum $ filter (\x -> not (estAtout x)) $ filter (\x -> not (elem x cartes)) $ (toList deck), MonJeu(cartes))
|
||||||
ecart (MonJeu(cartes)) chien = let grosTas = sort (chien ++ cartes) in (take 3 grosTas,MonJeu(drop 3 grosTas))
|
ecart (MonJeu(cartes)) chien = return $ let grosTas = sort (chien ++ cartes) in (take 3 grosTas,MonJeu(drop 3 grosTas))
|
||||||
annonce self = ([], self) -- On ne fait pas d'annonce. Jamais.
|
annonce self = return ([], self) -- On ne fait pas d'annonce. Jamais.
|
||||||
debutPartie self typePrise carteAppelee chien annonces i = self -- On s'en fiche de l'info.
|
debutPartie self typePrise carteAppelee chien annonces i = return self -- On s'en fiche de l'info.
|
||||||
jouer (MonJeu cartes) pli = (joué, MonJeu (delete joué cartes)) -- On joue la plus petite carte que l'on aie.
|
jouer (MonJeu cartes) pli = return (joué, MonJeu (delete joué cartes)) -- On joue la plus petite carte que l'on aie.
|
||||||
where joué = minimum [carte | carte<-cartes, peutJouer carte cartes pli]
|
where joué = minimum [carte | carte<-cartes, peutJouer carte cartes pli]
|
||||||
finTour self pli = self -- On s'en fiche de l'info.
|
finTour self pli = return self -- On s'en fiche de l'info.
|
||||||
|
|
||||||
|
|
||||||
|
playerSort :: Carte -> Carte -> Ordering
|
||||||
|
playerSort (Valeur(col1,val1)) (Valeur(col2,val2))
|
||||||
|
| col1==col2 = compare val1 val2
|
||||||
|
| otherwise = compare col1 col2
|
||||||
|
playerSort (Valeur(_,_)) _ = LT
|
||||||
|
playerSort _ (Valeur(_,_)) = GT
|
||||||
|
playerSort (Atout(k)) (Atout(l)) = compare k l
|
||||||
|
playerSort (Atout(_)) Excuse = LT
|
||||||
|
playerSort Excuse (Atout(_)) = GT
|
||||||
|
playerSort Excuse Excuse = EQ
|
||||||
|
|
||||||
|
annoncePriseJoueur :: Int -> Maybe TypePrise -> IO ()
|
||||||
|
annoncePriseJoueur i t = putStrLn $ "Le joueur "++(show (i+1))++" a "++(case t of {
|
||||||
|
Nothing -> "passé.";
|
||||||
|
Just Prise -> "pris.";
|
||||||
|
Just Garde -> "pris en garde.";
|
||||||
|
Just GardeSans -> "pris en garde sans le chien.";
|
||||||
|
Just GardeContre -> "pris en garde avec le chien à la défence.";
|
||||||
|
Just Chelem -> "annoncé un Grand Chelem.";
|
||||||
|
})
|
||||||
|
annoncePriseMoi :: Maybe TypePrise -> String
|
||||||
|
annoncePriseMoi t = (case t of {
|
||||||
|
Nothing -> "Je passe.";
|
||||||
|
Just Prise -> "Je prends.";
|
||||||
|
Just Garde -> "Je prends en garde.";
|
||||||
|
Just GardeSans -> "Je prend en garde sans le chien.";
|
||||||
|
Just GardeContre -> "Je prend en garde avec le chien à la défence.";
|
||||||
|
Just Chelem -> "J'annonce un Grand Chelem.";
|
||||||
|
})
|
||||||
|
allPrises = [Nothing,Just Prise, Just Garde, Just GardeSans, Just GardeContre, Just Chelem]
|
||||||
|
|
||||||
|
readUntilIntIn :: String -> [Int] -> IO Int
|
||||||
|
readUntilIntIn s l = do
|
||||||
|
putStr s
|
||||||
|
istr <- getLine
|
||||||
|
let i = (read istr :: Int)
|
||||||
|
if elem i l
|
||||||
|
then return i
|
||||||
|
else readUntilIntIn s l
|
||||||
|
|
||||||
|
data VraiJoueurIA = VraiJeu ([Carte])
|
||||||
|
instance JoueurIA VraiJoueurIA where
|
||||||
|
distrib self cartes pos = do
|
||||||
|
let jeu = sortBy playerSort cartes
|
||||||
|
putStrLn "Voici votre jeu : "
|
||||||
|
for_ jeu (putStrLn . show)
|
||||||
|
return (VraiJeu(jeu))
|
||||||
|
prise (VraiJeu cartes) prises = do
|
||||||
|
let nprises = length prises
|
||||||
|
if nprises==0
|
||||||
|
then putStrLn "Vous êtes le premier à parler !"
|
||||||
|
else for_ [(nprises-1)..0] (\i -> annoncePriseJoueur (mod (-i) 5) (prises !! i))
|
||||||
|
let maxPrise = maximum prises
|
||||||
|
if maxPrise==Just Chelem
|
||||||
|
then do
|
||||||
|
putStrLn "Vous ne pouvez pas monter là dessus, souhaitez-lui bonne chance !"
|
||||||
|
return (Nothing,VraiJeu cartes)
|
||||||
|
else do
|
||||||
|
let availablePrises = filter (maxPrise<) allPrises
|
||||||
|
let aplength = length availablePrises
|
||||||
|
for_ [0..(aplength-1)] (\i -> putStrLn $ (show (i+1))++" -> "++(annoncePriseMoi (availablePrises !! i)))
|
||||||
|
i <- readUntilIntIn "Qu'annoncez-vous : " [1..aplength]
|
||||||
|
let laprise = availablePrises !! (i-1)
|
||||||
|
return (laprise,VraiJeu cartes)
|
||||||
|
annonce self = return ([], self) -- TODO, pour l'instant on ne fait pas d'annonce.
|
||||||
|
carte (VraiJeu cartes) = do
|
||||||
|
putStrLn "Liste des cartes : "
|
||||||
|
let availableCartes = filter (\s -> not $ estUnBout s) (toList deck)
|
||||||
|
let aclength = length availableCartes
|
||||||
|
for_ [0..(aclength-1)] (\i -> putStrLn $ (show (i+1))++" -> "++(show (availableCartes !! i)))
|
||||||
|
|
||||||
|
i <- readUntilIntIn "Quelle carte appelez-vous ? " [1..aclength]
|
||||||
|
let lacarte = availableCartes !! (i-1)
|
||||||
|
|
||||||
|
return (lacarte,VraiJeu cartes)
|
||||||
|
ecart (VraiJeu(cartes)) chien = do
|
||||||
|
putStrLn "Vos cartes, avec le chien :"
|
||||||
|
let toutesCartes = (cartes ++ chien)
|
||||||
|
let clength = length toutesCartes
|
||||||
|
for_ [0..(clength-1)] (\i -> putStrLn $ (show (i+1))++" -> "++(show (toutesCartes !! i)))
|
||||||
|
|
||||||
|
i1 <- readUntilIntIn "Quelle est la première carte de l'écart ? " [1..clength]
|
||||||
|
let carte1 = toutesCartes !! (i1-1)
|
||||||
|
|
||||||
|
i2 <- readUntilIntIn "Quelle est la seconde carte de l'écart ? " (delete i1 [1..clength])
|
||||||
|
let carte2 = toutesCartes !! (i2-1)
|
||||||
|
|
||||||
|
i3 <- readUntilIntIn "Quelle est la troisième carte de l'écart ? " (delete i1 $ delete i2 [1..clength])
|
||||||
|
let carte3 = toutesCartes !! (i3-1)
|
||||||
|
|
||||||
|
let ecartEffectue = [carte1,carte2,carte3]
|
||||||
|
|
||||||
|
return (ecartEffectue, VraiJeu (deleteAllOrError ecartEffectue toutesCartes))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user