Added version using case

diff --git a/advent-of-code23.cabal b/advent-of-code23.cabal
index c0bb353c5c72d133b4058d09a2eae60d99f540e8..a8a4504fcb843826ec0a8d9894cbdaaae3f741fd 100644 (file)
--- a/advent-of-code23.cabal
+++ b/advent-of-code23.cabal
@@ -140,4 +140,8 @@ executable advent07
   import: common-extensions, build-directives
   main-is: advent07/Main.hs
   build-depends: text, attoparsec
-  
\ No newline at end of file
+
+executable advent07c
+  import: common-extensions, build-directives
+  main-is: advent07/MainWithCase.hs
+  build-depends: text, attoparsec
\ No newline at end of file

diff --git a/advent07/MainWithCase.hs b/advent07/MainWithCase.hs
new file mode 100644 (file)
index 0000000..36b4cd8
--- /dev/null
+++ b/advent07/MainWithCase.hs
@@ -0,0 +1,89 @@
+-- Writeup at https://work.njae.me.uk/2023/12/07/advent-of-code-2023-day-07/
+
+import AoC
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text -- hiding (take)
+import Control.Applicative
+import Data.List
+
+data Card = Joker | Two | Three | Four | Five | Six | Seven | Eight | Nine | 
+            Ten | Jack | Queen | King | Ace deriving (Eq, Ord, Show)
+
+data HandClass = HighCard | OnePair | TwoPair | ThreeOfAKind | FullHouse | 
+                 FourOfAKind | FiveOfAKind deriving (Eq, Ord, Show)
+
+data Hand = Hand [Card] Int deriving (Eq, Ord, Show)
+data ClassifiedHand = CHand HandClass [Card] Int deriving (Eq, Ord, Show)
+
+type SignatureElement = (Int, [Card])
+type Signature = [SignatureElement]
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- TIO.readFile dataFileName
+      let hands = successfulParse text
+      print $ part1 hands
+      print $ part2 hands
+      
+part1, part2 :: [Hand] -> Int
+part1 hands = sum $ fmap score rankedHands
+  where sortedHands = sort $ fmap classify hands
+        rankedHands = zip [1..] sortedHands
+        score (r, CHand _ _ bid) = r * bid
+
+part2 = part1 . fmap enJoker
+
+enJoker :: Hand -> Hand
+enJoker (Hand cards bid) = Hand jCards bid
+  where jCards = replace Jack Joker cards
+
+replace :: Eq a => a -> a -> [a] -> [a]
+replace _ _ [] = []
+replace f t (x:xs) 
+  | x == f = t : replace f t xs
+  | otherwise = x : replace f t xs
+
+classify :: Hand -> ClassifiedHand
+classify (Hand cards bid) =
+  case (sign cards) of 
+    ((5, _):_)        -> CHand FiveOfAKind cards bid
+    ((4, _):_)        -> CHand FourOfAKind cards bid
+    ((3, _):(2, _):_) -> CHand FullHouse cards bid
+    ((3, _):_)        -> CHand ThreeOfAKind cards bid
+    ((2, _):(2, _):_) -> CHand TwoPair cards bid
+    ((2, _):_)        -> CHand OnePair cards bid
+    _                 -> CHand HighCard cards bid
+  
+sign :: [Card] -> Signature
+-- sign = reverse . sort . fmap (\g -> (length g, g)) . group . sort
+sign cards = addJokers nonJokerSigned (length jokers, jokers)
+  where (jokers, nonJokers) = partition (== Joker) cards
+        nonJokerSigned = reverse $ sort $ fmap (\g -> (length g, g)) $ 
+                           group $ sort nonJokers
+
+addJokers :: Signature -> SignatureElement -> Signature
+addJokers [] js = [js]
+addJokers ((n, cs):xs) (jn, js) = (n + jn, cs ++ js):xs
+
+-- Parse the input file
+
+handsP :: Parser [Hand]
+handP :: Parser Hand
+cardP :: Parser Card
+
+handsP = handP `sepBy` endOfLine
+handP = Hand <$> ((many1 cardP) <* space) <*> decimal
+
+cardP = (Two <$ "2") <|> (Three <$ "3") <|> (Four <$ "4") <|> 
+        (Five <$ "5") <|> (Six <$ "6") <|> (Seven <$ "7") <|> 
+        (Eight <$ "8") <|> (Nine <$ "9") <|> (Ten <$ "T") <|> 
+        (Jack <$ "J") <|> (Queen <$ "Q") <|> (King <$ "K") <|> 
+        (Ace <$ "A")
+
+successfulParse :: Text -> [Hand]
+successfulParse input = 
+  case parseOnly handsP input of
+    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right matches -> matches