{-# LANGUAGE ScopedTypeVariables #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Algorithms.Geometry.DelaunayTriangulation.Types
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Defines some geometric types used in the delaunay triangulation
--
--------------------------------------------------------------------------------
module Algorithms.Geometry.DelaunayTriangulation.Types
  ( VertexID
  , Vertex
  , Adj
  , Triangulation(..)
  , vertexIds
  , positions
  , neighbours
  , Mapping
  , edgesAsPoints
  , edgesAsVertices
  , toPlanarSubdivision
  , toPlaneGraph
  ) where

import           Control.Lens
import qualified Data.CircularList as C
import           Data.Ext
import           Data.Geometry
import           Data.Geometry.PlanarSubdivision
import qualified Data.IntMap.Strict as IM
import qualified Data.Map as M
-- import qualified Data.Map.Strict as SM
import qualified Data.PlaneGraph  as PG
import qualified Data.PlanarGraph as PPG
import qualified Data.Vector as V


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

-- We store all adjacency lists in clockwise order

-- : If v on the convex hull, then its first entry in the adj. lists is its CCW
-- successor (i.e. its predecessor) on the convex hull

-- | Vertex identifier.
type VertexID = Int

-- | Rotating Right <-> rotate clockwise
type Vertex    = C.CList VertexID

-- | Neighbours indexed by VertexID.
type Adj = IM.IntMap (C.CList VertexID)

-- | Neighbours are stored in clockwise order: i.e. rotating right moves to the
-- next clockwise neighbour.
data Triangulation p r = Triangulation { Triangulation p r -> Map (Point 2 r) VertexID
_vertexIds  :: M.Map (Point 2 r) VertexID
                                       , Triangulation p r -> Vector (Point 2 r :+ p)
_positions  :: V.Vector (Point 2 r :+ p)
                                       , Triangulation p r -> Vector (CList VertexID)
_neighbours :: V.Vector (C.CList VertexID)
                                       }
                         deriving (VertexID -> Triangulation p r -> ShowS
[Triangulation p r] -> ShowS
Triangulation p r -> String
(VertexID -> Triangulation p r -> ShowS)
-> (Triangulation p r -> String)
-> ([Triangulation p r] -> ShowS)
-> Show (Triangulation p r)
forall a.
(VertexID -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
forall p r.
(Show r, Show p) =>
VertexID -> Triangulation p r -> ShowS
forall p r. (Show r, Show p) => [Triangulation p r] -> ShowS
forall p r. (Show r, Show p) => Triangulation p r -> String
showList :: [Triangulation p r] -> ShowS
$cshowList :: forall p r. (Show r, Show p) => [Triangulation p r] -> ShowS
show :: Triangulation p r -> String
$cshow :: forall p r. (Show r, Show p) => Triangulation p r -> String
showsPrec :: VertexID -> Triangulation p r -> ShowS
$cshowsPrec :: forall p r.
(Show r, Show p) =>
VertexID -> Triangulation p r -> ShowS
Show,Triangulation p r -> Triangulation p r -> Bool
(Triangulation p r -> Triangulation p r -> Bool)
-> (Triangulation p r -> Triangulation p r -> Bool)
-> Eq (Triangulation p r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall p r.
(Eq r, Eq p) =>
Triangulation p r -> Triangulation p r -> Bool
/= :: Triangulation p r -> Triangulation p r -> Bool
$c/= :: forall p r.
(Eq r, Eq p) =>
Triangulation p r -> Triangulation p r -> Bool
== :: Triangulation p r -> Triangulation p r -> Bool
$c== :: forall p r.
(Eq r, Eq p) =>
Triangulation p r -> Triangulation p r -> Bool
Eq)

-- | Mapping between triangulated points and their internal VertexID.
vertexIds :: Lens' (Triangulation p r) (M.Map (Point 2 r) VertexID)
vertexIds :: (Map (Point 2 r) VertexID -> f (Map (Point 2 r) VertexID))
-> Triangulation p r -> f (Triangulation p r)
vertexIds = (Triangulation p r -> Map (Point 2 r) VertexID)
-> (Triangulation p r
    -> Map (Point 2 r) VertexID -> Triangulation p r)
-> Lens
     (Triangulation p r)
     (Triangulation p r)
     (Map (Point 2 r) VertexID)
     (Map (Point 2 r) VertexID)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Triangulation p r -> Map (Point 2 r) VertexID
forall p r. Triangulation p r -> Map (Point 2 r) VertexID
_vertexIds (\(Triangulation Map (Point 2 r) VertexID
_v Vector (Point 2 r :+ p)
p Vector (CList VertexID)
n) Map (Point 2 r) VertexID
v -> Map (Point 2 r) VertexID
-> Vector (Point 2 r :+ p)
-> Vector (CList VertexID)
-> Triangulation p r
forall p r.
Map (Point 2 r) VertexID
-> Vector (Point 2 r :+ p)
-> Vector (CList VertexID)
-> Triangulation p r
Triangulation Map (Point 2 r) VertexID
v Vector (Point 2 r :+ p)
p Vector (CList VertexID)
n)

-- | Point positions indexed by VertexID.
positions :: Lens (Triangulation p1 r) (Triangulation p2 r) (V.Vector (Point 2 r :+ p1)) (V.Vector (Point 2 r :+ p2))
positions :: (Vector (Point 2 r :+ p1) -> f (Vector (Point 2 r :+ p2)))
-> Triangulation p1 r -> f (Triangulation p2 r)
positions = (Triangulation p1 r -> Vector (Point 2 r :+ p1))
-> (Triangulation p1 r
    -> Vector (Point 2 r :+ p2) -> Triangulation p2 r)
-> Lens
     (Triangulation p1 r)
     (Triangulation p2 r)
     (Vector (Point 2 r :+ p1))
     (Vector (Point 2 r :+ p2))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Triangulation p1 r -> Vector (Point 2 r :+ p1)
forall p r. Triangulation p r -> Vector (Point 2 r :+ p)
_positions (\(Triangulation Map (Point 2 r) VertexID
v Vector (Point 2 r :+ p1)
_p Vector (CList VertexID)
n) Vector (Point 2 r :+ p2)
p -> Map (Point 2 r) VertexID
-> Vector (Point 2 r :+ p2)
-> Vector (CList VertexID)
-> Triangulation p2 r
forall p r.
Map (Point 2 r) VertexID
-> Vector (Point 2 r :+ p)
-> Vector (CList VertexID)
-> Triangulation p r
Triangulation Map (Point 2 r) VertexID
v Vector (Point 2 r :+ p2)
p Vector (CList VertexID)
n)

-- | Point neighbours indexed by VertexID.
neighbours :: Lens' (Triangulation p r) (V.Vector (C.CList VertexID))
neighbours :: (Vector (CList VertexID) -> f (Vector (CList VertexID)))
-> Triangulation p r -> f (Triangulation p r)
neighbours = (Triangulation p r -> Vector (CList VertexID))
-> (Triangulation p r
    -> Vector (CList VertexID) -> Triangulation p r)
-> Lens
     (Triangulation p r)
     (Triangulation p r)
     (Vector (CList VertexID))
     (Vector (CList VertexID))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Triangulation p r -> Vector (CList VertexID)
forall p r. Triangulation p r -> Vector (CList VertexID)
_neighbours (\(Triangulation Map (Point 2 r) VertexID
v Vector (Point 2 r :+ p)
p Vector (CList VertexID)
_n) Vector (CList VertexID)
n -> Map (Point 2 r) VertexID
-> Vector (Point 2 r :+ p)
-> Vector (CList VertexID)
-> Triangulation p r
forall p r.
Map (Point 2 r) VertexID
-> Vector (Point 2 r :+ p)
-> Vector (CList VertexID)
-> Triangulation p r
Triangulation Map (Point 2 r) VertexID
v Vector (Point 2 r :+ p)
p Vector (CList VertexID)
n)


type instance NumType   (Triangulation p r) = r
type instance Dimension (Triangulation p r) = 2

-- | Bidirectional mapping between points and VertexIDs.
type Mapping p r = (M.Map (Point 2 r) VertexID, V.Vector (Point 2 r :+ p))




-- showDT :: (Show p, Show r)  => Triangulation p r -> IO ()
-- showDT = mapM_ print . edgesAsPoints

{- HLINT ignore edgesAsPoints -}
-- | List add edges as point pairs.
edgesAsPoints   :: Triangulation p r -> [(Point 2 r :+ p, Point 2 r :+ p)]
edgesAsPoints :: Triangulation p r -> [(Point 2 r :+ p, Point 2 r :+ p)]
edgesAsPoints Triangulation p r
t = let pts :: Vector (Point 2 r :+ p)
pts = Triangulation p r -> Vector (Point 2 r :+ p)
forall p r. Triangulation p r -> Vector (Point 2 r :+ p)
_positions Triangulation p r
t
                       in ((VertexID, VertexID) -> (Point 2 r :+ p, Point 2 r :+ p))
-> [(VertexID, VertexID)] -> [(Point 2 r :+ p, Point 2 r :+ p)]
forall a b. (a -> b) -> [a] -> [b]
map (\(VertexID
u,VertexID
v) -> (Vector (Point 2 r :+ p)
pts Vector (Point 2 r :+ p) -> VertexID -> Point 2 r :+ p
forall a. Vector a -> VertexID -> a
V.! VertexID
u, Vector (Point 2 r :+ p)
pts Vector (Point 2 r :+ p) -> VertexID -> Point 2 r :+ p
forall a. Vector a -> VertexID -> a
V.! VertexID
v)) ([(VertexID, VertexID)] -> [(Point 2 r :+ p, Point 2 r :+ p)])
-> (Triangulation p r -> [(VertexID, VertexID)])
-> Triangulation p r
-> [(Point 2 r :+ p, Point 2 r :+ p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Triangulation p r -> [(VertexID, VertexID)]
forall p r. Triangulation p r -> [(VertexID, VertexID)]
edgesAsVertices (Triangulation p r -> [(Point 2 r :+ p, Point 2 r :+ p)])
-> Triangulation p r -> [(Point 2 r :+ p, Point 2 r :+ p)]
forall a b. (a -> b) -> a -> b
$ Triangulation p r
t

-- | List add edges as VertexID pairs.
edgesAsVertices :: Triangulation p r -> [(VertexID,VertexID)]
edgesAsVertices :: Triangulation p r -> [(VertexID, VertexID)]
edgesAsVertices = ((VertexID, CList VertexID) -> [(VertexID, VertexID)])
-> [(VertexID, CList VertexID)] -> [(VertexID, VertexID)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(VertexID
i,CList VertexID
ns) -> (VertexID -> (VertexID, VertexID))
-> [VertexID] -> [(VertexID, VertexID)]
forall a b. (a -> b) -> [a] -> [b]
map (VertexID
i,) ([VertexID] -> [(VertexID, VertexID)])
-> (CList VertexID -> [VertexID])
-> CList VertexID
-> [(VertexID, VertexID)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VertexID -> Bool) -> [VertexID] -> [VertexID]
forall a. (a -> Bool) -> [a] -> [a]
filter (VertexID -> VertexID -> Bool
forall a. Ord a => a -> a -> Bool
> VertexID
i) ([VertexID] -> [VertexID])
-> (CList VertexID -> [VertexID]) -> CList VertexID -> [VertexID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CList VertexID -> [VertexID]
forall a. CList a -> [a]
C.toList (CList VertexID -> [(VertexID, VertexID)])
-> CList VertexID -> [(VertexID, VertexID)]
forall a b. (a -> b) -> a -> b
$ CList VertexID
ns)
       ([(VertexID, CList VertexID)] -> [(VertexID, VertexID)])
-> (Triangulation p r -> [(VertexID, CList VertexID)])
-> Triangulation p r
-> [(VertexID, VertexID)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [VertexID] -> [CList VertexID] -> [(VertexID, CList VertexID)]
forall a b. [a] -> [b] -> [(a, b)]
zip [VertexID
0..] ([CList VertexID] -> [(VertexID, CList VertexID)])
-> (Triangulation p r -> [CList VertexID])
-> Triangulation p r
-> [(VertexID, CList VertexID)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (CList VertexID) -> [CList VertexID]
forall a. Vector a -> [a]
V.toList (Vector (CList VertexID) -> [CList VertexID])
-> (Triangulation p r -> Vector (CList VertexID))
-> Triangulation p r
-> [CList VertexID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Triangulation p r -> Vector (CList VertexID)
forall p r. Triangulation p r -> Vector (CList VertexID)
_neighbours

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

-- data ST a b c = ST { fst' :: !a, snd' :: !b , trd' :: !c}

-- type ArcID = Int

-- | ST' is a strict triple (m,a,x) containing:
--
-- - m: a Map, mapping edges, represented by a pair of vertexId's (u,v) with
--            u < v, to arcId's.
-- - a: the next available unused arcID
-- - x: the data value we are interested in computing
-- type ST' a = ST (SM.Map (VertexID,VertexID) ArcID) ArcID a


-- | convert the triangulation into a planarsubdivision
--
-- running time: \(O(n)\).
toPlanarSubdivision    :: (Ord r, Fractional r)
                       => proxy s -> Triangulation p r -> PlanarSubdivision s p () () r
toPlanarSubdivision :: proxy s -> Triangulation p r -> PlanarSubdivision s p () () r
toPlanarSubdivision proxy s
px = PlaneGraph s p () () r -> PlanarSubdivision s p () () r
forall k (s :: k) v e f r.
(Ord r, Fractional r) =>
PlaneGraph s v e f r -> PlanarSubdivision s v e f r
fromPlaneGraph (PlaneGraph s p () () r -> PlanarSubdivision s p () () r)
-> (Triangulation p r -> PlaneGraph s p () () r)
-> Triangulation p r
-> PlanarSubdivision s p () () r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy s -> Triangulation p r -> PlaneGraph s p () () r
forall k (proxy :: k -> *) (s :: k) p r.
proxy s -> Triangulation p r -> PlaneGraph s p () () r
toPlaneGraph proxy s
px

-- | convert the triangulation into a plane graph
--
-- running time: \(O(n)\).
toPlaneGraph    :: forall proxy s p r.
                   proxy s -> Triangulation p r -> PG.PlaneGraph s p () () r
toPlaneGraph :: proxy s -> Triangulation p r -> PlaneGraph s p () () r
toPlaneGraph proxy s
_ Triangulation p r
tr = PlanarGraph s 'Primal (VertexData r p) () ()
-> PlaneGraph s p () () r
forall k (s :: k) v e f r.
PlanarGraph s 'Primal (VertexData r v) e f -> PlaneGraph s v e f r
PG.PlaneGraph (PlanarGraph s 'Primal (VertexData r p) () ()
 -> PlaneGraph s p () () r)
-> PlanarGraph s 'Primal (VertexData r p) () ()
-> PlaneGraph s p () () r
forall a b. (a -> b) -> a -> b
$ PlanarGraph s 'Primal () () ()
gPlanarGraph s 'Primal () () ()
-> (PlanarGraph s 'Primal () () ()
    -> PlanarGraph s 'Primal (VertexData r p) () ())
-> PlanarGraph s 'Primal (VertexData r p) () ()
forall a b. a -> (a -> b) -> b
&(Vector () -> Identity (Vector (VertexData r p)))
-> PlanarGraph s 'Primal () () ()
-> Identity (PlanarGraph s 'Primal (VertexData r p) () ())
forall k (s :: k) (w :: World) v e f v'.
Lens
  (PlanarGraph s w v e f)
  (PlanarGraph s w v' e f)
  (Vector v)
  (Vector v')
PPG.vertexData ((Vector () -> Identity (Vector (VertexData r p)))
 -> PlanarGraph s 'Primal () () ()
 -> Identity (PlanarGraph s 'Primal (VertexData r p) () ()))
-> Vector (VertexData r p)
-> PlanarGraph s 'Primal () () ()
-> PlanarGraph s 'Primal (VertexData r p) () ()
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Vector (VertexData r p)
vtxData
  where
    g :: PlanarGraph s 'Primal () () ()
g       = [(VertexId s 'Primal, CList (VertexId s 'Primal))]
-> PlanarGraph s 'Primal () () ()
forall k (s :: k) (w :: World) (h :: * -> *).
(Foldable h, Functor h) =>
[(VertexId s w, h (VertexId s w))] -> PlanarGraph s w () () ()
PPG.fromAdjacencyLists ([(VertexId s 'Primal, CList (VertexId s 'Primal))]
 -> PlanarGraph s 'Primal () () ())
-> (Vector (CList VertexID)
    -> [(VertexId s 'Primal, CList (VertexId s 'Primal))])
-> Vector (CList VertexID)
-> PlanarGraph s 'Primal () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (VertexId s 'Primal, CList (VertexId s 'Primal))
-> [(VertexId s 'Primal, CList (VertexId s 'Primal))]
forall a. Vector a -> [a]
V.toList (Vector (VertexId s 'Primal, CList (VertexId s 'Primal))
 -> [(VertexId s 'Primal, CList (VertexId s 'Primal))])
-> (Vector (CList VertexID)
    -> Vector (VertexId s 'Primal, CList (VertexId s 'Primal)))
-> Vector (CList VertexID)
-> [(VertexId s 'Primal, CList (VertexId s 'Primal))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VertexID
 -> CList VertexID
 -> (VertexId s 'Primal, CList (VertexId s 'Primal)))
-> Vector (CList VertexID)
-> Vector (VertexId s 'Primal, CList (VertexId s 'Primal))
forall a b. (VertexID -> a -> b) -> Vector a -> Vector b
V.imap VertexID
-> CList VertexID
-> (VertexId s 'Primal, CList (VertexId s 'Primal))
forall k k (f :: * -> *) (s :: k) (w :: World) (s :: k)
       (w :: World).
Functor f =>
VertexID -> f VertexID -> (VertexId s w, f (VertexId s w))
f (Vector (CList VertexID) -> PlanarGraph s 'Primal () () ())
-> Vector (CList VertexID) -> PlanarGraph s 'Primal () () ()
forall a b. (a -> b) -> a -> b
$ Triangulation p r
trTriangulation p r
-> Getting
     (Vector (CList VertexID))
     (Triangulation p r)
     (Vector (CList VertexID))
-> Vector (CList VertexID)
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector (CList VertexID))
  (Triangulation p r)
  (Vector (CList VertexID))
forall p r. Lens' (Triangulation p r) (Vector (CList VertexID))
neighbours
    f :: VertexID -> f VertexID -> (VertexId s w, f (VertexId s w))
f VertexID
i f VertexID
adj = (VertexID -> VertexId s w
forall k (s :: k) (w :: World). VertexID -> VertexId s w
VertexId VertexID
i, VertexID -> VertexId s w
forall k (s :: k) (w :: World). VertexID -> VertexId s w
VertexId (VertexID -> VertexId s w) -> f VertexID -> f (VertexId s w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f VertexID
adj)
    vtxData :: Vector (VertexData r p)
vtxData = (\(Point 2 r
loc :+ p
p) -> Point 2 r -> p -> VertexData r p
forall r v. Point 2 r -> v -> VertexData r v
VertexData Point 2 r
loc p
p) ((Point 2 r :+ p) -> VertexData r p)
-> Vector (Point 2 r :+ p) -> Vector (VertexData r p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Triangulation p r
trTriangulation p r
-> Getting
     (Vector (Point 2 r :+ p))
     (Triangulation p r)
     (Vector (Point 2 r :+ p))
-> Vector (Point 2 r :+ p)
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector (Point 2 r :+ p))
  (Triangulation p r)
  (Vector (Point 2 r :+ p))
forall p1 r p2.
Lens
  (Triangulation p1 r)
  (Triangulation p2 r)
  (Vector (Point 2 r :+ p1))
  (Vector (Point 2 r :+ p2))
positions