{-# Language ImportQualifiedPost, DeriveGeneric, TypeFamilies, TypeOperators, BlockArguments #-}
{-|
Module      : Advent.Coord
Description : Row-major coordinates
Copyright   : (c) Eric Mertens, 2018
License     : ISC
Maintainer  : emertens@gmail.com

2-dimensional coordinates commonly found in AoC problems
where y grows down, x grows right.

@
   -y
    ↑
-x ←0→ +x
    ↓
   +y
@

-}
module Advent.Coord where

import Data.Foldable (toList)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.MemoTrie
import GHC.Generics (Generic)
import GHC.Ix (Ix(unsafeIndex, range, index, inRange, unsafeRangeSize), indexError)

-- | Two-dimensional coordinate
data Coord = C !Int !Int
  deriving (ReadPrec [Coord]
ReadPrec Coord
Int -> ReadS Coord
ReadS [Coord]
(Int -> ReadS Coord)
-> ReadS [Coord]
-> ReadPrec Coord
-> ReadPrec [Coord]
-> Read Coord
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Coord]
$creadListPrec :: ReadPrec [Coord]
readPrec :: ReadPrec Coord
$creadPrec :: ReadPrec Coord
readList :: ReadS [Coord]
$creadList :: ReadS [Coord]
readsPrec :: Int -> ReadS Coord
$creadsPrec :: Int -> ReadS Coord
Read, Int -> Coord -> ShowS
[Coord] -> ShowS
Coord -> String
(Int -> Coord -> ShowS)
-> (Coord -> String) -> ([Coord] -> ShowS) -> Show Coord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Coord] -> ShowS
$cshowList :: [Coord] -> ShowS
show :: Coord -> String
$cshow :: Coord -> String
showsPrec :: Int -> Coord -> ShowS
$cshowsPrec :: Int -> Coord -> ShowS
Show, Eq Coord
Eq Coord
-> (Coord -> Coord -> Ordering)
-> (Coord -> Coord -> Bool)
-> (Coord -> Coord -> Bool)
-> (Coord -> Coord -> Bool)
-> (Coord -> Coord -> Bool)
-> (Coord -> Coord -> Coord)
-> (Coord -> Coord -> Coord)
-> Ord Coord
Coord -> Coord -> Bool
Coord -> Coord -> Ordering
Coord -> Coord -> Coord
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Coord -> Coord -> Coord
$cmin :: Coord -> Coord -> Coord
max :: Coord -> Coord -> Coord
$cmax :: Coord -> Coord -> Coord
>= :: Coord -> Coord -> Bool
$c>= :: Coord -> Coord -> Bool
> :: Coord -> Coord -> Bool
$c> :: Coord -> Coord -> Bool
<= :: Coord -> Coord -> Bool
$c<= :: Coord -> Coord -> Bool
< :: Coord -> Coord -> Bool
$c< :: Coord -> Coord -> Bool
compare :: Coord -> Coord -> Ordering
$ccompare :: Coord -> Coord -> Ordering
Ord, Coord -> Coord -> Bool
(Coord -> Coord -> Bool) -> (Coord -> Coord -> Bool) -> Eq Coord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Coord -> Coord -> Bool
$c/= :: Coord -> Coord -> Bool
== :: Coord -> Coord -> Bool
$c== :: Coord -> Coord -> Bool
Eq, (forall x. Coord -> Rep Coord x)
-> (forall x. Rep Coord x -> Coord) -> Generic Coord
forall x. Rep Coord x -> Coord
forall x. Coord -> Rep Coord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Coord x -> Coord
$cfrom :: forall x. Coord -> Rep Coord x
Generic)

-- | Row (y) of coordinate
coordRow :: Coord -> Int
coordRow :: Coord -> Int
coordRow (C Int
row Int
_) = Int
row

-- | Column (x) of coordinate
coordCol :: Coord -> Int
coordCol :: Coord -> Int
coordCol (C Int
_ Int
col) = Int
col

-- | Row-major coordinate indexing
--
-- >>> range (C 1 1, C 2 2)
-- [C 1 1,C 1 2,C 2 1,C 2 2]
--
-- >>> index (C 1 1, C 2 2) <$> range (C 1 1, C 2 2)
-- [0,1,2,3]
instance Ix Coord where
  unsafeIndex :: (Coord, Coord) -> Coord -> Int
unsafeIndex (C Int
lorow Int
locol, C Int
hirow Int
hicol) (C Int
row Int
col) =
    (Int, Int) -> Int -> Int
