adventofcode1608/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]