-
Notifications
You must be signed in to change notification settings - Fork 4
/
handcalc.clinc
235 lines (208 loc) · 7.36 KB
/
handcalc.clinc
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
; ranks are 2-14 with 2 being two, 13 being king, and 14 being ace
; suits are 1-4 with no particular labelling
; takes a list of cards (rank . suit) and returns a bitfield of
; which cards to include to make the best possible hand
; doesn't work for ten or more cards if there are multiple flushes
; all sorting is done highest to lowest
(import std.map)
(import std.filtermap)
(import std.relops)
(import std.truncate)
(import std.partition)
(import std.append)
(import std.atomsort)
(import onchain.calpoker.flatten_card)
(import onchain.calpoker.onehandcalc exposing group_by_count_inner)
(defun find_flush (suits)
(assign
((count1 . suit1)) (group_by_count_clean (atomsort suits))
(* suit1 (>= count1 5))
)
)
(defun straight_high_inner (ranks last count)
(if (not ranks)
(if (logand (= last 2) (= count 4))
; maybe ace to five
5
0
)
(if (= last (f ranks))
; skip identical cards
(straight_high_inner (r ranks) last count)
; if the partial straight continues
(if (= (f ranks) (- last 1))
(if (= count 4)
; found a straight, add 3 to last because next and last are included
(+ last 3)
; keep looking for a straight with the count going up by one
(straight_high_inner (r ranks) (f ranks) (+ count 1))
)
; reset the count
(straight_high_inner (r ranks) (f ranks) 1)
)
)
)
)
; returns the high card of a straight or 0 if there isn't any
; ranks must be sorted in descending order
(defun straight_high_extended (ranks)
(assign
high (straight_high_inner ranks 0 0)
(if (= high 5)
(* (= (f ranks) 14) 5)
high
)
)
)
(defun group_by_count_clean (items)
(map
unflatten_card
(atomsort (group_by_count_inner items (f items) 0))
)
)
(defun find_straight_flush_indices (flush_suit straight_flush_high (@ cards ((first_rank . first_suit) . remaining)))
(if (not cards)
0
(assign
straight_to_ace_match
(logand
(= straight_flush_high 5)
(= first_rank 14)
)
rank_in_range
(logand
(<= first_rank straight_flush_high)
(> first_rank (- straight_flush_high 5))
)
hit
(logand
(= first_suit flush_suit)
(logior straight_to_ace_match rank_in_range)
)
(logior (lsh (find_straight_flush_indices flush_suit straight_flush_high remaining) 1) hit)
)
)
)
(defun flush_cards_with_index (flush_suit index (@ cards ((first_rank . first_suit))))
(if (not cards)
0
(if (= flush_suit first_suit)
(c (flatten_card (c first_rank index)) (flush_cards_with_index flush_suit (+ index 1) (r cards)))
(flush_cards_with_index flush_suit (+ index 1) (r cards))
)
)
)
(defun find_flush_indices (flush_suit cards)
(assign
myfiltered (truncate 5 (atomsort (flush_cards_with_index flush_suit 0 cards)))
(to_bitfield (map (lambda (x) (logand x 15)) myfiltered))
)
)
(defun to_bitfield (includes)
(if (not includes)
0
(logior (lsh 1 (f includes)) (to_bitfield (r includes)))
)
)
(defun find_straight_includes (ranks with_index)
(if (all ranks with_index)
(if (= (f ranks) (lsh (f with_index) -4))
(c (logand 15 (f with_index)) (find_straight_includes (r ranks) (r with_index)))
(find_straight_includes ranks (r with_index))
)
0
)
)
(defun find_straight_indices (my_straight_high cards)
(assign
with_index (atomsort (ranks_with_indices 0 cards))
my_ranks
(if (= my_straight_high 5)
(list 14 5 4 3 2)
(list
my_straight_high
(- my_straight_high 1)
(- my_straight_high 2)
(- my_straight_high 3)
(- my_straight_high 4)
)
)
(to_bitfield (find_straight_includes my_ranks with_index))
)
)
(defun ranks_with_indices (index cards)
(if (not cards)
0
(c (flatten_card (c (f (f cards)) index)) (ranks_with_indices (+ index 1) (r cards)))
)
)
(defun find_hand_indices ((@ numbered-cards ((number . card) . rest)))
(if numbered-cards
(logior (lsh 1 number) (find_hand_indices rest))
0
)
)
(defun number_cards (num cards)
(if cards
(c (c num (f cards)) (number_cards (+ num 1) (r cards)))
0
)
)
;; Sorts the cards by group size according to hand.
;; Hand has pairs of count and rank. We pull out cards based on their rank
;; until each bucket is empty in hand and then give the remaining cards.
(defun bucket_cards_by_frequency_groups (hand cards)
(if hand
(assign
(hand_freq . want_rank) (f hand)
(cards_with_rank . cards_without_rank) (partition (lambda ((& want_rank) (num . (rank . suit))) (= rank want_rank)) cards)
;; We have the cards with this rank... go to the next wanted rank.
(append cards_with_rank (bucket_cards_by_frequency_groups (r hand) cards_without_rank))
)
cards
)
)
(defun normal_full_house (firstcount secondcount hand cards)
(find_hand_indices (truncate 5 (bucket_cards_by_frequency_groups hand (number_cards 0 cards))))
)
(defun handcalc (cards)
(assign-lambda
first (lambda (x) (f x))
rest (lambda (x) (r x))
sorted_ranks (atomsort (map first cards))
hand (group_by_count_clean sorted_ranks)
((firstcount . firstrank) (secondcount . secondrank)) hand
flush_suit (find_flush (map rest cards))
(if ;; Full house
(logand (= firstcount 3) (= secondcount 2))
(normal_full_house firstcount secondcount hand cards)
;; Flush
flush_suit
(assign-lambda
flush_cards (filtermap (lambda ((& flush_suit) (@ thecard (rank . suit))) (if (= suit flush_suit) rank 0)) cards)
straight_flush_high (straight_high_extended (atomsort flush_cards))
(if straight_flush_high
(find_straight_flush_indices flush_suit straight_flush_high cards)
(if (logior (< firstcount 3) (logand (= firstcount 3) (= secondcount 1)))
(find_flush_indices flush_suit cards)
(find_hand_indices (truncate 5 (bucket_cards_by_frequency_groups hand (number_cards 0 cards))))
)
)
)
;; Else
(assign
my_straight_high (straight_high_extended sorted_ranks)
(if (all
my_straight_high
(logior
(< firstcount 3)
(logand (= firstcount 3) (= secondcount 1))
)
)
(find_straight_indices my_straight_high cards)
(find_hand_indices (truncate 5 (bucket_cards_by_frequency_groups hand (number_cards 0 cards))))
)
)
)
)
)