Poker en Haskell

une approche constructive

Nous allons aborder le problème du poker (cf introduction du traitement avec Python) de manière cette fois constructive : nous allons créer les mains de Poker pour ensuite les compter, ce qui correspond à la démarche utilisée en cours de mathématique, une fois qu'ont été introduites les combinaisons.

Nous utiliserons pour illustrer notre propos le langage Haskell qui appartient à la famille des langages fonctionnels donc très proche du langage mathématique. On en trouvera une introduction ludique sur cette page.

Ce type de programmation peut paraître déroutant car il ne correspond pas aux canons des langages impératifs des années 1950 habituellement enseignés. Il est beaucoup plus moderne et influence d'autres langages comme Python et surtout Scala. Il est surtout pour nous beaucoup plus proche de la mathématique, et moderne comme l'annonçait dès 1978 John Backus dans son célèbre article de réception du prix Turing.
Les fonctions proposées dans cet article sont sûrement ardues par leur concision pour des élèves de lycée mais sont indispensables pour la culture mathématique et informatique de leurs professeurs.

types de données algébriques

Nous allons implémenter nos jeux de cartes en créant des types (cf le chapitre consacrés aux types algébriques sur LYAH) pour introduire les couleurs, les hauteurs, les cartes, les mains. On peut considérer les types que nous allons utiliser comme des ensembles ordonnés.

Le mot-clé est Data qui permet d'introduire un nouveau type de données:

Haskell
data Couleur = Trefle | Carreau | Coeur | Pique 
             deriving (Eq, Ord, Show, Read, Bounded, Enum)

On rentre les couleurs dans l'ordre du jeu de bridge. Sans chercher à rentrer dans les détails, disons que la deuxième ligne indique qu'on pourra faire des tests d'égalité (Eq), d'ordre (Ord), qu'on pourra afficher les éléments du type (Show), les lire à partir de chaînes de caractères (Read), qu'ils sont bornés (Bounded) et qu'on pourra les énumérer (Enum). Pour plus de détails sur la dérivation de classes, voir ce chapitre.

Haskell
*Main> succ Trefle
Carreau
*Main> [Trefle .. Pique]
[Trefle,Carreau,Coeur,Pique]
*Main> [Trefle .. ]
[Trefle,Carreau,Coeur,Pique]
*Main> [Carreau .. ]
[Carreau,Coeur,Pique]
*Main> pred Pique
Coeur

On fait de même pour les hauteurs:

Haskell
data Hauteur = Deux | Trois | Quatre | Cinq | Six | Sept | Huit | Neuf | Dix | Valet | Dame | Roi | As 
            deriving(Eq, Ord, Show, Read, Bounded, Enum)

Alors, par exemple:

Haskell
*Main> [Sept ..]
[Sept,Huit,Neuf,Dix,Valet,Dame,Roi,As]
*Main> length [Deux ..]
13

Ensuite, pour clarifier le code, nous allons créer des synonymes de types pour désigner une carte qui sera un couple (Hauteur,Couleur) et une main qui sera une liste de cartes:

Haskell
type Carte = (Hauteur,Couleur)
 
type Main = [Carte]

