{-# Language ImportQualifiedPost, QuasiQuotes #-}
{-|
Module      : Main
Description : Day 6 solution
Copyright   : (c) Eric Mertens, 2018
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2018/day/6>

-}
{-# Language OverloadedStrings #-}
module Main (main) where

import Advent        (format, counts)
import Advent.Coord (Coord(C), cardinal, coordCol, coordRow,
                     above, below, right, left, manhattan, boundingBox)
import Advent.Search (dfs)
import Data.List (groupBy, sort, sortBy)
import Data.Function (on)
import Data.Ix (range)
import Data.Map qualified as Map

-- | Print the answers to day 6
--
-- >>> :main
-- 5365
-- 42513
main :: IO ()
IO ()
main =
 do let toCoord :: (Int, Int) -> Coord
toCoord (Int
x,Int
y) = Int -> Int -> Coord
C Int
y Int
x
    [Coord]
input <- ((Int, Int) -> Coord) -> [(Int, Int)] -> [Coord]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Coord
toCoord ([(Int, Int)] -> [Coord]) -> IO [(Int, Int)] -> IO [Coord]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [format|2018 6 (%u, %u%n)*|]
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([Coord] -> Int
part1 [Coord]
input)
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([Coord] -> Int
part2 [Coord]
input)

-- | Part 1 looks for the largest completely closed region of coordinates
-- that are nearest to one of the input coordinates. We determine that a
-- region is closed by growing the considered region and eliminating
-- any regions that continue to grow. These still growing regions would
-- only grow larger and larger!
part1 ::
  [Coord] {- ^ input coordinates      -} ->
  Int     {- ^ solution               -}
part1 :: [Coord] -> Int
part1 [Coord]
input
  = Map Coord Int -> Int
forall a. Ord a => Map Coord a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum
  (Map Coord Int -> Int) -> Map Coord Int -> Int
forall a b. (a -> b) -> a -> b
$ (Maybe Int -> Maybe Int) -> Map Coord (Maybe Int) -> Map Coord Int
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Maybe Int -> Maybe Int
forall a. a -> a
id -- eliminate growing regions
  (Map Coord (Maybe Int) -> Map Coord Int)
-> Map Coord (Maybe Int) -> Map Coord Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Maybe Int)
-> Map Coord Int -> Map Coord Int -> Map Coord (Maybe Int)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith Int -> Int -> Maybe Int
forall {a}. Eq a => a -> a -> Maybe a
match ([Coord] -> Map Coord Int
regionSizes [Coord]
box0) ([Coord] -> Map Coord Int
regionSizes [Coord]
box1)
  where
    regionSizes :: [Coord] -> Map Coord Int
regionSizes = [Coord] -> Map Coord Int
forall (f :: * -> *) a. (Foldable f, Ord a) => f a -> Map a Int
counts ([Coord] -> Map Coord Int)
-> ([Coord] -> [Coord]) -> [Coord] -> Map Coord Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coord -> [Coord]) -> [Coord] -> [Coord]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Coord -> [Coord]
toRegion

    match :: a -> a -> Maybe a
match a
x a
y
      | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y    = a -> Maybe a
forall a. a -> Maybe a
Just a
x
      | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing

    toRegion :: Coord -> [Coord]
toRegion Coord
c =
      case [[(Coord, Int)]]
choices of
        [(Coord
r,Int
_)]:[[(Coord, Int)]]
_ -> [Coord
r] -- only matches on unique minimum
        [[(Coord, Int)]]
_         -> []
      where
        choices :: [[(Coord, Int)]]
choices = ((Coord, Int) -> (Coord, Int) -> Bool)
-> [(Coord, Int)] -> [[(Coord, Int)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==)    (Int -> Int -> Bool)
-> ((Coord, Int) -> Int) -> (Coord, Int) -> (Coord, Int) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Coord, Int) -> Int
forall a b. (a, b) -> b
snd)
                ([(Coord, Int)] -> [[(Coord, Int)]])
-> [(Coord, Int)] -> [[(Coord, Int)]]
forall a b. (a -> b) -> a -> b
$ ((Coord, Int) -> (Coord, Int) -> Ordering)
-> [(Coord, Int)] -> [(Coord, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy  (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> ((Coord, Int) -> Int)
-> (Coord, Int)
-> (Coord, Int)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Coord, Int) -> Int
forall a b. (a, b) -> b
snd)
                  [ (Coord
coord, Coord -> Coord -> Int
manhattan Coord
c Coord
coord) | Coord
coord <- [Coord]
input ]

    Just (Coord
topLeft, Coord
bottomRight) = [Coord] -> Maybe (Coord, Coord)
forall (f :: * -> *). Foldable f => f Coord -> Maybe (Coord, Coord)
boundingBox [Coord]
input

    -- Compute all the coordinates within the min/max bounds as well as a
    -- box that is one larger all the way around
    box0 :: [Coord]
box0 = (Coord, Coord) -> [Coord]
forall a. Ix a => (a, a) -> [a]
range (Coord
topLeft, Coord
bottomRight)
    box1 :: [Coord]
box1 = (Coord, Coord) -> [Coord]
forall a. Ix a => (a, a) -> [a]
range (Coord -> Coord
left (Coord -> Coord
above Coord
topLeft), Coord -> Coord
right (Coord -> Coord
below Coord
bottomRight))


-- | Part 2 finds the size of the region with sum of distances less than 10,000
-- by knowing that this region must contain the point found at the median of
-- all x and y coordinates (which is where the distance will be minimized.
-- Because the region is defined by Manhattan distance the region
-- must be connected, so we can find it by expanding this starting point.
-- Next we'll grow the region considering cardinal neighbors for any point that
-- is in bounds. Once we're unable to grow the region any further we return its
-- size.
part2 :: [Coord] -> Int
part2 :: [Coord] -> Int
part2 [Coord]
input = [Coord] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Coord -> [Coord]) -> Coord -> [Coord]
forall a. Ord a => (a -> [a]) -> a -> [a]
dfs Coord -> [Coord]
step Coord
startingPoint)
  where
    distances :: Coord -> Int
    distances :: Coord -> Int
distances Coord
c = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Coord -> Int) -> [Coord] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Coord -> Coord -> Int
manhattan Coord
c) [Coord]
input)

    step :: Coord -> [Coord]
step Coord
c = [Coord
n | Coord
n <- Coord -> [Coord]
cardinal Coord
c, Coord -> Int
distances Coord
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10000]

    startingPoint :: Coord
startingPoint = Int -> Int -> Coord
C ([Int] -> Int
forall a. Ord a => [a] -> a
median ((Coord -> Int) -> [Coord] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Coord -> Int
coordRow [Coord]
input)) ([Int] -> Int
forall a. Ord a => [a] -> a
median ((Coord -> Int) -> [Coord] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Coord -> Int
coordCol [Coord]
input))

-- | Return the median element of a list. For even lists return the second
-- of the two middle elements.
--
-- >>> median [10,1,5]
-- 5
-- >>> median [1,3,4,5]
-- 4
-- >>> median [1,3,9,10,4,5]
-- 5
median :: Ord a => [a] -> a
median :: forall a. Ord a => [a] -> a
median [a]
xs = [a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
xs [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2)