Day 20

src/AOC-20a.hs

 module Main where
 
-import Data.Array
+import Data.Array ( Ix(range), (!), array, assocs, bounds, elems, inRange, Array )
 
 type ImageAlgorithm = Array Int Int   -- 512 elements
 type Image = (Array (Int,Int) Int,Int) -- the second coordinate is the default pixel
@@ -30,15 +30,17 @@ padImage (input,px) = (output,px) where
   yInputMin = minimum [ y | ((_,y),v) <- assocs input, v /= px ]
   xInputMax = maximum [ x | ((x,_),v) <- assocs input, v /= px ]
   yInputMax = maximum [ y | ((_,y),v) <- assocs input, v /= px ]
-  xOffset = 3 - xInputMin
-  yOffset = 3 - yInputMin
-  xOutputMax = 5 + xInputMax - xInputMin
-  yOutputMax = 5 + yInputMax - yInputMin
+  padding = 2
+  xOffset = padding + 1 - xInputMin
+  yOffset = padding + 1  - yInputMin
+  xOutputMax = 2 * padding + 1 + xInputMax - xInputMin
+  yOutputMax = 2 * padding + 1 + yInputMax - yInputMin
   bds = ((1,1),(xOutputMax,yOutputMax))
   output = array ((1,1),(xOutputMax,yOutputMax)) [ (p,pixelAt p) | p <- range bds]
   pixelAt (x,y)
-    | x <= 2 || y <= 2 || x >= xOutputMax - 1 || y >= yOutputMax - 1 = px
-    | otherwise = input ! (x - xOffset, y - yOffset)
+    | inRange (padding+1,xOutputMax-padding) x && inRange (padding+1,yOutputMax-padding) y
+      = input ! (x - xOffset, y - yOffset)
+    | otherwise = px
 
 showImage :: Image -> String
 showImage (arr,_) = unlines [ [ encode (arr ! (x,y)) | x <- [1..xMax] ] | y <- [1..yMax]] where
