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)

[GnuVince]

bluestorm: Je suis pas certain de savoir comment factoriser ça. Peut-être quelque chose du genre:

Code :

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

1
2
3
4
5
6
 
makeCounter :: Hand -> Starter -> (Hand -> Int) -> Int
makeCounter hand Nothing f = f hand
makeCounter hand (Just starter) f = f (starter:hand)
 
count15 hand starter = makeCounter hand starter count15Aux

Qu'en penses-tu?

[gasche]

Disclaimer : je connais pas les règles du jeu, et je survole le code, donc je risque de dire des conneries.

J'ai l'impression que l'information du "Starter" est utilisée que dans un seul cas, countJack. Dans tout le reste, on utilise juste hand et starter comme une seule liste.

Si cette analyse est correcte (cf. disclaimer), je pense qu'on peut carrément gérer le problème à la racine :

Code :

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

1
2
3
4
5
6
7
8
9
-- Count all points in a hand
count :: Hand -> Starter -> Bool -> Int
count hand starter isCrib =
    let hand' = maybeToList starter ++ hand in
    sum [ countPairs hand'
        , countJack hand starter
        , count15 hand'
        , countFlush hand' isCrib
        , countStraight hand']

(en adaptant évidemment les fonctions concernées)

[Jedai]

En fait pas exactement, countFlush fait un usage particulier du Starter, il faudrait le remanier un peu, mais je pense que sinon tu as raison, et ça éviterait un tas de fonction auxiliaire peu intéressantes.

--
Jedaï

[Jedai]

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

Pas exactement, maximumBy ne renvoie qu'un élément, alors qu'on veut garder toutes les suites de la longueur de la plus longue. ce serait plutôt :

Code :

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

keepLongest = last . groupBy ((==) `on` length) . sortBy (comparing length)

Et là je ne sais pas si on a gagné en lisibilité, on a certainement perdu en efficacité (m'enfin vu la taille des listes, ça doit être parfaitement négligeable).

EDIT : En fait, avec la paresse, la solution suivante est sans doute pas trop mauvaise, avec un peu de chance elle a pratiquement une complexité linéaire en moyenne :

Code :

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

keepLongest = head . groupBy ((==) `on` length) . sortBy (flip $ comparing length)

--
Jedaï

[GnuVince]

Voici où j'en suis après vos suggestions:

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
 
module Cribbage where
 
import Data.List
import Data.Maybe
 
data Suit = Clubs | Diamond | Heart | Spade
   deriving (Show, Eq)
 
data Rank = Ace
          | Two
          | Three
          | Four
          | Five
          | Six
          | Seven
          | Eight
          | Nine
          | Ten
          | Jack
          | Queen
          | King
   deriving (Show, Eq, Enum)
 
type Card    = (Rank, Suit)
type Hand    = [Card]
type Starter = Maybe Card
 
rank :: Card -> Rank
rank = fst
 
suit :: Card -> Suit
suit = snd
 
isFigure :: Card -> Bool
isFigure (rank, _) =
   case rank of
       Jack  -> True
       Queen -> True
       King  -> 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 | isFigure c = 10
        | otherwise  = fromEnum (fst c) + 1
 
 
-- This will be needed to figure out if we have a straight later on.
position :: Card -> Int
position (rank, _) = fromEnum rank
 
 
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)
 
 
makeCounter :: Hand -> Starter -> (Hand -> Int) -> Int
makeCounter hand Nothing f        = f hand
makeCounter hand (Just starter) f = f (starter:hand)
 
-- Count all points in a hand
count :: Hand -> Starter -> Bool -> Int
count hand starter isCrib =
    sum [ countPairs hand'
        , count15 hand'
        , countStraight hand'
        , countJack hand starter
        , countFlush hand starter isCrib]
        where hand' = maybeToList starter ++ hand
 
 
-- 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 -> Int
countPairs cards = sum [2 |(r:rs) <- tails cards, _ <- filter (==r) rs]
 
 
-- Straights of 3 cards and more are worth 1 point per card.
-- Only the longest straights are considered.
countStraight :: Hand -> Int
countStraight cards =
   sum $ map length $ keepLongest straights
       where straights = [straight | straight <- powerset cards,
                          isStraight straight]
 
isStraight :: Hand -> Bool
isStraight l
   | length l < 3 = False
   | otherwise =
       all (== (head values)) values
           where values = zipWith (-) (sort $ map position l) [0..]
 
keepLongest :: [Hand] -> [Hand]
keepLongest straights =
   filter ((== maxLength) . length) straights
       where maxLength = maximum $ map length straights
 
 
-- Every combination of cards totaling 15 is worth 2 points.
count15 :: Hand -> Int
count15 cards =
   sum [2 | x <- values, sum x == 15]
       where values = powerset $ map value cards
 
 
-- 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 cards =
   if allSameSuit then length cards else 0
       where (s:ss) = map suit cards
             allSameSuit = all (== s) ss
 
 
-- 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 (_, starterSuit))  =
   length [suit | (rank, suit) <- hand,
           rank == Jack, suit == starterSuit]

