hgeometry-0.12.0.0: Geometric Algorithms, Data structures, and Data types.
Copyright(C) Frank Staals
Licensesee the LICENSE file
MaintainerFrank Staals
Safe HaskellNone
LanguageHaskell2010

Data.Geometry.Polygon

Description

A Polygon data type and some basic functions to interact with them.

Synopsis

Types

data PolygonType Source #

We distinguish between simple polygons (without holes) and polygons with holes.

Constructors

Simple 
Multi 

data Polygon (t :: PolygonType) p r where Source #

Polygons are sequences of points and may or may not contain holes.

Degenerate polygons (polygons with self-intersections or fewer than 3 points) are only possible if you use functions marked as unsafe.

Constructors

SimplePolygon :: Vertices (Point 2 r :+ p) -> SimplePolygon p r 
MultiPolygon :: SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon p r 

Instances

Instances details
Bifunctor (Polygon t) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

Methods

bimap :: (a -> b) -> (c -> d) -> Polygon t a c -> Polygon t b d #

first :: (a -> b) -> Polygon t a c -> Polygon t b c #

second :: (b -> c) -> Polygon t a b -> Polygon t a c #

Bitraversable (Polygon t) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

Methods

bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> Polygon t a b -> f (Polygon t c d) #

Bifoldable (Polygon t) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

Methods

bifold :: Monoid m => Polygon t m m -> m #

bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> Polygon t a b -> m #

bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> Polygon t a b -> c #

bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> Polygon t a b -> c #

Functor (Polygon t p) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

Methods

fmap :: (a -> b) -> Polygon t p a -> Polygon t p b #

(<$) :: a -> Polygon t p b -> Polygon t p a #

(Read p, Read r) => Read (MultiPolygon p r) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

(Read p, Read r) => Read (SimplePolygon p r) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

PointFunctor (Polygon t p) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

Methods

pmap :: (Point (Dimension (Polygon t p r)) r -> Point (Dimension (Polygon t p s)) s) -> Polygon t p r -> Polygon t p s Source #

(Fractional r, Ord r) => IsIntersectableWith (Point 2 r) (Polygon t p r) Source # 
Instance details

Defined in Data.Geometry.Polygon

Methods

intersect :: Point 2 r -> Polygon t p r -> Intersection (Point 2 r) (Polygon t p r) #

intersects :: Point 2 r -> Polygon t p r -> Bool #

nonEmptyIntersection :: proxy (Point 2 r) -> proxy (Polygon t p r) -> Intersection (Point 2 r) (Polygon t p r) -> Bool #

(Eq p, Eq r) => Eq (Polygon t p r) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

Methods

(==) :: Polygon t p r -> Polygon t p r -> Bool #

(/=) :: Polygon t p r -> Polygon t p r -> Bool #

(Show p, Show r) => Show (Polygon t p r) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

Methods

showsPrec :: Int -> Polygon t p r -> ShowS #

show :: Polygon t p r -> String #

showList :: [Polygon t p r] -> ShowS #

(ToJSON r, ToJSON p) => ToJSON (Polygon t p r) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

Methods

toJSON :: Polygon t p r -> Value #

toEncoding :: Polygon t p r -> Encoding #

toJSONList :: [Polygon t p r] -> Value #

toEncodingList :: [Polygon t p r] -> Encoding #

