ccf2de0f735e28b21e7115ab22f8186447ef9e7d
[advent-of-code-16.git] / app / advent08.hs
1 module Main(main) where
2
3 import Data.Array.IArray
4 import Text.Parsec
5 import Control.Monad (liftM, ap)
6
7 -- Row 1 is top, column 1 is left
8 type Position = (Int, Int)
9 type Screen = Array Position Bool
10
11 data Direction = Row | Column deriving (Show)
12 data Command = Rect Int Int | Rotate Direction Int Int deriving (Show)
13
14 data ScState a = ScState (Screen -> (Screen, a))
15
16 mkScreen :: Int -> Int -> Screen
17 mkScreen w h = array ((0, 0), (h - 1, w - 1))
18 [((i, j), False) | i <- [0..(h-1)], j <- [0..(w-1)]]
19
20 showScreen :: Screen -> String
21 showScreen screen = unlines [showRow r | r <- [minRow..maxRow]]
22 where ((minRow, minCol), (maxRow, maxCol)) = bounds screen
23 showCell True = '*'
24 showCell False = ' '
25 showRow r = [showCell (screen!(r, c)) | c <- [minCol..maxCol]]
26
27 countLights :: Screen -> Int
28 countLights screen = length $ filter (id) $ elems screen
29
30 screen0 :: Screen
31 screen0 = mkScreen 50 6
32
33
34 main :: IO ()
35 main = do
36 text <- readFile "data/advent08.txt"
37 let instrs = successfulParse $ parseCommands text
38 part1 instrs
39 part2 instrs
40
41 part1 :: [Command] -> IO ()
42 part1 commands =
43 print $ countLights $ (extractScreen . doCommands) commands
44
45 part2 :: [Command] -> IO ()
46 part2 commands =
47 putStrLn $ showScreen $ (extractScreen . doCommands) commands
48
49
50 instance Functor ScState where
51 fmap = liftM
52
53 instance Applicative ScState where
54 pure = return
55 (<*>) = ap
56
57 instance Monad ScState where
58 return x = ScState (\screen -> (screen, x))
59
60 (ScState st) >>= f
61 = ScState (\screen -> let
62 (newScreen, y) = st screen
63 (ScState transformer) = f y
64 in
65 transformer newScreen)
66
67 doCommands :: [Command] -> ScState (Int)
68 doCommands [] = return 0
69 doCommands (i:is) =
70 do doCommand i
71 doCommands is
72 return 0
73
74 doCommand :: Command -> ScState Int
75 doCommand i = ScState (execute i)
76
77 execute :: Command -> (Screen -> (Screen, Int))
78 execute (Rect w h) screen = (rect screen w h, 0)
79 execute (Rotate Column c n) screen = (rotateColumn screen c n, 0)
80 execute (Rotate Row r n) screen = (rotateRow screen r n, 0)
81
82 extractScreen :: ScState Int -> Screen
83 extractScreen (ScState st) = fst (st screen0)
84
85
86
87 parseCommands :: String -> Either ParseError [Command]
88 parseCommands input = parse commandFile "(unknown)" input
89
90 commandFile = commandLine `endBy` newline
91 commandLine = (try rectCommand) <|> rotateCommand
92
93 rectCommand =
94 do string "rect"
95 spaces
96 w <- (many1 digit)
97 char 'x'
98 h <- (many1 digit)
99 return (Rect (read w) (read h))
100
101 rotateCommand =
102 do string "rotate"
103 spaces
104 direction <- (string "row" <|> string "column")
105 spaces
106 string "x=" <|> string "y="
107 index <- (many1 digit)
108 spaces
109 string "by"
110 spaces
111 distance <- (many1 digit)
112 return (buildCommand direction index distance)
113
114 buildCommand "row" i d = Rotate Row (read i) (read d)
115 buildCommand "column" i d = Rotate Column (read i) (read d)
116
117 successfulParse :: Either ParseError [a] -> [a]
118 successfulParse (Left _) = []
119 successfulParse (Right a) = a
120
121
122
123
124 rect :: Screen -> Int -> Int -> Screen
125 rect screen w h = screen // newBits
126 where newBits = [((i, j), True) | i <- [0..(h-1)], j <- [0..(w-1)]]
127
128 rotateColumn :: Screen -> Int -> Int -> Screen
129 rotateColumn screen column givenShift = screen // newCells
130 where
131 ((minRow, minCol), (maxRow, maxCol)) = bounds screen
132 colLength = 1 + maxRow - minRow
133 shift = givenShift `mod` colLength
134 offset = colLength - shift
135 column0 = [screen!(r, column) | r <- [minRow..maxRow]]
136 newColumn = (drop offset column0) ++ (take offset column0)
137 newCells = [((r, column), cell) | (r, cell) <- zip [minRow..maxRow] newColumn]
138
139 rotateRow :: Screen -> Int -> Int -> Screen
140 rotateRow screen row givenShift = screen // newCells
141 where
142 ((minRow, minCol), (maxRow, maxCol)) = bounds screen
143 rowLength = 1 + maxCol - minCol
144 shift = givenShift `mod` rowLength
145 offset = rowLength - shift
146 row0 = [screen!(row, c) | c <- [minCol..maxCol]]
147 newRow = (drop offset row0) ++ (take offset row0)
148 newCells = [((row, c), cell) | (c, cell) <- zip [minCol..maxCol] newRow]