{-# Language QuasiQuotes, DataKinds, NumericUnderscores, GADTs #-}
{-|
Module      : Main
Description : Day 15 solution
Copyright   : (c) Eric Mertens, 2022
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2022/day/15>

>>> :{
:main +
  "part 1 override 10 part 2 override 20\n\
  \Sensor at x=2, y=18: closest beacon is at x=-2, y=15\n\
  \Sensor at x=9, y=16: closest beacon is at x=10, y=16\n\
  \Sensor at x=13, y=2: closest beacon is at x=15, y=3\n\
  \Sensor at x=12, y=14: closest beacon is at x=10, y=16\n\
  \Sensor at x=10, y=20: closest beacon is at x=10, y=16\n\
  \Sensor at x=14, y=17: closest beacon is at x=10, y=16\n\
  \Sensor at x=8, y=7: closest beacon is at x=2, y=10\n\
  \Sensor at x=2, y=0: closest beacon is at x=2, y=10\n\
  \Sensor at x=0, y=11: closest beacon is at x=2, y=10\n\
  \Sensor at x=20, y=14: closest beacon is at x=25, y=17\n\
  \Sensor at x=17, y=20: closest beacon is at x=21, y=22\n\
  \Sensor at x=16, y=7: closest beacon is at x=15, y=3\n\
  \Sensor at x=14, y=3: closest beacon is at x=15, y=3\n\
  \Sensor at x=20, y=1: closest beacon is at x=15, y=3\n"
:}
26
56000011

-}
module Main where

import Advent (format)
import Advent.Box (Box', Box(Dim,Pt), subtractBox, size, unionBoxes)
import Advent.Coord (manhattan, Coord(C))
import Advent.Nat (Nat(S))

-- | Input is a list of: sensor x and y, beacon x and y
type Input = [(Int,Int,Int,Int)]

-- |
-- >>> :main
-- 4724228
-- 13622251246513
main :: IO ()
IO ()
main =
 do (Maybe (Int, Int)
cfg,[(Int, Int, Int, Int)]
input) <- [format|2022 15
      (|part 1 override %u part 2 override %u%n)
      (Sensor at x=%d, y=%d: closest beacon is at x=%d, y=%d%n)*|]
    let ([Sensor]
diamonds, [Coord]
beacons) = [(Sensor, Coord)] -> ([Sensor], [Coord])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Int, Int, Int, Int)] -> [(Sensor, Coord)]
inputSensors [(Int, Int, Int, Int)]
input)
    Int -> IO ()
forall a. Show a => a -> IO ()
print (Int -> [Sensor] -> [Coord] -> Int
part1 (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
2_000_000 (Int, Int) -> Int
forall a b. (a, b) -> a
fst Maybe (Int, Int)
cfg) [Sensor]
diamonds [Coord]
beacons)
    Int -> IO ()
forall a. Show a => a -> IO ()
print (Int -> [Sensor] -> Int
part2 (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
4_000_000 (Int, Int) -> Int
forall a b. (a, b) -> b
snd Maybe (Int, Int)
cfg) [Sensor]
diamonds)

-- | A sensor has a location and a radius
data Sensor = Sensor Coord Int

-- | Convert input data into a list of sensors and beacon coordinates
inputSensors :: Input -> [(Sensor, Coord)]
inputSensors :: [(Int, Int, Int, Int)] -> [(Sensor, Coord)]
inputSensors [(Int, Int, Int, Int)]
input =
  [(Coord -> Int -> Sensor
Sensor Coord
s (Coord -> Coord -> Int
manhattan Coord
s Coord
b), Coord
b) | (Int
sx,Int
sy,Int
bx,Int
by) <- [(Int, Int, Int, Int)]
input, let s :: Coord
s = Int -> Int -> Coord
C Int
sy Int
sx, let b :: Coord
b = Int -> Int -> Coord
C Int
by Int
bx]

-- part 1 logic

