From 16a2a70f5714b87f348e45110bbc50ee0da9e4b5 Mon Sep 17 00:00:00 2001
From: Samae <eeva@samae>
Date: Sat, 21 Dec 2024 22:44:59 +0200
Subject: [PATCH] Day 11

---
 .gitignore         |  3 +-
 Main.hs            |  7 ++--
 flake.nix          |  1 +
 inputs/day11.input |  1 +
 package.yaml       |  8 +++--
 src/Day11.hs       | 82 ++++++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 96 insertions(+), 6 deletions(-)
 create mode 100644 inputs/day11.input
 create mode 100644 src/Day11.hs

diff --git a/.gitignore b/.gitignore
index 1bd6332..03cde98 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,7 +1,8 @@
 result*
 *.cabal
 dist-newstyle
-*.eventlog
+*.eventlog*
 *.prof
 *.dot
 *.pdf
+aoc24-debug.*
diff --git a/Main.hs b/Main.hs
index f96fb48..692accf 100644
--- a/Main.hs
+++ b/Main.hs
@@ -12,6 +12,7 @@ import Day7
 import Day8
 import Day9
 import Day10
+import Day11
 
 main :: IO ()
 main = do
@@ -34,5 +35,7 @@ main = do
   -- Day8.main
   -- putStrLn "Day 9"
   -- Day9.main
-  putStrLn "Day 10"
-  Day10.main
+  -- putStrLn "Day 10"
+  -- Day10.main
+  putStrLn "Day 11"
+  Day11.main
diff --git a/flake.nix b/flake.nix
index 93a5523..6d8711f 100644
--- a/flake.nix
+++ b/flake.nix
@@ -28,6 +28,7 @@
             ghcid
             cabal-install
             fourmolu
+            eventlog2html
           ];
         # Change the prompt to show that you are in a devShell
         shellHook = ''
diff --git a/inputs/day11.input b/inputs/day11.input
new file mode 100644
index 0000000..e034fb6
--- /dev/null
+++ b/inputs/day11.input
@@ -0,0 +1 @@
+5910927 0 1 47 261223 94788 545 7771
diff --git a/package.yaml b/package.yaml
index 1eb715d..2a5feb3 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,12 +1,13 @@
 name: aoc24
 
-ghc-options: -Wall -threaded
+ghc-options: -Wall -threaded -O2
 
 default-extensions:
   - OverloadedStrings
 
 dependencies:
   - base == 4.*
+  - MemoTrie
   - algebraic-graphs
   - async
   - attoparsec
@@ -15,6 +16,7 @@ dependencies:
   - hashable
   - linear
   - matrix
+  - mtl
   - parallel
   - recursion-schemes
   - safe
@@ -33,7 +35,7 @@ executables:
       - aoc24
   aoc24-debug:
     main: Main.hs
-    ghc-options: -Wall -threaded -rtsopts -prof #-fprof-auto
+    ghc-options: -Wall -threaded -O2 -rtsopts -prof -auto-all #-fprof-auto
     dependencies:
       - aoc24
 
@@ -50,7 +52,7 @@ library:
     - Day8
     - Day9
     - Day10
-    # - Day11
+    - Day11
     # - Day12
     # - Day13
     # - Day14
diff --git a/src/Day11.hs b/src/Day11.hs
new file mode 100644
index 0000000..5ed50a5
--- /dev/null
+++ b/src/Day11.hs
@@ -0,0 +1,82 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Day11 where
+
+import Control.Monad.State
+import Data.Attoparsec.Text (Parser, decimal, parseOnly, sepBy)
+import Data.Bifunctor (bimap)
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as Map
+import Data.Hashable (Hashable)
+import qualified Data.Text.IO as T
+
+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 -> Either Int (Int, Int)
+applyRule 0 = Left 1
+applyRule n | even leng = Right $ bimap read read $ splitAt half (show n)
+  where
+    half :: Int
+    half = leng `div` 2
+    leng :: Int
+    leng = length $ show n
+applyRule n = Left $ n * 2024
+
+solveA :: [Int] -> Int
+solveA = sum . map (\x -> evalState (len 25 x) Map.empty)
+
+-- borrowed from https://functional.computer/blog/memotries
+memoize ::
+  (Eq a, Ord a, Hashable a, Eq c, Ord c, Hashable c) =>
+  (a -> c -> State (HashMap (a, c) b) b) ->
+  a ->
+  c ->
+  State (HashMap (a, c) b) b
+memoize f counter val = do
+  computed <- get
+  case Map.lookup (counter, val) computed of
+    Just result ->
+      return result
+    Nothing -> do
+      result <- f counter val
+      modify $ Map.insert (counter, val) result
+      return result
+
+len :: Int -> Int -> State (HashMap (Int, Int) Int) Int
+len 0 _ = pure 1
+len i n = case applyRule n of
+  Left v -> lenMemo (i - 1) v
+  --  trace (unwords [show i, "(", show n, "):", show v, "(", show u, ")"]) u
+  Right (v1, v2) -> do
+    u1 <- lenMemo (i - 1) v1
+    u2 <- lenMemo (i - 1) v2
+    pure (u1 + u2)
+
+lenMemo :: Int -> Int -> State (HashMap (Int, Int) Int) Int
+lenMemo = memoize len
+
+solveB :: [Int] -> Int
+solveB = sum . map (\x -> evalState (len 75 x) Map.empty)
+
+inputEx :: [Int]
+inputEx = [125, 17]
+
+main :: IO ()
+main = do
+  Right input <- parseOnly parseInput <$> T.readFile "inputs/day11.input"
+  putStrLn "Part 1"
+  print $ solveA inputEx
+  print $ solveA input
+  putStrLn "Part 2"
+  print $ solveB input