0votos

Poker Kata en Haskell

por josejuan hace 6 años

Escribir las funciones directamente para evaluar "al vuelo" una única mano son fáciles, pero también es fácil colarse con algún predicado. Aquí hago funciones que evalúan al vuelo cada jugada, sin monos primero y luego con monos. Aprovecho los datos que generé en mi solución anterior para verificar éstas funciones (y recíprocamente que mis archivos son correctos también).

Conviértete en un jugador de poker profesional y averigua la combinación ganadora que tienes entre tus manos.

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
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
import Data.List 
import System.IO (getContents) 
import System.Environment (getArgs) 
import System.Exit (exitFailure, exitSuccess) 
 
-- sin controlar monos 
data Carta = Carta {carta :: Int, palo :: Int} deriving (Show, Eq, Ord) 
 
cartas = map carta 
numerode = map length . group . sort 
ncartas = numerode . cartas 
tiene n = elem n . ncartas 
 
pareja cs = tiene 2 cs || trio cs 
doblepareja cs = poker cs || (pareja cs && trio cs) || ((2==) . length . filter (2==) . ncartas) cs 
trio cs = poker cs || tiene 3 cs 
escalera cs = [1] == (nub . numerode) ns && maximum ns - minimum ns < 5 where ns = cartas cs 
color = ((1==).length) . numerode . map palo 
full cs = pareja cs && trio cs 
poker = tiene 4 
escaleraColor cs = color cs && escalera cs 
escaleraReal cs = color cs && escalera ((Carta 14 (palo $ head cs):) $ filter ((1/=).carta) cs) 
 
 
 
-- controlando monos 
monos = length . filter ((0==).palo) 
sinmonos = filter ((0/=).palo) 
pajarita cs = m > 1 || (m > 0 && pareja cs) where m = monos cs 
 
pareja'' = pareja . sinmonos 
doblepareja'' = doblepareja . sinmonos 
trio'' = trio . sinmonos 
 
pareja' cs = monos cs > 0 || pareja'' cs 
doblepareja' cs = pajarita cs || doblepareja'' cs  
trio' cs = pajarita cs || trio'' cs 
escalera' = escalera . sinmonos 
color' = color . sinmonos 
full' cs = (m > 1 && pareja'' cs) || (m > 0 && (doblepareja'' cs || trio'' cs)) || (full . sinmonos) cs 
           where m = monos cs 
poker' cs = (m > 1 && pareja'' cs) || (m > 0 && trio'' cs) || (poker . sinmonos) cs 
            where m = monos cs 
escaleraColor' = escaleraColor . sinmonos 
escaleraReal' = escaleraReal . sinmonos 
 
 
 
 
-- Para teatear el tema podemos usar el trabajo de mi solución anterior. 
-- Testea una función dada una entrada en el formato de mi anterior solución 
main = do 
  toTest <- getArgs >>= return . head 
  putStrLn $ "Testeando {" ++ toTest ++ "}..." 
  let f = case toTest of 
            "pareja" -> pareja 
            "doblepareja" -> doblepareja 
            "trio" -> trio 
            "escalera" -> escalera 
            "color" -> color 
            "full" -> full 
            "poker" -> poker 
            "escaleraColor" -> escaleraColor 
            "escaleraReal" -> escaleraReal 
            "pareja_" -> pareja' 
            "doblepareja_" -> doblepareja' 
            "trio_" -> trio' 
            "escalera_" -> escalera' 
            "color_" -> color' 
            "full_" -> full' 
            "poker_" -> poker' 
            "escaleraColor_" -> escaleraColor' 
            "escaleraReal_" -> escaleraReal' 
  manos <- getContents >>= return . map leeMano . lines 
  let errores = filter (not.f) manos 
  if not (null errores) 
    then 
      do 
        putStrLn $ "ERROR con la mano:" 
        putStrLn $ "{" ++ (show $ head $ errores) ++ "}" 
        exitFailure 
    else 
      do 
        putStrLn "Todo correcto." 
        exitSuccess 
 
leeMano [] = [] 
leeMano (x:y:xs) = Carta (n y) (p x): leeMano xs 
                   where n '>' = 0 
                         n '1' = 1 
                         n '2' = 2 
                         n '3' = 3 
                         n '4' = 4 
                         n '5' = 5 
                         n '6' = 6 
                         n '7' = 7 
                         n '8' = 8 
                         n '9' = 9 
                         n '0' = 10 
                         n 'J' = 11 
                         n 'Q' = 12 
                         n 'K' = 13 
                         p '<' = 0 
                         p 'O' = 1 
                         p 'C' = 2 
                         p 'E' = 3 
                         p 'B' = 4 
 
