day07

ollanta · ollanta · commit afb60c162719 · 2023-12-07T07:14:03.000+01:00
diff --git a/day07/one.hs b/day07/one.hs
@@ -0,0 +1,36 @@
+import Data.Char
+import Data.List
+import Text.Parsec
+import Parsing
+
+main :: IO ()
+main = optimisticInteract readD solve
+
+readD :: Parser [(String, Integer)]
+readD = readHand `sepEndBy` newline
+  where
+    readHand = do
+      cards <- many1 (oneOf "AKQJT98765432")
+      many1 space
+      bid <- number
+      return (cards, bid)
+
+
+solve hands = unlines [
+  show sorted
+  , show scores
+  , show answer
+  ]
+  where
+    answer = sum scores
+    sorted = sortOn (scoreHand . fst) hands
+    scores = zipWith (*) [1..] . map snd $ sorted
+
+    scoreHand cards = foldl (\acc s -> acc*100 + scoreCard s) typeScore cards
+      where
+        groups = reverse . sort . map length . groupBy (==) . sort $ cards
+        
+        countsMatch = and . zipWith (==) groups
+        typeScore = fst . head . filter (countsMatch . snd) $ zip [7,6..1] [[5], [4], [3,2], [3], [2,2], [2], []]
+
+        scoreCard c = fst . head . filter ((==c) . snd) $ zip [1..] "23456789TJQKA"
diff --git a/day07/test.txt b/day07/test.txt
@@ -0,0 +1,5 @@
+32T3K 765
+T55J5 684
+KK677 28
+KTJJT 220
+QQQJA 483
diff --git a/day07/two.hs b/day07/two.hs
@@ -0,0 +1,38 @@
+import Data.Char
+import Data.List
+import Text.Parsec
+import Parsing
+
+main :: IO ()
+main = optimisticInteract readD solve
+
+readD :: Parser [(String, Integer)]
+readD = readHand `sepEndBy` newline
+  where
+    readHand = do
+      cards <- many1 (oneOf "AKQJT98765432")
+      many1 space
+      bid <- number
+      return (cards, bid)
+
+
+solve hands = unlines [
+  show sorted
+  , show scores
+  , show answer
+  ]
+  where
+    answer = sum scores
+    sorted = sortOn (scoreHand . fst) hands
+    scores = zipWith (*) [1..] . map snd $ sorted
+
+    scoreHand cards = foldl (\acc s -> acc*100 + scoreCard s) typeScore cards
+      where
+        noJgroups = reverse . sort . map length . groupBy (==) . sort . filter (/='J') $ cards
+        js = length . filter (=='J') $ cards
+        groups = zipWith (+) (js:repeat 0) (noJgroups++[0]) -- Add a 0 to handle the case of all cards being J
+        
+        countsMatch = and . zipWith (==) groups
+        typeScore = fst . head . filter (countsMatch . snd) $ zip [7,6..1] [[5], [4], [3,2], [3], [2,2], [2], []]
+
+        scoreCard c = fst . head . filter ((==c) . snd) $ zip [1..] "J23456789TQKA"
