Skip to content

Commit

Permalink
Simplified hand calculation, removed hand type hint and fixed bugs in…
Browse files Browse the repository at this point in the history 
… calpoker
  • Loading branch information
@prozacchiwawa
Bram Cohen authored and prozacchiwawa committed Sep 18, 2024
1 parent 39cd995 commit a85b46e
Show file tree
Hide file tree
Showing 2 changed files with 58 additions and 91 deletions.
32 changes: 22 additions & 10 deletions calpoker_generate.clinc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@
; state is empty
; move is alice commit to a salted word
; evidence is empty
(defun calpokera ((move next_validation_hash mover_share previous_validation_hash
(defun calpokera (mod_hash (move next_validation_hash mover_share previous_validation_hash
mover_puzzle_hash waiter_puzzle_hash amount timeout max_move_size referee_hash)
dictionary_key me mover_puzzle solution evidence)

Expand All @@ -31,7 +31,7 @@
; state is alice's commit
; move is bob's seed
; evidence is empty
(defun calpokerb ((move next_validation_hash mover_share previous_validation_hash
(defun calpokerb (mod_hash (move next_validation_hash mover_share previous_validation_hash
mover_puzzle_hash waiter_puzzle_hash amount timeout max_move_size referee_hash)
alice_commit me mover_puzzle solution evidence)
(assert
Expand Down Expand Up @@ -112,7 +112,7 @@
; state is alice's commit and bob's seed
; move is alice's reveal of her card generating seed and her commit to which cards she's picking
; evidence is empty
(defun calpokerc ((move next_validation_hash mover_share previous_validation_hash
(defun calpokerc (mod_hash (move next_validation_hash mover_share previous_validation_hash
mover_puzzle_hash waiter_puzzle_hash amount timeout max_move_size referee_hash)
(alice_commit bob_seed) me mover_puzzle solution evidence)
(assert
Expand All @@ -130,7 +130,7 @@

(defun onecount (mymask)
(if mymask
(+ (& mymask 1) (onecount (lsh mymask -1)))
(+ (logand mymask 1) (onecount (lsh mymask -1)))
0
)
)
Expand All @@ -139,7 +139,7 @@
; state is the cards for both players and alice's card pick commitment
; move is Bob's picks
; evidence is empty
(defun calpokerd ((bob_picks next_validation_hash mover_share previous_validation_hash
(defun calpokerd (mod_hash (bob_picks next_validation_hash mover_share previous_validation_hash
mover_puzzle_hash waiter_puzzle_hash amount timeout max_move_size referee_hash)
(cards alice_commit) me mover_puzzle solution evidence)
(assert
Expand Down Expand Up @@ -176,20 +176,32 @@
)
)

(defun pull_out_cards (selections cards count)
(if (not cards)
(assert
(= count 4)
0
)
(logand selections 1)
(c (make_card (f cards)) (pull_out_cards (lsh -1 selections) (r cards) (+ count 1)))
(pull_out_cards (lsh -1 selections) (r cards) count)
)
)

; Bob challenging
; state is (Bob's picks (alice_cards bob_cards) alice_commit)
; move is (alice_salted_picks alice_hand_type)
; evidence is Bob's hand type
(defun calpokere ((move next_validation_hash mover_share previous_validation_hash
(defun calpokere (mod_hash (move next_validation_hash mover_share previous_validation_hash
mover_puzzle_hash waiter_puzzle_hash amount timeout max_move_size referee_hash)
(bob_picks (alice_cards bob_cards) alice_commit) me mover_puzzle solution bob_hand_type)
(bob_picks (alice_cards bob_cards) alice_commit) me mover_puzzle solution bob_card_selections)
(assign
alice_picks (substr move 0 1)
alice_salted_picks (substr move 0 17)
alice_hand_type (substr move 17 18)
alice_card_selections (substr move 17 18)
(alice_final_cards bob_final_cards) (extract_cards bob_picks bob_cards &rest (extract_cards alice_picks alice_cards 0 0))
result (hand_compare (onehandcalc alice_hand_type (map make_card alice_final_cards))
(onehandcalc bob_hand_type (map make_card bob_final_cards)))
result (hand_compare (onehandcalc (pull_out_cards alice_card_selections alice_final_cards 0))
(onehandcalc (pull_out_cards bob_card_selections bob_final_cards 0)))
(assert
(not
(all
Expand Down
117 changes: 36 additions & 81 deletions onehandcalc.clinc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,21 +3,17 @@
; suits are 1-4 with no particular labelling
; takes a list of five cards (rank . suit) and returns the value of the best poker
; hand which can be made with them
; returned list is hand type followed by cards in descending order
; doesn't work for ten or more cards if there are multiple flushes
; all sorting is done highest to lowest
; Hands are represented:
; straight flush (5 high_card)
; 4 of a kind (4 1 quad_rank kicker)
; full house (3 2 set_rank pair_rank)
; flush (3 1 3 high_card first_kicker second_kicker third_kicker fourth_kicker)
; straight (3 1 2 high_card)
; set (3 1 1 set_rank first_kicker second_kicker)
; two pair (2 2 1 high_pair_rank low_pair_rank kicker)
; pair (2 1 1 1 pair_rank first_kicker second_kicker third_kicker)
; high card (1 1 1 1 1 high_card first_kicker second_kicker third_kicker fourth_kicker)
(
(include assert.clinc)
(defconstant STRAIGHT_FLUSH 9)
(defconstant FOUR_OF_A_KIND 8)
(defconstant FULL_HOUSE 7)
(defconstant FLUSH 6)
(defconstant STRAIGHT 5)
(defconstant THREE_OF_A_KIND 4)
(defconstant TWO_PAIR 3)
(defconstant PAIR 2)
(defconstant HIGH_CARD 1)
(defconstant GROUP 1)
(defun hand_compare (a b)
(if (= (f a) (f b))
(if (r a)
Expand Down Expand Up @@ -80,88 +76,47 @@
0
)
)
; returns the high card of a straight or asserts if there isn't any
; ranks must be sorted in descending order
(defun straight_high (rank1 rank2 rank3 rank4 rank5)
(assert
(not logior (= rank1 rank2) (= rank2 rank3) (= rank3 rank4) (= rank4 rank5))
(if (logiand (= rank1 14) (= rank2 5))
(assert (= rank5 2)
14
)
(assert (= rank5 (- rank1 4))
rank1
)
)
(defun check_flush ((rank1 . suit1) (rank2 . suit2) (rank3 . suit3) (rank4 . suit4) (rank5 . suit5))
(logand (= suit1 suit2) (= suit2 suit3) (= suit3 suit4) (= suit4 suit5))
)
; returns the high card of a straight or 0 if there isn't any
(defun straight_high (count1 count2 count3 count4 count5 card1 card2 card3 card4 card5)
(if (not (= count1 1))
0
(= card5 (- card1 4))
card1
(= card1 14)
(* (= card2 5) 5)
0
)
)
(defun group_by_count_inner (items last count)
(if (not items)
(list (logior (lsh count 4) last))
(if (= (f items) last)
(group_by_count_inner (r items) last (+ count 1))
(assign-inline val (group_by_count_inner (r items) (f items) 1)
(c (logior (lsh count 4) last) val)
)
(c (logior (lsh count 4) last) (group_by_count_inner (r items) (f items) 1))
)
)
)
(defun group_by_count (items)
(group_by_count_inner items (f items) 0)
)
(defun onehandcalc (hand_type ((card1rank . card1suit) (card2rank . card2suit) (card3rank . card3suit)
(card4rank . card4suit) (card5rank . card5suit)))
(assign-lambda
(defun onehandcalc (@ cards (((card1rank . card1suit) (card2rank . card2suit) (card3rank . card3suit)
(card4rank . card4suit) (card5rank . card5suit))))
(assign
ranks (atomsort (list card1rank card2rank card3rank card4rank card5rank))
(if (= hand_type GROUP)
(assign-lambda
(@ groups ((top_count . top_card) (second_count . second_card)))
(map (lambda (myval) (c (lsh myval -4) (logand myval 0x0F)))
(atomsort (group_by_count ranks))
)
(c
(if (= top_count 1)
HIGH_CARD
(if (= top_count 2)
(if (= second_count 1)
PAIR
TWO_PAIR
)
(if (= top_count 3)
(if (= second_count 1)
THREE_OF_A_KIND
FULL_HOUSE
)
FOUR_OF_A_KIND
)
)
)
(map (lambda (p . q) q) groups)
)
raw_groups (atomsort (group_by_count ranks))
hand (map (lambda (x) (lsh -4 x)) raw_groups (map (lambda (x) (logand x 15)) raw_groups))
shigh (straight_high &rest hand)
(if shigh
(if (check_flush &rest cards)
(list 5 shigh)
(list 3 1 2 shigh)
)
(if (= hand_type STRAIGHT)
(assign-lambda
fsh (straight_high ranks)
(assert
fsh
(list STRAIGHT fsh)
)
)
(assert
(logand (= card1suit card2suit) (= card1suit card3suit)
(= card1suit card4suit) (= card1suit card5suit)
)
(if (= hand_type FLUSH)
(c FLUSH ranks)
(assign-lambda
fsh (straight_high ranks)
(assert
fsh
(list STRAIGHT_FLUSH fsh)
)
)
)
)
(if (check_flush &rest cards)
(list 3 1 3 (r (r (r (r (r hand))))))
hand
)
)
)
Expand Down

0 comments on commit a85b46e

Please sign in to comment.