feat(2024/Day17)

Author: goblivend

2024/Day17/Day17.hs

@@ -0,0 +1,80 @@
+module Main where
+
+import Data.Bits
+import Data.Char
+import Data.List
+import Data.List.Split
+import Data.List.Unique
+import Data.Matrix (Matrix, (!))
+import Data.Matrix qualified as Mat
+import Data.Set (Set)
+import Data.Set qualified as S
+import Data.Tuple.Extra
+import Debug.Trace
+import GHC.Integer (shiftRInteger)
+import GHC.Num (integerFromInt, integerToInt)
+import System.Environment
+import Text.Regex.TDFA ((=~))
+
+-- TODO: Cleanup imports after day done
+
+data Input = Computer {program :: [Integer], programCounter :: Int, registerA :: Integer, registerB :: Integer, registerC :: Integer, output :: [Integer]} deriving (Show, Eq, Ord)
+
+type Output = Integer
+
+parseInput :: String -> Input
+parseInput input = Computer pg 0 regA regB regC []
+  where
+    [lRegA, lRegB, lRegC, _, lPg] = lines input
+    readVal = read . dropWhile (not . isDigit)
+    regA = readVal lRegA
+    regB = readVal lRegB
+    regC = readVal lRegC
+    pg = read . (\l -> "[" ++ l ++ "]") . dropWhile (not . isDigit) $ lPg
+
+getValue :: Input -> Integer -> Integer
+getValue (Computer _ _ rA _ _ _) 4 = rA
+getValue (Computer _ _ _ rB _ _) 5 = rB
+getValue (Computer _ _ _ _ rC _) 6 = rC
+getValue (Computer _ _ _ _ _ _) n = n
+
+calculateOp :: Input -> Integer -> Integer -> Input
+calculateOp (c@(Computer _ pc rA rB rC out)) 0 n = c {programCounter = pc + 2, registerA = rA `div` (2 ^ (getValue c n))}
+calculateOp (c@(Computer _ pc rA rB rC out)) 1 n = c {programCounter = pc + 2, registerB = rB `xor` n}
+calculateOp (c@(Computer _ pc rA rB rC out)) 2 n = c {programCounter = pc + 2, registerB = (getValue c n) `mod` 8}
+calculateOp (c@(Computer _ pc 00 rB rC out)) 3 n = c {programCounter = pc + 2}
+calculateOp (c@(Computer _ pc rA rB rC out)) 3 n = c {programCounter = integerToInt $ getValue c n}
+calculateOp (c@(Computer _ pc rA rB rC out)) 4 n = c {programCounter = pc + 2, registerB = rB `xor` rC}
+calculateOp (c@(Computer _ pc rA rB rC out)) 5 n = c {programCounter = pc + 2, output = (getValue c n) `mod` 8 : out}
+calculateOp (c@(Computer _ pc rA rB rC out)) 6 n = c {programCounter = pc + 2, registerB = rA `div` (2 ^ (getValue c n))}
+calculateOp (c@(Computer _ pc rA rB rC out)) 7 n = c {programCounter = pc + 2, registerC = rA `div` (2 ^ (getValue c n))}
+
+performOps :: Input -> [Output]
+performOps (c@(Computer pg pc _ _ _ out))
+  | pc >= length pg = reverse out
+  | otherwise = performOps $ calculateOp c op comboOp
+  where
+    op = pg !! pc
+    comboOp = pg !! (pc + 1)
+
+part1 :: Input -> [Output]
+part1 = performOps
+
+part2 :: Input -> Output
+part2 input = head $ sub' 1 0
+  where
+    sub' p v
+      | (== p) . length $ program input = currIt
+      | otherwise = concat $ map (sub' (p + 1)) currIt
+      where
+        currIt = filter (\i -> (`isSuffixOf` program input) . performOps $ input {registerA = i}) [8 * v .. 8 * v + 7]
+
+main :: IO ()
+main = do
+  args <- getArgs
+  content <- readFile (last args)
+  let input = parseInput content
+  print input
+
+  print $ part1 input
+  print $ part2 input

2024/Day17/Makefile

@@ -0,0 +1,28 @@
+CONTAINER_NAME=haskell-aoc
+SRC=./Day17.hs
+TARGET=Day17
+all: $(TARGET)
+
+$(TARGET): $(SRC)
+	ghc -O3 $(SRC)
+
+profile: $(SRC)
+
+
+clean:
+	$(RM) ./Day17 ./Day17.o ./Day17.hi
+
+setup: $(SRC)
+	docker cp $(SRC) $(CONTAINER_NAME):/home/haskell/Main.hs
+	docker cp input.txt $(CONTAINER_NAME):/home/haskell/input.txt
+	docker cp shortinput.txt $(CONTAINER_NAME):/home/haskell/shortinput.txt
+
+profiling: setup
+	docker exec -it $(CONTAINER_NAME) cabal build --enable-profiling
+	docker exec -it $(CONTAINER_NAME) ./profile input.txt
+
+run: setup
+	docker exec -it $(CONTAINER_NAME) cabal build
+	docker exec -it $(CONTAINER_NAME) ./run input.txt
+
+.PHONY: all $(TARGET) clean setup profiling run

2024/Day17/input.txt

@@ -0,0 +1,5 @@
+Register A: 66171486
+Register B: 0
+Register C: 0
+
+Program: 2,4,1,6,7,5,4,6,1,4,5,5,0,3,3,0

2024/Day17/shortinput.txt

@@ -0,0 +1,5 @@
+Register A: 729
+Register B: 0
+Register C: 0
+
+Program: 0,1,5,4,3,0

2024/Day17/shortinput2.txt

@@ -0,0 +1,5 @@
+Register A: 2024
+Register B: 0
+Register C: 0
+
+Program: 0,3,5,4,3,0

2024/README.md

@@ -15,10 +15,10 @@ This year will do it in Haskell, but might try few days in Rust as well
 - [x] Day 11
 - [x] Day 12
 - [x] Day 13
-- [ ] Day 14
-- [ ] Day 15
-- [ ] Day 16
-- [ ] Day 17
+- [x] Day 14
+- [x] Day 15
+- [x] Day 16
+- [?] Day 17
 - [ ] Day 18
 - [ ] Day 19
 - [ ] Day 20
@@ -238,3 +238,20 @@ But then at the moment when I reach the last intersection I need to go back up t
 ```
 
 The optimization would allow me to skip this last part represented with `X`
+
+### Day17
+
+The first part was a simple computer simulation.
+
+For the second one I didn't really succeed on my own...
+
+Sadly in order to find the result I had to look at tips on how to solve it.
+
+Basically each instruction corresponds to a byte in the register A
+
+The register A is basically reduced like `out A%8, A = A/8`, so to build the register A you just have to go backward :
+- For the last instruction, check all results for `regA in [0..7]`
+- For the one before, check all the results for `regA in [prev*8..prev*8+7]`
+- Continue recursively until you get all the numbers
+
+Even though I didn't solve this one on my own I learnt how to analyze the output in order to find results