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