From 832b85fb7bb047a6d5364d37328cb9cac5e875a7 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Mon, 8 Dec 2025 23:38:48 +0000 Subject: [PATCH] Solve day 8 part 2 --- haskell/Pre.hs | 10 +++++++++- haskell/Puzzles/Day3.hs | 5 +---- haskell/Puzzles/Day6.hs | 18 +++++++++++++++--- outputs/real/6/2 | 1 + 4 files changed, 26 insertions(+), 8 deletions(-) create mode 100644 outputs/real/6/2 diff --git a/haskell/Pre.hs b/haskell/Pre.hs index d15ea39..d7e1f2d 100644 --- a/haskell/Pre.hs +++ b/haskell/Pre.hs @@ -34,6 +34,8 @@ module Pre ( module Text.Megaparsec.Char, module Text.Megaparsec.Char.Lexer, Puzzle (..), + digit, + digitsToInt, ) where @@ -61,7 +63,7 @@ import Data.Foldable1 import Data.Function import Data.Functor import Data.List (sortOn, tails, transpose) -import Data.List.Extra (dropEnd, enumerate) +import Data.List.Extra (dropEnd, enumerate, notNull, splitOn) import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty, some1) import Data.Maybe import Data.Ord @@ -88,3 +90,9 @@ data Puzzle = forall input. Puzzle , parts :: [input -> TL.Text] , extraTests :: Bool -> FilePath -> IO input -> [TestTree] } + +digit :: (Token s ~ Char, Num b, MonadParsec e s f) => f b +digit = fromIntegral . digitToInt <$> digitChar + +digitsToInt :: (Integral a) => [a] -> Int +digitsToInt = snd . foldr (\b (p, acc) -> (10 * p, acc + fromIntegral b * p)) (1, 0) diff --git a/haskell/Puzzles/Day3.hs b/haskell/Puzzles/Day3.hs index 93da1c5..085d229 100644 --- a/haskell/Puzzles/Day3.hs +++ b/haskell/Puzzles/Day3.hs @@ -9,7 +9,7 @@ puzzle :: Puzzle puzzle = Puzzle { number = 3 - , parser = const $ flip sepEndBy newline $ Bank . fmap (fromIntegral . digitToInt) <$> some1 digitChar + , parser = const $ flip sepEndBy newline $ Bank <$> some1 digit , parts = [ TL.show . sum @@ -39,6 +39,3 @@ maxBatteries n0 (Bank bs0) = flip unfoldrM (n0, toList bs0) \case -- returns the leftmost element in case of a tie findMax :: (Ord a) => NonEmpty a -> (a, Int) findMax = foldl1' (\m x -> if fst x > fst m then x else m) . flip NE.zip (0 :| [1 ..]) - -digitsToInt :: [Battery] -> Int -digitsToInt = snd . foldr (\b (p, acc) -> (10 * p, acc + fromIntegral b * p)) (1, 0) diff --git a/haskell/Puzzles/Day6.hs b/haskell/Puzzles/Day6.hs index 6538549..35e71df 100644 --- a/haskell/Puzzles/Day6.hs +++ b/haskell/Puzzles/Day6.hs @@ -9,14 +9,24 @@ puzzle = Puzzle { number = 6 , parser = const do - ints <- (hspace *> (decimal `sepBy1` hspace1)) `sepEndBy1` newline + ints <- some ((Just <$> digit) <|> (single ' ' $> Nothing)) `sepEndBy1` newline ops <- ((single '*' $> Multiply) <|> (single '+' $> Add)) `sepEndBy` hspace1 void newline - pure (ops, transpose ints) + pure (ops, ints) , parts = [ TL.show . sum - . uncurry (zipWith \op -> foldl' (apply op) (unit op)) + . uncurry (zipWith applyToList) + . second (transpose . map (map (digitsToInt @Int . catMaybes) . filter notNull . splitOn [Nothing])) + , TL.show + . sum + . uncurry (zipWith applyToList) + . second + ( map catMaybes + . splitOn [Nothing] + . map (\l -> if all isNothing l then Nothing else Just $ digitsToInt @Int $ catMaybes l) + . transpose + ) ] , extraTests = mempty } @@ -31,3 +41,5 @@ unit :: Op -> Int unit = \case Add -> 0 Multiply -> 1 +applyToList :: Op -> [Int] -> Int +applyToList op = foldl' (apply op) (unit op) diff --git a/outputs/real/6/2 b/outputs/real/6/2 new file mode 100644 index 0000000..dfb69dc --- /dev/null +++ b/outputs/real/6/2 @@ -0,0 +1 @@ +11708563470209 \ No newline at end of file