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
  23 showScreen :: Screen -> String
  24 showScreen screen = unlines [showRow r | r <- [minRow..maxRow]]
  25     where ((minRow, minCol), (maxRow, maxCol)) = bounds screen
  26           showCell True  = '#'
  27           showCell False = '.'
  28           showRow r = [showCell (screen!(r, c)) | c <- [minCol..maxCol]]
  29
  30 countLights :: Screen -> Int
  31 countLights screen = length $ filter (id) $ elems screen
  32
  33 screen0 = mkScreen 50 6
  34
  35 instrs = [ Rect 3 2
  36          , Rotate Column 1 1
  37          , Rotate Row 0 4
  38          , Rotate Column 1 1
  39          , Rotate Row 1 6
  40          , Rotate Row 2 8
  41          , Rect 1 3
  42          ]
  43
  44 main :: IO ()
  45 main = do
  46     text <- readFile "advent08.txt"
  47     let instrs = successfulParse $ parseCommands text
  48     -- print instrs
  49     part1 instrs
  50     part2 instrs
  51
  52 part1 :: [Command] -> IO ()
  53 part1 instructions =
  54     putStrLn $ showScreen $ (extractScreen . doInstructions) instructions
  55
  56 part2 :: [Command] -> IO ()
  57 part2 instructions =
  58     print $ countLights $ (extractScreen . doInstructions) instructions
  59
  60 instance Functor ScState where
  61   fmap = liftM
  62
  63 instance Applicative ScState where
  64   pure  = return
  65   (<*>) = ap
  66
  67 instance Monad (ScState) where
  68     return x = ScState (\screen -> (screen, x))
  69
  70     (ScState st) >>= f
  71         = ScState (\screen -> let
  72                             (newScreen, y) = st screen
  73                             (ScState transformer) = f y
  74                             in
  75                             transformer newScreen)
  76
  77 doInstructions [] = return 0
  78 doInstructions (i:is) =
  79     do doInstruction i
  80        doInstructions is
  81        return 0
  82
  83 doInstruction i = ScState (execute i)
  84
  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)
  88
  89 extractScreen (ScState st) = fst (st screen0)
  90
  91 parseCommands :: String -> Either ParseError [Command]
  92 parseCommands input = parse commandFile "(unknown)" input
  93
  94 commandFile = commandLine `endBy` newline
  95 commandLine = (try rectCommand) <|> rotateCommand
  96
  97 rectCommand =
  98     do  string "rect"
  99         spaces
 100         w <- (many1 digit)
 101         char 'x'
 102         h <- (many1 digit)
 103         return (Rect (read w) (read h))
 104
 105 rotateCommand =
 106     do  string "rotate"
 107         spaces
 108         direction <- (string "row" <|> string "column")
 109         spaces
 110         string "x=" <|> string "y="
 111         index <- (many1 digit)
 112         spaces
 113         string "by"
 114         spaces
 115         distance <- (many1 digit)
 116         return (buildCommand direction index distance)
 117
 118 buildCommand "row" i d = Rotate Row (read i) (read d)
 119 buildCommand "column" i d = Rotate Column (read i) (read d)
 120
 121 successfulParse :: Either ParseError [a] -> [a]
 122 successfulParse (Left _) = []
 123 successfulParse (Right a) = a
 124
 125
 126
 127
 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)]]
 131
 132 rotateColumn :: Screen -> Int -> Int -> Screen
 133 rotateColumn screen column givenShift = screen // newCells
 134     where
 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]
 142
 143 rotateRow :: Screen -> Int -> Int -> Screen
 144 rotateRow screen row givenShift = screen // newCells
 145     where
 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]