Ajout de plein de méthodes.
This commit is contained in:
parent
abea7be63b
commit
927b51045e
GPG Key ID:
DBA23608F23F5A10
16
tarotinator/README.md
Normal file
16
tarotinator/README.md
Normal file
@ -0,0 +1,16 @@
|
||||
Utilisation
|
||||
-----------
|
||||
|
||||
Vous pouvez utiliser la commande `cabal run [paramètres]` afin de lancer directement le programme.
|
||||
|
||||
Si toutefois vous souhaitez seulement le compiler, vous pouvez lancer `cabal build`.
|
||||
|
||||
|
||||
Pour aller plus loin
|
||||
--------------------
|
||||
|
||||
(Ceci est une TODO list)
|
||||
|
||||
Ajouter la prise à l'IA.
|
||||
|
||||
Ajouter la possiblité de random l'IA (avec par exemple une classe qui fonctionne avec de IO)
|
||||
@ -1,18 +1,32 @@
|
||||
module Cartes where
|
||||
import Data.Set as Set
|
||||
|
||||
data Figure = Valet | Cavalier | Dame | Roi deriving (Eq, Ord, Show)
|
||||
data ValeurCouleur = As | Deux | Trois | Quatre | Cinq | Six | Sept | Huit | Neuf | Dix | Valet | Cavalier | Dame | Roi deriving (Eq, Ord, Show)
|
||||
data Couleur = Pique | Coeur | Carreau | Trefle deriving (Eq, Show, Ord)
|
||||
data Carte = Valeur (Int, Couleur) | Tete (Figure, Couleur) | Atout Int | Excuse deriving (Eq, Ord)
|
||||
data Carte = Valeur (ValeurCouleur, Couleur) | Atout Int | Excuse deriving (Eq, Ord)
|
||||
|
||||
instance Show Carte where
|
||||
show (Excuse) = "Excuse"
|
||||
show (Atout n) = (show n) ++ " d'atout"
|
||||
show (Tete (f,c)) = (show f) ++ " de " ++ (show c)
|
||||
show (Valeur (n,c)) = (show n) ++ " de " ++ (show c)
|
||||
|
||||
allFigures = [Valet, Cavalier, Dame, Roi]
|
||||
allValeurs = [As, Deux, Trois, Quatre, Cinq, Six, Sept, Huit, Neuf, Dix, Valet, Cavalier, Dame, Roi]
|
||||
allCouleurs = [Pique, Coeur, Carreau, Trefle]
|
||||
|
||||
deck :: Set Carte
|
||||
deck = fromList ([Valeur (n,c) | n<-[1..10], c<-allCouleurs] ++ [Tete (f,c) | f<- allFigures, c<- allCouleurs] ++ [Atout n | n<-[1..21]] ++ [Excuse])
|
||||
deck = fromList ([Valeur (n,c) | n<-allValeurs, c<-allCouleurs] ++ [Atout n | n<-[1..21]] ++ [Excuse])
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
--------------------------------------
|
||||
------------- List Utils -------------
|
||||
--------------------------------------
|
||||
replaceNth :: [a] -> Int -> a -> [a]
|
||||
replaceNth (e:s) i newElement
|
||||
| i==0 = newElement:s
|
||||
| otherwise = replaceNth s (i-1) newElement
|
||||
|
||||
@ -1,4 +1,17 @@
|
||||
import Cartes
|
||||
import System.Random.Shuffle
|
||||
import Data.Set
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = putStrLn (show (deck))
|
||||
main = do
|
||||
donne <- shuffleM $ toList deck
|
||||
let
|
||||
taz = distribuer randomizedGame
|
||||
infiniteSteps = iterate singleStep taz
|
||||
steps = takeWhile (not . isDone) infiniteSteps
|
||||
for_ steps $ \(x,y) -> do
|
||||
print (length x, length y)
|
||||
putStrLn $ prettyDeck x
|
||||
putStrLn $ prettyDeck y
|
||||
putStrLn ""
|
||||
|
||||
@ -1,8 +1,102 @@
|
||||
module Tarot where
|
||||
|
||||
import Cartes
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
|
||||
-- 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
|
||||
-- Distrib crée l'état initial lorsque les cartes ont été distribuées.
|
||||
distrib :: [Carte] -> s
|
||||
-- Distrib crée l'état initial lorsque les cartes ont été distribuées. l'entier est la position du joueur qui commence.
|
||||
distrib :: [Carte] -> Int -> s
|
||||
-- debutPartie est appelee avant le premier pli. l'entier est la position du joueur qui a pris
|
||||
debutPartie :: s -> Int -> 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 :: s -> [Carte] -> (Carte, s)
|
||||
-- finTour informe des cartes qui ont été jouées pendant le tour.
|
||||
finTour :: s -> [Carte] -> s
|
||||
|
||||
|
||||
data CouleurPli = CCouleur Couleur | CAtout | CExcuse deriving Eq
|
||||
|
||||
-- Renvoie la couleur qu'une première carte induit à un pli.
|
||||
couleurPliFromCarte :: Carte -> CouleurPli
|
||||
couleurPliFromCarte (Valeur (_, c)) = CCouleur c
|
||||
couleurPliFromCarte (Atout _) = CAtout
|
||||
couleurPliFromCarte Excuse = CExcuse
|
||||
|
||||
-- Renvoie la couleur du pli suivant les cartes posées.
|
||||
couleurPli :: [Carte] -> CouleurPli
|
||||
couleurPli [] = CExcuse
|
||||
couleurPli (e:s)
|
||||
| z==CExcuse = couleurPliFromCarte e
|
||||
| otherwise = z
|
||||
where z = couleurPli s
|
||||
|
||||
-- Renvoie la carte qui a fait le pli
|
||||
gagnantPli :: [Carte] -> Maybe Carte
|
||||
gagnantPli [] = Nothing
|
||||
pli (e:s) = case (e, w) of {
|
||||
(_, Nothing) -> Just e; -- La seule carte d'un pli le gagne
|
||||
(_, Just Excuse) -> Just e; -- Si juste une excuse a été jouée, la nouvelle carte gagne le pli.
|
||||
(Atout n, Just (Atout m)) -> Just (Atout (max n m)); -- L'atout le plus haut gagne
|
||||
(Atout _, _) -> Just e; -- Seul un atout peut batter un atout.
|
||||
(Valeur (f,c), Just (Atout _)) -> w; -- On s'est pissé dessus, on ne prend pas le pli
|
||||
(Valeur (f,c), Just (Valeur (f',c'))) -> meilleur f f' c c'
|
||||
}
|
||||
where w = gagnantPli s
|
||||
meilleur f f' c c'
|
||||
| c==c' = Just (Valeur (max f f', c)) -- On joue la bonne couleur, le meilleur gagne.
|
||||
| otherwise = w -- Notre couleur est pas la bonne, on pert.
|
||||
|
||||
grosAtout :: [Carte] -> Maybe Int
|
||||
grosAtout [] = Nothing
|
||||
grosAtout ((Atout k):s) = case (grosAtout s) of {
|
||||
Nothing -> Just k;
|
||||
Just m -> Just (max k m)
|
||||
}
|
||||
grosAtout (e:s) = grosAtout s
|
||||
|
||||
hasAtout [] = False
|
||||
hasAtout ((Atout k):s) = True
|
||||
hasAtout (_:s) = hasAtout s
|
||||
|
||||
hasCouleur c [] = False
|
||||
hasCouleur c ((Valeur (_,col)):s) = (c==col) || (hasCouleur c s)
|
||||
hasCouleur c (_:s) = hasCouleur c s
|
||||
|
||||
-- Indique si un joueur peut jouer une carte
|
||||
-- Paramètres: Carte à tester, mon jeu, le pli
|
||||
-- On suppose que la carte a jouer est dans le jeu
|
||||
peutJouer :: Carte -> [Carte] -> [Carte] -> Bool
|
||||
peutJouer c jeu pli = case (couleurPli pli,c) of {
|
||||
(CExcuse,_) -> True; -- On joue ce qu'on veut si le pli n'a pas de couleur.
|
||||
(_,Excuse) -> True; -- On joue l'excuse quand on veut.
|
||||
(CAtout, Atout atoutJoue) -> let (Just grosJoue, Just grosJeu)=(grosAtout pli,grosAtout jeu) in (grosJoue<atoutJoue) || (grosJeu<grosJoue); -- Si on est monté, OK, sinon, c'est qu'on a pas au dessus.
|
||||
(CAtout, _) -> not (hasAtout jeu); -- On peut se pisser dessus que si on a plus d'atout.
|
||||
(CCouleur c, Atout atoutJoue) -> not (hasCouleur c jeu) && (case (grosAtout pli) of {Nothing -> True; Just grosJoue -> let (Just grosJeu)=(grosAtout jeu) in (grosJoue<atoutJoue) || (grosJeu<grosJoue)}); -- Idem que deux lignes au dessus, mais on doit vérifier que on aie pas la couleur.
|
||||
(CCouleur c, Valeur (_,c')) -> (c==c') || ((not (hasCouleur c jeu)) && (not (hasAtout jeu))) -- Soit on a joué la couleur demandée, soit on avait ni la couleur, ni l'atout.
|
||||
}
|
||||
|
||||
|
||||
distribuer :: [Carte] -> ([[Carte]],[Carte])
|
||||
distribuer l = ([j1,j2,j3,j4,j5],chien)
|
||||
where
|
||||
(j1,r1) = splitAt 15 l
|
||||
(j2,r2) = splitAt 15 r1
|
||||
(j3,r3) = splitAt 15 r2
|
||||
(j4,r4) = splitAt 15 r3
|
||||
(j5,chien) = splitAt 15 r4
|
||||
|
||||
type EtatPartie = ([[Carte]],[[Carte]])
|
||||
|
||||
-- Le premier élément de la liste de joueur (le plus profond) est le premier joueur
|
||||
-- Renvoie le nouvel état de la partie ainsi qu'une copie du pli joué.
|
||||
jouerPli :: JoueurIA j => [j] -> EtatPartie -> ([j],EtatPartie,[Carte])
|
||||
jouerPli joueurs (jeux,points) = (etats, ([delete c jeu | (c,jeu)<-(zip pli jeux)], replaceNth points indiceGagnant (pli ++ (points !! indiceGagnant))), pli) -- TODO l'excuse n'est pas gérée
|
||||
where
|
||||
(pli,etats)=foldr (\joueur -> \(pli,etats) -> let (carte,etat) = jouer joueur pli in (carte:pli,etat:etats)) ([],[]) joueurs
|
||||
indiceGagnant = fromJust $ elemIndex (fromJust $ gagnantPli pli) (pli)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
15
tarotinator/src/TarotIAs.hs
Normal file
15
tarotinator/src/TarotIAs.hs
Normal file
@ -0,0 +1,15 @@
|
||||
module TarotIAs where
|
||||
|
||||
import Data.List
|
||||
import Cartes
|
||||
import Tarot
|
||||
|
||||
|
||||
data RandomIA = MonJeu ([Carte])
|
||||
|
||||
instance JoueurIA RandomIA where
|
||||
distrib cartes pos = MonJeu cartes -- Notre état est les cartes que l'on a
|
||||
debutPartie cartes i = cartes -- On s'en fiche de l'info
|
||||
jouer (MonJeu cartes) pli = (joué, MonJeu (delete joué cartes))
|
||||
where joué = minimum [carte | carte<-cartes, peutJouer carte cartes pli]
|
||||
finTour cartes pli = cartes
|
||||
@ -17,16 +17,16 @@ cabal-version: >=1.10
|
||||
|
||||
library
|
||||
exposed-modules: Cartes, Tarot
|
||||
other-modules:
|
||||
other-modules:
|
||||
-- other-extensions:
|
||||
build-depends: base >=4.11 && <4.12, containers
|
||||
build-depends: base >=4.11 && <4.12, containers, random-shuffle, random, MonadRandom
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
|
||||
executable tarotinator
|
||||
main-is: Main.hs
|
||||
other-modules: Cartes, Tarot
|
||||
other-modules: Cartes, Tarot, TarotIAs
|
||||
-- other-extensions:
|
||||
build-depends: base >=4.11 && <4.12, containers
|
||||
build-depends: base >=4.11 && <4.12, containers, random-shuffle, random, MonadRandom
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user