[gasche]

Je ne sais pas à quoi sert makeCounter, mais il n'est pas normal qu'elle implémente encore la vieille logique qui devrait avoir été éliminée avec l'utilisation des hand' .

Remarque stylistique : je n'aime pas l'utilisation du "where" dans
where hand' = maybeToList starter ++ hand
Je sais que les haskelleux ont tendance à mettre des "where" partout, parce que, semble-t-il, c'est la classe, mais je pense qu'il faut savoir apprécier les qualités de "let ... in", et que dans ce cas, la formulation en let .. in est plus claire.

Ta fonction countFlush est toujours laide. Pourquoi ne pas partitionner en deux fonctions, countFlush et countFlushCrib, la première utilisant hand' ?

Enfin, je ne suis pas fan de la définition du powerset. Le petit tortillon de Jedai est peut-être très sympathique, mais pour ma part je n'y comprend rien (et je n'ai pas envie de lui allouer la capacité CPU nécessaire dans l'immédiat). J'aurais horreur d'inclure dans *mon* code un code que je ne comprends pas. À ta place (mais peut-être que tu vois tout à fait en quoi cette version est mieux, et alors mon commentaire ne s'applique pas à toi), je mettrais la version avec ++, qui est simple est naturelle.
Si tu veux faire compliqué et joli, tu peux essayer plutôt la sublime (et en plus pour ma part, je la comprends, donc je suis content)

Code :

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

powerset = filterM (const [True, False])

[Jedai]

Enfin, je ne suis pas fan de la définition du powerset. Le petit tortillon de Jedai est peut-être très sympathique, mais pour ma part je n'y comprend rien (et je n'ai pas envie de lui allouer la capacité CPU nécessaire dans l'immédiat). J'aurais horreur d'inclure dans *mon* code un code que je ne comprends pas. À ta place (mais peut-être que tu vois tout à fait en quoi cette version est mieux, et alors mon commentaire ne s'applique pas à toi), je mettrais la version avec ++, qui est simple est naturelle.

La version avec (++) et la version avec (/\/) sont strictement les mêmes excepté que la version avec (/\/) peut produire sa liste en mémoire constante (pourvu qu'on la consomme de l'autre côté). (/\/) peut aussi être appelé "interleave" (entrelacer) et est très simple : elle prend deux listes et en fait une liste où les éléments des deux arguments alternent, un de la première liste, un de la seconde, etc...

Code :

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

1
2
3
4
powerset :: [a] -> [[a]]
powerset [] = [[]]
powerset (x:xs) = map (x:) xxs /\/ xxs
    where xxs = powerset xs

Si on utilise (++), powerset doit garder xxs totalement en mémoire pour produire la seconde moitié des éléments, avec (/\/), elle peut se contenter de garder un élément de xxs juste le temps de produire deux éléments de (powerset (x : xs)).
J'aime bien mon opérateur, mais je sais que nos goûts en matière stylistique ne concordent pas trop (par exemple j'aime bien where, quoique j'utiliserais un nom plus descriptif que hand' probablement), peut être cela serait-il plus agréable à tes yeux avec une fonction comme interleave :

Code :

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

1
2
3
4
5
6
7
8
9
10
powerset :: [a] -> [[a]]
powerset [] = [[]]
powerset (x:xs) = map (x:) xxs `interleave` xxs
    where xxs = powerset xs
 
-- |@interleave xs ys@ alternate between elements from
--  xs and ys : [x1,y1,x2,y2,...]
interleave :: [a] -> [a] -> [a]
interleave [] ys = ys
interleave (x:xs) ys = x : interleave ys xs

Si tu veux faire compliqué et joli, tu peux essayer plutôt la sublime (et en plus pour ma part, je la comprends, donc je suis content)

Code :

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

powerset = filterM (const [True, False])

C'est un très joli code, mais il a l'inconvénient de ne pas produire en mémoire constante, il est également deux fois plus lent que le powerset que j'ai proposé. Il est également encore plus ésotérique à mon avis que mon powerset, même avec (/\/)... Tout le monde ne maitrise pas suffisamment la monade des listes pour comprendre ce code instantanément.

