advent19/src/advent19.hs

   1 import Debug.Trace
   2
   3 import Intcode
   4
   5 import qualified Data.Text.IO as TIO
   6
   7 import qualified Data.Map.Strict as M
   8 -- import Data.Map.Strict ((!))
   9 import Data.List
  10
  11 type Bounds = (Integer, Integer) -- upper, lower
  12
  13 type Beam = M.Map Integer Bounds
  14
  15
  16 main :: IO ()
  17 main = do
  18         text <- TIO.readFile "data/advent19.txt"
  19         let mem = parseMachineMemory text
  20         let machine = makeMachine mem
  21         print $ part1 machine
  22         print $ part2 machine
  23
  24
  25 maxY = 50 :: Integer
  26 xRange = [0..49] :: [Integer]
  27 boxSize = 100 :: Integer
  28
  29
  30 part1 machine = sum $ map cellsInRange $ M.elems beamPresence
  31     where beamPresence = foldl' (traceBeam machine) M.empty xRange -- [0..49] @[Integer]
  32
  33
  34 part2 machine = score $ head $ dropWhile (not . containsBox) corners
  35     where uppers = scanl' (traceUpper machine) 0 xs
  36           lowers = scanl' (traceLower machine) (0, 0) xs
  37           corners = zip (drop ((fromIntegral boxSize) - 1) uppers) lowers
  38           xs = [0..] :: [Integer]
  39
  40 cellsInRange :: Bounds -> Integer
  41 cellsInRange (u, l) = l' - u'
  42     where u' = min u maxY
  43           l' = min l maxY
  44
  45 containsBox (yt, (_xb, yb)) = yt + boxSize - 1 <= yb
  46
  47 score (yt, (xb, _yb)) = xb * 10000 + yt
  48
  49
  50 traceBeam :: Machine -> Beam -> Integer -> Beam
  51 -- traceBeam _machine beam x | trace ((show x) ++ " " ++ (show beam)) False = undefined
  52 traceBeam machine beam x = M.insert x (u', l') beam
  53     where (prevU, _prevL) = M.findWithDefault (0, 0) (x - 1) beam
  54           (bic, _foundU) = beamInColumn machine x
  55           u = head $ dropWhile (\y -> not $ tractorBeamAt machine x y) [prevU..]
  56           l = head $ dropWhile (\y -> tractorBeamAt machine x y) [u..]
  57           (u', l') = if prevU == 0 && bic == False
  58                        then (0, 0)
  59                        else (u, l)
  60
  61 traceUpper :: Machine -> Integer -> Integer -> Integer
  62 traceUpper machine prev x = u'
  63     where (bic, _foundU) = beamInColumn machine x
  64           u = head $ dropWhile (\y -> not $ tractorBeamAt machine x y) [prev..]
  65           u' = if prev == 0 && bic == False
  66                then 0
  67                else u
  68
  69 traceLower :: Machine -> (Integer, Integer) -> Integer -> (Integer, Integer)
  70 traceLower machine (_, prev) x = (x, l')
  71     where (bic, foundU) = beamInColumn machine x
  72           startL = if prev == 0 then foundU else prev
  73           l = head $ dropWhile (\y -> tractorBeamAt machine x y) [startL..]
  74           l' = if prev == 0 && bic == False
  75                then 0
  76                else l - 1
  77
  78 tractorBeamAt :: Machine -> Integer -> Integer -> Bool
  79 tractorBeamAt machine x y = (head output) == 1
  80     where (_, _, output) = runMachine [x, y] machine
  81
  82
  83 beamInColumn :: Machine -> Integer -> (Bool, Integer)
  84 beamInColumn machine x
  85     | null fromTop = (False, 0)
  86     | otherwise = (True, head fromTop)
  87     where fromTop = dropWhile (\y -> not $ tractorBeamAt machine x y) [0..maxY]
  88