diff --git a/Y2022.cabal b/Y2022.cabal index a26dc75..574089b 100644 --- a/Y2022.cabal +++ b/Y2022.cabal @@ -48,6 +48,7 @@ library Days.D12 Days.D13 Days.D14 + Days.D15 build-depends: bytestring , either diff --git a/app/Main.hs b/app/Main.hs index c309245..9b9de0a 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -22,6 +22,7 @@ paths = , "./data/12.in" , "./data/13.in" , "./data/14.in" + , "./data/15.in" ] solutions :: [(Int, Day, FilePath)] diff --git a/bench/Bench.hs b/bench/Bench.hs index 9b0c9e8..c04962d 100644 --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -21,6 +21,7 @@ paths = , "./data/12.in" , "./data/13.in" , "./data/14.in" + , "./data/15.in" ] solutions :: [(Integer, [Day], FilePath)] diff --git a/data/15.in b/data/15.in new file mode 100644 index 0000000..3467762 --- /dev/null +++ b/data/15.in @@ -0,0 +1,34 @@ +Sensor at x=391282, y=2038170: closest beacon is at x=-532461, y=2166525 +Sensor at x=3042382, y=3783761: closest beacon is at x=3113582, y=3814857 +Sensor at x=3444090, y=757238: closest beacon is at x=2930045, y=2000000 +Sensor at x=971638, y=288172: closest beacon is at x=935006, y=638195 +Sensor at x=2175844, y=1879176: closest beacon is at x=2930045, y=2000000 +Sensor at x=3063103, y=3820576: closest beacon is at x=3113582, y=3814857 +Sensor at x=2591294, y=3667337: closest beacon is at x=2768198, y=3762135 +Sensor at x=2579773, y=3989626: closest beacon is at x=2768198, y=3762135 +Sensor at x=2887876, y=2106773: closest beacon is at x=2930045, y=2000000 +Sensor at x=2808659, y=3280271: closest beacon is at x=2768198, y=3762135 +Sensor at x=2874212, y=3897058: closest beacon is at x=2768198, y=3762135 +Sensor at x=720384, y=134640: closest beacon is at x=935006, y=638195 +Sensor at x=489, y=1241813: closest beacon is at x=-532461, y=2166525 +Sensor at x=120643, y=2878973: closest beacon is at x=227814, y=3107489 +Sensor at x=3990734, y=2991891: closest beacon is at x=3924443, y=3039680 +Sensor at x=1494086, y=3030634: closest beacon is at x=2537630, y=2793941 +Sensor at x=1864417, y=360451: closest beacon is at x=935006, y=638195 +Sensor at x=2974807, y=3732804: closest beacon is at x=3113582, y=3814857 +Sensor at x=3273340, y=3998032: closest beacon is at x=3113582, y=3814857 +Sensor at x=1468886, y=1597081: closest beacon is at x=935006, y=638195 +Sensor at x=2083016, y=3743849: closest beacon is at x=2768198, y=3762135 +Sensor at x=3387080, y=3393862: closest beacon is at x=3113582, y=3814857 +Sensor at x=2959440, y=2052862: closest beacon is at x=2930045, y=2000000 +Sensor at x=1180804, y=1112043: closest beacon is at x=935006, y=638195 +Sensor at x=2829808, y=2206448: closest beacon is at x=2930045, y=2000000 +Sensor at x=3999024, y=3114260: closest beacon is at x=3924443, y=3039680 +Sensor at x=540955, y=3893312: closest beacon is at x=227814, y=3107489 +Sensor at x=3669058, y=2350731: closest beacon is at x=3924443, y=3039680 +Sensor at x=2915068, y=2754266: closest beacon is at x=2537630, y=2793941 +Sensor at x=3507419, y=2838686: closest beacon is at x=3924443, y=3039680 +Sensor at x=165939, y=498589: closest beacon is at x=935006, y=638195 +Sensor at x=3917917, y=3792648: closest beacon is at x=3924443, y=3039680 +Sensor at x=40698, y=3202257: closest beacon is at x=227814, y=3107489 +Sensor at x=2619948, y=2439745: closest beacon is at x=2537630, y=2793941 diff --git a/src/Days/D15.hs b/src/Days/D15.hs new file mode 100644 index 0000000..9fe0ced --- /dev/null +++ b/src/Days/D15.hs @@ -0,0 +1,170 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Days.D15 where + +import Common +import Data.Bifunctor (first) +import Data.List (nub, sort) +import Parse +import Text.Megaparsec.Char (space) +import Text.Megaparsec.Char.Lexer qualified as L + +data V2 = V2 !Int !Int deriving (Eq, Ord, Show) + +instance Num V2 where + (+) (V2 a b) (V2 c d) = V2 (a + c) (b + d) + (*) (V2 a b) (V2 c d) = V2 (a * c) (b * d) + abs (V2 a b) = V2 (abs a) (abs b) + signum (V2 a b) = V2 (signum a) (signum b) + fromInteger = undefined + negate (V2 a b) = V2 (negate a) (negate b) + +data Report = Report {sensor :: V2, beacon :: V2} + deriving (Show) + +dist :: V2 -> V2 -> Int +dist (V2 a b) (V2 c d) = abs (c - a) + abs (d - b) + +parser :: Parser [Report] +parser = someLines report + where + report = + ( \sensor beacon -> + (Report {sensor = sensor, beacon = beacon}) + ) + <$ symbol "Sensor at" + <*> point + <* symbol ": closest beacon is at" + <*> point + point = + V2 + <$ symbol "x=" + <*> int + <* symbol ", y=" + <*> int + symbol = L.symbol space + +spanAt :: Int -> Report -> (Int, Int) +spanAt lineY (Report {..}) = + case sensor of + (V2 x y) -> + let yDiff = abs (y - lineY) + range = dist beacon sensor + lineRange = range - yDiff + in (x - lineRange, x + lineRange) + +mergeOverlap :: [(Int, Int)] -> [(Int, Int)] +mergeOverlap [] = [] +mergeOverlap [x] = [x] +mergeOverlap ((a, b) : xs@((c, d) : rest)) = + if b < c + then (a, b) : mergeOverlap xs + else mergeOverlap ((min a c, max b d) : rest) + +part1 :: [Report] -> Int +part1 reports = + let row = 2_000_000 + coveredCount = + sum + . map (\(a, b) -> b - a + 1) + . mergeOverlap + . sort + . filter (uncurry (<=)) + $ map (spanAt row) reports + + beaconCount = + length + . nub + . filter (\(V2 _ b) -> b == row) + $ map beacon reports + in coveredCount - beaconCount + +transform :: V2 -> V2 +transform (V2 x y) = V2 (x + y) (x - y) + +untransform :: V2 -> V2 +untransform (V2 x y) = V2 ((x + y) `div` 2) ((x - y) `div` 2) + +type Square = (V2, Int) + +data Line = L V2 V2 deriving (Show) + +squareEdges :: Square -> [Line] +squareEdges (V2 x y, r) = + [ L (min p1 p2) (max p1 p2) + | p1 <- [V2 (x + r) (y + r), V2 (x - r) (y - r)], + p2 <- [V2 (x + r) (y - r), V2 (x - r) (y + r)] + ] + +unit :: Line -> V2 +unit (L p1 p2) = signum (p2 - p1) + +base :: Line -> V2 +base l = V2 1 1 - unit l + +len :: V2 -> Int +len (V2 x y) = x + y + +on :: V2 -> Line -> Bool +on p l@(L p1 p2) = + let commonDim = base l + diffDim = unit l + in (commonDim * p == commonDim * p1) + && diffDim * p1 <= diffDim * p + && diffDim * p <= diffDim * p2 + +intersect :: Line -> Line -> [V2] +intersect l@(L p1 p2) l'@(L p1' p2') + | unit l == unit l' = + [p1 | p1 `on` l'] + ++ [p2 | p2 `on` l'] + ++ [p1' | p1' `on` l] + ++ [p2' | p2' `on` l] + | otherwise = + let p = base l * p1 + base l' * p1' + in ([p | p `on` l, p `on` l']) + +-- Too lazy to clean this up :P +part2 :: [Report] -> Int +part2 reports = + let squares = map (\(Report {..}) -> (sensor, dist sensor beacon)) reports + + tSquares = map (first transform) squares + tEdgeIntersections = + nub $ + concat + [ concat + [ e `intersect` e' + | e <- squareEdges sq, + e' <- squareEdges sq' + ] + | sq <- tSquares, + sq' <- tSquares, + sq < sq' + ] + + edgeIntersections = map untransform tEdgeIntersections + + covered p = any (\(sensor, r) -> dist sensor p <= r) squares + inside p = any (\(sensor, r) -> dist sensor p < r) squares + in (\(V2 x y) -> x * 4_000_000 + y) + . head + . filter (all covered . neigh4) + . filter (<= V2 4_000_000 4_000_000) + . filter (V2 0 0 <=) + . concat + . filter ((1 ==) . length) + . map (filter (not . covered) . neigh4) + . filter (not . inside) + $ edgeIntersections + where + neigh4 p = + map + (p +) + [V2 (-1) 0, V2 0 (-1), V2 0 1, V2 1 0] + +day :: Day +day = parsecDay parser (definitive . part1, definitive . part2) diff --git a/src/Lib.hs b/src/Lib.hs index f7f5ed3..9a4e448 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -26,6 +26,7 @@ import Days.D11 qualified as D11 import Days.D12 qualified as D12 import Days.D13 qualified as D13 import Days.D14 qualified as D14 +import Days.D15 qualified as D15 import Data.ByteString.Char8 qualified as BS import Data.Text.IO qualified as T @@ -52,4 +53,5 @@ days = , [D12.day] , [D13.day] , [D14.day] + , [D15.day] ]