(D'un autre côté, au pire GnuVince va faire des powerset de 5 éléments... Je doute que le choix d'un powerset, même 4 fois plus lent comme son original (qui était tout de même en mémoire constante) change quoique ce soit)

--
Jedaï

[GnuVince]

bluestorm: J'avais utilisé makeCounter, mais finalement j'ai préféré ta suggestion d'utiliser maybeToList (que je ne connaissais pas.) La raison pour laquelle makeCounter est encore là est simplement que j'ai oublié de la supprimer.

Je suis assez content de l'état actuel du code, je voudrais maintenant savoir comment le tester. Dans un langage comme Python, ça serait pas très difficile en utilisant un framework du genre xUnit et en créant moi-même des dizaines de cas spécifiques. Haskell a la librairie QuickCheck, je me demandais si elle serait utilisable pour mon problème. Je comprends qu'elle demande que l'on trouve des propriétés du code, mais j'ai bien peur d'avoir de la misère à en trouver pour mon code.

Ça vaudrait la peine de partir une nouvelle discussion pour l'utilisation de QC?

[Jedai]

QuickCheck est un bel outil très intéressant, mais dans ton cas son utilisation demande un peu de réflexion. Quelques idées serait de vérifier par exemple que l'ordre de la liste n'influe pas sur le score, que le nombre de point total et par fonction ne dépasse pas un certain seuil, etc... Ca reste très basique, tes fonctions ne sont pas très riches d'un point de vue propriétés algébriques à mon avis.
Dans ton cas, HUnit est certainement plus adapté, quelques mains exemples, pour vérifier que les fonctions ne font pas n'importe quoi.

--
Jedaï

[GnuVince]

D'accord. Merci, Jedaï.

[gasche]

