This commit is contained in:
Jens Kadenbach
2022-12-12 09:57:32 +01:00
parent 08306ed57d
commit 17e4d9d0ab
5 changed files with 415 additions and 1 deletions

View File

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

139
ressources/day10-input Normal file
View File

@@ -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

79
src/Day10.hs Normal file
View File

@@ -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)

View File

@@ -11,9 +11,10 @@ import Day6 (day6)
import Day7 (day7) import Day7 (day7)
import Day8 (day8) import Day8 (day8)
import Day9 (day9) import Day9 (day9)
import Day10 (day10)
days :: [IO ()] 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 :: IO ()
sep = putStrLn "---------" sep = putStrLn "---------"

193
test/Day10Spec.hs Normal file
View File

@@ -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