{- 
 
  NOTA: este test valida que no hay falsos negativos (ej. pókeres que no son detectados), 
        pero habría que añadir algún test para los falsos positivos (ej. dice que hay un 
        póker pero no lo es).  
 
  Así, para testear las jugadas (funciones) sin monos, podemos lanzar un script como 
 
    grep -v '<>' CO.jugadas.txt | runghc pok.hs color && 
    grep -v '<>' DP.jugadas.txt | runghc pok.hs doblepareja && 
    grep -v '<>' EC.jugadas.txt | runghc pok.hs escaleraColor && 
    grep -v '<>' ER.jugadas.txt | runghc pok.hs escaleraReal && 
    grep -v '<>' ES.jugadas.txt | runghc pok.hs escalera && 
    grep -v '<>' FU.jugadas.txt | runghc pok.hs full && 
    grep -v '<>' PA.jugadas.txt | runghc pok.hs pareja && 
    grep -v '<>' PO.jugadas.txt | runghc pok.hs poker && 
    grep -v '<>' TR.jugadas.txt | runghc pok.hs trio 
 
 
  Para las de monos otro como: 
 
    runghc pok.hs color_ < CO.jugadas.txt && 
    runghc pok.hs doblepareja_ < DP.jugadas.txt && 
    runghc pok.hs escaleraColor_ < EC.jugadas.txt && 
    runghc pok.hs escaleraReal_ < ER.jugadas.txt && 
    runghc pok.hs escalera_ < ES.jugadas.txt && 
    runghc pok.hs full_ < FU.jugadas.txt && 
    runghc pok.hs pareja_ < PA.jugadas.txt && 
    runghc pok.hs poker_ < PO.jugadas.txt && 
    runghc pok.hs trio_ < TR.jugadas.txt 
 
 
  Es decir, algo como: 
 
 
    [josejuan@centella solveet]$ grep -v '<>' CO.jugadas.txt | runghc pok.hs color && 
    > grep -v '<>' DP.jugadas.txt | runghc pok.hs doblepareja && 
    > grep -v '<>' EC.jugadas.txt | runghc pok.hs escaleraColor && 
    > grep -v '<>' ER.jugadas.txt | runghc pok.hs escaleraReal && 
    > grep -v '<>' ES.jugadas.txt | runghc pok.hs escalera && 
    > grep -v '<>' FU.jugadas.txt | runghc pok.hs full && 
    > grep -v '<>' PA.jugadas.txt | runghc pok.hs pareja && 
    > grep -v '<>' PO.jugadas.txt | runghc pok.hs poker && 
    > grep -v '<>' TR.jugadas.txt | runghc pok.hs trio && 
    > runghc pok.hs color_ < CO.jugadas.txt && 
    > runghc pok.hs doblepareja_ < DP.jugadas.txt && 
    > runghc pok.hs escaleraColor_ < EC.jugadas.txt && 
    > runghc pok.hs escaleraReal_ < ER.jugadas.txt && 
    > runghc pok.hs escalera_ < ES.jugadas.txt && 
    > runghc pok.hs full_ < FU.jugadas.txt && 
    > runghc pok.hs pareja_ < PA.jugadas.txt && 
    > runghc pok.hs poker_ < PO.jugadas.txt && 
    > runghc pok.hs trio_ < TR.jugadas.txt 
    Testeando {color}... 
    Todo correcto. 
    Testeando {doblepareja}... 
    Todo correcto. 
    Testeando {escaleraColor}... 
    Todo correcto. 
    Testeando {escaleraReal}... 
    Todo correcto. 
    Testeando {escalera}... 
    Todo correcto. 
    Testeando {full}... 
    Todo correcto. 
    Testeando {pareja}... 
    Todo correcto. 
    Testeando {poker}... 
    Todo correcto. 
    Testeando {trio}... 
    Todo correcto. 
    Testeando {color_}... 
    Todo correcto. 
    Testeando {doblepareja_}... 
    Todo correcto. 
    Testeando {escaleraColor_}... 
    Todo correcto. 
    Testeando {escaleraReal_}... 
    Todo correcto. 
    Testeando {escalera_}... 
    Todo correcto. 
    Testeando {full_}... 
    Todo correcto. 
    Testeando {pareja_}... 
    Todo correcto. 
    Testeando {poker_}... 
    Todo correcto. 
    Testeando {trio_}... 
    Todo correcto. 
    [josejuan@centella solveet]$ _ 
 
-} 

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.