(FromJSON r, Eq r, Num r, FromJSON p) => FromJSON (Polygon 'Simple p r) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

(FromJSON r, Eq r, Num r, FromJSON p) => FromJSON (Polygon 'Multi p r) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

(NFData p, NFData r) => NFData (Polygon t p r) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

Methods

rnf :: Polygon t p r -> () #

Fractional r => IsTransformable (Polygon t p r) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

Methods

transformBy :: Transformation (Dimension (Polygon t p r)) (NumType (Polygon t p r)) -> Polygon t p r -> Polygon t p r Source #

IsBoxable (Polygon t p r) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

Methods

boundingBox :: Polygon t p r -> Box (Dimension (Polygon t p r)) () (NumType (Polygon t p r)) Source #

type NumType (SomePolygon p r) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

type NumType (SomePolygon p r) = r
type Dimension (SomePolygon p r) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

type Dimension (SomePolygon p r) = 2
type IntersectionOf (Line 2 r) (Boundary (Polygon t p r)) Source # 
Instance details

Defined in Data.Geometry.Polygon

type IntersectionOf (Line 2 r) (Boundary (Polygon t p r)) = '[Seq (Either (Point 2 r) (LineSegment 2 () r))]
type IntersectionOf (Point 2 r) (Polygon t p r) Source # 
Instance details

Defined in Data.Geometry.Polygon

type IntersectionOf (Point 2 r) (Polygon t p r) = '[NoIntersection, Point 2 r]
type NumType (Polygon t p r) Source # 
Instance details

Defined in Data.Geometry.Polygon.Core

type NumType (Polygon t p r) = r
type Dimension (Polygon t p r) Source #

Polygons are per definition 2 dimensional

Instance details

Defined in Data.Geometry.Polygon.Core

type Dimension (Polygon t p r) = 2

_SimplePolygon :: Prism' (Polygon Simple p r) (Vertices (Point 2 r :+ p)) Source #

Prism to test if we are a simple polygon

>>> is _SimplePolygon simplePoly
True

_MultiPolygon :: Prism' (Polygon Multi p r) (Polygon Simple p r, [Polygon Simple p r]) Source #

Prism to test if we are a Multi polygon

>>> is _MultiPolygon multiPoly
True

type SimplePolygon = Polygon Simple Source #

Polygon without holes.

type MultiPolygon = Polygon Multi Source #

Polygon with zero or more holes.

type SomePolygon p r = Either (Polygon Simple p r) (Polygon Multi p r) Source #

Either a simple or multipolygon

Conversion

fromPoints :: forall p r. (Eq r, Num r) => [Point 2 r :+ p] -> SimplePolygon p r Source #

\( O(n) \) Creates a polygon from the given list of vertices.

The points are placed in CCW order if they are not already. Overlapping edges and repeated vertices are allowed.

fromCircularVector :: forall p r. (Eq r, Num r) => CircularVector (Point 2 r :+ p) -> SimplePolygon p r Source #

\( O(n) \) Creates a polygon from the given vector of vertices.

The points are placed in CCW order if they are not already. Overlapping edges and repeated vertices are allowed.

simpleFromPoints :: forall p r. (Ord r, Fractional r) => [Point 2 r :+ p] -> SimplePolygon p r Source #

\( O(n \log n) \) Creates a simple polygon from the given list of vertices.

The points are placed in CCW order if they are not already. Overlapping edges and repeated vertices are not allowed and will trigger an exception.

simpleFromCircularVector :: forall p r. (Ord r, Fractional r) => CircularVector (Point 2 r :+ p) -> SimplePolygon p r Source #

\( O(n \log n) \) Creates a simple polygon from the given vector of vertices.

The points are placed in CCW order if they are not already. Overlapping edges and repeated vertices are not allowed and will trigger an exception.

unsafeFromPoints :: [Point 2 r :+ p] -> SimplePolygon p r Source #

\( O(n) \) Creates a simple polygon from the given list of vertices.

pre: the input list constains no repeated vertices.

unsafeFromCircularVector :: CircularVector (Point 2 r :+ p) -> SimplePolygon p r Source #

\( O(1) \) Creates a simple polygon from the given vector of vertices.

pre: the input list constains no repeated vertices.

unsafeFromVector :: Vector (Point 2 r :+ p) -> SimplePolygon p r Source #

\( O(1) \) Creates a simple polygon from the given vector of vertices.

pre: the input list constains no repeated vertices.

toVector :: Polygon t p r -> Vector (Point 2 r :+ p) Source #

\( O(n) \) Polygon points, from left to right.

toPoints :: Polygon t p r -> [Point 2 r :+ p] Source #

\( O(n) \) Polygon points, from left to right.

isSimple :: (Ord r, Fractional r) => Polygon p t r -> Bool Source #

\( O(n \log n) \) Check if a polygon has any holes, duplicate points, or self-intersections.

Accessors

size :: Polygon t p r -> Int Source #

\( O(1) \) Vertex count. Includes the vertices of holes.

polygonVertices :: Polygon t p r -> NonEmpty (Point 2 r :+ p) Source #

\( O(n) \) The vertices in the polygon. No guarantees are given on the order in which they appear!

listEdges :: Polygon t p r -> [LineSegment 2 p r] Source #

\( O(n) \) Lists all edges. The edges on the outer boundary are given before the ones on the holes. However, no other guarantees are given on the order.

outerBoundary :: forall t p r. Lens' (Polygon t p r) (SimplePolygon p r) Source #

\( O(1) \) Lens access to the outer boundary of a polygon.

outerBoundaryVector :: forall t p r. Getter (Polygon t p r) (CircularVector (Point 2 r :+ p)) Source #

Getter access to the outer boundary vector of a polygon.

>>> toList (simpleTriangle ^. outerBoundaryVector)
[Point2 0 0 :+ (),Point2 2 0 :+ (),Point2 1 1 :+ ()]

unsafeOuterBoundaryVector :: forall t p r. Lens' (Polygon t p r) (CircularVector (Point 2 r :+ p)) Source #

Unsafe lens access to the outer boundary vector of a polygon.

>>> toList (simpleTriangle ^. unsafeOuterBoundaryVector)
[Point2 0 0 :+ (),Point2 2 0 :+ (),Point2 1 1 :+ ()]
>>> simpleTriangle & unsafeOuterBoundaryVector .~ CV.singleton (Point2 0 0 :+ ())
SimplePolygon [Point2 0 0 :+ ()]

outerBoundaryEdges :: Polygon t p r -> CircularVector (LineSegment 2 p r) Source #

\( O(n) \) The edges along the outer boundary of the polygon. The edges are half open.

outerVertex :: Int -> Getter (Polygon t p r) (Point 2 r :+ p) Source #

O(1) Access the i^th vertex on the outer boundary. Indices are modulo \(n\).

>>> simplePoly ^. outerVertex 0
Point2 0 0 :+ ()

outerBoundaryEdge :: Int -> Polygon t p r -> LineSegment 2 p r Source #

\( O(1) \) Get the n^th edge along the outer boundary of the polygon. The edge is half open.

polygonHoles :: forall p r. Lens' (Polygon Multi p r) [Polygon Simple p r] Source #

Lens access for polygon holes.

>>> multiPoly ^. polygonHoles
[SimplePolygon [Point2 0 0 :+ (),Point2 2 0 :+ (),Point2 1 1 :+ ()]]

polygonHoles' :: Traversal' (Polygon t p r) [Polygon Simple p r] Source #

\( O(1) \). Traversal lens for polygon holes. Does nothing for simple polygons.

holeList :: Polygon t p r -> [Polygon Simple p r] Source #

Get all holes in a polygon

Properties

area :: Fractional r => Polygon t p r -> r Source #

Compute the area of a polygon

signedArea :: Fractional r => SimplePolygon p r -> r Source #

Compute the signed area of a simple polygon. The the vertices are in clockwise order, the signed area will be negative, if the verices are given in counter clockwise order, the area will be positive.

centroid :: Fractional r => SimplePolygon p r -> Point 2 r Source #

Compute the centroid of a simple polygon.

Queries

inPolygon :: forall t p r. (Fractional r, Ord r) => Point 2 r -> Polygon t p r -> PointLocationResult Source #

Check if a point lies inside a polygon, on the boundary, or outside of the polygon. Running time: O(n).

>>> Point2 1 1 `inPolygon` simplePoly
Inside
>>> Point2 0 0 `inPolygon` simplePoly
OnBoundary
>>> Point2 10 0 `inPolygon` simplePoly
OnBoundary
>>> Point2 5 13 `inPolygon` simplePoly
Inside
>>> Point2 5 10 `inPolygon` simplePoly
Inside
>>> Point2 10 5 `inPolygon` simplePoly
OnBoundary
>>> Point2 20 5 `inPolygon` simplePoly
Outside

TODO: Add some testcases with multiPolygons TODO: Add some more onBoundary testcases

insidePolygon :: (Fractional r, Ord r) => Point 2 r -> Polygon t p r -> Bool Source #

Test if a point lies strictly inside the polgyon.

onBoundary :: (Num r, Ord r) => Point 2 r -> Polygon t p r -> Bool Source #

\( O(n) \) Test if q lies on the boundary of the polygon.

>>> Point2 1 1 `onBoundary` simplePoly
False
>>> Point2 0 0 `onBoundary` simplePoly
True
>>> Point2 10 0 `onBoundary` simplePoly
True
>>> Point2 5 13 `onBoundary` simplePoly
False
>>> Point2 5 10 `onBoundary` simplePoly
False
>>> Point2 10 5 `onBoundary` simplePoly
True
>>> Point2 20 5 `onBoundary` simplePoly
False

TODO: testcases multipolygon

isTriangle :: Polygon p t r -> Bool Source #

\( O(1) \) Test if the polygon is a triangle

isStarShaped :: (MonadRandom m, Ord r, Fractional r) => SimplePolygon p r -> m (Maybe (Point 2 r)) Source #

Test if a Simple polygon is star-shaped. Returns a point in the kernel (i.e. from which the entire polygon is visible), if it exists.

\(O(n)\) expected time

isCounterClockwise :: (Eq r, Num r) => Polygon t p r -> Bool Source #

\( O(n) \) Test if the outer boundary of the polygon is in clockwise or counter clockwise order.

toCounterClockWiseOrder :: (Eq r, Num r) => Polygon t p r -> Polygon t p r Source #

\( O(n) \) Make sure that every edge has the polygon's interior on its left, by orienting the outer boundary into counter-clockwise order, and the inner borders (i.e. any holes, if they exist) into clockwise order.

toCounterClockWiseOrder' :: (Eq r, Num r) => Polygon t p r -> Polygon t p r Source #

\( O(n) \) Orient the outer boundary into counter-clockwise order. Leaves any holes as they are.

toClockwiseOrder :: (Eq r, Num r) => Polygon t p r -> Polygon t p r Source #

\( O(n) \) Make sure that every edge has the polygon's interior on its right, by orienting the outer boundary into clockwise order, and the inner borders (i.e. any holes, if they exist) into counter-clockwise order.

toClockwiseOrder' :: (Eq r, Num r) => Polygon t p r -> Polygon t p r Source #

\( O(n) \) Orient the outer boundary into clockwise order. Leaves any holes as they are.

reverseOuterBoundary :: Polygon t p r -> Polygon t p r Source #

Reorient the outer boundary from clockwise order to counter-clockwise order or from counter-clockwise order to clockwise order. Leaves any holes as they are.

rotateLeft :: Int -> SimplePolygon p r -> SimplePolygon p r Source #

\( O(1) \) Rotate the polygon to the left by n number of points.

rotateRight :: Int -> SimplePolygon p r -> SimplePolygon p r Source #

\( O(1) \) Rotate the polygon to the right by n number of points.

maximumVertexBy :: ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering) -> Polygon t p r -> Point 2 r :+ p Source #

\( O(n) \) Yield the maximum point of a polygon according to the given comparison function.

minimumVertexBy :: ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering) -> Polygon t p r -> Point 2 r :+ p Source #

