diff --git a/haskell/Pre.hs b/haskell/Pre.hs index 4993d13..6ae7d50 100644 --- a/haskell/Pre.hs +++ b/haskell/Pre.hs @@ -21,6 +21,7 @@ module Pre ( module Data.Stream.Infinite, module Data.Text, module Data.Text.Encoding, + module Data.Traversable, module Data.Void, module Data.Word, module Linear, @@ -66,6 +67,7 @@ import Data.Stream.Infinite (Stream ((:>))) import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) import Data.Text.Lazy qualified as TL +import Data.Traversable import Data.Void import Data.Word import Linear (V2 (..)) diff --git a/haskell/Puzzles/Day7.hs b/haskell/Puzzles/Day7.hs index d682bfc..e6e2047 100644 --- a/haskell/Puzzles/Day7.hs +++ b/haskell/Puzzles/Day7.hs @@ -2,14 +2,32 @@ module Puzzles.Day7 (puzzle) where import Pre +import Data.IntSet qualified as IS +import Data.Text.Lazy qualified as TL + puzzle :: Puzzle puzzle = Puzzle { number = 7 - , parser = pure () + , parser = do + line1 <- some $ (single '.' $> False) <|> (single 'S' $> True) + start <- maybe (fail "start not found") (pure . fst) $ find snd $ zip [0 ..] line1 + void newline + rows <- (some $ (single '.' $> False) <|> (single '^' $> True)) `sepEndBy1` newline + let splitters = map (IS.fromList . map fst . filter snd . zip [0 ..]) rows + pure (start, splitters) , parts = - [ \() -> - "TODO" + [ uncurry \start -> + TL.show + . flip execState (0 :: Int) + . foldlM + ( \beams splitters -> + IS.fromList . concat <$> for (IS.toList beams) \x -> do + let hit = x `IS.member` splitters + when hit $ modify succ + pure if hit then [x - 1, x + 1] else [x] + ) + (IS.singleton start) ] , extraTests = mempty } diff --git a/outputs/real/7/1 b/outputs/real/7/1 new file mode 100644 index 0000000..8799d84 --- /dev/null +++ b/outputs/real/7/1 @@ -0,0 +1 @@ +1537 \ No newline at end of file