Discussion :

[GnuVince]

Bonjour,

j'ai écrit une petite librairie pour compter le score d'une main de cribbage en Haskell. J'aimerais avoir des commentaires s'il vous plaît. Pour ceux qui ne savent pas comment compter les points au cribbage, voici un lien qui peut aider: http://www.cribbage.ca/cribbage_points_fr.shtml

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
 
module Cribbage where
 
-- We're going to need bit manipulation for powerset
import Data.Bits
import Data.List
 
data Suit = Clubs | Diamond | Heart | Spade
    -- Ord is needed when we sort cards.  In cribbage, no suit is
    -- stronger than another.
    deriving (Show, Eq, Ord) 
 
data Value = Ace
           | Two
           | Three
           | Four
           | Five
           | Six
           | Seven
           | Eight
           | Nine
           | Ten
           | Jack
           | Queen
           | King
    deriving (Show, Eq, Ord)
 
type Card = (Value, Suit)
type Hand = [Card]
type Starter = Maybe Card
 
suit :: Card -> Suit
suit = snd
 
-- A numerical card has its own value, the ace is worth one,
-- and all figures are worth 10.
value :: Card -> Int
value (val, _) =
    case val of
        Ace   -> 1
        Two   -> 2
        Three -> 3
        Four  -> 4
        Five  -> 5
        Six   -> 6
        Seven -> 7
        Eight -> 8
        Nine  -> 9
        _     -> 10
 
-- This will be needed to figure out if we have a straight later on.
position :: Card -> Int
position (val, _) = 
    case val of
        Ace   -> 0
        Two   -> 1
        Three -> 2
        Four  -> 3
        Five  -> 4
        Six   -> 5
        Seven -> 6
        Eight -> 7
        Nine  -> 8
        Ten   -> 9
        Jack  -> 10
        Queen -> 11
        King  -> 12
 
powerset :: [a] -> [[a]]
powerset l =
    [[l !! j | j <- [0 .. length l], (shiftL 1 j::Int) .&. i > 0]
     | i <- [0 .. 2 ^ (length l) - 1]]
 
 
-- Count all points in a hand
count :: Hand -> Starter -> Bool -> Int
count hand starter isCrib =
    sum [ countPairs hand starter
        , countJack hand starter
        , count15 hand starter
        , countFlush hand starter isCrib
        , countStraight hand starter]
 
-- 1 pair: 2 points
-- 2 pairs: 4 points
-- 3 pairs (3 of a kind): 6 points
-- 6 pairs (4 of a kind): 12 points
countPairs :: Hand -> Starter -> Int
countPairs hand (Just starter) = countPairsAux (starter:hand)
countPairs hand Nothing        = countPairsAux hand
 
countPairsAux :: Hand -> Int
countPairsAux hand =
    length pairs * 2 
        where sets  = powerset [value | (value, _) <- hand]
              pairs = [set | set <- sets, length set == 2 &&
                  (set !! 0) == (set !! 1)]
 
-- One point if the suit of a jack in the hand
-- is the same as the suit of the starter card.
countJack :: Hand -> Starter -> Int
countJack hand Nothing = 0
countJack hand (Just (_, starter_suit)) = 
    if jack then 1 else 0
        where suits = [suit | (value, suit) <- hand, value == Jack]
              jack  = any (== starter_suit) suits
 
 
-- Every combination of cards totaling 15 is worth 2 points.
count15 :: Hand -> Starter -> Int
count15 hand Nothing = count15Aux hand
count15 hand (Just starter) = count15Aux (starter:hand)
 
count15Aux :: Hand -> Int
count15Aux hand =
    length [x | x <- values, sum x == 15] * 2
        where values = powerset [value card | card <- hand]
 
 
-- If every card in a hand are of the same suit, 1 point
-- per hand is awarded.  To be valid in the crib, the 
-- starter card must also be of the same suit.
countFlush :: Hand -> Starter -> Bool -> Int
countFlush hand Nothing _ = countFlushAux hand
countFlush hand (Just starter) True = countFlushAux (starter:hand)
countFlush hand (Just starter) False = 
    maximum [countFlushAux x | x <- [hand, (starter:hand)]]
 
