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

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

We're in an asteroid field of infinitesimal asteroids on a lattice.
We'll need to figure out which location can see the most other asteroids
and then figure out what order a clockwise sweep of them those asteroids
fall into.

-}
module Main (main) where

import Advent (getInputLines, countBy)
import Advent.Coord (coordLines, Coord(..), manhattan, scaleCoord)
import Data.Foldable (Foldable(toList))
import Data.List (sortOn, transpose)
import Data.Map qualified as Map
import Data.Ratio ((%))
import Data.Set (Set)
import Data.Set qualified as Set

-- | >>> :main
-- 227
-- 604
main :: IO ()
IO ()
main =
 do [String]
inp <- Int -> Int -> IO [String]
getInputLines Int
2019 Int
10
    let locs :: Set Coord
locs = [Coord] -> Set Coord
forall a. Ord a => [a] -> Set a
Set.fromList [Coord
c | (Coord
c,Char
'#') <- [String] -> [(Coord, Char)]
coordLines [String]
inp]
    let (Int
vis, Coord
base) = Set Coord -> (Int, Coord)
findBase Set Coord
locs
    Int -> IO ()
forall a. Show a => a -> IO ()
print Int
vis
    let C Int
y Int
x = Coord -> Set Coord -> [Coord]
spiral Coord
base (Coord -> Set Coord -> Set Coord
forall a. Ord a => a -> Set a -> Set a
Set.delete Coord
base Set Coord
locs) [Coord] -> Int -> Coord
forall a. HasCallStack => [a] -> Int -> a
!! Int
199
    Int -> IO ()
forall a. Show a => a -> IO ()
print (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)

-- | Find the location of the base with the most visibility.
findBase :: Set Coord -> (Int, Coord)
findBase :: Set Coord -> (Int, Coord)
findBase Set Coord
m = [(Int, Coord)] -> (Int, Coord)
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [((Coord -> Bool) -> Set Coord -> Int
forall (f :: * -> *) a. Foldable f => (a -> Bool) -> f a -> Int
countBy (Set Coord -> Coord -> Coord -> Bool
lineOfSight Set Coord
m Coord
i) Set Coord
m, Coord
i) | Coord
i <- Set Coord -> [Coord]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Coord
m]

-- | Return the coordinates ordered in a spiral given a center
-- location.
spiral ::
  Coord {- ^ center of spiral -} ->
  Set Coord {- ^ objects -} ->
  [Coord] {- ^ spiral ordered objects -}
spiral :: Coord -> Set Coord -> [Coord]
spiral Coord
base
  = [[Coord]] -> [Coord]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  ([[Coord]] -> [Coord])
-> (Set Coord -> [[Coord]]) -> Set Coord -> [Coord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Coord]] -> [[Coord]]
forall a. [[a]] -> [[a]]
transpose
  ([[Coord]] -> [[Coord]])
-> (Set Coord -> [[Coord]]) -> Set Coord -> [[Coord]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Coord] -> [Coord]) -> [[Coord]] -> [[Coord]]
forall a b. (a -> b) -> [a] -> [b]
map ((Coord -> Int) -> [Coord] -> [Coord]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Coord -> Coord -> Int
manhattan Coord
base))
  ([[Coord]] -> [[Coord]])
