Day 10

aoc2022.cabal

@@ -27,6 +27,7 @@ library
   exposed-modules:
       Day1
       Day1.Internal
+      Day10
       Day2
       Day2.Part1
       Day2.Part2
@@ -100,6 +101,7 @@ test-suite aoc2022-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
+      Day10Spec
       Day1Spec
       Day2Spec
       Day3Spec

ressources/day10-input

@@ -0,0 +1,139 @@
+addx 1
+noop
+noop
+noop
+addx 5
+addx 5
+noop
+noop
+addx 9
+addx -5
+addx 1
+addx 4
+noop
+noop
+noop
+addx 6
+addx -1
+noop
+addx 5
+addx -2
+addx 7
+noop
+addx 3
+addx -2
+addx -38
+noop
+noop
+addx 32
+addx -22
+noop
+addx 2
+addx 3
+noop
+addx 2
+addx -2
+addx 7
+addx -2
+noop
+addx 3
+addx 2
+addx 5
+addx 2
+addx -5
+addx 10
+noop
+addx 3
+noop
+addx -38
+addx 1
+addx 27
+noop
+addx -20
+noop
+addx 2
+addx 27
+noop
+addx -22
+noop
+noop
+noop
+noop
+addx 3
+addx 5
+addx 2
+addx -11
+addx 16
+addx -2
+addx -17
+addx 24
+noop
+noop
+addx 1
+addx -38
+addx 15
+addx 10
+addx -15
+noop
+addx 2
+addx 26
+noop
+addx -21
+addx 19
+addx -33
+addx 19
+noop
+addx -6
+addx 9
+addx 3
+addx 4
+addx -21
+addx 4
+addx 20
+noop
+addx 3
+addx -38
+addx 28
+addx -21
+addx 9
+addx -8
+addx 2
+addx 5
+addx 2
+addx -9
+addx 14
+addx -2
+addx -5
+addx 12
+addx 3
+addx -2
+addx 2
+addx 7
+noop
+noop
+addx -27
+addx 28
+addx -36
+noop
+addx 1
+addx 5
+addx -1
+noop
+addx 6
+addx -1
+addx 5
+addx 5
+noop
+noop
+addx -2
+addx 20
+addx -10
+addx -3
+addx 1
+addx 3
+addx 2
+addx 4
+addx 3
+noop
+addx -30
+noop

src/Day10.hs

@@ -0,0 +1,79 @@
+module Day10
+  ( Instruction (..),
+    parseProgram,
+    signalStrength,
+    executeProgram,
+    draw,
+    isSpriteDrawn,
+    day10
+  )
+where
+
+import Control.Arrow ((>>>))
+import qualified Data.Matrix as M
+import Debug.Trace (trace)
+import Data.List.Split (chunksOf)
+import Data.List (intercalate)
+
+data Instruction = Addx Int | Noop
+  deriving (Show, Eq)
+
+newtype Pixel = Pixel Bool deriving (Eq)
+
+instance Show Pixel where
+  show (Pixel True) = "▓"
+  show (Pixel False) = "░"
+
+
+type CRT = String
+
+parseProgram :: String -> [Instruction]
+parseProgram = lines >>> map parseProgram'
+  where
+    parseProgram' :: String -> Instruction
+    parseProgram' "noop" = Noop
+    parseProgram' line = splitAt 4 >>> snd >>> read >>> Addx $ line
+
+
+isSpriteDrawn :: Int -> Int -> Bool
+isSpriteDrawn x p = abs (position - x) <= 1
+  where
+    position = p `mod` 40
+
+draw :: [Int] -> CRT
+draw registerValues = unlines lastPicture
+  where
+    pictures = zipWith isSpriteDrawn registerValues [0..]
+    lastPicture = concatMap (show . Pixel) >>> chunksOf 40 $ pictures
+
+
+
+signalStrength :: [Int] -> Int
+signalStrength e = start + sum computedRest
+  where
+    start = e !! 20 * 20
+    rest = drop 20 e
+    withCycle = zip [60, 100..] (every 40 rest)
+    computedRest = [c*r | (c,r) <- withCycle]
+
+every :: Int -> [a] -> [a]
+every n xs = case drop (n-1) xs of
+              y : ys -> y : every n ys
+              [] -> []
+
+executeProgram :: [Instruction] -> [Int]
+executeProgram = scanl (+) 1 . concatMap execOne
+  where
+    execOne instruction = case instruction of
+        Noop   -> [0]
+        Addx x -> [0, x]
+
+day10 :: IO ()
+day10 = do
+  input <- readFile "ressources/day10-input"
+  putStrLn "Day10"
+  let states = parseProgram >>> executeProgram $ input
+  let signal = signalStrength states
+  let crt = draw states
+  putStrLn ("Signal strength: " ++ show signal)
+  putStrLn ("CRT picture: \n" ++ crt)

src/Lib.hs

@@ -11,9 +11,10 @@ import Day6 (day6)
 import Day7 (day7)
 import Day8 (day8)
 import Day9 (day9)
