-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathHandRankings.hs
258 lines (195 loc) · 9.64 KB
/
HandRankings.hs
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
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
---- Poker Analyser Hand Ranking Related Functions
--
-- Author:
-- Dr-Lord
--
-- Version:
-- 0.19 - 16-17/07/2015
--
-- Description:
-- Poker analysing shell.
-- This package contains all the functions related to ranking sets of
-- five cards (hands).
--
-- Sections:
-- 0 - Imports
-- 1 - Complete Rankers
-- 2 - Single HandType Rankers
-- 3 - HandType Absolute Instances Counters
-- 4 - General Functions
--
---- 0 - IMPORTS ---------------------------------------------------------------
module HandRankings where
import DataTypes
import HandTypeCheckers
import GeneralFunctions (choose, combinations)
import Data.Function (on)
---- 1 - COMPLETE RANKERS ------------------------------------------------------
-- Given two sets of cards (preferably of 5 cards each, i.e. hands) return
-- an Ordering (by evaluating what HandType they constitute and ranking them)
cmpHands :: [Card] -> [Card] -> Ordering
cmpHands = compare `on` rankHand
-- Given two sets of cards (preferably of 5 cards each, i.e. hands) return
-- whether they are equal by evaluating what HandType they constitute and
-- ranking them
eqHands :: [Card] -> [Card] -> Bool
eqHands = (==) `on` rankHand
-- Given any set of cards, return its best Hand
bestHand :: [Card] -> Hand
bestHand cs = Hand ht htf (rankHandType bht) ncs
where bht@(Hand ht htf _ ncs) = bestHandType cs
-- Given any set of 5 cards (hand), return its rank
rankHand :: [Card] -> Int
rankHand cs = rankHandType $ bestHandType cs
-- Given any identified HandType and its characteristic details, return its rank
-- NOTE: The input is the same as the output of functions like whatIs and bestHandType
rankHandType :: Hand -> Int
rankHandType (Hand ht htf _ cs) = case ht of
RoyalFlush -> rankRoyalFlush cs $ toS htf
StraightFlush -> rankStraightFlush cs $ toT htf
FourOfAKind -> rankFourOfAKind cs $ toV htf
FullHouse -> rankFullHouse cs $ toL htf
Flush -> rankFlush cs $ toS htf
Straight -> rankStraight cs $ toV htf
ThreeOfAKind -> rankThreeOfAKind cs $ toV htf
TwoPair -> rankTwoPair cs $ toL htf
OnePair -> rankOnePair cs $ toV htf
HighCard -> rankHighCard cs $ toV htf
---- 2 - SINGLE HANDTYPE RANKERS -----------------------------------------------
-- These rankers do not take any Suit hierarchy into account, therefore
-- there are gaps in the ranks, which do not affect any process whatsoever.
-- Also, these functions work under the assumption that the given hand is
-- of the correct HandType
-- Given a RoyalFlush, return its rank among the existing ones
-- NOTE: There are only 4, and are all equivalent (4/4)
rankRoyalFlush :: [Card] -> Suit -> Int
rankRoyalFlush cs sui = minRank RoyalFlush
-- Given a StraightFlush, return its rank among the existing ones
-- NOTE: There are 32, but they depend only on the value of their highest
-- card, therefore there are 13, but realistically only 8 (32/4)
rankStraightFlush :: [Card] -> (Suit,Value) -> Int
rankStraightFlush cs (sui,val) = minRank StraightFlush + fromEnum val
-- Given a FourOfAKind, return its rank among the existing ones
-- NOTE: There are 624, but they depend only on the value of the repeated
-- card and the fifth one, therefore there are only 13*12 (624/4)
rankFourOfAKind :: [Card] -> Value -> Int
rankFourOfAKind = rankNPlet FourOfAKind
-- Given a FullHouse, return its rank among the existing ones
-- NOTE: There are 3744, but they depend only on the values of the triplet
-- and the pair, therefore there are only 13*12 (3744/4 and / other combinations)
rankFullHouse :: [Card] -> [Value] -> Int
rankFullHouse cs vals = minRank FullHouse + fromEnum three * 13 + fromEnum pair
where three = head vals
pair = last vals
-- Given a Flush, return its rank among the existing ones
-- NOTE: There are 5112, but they depend only on the values of their cards
-- therefore there are 13*12*11*10*9, from which to subtract all the
-- Straight and Royal Flushes
rankFlush :: [Card] -> Suit -> Int
rankFlush cs sui = minRank Flush + sum (map (fromEnum . value) cs)
-- Given a Straight, return its rank among the existing ones
-- NOTE: There are 9180, but they depend only on the value of their highest
-- card, therefore there are 13, but realistically only 8 (32/4)
rankStraight :: [Card] -> Value -> Int
rankStraight cs val = minRank Straight + fromEnum val
-- Given a ThreeOfAKind, return its rank among the existing ones
-- NOTE: There are 54912, but they depend only on the value of the repeated
-- card and the other two's, and all the FullHouses have to be removed,
-- therefore there are only 13*12*11
rankThreeOfAKind :: [Card] -> Value -> Int
rankThreeOfAKind = rankNPlet ThreeOfAKind
-- Given a TwoPair, return its rank among the existing ones
-- NOTE: There are 123552, but they depend only on the values of the first
-- and second pair and the fifth card, excluding all FullHouses and
-- FourOfAKinds, therefore there are only 13*12*11
rankTwoPair :: [Card] -> [Value] -> Int
rankTwoPair cs vals = minRank TwoPair + valuesBaseSum
where valuesBaseSum = sum $ zipWith (*) (map (13^) [0..]) addenda
addenda = reverse [fromEnum first, fromEnum second, fifthCard]
fifthCard = fromEnum . head $ filter ((`notElem` vals) . value) cs
first = head vals
second = last vals
-- Given a OnePair, return its rank among the existing ones
-- NOTE: There are 1098240, but they depend only on the value of the repeated
-- card and the other three's, and all the FourOfAKinds, ThreeOfAKinds,
-- FullHouses and TwoPairs have to be removed, therefore there are only 13*12*11*10
rankOnePair :: [Card] -> Value -> Int
rankOnePair = rankNPlet OnePair
-- Given a OnePair, return its rank among the existing ones
-- NOTE: There are 1303560, but they depend only on the value of the highest
-- card and the sum of the others'
rankHighCard :: [Card] -> Value -> Int
rankHighCard cs val = minRank HighCard + fromEnum val * 13 + otherCardsSum
where otherCardsSum = sum $ map (fromEnum . value) otherCards
otherCards = filter ((/= val) . value) cs
---- 3 - HANDTYPE ABSOLUTE INSTANCES COUNTERS ----------------------------------
-- NOTE: This section is the "long" and "wrong" way to get to these values,
-- but it was easy to set up as a working version.
-- The same functions are be done through the `choose` function in the
-- HandType Instances Calculators section.
-- Cached result of: allHandTypesIn allCards
-- NOTE: (sum $ map snd totHtsCounts) == (52 `choose` 5)
totHtsCounts :: [(HandType,Int)]
totHtsCounts = [
(HighCard,1303560),
(OnePair,1098240),
(TwoPair,123552),
(ThreeOfAKind,54912),
(Straight,9180),
(Flush,5112),
(FullHouse,3744),
(FourOfAKind,624),
(StraightFlush,32),
(RoyalFlush,4)
]
-- Return the list of all HandTypes and how many "real" instances of each
-- exist in a given set of cards , i.e. taking into account the fact that if
-- some cards constitute more than one HandType, they should count only as
-- the highest one
allHandTypesIn :: [Card] -> [(HandType,Int)]
allHandTypesIn cs = identifyHts . foldl countHandTypes zeroes $ handCombinations cs
where identifyHts = zip allHandTypes
zeroes = replicate 10 0
countHandTypes counts hand = concat [
take itsHtNum counts,
[(counts!!itsHtNum) + 1],
drop (itsHtNum + 1) counts
]
where itsHtNum = fromEnum . hType $ bestHandType hand
-- Return how many hands have a specific HandType as their highest one
totalHt :: HandType -> Int
totalHt ht = ht `handTypeIn` allCards
-- Return how many hands have a specific HandType as their highest one
-- within a set of cards
handTypeIn :: HandType -> [Card] -> Int
ht `handTypeIn` cs = foldl countHandType 0 $ handCombinations cs
where countHandType count hand
| itsHt == ht = count + 1
| otherwise = count
where itsHt = hType $ bestHandType hand
-- Return all possible 5-card combinations from the given cards
handCombinations :: [Card] -> [[Card]]
handCombinations = intsLToCardsL . combinations 5 . cardsToInts
---- 4 - GENERAL FUNCTIONS -----------------------------------------------------
-- Given an N-Plet kind of hand, return its rank among the existing ones
rankNPlet :: HandType -> [Card] -> Value -> Int
rankNPlet ht cs val = minRank ht + n * fromEnum val * 13 + otherCardsSum
where -- n is just a scaling factor in order to separate the highest lower
-- specific N-Plet hands from the lowest higher ones.
-- i.e. a pair of 2 with an Ace, King and Queen from a pair of 3 with
-- a 2, a 4 and a 5.
-- NOTE: In fact, the factor is only necessary for THAT specific case
n
| ht == OnePair = 3
| otherwise = 5 - length otherCards
otherCardsSum = sum $ map (fromEnum . value) otherCards
otherCards = filter ((/= val) . value) cs
-- Return the rank of the lowest specified HandType in the HandType counts
-- for all cards
minRank :: HandType -> Int
minRank = minRankIn totHtsCounts
-- Return the rank of the lowest specified HandType in the given HandType
-- counts
minRankIn :: [(HandType,Int)] -> HandType -> Int
minRankIn htCounts ht = sum $ map (snd . (htCounts!!)) [0..htNum - 1]
where htNum = fromEnum ht