1 module Main(main) where
3 import Data.Array.IArray
5 -- import Control.Applicative
6 import Control.Applicative ((<$), (<*), (*>), (<*>), pure, liftA)
7 import Control.Monad (liftM, ap)
9 -- Row 1 is top, column 1 is left
10 type Position = (Int, Int)
11 type Screen = Array Position Bool
13 data Direction = Row | Column deriving (Show)
14 data Command = Rect Int Int | Rotate Direction Int Int deriving (Show)
16 data ScState a = ScState (Screen -> (Screen, a))
18 mkScreen :: Int -> Int -> Screen
19 mkScreen w h = array ((0, 0), (h - 1, w - 1))
20 [((i, j), False) | i <- [0..(h-1)], j <- [0..(w-1)]]
23 showScreen :: Screen -> String
24 showScreen screen = unlines [showRow r | r <- [minRow..maxRow]]
25 where ((minRow, minCol), (maxRow, maxCol)) = bounds screen
28 showRow r = [showCell (screen!(r, c)) | c <- [minCol..maxCol]]
30 countLights :: Screen -> Int
31 countLights screen = length $ filter (id) $ elems screen
33 screen0 = mkScreen 50 6
46 text <- readFile "advent08.txt"
47 let instrs = successfulParse $ parseCommands text
52 part1 :: [Command] -> IO ()
54 putStrLn $ showScreen $ (extractScreen . doInstructions) instructions
56 part2 :: [Command] -> IO ()
58 print $ countLights $ (extractScreen . doInstructions) instructions
60 instance Functor ScState where
63 instance Applicative ScState where
67 instance Monad (ScState) where
68 return x = ScState (\screen -> (screen, x))
71 = ScState (\screen -> let
72 (newScreen, y) = st screen
73 (ScState transformer) = f y
75 transformer newScreen)
77 doInstructions [] = return 0
78 doInstructions (i:is) =
83 doInstruction i = ScState (execute i)
85 execute (Rect w h) screen = (rect screen w h, 0)
86 execute (Rotate Column c n) screen = (rotateColumn screen c n, 0)
87 execute (Rotate Row r n) screen = (rotateRow screen r n, 0)
89 extractScreen (ScState st) = fst (st screen0)
91 parseCommands :: String -> Either ParseError [Command]
92 parseCommands input = parse commandFile "(unknown)" input
94 commandFile = commandLine `endBy` newline
95 commandLine = (try rectCommand) <|> rotateCommand
103 return (Rect (read w) (read h))
108 direction <- (string "row" <|> string "column")
110 string "x=" <|> string "y="
111 index <- (many1 digit)
115 distance <- (many1 digit)
116 return (buildCommand direction index distance)
118 buildCommand "row" i d = Rotate Row (read i) (read d)
119 buildCommand "column" i d = Rotate Column (read i) (read d)
121 successfulParse :: Either ParseError [a] -> [a]
122 successfulParse (Left _) = []
123 successfulParse (Right a) = a
128 rect :: Screen -> Int -> Int -> Screen
129 rect screen w h = screen // newBits
130 where newBits = [((i, j), True) | i <- [0..(h-1)], j <- [0..(w-1)]]
132 rotateColumn :: Screen -> Int -> Int -> Screen
133 rotateColumn screen column givenShift = screen // newCells
135 ((minRow, minCol), (maxRow, maxCol)) = bounds screen
136 colLength = 1 + maxRow - minRow
137 shift = givenShift `mod` colLength
138 offset = colLength - shift
139 column0 = [screen!(r, column) | r <- [minRow..maxRow]]
140 newColumn = (drop offset column0) ++ (take offset column0)
141 newCells = [((r, column), cell) | (r, cell) <- zip [minRow..maxRow] newColumn]
143 rotateRow :: Screen -> Int -> Int -> Screen
144 rotateRow screen row givenShift = screen // newCells
146 ((minRow, minCol), (maxRow, maxCol)) = bounds screen
147 rowLength = 1 + maxCol - minCol
148 shift = givenShift `mod` rowLength
149 offset = rowLength - shift
150 row0 = [screen!(row, c) | c <- [minCol..maxCol]]
151 newRow = (drop offset row0) ++ (take offset row0)
152 newCells = [((row, c), cell) | (c, cell) <- zip [minCol..maxCol] newRow]