Merge pull request #181 from ephemient/hs/day22

hs/src/Day11.hs

@@ -5,12 +5,11 @@
 -- Description:    <https://adventofcode.com/2024/day/11 Day 11: Plutonian Pebbles>
 module Day11 (part1, part2, solve) where
 
-import Common (readEntire)
+import Common (readMany)
 import Data.IntMap (IntMap)
 import Data.IntMap qualified as IntMap (toList)
 import Data.IntMap.Strict qualified as IntMap (fromListWith)
 import Data.Text (Text)
-import Data.Text qualified as T (words)
 import Data.Text.Read qualified as T (decimal)
 
 part1, part2 :: Text -> Either String Int
@@ -19,7 +18,7 @@ part2 = solve 75
 
 solve :: Int -> Text -> Either String Int
 solve n input = do
-  nums <- mapM (readEntire T.decimal) $ T.words input
+  (nums, _) <- readMany T.decimal input
   pure $ foldl' (+) 0 $ iterate step (IntMap.fromListWith (+) $ (,1) <$> nums) !! n
 
 step :: IntMap Int -> IntMap Int

hs/src/Day2.hs

@@ -3,17 +3,17 @@
 -- Description:    <https://adventofcode.com/2024/day/2 Day 2: Red-Nosed Reports>
 module Day2 (part1, part2) where
 
-import Common (readEntire)
+import Common (readEntire, readMany)
 import Control.Monad (ap, foldM_, guard)
 import Data.Functor (($>))
 import Data.List (inits, tails)
 import Data.Maybe (isJust)
 import Data.Text (Text)
-import Data.Text qualified as T (lines, words)
+import Data.Text qualified as T (lines)
 import Data.Text.Read qualified as T (decimal)
 
 parse :: Text -> Either String [[Int]]
-parse = mapM (mapM (readEntire T.decimal) . T.words) . T.lines
+parse = mapM (readEntire $ readMany T.decimal) . T.lines
 
 isSafe1, isSafe2 :: [Int] -> Bool
 isSafe1 = isJust . foldM_ go EQ . (zipWith (-) `ap` drop 1)

hs/src/Day22.hs

@@ -4,12 +4,17 @@
 module Day22 (part1, part2) where
 
 import Common (readMany)
+import Control.Monad.ST (ST, runST)
+import Control.Monad.ST.Unsafe (unsafeInterleaveST)
 import Control.Parallel.Strategies (parList, rseq, withStrategy)
-import Data.Bits (shiftL, shiftR, xor, (.&.))
-import Data.IntMap.Strict qualified as IntMap (fromListWith, null, unionsWith)
+import Data.Array.ST (Ix, MArray (newArray), STUArray, modifyArray', readArray, writeArray)
+import Data.Bits (bit, shiftL, shiftR, testBit, xor, (.&.))
+import Data.Foldable (Foldable (foldMap'))
 import Data.List (tails)
+import Data.Semigroup (Max (Max, getMax))
 import Data.Text (Text)
 import Data.Text.Read qualified as T (decimal)
+import Data.Vector.Unboxed qualified as V (generate, (!))
 
 step :: Int -> Int
 step num = num3
@@ -20,21 +25,28 @@ step num = num3
 
 part1 :: Text -> Either String Int
 part1 input = do
-  (nums, _) <- readMany T.decimal input
-  pure $ sum $ withStrategy (parList rseq) [iterate step num !! 2000 | num <- nums]
+  (nums, _) <- readMany @Int T.decimal input
+  pure $ sum [foldl' xor 0 [constants V.! i | i <- [0 .. 23], testBit num i] | num <- nums]
+  where
+    constants = V.generate 24 $ (!! 2000) . iterate step . bit
 
 part2 :: Text -> Either String Int
 part2 input = do
   (nums, _) <- readMany T.decimal input
-  let results =
-        IntMap.unionsWith (+) . withStrategy (parList rseq) $
-          [ IntMap.fromListWith (const id) $
-              [ (((a * 19 + b) * 19 + c) * 19 + d, price)
-              | (a : b : c : d : _, price) <- zip (tails deltas) $ drop 4 prices
-              ]
-          | num <- nums,
-            let secrets = take 2001 $ iterate step num
-                prices = map (`mod` 10) secrets
-                deltas = zipWith (-) prices $ drop 1 prices
-          ]
-  pure $ if IntMap.null results then 0 else maximum results
+  pure $ runST $ do
+    acc <- newSTUArray ((-9, -9, -9, -9), (9, 9, 9, 9)) 0
+    let f num = do
+          seen <- newSTUArray ((-9, -9, -9, -9), (9, 9, 9, 9)) False
+          let prices = map (`mod` 10) $ take 2001 $ iterate step num
+              g (key, price) =
+                readArray seen key >>= \case
+                  True -> pure Nothing
+                  False -> do
+                    writeArray seen key True
+                    modifyArray' acc key (+ price)
+                    Just . Max <$> readArray acc key
+          foldMap' g [((a - b, b - c, c - d, d - e), e) | a : b : c : d : e : _ <- tails prices]
+    maybe 0 getMax . mconcat . withStrategy (parList rseq) <$> mapM (unsafeInterleaveST . f) nums
+  where
+    newSTUArray :: forall s i e. (Ix i, MArray (STUArray s) e (ST s)) => (i, i) -> e -> ST s (STUArray s i e)
+    newSTUArray = newArray