; 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 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
(
    (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)
    (defun hand_compare (a b)
        (if (= (f a) (f b))
            (if (r a)
                (hand_compare (r a) (r b))
                0
            )
            (- (* 2 (> (f a) (f b))) 1)
        )
    )
    (defun hand< (a b)
        (= (hand_compare a b) -1)
    )
    (defun merge (a b)
        (if (not a)
            b
            (if (not b)
                a
                (if (> (f a) (f b))
                    (c (f a) (merge (r a) b))
                    (c (f b) (merge a (r b)))
                )
            )
        )
    )
    ; Sorts atoms into descending order
    ; This is optimized for sorting short lists
    ; A more general function would return a list of lists of ascending sizes 
    ; to be merged 
    (defun atomsort ((@ firstpos (first @ secondpos (second @ thirdpos (third . remaining)))))
        (if firstpos
            (if secondpos
                (if thirdpos
                    (assign-lambda
                        mylist
                        (if (> first second)
                            (if (> second third)
                                (list first second third)
                                (if (> first third)
                                    (list first third second)
                                    (list third first second)
                                )
                            )
                            (if (> first third)
                                (list second first third)
                                (if (> second third)
                                    (list second third first)
                                    (list third second first)
                                )
                            )
                        )
                        (merge mylist (atomsort remaining))
                    )
                    (if (> first second)
                        firstpos
                        (list second first)
                    )
                )
                firstpos
            )
            0
        )
    )
    (defun count_suits_2 ((@ suits (firstsuit . remaining)))
        (if (not suits)
            (c (c 0 0) (c 0 0))
            (assign-lambda ((@ cd (clubs . diamonds)) . (@ hs (hearts . spades))) (count_suits remaining)
                (if (= firstsuit 1)
                    (c (c (+ clubs 1) diamonds) hs)
                    (if (= firstsuit 2)
                        (c (c clubs (+ diamonds 1)) hs)
                        (if (= firstsuit 3)
                            (c cd (c (+ hearts 1) spades))
                            (c cd (c hearts (+ spades 1)))
                        )
                    )
                )
            )
        )
    )
    (defun find_flush_2 (suits)
        (assign-lambda ((clubs . diamonds) . (hearts . spades)) (count_suits suits)
            (if (> clubs 4)
                1
                (if (> diamonds 4)
                    2
                    (if (> hearts 4)
                        3
                        (if (> spades 4)
                            4
                            0
                        )
                    )
                )
            )
        )
    )
    (defun count_suits (suits)
        (if suits
            (+ (count_suits (r suits)) (ash 1 (* 4 (- (f suits) 1))))
            0
        )
    )
    (defun find_flush (suits)
        (assign-lambda 
            myvals (count_suits suits)
            (if (> (logand myvals 0xF000) 0x4000)
                4
                (if (> (logand myvals 0x0F00) 0x0400)
                    3
                    (if (> (logand myvals 0x00F0) 0x0040)
                        2
                        (if (> (logand myvals 0x0F) 0x04)
                            1
                            0
                        )
                    )
                )
            )
        )
    )
    (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 (ranks)
        (assign-lambda high (straight_high_inner ranks 0 0)
            (if (= high 5)
                (* (= (f ranks) 14) 5)
                high
            )
        )
    )
    (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)
                )
            )
        )
    )
    (defun group_by_count (items)
        (group_by_count_inner items (f items) 0)
    )
    (defun handcalc (cards)
        (assign-lambda
            first (lambda (x) (f x))
            rest (lambda (x) (r x))
            fsuit (find_flush (map rest cards))
            max_flush (if (not fsuit)
                (list 0)
                (assign-lambda
                    flushcards
                    (filtermap 
                        (lambda ((& fsuit) (card_rank . card_suit))
                            (if (= fsuit card_suit)
                                card_rank
                                0
                            )
                        )
                        cards
                        0
                    )
                    flushranks (atomsort flushcards)
                    fsh (straight_high flushranks)
                    (if fsh
                        (list STRAIGHT_FLUSH fsh)
                        (c FLUSH (slice flushranks 5))
                    )
                )
            )
            ranks (atomsort (map first cards))
            sh (straight_high ranks)
            max_straight (if sh
                (list STRAIGHT sh)
                (list 0)
            )
            groups (map 
                (lambda (myval) (c (lsh myval -4) (logand myval 0x0F)))
                (atomsort (group_by_count ranks))
            )
            (top_count . top_card) (f groups)
            (second_count . second_card) (f (r groups))
            topcards (map rest groups)
            max_group (if (= top_count 1)
                (c HIGH_CARD (slice topcards 5))
                (if (= top_count 2)
                    (if (= second_count 1)
                        (c PAIR (slice topcards 4))
                        (c TWO_PAIR (slice topcards 3))
                    )
                    (if (= top_count 3)
                        (if (= second_count 1)
                            (c THREE_OF_A_KIND (slice topcards 3))
                            (c FULL_HOUSE (slice topcards 2))
                        )
                        (c FOUR_OF_A_KIND (slice topcards 2))
                    )
                )
            )
            ; max of max_flush max_straight and max_group
            (if (> (f max_flush) (f max_straight))
                (if (> (f max_flush) (f max_group))
                    max_flush
                    max_group
                )
                (if (> (f max_straight) (f max_group))
                    max_straight
                    max_group
                )
            )
        )
    )
)