diff --git a/hs/src/Day14.hs b/hs/src/Day14.hs index b625d457..f959c69f 100644 --- a/hs/src/Day14.hs +++ b/hs/src/Day14.hs @@ -7,6 +7,7 @@ module Day14 (part1, part1', part2) where import Common (groupConsecutiveBy) import Control.Monad (join, liftM2) +import Control.Parallel.Strategies (parList, rdeepseq, withStrategy) import Data.Char (intToDigit) import Data.Map qualified as Map (findWithDefault) import Data.Map.Strict qualified as Map (fromListWith) @@ -47,7 +48,7 @@ part2 :: Text -> Either (ParseErrorBundle Text Void) Int part2 input = do robots <- parse parser "" input let (_, bestTime) = - minimum + minimum . withStrategy (parList rdeepseq) $ [ (Down $ maximum $ map length verticalLines, t) | t <- [0 .. lcm width height - 1], let verticalLines = diff --git a/hs/src/Day15.hs b/hs/src/Day15.hs index 92a6e43e..75c4d4be 100644 --- a/hs/src/Day15.hs +++ b/hs/src/Day15.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE OverloadedStrings #-} -- | @@ -49,31 +48,31 @@ part1 input = do move' mover pos' delta = assert (grid ! pos == '@') . maybe state ((,pos') . (grid //) . sort) $ mover delta pos' [(pos', '@'), (pos, '.')] - moveY, moveX :: Int -> (Int, Int) -> [((Int, Int), Char)] -> Maybe [((Int, Int), Char)] moveY dy pos'@(y, x) k = case grid ! pos' of '.' -> Just k 'O' -> moveY dy (y + dy, x) $ ((y + dy, x), 'O') : (pos', '.') : k - '[' -> - assert (grid ! (y, x + 1) == ']') do - k' <- - moveY dy (y + dy, x) $ - ((y + dy, x), '[') : ((y + dy, x + 1), ']') : ((y, x), '.') : ((y, x + 1), '.') : k - moveY dy (y + dy, x + 1) k' - ']' -> assert (grid ! (y, x - 1) == '[') do - k' <- moveY dy (y + dy, x) $ ((y + dy, x - 1), '[') : ((y + dy, x), ']') : ((y, x - 1), '.') : ((y, x), '.') : k + '[' -> assert (grid ! (y, x + 1) == ']') $ do + k' <- + moveY dy (y + dy, x) $ + ((y + dy, x), '[') : ((y + dy, x + 1), ']') : ((y, x), '.') : ((y, x + 1), '.') : k + moveY dy (y + dy, x + 1) k' + ']' -> assert (grid ! (y, x - 1) == '[') $ do + k' <- + moveY dy (y + dy, x) $ + ((y + dy, x - 1), '[') : ((y + dy, x), ']') : ((y, x - 1), '.') : ((y, x), '.') : k moveY dy (y + dy, x - 1) k' _ -> Nothing moveX dx pos'@(y, x) k = case grid ! pos' of '.' -> Just k - d | d == 'O' || d == '[' || d == ']' -> moveX dx (y, x + dx) $ ((y, x + dx), d) : (pos', '.') : k - _ -> Nothing + '#' -> Nothing + d -> moveX dx (y, x + dx) $ ((y, x + dx), d) : (pos', '.') : k move state _ = state part2 :: Text -> Either String Int -part2 = - part1 . T.concatMap \case - '#' -> "##" - '.' -> ".." - '@' -> "@." - 'O' -> "[]" - c -> T.singleton c +part2 = part1 . T.concatMap f + where + f '#' = "##" + f '.' = ".." + f '@' = "@." + f 'O' = "[]" + f c = T.singleton c