Copyright | (C) Frank Staals |
---|---|
License | see the LICENSE file |
Maintainer | Frank Staals |
Safe Haskell | None |
Language | Haskell2010 |
Synopsis
- data PointLocationDS s v e f r = PointLocationDS (VerticalRayShootingStructure v (Dart s) r) (PlanarSubdivision s v e f r) (FaceId' s)
- verticalRayShootingStructure :: forall k (s :: k) v e f r. Getter (PointLocationDS (s :: k) v e f r) (VerticalRayShootingStructure v (Dart s) r)
- subdivision :: forall k (s :: k) v e f r. Getter (PointLocationDS (s :: k) v e f r) (PlanarSubdivision s v e f r)
- outerFace :: forall k (s :: k) v e f r. Getter (PointLocationDS (s :: k) v e f r) (FaceId' s)
- pointLocationDS :: (Ord r, Fractional r) => PlanarSubdivision s v e f r -> PointLocationDS s v e f r
- dartAbove :: (Ord r, Fractional r) => Point 2 r -> PointLocationDS s v e f r -> Maybe (Dart s)
- dartAboveOrOn :: (Ord r, Fractional r) => Point 2 r -> PointLocationDS s v e f r -> Maybe (Dart s)
- faceContaining :: (Ord r, Fractional r) => Point 2 r -> PointLocationDS s v e f r -> f
- faceIdContaining :: (Ord r, Fractional r) => Point 2 r -> PointLocationDS s v e f r -> FaceId' s
- type InPolygonDS v r = PointLocationDS Dummy (SP Int v) () InOut r
- inPolygonDS :: (Fractional r, Ord r) => SimplePolygon v r -> InPolygonDS v r
- data InOut
- pointInPolygon :: (Ord r, Fractional r) => Point 2 r -> InPolygonDS v r -> InOut
- edgeOnOrAbove :: (Ord r, Fractional r) => Point 2 r -> InPolygonDS v r -> Maybe (LineSegment 2 (SP Int v) r)
Documentation
data PointLocationDS s v e f r Source #
Planar Point Location Data structure
PointLocationDS (VerticalRayShootingStructure v (Dart s) r) (PlanarSubdivision s v e f r) (FaceId' s) |
Instances
(Eq r, Eq v, Eq e, Eq f) => Eq (PointLocationDS s v e f r) Source # | |
Defined in Data.Geometry.PointLocation.PersistentSweep (==) :: PointLocationDS s v e f r -> PointLocationDS s v e f r -> Bool # (/=) :: PointLocationDS s v e f r -> PointLocationDS s v e f r -> Bool # | |
(Show r, Show v, Show e, Show f) => Show (PointLocationDS s v e f r) Source # | |
Defined in Data.Geometry.PointLocation.PersistentSweep showsPrec :: Int -> PointLocationDS s v e f r -> ShowS # show :: PointLocationDS s v e f r -> String # showList :: [PointLocationDS s v e f r] -> ShowS # |
verticalRayShootingStructure :: forall k (s :: k) v e f r. Getter (PointLocationDS (s :: k) v e f r) (VerticalRayShootingStructure v (Dart s) r) Source #
subdivision :: forall k (s :: k) v e f r. Getter (PointLocationDS (s :: k) v e f r) (PlanarSubdivision s v e f r) Source #
outerFace :: forall k (s :: k) v e f r. Getter (PointLocationDS (s :: k) v e f r) (FaceId' s) Source #
Building the Data Structure
pointLocationDS :: (Ord r, Fractional r) => PlanarSubdivision s v e f r -> PointLocationDS s v e f r Source #
Builds a pointlocation data structure on the planar subdivision with \(n\) vertices.
running time: \(O(n\log n)\). space: \(O(n\log n)\).
Querying the Data Structure
dartAbove :: (Ord r, Fractional r) => Point 2 r -> PointLocationDS s v e f r -> Maybe (Dart s) Source #
Locates the first edge (dart) strictly above the query point. returns Nothing if the query point lies in the outer face and there is no dart above it.
running time: \(O(\log n)\)
dartAboveOrOn :: (Ord r, Fractional r) => Point 2 r -> PointLocationDS s v e f r -> Maybe (Dart s) Source #
faceContaining :: (Ord r, Fractional r) => Point 2 r -> PointLocationDS s v e f r -> f Source #
Locates the face containing the query point.
running time: \(O(\log n)\)
faceIdContaining :: (Ord r, Fractional r) => Point 2 r -> PointLocationDS s v e f r -> FaceId' s Source #
Locates the faceId of the face containing the query point.
If the query point lies *on* an edge, an arbitrary face incident to the edge is returned.
running time: \(O(\log n)\)
type InPolygonDS v r = PointLocationDS Dummy (SP Int v) () InOut r Source #
inPolygonDS :: (Fractional r, Ord r) => SimplePolygon v r -> InPolygonDS v r Source #
Data structure for fast InPolygon Queries newtype InPolygonDS v r = InPolygonDS (VRS.VerticalRayShootingStructure (Vertex v r) () r) deriving (Show,Eq)
pointInPolygon :: (Ord r, Fractional r) => Point 2 r -> InPolygonDS v r -> InOut Source #
Returns if a query point lies in (or on the boundary of) the polygon.
\(O(\log n)\)
edgeOnOrAbove :: (Ord r, Fractional r) => Point 2 r -> InPolygonDS v r -> Maybe (LineSegment 2 (SP Int v) r) Source #
Finds the edge on or above the query point, if it exists