This commit is contained in:
Samae 2024-12-21 22:44:59 +02:00
parent 51cb2314a8
commit c4a57ffd2d
6 changed files with 87 additions and 6 deletions

3
.gitignore vendored
View file

@ -1,7 +1,8 @@
result* result*
*.cabal *.cabal
dist-newstyle dist-newstyle
*.eventlog *.eventlog*
*.prof *.prof
*.dot *.dot
*.pdf *.pdf
aoc24-debug.*

View file

@ -12,6 +12,7 @@ import Day7
import Day8 import Day8
import Day9 import Day9
import Day10 import Day10
import Day11
main :: IO () main :: IO ()
main = do main = do
@ -34,5 +35,7 @@ main = do
-- Day8.main -- Day8.main
-- putStrLn "Day 9" -- putStrLn "Day 9"
-- Day9.main -- Day9.main
putStrLn "Day 10" -- putStrLn "Day 10"
Day10.main -- Day10.main
putStrLn "Day 11"
Day11.main

View file

@ -28,6 +28,7 @@
ghcid ghcid
cabal-install cabal-install
fourmolu fourmolu
eventlog2html
]; ];
# Change the prompt to show that you are in a devShell # Change the prompt to show that you are in a devShell
shellHook = '' shellHook = ''

1
inputs/day11.input Normal file
View file

@ -0,0 +1 @@
5910927 0 1 47 261223 94788 545 7771

View file

@ -1,6 +1,6 @@
name: aoc24 name: aoc24
ghc-options: -Wall -threaded ghc-options: -Wall -threaded -O2
default-extensions: default-extensions:
- OverloadedStrings - OverloadedStrings
@ -25,6 +25,7 @@ dependencies:
- unordered-containers - unordered-containers
- utility-ht - utility-ht
- vector - vector
- MemoTrie
executables: executables:
aoc24: aoc24:
@ -33,7 +34,7 @@ executables:
- aoc24 - aoc24
aoc24-debug: aoc24-debug:
main: Main.hs main: Main.hs
ghc-options: -Wall -threaded -rtsopts -prof #-fprof-auto ghc-options: -Wall -threaded -O2 -rtsopts -prof -auto-all #-fprof-auto
dependencies: dependencies:
- aoc24 - aoc24
@ -50,7 +51,7 @@ library:
- Day8 - Day8
- Day9 - Day9
- Day10 - Day10
# - Day11 - Day11
# - Day12 # - Day12
# - Day13 # - Day13
# - Day14 # - Day14

74
src/Day11.hs Normal file
View file

@ -0,0 +1,74 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Day11 where
import Data.Attoparsec.Text (Parser, decimal, parseOnly, sepBy)
import Data.Function (fix)
import qualified Data.Text.IO as T
import Data.Vector (Vector)
import qualified Data.Vector as V
import Debug.Trace
parseInput :: Parser [Int]
parseInput = decimal `sepBy` " "
-- 1. If the stone is engraved with the number 0, it is replaced by a stone
-- engraved with the number 1.
-- 2. If the stone is engraved with a number that has an even number of digits,
-- it is replaced by two stones. The left half of the digits are engraved on
-- the new left stone, and the right half of the digits are engraved on the
-- new right stone. (The new numbers don't keep extra leading zeroes: 1000
-- would become stones 10 and 0.)
-- 3. If none of the other rules apply, the stone is replaced by a new stone; the
-- old stone's number multiplied by 2024 is engraved on the new stone.
applyRule :: Int -> Vector Int
applyRule 0 = whnfElements $ V.singleton 1
applyRule n
| even leng && n > 9 =
whnfElements $ V.fromList [n `div` 10 ^ half, n `mod` 10 ^ half]
where
half :: Int
half = leng `div` 2
leng :: Int
leng = ceiling (logBase 10 (fromIntegral n) :: Float)
applyRule n = whnfElements $ V.singleton $ n * 2024
whnfElements :: Vector a -> Vector a
whnfElements v = V.foldl' (flip seq) () v `seq` v
solveA :: Vector Int -> Int
solveA = V.length . curry iterThis 25
solveA' :: [Int] -> Int
solveA' = sum . map (lenMemo 25)
iterThis :: (Int, Vector Int) -> Vector Int
iterThis (0, vx) = vx
iterThis (n, vx) = iterThis (n - 1, whnfElements $ V.concatMap applyRule vx)
len :: (Int -> Int -> Int) -> Int -> Int -> Int
len _ 0 _ = 1
len f i x = traceShow i $ sum (fmap (f (i - 1)) (applyRule x))
memoize :: (Int -> a) -> (Int -> a)
memoize f = (map f [0 ..] !!)
lenMemo :: Int -> Int -> Int
lenMemo = fix (memoize . len)
solveB :: [Int] -> Int
solveB = sum . map (lenMemo 75)
inputEx :: [Int]
inputEx = [125, 17]
main :: IO ()
main = do
Right input <- parseOnly parseInput <$> T.readFile "inputs/day11.input"
putStrLn "Part 1"
print $ solveA $ V.fromList inputEx
print $ solveA $ V.fromList input
print $ solveA' input
putStrLn "Part 2"
print $ solveB input