-- | Compute the number of locations in a given row that can't contain a sensor.
part1 ::
  Int      {- ^ y value of row -} ->
  [Sensor] {- ^ sensors -} ->
  [Coord]  {- ^ beacons -} ->
  Int      {- ^ locations in row that can't contain a sensor -}
part1 :: Int -> [Sensor] -> [Coord] -> Int
part1 Int
row [Sensor]
diamonds [Coord]
beacons =
  [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Box ('S 'Z) -> Int) -> [Box ('S 'Z)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Box ('S 'Z) -> Int
forall (n :: Nat). Box n -> Int
size ([Box ('S 'Z)] -> [Int]) -> [Box ('S 'Z)] -> [Int]
forall a b. (a -> b) -> a -> b
$
  [Box ('S 'Z)] -> [Box ('S 'Z)] -> [Box ('S 'Z)]
forall (n :: Nat). [Box n] -> [Box n] -> [Box n]
subtractAllOf [Int -> Int -> Box 'Z -> Box ('S 'Z)
forall (n :: Nat). Int -> Int -> Box n -> Box ('S n)
cover Int
x Int
0 Box 'Z
Pt | C Int
y Int
x <- [Coord]
beacons, Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
row] ([Box ('S 'Z)] -> [Box ('S 'Z)]) -> [Box ('S 'Z)] -> [Box ('S 'Z)]
forall a b. (a -> b) -> a -> b
$
  [Box ('S 'Z)] -> [Box ('S 'Z)]
forall (a :: Nat). [Box a] -> [Box a]
unionBoxes ([Box ('S 'Z)] -> [Box ('S 'Z)]) -> [Box ('S 'Z)] -> [Box ('S 'Z)]
forall a b. (a -> b) -> a -> b
$
  (Sensor -> [Box ('S 'Z)]) -> [Sensor] -> [Box ('S 'Z)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Sensor -> [Box' 1]
rowSlice Int
row) [Sensor]
diamonds

-- | Generate the 1-d box describing the X region covered by the sensor at a given Y value
rowSlice ::
  Int           {- ^ y value            -} ->
  Sensor        {- ^ sensor             -} ->
  [Box' 1] {- ^ bounds on x values -}
rowSlice :: Int -> Sensor -> [Box' 1]
rowSlice Int
y (Sensor (C Int
sy Int
sx) Int
r) = [Int -> Int -> Box 'Z -> Box ('S 'Z)
forall (n :: Nat). Int -> Int -> Box n -> Box ('S n)
cover Int
sx Int
dx Box 'Z
Pt | Int
dx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0]
  where
    dy :: Int
dy = Int -> Int
forall a. Num a => a -> a
abs (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sy)
    dx :: Int
dx = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dy

-- part 2 logic

-- | Find the tuning frequency of the only location in the given region that could
-- contain an undiscovered beacon.
part2 ::
  Int      {- ^ search region size -} ->
  [Sensor] {- ^ sensors -} ->
  Int      {- ^ tuning frequency -}
part2 :: Int -> [Sensor] -> Int
part2 Int
search [Sensor]
diamonds = [Int] -> Int
forall a. HasCallStack => [a] -> a
head
  [ Int
4_000_000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y
    | let center :: Coord
center = Int -> Int -> Coord
C (Int
searchInt -> Int -> Int
forall a. Integral a => a -> a -> a
`div`Int
2) (Int
searchInt -> Int -> Int
forall a. Integral a => a -> a -> a
`div`Int
2)
    , C Int
y Int
x <-
        (Box ('S ('S 'Z)) -> Coord) -> [Box ('S ('S 'Z))] -> [Coord]
forall a b. (a -> b) -> [a] -> [b]
map Box' 2 -> Coord
Box ('S ('S 'Z)) -> Coord
boxCorner ([Box ('S ('S 'Z))] -> [Coord]) -> [Box ('S ('S 'Z))] -> [Coord]
forall a b. (a -> b) -> a -> b
$
        [Box ('S ('S 'Z))] -> [Box ('S ('S 'Z))] -> [Box ('S ('S 'Z))]
forall (n :: Nat). [Box n] -> [Box n] -> [Box n]
subtractAllOf ((Sensor -> Box ('S ('S 'Z))) -> [Sensor] -> [Box ('S ('S 'Z))]
forall a b. (a -> b) -> [a] -> [b]
map Sensor -> Box' 2
Sensor -> Box ('S ('S 'Z))
diamondBox [Sensor]
diamonds)
        [Sensor -> Box' 2
diamondBox (Coord -> Int -> Sensor
Sensor Coord
center Int
search)]
    , Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
y, Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
search
    , Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x, Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
search]

-- | Find a corner of a diamond represented as a square region.
boxCorner :: Box' 2 -> Coord
boxCorner :: Box' 2 -> Coord
boxCorner (Dim Int
xpy Int
_ (Dim Int
xmy Int
_ Box n
_)) = Int -> Int -> Coord
C ((Int
xpy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xmy) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) ((Int
xpy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
xmy) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)

-- | Covert a diamond centered at a coordinate with a radius into a square region.
diamondBox :: Sensor -> Box' 2
diamondBox :: Sensor -> Box' 2
diamondBox (Sensor (C Int
y Int
x) Int
r) = Int -> Int -> Box ('S 'Z) -> Box ('S ('S 'Z))
forall (n :: Nat). Int -> Int -> Box n -> Box ('S n)
cover (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y) Int
r (Int -> Int -> Box 'Z -> Box ('S 'Z)
forall (n :: Nat). Int -> Int -> Box n -> Box ('S n)
cover (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
y) Int
r Box 'Z
Pt)

-- Box utilities

-- | Remove the first list of regions from the second.
subtractAllOf ::
  [Box n] {- ^ remove this -} ->
  [Box n] {- ^ from this -} ->
  [Box n] {- ^ remaining region -}
subtractAllOf :: forall (n :: Nat). [Box n] -> [Box n] -> [Box n]
subtractAllOf [Box n]
xs [Box n]
ys = ([Box n] -> Box n -> [Box n]) -> [Box n] -> [Box n] -> [Box n]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Box n] -> Box n -> [Box n]
forall {t :: * -> *} {n :: Nat}.
Foldable t =>
t (Box n) -> Box n -> [Box n]
remove1 [Box n]
ys [Box n]
xs
  where
    remove1 :: t (Box n) -> Box n -> [Box n]
remove1 t (Box n)
acc Box n
x = (Box n -> [Box n]) -> t (Box n) -> [Box n]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Box n -> Box n -> [Box n]
forall (n :: Nat). Box n -> Box n -> [Box n]
subtractBox Box n
x) t (Box n)
acc

-- | Extend a box to cover a new dimension centered on x with radius r.
cover :: Int {- ^ position -} -> Int {- ^ radius -} -> Box n -> Box ('S n)
cover :: forall (n :: Nat). Int -> Int -> Box n -> Box ('S n)
cover Int
x Int
r = Int -> Int -> Box n -> Box ('S n)
forall (n :: Nat). Int -> Int -> Box n -> Box ('S n)
Dim (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r) (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)