day7.hs (4140B)
1 -- AOC 2023: Day 7 - Camel Cards 2 -- 3 -- Camel Cards is a game like poker except each player is dealt 5 4 -- cards from the start and the order they are received in is 5 -- important. In this example a list of hands are given along with a 6 -- bid amount for each hand. The hands should be ranked and sorted - 7 -- if their are N hands the worst hand will be assigned rank 1 and 8 -- the best will be assigned rank N+1. Anytime two hands are equal 9 -- (eg. both are full house) then the cards should be compared from 10 -- left to right with and the first hand with a higher value card 11 -- wins (Aces are highest). 12 -- 13 -- Example input: 14 -- 32T3K 765 -- one pair, rank 1 15 -- T55J5 684 -- three of a kind, rank 4 (T < Q) 16 -- KK677 28 -- two pair, rank 3 (K > T) 17 -- KTJJT 220 -- two pair, rank 2 (T < K) 18 -- QQQJA 483 -- three of a kind, rank 5 (Q > T) 19 -- Test Output: 6404 20 -- 21 -- Task 2: 'J' cards are now jokers. For the purpose of creating 22 -- hands they are wild cards. For comparing equal scoring hands they 23 -- have the lowest value. 24 -- Same Input: 25 -- 32T3K 765 -- one pair, rank 1 26 -- T55J5 684 -- four of a kind, rank 3 27 -- KK677 28 -- two pair, rank 2 28 -- KTJJT 220 -- four of a kind, rank 5 29 -- QQQJA 483 -- four of a kind, rank 4 30 -- Test Output: 5905 31 -- 32 type Rank = Int 33 34 type Hand = String 35 36 type Bid = Int 37 38 data CamelHand = 39 CamelHand Rank Hand Bid 40 deriving (Eq, Show) 41 42 data Cond a = 43 a :? a 44 45 infixl 0 ? 46 47 infixl 1 :? 48 49 (?) :: Bool -> Cond a -> a 50 True ? (x :? _) = x 51 False ? (_ :? y) = y 52 53 qsort :: Ord a => [a] -> [a] 54 qsort [] = [] 55 qsort (x:xs) = qsort lhs ++ [x] ++ qsort rhs 56 where 57 rhs = filter (< x) xs 58 lhs = filter (>= x) xs 59 60 cameltuple :: CamelHand -> (Rank, Hand, Bid) 61 cameltuple (CamelHand r h b) = (r, h, b) 62 63 cardval :: Bool -> Char -> Int 64 cardval p2 c 65 | c == 'A' = 14 66 | c == 'K' = 13 67 | c == 'Q' = 12 68 | c == 'J' = p2 ? 1 :? 11 69 | c == 'T' = 10 70 | c == '9' = 9 71 | c == '8' = 8 72 | c == '7' = 7 73 | c == '6' = 6 74 | c == '5' = 5 75 | c == '4' = 4 76 | c == '3' = 3 77 | c == '2' = 2 78 79 cardcounts :: Hand -> [Int] 80 cardcounts [] = [] 81 cardcounts (x:xs) = [lf] ++ cardcounts rem 82 where 83 lf = (+ 1) . length $ filter (== x) xs 84 rem = filter (/= x) xs 85 86 classifyhand :: [Int] -> Int 87 classifyhand (lh:lt) 88 | ll == 1 = 6 -- five of a kind 89 | ll == 2 = (lh == 4) ? 5 :? 4 -- four of a kind or full house 90 | ll == 3 = (lh == 3) ? 3 :? 2 -- three of a kind or two pairs 91 | ll == 4 = 1 -- one pair 92 | otherwise = 0 93 where 94 ll = length lt + 1 95 96 handscore :: Bool -> Hand -> Int 97 handscore p2 hand = classifyhand hn 98 where 99 f = qsort . cardcounts 100 nc = p2 ? (f $ filter (/= 'J') hand) :? f hand 101 jc = length $ filter (== 'J') hand 102 hn = 103 not p2 ? 104 nc :? [null nc ? 0 :? head nc + jc] ++ (null nc ? [] :? tail nc) 105 106 cmpeqhand :: Bool -> Hand -> Hand -> Int 107 cmpeqhand p2 (lh:lt) (rh:rt) 108 | val == 0 = cmpeqhand p2 lt rt 109 | otherwise = val 110 where 111 val = (cardval p2 lh) - (cardval p2 rh) 112 113 cmphand :: Bool -> Hand -> Hand -> Int 114 cmphand p2 lh rh 115 | val == 0 = cmpeqhand p2 lh rh 116 | otherwise = val 117 where 118 val = handscore p2 lh - handscore p2 rh 119 120 inserthand :: Bool -> [CamelHand] -> CamelHand -> [CamelHand] 121 inserthand p2 chands newchand 122 | null chands = [newchand] 123 | cmp > 0 = [n_n_chand] ++ chands 124 | cmp < 0 = [n_o_chand] ++ inserthand p2 (tail chands) newchand 125 where 126 hCH = head chands 127 (_, nhand, nbid) = cameltuple newchand 128 (orank, ohand, obid) = cameltuple hCH 129 cmp = cmphand p2 nhand ohand 130 n_o_chand = CamelHand (orank + 1) ohand obid 131 n_n_chand = CamelHand (orank + 1) nhand nbid 132 133 makecamelhand :: String -> CamelHand 134 makecamelhand = (\(c, b) -> CamelHand 1 c (read $ tail b)) . span (/= ' ') 135 136 handwinnings :: CamelHand -> Int 137 handwinnings (CamelHand r _ b) = r * b 138 139 main = do 140 contents <- getContents 141 let hands = map makecamelhand $ lines contents 142 let handsp1 = foldl (inserthand False) [] hands 143 let handsp2 = foldl (inserthand True) [] hands 144 putStrLn $ "Task 1: " ++ show (foldl (+) 0 $ map handwinnings handsp1) 145 putStrLn $ "Task 2: " ++ show (foldl (+) 0 $ map handwinnings handsp2)