From c3067ba213f2ad80a23d0d3e67a316513c84ba17 Mon Sep 17 00:00:00 2001 From: Daniel Lin Date: Thu, 2 Jan 2025 03:35:45 -0500 Subject: [PATCH 1/2] Ignore trailing whitespace --- hs/src/Day11.hs | 5 ++--- hs/src/Day2.hs | 6 +++--- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/hs/src/Day11.hs b/hs/src/Day11.hs index 0cd9ec31..778ae16f 100644 --- a/hs/src/Day11.hs +++ b/hs/src/Day11.hs @@ -5,12 +5,11 @@ -- Description: 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 diff --git a/hs/src/Day2.hs b/hs/src/Day2.hs index dfb85cf9..7b796123 100644 --- a/hs/src/Day2.hs +++ b/hs/src/Day2.hs @@ -3,17 +3,17 @@ -- Description: 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) From d76f32147292776a603d58b0bfa706d13850e9ae Mon Sep 17 00:00:00 2001 From: Daniel Lin Date: Thu, 2 Jan 2025 03:36:20 -0500 Subject: [PATCH 2/2] Day 22: Speed up with precomputation, arrays, unsafe ST --- hs/src/Day22.hs | 44 ++++++++++++++++++++++++++++---------------- 1 file changed, 28 insertions(+), 16 deletions(-) diff --git a/hs/src/Day22.hs b/hs/src/Day22.hs index 8c3d9270..3f567220 100644 --- a/hs/src/Day22.hs +++ b/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