countFlushAux :: Hand -> Int
countFlushAux hand =
    if allSameSuit then length hand else 0
        where suits = map suit hand
              allSameSuit = all (== (head suits)) suits
 
-- Straights of 3 cards and more are worth 1 point per card.
-- Only the longest straights are considered.
countStraight :: Hand -> Starter -> Int
countStraight hand Nothing = countStraightAux hand
countStraight hand (Just starter) = countStraightAux (starter:hand)
 
countStraightAux :: Hand -> Int
countStraightAux hand =
    sum $ map length $ keepLongest straights
        where straights = [straight | straight <- powerset hand,
                           isStraight straight]
 
isStraight :: Hand -> Bool
isStraight l | length l < 3 = False
isStraight l =
    all (== (head values)) values
        where cards = sort l
              values = [e - i | (i, e) <- zip [0..] (map position cards)]
 
keepLongest :: [Hand] -> [Hand]
keepLongest straights = 
    [straight | straight <- straights, length straight == maxLength]
        where maxLength = maximum $ map length straights

[Jedai]

Je vais regarder le reste, mais déjà un powerset un peu plus efficace et joli :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
powerset :: [a] -> [[a]]
powerset [] = [[]]
powerset (x:xs) = map (x:) xxs /\/ xxs
    where xxs = powerset xs
 
infixl 5 /\/
[] /\/ ys = ys
(x:xs) /\/ ys = x:(ys /\/ xs)

C'est un classique, qui est plus facile à comprendre écrit comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
p' :: [a] -> [[a]]
powerset [] = [[]]
powerset (x:xs) = map (x:) xxs ++ xxs
    where xxs = powerset xs

Les parties de (x : xs) sont les parties de xs plus les parties de xs auxquelles on a rajouté x.
(mais le /\/, disons opérateur "d'entrelacement", permet de consommer paresseusement la liste en mémoire constante. Si le symbole ne te plait pas tu peux en changer évidemment ).

--
Jedaï

[Jedai]

Après relecture, c'est à peu près comme ça que je l'aurais écrit (il faut dire que le système de score du cribbage est particulièrement simple et sympathique du point de vue informatique), j'aurais peut-être fait moins usage des compréhensions de liste...

Je te donne ce que j'ai fait après un passage :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
module Cribbage where
 
import Data.List
 
data Suit = Clubs | Diamond | Heart | Spade
    -- Ord is needed when we sort cards.  In cribbage, no suit is
    -- stronger than another.
    deriving (Show, Eq, Ord) 
 
data Value = Ace
           | Two
           | Three
           | Four
           | Five
           | Six
           | Seven
           | Eight
           | Nine
           | Ten
           | Jack
           | Queen
           | King
    deriving (Show, Eq, Ord, Enum)
 
type Card = (Value, Suit)
type Hand = [Card]
type Starter = Maybe Card
 
suit :: Card -> Suit
suit = snd
 
isFigure :: Card -> Bool
isFigure (val, _) = case val of
                      Jack -> True
                      King -> True
                      Queen -> True
                      _ -> False
 
-- A numerical card has its own value, the ace is worth one,
-- and all figures are worth 10.
value :: Card -> Int
value c = if isFigure c then 10 else fromEnum (fst c) + 1
 
-- This will be needed to figure out if we have a straight later on.
position :: Card -> Int
position (val, _) = fromEnum val
 
powerset :: [a] -> [[a]]
powerset [] = [[]]
powerset (x:xs) = map (x:) xxs /\/ xxs
    where xxs = powerset xs
 
infixl 5 /\/
(/\/) :: [a] -> [a] -> [a]
[] /\/ ys = ys
(x:xs) /\/ ys = x:(ys /\/ xs)
 
-- Count all points in a hand
count :: Hand -> Starter -> Bool -> Int
count hand starter isCrib =
    sum [ countPairs hand starter
        , countJack hand starter
        , count15 hand starter
        , countFlush hand starter isCrib
        , countStraight hand starter]
 
-- 1 pair: 2 points
-- 2 pairs: 4 points
-- 3 pairs (3 of a kind): 6 points
-- 6 pairs (4 of a kind): 12 points
countPairs :: Hand -> Starter -> Int
countPairs hand (Just starter) = countPairsAux (starter:hand)
countPairs hand Nothing        = countPairsAux hand
 