+import Day10 (day10)
 
 days :: [IO ()]
-days = [day1, day2, day3, day4, day5, day6, day7, day8, day9]
+days = [day1, day2, day3, day4, day5, day6, day7, day8, day9, day10]
 
 sep :: IO ()
 sep = putStrLn "---------"

test/Day10Spec.hs

@@ -0,0 +1,193 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Day10Spec (spec) where
+
+import Control.Arrow ((>>>))
+import Day10
+import Test.Hspec
+import Text.Heredoc
+
+testInput :: String
+testInput = [str|noop
+                |addx 3
+                |addx -5
+                |]
+
+testProgram :: [Instruction]
+testProgram = [Noop, Addx 3, Addx (-5)]
+
+testInput2 :: String
+testInput2 = [str|addx 15
+                 |addx -11
+                 |addx 6
+                 |addx -3
+                 |addx 5
+                 |addx -1
+                 |addx -8
+                 |addx 13
+                 |addx 4
+                 |noop
+                 |addx -1
+                 |addx 5
+                 |addx -1
+                 |addx 5
+                 |addx -1
+                 |addx 5
+                 |addx -1
+                 |addx 5
+                 |addx -1
+                 |addx -35
+                 |addx 1
+                 |addx 24
+                 |addx -19
+                 |addx 1
+                 |addx 16
+                 |addx -11
+                 |noop
+                 |noop
+                 |addx 21
+                 |addx -15
+                 |noop
+                 |noop
+                 |addx -3
+                 |addx 9
+                 |addx 1
+                 |addx -3
+                 |addx 8
+                 |addx 1
+                 |addx 5
+                 |noop
+                 |noop
+                 |noop
+                 |noop
+                 |noop
+                 |addx -36
+                 |noop
+                 |addx 1
+                 |addx 7
+                 |noop
+                 |noop
+                 |noop
+                 |addx 2
+                 |addx 6
+                 |noop
+                 |noop
+                 |noop
+                 |noop
+                 |noop
+                 |addx 1
+                 |noop
+                 |noop
+                 |addx 7
+                 |addx 1
+                 |noop
+                 |addx -13
+                 |addx 13
+                 |addx 7
+                 |noop
+                 |addx 1
+                 |addx -33
+                 |noop
+                 |noop
+                 |noop
+                 |addx 2
+                 |noop
+                 |noop
+                 |noop
+                 |addx 8
+                 |noop
+                 |addx -1
+                 |addx 2
+                 |addx 1
+                 |noop
+                 |addx 17
+                 |addx -9
+                 |addx 1
+                 |addx 1
+                 |addx -3
+                 |addx 11
+                 |noop
+                 |noop
+                 |addx 1
+                 |noop
+                 |addx 1
+                 |noop
+                 |noop
+                 |addx -13
+                 |addx -19
+                 |addx 1
+                 |addx 3
+                 |addx 26
+                 |addx -30
+                 |addx 12
+                 |addx -1
+                 |addx 3
+                 |addx 1
+                 |noop
+                 |noop
+                 |noop
+                 |addx -9
+                 |addx 18
+                 |addx 1
+                 |addx 2
+                 |noop
+                 |noop
+                 |addx 9
+                 |noop
+                 |noop
+                 |noop
+                 |addx -1
+                 |addx 2
+                 |addx -37
+                 |addx 1
+                 |addx 3
+                 |noop
+                 |addx 15
+                 |addx -21
+                 |addx 22
+                 |addx -6
+                 |addx 1
+                 |noop
+                 |addx 2
+                 |addx 1
+                 |noop
+                 |addx -10
+                 |noop
+                 |noop
+                 |addx 20
+                 |addx 1
+                 |addx 2
+                 |addx 2
+                 |addx -6
+                 |addx -11
+                 |noop
+                 |noop
+                 |noop
+                |]
+
+spec :: Spec
+spec =
+  describe "Day10" $ do
+    describe "Part1" $ do
+      it "parses" $ do
+        parseProgram testInput `shouldBe` testProgram
+      it "executes" $ do
+        executeProgram testProgram `shouldBe` [1,1,1,4,4,-1]
+      it "executes larger program" $ do
+        let registerValues = parseProgram >>> executeProgram $ testInput2
+        registerValues !! 20 `shouldBe` 21
+        registerValues !! 60 `shouldBe` 19
+        registerValues !! 100 `shouldBe` 18
+        registerValues !! 140 `shouldBe` 21
+        registerValues !! 180 `shouldBe` 16
+        registerValues !! 220 `shouldBe` 18
+      it "computes signal strength" $ do
+        let registerValues = parseProgram >>> executeProgram $ testInput2
+        signalStrength registerValues `shouldBe` 13140
+      it "prints a crt" $ do
+        let registerValues = parseProgram >>> executeProgram $ testInput2
+        putStrLn $ draw registerValues
+      it "sprites drawn" $ do
+        isSpriteDrawn 1 1 `shouldBe` True
+        isSpriteDrawn 1 1 `shouldBe` True
+