Solve 2024-01

src/AoC.hs

@@ -41,4 +41,4 @@ printResult (Left e) = putTextLn e
 printResult (Right s) = print s
 
 defaultMain :: IO ()
-defaultMain = Exception.catch (runAoC Y2023 D05 >>= printResult) handleError
+defaultMain = Exception.catch (runAoC Y2024 D01 >>= printResult) handleError

src/AoC/Y2024/D01.hs

@@ -1,6 +1,39 @@
 module AoC.Y2024.D01 (solve) where
 
 import AoC.Riddle
+import Data.IntMap qualified as M
+
+parse :: Text -> ([Int], [Int])
+parse riddle =
+  let
+    lists = transpose $ mapMaybe (readMaybe . toString) . words <$> lines riddle
+   in
+    case lists of
+      [as, bs] -> (as, bs)
+      _ -> ([], [])
+
+part1 :: Riddle -> Int
+part1 riddle =
+  let
+    (as, bs) = parse riddle
+    as' = sort as
+    bs' = sort bs
+    distances = zipWith (\a b -> if a > b then a - b else b - a) as' bs'
+   in
+    sum distances
+
+mkOccurrences :: [Int] -> IntMap Int
+mkOccurrences = M.unionsWith (+) . fmap (\i -> one (i, 1))
+
+part2 :: Riddle -> Int
+part2 riddle =
+  let
+    (as, bs) = parse riddle
+    occurrences = mkOccurrences bs
+    step a total = total + a * fromMaybe 0 (M.lookup a occurrences)
+   in
+    foldr step 0 as
 
 solve :: (MonadIO m) => Text -> m (Either Text Solution)
-solve _ = pure $ Left "not yet implemented"
+solve riddle = do
+  pure $ Right [fromIntegral $ part1 riddle, fromIntegral $ part2 riddle]