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]