advent20/Main.hs

   1 -- Writeup at https://work.njae.me.uk/2021/12/18/advent-of-code-2021-day-16/
   2
   3
   4 import Control.Monad.State.Strict
   5 import Control.Monad.Reader
   6 -- import Control.Monad.Writer
   7 import Control.Monad.RWS.Strict
   8 import Data.List
   9 import Data.Ix
  10 import Data.Maybe
  11
  12 import qualified Data.Set as S
  13 import Linear (V2(..), (^+^))
  14
  15 type Pixel = V2 Int -- row, column
  16
  17 data Image = Image
  18   { grid :: S.Set Pixel
  19   , distantPixel :: Bool
  20   , explicitRegion :: (Pixel, Pixel)
  21   } deriving (Eq, Show)
  22
  23 type Enhancement = [Bool]
  24
  25 type ImageEnhancer = RWS Enhancement [Int] Image
  26
  27 main :: IO ()
  28 main =
  29   do  text <- readFile "data/advent20.txt"
  30       let (enhancement, image) = parse text
  31       print $ part1 enhancement image
  32       print $ part2 enhancement image
  33
  34 -- part1 enhancement image = s
  35 --   where (s, image', _) = runRWS (enhanceImage 2) enhancement image
  36
  37 part1 enhancement image = fst $ evalRWS (enhanceImage 2) enhancement image
  38
  39 part2 enhancement image = fst $ evalRWS (enhanceImage 50) enhancement image
  40
  41 enhanceImage :: Int -> ImageEnhancer Int
  42 enhanceImage 0 = do image <- get
  43                     return $ S.size $ grid image
  44 enhanceImage n = do newImage
  45                     enhanceImage (n - 1)
  46
  47 newImage :: ImageEnhancer ()
  48 newImage =
  49   do  image <- get
  50       let region = explicitRegion image
  51       let region' = expandRegion region
  52       let heres = range region'
  53       let distant = distantPixel image
  54       newPixelStates <- mapM newPixel heres
  55       let grid' = S.fromList $ catMaybes newPixelStates
  56       enhancement <- ask
  57       let distant' = if distant then (last enhancement) else (head enhancement)
  58       put $ Image {grid = grid', distantPixel = distant', explicitRegion = region'}
  59
  60
  61 showImage :: Image -> String
  62 showImage image =
  63   unlines $ [ [showPixel (V2 r c) | c <- [minC..maxC] ] | r <- [minR..maxR]]
  64   where (V2 minR minC, V2 maxR maxC) = explicitRegion image
  65         g = grid image
  66         showPixel here = if here `S.member` g then '█' else ' '
  67
  68 newPixel :: Pixel -> ImageEnhancer (Maybe Pixel)
  69 newPixel here =
  70   do  stencil <- findStencil here
  71       let i = intify stencil
  72       enh <- ask
  73       return $ if enh!!i then Just here else Nothing
  74
  75 findStencil :: Pixel -> ImageEnhancer [Bool]
  76 findStencil here =
  77   do  let nbrs = map (here ^+^) neighbours
  78       g <- gets grid
  79       d <- gets distantPixel
  80       r <- gets explicitRegion
  81       return $ map (findContents g d r) nbrs
  82
  83 findContents :: S.Set Pixel -> Bool -> (Pixel, Pixel) -> Pixel -> Bool
  84 findContents grid distant region here
  85   | inRange region here = here `S.member` grid
  86   | otherwise           = distant
  87
  88
  89 neighbours :: [Pixel]
  90 neighbours = [V2 r c | r <- [-1, 0, 1], c <- [-1, 0, 1]]
  91
  92 expandRegion :: (Pixel, Pixel) -> (Pixel, Pixel)
  93 expandRegion ((V2 r0 c0), (V2 r1 c1)) = (V2 (r0 - 1) (c0 - 1), V2 (r1 + 1) (c1 + 1))
  94
  95 parse text = (enhancement, image)
  96   where ls = lines text
  97         enhancement = [ c == '#' | c <- head ls]
  98         image = mkImage $ drop 2 ls
  99
 100
 101 mkImage :: [String] -> Image
 102 mkImage rows = Image { grid = grid, distantPixel = False
 103                      , explicitRegion = ((V2 0 0), (V2 maxRow maxCol))
 104                      }
 105   where maxRow = length rows - 1
 106         maxCol = (length $ head rows) - 1
 107         grid = S.fromList [V2 r c | r <- [0..maxRow], c <- [0..maxCol], (rows!!r)!!c == '#']
 108
 109
 110 intify pixels = foldl' addBit 0 pixels
 111   where addBit w b = (w * 2) + (if b then 1 else 0)
 112
 113 -- wordify :: BS.BitString -> Integer
 114 -- wordify bs = foldl' addBit 0 $ BS.to01List bs
 115 --   where addBit w b = (w * 2) + (fromIntegral b)