src/advent11/advent11.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 -- Using a summed-area table, e.g. see https://en.wikipedia.org/wiki/Summed-area_table
   4
   5 import Data.List
   6 import qualified Data.Map.Strict as M
   7 import Data.Map.Strict ((!))
   8 -- import qualified Data.Set as S
   9 -- import Data.Function (on)
  10 import Data.Ord (comparing)
  11
  12 type Coord = (Integer, Integer) -- x, y
  13 type Grid = M.Map Coord Integer
  14
  15 key = 5719
  16 -- key = 42
  17
  18 main :: IO ()
  19 main = do
  20         let g = makeGrid key
  21         print $ part1 g
  22         print $ part2 g
  23
  24
  25 part1 grid = keyOfMaxValue sg
  26     where sg = allSubCellPower 3 grid
  27
  28
  29 part2 grid = maximumBy (comparing snd) $ [bestInGrid size grid | size <- [3..300]]
  30
  31 -- bestSubCell size grid =
  32
  33 makeGrid :: Integer -> Grid
  34 -- makeGrid key = M.fromList [((x, y), powerLevel x y key) | x <- [1..300], y <- [1..300] ]
  35 makeGrid key = foldl' addSummedArea M.empty [((x, y), powerLevel x y key) | x <- [0..300], y <- [0..300] ]
  36
  37 addSummedArea :: Grid -> ((Integer, Integer), Integer) -> Grid
  38 addSummedArea grid ((x, y), power) = M.insert (x, y) (power + upper + left - upperLeft) grid
  39     where upper = M.findWithDefault 0 (x-1, y) grid
  40           left  = M.findWithDefault 0 (x, y-1) grid
  41           upperLeft = M.findWithDefault 0 (x-1, y-1) grid
  42
  43
  44 powerLevel :: Integer -> Integer -> Integer -> Integer
  45 powerLevel 0 y _ = 0
  46 powerLevel x 0 _ = 0
  47 powerLevel x y key = ((interim `div` 100) `mod` 10) - 5
  48     where rackID = x + 10
  49           interim = ((rackID) * y + key) * rackID
  50
  51 subCellPower :: Integer -> Integer -> Integer -> Grid -> Integer
  52 -- subCellPower size x y grid = sum [grid!(sx, sy) | sx <- [x..(x+size-1)], sy <- [y..(y+size-1)]]
  53 subCellPower size x0 y0 grid = grid!(x,y) + grid!(x',y') - grid!(x,y') - grid!(x',y)
  54     where x  = x0 - 1
  55           x' = x + size
  56           y  = y0 - 1
  57           y' = y + size
  58
  59 allSubCellPower :: Integer -> Grid -> Grid
  60 allSubCellPower size grid = M.fromList [((x, y), subCellPower size x y grid)| x <- [1..(301-size)], y <- [1..(301-size)]]
  61
  62
  63 keyAndMaxValue :: Ord b => M.Map a b -> (a, b)
  64 keyAndMaxValue m = M.foldrWithKey mergeKV (M.findMin m) m
  65     where mergeKV k v (bestK, bestV) =
  66             if v > bestV then (k, v) else (bestK, bestV)
  67
  68 keyOfMaxValue :: Ord b => M.Map a b -> a
  69 keyOfMaxValue m = fst $ keyAndMaxValue m
  70
  71 bestInGrid :: Integer -> Grid -> ((Integer, Integer, Integer), Integer)
  72 bestInGrid size grid = ((x, y, size), p)
  73     where ((x, y), p) = keyAndMaxValue $ allSubCellPower size grid