From a42f7bbbe13fdf33bd26882f75e4a73c694ab7e8 Mon Sep 17 00:00:00 2001
From: Daniele Fucini <dfucini@gmail.com>
Date: Sat, 21 Dec 2024 17:40:09 +0100
Subject: [PATCH] Day 17, Part 2 (slow)

---
 src/Day17.hs | 20 +++++++++++++++++++-
 src/Main.hs  |  6 +++++-
 2 files changed, 24 insertions(+), 2 deletions(-)

diff --git a/src/Day17.hs b/src/Day17.hs
index cdd8a1d..20de2e3 100644
--- a/src/Day17.hs
+++ b/src/Day17.hs
@@ -1,6 +1,7 @@
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+{-# OPTIONS_GHC -Wno-type-defaults #-}
 
-module Day17 (day17_1) where
+module Day17 (day17_1, day17_2) where
 
 import Control.Monad.State
 import Data.Bits
@@ -115,6 +116,11 @@ runProgram = do
         _ -> return ()
       runProgram
 
+checkIfCreatesCopy :: Computer -> Bool
+checkIfCreatesCopy c =
+  let o = map read . filter (not . null) . splitOn "," . output $ execState runProgram c
+   in o == program c
+
 day17_1 :: IO ()
 day17_1 = do
   contents <- lines <$> readFile "input/day17.txt"
@@ -124,3 +130,15 @@ day17_1 = do
       computer = Computer {registerA = fst . fromJust $ uncons registers, registerB = registers !! 1, registerC = registers !! 2, pointer = 0, program = prog, output = ""}
   putStr "Day 17, Puzzle 1 solution: "
   print . drop 1 . output $ execState runProgram computer
+
+day17_2 :: IO ()
+day17_2 = do
+  contents <- lines <$> readFile "input/day17.txt"
+  let [r, [p]] = splitOn [""] contents
+      registers = map (read . filter isDigit) r
+      prog = map (read . filter isDigit) $ splitOn "," p
+      computer = Computer {registerA = 0, registerB = registers !! 1, registerC = registers !! 2, pointer = 0, program = prog, output = ""}
+      regA = [805464 * 2 ^ 27 ..] -- Threshold derived empirically, a better threshold must be possible because this is very slow, but got the correct answer.
+  putStrLn $
+    "Day 17, Puzzle 2 solution: "
+      ++ show (fst . fromJust . uncons $ dropWhile (\x -> not (checkIfCreatesCopy computer {registerA = x})) regA)
diff --git a/src/Main.hs b/src/Main.hs
index 8754d9b..6047577 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -15,7 +15,7 @@ import Day12 (day12_1)
 import Day13 (day13_1, day13_2)
 import Day14 (day14_1, day14_2)
 import Day15 (day15_1)
-import Day17 (day17_1)
+import Day17 (day17_1, day17_2)
 import Day18 (day18_1, day18_2)
 import Day19 (day19_1)
 import System.Environment (getArgs)
@@ -92,6 +92,10 @@ main = do
       day14_2
     "15" : "1" : _ -> day15_1
     "17" : "1" : _ -> day17_1
+    "17" : "2" : _ -> day17_2
+    "17" : _ -> do
+        day17_1
+        day17_2
     "18" : "1" : _ -> day18_1
     "18" : "2" : _ -> day18_2
     "18" : _ -> do