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

<https://adventofcode.com/2019/day/3>

-}
module Main (main) where

import Advent (format, stageTH)
import Advent.Coord
import Control.Applicative (liftA2)
import Data.Foldable (asum)
import Data.List (foldl1')
import Data.Map (Map)
import Data.Map qualified as Map

-- $setup
-- >>> :set -XQuasiQuotes
-- >>> let parse = [format|- ((@D%u)&,%n)*|] . unlines

-- | Directions up, down, left, and right.
data D = DU | DD | DL | DR
  deriving Int -> D -> ShowS
[D] -> ShowS
D -> String
(Int -> D -> ShowS) -> (D -> String) -> ([D] -> ShowS) -> Show D
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> D -> ShowS
showsPrec :: Int -> D -> ShowS
$cshow :: D -> String
show :: D -> String
$cshowList :: [D] -> ShowS
showList :: [D] -> ShowS
Show

stageTH

-- coordinates ---------------------------------------------------------

-- | Convert a direction letter unit vector in the given direction.
toUnitVector :: D -> Coord
toUnitVector :: D -> Coord
toUnitVector D
DU = Coord
north
toUnitVector D
DD = Coord
south
toUnitVector D
DL = Coord
west
toUnitVector D
DR = Coord
east

------------------------------------------------------------------------

-- | >>> :main
-- 2129
-- 134662
main :: IO ()
IO ()
main =
  do (Int
p1,Int
p2) <- [[(D, Int)]] -> (Int, Int)
answers ([[(D, Int)]] -> (Int, Int)) -> IO [[(D, Int)]] -> IO (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [format|2019 3 ((@D%u)&,%n)*|]
     Int -> IO ()
forall a. Show a => a -> IO ()
print Int
p1
     Int -> IO ()
forall a. Show a => a -> IO ()
print Int
p2

-- | Given the input file parsed as lists of lists of motions, compute the
-- nearest distance to origin and minimum sum steps to intersection.
--
-- >>> let check = answers . parse
-- >>> check ["R8,U5,L5,D3","U7,R6,D4,L4"]
-- (6,30)
-- >>> check ["R75,D30,R83,U83,L12,D49,R71,U7,L72","U62,R66,U55,R34,D71,R55,D58,R83"]
-- (159,610)
-- >>> check ["R98,U47,R26,D63,R33,U87,L62,D20,R33,U53,R51","U98,R91,D20,R16,D67,R40,U7,R15,U6,R7"]
-- (135,410)
answers :: [[(D, Int)]] -> (Int, Int)
answers :: [[(D, Int)]] -> (Int, Int)
answers [[(D, Int)]]
xs = (Map Coord Int -> Int
forall a. Map Coord a -> Int
nearestDistanceToOrigin Map Coord Int
intersections, Map Coord Int -> Int
forall a. Ord a => Map Coord a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum Map Coord Int
intersections)
  where
    intersections :: Map Coord Int
intersections = [[(D, Int)]] -> Map Coord Int
pathIntersections [[(D, Int)]]
xs

-- | Computes the map of path intersections, compute the shortest
-- distance of an intersection to the origin.
nearestDistanceToOrigin :: Map Coord a -> Int
nearestDistanceToOrigin :: forall a. Map Coord a -> Int
nearestDistanceToOrigin = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> Int) -> (Map Coord a -> [Int]) -> Map Coord a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coord -> Int) -> [Coord] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Coord -> Coord -> Int
manhattan Coord
origin) ([Coord] -> [Int])
-> (Map Coord a -> [Coord]) -> Map Coord a -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Coord a -> [Coord]
forall k a. Map k a -> [k]
Map.keys

-- | Given a list of paths compute a map of locations that have intersections
-- among all of the paths. The value at each location is the sum of the
-- number of steps taken along each of the paths to get to that point.
--
-- >>> let check = pathIntersections . parse
-- >>> check ["R8,U5,L5,D3","U7,R6,D4,L4"]
-- fromList [(C (-5) 6,30),(C (-3) 3,40)]
pathIntersections :: [[(D,Int)]] -> Map Coord Int
pathIntersections :: [[(D, Int)]] -> Map Coord Int
pathIntersections = (Map Coord Int -> Map Coord Int -> Map Coord Int)
-> [Map Coord Int] -> Map Coord Int
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' ((Int -> Int -> Int)
-> Map Coord Int -> Map Coord Int -> Map Coord Int
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)) ([Map Coord Int] -> Map Coord Int)
-> ([[(D, Int)]] -> [Map Coord Int])
-> [[(D, Int)]]
-> Map Coord Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(D, Int)] -> Map Coord Int) -> [[(D, Int)]] -> [Map Coord Int]
forall a b. (a -> b) -> [a] -> [b]
map [(D, Int)] -> Map Coord Int
distances

-- | Generate a map of the coordinates a path visits. Each coordinate is
-- indexed by the number of steps it took to get to that location.
--
-- >>> distances [(DD,2), (DR,1)]
-- fromList [(C 1 0,1),(C 2 0,2),(C 2 1,3)]
distances :: [(D,Int)] -> Map Coord Int
distances :: [(D, Int)] -> Map Coord Int
distances [(D, Int)]
steps = (Int -> Int -> Int) -> [(Coord, Int)] -> Map Coord Int
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Int -> Int -> Int
forall a. Ord a => a -> a -> a
min ([Coord] -> [Int] -> [(Coord, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([(D, Int)] -> [Coord]
generatePath [(D, Int)]
steps) [Int
1..])

-- | Generate the list of coordinates visited by a list of steps.
--
-- >>> generatePath [(DD,2), (DR,1)]
-- [C 1 0,C 2 0,C 2 1]
generatePath :: [(D,Int)] -> [Coord]
generatePath :: [(D, Int)] -> [Coord]
generatePath
  = (Coord -> Coord -> Coord) -> [Coord] -> [Coord]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 Coord -> Coord -> Coord
forall a. Num a => a -> a -> a
(+)
  ([Coord] -> [Coord])
-> ([(D, Int)] -> [Coord]) -> [(D, Int)] -> [Coord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((D, Int) -> [Coord]) -> [(D, Int)] -> [Coord]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(D
d,Int
n) -> Int -> Coord -> [Coord]
forall a. Int -> a -> [a]
replicate Int
n (D -> Coord
toUnitVector D
d))