Jedai : le symbole infixe ne me dérange pas vraiment (enfin, pour être franc, je trouve qu'il n'est pas vraiment nécessaire, et qu'il n'est pas assez couramment utilisé pour mériter une introduction dans l'espace de nom réduit des symboles infixes dans ma tête), c'est plutôt le comportement (en mémoire, toussa) que je ne maîtrise pas (comme la plupart des fonctions en Haskell, d'ailleurs, mais tant qu'à ne pas maîtriser, autant prendre le truc qui a l'air le plus naturel, au départ en tout cas).

Cependant, comme tu as l'air prêt à expliquer, je suis intéressé et je retire ce que j'ai dit sur mon temps CPU (ou plutôt, je rajoute du temps CPU).
J'ai lu tes explications mais je ne comprend pas encore vraiment : j'ai l'impression de comprendre un truc mais ça correspond pas spécialement à ce que tu racontes (en particulier je vois pas tellement à quoi correspond le "mémoire constante").

Quand on utilise ++, la liste à droite est gardée "en mémoire" jusqu'à que tous les éléments de la liste de gauche aient été consommés paresseusement. En particulier, le GC ne peut pas réclamer le binding lié à la liste xxs. Ça, ça correspond à ce que tu dis, et c'est assez clair.

Quand on utilise /\/, la deuxième liste est gardée en mémoire pendant les deux premiers accès à la liste (le premier mange dans la liste de gauche, mais dès le deuxième on mange dans la liste de droite), et dès la fin du deuxième appel, la "mémoire" (ou les thunks ou le moyen-d'implémentation-lazy-qui-fait-mal-à-la-tête) ne retient que la queue de cette liste de droite (et après encore deux lectures, la queue de cette queue, etc...). J'ai bon ?

Où est-ce qu'on peut qualifier ça de "mémoire constante" ? Tu parles de l'évolution de la mémoire si on lit successivement tous les éléments d'une liste produite par /\/ ?
(Je pourrais réfléchir et peut-être trouver ça tout seul, mais comme tu as l'air prêt à expliquer gentiment, et que ça intéresse peut-être des gens, et que j'ai autre chose pour occuper mon CPU dans l'immédiat, je préfère demander comme un lâche)

[Jedai]

Quand on utilise ++, la liste à droite est gardée "en mémoire" jusqu'à que tous les éléments de la liste de gauche aient été consommés paresseusement. En particulier, le GC ne peut pas réclamer le binding lié à la liste xxs. Ça, ça correspond à ce que tu dis, et c'est assez clair.

Ok, ça c'est bon. Effectivement, l'appel a besoin de conserver le premier élément de xxs durant le calcul de toute la première moitié du résultat.

Quand on utilise /\/, la deuxième liste est gardée en mémoire pendant les deux premiers accès à la liste (le premier mange dans la liste de gauche, mais dès le deuxième on mange dans la liste de droite), et dès la fin du deuxième appel, la "mémoire" (ou les thunks ou le moyen-d'implémentation-lazy-qui-fait-mal-à-la-tête) ne retient que la queue de cette liste de droite (et après encore deux lectures, la queue de cette queue, etc...). J'ai bon ?

Où est-ce qu'on peut qualifier ça de "mémoire constante" ? Tu parles de l'évolution de la mémoire si on lit successivement tous les éléments d'une liste produite par /\/ ?

Voyons un exemple :

Code :

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

1
2
3
4
ssum :: (Num a) => [[a]] -> a
ssum = foldl' (+) 0 . map (foldl' (+) 0)
 
main = print . ssum . powerset $ ([1..30] :: [Integer])

Selon les powerset utilisé, ce code va avoir un comportement civilisé : il va travailler en mémoire constante et relativement faible (à peu près 3 fois la taille d'une liste de 30 Integer disons, et des poussières), ou il va complètement exploser en mémoire.

Avec ce powerset :

Code :

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

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

ou celui-là :

Code :

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

powerset = filterM (const [True, False])

Il explosera.

Tandis qu'avec ce powerset :

Code :

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

1
2
3
4
5
6
7
8
9
10
powerset :: [a] -> [[a]]
powerset [] = [[]]
powerset (x:xs) = map (x:) xxs `interleave` xxs
    where xxs = powerset xs
 
-- |@interleave xs ys@ alternate between elements from
--  xs and ys : [x1,y1,x2,y2,...]
interleave :: [a] -> [a] -> [a]
interleave [] ys = ys
interleave (x:xs) ys = x : interleave ys xs

il restera bien civilisé.

C'est pourquoi je parle de "mémoire constante". En fait il serait plus exact de parler d'une complexité mémorielle linéaire au lieu d'être exponentielle dans le cas d'une consommation directe (qui est un cas très commun : pour prendre un exemple du code de GnuVince, sa recherche des suites ne prends qu'autant d'espace qu'il y a de suites, les autres parties de la main sont produites et éliminées au fur et à mesure).

Est-ce que tu as bien compris pourquoi ça se passait ainsi ? Ton explication n'est pas très très claire, j'ai l'impression que tu oublie xxs dedans : avec "mon" powerset, xxs est aussi produite au fur et à mesure, et on peut oublier un élément de xxs et passer au suivant (qu'on génère à ce moment là) dès qu'on a sortit deux éléments du résultat.

En résumé, le powerset avec (/\/) peut se comporter comme un flux, le powerset avec (++) non.

--
Jedaï

[Jedai]

NB : GnuVince n'a pas vraiment besoin de powerset en réalité, il ne l'utilise que pour ses suites, et on peut se contenter de :

Code :

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

1
2
3
4
5
6
countStraight' hand = product . map length . keepLongest $ straights
    where straights = filter (isStraight . map position . head . transpose) . sub 
                      . groupBy ((==) `on` position) 
                      . sortBy (comparing position) $ hand
          isStraight xs = length xs >= 3 && all (== 1) (zipWith (-) (tail xs) xs)
          sub = concatMap (tail . inits) . (init . tails)

qui dans notre cas est en fait plus compliquée et sans doute plus lente, mais avec des mains plus grandes comme dans d'autre jeux, cette solution deviendrait nettement meilleure.

--
Jedaï

[Jedai]

Voyons un exemple :

Code :

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

1
2
3
4
ssum :: (Num a) => [[a]] -> a
ssum = foldl' (+) 0 . map (foldl' (+) 0)
 
main = print . ssum . powerset $ ([1..30] :: [Int])

On peut noter, que sur cet exemple, un programme compilé par GHC -O2 mets 330s sur ma machine, là où le programme suivant en C (compilé avec GCC -O3) mets 150s, ce que je trouve, personnellement très impressionant :

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
#include<stdio.h>
 
int main(int argc, char **argv) {
  int nat[30];
  int i,j,c;
  int sum = 0;
 
  // initialisation du tableau
  for( i = 0; i < 30; i++ )
    nat[i] = i+1;
 
  // parcours des parties
  for( i=1; i < (1 << 30); i++) {
    for( j = 1 << 29, c = 29; j; j >>= 1, c-- ) {
      if ( j & i )
	sum += nat[c];
    }
  }
 
  printf( "Somme = %d", sum );
 
  return 0;
}

--
Jedaï