@@ -48,14 +50,13 @@ showImage (arr,_) = unlines [ [ encode (arr ! (x,y)) | x <- [1..xMax] ] | y <- [
   encode c = error $ "showImage.encode: invalid pixel value: " ++ show c
 
 processImage :: ImageAlgorithm -> Image -> Image
-processImage algorithm img = (result,dpx) where
-  (arr,_)= padImage img
+processImage algorithm img = (result,ndpx) where
+  (arr,dpx)= padImage img
   ((1,1),(xMax,yMax)) = bounds arr
-  dpx = algorithm ! 0
-  borderpx = algorithm ! if dpx == 0 then 0 else 511
+  ndpx = algorithm ! if dpx == 0 then 0 else 511
   result = array (bounds arr) $ [ ((x,y),pixelAt (x,y)) | x <-[1..xMax], y <- [1..yMax]]
   pixelAt (x,y)
-    | x == 1 || x == xMax || y == 1 || y == yMax = borderpx
+    | x == 1 || x == xMax || y == 1 || y == yMax = ndpx
     | otherwise = algorithm ! fromBinary (neighborhoodBits (x,y))
   neighborhoodBits (x,y) = map (arr !) [(x',y') | y' <- [y-1..y+1], x' <- [x-1..x+1]]
 
@@ -66,13 +67,10 @@ twice :: (a -> a) -> (a -> a)
 twice f a = f (f a)
 
 countLit :: Image -> Int
-countLit (img,_) = length [p | p <- range (bounds img), img ! p == 1]
+countLit (img,0) = sum . elems $ img
+countLit (_,_) = error $ "countLit -- infinite image"
 
 main :: IO ()
 main = do
-  (algorithm,image) <- processInput <$> readFile "data/image.txt"
-  print . countLit . twice (processImage algorithm) $ image
-
-{-
-  5406 too high
--}
+  (algorithm,img) <- processInput <$> readFile "data/image.txt"
+  putStr . show . countLit . twice (processImage algorithm) $ img

src/AOC-20b.hs

 module Main where
 
+import Data.Array ( Ix(range), (!), array, assocs, bounds, elems, inRange, Array )
+
+type ImageAlgorithm = Array Int Int   -- 512 elements
+type Image = (Array (Int,Int) Int,Int) -- the second coordinate is the default pixel
+
+processInput :: String -> (ImageAlgorithm,Image)
+processInput s = (toAlgorithm header,toImage (tail rest)) where
+  header : rest = lines s
+  toAlgorithm = array (0,511) . zip [0..] . verify
+  verify str
+    | length str == 512 = map decode str
+    | otherwise = error "processInput -- invalid image algorithm"
+  decode :: Char -> Int
+  decode '#' = 1
+  decode '.' = 0
+  decode c   = error $ "processInput.decode -- invalid character: " ++ [c]
+  toImage ls = (array ((1,1),(width,height)) pixels, 0) where
+    width = length (head ls)
+    height = length ls
+    pixels = [((x,y),decode c)
+             | (y,row) <- zip [1..] ls
+             , (x,c) <- zip [1..] row
+             ]
+
+padImage :: Image -> Image
+padImage (input,px) = (output,px) where
+  xInputMin = minimum [ x | ((x,_),v) <- assocs input, v /= px ]
+  yInputMin = minimum [ y | ((_,y),v) <- assocs input, v /= px ]
+  xInputMax = maximum [ x | ((x,_),v) <- assocs input, v /= px ]
+  yInputMax = maximum [ y | ((_,y),v) <- assocs input, v /= px ]
+  padding = 2
+  xOffset = padding + 1 - xInputMin
+  yOffset = padding + 1  - yInputMin
+  xOutputMax = 2 * padding + 1 + xInputMax - xInputMin
+  yOutputMax = 2 * padding + 1 + yInputMax - yInputMin
+  bds = ((1,1),(xOutputMax,yOutputMax))
+  output = array ((1,1),(xOutputMax,yOutputMax)) [ (p,pixelAt p) | p <- range bds]
+  pixelAt (x,y)
+    | inRange (padding+1,xOutputMax-padding) x && inRange (padding+1,yOutputMax-padding) y
+      = input ! (x - xOffset, y - yOffset)
+    | otherwise = px
+
+showImage :: Image -> String
+showImage (arr,_) = unlines [ [ encode (arr ! (x,y)) | x <- [1..xMax] ] | y <- [1..yMax]] where
+  ((1,1),(xMax,yMax)) = bounds arr
+  encode 0 = '.'
+  encode 1 = '#'
+  encode c = error $ "showImage.encode: invalid pixel value: " ++ show c
+
+processImage :: ImageAlgorithm -> Image -> Image
+processImage algorithm img = (result,ndpx) where
+  (arr,dpx)= padImage img
+  ((1,1),(xMax,yMax)) = bounds arr
+  ndpx = algorithm ! if dpx == 0 then 0 else 511
+  result = array (bounds arr) $ [ ((x,y),pixelAt (x,y)) | x <-[1..xMax], y <- [1..yMax]]
+  pixelAt (x,y)
+    | x == 1 || x == xMax || y == 1 || y == yMax = ndpx
+    | otherwise = algorithm ! fromBinary (neighborhoodBits (x,y))
+  neighborhoodBits (x,y) = map (arr !) [(x',y') | y' <- [y-1..y+1], x' <- [x-1..x+1]]
+
+fromBinary :: [Int] -> Int
+fromBinary = sum . zipWith (*) (iterate (*2) 1) . reverse
+
+iter :: Int -> (a -> a) -> (a -> a)
+iter 0 _ = id
+iter n f = f . iter (n-1) f
+
+countLit :: Image -> Int
+countLit (img,0) = sum . elems $ img
+countLit (_,_) = error $ "countLit -- infinite image"
+
 main :: IO ()
-main = pure ()
+main = do
+  (algorithm,img) <- processInput <$> readFile "data/image.txt"
+  putStr . show . countLit . iter 50 (processImage algorithm) $ img