forall a. Ix a => (a, a) -> a -> Int
unsafeIndex (Int
lorow,Int
hirow) Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int, Int) -> Int
forall a. Ix a => (a, a) -> Int
unsafeRangeSize (Int
locol,Int
hicol) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int, Int) -> Int -> Int
forall a. Ix a => (a, a) -> a -> Int
unsafeIndex (Int
locol,Int
hicol) Int
col
  {-# INLINE unsafeIndex #-}

  index :: (Coord, Coord) -> Coord -> Int
index (Coord, Coord)
b Coord
i
    | (Coord, Coord) -> Coord -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Coord, Coord)
b Coord
i = (Coord, Coord) -> Coord -> Int
forall a. Ix a => (a, a) -> a -> Int
unsafeIndex (Coord, Coord)
b Coord
i
    | Bool
otherwise   = (Coord, Coord) -> Coord -> String -> Int
forall a b. Show a => (a, a) -> a -> String -> b
indexError (Coord, Coord)
b Coord
i String
"Coord" 
  {-# INLINE index #-}

  inRange :: (Coord, Coord) -> Coord -> Bool
inRange (C Int
lorow Int
locol, C Int
hirow Int
hicol) (C Int
row Int
col) =
    (Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int
lorow,Int
hirow) Int
row Bool -> Bool -> Bool
&& (Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int
locol,Int
hicol) Int
col
  {-# INLINE inRange #-}

  range :: (Coord, Coord) -> [Coord]
range (C Int
lorow Int
locol, C Int
hirow Int
hicol) =
    [Int -> Int -> Coord
C Int
row Int
col | Int
row <- [Int
lorow..Int
hirow], Int
col <- [Int
locol..Int
hicol]]
  {-# INLINE range #-}

  unsafeRangeSize :: (Coord, Coord) -> Int
unsafeRangeSize (C Int
lorow Int
locol, C Int
hirow Int
hicol) =
    (Int
hirow Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lorow Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
hicol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
locol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  {-# INLINE unsafeRangeSize #-}

-- | Decrement y coordinate
above :: Coord -> Coord
above :: Coord -> Coord
above (C Int
y Int
x) = Int -> Int -> Coord
C (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
x

-- | Increment y coordinate
below :: Coord -> Coord
below :: Coord -> Coord
below (C Int
y Int
x) = Int -> Int -> Coord
C (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
x

-- | Decrement x coordinate
left :: Coord -> Coord
left :: Coord -> Coord
left  (C Int
y Int
x) = Int -> Int -> Coord
C Int
y (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

-- | Increment x coordinate
right :: Coord -> Coord
right :: Coord -> Coord
right (C Int
y Int
x) = Int -> Int -> Coord
C Int
y (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | Swap x and y coordinates
invert :: Coord -> Coord
invert :: Coord -> Coord
invert (C Int
y Int
x) = Int -> Int -> Coord
C Int
x Int
y

-- | Invert the x coordinate
flipX :: Coord -> Coord
flipX :: Coord -> Coord
flipX (C Int
y Int
x) = Int -> Int -> Coord
C Int
y (-Int
x)

-- | Invert the y coordinate
flipY :: Coord -> Coord
flipY :: Coord -> Coord
flipY (C Int
y Int
x) = Int -> Int -> Coord
C (-Int
y) Int
x

-- | Rotate coordinate 90-degrees CCW about the origin
turnLeft :: Coord -> Coord
turnLeft :: Coord -> Coord
turnLeft  (C Int
y Int
x) = Int -> Int -> Coord
C (-Int
x) Int
y

-- | Rotate coordinate 90-degrees CW about the origin
turnRight :: Coord -> Coord
turnRight :: Coord -> Coord
turnRight (C Int
y Int
x) = Int -> Int -> Coord
C Int
x (-Int
y)

-- | Rotate the coordinate 180-degrees about the origin
turnAround :: Coord -> Coord
turnAround :: Coord -> Coord
turnAround (C Int
y Int
x) = Int -> Int -> Coord
C (-Int
y) (-Int
x)

-- | Compute the Manhattan distance between two coordinates
manhattan :: Coord -> Coord -> Int
manhattan :: Coord -> Coord -> Int
manhattan (C Int
x Int
y) (C Int
u Int
v) = Int -> Int
forall a. Num a => a -> a
abs (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
u) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Num a => a -> a
abs (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
v)

-- | Compute the 4 cardinal neighbors of a coordinate: north, south, east, west
cardinal :: Coord -> [Coord]
cardinal :: Coord -> [Coord]
cardinal Coord
c = Coord
c Coord -> [Coord] -> [Coord]
`seq` [Coord -> Coord
above Coord
c, Coord -> Coord
left Coord
c, Coord -> Coord
right Coord
c, Coord -> Coord
below Coord
c]

-- | Compute the 8 cardinal neighbors and diagonal neighbors
neighbors :: Coord -> [Coord]
neighbors :: Coord -> [Coord]
neighbors Coord
c = Coord
c Coord -> [Coord] -> [Coord]
`seq` [Coord -> Coord
above Coord
c, Coord -> Coord
left Coord
c, Coord -> Coord
right Coord
c, Coord -> Coord
below Coord
c,
                       Coord -> Coord
above (Coord -> Coord
left Coord
c), Coord -> Coord
above (Coord -> Coord
right Coord
c),
                       Coord -> Coord
below (Coord -> Coord
left Coord
c), Coord -> Coord
below (Coord -> Coord
right Coord
c)]

-- | Find the upper-left and lower-right coordinates that
-- inclusively contain all the coordinates in a list of
-- coordinates.
boundingBox :: [Coord] -> Maybe (Coord, Coord)
boundingBox :: [Coord] -> Maybe (Coord, Coord)
boundingBox [Coord]
t =
  case [Coord]
t of
    []         -> Maybe (Coord, Coord)
forall a. Maybe a
Nothing
    C Int
y Int
x : [Coord]
cs -> Int -> Int -> Int -> Int -> [Coord] -> Maybe (Coord, Coord)
go Int
y Int
x Int
y Int
x [Coord]
cs
  where
    go :: Int -> Int -> Int -> Int -> [Coord] -> Maybe (Coord, Coord)
go Int
loy Int
lox Int
hiy Int
hix [] = (Coord, Coord) -> Maybe (Coord, Coord)
forall a. a -> Maybe a
Just (Int -> Int -> Coord
C Int
loy Int
lox, Int -> Int -> Coord
C Int
hiy Int
hix)
    go Int
loy Int
lox Int
hiy Int
hix (C Int
y Int
x : [Coord]
cs) = Int -> Int -> Int -> Int -> [Coord] -> Maybe (Coord, Coord)
go (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
loy Int
y) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
lox Int
x) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
hiy Int
y) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
hix Int
x) [Coord]
cs

-- | Coordinate at the origin
origin :: Coord
origin :: Coord
origin = Int -> Int -> Coord
C Int
0 Int
0

-- | Unit vector pointing up
north :: Coord
north :: Coord
north = Int -> Int -> Coord
C (-Int
1) Int
0

-- | Unit vector pointing right
east :: Coord
east :: Coord
east = Int -> Int -> Coord
C Int
0 Int
1

-- | Unit vector pointing down
south :: Coord
south :: Coord
south = Int -> Int -> Coord
C Int
1 Int
0

-- | Unit vector pointing left
west :: Coord
west :: Coord
west = Int -> Int -> Coord
C Int
0 (-Int
1)

-- | Add two coordinates as vectors from the origin
addCoord :: Coord -> Coord -> Coord
addCoord :: Coord -> Coord -> Coord
addCoord (C Int
y Int
x) (C Int
v Int
u) = Int -> Int -> Coord
C (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
v) (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
u)

-- | Scale a coordinate as a vector from the origin
scaleCoord :: Int -> Coord -> Coord
scaleCoord :: Int -> Coord -> Coord
scaleCoord Int
n (C Int
x Int
y) = Int -> Int -> Coord
C (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n) (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n)

-- | Render a minimal bounding box containing all the characters
-- at the given coordinates. Empty space filled with space characters.
drawPicture :: Map Coord Char -> String
drawPicture :: Map Coord Char -> String
drawPicture Map Coord Char
pixels =
  case [Coord] -> Maybe (Coord, Coord)
boundingBox (Map Coord Char -> [Coord]
forall k a. Map k a -> [k]
Map.keys Map Coord Char
pixels) of
    Maybe (Coord, Coord)
Nothing -> String
""
    Just (C Int
miny Int
minx, C Int
maxy Int
maxx) ->
      [String] -> String
unlines [[Char -> Coord -> Map Coord Char -> Char
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Char
' ' (Int -> Int -> Coord
C Int
y Int
x) Map Coord Char
pixels | Int
x <- [Int
minx .. Int
maxx]] | Int
y <- [Int
miny .. Int
maxy]]

-- | Render a minimal bounding box containing boxes
-- at the given coordinates.
drawCoords :: Foldable t => t Coord -> String
drawCoords :: forall (t :: * -> *). Foldable t => t Coord -> String
drawCoords t Coord
coords = Map Coord Char -> String
drawPicture ([(Coord, Char)] -> Map Coord Char
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Coord
c,Char
'█') | Coord
c <- t Coord -> [Coord]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Coord
coords])

-- | Given a list of lines pair up each character with
-- its position.
coordLines :: [String] -> [(Coord, Char)]
coordLines :: [String] -> [(Coord, Char)]
coordLines [String]
rows = [(Int -> Int -> Coord
C Int
y Int
x, Char
z) | (Int
y,String
row) <- [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [String]
rows, (Int
x,Char
z) <- [Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] String
row]

mapCoord :: (Int -> Int) -> Coord -> Coord
mapCoord :: (Int -> Int) -> Coord -> Coord
mapCoord Int -> Int
f (C Int
y Int
x) = Int -> Int -> Coord
C (Int -> Int
f Int
y) (Int -> Int
f Int
x)

zipCoord :: (Int -> Int -> Int) -> Coord -> Coord -> Coord
zipCoord :: (Int -> Int -> Int) -> Coord -> Coord -> Coord
zipCoord Int -> Int -> Int
f (C Int
y1 Int
x1) (C Int
y2 Int
x2) = Int -> Int -> Coord
C (Int -> Int -> Int
f Int
y1 Int
y2) (Int -> Int -> Int
f Int
x1 Int
x2)

-- | Paisewise treatment of coordinates
instance Num Coord where
  + :: Coord -> Coord -> Coord
(+) = (Int -> Int -> Int) -> Coord -> Coord -> Coord
zipCoord Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
  {-# INLINE (+) #-}
  (-) = (Int -> Int -> Int) -> Coord -> Coord -> Coord
zipCoord (-)
  {-# INLINE (-) #-}
  * :: Coord -> Coord -> Coord
(*) = (Int -> Int -> Int) -> Coord -> Coord -> Coord
zipCoord Int -> Int -> Int
forall a. Num a => a -> a -> a
(*)
  {-# INLINE (*) #-}
  negate :: Coord -> Coord
negate = (Int -> Int) -> Coord -> Coord
mapCoord Int -> Int
forall a. Num a => a -> a
negate
  {-# INLINE negate #-}
  abs :: Coord -> Coord
abs = (Int -> Int) -> Coord -> Coord
mapCoord Int -> Int
forall a. Num a => a -> a
abs
  {-# INLINE abs #-}
  signum :: Coord -> Coord
signum = (Int -> Int) -> Coord -> Coord
mapCoord Int -> Int
forall a. Num a => a -> a
signum
  {-# INLINE signum #-}
  fromInteger :: Integer -> Coord
fromInteger = (\Int
i -> Int -> Int -> Coord
C Int
i Int
i) (Int -> Coord) -> (Integer -> Int) -> Integer -> Coord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger
  {-# INLINE fromInteger #-}

instance HasTrie Coord where
  newtype Coord :->: a = CT (Int :->: Int :->: a)
  trie :: forall b. (Coord -> b) -> Coord :->: b
trie Coord -> b
f = (Int :->: (Int :->: b)) -> Coord :->: b
forall a. (Int :->: (Int :->: a)) -> Coord :->: a
CT ((Int -> Int :->: b) -> Int :->: (Int :->: b)
forall a b. HasTrie a => (a -> b) -> a :->: b
trie \Int
y -> (Int -> b) -> Int :->: b
forall a b. HasTrie a => (a -> b) -> a :->: b
trie \Int
x -> Coord -> b
f (Int -> Int -> Coord
C Int
y Int
x))
  CT Int :->: (Int :->: b)
t untrie :: forall b. (Coord :->: b) -> Coord -> b
`untrie` C Int
y Int
x = Int :->: (Int :->: b)
t (Int :->: (Int :->: b)) -> Int -> Int :->: b
forall a b. HasTrie a => (a :->: b) -> a -> b
`untrie` Int
y (Int :->: b) -> Int -> b
forall a b. HasTrie a => (a :->: b) -> a -> b
`untrie` Int
x
  enumerate :: forall b. (Coord :->: b) -> [(Coord, b)]
enumerate (CT Int :->: (Int :->: b)
t) = [(Int -> Int -> Coord
C Int
y Int
x, b
a) | (Int
y, Int :->: b
xs) <- (Int :->: (Int :->: b)) -> [(Int, Int :->: b)]
forall a b. HasTrie a => (a :->: b) -> [(a, b)]
enumerate Int :->: (Int :->: b)
t, (Int
x, b
a) <- (Int :->: b) -> [(Int, b)]
forall a b. HasTrie a => (a :->: b) -> [(a, b)]
enumerate Int :->: b
xs]