74 lines
2.2 KiB
Haskell
74 lines
2.2 KiB
Haskell
{-# 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
|