module Geometry.Qhull.Shared
  (
    sameFamily
  , verticesIds
  , verticesCoordinates
  , nVertices
  , edgesIds
  , edgesIds'
  , edgesCoordinates
  , nEdges
  , isEdge
  , toPoints
  , toPoints'
  )
  where
import qualified Data.HashMap.Strict.InsOrd as H
import qualified Data.IntMap.Strict         as IM
import           Data.Maybe                 ( fromJust )
import           Geometry.Qhull.Types       ( HasEdges(..),
                                              HasVertices(..),
                                              Family(Family),
                                              IndexPair(..),
                                              Index )

-- | whether two families are the same

sameFamily :: Family -> Family -> Bool
sameFamily :: Family -> Family -> Bool
sameFamily (Family Int
i) (Family Int
j) = Int
i forall a. Eq a => a -> a -> Bool
== Int
j
sameFamily Family
_ Family
_ = Bool
False

-- | vertices ids

verticesIds :: HasVertices a => a -> [Index]
verticesIds :: forall a. HasVertices a => a -> [Int]
verticesIds = forall a. IntMap a -> [Int]
IM.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. HasVertices m => m -> IndexMap [Double]
_vertices

-- | vertices coordinates

verticesCoordinates :: HasVertices a => a -> [[Double]]
verticesCoordinates :: forall a. HasVertices a => a -> [[Double]]
verticesCoordinates = forall a. IntMap a -> [a]
IM.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. HasVertices m => m -> IndexMap [Double]
_vertices

-- | number of vertices

nVertices :: HasVertices a => a -> Int
nVertices :: forall a. HasVertices a => a -> Int
nVertices = forall a. IntMap a -> Int
IM.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. HasVertices m => m -> IndexMap [Double]
_vertices

-- | edges ids

edgesIds :: HasEdges a => a -> [IndexPair]
edgesIds :: forall a. HasEdges a => a -> [IndexPair]
edgesIds = forall k v. InsOrdHashMap k v -> [k]
H.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. HasEdges m => m -> EdgeMap
_edges

-- | edges ids as pairs of integers

edgesIds' :: HasEdges a => a -> [(Index,Index)]
edgesIds' :: forall a. HasEdges a => a -> [(Int, Int)]
edgesIds' a
x = forall a b. (a -> b) -> [a] -> [b]
map IndexPair -> (Int, Int)
fromPair (forall a. HasEdges a => a -> [IndexPair]
edgesIds a
x)
  where
    fromPair :: IndexPair -> (Int, Int)
fromPair (Pair Int
i Int
j) = (Int
i,Int
j)

-- | edges coordinates

edgesCoordinates :: HasEdges a => a -> [([Double],[Double])]
edgesCoordinates :: forall a. HasEdges a => a -> [([Double], [Double])]
edgesCoordinates = forall k v. InsOrdHashMap k v -> [v]
H.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. HasEdges m => m -> EdgeMap
_edges

-- | number of edges

nEdges :: HasEdges a => a -> Int
nEdges :: forall a. HasEdges a => a -> Int
nEdges = forall k v. InsOrdHashMap k v -> Int
H.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. HasEdges m => m -> EdgeMap
_edges

-- | whether a pair of vertices indices form an edge;

-- the order of the indices has no importance

isEdge :: HasEdges a => a -> (Index, Index) -> Bool
isEdge :: forall a. HasEdges a => a -> (Int, Int) -> Bool
isEdge a
x (Int
i,Int
j) = Int -> Int -> IndexPair
Pair Int
i Int
j forall k a. (Eq k, Hashable k) => k -> InsOrdHashMap k a -> Bool
`H.member` forall m. HasEdges m => m -> EdgeMap
_edges a
x

-- | edge as pair of points; the order of the vertices has no importance

toPoints :: HasEdges a => a -> (Index, Index) -> Maybe ([Double], [Double])
toPoints :: forall a.
HasEdges a =>
a -> (Int, Int) -> Maybe ([Double], [Double])
toPoints a
x (Int
i,Int
j) = forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
H.lookup (Int -> Int -> IndexPair
Pair Int
i Int
j) (forall m. HasEdges m => m -> EdgeMap
_edges a
x)

-- | edge as pair of points, without checking the edge exists

toPoints' :: HasEdges a => a -> (Index, Index) -> ([Double], [Double])
toPoints' :: forall a. HasEdges a => a -> (Int, Int) -> ([Double], [Double])
toPoints' a
x (Int
i,Int
j) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a.
HasEdges a =>
a -> (Int, Int) -> Maybe ([Double], [Double])
toPoints a
x (Int
i,Int
j)