From 6e2cc4e2b56ebe615f913bcd09862e99ac33fca4 Mon Sep 17 00:00:00 2001
From: HeNine <>
Date: Thu, 15 Dec 2022 13:22:16 +0100
Subject: [PATCH] day 15

---
 aoc2022.cabal             |  29 ++++++++++
 data/input150.txt         |  14 +++++
 data/input151.txt         |  33 ++++++++++++
 src/day15/Day15Lib.hs     | 110 ++++++++++++++++++++++++++++++++++++++
 src/day15/test/AoCTest.hs |  41 ++++++++++++++
 src/day15/test/Basic.hs   |  38 +++++++++++++
 6 files changed, 265 insertions(+)
 create mode 100644 data/input150.txt
 create mode 100644 data/input151.txt
 create mode 100644 src/day15/Day15Lib.hs
 create mode 100644 src/day15/test/AoCTest.hs
 create mode 100644 src/day15/test/Basic.hs

diff --git a/aoc2022.cabal b/aoc2022.cabal
index 73754c3..cf5bd09 100644
--- a/aoc2022.cabal
+++ b/aoc2022.cabal
@@ -345,4 +345,33 @@ test-suite day13aoctest
                      , parsec
                      , split
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
+-- Day 15
+
+test-suite day15basictest
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      src/day15/test, src/day15
+  main-is:             Basic.hs
+  other-modules:       
+      Day15Lib
+  build-depends:       base
+                     , HUnit
+                     , parsec
+                     , containers
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
+
+test-suite day15aoctest
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      src/day15/test, src/day15
+  main-is:             AoCTest.hs
+  other-modules:       
+      Day15Lib
+  build-depends:       base
+                     , HUnit
+                     , parsec
+                     , containers
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   default-language:    Haskell2010
\ No newline at end of file
diff --git a/data/input150.txt b/data/input150.txt
new file mode 100644
index 0000000..91960de
--- /dev/null
+++ b/data/input150.txt
@@ -0,0 +1,14 @@
+Sensor at x=2, y=18: closest beacon is at x=-2, y=15
+Sensor at x=9, y=16: closest beacon is at x=10, y=16
+Sensor at x=13, y=2: closest beacon is at x=15, y=3
+Sensor at x=12, y=14: closest beacon is at x=10, y=16
+Sensor at x=10, y=20: closest beacon is at x=10, y=16
+Sensor at x=14, y=17: closest beacon is at x=10, y=16
+Sensor at x=8, y=7: closest beacon is at x=2, y=10
+Sensor at x=2, y=0: closest beacon is at x=2, y=10
+Sensor at x=0, y=11: closest beacon is at x=2, y=10
+Sensor at x=20, y=14: closest beacon is at x=25, y=17
+Sensor at x=17, y=20: closest beacon is at x=21, y=22
+Sensor at x=16, y=7: closest beacon is at x=15, y=3
+Sensor at x=14, y=3: closest beacon is at x=15, y=3
+Sensor at x=20, y=1: closest beacon is at x=15, y=3
\ No newline at end of file
diff --git a/data/input151.txt b/data/input151.txt
new file mode 100644
index 0000000..a1272e3
--- /dev/null
+++ b/data/input151.txt
@@ -0,0 +1,33 @@
+Sensor at x=2302110, y=2237242: closest beacon is at x=2348729, y=1239977
+Sensor at x=47903, y=2473047: closest beacon is at x=-432198, y=2000000
+Sensor at x=2363579, y=1547888: closest beacon is at x=2348729, y=1239977
+Sensor at x=3619841, y=520506: closest beacon is at x=2348729, y=1239977
+Sensor at x=3941908, y=3526118: closest beacon is at x=3772294, y=3485243
+Sensor at x=3206, y=1564595: closest beacon is at x=-432198, y=2000000
+Sensor at x=3123411, y=3392077: closest beacon is at x=2977835, y=3592946
+Sensor at x=3279053, y=3984688: closest beacon is at x=2977835, y=3592946
+Sensor at x=2968162, y=3938490: closest beacon is at x=2977835, y=3592946
+Sensor at x=1772120, y=2862246: closest beacon is at x=2017966, y=3158243
+Sensor at x=3283241, y=2619168: closest beacon is at x=3172577, y=2521434
+Sensor at x=2471642, y=3890150: closest beacon is at x=2977835, y=3592946
+Sensor at x=3163348, y=3743489: closest beacon is at x=2977835, y=3592946
+Sensor at x=2933313, y=2919047: closest beacon is at x=3172577, y=2521434
+Sensor at x=2780640, y=3629927: closest beacon is at x=2977835, y=3592946
+Sensor at x=3986978, y=2079918: closest beacon is at x=3998497, y=2812428
+Sensor at x=315464, y=370694: closest beacon is at x=-550536, y=260566
+Sensor at x=3957316, y=3968366: closest beacon is at x=3772294, y=3485243
+Sensor at x=2118533, y=1074658: closest beacon is at x=2348729, y=1239977
+Sensor at x=3494855, y=3378533: closest beacon is at x=3772294, y=3485243
+Sensor at x=2575727, y=210553: closest beacon is at x=2348729, y=1239977
+Sensor at x=3999990, y=2813525: closest beacon is at x=3998497, y=2812428
+Sensor at x=3658837, y=3026912: closest beacon is at x=3998497, y=2812428
+Sensor at x=1551619, y=1701155: closest beacon is at x=2348729, y=1239977
+Sensor at x=2625855, y=3330422: closest beacon is at x=2977835, y=3592946
+Sensor at x=3476946, y=2445098: closest beacon is at x=3172577, y=2521434
+Sensor at x=2915568, y=1714113: closest beacon is at x=2348729, y=1239977
+Sensor at x=729668, y=3723377: closest beacon is at x=-997494, y=3617758
+Sensor at x=3631681, y=3801747: closest beacon is at x=3772294, y=3485243
+Sensor at x=2270816, y=3197807: closest beacon is at x=2017966, y=3158243
+Sensor at x=3999999, y=2810929: closest beacon is at x=3998497, y=2812428
+Sensor at x=3978805, y=3296024: closest beacon is at x=3772294, y=3485243
+Sensor at x=1054910, y=811769: closest beacon is at x=2348729, y=1239977
\ No newline at end of file
diff --git a/src/day15/Day15Lib.hs b/src/day15/Day15Lib.hs
new file mode 100644
index 0000000..0f4c30d
--- /dev/null
+++ b/src/day15/Day15Lib.hs
@@ -0,0 +1,110 @@
+module Day15Lib
+  ( Vector (..),
+    Sensor (..),
+    parseNumber,
+    parseLine,
+    generateBoundary,
+    --
+    processInput1,
+    processInput2,
+  )
+where
+
+import Data.Bifunctor (Bifunctor (bimap))
+import Data.List
+import qualified Data.Set as Set
+import Debug.Trace
+import Text.Parsec
+
+type Parser = Parsec String ()
+
+data Sensor = Sensor
+  { position :: Vector,
+    beacon :: Vector
+  }
+  deriving (Show, Eq)
+
+newtype Vector = Vector (Int, Int) deriving (Show, Eq, Ord)
+
+instance Num Vector where
+  Vector v1 + Vector v2 = Vector (fst v1 + fst v2, snd v1 + snd v2)
+  Vector v1 - Vector v2 = Vector (fst v1 - fst v2, snd v1 - snd v2)
+  Vector v1 * Vector v2 = Vector (fst v1 * fst v2, snd v1 * snd v2)
+  fromInteger i = Vector (fromInteger i, fromInteger i)
+  abs (Vector v) = Vector (bimap abs abs v)
+  signum (Vector (x, y)) = Vector (signum x, signum y)
+
+l1d :: Vector -> Vector -> Int
+l1d v1 v2 = dx + dy where Vector (dx, dy) = abs (v1 - v2)
+
+sensorRange :: Sensor -> Int
+sensorRange sensor = l1d (position sensor) (beacon sensor)
+
+parseSensor :: Parser Sensor
+parseSensor = do
+  string "Sensor at x="
+  sx <- parseNumber
+  string ", y="
+  sy <- parseNumber
+  string ": closest beacon is at x="
+  bx <- parseNumber
+  string ", y="
+  by <- parseNumber
+  return $
+    Sensor
+      { position = Vector (sx, sy),
+        beacon = Vector (bx, by)
+      }
+
+parseNumber :: Parser Int
+parseNumber = do
+  sign <- option "" (string "-")
+  number <- many1 digit
+  return . read $ sign ++ number
+
+parseLine :: String -> Sensor
+parseLine line = case parse parseSensor "" line of
+  Left _ -> error $ "parse error: " ++ line
+  Right s -> s
+
+-- ####################
+
+processInput1 :: Int -> String -> Int
+processInput1 ylevel input =
+  let sensors = map parseLine . lines $ input
+      beaconsInLine =
+        Set.fromList
+          . map (\Sensor {beacon = Vector (x, _)} -> x)
+          . filter (\Sensor {beacon = Vector (_, y)} -> y == ylevel)
+          $ sensors
+      relevant = filter (isRelevant ylevel) sensors
+      empte = foldl Set.union Set.empty . map (Set.fromList . generateEmpty ylevel) $ relevant
+   in Set.size $ Set.difference empte beaconsInLine
+
+generateEmpty :: Int -> Sensor -> [Int]
+generateEmpty ylevel s@(Sensor {position = Vector (x, y)}) = [x - d .. x + d] where d = sensorRange s - abs (y - ylevel)
+
+isRelevant :: Int -> Sensor -> Bool
+isRelevant ylevel s@(Sensor {position = Vector (_, y)}) = abs (y - ylevel) <= sensorRange s
+
+processInput2 :: Int -> String -> Int
+processInput2 r input =
+  let sensors = map parseLine . lines $ input
+      candidates =
+        filter (\(Vector (x, y)) -> x >= 0 && x <= r && y >= 0 && y <= r) $
+          concatMap generateBoundary sensors
+      [Vector (x, y)] = nub $ [c | c <- candidates, not $ any (isDetected c) sensors]
+   in x * 4000000 + y
+
+isDetected :: Vector -> Sensor -> Bool
+isDetected v s = l1d (position s) v <= sensorRange s
+
+generateBoundary :: Sensor -> [Vector]
+generateBoundary s@(Sensor {position = Vector (x, y)}) =
+  map
+    (position s +)
+    ( zipWith (curry Vector) [(-d) .. d] ([0 .. d] ++ [(d - 1), (d - 2) .. 0])
+        ++ zipWith (curry Vector) [(-d + 1) .. (d - 1)] ([-1, -2 .. (-d)] ++ [(-d + 1), (-d + 2) .. 0])
+    )
+  where
+    d = sensorRange s + 1
diff --git a/src/day15/test/AoCTest.hs b/src/day15/test/AoCTest.hs
new file mode 100644
index 0000000..027171b
--- /dev/null
+++ b/src/day15/test/AoCTest.hs
@@ -0,0 +1,41 @@
+import Day15Lib (processInput1, processInput2)
+import System.IO
+import Test.HUnit
+
+testCases1 =
+  [ ("data/input150.txt", 10, 26),
+    ("data/input151.txt", 2000000, 5083287)
+  ]
+
+testCase1 (file, ylevel, result) = do
+  withFile
+    file
+    ReadMode
+    ( \handle -> do
+        contents <- hGetContents handle
+        assertEqual "input test" result $ processInput1 ylevel contents
+    )
+
+testCases2 =
+  [ ("data/input150.txt", 20, 56000011),
+    ("data/input151.txt", 4000000, 13134039205729)
+  ]
+
+testCase2 (file, r, result) = do
+  withFile
+    file
+    ReadMode
+    ( \handle -> do
+        contents <- hGetContents handle
+        assertEqual ("input test: " ++ file) result $ processInput2 r contents
+    )
+
+tests =
+  TestList $
+    [TestCase (testCase1 c) | c <- testCases1]
+      ++ [TestCase (testCase2 c) | c <- testCases2]
+
+main :: IO ()
+main = do
+  runTestTT tests
+  return ()
diff --git a/src/day15/test/Basic.hs b/src/day15/test/Basic.hs
new file mode 100644
index 0000000..b853bb2
--- /dev/null
+++ b/src/day15/test/Basic.hs
@@ -0,0 +1,38 @@
+import qualified Data.Set as Set
+import Day15Lib
+import Test.HUnit
+import Text.Parsec
+
+parseTests =
+  [ parse parseNumber "" "1"
+      ~?= Right (1),
+    parse parseNumber "" "-10"
+      ~?= Right (-10),
+    parseLine "Sensor at x=2, y=18: closest beacon is at x=-2, y=15"
+      ~?= Sensor {position = Vector (2, 18), beacon = Vector (-2, 15)}
+  ]
+
+boundaryTests =
+  [ generateBoundary Sensor {position = Vector (0, 0), beacon = Vector (0, 1)}
+      ~?=
+        [ Vector (0, 2),
+          Vector (1, 1),
+          Vector (2, 0),
+          Vector (1, -1),
+          Vector (0, -2),
+          Vector (-1, -1),
+          Vector (-2, 0),
+          Vector (-1, 1)
+        ]
+  ]
+
+tests =
+  TestList $
+    parseTests
+      ++ boundaryTests
+      ++ []
+
+main :: IO ()
+main = do
+  runTestTT tests
+  return ()