{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances  #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Algorithms.Geometry.WSPD.Types
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Data types that can represent a well separated pair decomposition (wspd).
--
--------------------------------------------------------------------------------
module Algorithms.Geometry.WSPD.Types
  where

import           Control.Lens hiding (Level)
import           Data.BinaryTree
import           Data.Ext
import           Data.Geometry.Box
import           Data.Geometry.Point
import           Data.Geometry.Vector
import qualified Data.LSeq as LSeq
import           Data.Measured.Class
import qualified Data.Sequence as S
import qualified Data.Traversable as Tr

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

type SplitTree d p r a = BinLeafTree (NodeData d r a) (Point d r :+ p)

type PointSet d p r a = SplitTree d p r a

type WSP d p r a = (PointSet d p r a, PointSet d p r a)

-- | Data that we store in the split tree
data NodeData d r a = NodeData { NodeData d r a -> Int
_splitDim :: !Int
                               , NodeData d r a -> Box d () r
_bBox     :: !(Box d () r)
                               , NodeData d r a -> a
_nodeData :: !a
                               }
deriving instance (Arity d, Show r, Show a) => Show (NodeData d r a)
deriving instance (Arity d, Eq r,   Eq a)   => Eq   (NodeData d r a)

makeLenses ''NodeData

instance Semigroup v => Measured v (NodeData d r v) where
  measure :: NodeData d r v -> v
measure = NodeData d r v -> v
forall (d :: Nat) r a. NodeData d r a -> a
_nodeData

instance Functor (NodeData d r) where
  fmap :: (a -> b) -> NodeData d r a -> NodeData d r b
fmap = (a -> b) -> NodeData d r a -> NodeData d r b
forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
Tr.fmapDefault

instance Foldable (NodeData d r) where
  foldMap :: (a -> m) -> NodeData d r a -> m
foldMap = (a -> m) -> NodeData d r a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
Tr.foldMapDefault

instance Traversable (NodeData d r) where
  traverse :: (a -> f b) -> NodeData d r a -> f (NodeData d r b)
traverse a -> f b
f (NodeData Int
d Box d () r
b a
x) = Int -> Box d () r -> b -> NodeData d r b
forall (d :: Nat) r a. Int -> Box d () r -> a -> NodeData d r a
NodeData Int
d Box d () r
b (b -> NodeData d r b) -> f b -> f (NodeData d r b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

--------------------------------------------------------------------------------
-- * Implementation types

-- | Non-empty sequence of points.
type PointSeq d p r = LSeq.LSeq 1 (Point d r :+ p)


data Level = Level { Level -> Int
_unLevel   :: Int
                   , Level -> Maybe Int
_widestDim :: Maybe Int
                   } deriving (Int -> Level -> ShowS
[Level] -> ShowS
Level -> String
(Int -> Level -> ShowS)
-> (Level -> String) -> ([Level] -> ShowS) -> Show Level
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Level] -> ShowS
$cshowList :: [Level] -> ShowS
show :: Level -> String
$cshow :: Level -> String
showsPrec :: Int -> Level -> ShowS
$cshowsPrec :: Int -> Level -> ShowS
Show,Level -> Level -> Bool
(Level -> Level -> Bool) -> (Level -> Level -> Bool) -> Eq Level
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Level -> Level -> Bool
$c/= :: Level -> Level -> Bool
== :: Level -> Level -> Bool
$c== :: Level -> Level -> Bool
Eq,Eq Level
Eq Level
-> (Level -> Level -> Ordering)
-> (Level -> Level -> Bool)
-> (Level -> Level -> Bool)
-> (Level -> Level -> Bool)
-> (Level -> Level -> Bool)
-> (Level -> Level -> Level)
-> (Level -> Level -> Level)
-> Ord Level
Level -> Level -> Bool
Level -> Level -> Ordering
Level -> Level -> Level
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 :: Level -> Level -> Level
$cmin :: Level -> Level -> Level
max :: Level -> Level -> Level
$cmax :: Level -> Level -> Level
>= :: Level -> Level -> Bool
$c>= :: Level -> Level -> Bool
> :: Level -> Level -> Bool
$c> :: Level -> Level -> Bool
<= :: Level -> Level -> Bool
$c<= :: Level -> Level -> Bool
< :: Level -> Level -> Bool
$c< :: Level -> Level -> Bool
compare :: Level -> Level -> Ordering
$ccompare :: Level -> Level -> Ordering
$cp1Ord :: Eq Level
Ord)
makeLenses ''Level

nextLevel             :: Level -> Level
nextLevel :: Level -> Level
nextLevel (Level Int
i Maybe Int
_) = Int -> Maybe Int -> Level
Level (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Maybe Int
forall a. Maybe a
Nothing


type Idx = Int


data ShortSide = L | R deriving (Int -> ShortSide -> ShowS
[ShortSide] -> ShowS
ShortSide -> String
(Int -> ShortSide -> ShowS)
-> (ShortSide -> String)
-> ([ShortSide] -> ShowS)
-> Show ShortSide
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShortSide] -> ShowS
$cshowList :: [ShortSide] -> ShowS
show :: ShortSide -> String
$cshow :: ShortSide -> String
showsPrec :: Int -> ShortSide -> ShowS
$cshowsPrec :: Int -> ShortSide -> ShowS
Show,ShortSide -> ShortSide -> Bool
(ShortSide -> ShortSide -> Bool)
-> (ShortSide -> ShortSide -> Bool) -> Eq ShortSide
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShortSide -> ShortSide -> Bool
$c/= :: ShortSide -> ShortSide -> Bool
== :: ShortSide -> ShortSide -> Bool
$c== :: ShortSide -> ShortSide -> Bool
Eq)

data FindAndCompact d r p = FAC { FindAndCompact d r p -> Seq (Point d r :+ p)
_leftPart  :: !(S.Seq (Point d r :+ p))
                                , FindAndCompact d r p -> Seq (Point d r :+ p)
_rightPart :: !(S.Seq (Point d r :+ p))
                                , FindAndCompact d r p -> ShortSide
_shortSide :: !ShortSide
                                }
deriving instance (Arity d, Show r, Show p) => Show (FindAndCompact d r p)
deriving instance (Arity d, Eq r,   Eq p)   => Eq   (FindAndCompact d r p)

makeLenses ''FindAndCompact