-> (Set Coord -> [[Coord]]) -> Set Coord -> [[Coord]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coord -> Rational) -> [Coord] -> [[Coord]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupOn (Coord -> Rational
toAngle (Coord -> Rational) -> (Coord -> Coord) -> Coord -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coord -> Coord -> Coord
forall a. Num a => a -> a -> a
subtract Coord
base)
  ([Coord] -> [[Coord]])
-> (Set Coord -> [Coord]) -> Set Coord -> [[Coord]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Coord -> [Coord]
forall a. Set a -> [a]
Set.toList

-- | Check if two asteroids have line of sight between each other.
lineOfSight ::
  Set Coord {- ^ obstructions -} ->
  Coord -> Coord -> Bool
lineOfSight :: Set Coord -> Coord -> Coord -> Bool
lineOfSight Set Coord
ast Coord
a Coord
b = Coord
a Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
/= Coord
b Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Coord -> Set Coord -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember Coord
c Set Coord
ast | Coord
c <- Coord -> Coord -> [Coord]
between Coord
a Coord
b]

-- * Coordinate utilities

-- | Return all the locations that fall on a line between two coordinates.
--
-- >>> between (C 1 1) (C 7 4)
-- [C 3 2,C 5 3]
--
-- >>> between (C 1 1) (C 6 6)
-- [C 2 2,C 3 3,C 4 4,C 5 5]
--
-- >>> between (C 5 5) (C 1 1)
-- [C 4 4,C 3 3,C 2 2]
--
-- >>> between (C 1 1) (C 6 7)
-- []
--
-- >>> between (C 0 0) (C 0 0)
-- []
between :: Coord -> Coord -> [Coord]
between :: Coord -> Coord -> [Coord]
between Coord
a Coord
b = [Coord
a Coord -> Coord -> Coord
forall a. Num a => a -> a -> a
+ Int -> Coord -> Coord
scaleCoord Int
i Coord
unit | Int
i <- [Int
1 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
  where
    C Int
dy Int
dx = Coord
b Coord -> Coord -> Coord
forall a. Num a => a -> a -> a
- Coord
a 
    n :: Int
n = Int -> Int -> Int
forall a. Integral a => a -> a -> a
gcd Int
dx Int
dy
    unit :: Coord
unit = Int -> Int -> Coord
C (Int
dy Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
n) (Int
dx Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
n)

-- | Compute a representation of the the angle from the origin to the given
-- coordinate such that the angles are ordered clockwise starting at directly
-- north.
--
-- >>> import Advent.Coord
-- >>> import Data.List (sort)
-- >>> let clockwise = [origin, north, north+north+east, north+east, north+east+east, east, south+east+east, south+east, south+south+east, south, south+south+west, south+west, south+west+west, west, north+west+west, north+west, north+north+west]
-- >>> let angles = map toAngle clockwise
-- >>> angles
-- [(-1) % 1,0 % 1,1 % 3,1 % 2,2 % 3,1 % 1,4 % 3,3 % 2,5 % 3,2 % 1,7 % 3,5 % 2,8 % 3,3 % 1,10 % 3,7 % 2,11 % 3]
--
-- Angles have clockwise arrangement:
--
-- >>> sort angles == angles
-- True
--
-- Angles are independent of scale:
--
-- >>> map toAngle clockwise == map (toAngle . (3*)) clockwise
-- True
toAngle :: Coord -> Rational
toAngle :: Coord -> Rational
toAngle (C Int
y Int
x)
  | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0, Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = -Rational
1          -- center
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0, Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
0 = Int -> Int -> Int -> Rational
forall {a} {a}. (Integral a, Integral a) => a -> a -> a -> Ratio a
mk Int
1 Int
x (-Int
y) -- northeast
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
0, Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> Int -> Int -> Rational
forall {a} {a}. (Integral a, Integral a) => a -> a -> a -> Ratio a
mk Int
2 Int
y Int
x    -- southeast
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0, Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
0 = Int -> Int -> Int -> Rational
forall {a} {a}. (Integral a, Integral a) => a -> a -> a -> Ratio a
mk Int
3 (-Int
x) Int
y -- southwest
  | Bool
otherwise      = Int -> Int -> Int -> Rational
forall {a} {a}. (Integral a, Integral a) => a -> a -> a -> Ratio a
mk Int
4 Int
y Int
x    -- northwest
  where
    -- q in [1,2,3,4]; a >= 0; b > 0
    mk :: a -> a -> a -> Ratio a
mk a
q a
a a
b = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
qa -> a -> a
forall a. Num a => a -> a -> a
*(a
aa -> a -> a
forall a. Num a => a -> a -> a
+a
b)a -> a -> a
forall a. Num a => a -> a -> a
-a
b) a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
aa -> a -> a
forall a. Num a => a -> a -> a
+a
b)

-- * List utilities

-- | Group the elements of a list using a charactizing function.
--
-- >>> groupOn (`mod` 3) [0..10]
-- [[9,6,3,0],[10,7,4,1],[8,5,2]]
groupOn :: Ord b => (a -> b) -> [a] -> [[a]]
groupOn :: forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupOn a -> b
f [a]
xs = Map b [a] -> [[a]]
forall k a. Map k a -> [a]
Map.elems (([a] -> [a] -> [a]) -> [(b, [a])] -> Map b [a]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) [(a -> b
f a
x, [a
x]) | a
x <- [a]
xs])