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