Cela nous permet alors, avec, comme en Python (qui s'en est inspiré...), des listes par compréhension, de créer un jeu de cartes en donnant la hauteur de départ (généralement 2 ou 7). On a l'habitude en Haskell, même si ce n'est pas obligatoire, de déclarer le type de la fonction que l'on va créer, pour clarifier le code. La petite flèche vers la gauche indique qu'on va prendre les hauteurs des cartes dans l'ensemble qui est à droite, c'est-à-dire ici toutes les hauteurs de début jusqu'à As:

Haskell
jeu :: Hauteur -> [Carte]
jeu debut = [(hauteur,couleur) | hauteur <- [debut .. As], couleur <- [Trefle .. ]]

Par exemple:

Haskell
*Main> jeu Sept
[(Sept,Trefle),(Sept,Carreau),(Sept,Coeur),(Sept,Pique),
 (Huit,Trefle),(Huit,Carreau),(Huit,Coeur),(Huit,Pique),
 (Neuf,Trefle),(Neuf,Carreau),(Neuf,Coeur),(Neuf,Pique),
 (Dix,Trefle),(Dix,Carreau),(Dix,Coeur),(Dix,Pique),
 (Valet,Trefle),(Valet,Carreau),(Valet,Coeur),(Valet,Pique),
 (Dame,Trefle),(Dame,Carreau),(Dame,Coeur),(Dame,Pique),
 (Roi,Trefle),(Roi,Carreau),(Roi,Coeur),(Roi,Pique),
 (As,Trefle),(As,Carreau),(As,Coeur),(As,Pique)]
*Main> length (jeu Sept)
32
*Main> length (jeu Deux)
52

Nous aurons également besoin de trouver toutes les cartes d'une même hauteur donnée en argument. Hop, un coup de liste par compréhension... Il nous faut en effet l'ensemble:

$$\big\{ (h,c) \mid c \in \{Trefle, Carreau, Coeur, Pique\}\big\}$$

Haskell
meme_hauteur :: Hauteur -> [Carte]
meme_hauteur    h        = [ (h,c) | c <- [Trefle .. ] ]

En n'oubliant pas que [ Trefle .. ] est un petit sucre syntaxique pour représenter [Trefle,Carreau,Coeur,Pique].

Nous pouvons obtenir de même l'ensemble des cartes ayant une couleur donnée. Nous devons rajouter la première hauteur en argument car les choses ne sont pas les mêmes avec 32 ou 52 cartes:

Haskell
meme_couleur :: Couleur -> Hauteur -> [Carte]
meme_couleur    c          debut   =  [ (h,c) | h <- [ debut .. ] ]

outils de dénombrement

Il est primordial dans ce problème de poker de savoir compter le nombre de combinaisons. Par exemple, dans un jeu de 32 cartes il y a $32 \choose 5$ sous-ensembles (ou mains) de 5 cartes.

On va utiliser la fonction subsequences de Haskell qui renvoie la liste des sous-ensembles d'une liste. Il faudra tout d'abord l'importer de la bibliothèque Data.List en plaçant

Haskell
import Data.List (subsequences)

en tête de notre fichier.

Haskell
*Main> subsequences [1,2,3]
[[],[1],[2],[1,2],[3],[1,3],[2,3],[1,2,3]]

Parmi toutes les parties d'un ensemble, nous ne nous intéresserons qu'à celles d'une longueur donnée. Nous utiliserons alors la fonction basique filter qui filtre une liste selon un prédicat (cf cette page ), c'est-à-dire selon une fonction qui renvoie un booléen.

Par exemple:

Haskell
*Main> filter (\x -> x > 3) [1,2,3,4,5,6,7]
[4,5,6,7]
*Main> filter (\x -> mod x 2 == 0) [1,2,3,4,5,6,7]
[2,4,6]

Pour avoir les combinaisons de k éléments d'une liste, il faudra donc ne garder parmi les sous-ensembles que ceux qui sont de cardinal (obtenu avec length) k:

Haskell
combinaisons :: Int -> [a]   -> [[a]]
combinaisons    k      liste =  filter (\partie -> (length partie) == k) (subsequences liste)

Par exemple:

Haskell
*Main> combinaisons 3 [1,2,3,4,5]
[[1,2,3],[1,2,4],[1,3,4],[2,3,4],[1,2,5],[1,3,5],[2,3,5],[1,4,5],[2,4,5],[3,4,5]]

comptons les carrés

Un carré est une main qui contient quatre cartes de même hauteur et une carte libre.
On peut commencer par les classer par la donnée de la hauteur du carré et de la hauteur de la carte libre.
Par exemple, la hauteur du carré étant 7 et celle de la carte libre 10, les éléments de cet ensemble de mains sont:

  • (7T,7K,7C,7P,10T)
  • (7T,7K,7C,7P,10K)
  • (7T,7K,7C,7P,10C)
  • (7T,7K,7C,7P,10P)

Nous obtenons ainsi des petits ensembles de mains qui vont réaliser une partition de l'ensemble des mains de carrés :

Haskell
carres_par_hauteurs :: Hauteur -> Hauteur -> [Main]
carres_par_hauteurs    h1         h2      =  [libre:carre | 
                                              carre <- combinaisons 4 (meme_hauteur h1), 
                                              libre <- meme_hauteur h2 
                                             ]   

Il faut noter l'emploi du : qui est le constructeur de liste sur Haskell, mais ceci est une autre histoire. Nous retiendrons seulement que cela permet de rajouter un élément à une liste:

Haskell
*Main> 1 : [3,4,5]
[1,3,4,5]
*Main> 1 : 2 : [3,4,5]
[1,2,3,4,5]

Pour reprendre notre exemple:

Haskell
*Main> carres_par_hauteurs Sept Dix
[ [(Dix,Trefle),(Sept,Trefle),(Sept,Carreau),(Sept,Coeur),(Sept,Pique)],
  [(Dix,Carreau),(Sept,Trefle),(Sept,Carreau),(Sept,Coeur),(Sept,Pique)],
  [(Dix,Coeur),(Sept,Trefle),(Sept,Carreau),(Sept,Coeur),(Sept,Pique)],
  [(Dix,Pique),(Sept,Trefle),(Sept,Carreau),(Sept,Coeur),(Sept,Pique)]
]

Ensuite, comptons ces carrés : il faut choisir une hauteur de carré, 4 cartes dans cette hauteur puis une hauteur parmi celles qui restent et une carte dans cette hauteur. Par exemple, pour 32 cartes :

$${8 \choose 1}\times {4 \choose 4} \times {7 \choose 1}\times {4 \choose 1}=224$$

On va suivre le même chemin ici. Il reste à traiter le « une hauteur parmi celles qui restent ». On va utiliser l'opérateur \\ qui correspond à la soustraction des ensembles («...privé de...») qu'il faut charger depuis Data.List. Nous mettrons donc en tête du fichier :

Haskell
import Data.List (subsequences,(\\))

Nous utiliserons enfin la fonction sum qui calcule la somme des éléments d'une liste:

Haskell
*Main> sum ([1,2,3,4,5] \\ [4,5])
6

Il n'y a donc plus qu'à traduire presque littéralement le calcul effectué sur les coefficients binomiaux:

Haskell
nb_carres :: Hauteur -> Int
nb_carres    debut   = sum [ length (carres_par_hauteurs h1 h2) | 
                             h1 <- hauteurs, 
                             h2 <- (hauteurs \\ [ h1 ]) ] 
  where hauteurs = [debut ..]

Alors, comme prévu:

Haskell
*Main> nb_carres Sept
224
*Main> nb_carres Deux
624

brelans, paires, full

full

Un Full peut être représenté par deux hauteurs : celle du brelan et celle de la paire.

Il s'agit de choisir une hauteur pour le brelan, trois cartes parmi 4 dans cette hauteur, une autre hauteur pour la paire et deux cartes dans cette hauteur. Par exemple, pour 32 cartes:

$$
{8 \choose 1}\times {4 \choose 3} \times {7 \choose 1} \times {4 \choose 2} = 1344
$$

On procède encore en deux étapes. On notera que ++ permet de concaténer deux chaînes:

Haskell
*Main> ["OK"] ++ ["Corral"]
["OK","Corral"]
*Main> "OK " ++ "Corral"
"OK Corral"

Revenons aux Full:

Haskell
full_par_hauteurs :: Hauteur -> Hauteur -> [Main]
full_par_hauteurs h1 h2 = [ trois ++ deux | 
                            trois <- combinaisons 3 (meme_hauteur h1), 
                            deux  <- combinaisons 2 (meme_hauteur h2)] 

Par exemple:

Haskell
*Main> full_par_hauteurs Sept As
[[(Sept,Trefle),(Sept,Carreau),(Sept,Coeur),(As,Trefle),(As,Carreau)],
 [(Sept,Trefle),(Sept,Carreau),(Sept,Coeur),(As,Trefle),(As,Coeur)],
 [(Sept,Trefle),(Sept,Carreau),(Sept,Coeur),(As,Carreau),(As,Coeur)],
 [(Sept,Trefle),(Sept,Carreau),(Sept,Coeur),(As,Trefle),(As,Pique)],
 [(Sept,Trefle),(Sept,Carreau),(Sept,Coeur),(As,Carreau),(As,Pique)],
 [(Sept,Trefle),(Sept,Carreau),(Sept,Coeur),(As,Coeur),(As,Pique)],
 [(Sept,Trefle),(Sept,Carreau),(Sept,Pique),(As,Trefle),(As,Carreau)],
 [(Sept,Trefle),(Sept,Carreau),(Sept,Pique),(As,Trefle),(As,Coeur)],
 [(Sept,Trefle),(Sept,Carreau),(Sept,Pique),(As,Carreau),(As,Coeur)],
 [(Sept,Trefle),(Sept,Carreau),(Sept,Pique),(As,Trefle),(As,Pique)],
 [(Sept,Trefle),(Sept,Carreau),(Sept,Pique),(As,Carreau),(As,Pique)],
 [(Sept,Trefle),(Sept,Carreau),(Sept,Pique),(As,Coeur),(As,Pique)],
 [(Sept,Trefle),(Sept,Coeur),(Sept,Pique),(As,Trefle),(As,Carreau)],
 [(Sept,Trefle),(Sept,Coeur),(Sept,Pique),(As,Trefle),(As,Coeur)],
 [(Sept,Trefle),(Sept,Coeur),(Sept,Pique),(As,Carreau),(As,Coeur)],
 [(Sept,Trefle),(Sept,Coeur),(Sept,Pique),(As,Trefle),(As,Pique)],
 [(Sept,Trefle),(Sept,Coeur),(Sept,Pique),(As,Carreau),(As,Pique)],
 [(Sept,Trefle),(Sept,Coeur),(Sept,Pique),(As,Coeur),(As,Pique)],
 [(Sept,Carreau),(Sept,Coeur),(Sept,Pique),(As,Trefle),(As,Carreau)],
 [(Sept,Carreau),(Sept,Coeur),(Sept,Pique),(As,Trefle),(As,Coeur)],
 [(Sept,Carreau),(Sept,Coeur),(Sept,Pique),(As,Carreau),(As,Coeur)],
 [(Sept,Carreau),(Sept,Coeur),(Sept,Pique),(As,Trefle),(As,Pique)],
 [(Sept,Carreau),(Sept,Coeur),(Sept,Pique),(As,Carreau),(As,Pique)],
 [(Sept,Carreau),(Sept,Coeur),(Sept,Pique),(As,Coeur),(As,Pique)]]

Il reste à les compter:

Haskell
nb_full :: Hauteur -> Int
nb_full debut = sum [length (full_par_hauteurs h1 h2) | 
                      h1 <- hauteurs, 
                      h2 <- (hauteurs \\ [ h1 ])] 
  where hauteurs = [debut ..]

Comptons:

Haskell
*Main> nb_full Sept
1344
*Main> nb_full Deux
3744

brelans

Cela commence toujours un peu pareil, avec maintenant trois cartes de même hauteur et deux cartes libres à prendre dans les hauteurs qui restent. Pour le choix des hauteurs, on veillera à prendre toutes les combinaisons de deux hauteurs parmi toutes celles qui ne sont pas celles du brelan. Pour 32 cartes :

$$
{8 \choose 1}\times{4 \choose 3}\times {7\choose 2}\times {4\choose 1}^2=10\,752
$$

Haskell
brelans_par_hauteurs :: Hauteur -> Hauteur -> Hauteur -> [Main]
brelans_par_hauteurs h1 h2 h3 = [ libre1:libre2:trois | 
                                  trois  <- combinaisons 3 (meme_hauteur h1), 
                                  libre1 <- meme_hauteur h2, 
                                  libre2 <- meme_hauteur h3]   
 
nb_brelans :: Hauteur -> Int
nb_brelans debut = sum [length (brelans_par_hauteurs h1 h2 h3) | 
                        h1      <- hauteurs, 
                        [h2,h3] <- combinaisons 2 (hauteurs \\ [ h1 ])] 
  where hauteurs = [debut ..]

On obtient:

Haskell
*Main> nb_brelans Sept
10752
*Main> nb_brelans Deux
54912

doubles paires

Toujours la même idée... Pour 32 cartes:

$$
{8 \choose 2} \times {4\choose 2}^2\times {6 \choose 1}\times {4\choose 1}=24\,192
$$

Avec Haskell:

Haskell
double_paire_par_hauteurs :: Hauteur -> Hauteur -> Hauteur -> [Main]
double_paire_par_hauteur h1 h2 h3 = 
  [ libre:paire1++paire2 | 
    paire1 <- combinaisons 2 (meme_hauteur h1), 
    paire2 <- combinaisons 2 (meme_hauteur h2),
    libre  <- meme_hauteur h3 ]   
  
nb_deux_paires :: Hauteur -> Int
nb_deux_paires debut = sum [length (double_paire_par_hauteurs h1 h2 h3) | 
                            [h1,h2] <- combinaisons 2 hauteurs,
                            h3      <- hauteurs \\ [h1,h2]]
  where hauteurs = [debut ..]

Ce qui donne:

Haskell
*Main> nb_doubles_paires Sept
24192
*Main> nb_doubles_paires Deux
123552

paires

Toujours la même idée... Pour 32 cartes:

$$
{8 \choose 1} \times {4\choose 2}\times {7 \choose 3}\times {4\choose 1}^3=107\,520
$$

Avec Haskell:

Haskell
paires_par_hauteurs :: Hauteur -> Hauteur -> Hauteur -> Hauteur -> [Main]
paires_par_hauteurs h1 h2 h3 h4 = [ libre1:libre2:libre3:paire | 
                                    paire <- combinaisons 2 (meme_hauteur h1), 
                                    libre1  <- meme_hauteur h2,
                                    libre2  <- meme_hauteur h3,
                                    libre3  <- meme_hauteur h3]   
 
nb_paires :: Hauteur -> Int
nb_paires debut = sum [length (paires_par_hauteurs h1 h2 h3 h4) | 
                       h1         <- hauteurs,
                       [h2,h3,h4] <- combinaisons 3 (hauteurs \\ [ h1 ])]
  where hauteurs = [debut ..]

Ce qui donne:

Haskell
*Main> nb_paires Sept
107520
*Main> nb_paires Deux
1098240

couleurs et quintes

Cela se complique un peu car il faut distinguer les couleurs qui ne sont pas des quintes et vice-versa...Le plus simple est de commencer par les quintes flush.

les quintes flush

On construit les différents niveaux de suites (cinq cartes dont les hauteurs se suivent, en donnant le plus petit niveau de la suite). La plus haute suite commence à Dix. On utilise la fonction take qui permet de prendre les premiers éléments d'une suite:

Haskell
niveaux_de_suites :: Hauteur -> [[Hauteur]]
niveaux_de_suites debut = [take 5 [start .. ] | start <- [debut .. Dix] ] 

Par exemple, à 32 cartes:

Haskell
*Main> niveaux_de_suites Sept
[[Sept,Huit,Neuf,Dix,Valet],
 [Huit,Neuf,Dix,Valet,Dame],
 [Neuf,Dix,Valet,Dame,Roi],
 [Dix,Valet,Dame,Roi,As]]

Pour avoir le nombre de quintes flush, il suffit ensuite de multiplier par le nombre de couleurs:

Haskell
nb_quintes_flush :: Hauteur -> Int
nb_quintes_flush    debut   = 
  (length (niveaux_de_suites debut)) * (length [Trefle ..])

les couleurs

Pour avoir les différentes mains de couleurs, on compte combien on peut en obtenir par couleur: il faut choisir cinq cartes parmi tous les niveaux d'une couleur puis faire ça pour chaque couleur et enlever les quintes flush. À 32 cartes:

$$
{8 \choose 5} \times 4 - 4\times 4=208
$$

Haskell
les_mains_par_couleur :: Hauteur -> Couleur -> [Main]
les_mains_par_couleur    debut      couleur = 
  combinaisons 5 (meme_couleur couleur debut)
 
nb_couleurs :: Hauteur -> Int
nb_couleurs    debut   = 
  (sum [length (les_mains_par_couleur debut couleur) | 
        couleur <- [Trefle ..]]) 
  - (nb_quintes_flush debut)

On obtient:

Haskell
*Main> nb_couleurs Sept
208
*Main> nb_couleurs Deux
5112

les quintes

Le plus dur pour la fin...

On va d'abord construire toutes les combinaisons avec répétitions des couleurs présentes dans un ordre donné dans une main de cinq cartes. On prend soin d'enlever les paquets de couleur uniforme pour éviter les quintes flush:

Haskell
les_paquets_couleurs :: [[Couleur]]
les_paquets_couleurs =  [[a,b,c,d,e] | 
                         a <- coul, 
                         b <- coul, 
                         c <- coul, 
                         d <- coul, 
                         e <- coul ] 
                       \\ [[c,c,c,c,c] | c <- coul]
  where coul = [Trefle ..]

Pour dresser la liste des quintes, on va fusionner les cinq niveaux d'une suite et les cinq couleurs avec la fonction zip qui prend deux listes en argument et renvoie la liste des couples formés d'un élément de la première liste et d'un autre de la deuxième.

Par exemple:

Haskell
*Main> zip [1,2,3] ['a','b','c']
[(1,'a'),(2,'b'),(3,'c')]

Ici, cela donne:

Haskell
les_quintes :: Hauteur -> [Main]
les_quintes debut = [ zip h c | 
                      h <- (niveaux_de_suites debut), 
                      c <- les_paquets_couleurs ] 

Il ne reste plus qu'à les compter:

Haskell
nb_quintes :: Hauteur -> Int
nb_quintes debut = length (les_quintes debut)

et on obtient:

Haskell
*Main> nb_quintes Sept
4080
*Main> nb_quintes Deux
9180

le code complet

Haskell
------------------------------------------------------------------------------------------
-- Last modified: <poker.hs modifié par  Guillaume CONNAN le vendredi 4 octobre 2013 à 00h 15min 33s>
--
--            P O K E R  :  D É N O M B R E M E N T   D E S    M A I N S
--
--
--------------------------------------------------------------------------------------------
 
import Data.List (subsequences,(\\))
 
data Couleur = Trefle | Carreau | Coeur | Pique 
             deriving (Eq,Ord, Show,Read, Bounded, Enum)
 
data Hauteur = Deux | Trois | Quatre | Cinq | Six | Sept | Huit | Neuf | Dix | Valet | Dame | Roi | As 
            deriving(Eq,Ord, Show,Read, Bounded, Enum)
 
type Carte = (Hauteur,Couleur)
 
type Main = [Carte]
 
-- renvoie la liste des cartes selon le début des valeurs, habituellement Deux ou Sept
jeu :: Hauteur -> [Carte]
jeu debut = [(haut,coul) | haut <- [debut .. As], coul <- [Trefle .. ]]
 
 
-- renvoie la liste des combinaisons de longueur k des élements de liste                    
combinaisons :: Int -> [a] -> [[a]]
combinaisons k liste = filter ((k==).length) (subsequences liste)
 
 
-- Version sans utiliser subsequences
--combinaisons2 :: Int -> [a] -> [[a]]
--combinaisons2 0 _  = [[]]
--combinaisons2 _ [] = []
--combinaisons2 n (x:xs) = (map (x:) (combinaisons (n-1) xs)) ++ (combinaisons n xs)
 
 
-- renvoie la liste des cartes de même hauteur
meme_hauteur :: Hauteur -> [Carte]
meme_hauteur h = [(h,c) | c <- [Trefle ..]]
 
-- renvoie la liste des cartes de même couleur
meme_couleur :: Couleur -> Hauteur -> [Carte]
meme_couleur c debut = [(h,c) | h <- [debut ..]]
                 
                       
 
{- dresse la liste des mains contenant des carrés 
de hauteur h1 avec une carte libre de hauteur h2-}
carres_par_hauteurs :: Hauteur -> Hauteur -> [Main]
carres_par_hauteurs    h1         h2      =  [ libre:carre | 
                                               carre <- combinaisons 4 (meme_hauteur h1), 
                                               libre <- meme_hauteur h2 
                                             ]   
 
-- compte les mains contenant des carrés
nb_carres :: Hauteur -> Int
nb_carres    debut   = sum [ length (carres_par_hauteurs h1 h2) | 
                             h1 <- hauteurs, 
                             h2 <- (hauteurs \\ [h1])
                                                                ] 
  where hauteurs = [debut ..]
        
-- dresse la liste des mains contenant des full des h1 par les h2
full_par_hauteurs :: Hauteur -> Hauteur -> [Main]
full_par_hauteurs h1 h2 = [ trois ++ deux | 
                            trois <- combinaisons 3 (meme_hauteur h1), 
                            deux  <- combinaisons 2 (meme_hauteur h2)] 
                          
-- compte les mains contenant des full
nb_full :: Hauteur -> Int
nb_full debut = sum [length (full_par_hauteurs h1 h2) | 
                      h1 <- hauteurs, 
                      h2 <- (hauteurs \\ [h1])] 
  where hauteurs = [debut ..]
        
-- dresse la liste des mains contenant des brelans de h1 avec des cartes libres de hauteurs h2 et h3
brelans_par_hauteurs :: Hauteur -> Hauteur -> Hauteur -> [Main]
brelans_par_hauteurs h1 h2 h3 = [ libre1:libre2:trois | 
                                  trois  <- combinaisons 3 (meme_hauteur h1), 
                                  libre1 <- meme_hauteur h2, 
                                  libre2 <- meme_hauteur h3]   
 
-- compte les mains contenant des brelans
nb_brelans :: Hauteur -> Int
nb_brelans debut = sum [length (brelans_par_hauteurs h1 h2 h3) | 
                        h1      <- hauteurs, 
                        [h2,h3] <- combinaisons 2 (hauteurs \\ [h1])] 
  where hauteurs = [debut ..]
 
-- dresse la liste des mains contenant des doubles paires des h1 par les h2 avec une carte libre de hauteur h3
double_paire_par_hauteurs :: Hauteur -> Hauteur -> Hauteur -> [Main]
double_paire_par_hauteurs h1 h2 h3 = 
  [ libre:paire1++paire2 | 
    paire1 <- combinaisons 2 (meme_hauteur h1), 
    paire2 <- combinaisons 2 (meme_hauteur h2),
    libre  <- meme_hauteur h3 ]   
  
-- compte les mains contenant des doubles paires
nb_doubles_paires :: Hauteur -> Int
nb_doubles_paires debut = sum [length (double_paire_par_hauteurs h1 h2 h3) | 
                            [h1,h2] <- combinaisons 2 hauteurs,
                            h3      <- hauteurs \\ [h1,h2]]
  where hauteurs = [debut ..]
                   
-- dresse la liste des mains contenant des paires de h1, les autres hauteurs étant celles des cartes libres
paires_par_hauteurs :: Hauteur -> Hauteur -> Hauteur -> Hauteur -> [Main]
paires_par_hauteurs h1 h2 h3 h4 = [ libre1:libre2:libre3:paire | 
                                    paire <- combinaisons 2 (meme_hauteur h1), 
                                    libre1  <- meme_hauteur h2,
                                    libre2  <- meme_hauteur h3,
                                    libre3  <- meme_hauteur h3]   
 
-- compte les mains contenant des paires
nb_paires :: Hauteur -> Int
nb_paires debut = sum [length (paires_par_hauteurs h1 h2 h3 h4) | 
                       h1         <- hauteurs,
                       [h2,h3,h4] <- combinaisons 3 (hauteurs \\ [h1])]
  where hauteurs = [debut ..]
        
 
 
 
 
 
 
 
 
-- renvoie la liste des suites possibles
niveaux_de_suites :: Hauteur -> [[Hauteur]]
niveaux_de_suites debut = [take 5 [start .. ] | start <- [debut .. Dix] ] 
 
-- dresse la liste des mains contenant des quintes flush
--les_quintes_flush :: Hauteur -> [Main]
--les_quintes_flush debut = [ zip h (repeat c) | 
--                            h <- (les_suites debut), 
--                           c <- [Trefle ..] ] 
 
-- compte les mains contenant des  quintes flush
nb_quintes_flush :: Hauteur -> Int
nb_quintes_flush    debut   = 
  (length (niveaux_de_suites debut)) * (length [Trefle ..])
 
-- dresse la liste des mains d'une couleur donnée
les_mains_par_couleur :: Hauteur -> Couleur -> [Main]
les_mains_par_couleur    debut      couleur = 
  combinaisons 5 (meme_couleur couleur debut)
 
-- compte les mains contenant des couleurs
nb_couleurs :: Hauteur -> Int
nb_couleurs    debut   = 
  (sum [length (les_mains_par_couleur debut couleur) | 
        couleur <- [Trefle ..]]) 
  - (nb_quintes_flush debut)
 
-- dresse la liste de toutes les combinaisons avec répétition de cinq couleurs parmi les 4 
les_paquets_couleurs :: [[Couleur]]
les_paquets_couleurs =  [[a,b,c,d,e] | 
                         a <- coul, 
                         b <- coul, 
                         c <- coul, 
                         d <- coul, 
                         e <- coul ] 
                       \\ [[c,c,c,c,c] | c <- coul]
  where coul = [Trefle ..]
 
-- dresse la liste des mains contenant des
les_quintes :: Hauteur -> [Main]
les_quintes debut = [ zip h c | 
                      h <- (niveaux_de_suites debut), 
                      c <- les_paquets_couleurs ] 
 
-- compte les mains contenant des 
nb_quintes :: Hauteur -> Int
nb_quintes debut = length (les_quintes debut)

courtesy of webmatter.de