\( O(n) \) Yield the maximum point of a polygon according to the given comparison function.

Misc

pickPoint :: (Ord r, Fractional r) => Polygon p t r -> Point 2 r Source #

\( O(n) \) Pick a point that is inside the polygon.

(note: if the polygon is degenerate; i.e. has <3 vertices, we report a vertex of the polygon instead.)

pre: the polygon is given in CCW order

findDiagonal :: (Ord r, Fractional r) => Polygon t p r -> LineSegment 2 p r Source #

\( O(n) \) Find a diagonal of the polygon.

pre: the polygon is given in CCW order

withIncidentEdges :: Polygon t p r -> Polygon t (Two (LineSegment 2 p r)) r Source #

Pairs every vertex with its incident edges. The first one is its predecessor edge, the second one its successor edge (in terms of the ordering along the boundary).

>>> mapM_ print . polygonVertices $ withIncidentEdges simplePoly
Point2 0 0 :+ V2 (ClosedLineSegment (Point2 1 11 :+ ()) (Point2 0 0 :+ ())) (ClosedLineSegment (Point2 0 0 :+ ()) (Point2 10 0 :+ ()))
Point2 10 0 :+ V2 (ClosedLineSegment (Point2 0 0 :+ ()) (Point2 10 0 :+ ())) (ClosedLineSegment (Point2 10 0 :+ ()) (Point2 10 10 :+ ()))
Point2 10 10 :+ V2 (ClosedLineSegment (Point2 10 0 :+ ()) (Point2 10 10 :+ ())) (ClosedLineSegment (Point2 10 10 :+ ()) (Point2 5 15 :+ ()))
Point2 5 15 :+ V2 (ClosedLineSegment (Point2 10 10 :+ ()) (Point2 5 15 :+ ())) (ClosedLineSegment (Point2 5 15 :+ ()) (Point2 1 11 :+ ()))
Point2 1 11 :+ V2 (ClosedLineSegment (Point2 5 15 :+ ()) (Point2 1 11 :+ ())) (ClosedLineSegment (Point2 1 11 :+ ()) (Point2 0 0 :+ ()))

