55 lines
1.2 KiB
Haskell
55 lines
1.2 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Days.D10 where
|
|
|
|
import Common
|
|
import Parse
|
|
|
|
import Data.List.Extra (chunksOf)
|
|
import Text.Megaparsec ((<|>))
|
|
import Text.Megaparsec.Char (space, string)
|
|
|
|
data Instruction = Noop | Addx Int
|
|
|
|
type Trace = [Int]
|
|
|
|
parser :: Parser [Instruction]
|
|
parser = someLines instruction
|
|
where
|
|
instruction :: Parser Instruction
|
|
instruction = (Noop <$ string "noop") <|> (Addx <$ string "addx" <* space <*> int)
|
|
|
|
trace :: [Instruction] -> Trace
|
|
trace =
|
|
scanl (+) 1
|
|
. foldMap
|
|
( \case
|
|
Noop -> [0]
|
|
Addx x -> [0, x]
|
|
)
|
|
|
|
snapshot :: [Int] -> [a] -> [a]
|
|
snapshot idxs l = [l !! (ix - 1) | ix <- idxs]
|
|
|
|
cycles :: [Int]
|
|
cycles = [20, 60, 100, 140, 180, 220]
|
|
|
|
part1 :: Trace -> Int
|
|
part1 = sum . zipWith (*) cycles . snapshot cycles
|
|
|
|
part2 :: Trace -> String
|
|
part2 = parseCRT . screenCrop . zipWith ((render .) . inRange) (cycle [0 .. 39])
|
|
where
|
|
inRange :: Int -> Int -> Bool
|
|
inRange a b = let d = b - a in d == 0 || d == 1 || d == -1
|
|
|
|
render :: Bool -> Char
|
|
render True = '#'
|
|
render False = '.'
|
|
|
|
screenCrop :: String -> [String]
|
|
screenCrop = take 6 . chunksOf 40
|
|
|
|
day :: Day
|
|
day = parsecDay (trace <$> parser) (definitive . part1, definitive . part2) |