countPairsAux :: Hand -> Int
countPairsAux hand = sum [2 |(v:vs) <- tails hand, val <- filter (==v) vs]
 
-- One point if the suit of a jack in the hand
-- is the same as the suit of the starter card.
countJack :: Hand -> Starter -> Int
countJack hand Nothing = 0
countJack hand (Just (_, starter_suit)) = 
    length [suit | (val, suit) <- hand, val == Jack, suit == starter_suit]
 
 
-- Every combination of cards totaling 15 is worth 2 points.
count15 :: Hand -> Starter -> Int
count15 hand Nothing = count15Aux hand
count15 hand (Just starter) = count15Aux (starter:hand)
 
count15Aux :: Hand -> Int
count15Aux hand =
    sum [2 | x <- values, sum x == 15]
        where values = powerset $ map value hand
 
 
-- If every card in a hand are of the same suit, 1 point
-- per hand is awarded.  To be valid in the crib, the 
-- starter card must also be of the same suit.
countFlush :: Hand -> Starter -> Bool -> Int
countFlush hand Nothing _ = countFlushAux hand
countFlush hand (Just starter) True = countFlushAux (starter:hand)
countFlush hand (Just starter) False = 
    maximum [countFlushAux x | x <- [hand, (starter:hand)]]
 
countFlushAux :: Hand -> Int
countFlushAux hand =
    if allSameSuit then length hand else 0
        where suits = map suit hand
              allSameSuit = all (== (head suits)) suits
 
-- Straights of 3 cards and more are worth 1 point per card.
-- Only the longest straights are considered.
countStraight :: Hand -> Starter -> Int
countStraight hand Nothing = countStraightAux hand
countStraight hand (Just starter) = countStraightAux (starter:hand)
 
countStraightAux :: Hand -> Int
countStraightAux hand =
    sum $ map length $ keepLongest straights
        where straights = [straight | straight <- powerset hand,
                           isStraight straight]
 
isStraight :: Hand -> Bool
isStraight l 
    | length l < 3 = False
    | otherwise =
        all (== (head values)) values
    where values = zipWith (-) (map position $ sort l) [0..]
 
keepLongest :: [Hand] -> [Hand]
keepLongest straights = 
    filter ((== maxLength) . length) straights
        where maxLength = maximum $ map length straights

Si je devais mettre en valeur deux points, ce serait zipWith (à la place d'une compréhension de liste avec zip), et le derive (Enum) qui t'économise de faire des grandes alternatives. Sinon quelques petits détails, comme la recherche de paires, pour laquelle le powerset est un peu excessif....

--
Jedaï

[GnuVince]

Merci Jedaï. Je connaissais pas la class Enum, mais ça aide définitivement. Pour le powerset, j'ai recopié verbatim de ma version en Python (dans laquelle j'utilise le truc binaire pour éviter un stack overflow), mais ta fonction est définitivement plus jolie (si on exclu le /\/ )

J'examine le code que tu m'a donné, et si j'ai des questions, ben je vais me les poser avant de revenir ici

[Jedai]

Par rapport à ta remarque sur Ord et les Suits, je pense qu'il serait préférable d'écrire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

values = zipWith (-) (sort . map position $ l) [0..]

dans ton code sur les suites, ce qui évite d'imposer une instance arbitraire de Ord sur les Suits.

(D'un autre côté tu pourrais avoir besoin d'afficher une main un minimum classée et si tu retire l'ordre sur les Suits, tu ne peux plus faire un truc avec un simple sort, quoique "concatMap (sortBy (comparing position)) . groupBy suit" soit sans doute mieux de toute façon.

--
Jedaï

[gasche]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
keepLongest :: [Hand] -> [Hand]
keepLongest straights = 
    filter ((== maxLength) . length) straights
        where maxLength = maximum $ map length straights

En hooglant un peu, on trouve (potentiellement dans Data.List) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
keepLongest :: [Hand] -> [Hand]
keepLongest straights = maximumBy (comparing length) straights

Sinon, au survol du code de Jedai, j'ai l'impression que ça pourrait valoir le coup de factoriser les trucs du genre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
count15 hand Nothing = count15Aux hand
count15 hand (Just starter) = count15Aux (starter:hand)