numberVertices :: Polygon t p r -> Polygon t (SP Int p) r Source #

assigns unique integer numbers to all vertices. Numbers start from 0, and are increasing along the outer boundary. The vertices of holes will be numbered last, in the same order.

>>> numberVertices simplePoly
SimplePolygon [Point2 0 0 :+ SP 0 (),Point2 10 0 :+ SP 1 (),Point2 10 10 :+ SP 2 (),Point2 5 15 :+ SP 3 (),Point2 1 11 :+ SP 4 ()]

extremesLinear :: (Ord r, Num r) => Vector 2 r -> Polygon t p r -> (Point 2 r :+ p, Point 2 r :+ p) Source #

Finds the extreme points, minimum and maximum, in a given direction

running time: \(O(n)\)

cmpExtreme :: (Num r, Ord r) => Vector 2 r -> (Point 2 r :+ p) -> (Point 2 r :+ q) -> Ordering Source #

Comparison that compares which point is larger in the direction given by the vector u.

findRotateTo :: ((Point 2 r :+ p) -> Bool) -> SimplePolygon p r -> Maybe (SimplePolygon p r) Source #

Rotate to the first point that matches the given condition.

>>> toVector <$> findRotateTo (== (Point2 1 0 :+ ())) (unsafeFromPoints [Point2 0 0 :+ (), Point2 1 0 :+ (), Point2 1 1 :+ ()])
Just [Point2 1 0 :+ (),Point2 1 1 :+ (),Point2 0 0 :+ ()]
>>> findRotateTo (== (Point2 7 0 :+ ())) $ unsafeFromPoints [Point2 0 0 :+ (), Point2 1 0 :+ (), Point2 1 1 :+ ()]
Nothing

Orphan instances

(Fractional r, Ord r) => IsIntersectableWith (Point 2 r) (Polygon t p r) Source # 
Instance details

Methods

intersect :: Point 2 r -> Polygon t p r -> Intersection (Point 2 r) (Polygon t p r) #

intersects :: Point 2 r -> Polygon t p r -> Bool #

nonEmptyIntersection :: proxy (Point 2 r) -> proxy (Polygon t p r) -> Intersection (Point 2 r) (Polygon t p r) -> Bool #