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

<https://adventofcode.com/2017/day/11>

Day 11 asks us to implement a hex grid coordinate system
and compute distances on it.

<https://www.redblobgames.com/grids/hexagons/>

* X grid lines are diagonal from @sw@ to @ne@
* Y grid lines are vertical

@
  +  1,2 +
   \\    /
0,2 +--+  2,1
   /    \\
 -+  1,1 +-
   \\    /
0,1 +--+  2,0
   /    \\
  +  1,0 +
@

-}
module Main where

import Advent (format, partialSums, stageTH)
import Advent.Coord (Coord(..), north, east, south, west)

data D = Dn | Dne | Dnw | Dse | Dsw | Ds 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

-- | Print the solutions to day 11. The input file can be overridden
-- via the command-line.
--
-- >>> :main
-- 761
-- 1542
main :: IO ()
IO ()
main =
  do [D]
input <- [format|2017 11 @D&,%n|]
     let distances :: [Int]
distances = (Coord -> Int) -> [Coord] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Coord -> Int
distance ([Coord] -> [Coord]
forall a. Num a => [a] -> [a]
partialSums ((D -> Coord) -> [D] -> [Coord]
forall a b. (a -> b) -> [a] -> [b]
map D -> Coord
translate [D]
input))
     Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Int
forall a. HasCallStack => [a] -> a
last    [Int]
distances)
     Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
distances)

-- | Compute minimum path distance from the origin on the hex grid.
--
-- >>> distance <$> [C (-1) 0,C (-1) 1,C 0 (-1),C 0 1,C 1 (-1),C 1 0]
-- [1,1,1,1,1,1]
-- >>> distance <$> [C (-1) (-1),C 1 1,C 2 (-1)]
-- [2,2,2]
distance :: Coord -> Int
distance :: Coord -> Int
distance (C Int
y Int
x) = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
forall a. Num a => a -> a
abs [Int
x,Int
y,Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y])

-- | Translate hex direction to grid projection.
--
-- >>> translate <$> [Dn,Ds,Dne,Dse,Dnw,Dsw]
-- [C (-1) 0,C 1 0,C (-1) 1,C 0 1,C 0 (-1),C 1 (-1)]
translate :: D -> Coord
translate :: D -> Coord
translate D
Dne = Coord
north Coord -> Coord -> Coord
forall a. Num a => a -> a -> a
+ Coord
east
translate D
Dn  = Coord
north
translate D
Dnw = Coord
west
translate D
Dsw = Coord
south Coord -> Coord -> Coord
forall a. Num a => a -> a -> a
+ Coord
west
translate D
Ds  = Coord
south
translate D
Dse = Coord
east