packages feed

hgeometry 0.11.0.0 → 0.12.0.0

raw patch · 153 files changed

+8262/−6694 lines, 153 filesdep +deepseq-genericsdep +directorydep +filepathdep ~MonadRandomdep ~QuickCheckdep ~basenew-component:exe:planargraphPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq-generics, directory, filepath, hgeometry, nonempty-vector, optparse-applicative, reanimate, reanimate-svg, tasty-bench, vector-algorithms, vector-circular

Dependency ranges changed: MonadRandom, QuickCheck, base, bytestring, containers, deepseq, dlist, fixed-vector, hashable, hgeometry-combinatorial, lens, linear, mtl, quickcheck-instances, semigroupoids, semigroups, text, vector, vinyl

API changes (from Hackage documentation)

- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: delaunayTriangulation' :: (Ord r, Fractional r) => BinLeafTree Size (Point 2 r :+ p) -> Mapping p r -> (Adj, ConvexPolygon (p :+ VertexID) r)
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: delete :: VertexID -> VertexID -> Adj -> Adj
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: firsts :: ConvexPolygon (p :+ VertexID) r -> IntMap VertexID
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: focus' :: CList a -> a
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: fromHull :: Ord r => Mapping p r -> ConvexPolygon (p :+ q) r -> Adj
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: insert :: (Num r, Ord r) => VertexID -> VertexID -> Merge p r ()
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: insert' :: (Num r, Ord r) => VertexID -> VertexID -> Mapping p r -> Adj -> Adj
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: isLeftOf :: (Ord r, Num r) => VertexID -> (VertexID, VertexID) -> Merge p r Bool
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: isRightOf :: (Ord r, Num r) => VertexID -> (VertexID, VertexID) -> Merge p r Bool
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: lookup' :: Ord k => Map k a -> k -> a
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: lookup'' :: Int -> IntMap a -> a
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: merge :: (Ord r, Fractional r) => Adj -> Adj -> LineSegment 2 (p :+ VertexID) r -> LineSegment 2 (p :+ VertexID) r -> Mapping p r -> Firsts -> Adj
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: moveUp :: (Ord r, Fractional r) => (VertexID, VertexID) -> VertexID -> VertexID -> Merge p r ()
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: nub' :: Eq a => NonEmpty (a :+ b) -> NonEmpty (a :+ b)
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: pred' :: CList a -> CList a
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: qTest :: (Ord r, Fractional r) => VertexID -> VertexID -> Vertex -> Vertex -> Merge p r Bool
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: rotateL :: (Ord r, Fractional r) => VertexID -> VertexID -> Vertex -> Merge p r (Vertex, Bool)
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: rotateL' :: (Ord r, Fractional r) => VertexID -> VertexID -> Vertex -> Vertex -> Merge p r Vertex
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: rotateR :: (Ord r, Fractional r) => VertexID -> VertexID -> Vertex -> Merge p r (Vertex, Bool)
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: rotateR' :: (Ord r, Fractional r) => VertexID -> VertexID -> Vertex -> Vertex -> Merge p r Vertex
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: rotateTo :: Eq a => a -> CList a -> CList a
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: rotateToFirst :: VertexID -> Firsts -> Merge p r ()
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: size' :: BinLeafTree Size a -> Size
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: succ' :: CList a -> CList a
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: type Firsts = IntMap VertexID
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: type Merge p r = StateT Adj (Reader (Mapping p r, Firsts))
- Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer: withID :: (c :+ e) -> e' -> c :+ (e :+ e')
- Algorithms.Geometry.DelaunayTriangulation.Naive: sortAround' :: (Num r, Ord r) => Mapping p r -> VertexID -> [VertexID] -> [VertexID]
- Algorithms.Geometry.DelaunayTriangulation.Types: ST :: !a -> !b -> !c -> ST a b c
- Algorithms.Geometry.DelaunayTriangulation.Types: [fst'] :: ST a b c -> !a
- Algorithms.Geometry.DelaunayTriangulation.Types: [snd'] :: ST a b c -> !b
- Algorithms.Geometry.DelaunayTriangulation.Types: [trd'] :: ST a b c -> !c
- Algorithms.Geometry.DelaunayTriangulation.Types: data ST a b c
- Algorithms.Geometry.DelaunayTriangulation.Types: showDT :: (Show p, Show r) => Triangulation p r -> IO ()
- Algorithms.Geometry.DelaunayTriangulation.Types: tEdges :: Triangulation p r -> [(VertexID, VertexID)]
- Algorithms.Geometry.DelaunayTriangulation.Types: triangulationEdges :: Triangulation p r -> [(Point 2 r :+ p, Point 2 r :+ p)]
- Algorithms.Geometry.DelaunayTriangulation.Types: type ArcID = Int
- Algorithms.Geometry.DelaunayTriangulation.Types: type ST' a = ST (Map (VertexID, VertexID) ArcID) ArcID a
- Algorithms.Geometry.EuclideanMST.EuclideanMST: data MSTW
- Algorithms.Geometry.EuclideanMST.EuclideanMST: euclideanMST :: (Ord r, Fractional r) => NonEmpty (Point 2 r :+ p) -> Tree (Point 2 r :+ p)
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: End :: !s -> EventType s
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: Event :: !Point 2 r -> !EventType (LineSegment 2 p r) -> Event p r
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: Intersection :: EventType s
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: Start :: !NonEmpty s -> EventType s
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: [eventPoint] :: Event p r -> !Point 2 r
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: [eventType] :: Event p r -> !EventType (LineSegment 2 p r)
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: asEventPts :: Ord r => LineSegment 2 p r -> [Event p r]
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: data Event p r
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: data EventType s
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: endsAt :: Ord r => Point 2 r -> LineSegment 2 p r -> Bool
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: extractContains :: (Fractional r, Ord r) => Point 2 r -> StatusStructure p r -> (StatusStructure p r, [LineSegment 2 p r], StatusStructure p r)
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: findNewEvent :: (Ord r, Fractional r) => Point 2 r -> LineSegment 2 p r -> LineSegment 2 p r -> Maybe (Event p r)
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: groupStarts :: Eq r => [Event p r] -> [Event p r]
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: handle :: forall r p. (Ord r, Fractional r) => Event p r -> EventQueue p r -> StatusStructure p r -> [IntersectionPoint p r]
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: isClosedStart :: Eq r => Point 2 r -> LineSegment 2 p r -> Bool
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: merge :: Ord r => [IntersectionPoint p r] -> Intersections p r
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: ordPoints :: Ord r => Point 2 r -> Point 2 r -> Ordering
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: rightEndpoint :: Ord r => LineSegment 2 p r -> r
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: startSegs :: Event p r -> [LineSegment 2 p r]
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: sweep :: (Ord r, Fractional r) => EventQueue p r -> StatusStructure p r -> [IntersectionPoint p r]
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: toStatusStruct :: (Fractional r, Ord r) => Point 2 r -> [LineSegment 2 p r] -> StatusStructure p r
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: type EventQueue p r = Set (Event p r)
- Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann: type StatusStructure p r = Set (LineSegment 2 p r)
- Algorithms.Geometry.LineSegmentIntersection.Naive: addTo :: Ord r => Point 2 r -> LineSegment 2 p r -> Intersections p r -> Intersections p r
- Algorithms.Geometry.LineSegmentIntersection.Naive: collect :: (Ord r, Fractional r) => (LineSegment 2 p r, LineSegment 2 p r) -> Intersections p r -> Intersections p r
- Algorithms.Geometry.LineSegmentIntersection.Naive: handlePoint :: Ord r => LineSegment 2 p r -> LineSegment 2 p r -> Point 2 r -> Intersections p r -> Intersections p r
- Algorithms.Geometry.LineSegmentIntersection.Naive: isEndPointOf :: Eq r => Point 2 r -> LineSegment 2 p r -> Bool
- Algorithms.Geometry.LineSegmentIntersection.Naive: pairs :: [a] -> [(a, a)]
- Algorithms.Geometry.LineSegmentIntersection.Types: Associated :: Set' (LineSegment 2 p r) -> Set' (LineSegment 2 p r) -> Associated p r
- Algorithms.Geometry.LineSegmentIntersection.Types: IntersectionPoint :: !Point 2 r -> !Associated p r -> IntersectionPoint p r
- Algorithms.Geometry.LineSegmentIntersection.Types: [_associatedSegs] :: IntersectionPoint p r -> !Associated p r
- Algorithms.Geometry.LineSegmentIntersection.Types: [_endPointOf] :: Associated p r -> Set' (LineSegment 2 p r)
- Algorithms.Geometry.LineSegmentIntersection.Types: [_interiorTo] :: Associated p r -> Set' (LineSegment 2 p r)
- Algorithms.Geometry.LineSegmentIntersection.Types: [_intersectionPoint] :: IntersectionPoint p r -> !Point 2 r
- Algorithms.Geometry.LineSegmentIntersection.Types: associated :: Ord r => [LineSegment 2 p r] -> [LineSegment 2 p r] -> Associated p r
- Algorithms.Geometry.LineSegmentIntersection.Types: associatedSegs :: forall p_a1HAK r_a1HAL p_a1HUq. Lens (IntersectionPoint p_a1HAK r_a1HAL) (IntersectionPoint p_a1HUq r_a1HAL) (Associated p_a1HAK r_a1HAL) (Associated p_a1HUq r_a1HAL)
- Algorithms.Geometry.LineSegmentIntersection.Types: data Associated p r
- Algorithms.Geometry.LineSegmentIntersection.Types: data IntersectionPoint p r
- Algorithms.Geometry.LineSegmentIntersection.Types: endPointOf :: Associated p r -> [LineSegment 2 p r]
- Algorithms.Geometry.LineSegmentIntersection.Types: endPoints' :: (HasEnd s, HasStart s) => s -> (StartCore s, EndCore s)
- Algorithms.Geometry.LineSegmentIntersection.Types: instance (Control.DeepSeq.NFData p, Control.DeepSeq.NFData r) => Control.DeepSeq.NFData (Algorithms.Geometry.LineSegmentIntersection.Types.Associated p r)
- Algorithms.Geometry.LineSegmentIntersection.Types: instance (GHC.Classes.Eq p, GHC.Classes.Eq r) => GHC.Classes.Eq (Algorithms.Geometry.LineSegmentIntersection.Types.Associated p r)
- Algorithms.Geometry.LineSegmentIntersection.Types: instance (GHC.Classes.Eq r, GHC.Classes.Eq p) => GHC.Classes.Eq (Algorithms.Geometry.LineSegmentIntersection.Types.IntersectionPoint p r)
- Algorithms.Geometry.LineSegmentIntersection.Types: instance (GHC.Show.Show r, GHC.Show.Show p) => GHC.Show.Show (Algorithms.Geometry.LineSegmentIntersection.Types.Associated p r)
- Algorithms.Geometry.LineSegmentIntersection.Types: instance (GHC.Show.Show r, GHC.Show.Show p) => GHC.Show.Show (Algorithms.Geometry.LineSegmentIntersection.Types.IntersectionPoint p r)
- Algorithms.Geometry.LineSegmentIntersection.Types: instance GHC.Classes.Ord r => GHC.Base.Monoid (Algorithms.Geometry.LineSegmentIntersection.Types.Associated p r)
- Algorithms.Geometry.LineSegmentIntersection.Types: instance GHC.Classes.Ord r => GHC.Base.Semigroup (Algorithms.Geometry.LineSegmentIntersection.Types.Associated p r)
- Algorithms.Geometry.LineSegmentIntersection.Types: instance GHC.Generics.Generic (Algorithms.Geometry.LineSegmentIntersection.Types.Associated p r)
- Algorithms.Geometry.LineSegmentIntersection.Types: interiorTo :: Associated p r -> [LineSegment 2 p r]
- Algorithms.Geometry.LineSegmentIntersection.Types: intersectionPoint :: forall p_a1HAK r_a1HAL. Lens' (IntersectionPoint p_a1HAK r_a1HAL) (Point 2 r_a1HAL)
- Algorithms.Geometry.LineSegmentIntersection.Types: isEndPointIntersection :: Associated p r -> Bool
- Algorithms.Geometry.LineSegmentIntersection.Types: type Compare a = a -> a -> Ordering
- Algorithms.Geometry.LineSegmentIntersection.Types: type Intersections p r = Map (Point 2 r) (Associated p r)
- Algorithms.Geometry.LineSegmentIntersection.Types: type Set' l = Map (Point (Dimension l) (NumType l), Point (Dimension l) (NumType l)) (NonEmpty l)
- Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone: L :: LR
- Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone: R :: LR
- Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone: chainOf :: P p r -> LR
- Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone: data LR
- Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone: isInside :: (Ord r, Num r) => P p r -> (P p r, P p r) -> Bool
- Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone: mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
- Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone: process :: (Ord r, Num r) => P p r -> Stack (P p r) -> SP (Stack (P p r)) [LineSegment 2 p r]
- Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone: seg :: P p r -> P p r -> LineSegment 2 p r
- Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone: splitPolygon :: Ord r => MonotonePolygon p r -> ([Point 2 r :+ (LR :+ p)], [Point 2 r :+ (LR :+ p)])
- Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone: testPoly5 :: SimplePolygon () Rational
- Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone: toVtx :: P p r -> Point 2 r :+ p
- Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone: type P p r = Point 2 r :+ (LR :+ p)
- Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone: type Stack a = [a]
- Algorithms.Geometry.SmallestEnclosingBall.Types: DiskResult :: Disk () r -> TwoOrThree (Point 2 r :+ p) -> DiskResult p r
- Algorithms.Geometry.SmallestEnclosingBall.Types: Three :: !a -> !a -> !a -> TwoOrThree a
- Algorithms.Geometry.SmallestEnclosingBall.Types: Two :: !a -> !a -> TwoOrThree a
- Algorithms.Geometry.SmallestEnclosingBall.Types: [_definingPoints] :: DiskResult p r -> TwoOrThree (Point 2 r :+ p)
- Algorithms.Geometry.SmallestEnclosingBall.Types: [_enclosingDisk] :: DiskResult p r -> Disk () r
- Algorithms.Geometry.SmallestEnclosingBall.Types: data DiskResult p r
- Algorithms.Geometry.SmallestEnclosingBall.Types: data TwoOrThree a
- Algorithms.Geometry.SmallestEnclosingBall.Types: definingPoints :: forall p_a2SvR r_a2SvS p_a2SOG. Lens (DiskResult p_a2SvR r_a2SvS) (DiskResult p_a2SOG r_a2SvS) (TwoOrThree ((:+) (Point 2 r_a2SvS) p_a2SvR)) (TwoOrThree ((:+) (Point 2 r_a2SvS) p_a2SOG))
- Algorithms.Geometry.SmallestEnclosingBall.Types: enclosingDisk :: forall p_a2SvR r_a2SvS. Lens' (DiskResult p_a2SvR r_a2SvS) (Disk () r_a2SvS)
- Algorithms.Geometry.SmallestEnclosingBall.Types: fromList :: [a] -> Either String (TwoOrThree a)
- Algorithms.Geometry.SmallestEnclosingBall.Types: instance (GHC.Classes.Eq r, GHC.Classes.Eq p) => GHC.Classes.Eq (Algorithms.Geometry.SmallestEnclosingBall.Types.DiskResult p r)
- Algorithms.Geometry.SmallestEnclosingBall.Types: instance (GHC.Show.Show r, GHC.Show.Show p) => GHC.Show.Show (Algorithms.Geometry.SmallestEnclosingBall.Types.DiskResult p r)
- Algorithms.Geometry.SmallestEnclosingBall.Types: instance Data.Foldable.Foldable Algorithms.Geometry.SmallestEnclosingBall.Types.TwoOrThree
- Algorithms.Geometry.SmallestEnclosingBall.Types: instance GHC.Base.Functor Algorithms.Geometry.SmallestEnclosingBall.Types.TwoOrThree
- Algorithms.Geometry.SmallestEnclosingBall.Types: instance GHC.Classes.Eq a => GHC.Classes.Eq (Algorithms.Geometry.SmallestEnclosingBall.Types.TwoOrThree a)
- Algorithms.Geometry.SmallestEnclosingBall.Types: instance GHC.Classes.Ord a => GHC.Classes.Ord (Algorithms.Geometry.SmallestEnclosingBall.Types.TwoOrThree a)
- Algorithms.Geometry.SmallestEnclosingBall.Types: instance GHC.Read.Read a => GHC.Read.Read (Algorithms.Geometry.SmallestEnclosingBall.Types.TwoOrThree a)
- Algorithms.Geometry.SmallestEnclosingBall.Types: instance GHC.Show.Show a => GHC.Show.Show (Algorithms.Geometry.SmallestEnclosingBall.Types.TwoOrThree a)
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: instance (Data.Geometry.Vector.VectorFamily.Arity d, GHC.Classes.Eq r, GHC.Classes.Eq a) => GHC.Classes.Eq (Algorithms.Geometry.WellSeparatedPairDecomposition.Types.NodeData d r a)
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: instance (Data.Geometry.Vector.VectorFamily.Arity d, GHC.Classes.Eq r, GHC.Classes.Eq p) => GHC.Classes.Eq (Algorithms.Geometry.WellSeparatedPairDecomposition.Types.FindAndCompact d r p)
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: instance (Data.Geometry.Vector.VectorFamily.Arity d, GHC.Show.Show r, GHC.Show.Show a) => GHC.Show.Show (Algorithms.Geometry.WellSeparatedPairDecomposition.Types.NodeData d r a)
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: instance (Data.Geometry.Vector.VectorFamily.Arity d, GHC.Show.Show r, GHC.Show.Show p) => GHC.Show.Show (Algorithms.Geometry.WellSeparatedPairDecomposition.Types.FindAndCompact d r p)
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: instance Data.Foldable.Foldable (Algorithms.Geometry.WellSeparatedPairDecomposition.Types.NodeData d r)
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: instance Data.Traversable.Traversable (Algorithms.Geometry.WellSeparatedPairDecomposition.Types.NodeData d r)
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: instance GHC.Base.Functor (Algorithms.Geometry.WellSeparatedPairDecomposition.Types.NodeData d r)
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: instance GHC.Base.Semigroup v => Data.Measured.Class.Measured v (Algorithms.Geometry.WellSeparatedPairDecomposition.Types.NodeData d r v)
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: instance GHC.Classes.Eq Algorithms.Geometry.WellSeparatedPairDecomposition.Types.Level
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: instance GHC.Classes.Eq Algorithms.Geometry.WellSeparatedPairDecomposition.Types.ShortSide
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: instance GHC.Classes.Ord Algorithms.Geometry.WellSeparatedPairDecomposition.Types.Level
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: instance GHC.Show.Show Algorithms.Geometry.WellSeparatedPairDecomposition.Types.Level
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: instance GHC.Show.Show Algorithms.Geometry.WellSeparatedPairDecomposition.Types.ShortSide
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: areWellSeparated :: (Arity d, Arity (d + 1), Fractional r, Ord r) => r -> SplitTree d p r a -> SplitTree d p r a -> Bool
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: areWellSeparated' :: (Floating r, Ord r, Arity d) => r -> SplitTree d p r a -> SplitTree d p r a -> Bool
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: assignLevel :: (c :+ (Idx :+ p)) -> Level -> RST s ()
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: assignLevels :: (Fractional r, Ord r, Arity d, Show r, Show p) => Int -> Int -> Vector d (PointSeq d (Idx :+ p) r) -> Level -> [Level] -> RST s (NonEmpty Level)
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: bbOf :: Ord r => SplitTree d p r a -> Box d () r
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: boxBox :: (Fractional r, Ord r, Arity d, Arity (d + 1)) => r -> Box d p r -> Box d p r -> Bool
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: boxBox1 :: (Floating r, Ord r, Arity d) => r -> Box d p r -> Box d p r -> Bool
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: children' :: BinLeafTree v a -> [BinLeafTree v a]
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: compactEnds :: Arity d => Vector d (PointSeq d (Idx :+ p) r) -> RST s (Vector d (PointSeq d (Idx :+ p) r))
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: compactEnds' :: PointSeq d (Idx :+ p) r -> RST s (PointSeq d (Idx :+ p) r)
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: distributePoints :: (Arity d, Show r, Show p) => Int -> Vector (Maybe Level) -> Vector d (PointSeq d (Idx :+ p) r) -> Vector (Vector d (PointSeq d (Idx :+ p) r))
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: distributePoints' :: Int -> Vector (Maybe Level) -> PointSeq d (Idx :+ p) r -> Vector (PointSeq d (Idx :+ p) r)
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: dropIdx :: (core :+ (t :+ extra)) -> core :+ extra
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: extends :: Arity d => Vector d (PointSeq d p r) -> Vector d (Range r)
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: fairSplitTree :: (Fractional r, Ord r, Arity d, 1 <= d, Show r, Show p) => NonEmpty (Point d r :+ p) -> SplitTree d p r ()
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: fairSplitTree' :: (Fractional r, Ord r, Arity d, 1 <= d, Show r, Show p) => Int -> Vector d (PointSeq d (Idx :+ p) r) -> BinLeafTree Int (Point d r :+ p)
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: findAndCompact :: (Ord r, Arity d, Show r, Show p) => Int -> PointSeq d (Idx :+ p) r -> r -> RST s (PointSeq d (Idx :+ p) r, PointSeq d (Idx :+ p) r)
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: findPairs :: (Floating r, Ord r, Arity d, Arity (d + 1)) => r -> SplitTree d p r a -> SplitTree d p r a -> [WSP d p r a]
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: fromSeqUnsafe :: () => Seq a -> LSeq n a
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: hasLevel :: (c :+ (Idx :+ p)) -> RST s Bool
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: ix' :: (Arity d, KnownNat d) => Int -> Lens' (Vector d a) a
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: levelOf :: (c :+ (Idx :+ p)) -> RST s (Maybe Level)
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: maxWidth :: (Arity d, Num r) => SplitTree d p r a -> r
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: reIndexPoints :: (Arity d, 1 <= d) => Vector d (PointSeq d (Idx :+ p) r) -> Vector d (PointSeq d (Idx :+ p) r)
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: transpose :: Arity d => Vector d (Vector a) -> Vector (Vector d a)
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: type RST s = ReaderT (MVector s (Maybe Level)) (ST s)
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: wellSeparatedPairs :: (Floating r, Ord r, Arity d, Arity (d + 1)) => r -> SplitTree d p r a -> [WSP d p r a]
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: widestDimension :: (Num r, Ord r, Arity d) => Vector d (PointSeq d p r) -> Int
- Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD: widths :: (Num r, Arity d) => Vector d (PointSeq d p r) -> Vector d r
- Data.Geometry: asSimplePolygon :: Polygon t p r -> SimplePolygon p r
- Data.Geometry: readVec :: forall d r. (Arity d, Read r) => ReadP (Vector d r)
- Data.Geometry.Ball: instance (GHC.Classes.Ord r, GHC.Float.Floating r) => Data.Intersection.IsIntersectableWith (Data.Geometry.LineSegment.LineSegment 2 p r) (Data.Geometry.Ball.Circle q r)
- Data.Geometry.Directions: _East :: Prism' CardinalDirection ()
- Data.Geometry.Directions: _North :: Prism' CardinalDirection ()
- Data.Geometry.Directions: _NorthEast :: Prism' InterCardinalDirection ()
- Data.Geometry.Directions: _NorthWest :: Prism' InterCardinalDirection ()
- Data.Geometry.Directions: _South :: Prism' CardinalDirection ()
- Data.Geometry.Directions: _SouthEast :: Prism' InterCardinalDirection ()
- Data.Geometry.Directions: _SouthWest :: Prism' InterCardinalDirection ()
- Data.Geometry.Directions: _West :: Prism' CardinalDirection ()
- Data.Geometry.HalfLine: [_halfLineDirection] :: HalfLine d r -> Vector d r
- Data.Geometry.HalfLine: [_startPoint] :: HalfLine d r -> Point d r
- Data.Geometry.HalfLine: onHalfLine :: (Ord r, Fractional r, Arity d) => Point d r -> HalfLine d r -> Bool
- Data.Geometry.LineSegment: instance (Data.Geometry.Vector.VectorFamily.Arity d, Control.DeepSeq.NFData r, Control.DeepSeq.NFData p) => Control.DeepSeq.NFData (Data.Geometry.LineSegment.LineSegment d p r)
- Data.Geometry.LineSegment: instance (GHC.Classes.Eq r, GHC.Classes.Eq p, Data.Geometry.Vector.VectorFamily.Arity d) => GHC.Classes.Eq (Data.Geometry.LineSegment.LineSegment d p r)
- Data.Geometry.LineSegment: instance (GHC.Classes.Ord r, GHC.Real.Fractional r) => Data.Intersection.IsIntersectableWith (Data.Geometry.LineSegment.LineSegment 2 p r) (Data.Geometry.Line.Internal.Line 2 r)
- Data.Geometry.LineSegment: instance (GHC.Classes.Ord r, GHC.Real.Fractional r) => Data.Intersection.IsIntersectableWith (Data.Geometry.LineSegment.LineSegment 2 p r) (Data.Geometry.LineSegment.LineSegment 2 p r)
- Data.Geometry.LineSegment: instance (GHC.Num.Num r, Data.Geometry.Vector.VectorFamily.Arity d) => Data.Geometry.Line.Internal.HasSupportingLine (Data.Geometry.LineSegment.LineSegment d p r)
- Data.Geometry.LineSegment: instance (GHC.Real.Fractional r, Data.Geometry.Vector.VectorFamily.Arity d, Data.Geometry.Vector.VectorFamily.Arity (d GHC.TypeNats.+ 1)) => Data.Geometry.Transformation.IsTransformable (Data.Geometry.LineSegment.LineSegment d p r)
- Data.Geometry.LineSegment: instance (GHC.Show.Show r, GHC.Show.Show p, Data.Geometry.Vector.VectorFamily.Arity d) => GHC.Show.Show (Data.Geometry.LineSegment.LineSegment d p r)
- Data.Geometry.LineSegment: instance (Test.QuickCheck.Arbitrary.Arbitrary r, Test.QuickCheck.Arbitrary.Arbitrary p, Data.Geometry.Vector.VectorFamily.Arity d) => Test.QuickCheck.Arbitrary.Arbitrary (Data.Geometry.LineSegment.LineSegment d p r)
- Data.Geometry.LineSegment: instance Data.Geometry.Interval.HasEnd (Data.Geometry.LineSegment.LineSegment d p r)
- Data.Geometry.LineSegment: instance Data.Geometry.Interval.HasStart (Data.Geometry.LineSegment.LineSegment d p r)
- Data.Geometry.LineSegment: instance Data.Geometry.Point.Internal.PointFunctor (Data.Geometry.LineSegment.LineSegment d p)
- Data.Geometry.LineSegment: instance Data.Geometry.Vector.VectorFamily.Arity d => Data.Bifunctor.Bifunctor (Data.Geometry.LineSegment.LineSegment d)
- Data.Geometry.LineSegment: instance Data.Geometry.Vector.VectorFamily.Arity d => Data.Geometry.Box.Internal.IsBoxable (Data.Geometry.LineSegment.LineSegment d p r)
- Data.Geometry.LineSegment: instance Data.Geometry.Vector.VectorFamily.Arity d => GHC.Base.Functor (Data.Geometry.LineSegment.LineSegment d p)
- Data.Geometry.LineSegment: onSegment :: (Ord r, Fractional r, Arity d) => Point d r -> LineSegment d p r -> Bool
- Data.Geometry.LineSegment: pattern Range' :: forall a. () => () => a -> a -> Range a
- Data.Geometry.PlanarSubdivision.Basic: data Dart (s :: k) :: forall k. () => k -> Type
- Data.Geometry.PlanarSubdivision.Basic: newtype FaceId (s :: k) (w :: World) :: forall k. () => k -> World -> Type
- Data.Geometry.Point: asAPoint :: AsAPoint p => Lens (p d r) (p d' r') (Point d r) (Point d' r')
- Data.Geometry.Point: class AsAPoint p
- Data.Geometry.Point: vector' :: AsAPoint p => Lens (p d r) (p d r') (Vector d r) (Vector d r')
- Data.Geometry.Polygon: asSimplePolygon :: Polygon t p r -> SimplePolygon p r
- Data.Geometry.RangeTree: instance (1 GHC.TypeNats.<= d, i GHC.TypeNats.<= d, Data.Geometry.RangeTree.Query (i GHC.TypeNats.- 1) d, Data.Geometry.Vector.VectorFamily.Arity d, i Data.Type.Equality.~ 2) => Data.Geometry.RangeTree.Query 2 d
- Data.Geometry.RangeTree: instance forall k1 k2 r p (d :: GHC.Types.Nat) (i :: k2) (v :: k1). (GHC.Classes.Eq r, GHC.Classes.Eq p, Data.Geometry.Vector.VectorFamily.Arity d) => GHC.Classes.Eq (Data.Geometry.RangeTree.Leaf i d v p r)
- Data.Geometry.RangeTree: instance forall k1 k2 r p (d :: GHC.Types.Nat) (i :: k2) (v :: k1). (GHC.Show.Show r, GHC.Show.Show p, Data.Geometry.Vector.VectorFamily.Arity d) => GHC.Show.Show (Data.Geometry.RangeTree.Leaf i d v p r)
- Data.Geometry.Slab: instance (GHC.Real.Fractional r, GHC.Classes.Ord r, Data.Geometry.Slab.HasBoundingLines o) => Data.Intersection.IsIntersectableWith (Data.Geometry.LineSegment.LineSegment 2 a r) (Data.Geometry.Slab.Slab o a r)
- Data.Geometry.SubLine: testz :: SubLine 2 () Rational Rational
- Data.Geometry.Vector.VectorFamily: instance (Data.Geometry.Vector.VectorFamily.Arity d, GHC.Show.Show r) => GHC.Show.Show (Data.Geometry.Vector.VectorFamily.Vector d r)
- Data.Geometry.Vector.VectorFamily: instance Data.Geometry.Vector.VectorFamily.Arity d => Control.Lens.Indexed.FoldableWithIndex GHC.Types.Int (Data.Geometry.Vector.VectorFamily.Vector d)
- Data.Geometry.Vector.VectorFamily: instance Data.Geometry.Vector.VectorFamily.Arity d => Control.Lens.Indexed.FunctorWithIndex GHC.Types.Int (Data.Geometry.Vector.VectorFamily.Vector d)
- Data.Geometry.Vector.VectorFamily: instance Data.Geometry.Vector.VectorFamily.Arity d => Control.Lens.Indexed.TraversableWithIndex GHC.Types.Int (Data.Geometry.Vector.VectorFamily.Vector d)
- Data.Geometry.Vector.VectorFamily: readVec :: forall d r. (Arity d, Read r) => ReadP (Vector d r)
- Data.Geometry.Vector.VectorFamilyPeano: [SS] :: !SingPeano d -> SingPeano (S d)
- Data.Geometry.Vector.VectorFamilyPeano: [SZ] :: SingPeano Z
- Data.Geometry.Vector.VectorFamilyPeano: [_unVF] :: VectorFamily -> VectorFamilyF d r
- Data.Geometry.Vector.VectorFamilyPeano: class ImplicitPeano (d :: PeanoNum)
- Data.Geometry.Vector.VectorFamilyPeano: data SingPeano (d :: PeanoNum)
- Data.Geometry.Vector.VectorFamilyPeano: destruct :: (ImplicitArity d, ImplicitArity (S d)) => VectorFamily (S d) r -> (r, VectorFamily d r)
- Data.Geometry.Vector.VectorFamilyPeano: elem0 :: Int -> Traversal' (VectorFamily Z r) r
- Data.Geometry.Vector.VectorFamilyPeano: elem1 :: Int -> Traversal' (VectorFamily One r) r
- Data.Geometry.Vector.VectorFamilyPeano: elem2 :: Int -> Traversal' (VectorFamily Two r) r
- Data.Geometry.Vector.VectorFamilyPeano: elem3 :: Int -> Traversal' (VectorFamily Three r) r
- Data.Geometry.Vector.VectorFamilyPeano: elem4 :: Int -> Traversal' (VectorFamily Four r) r
- Data.Geometry.Vector.VectorFamilyPeano: elemD :: Arity (FromPeano (Many d)) => Int -> Traversal' (VectorFamily (Many d) r) r
- Data.Geometry.Vector.VectorFamilyPeano: element' :: forall d r. ImplicitArity d => Int -> Traversal' (VectorFamily d r) r
- Data.Geometry.Vector.VectorFamilyPeano: implicitPeano :: ImplicitPeano d => SingPeano d
- Data.Geometry.Vector.VectorFamilyPeano: type Four = S Three
- Data.Geometry.Vector.VectorFamilyPeano: type Many d = S (S (S (S (S d))))
- Data.Geometry.Vector.VectorFamilyPeano: type One = S Z
- Data.Geometry.Vector.VectorFamilyPeano: type Three = S Two
- Data.Geometry.Vector.VectorFamilyPeano: unVF :: Lens (VectorFamily d r) (VectorFamily d t) (VectorFamilyF d r) (VectorFamilyF d t)
- Data.Geometry.Vector.VectorFamilyPeano: vectorFromList :: ImplicitArity d => [r] -> Maybe (VectorFamily d r)
- Data.Geometry.Vector.VectorFamilyPeano: vectorFromListUnsafe :: ImplicitArity d => [r] -> VectorFamily d r
- Data.PlaneGraph: data Dart (s :: k) :: forall k. () => k -> Type
- Data.PlaneGraph: newtype FaceId (s :: k) (w :: World) :: forall k. () => k -> World -> Type
- Data.PlaneGraph.Core: data Dart (s :: k) :: forall k. () => k -> Type
- Data.PlaneGraph.Core: newtype FaceId (s :: k) (w :: World) :: forall k. () => k -> World -> Type
+ Algorithms.Geometry.ClosestPair: closestPair :: (Ord r, Num r) => LSeq 2 (Point 2 r :+ p) -> Two (Point 2 r :+ p)
+ Algorithms.Geometry.ConvexHull: convexHull :: (Ord r, Num r) => NonEmpty (Point 2 r :+ p) -> ConvexPolygon p r
+ Algorithms.Geometry.DelaunayTriangulation.Naive: sortAroundMapping :: (Num r, Ord r) => Mapping p r -> VertexID -> [VertexID] -> [VertexID]
+ Algorithms.Geometry.DelaunayTriangulation.Types: edgesAsPoints :: Triangulation p r -> [(Point 2 r :+ p, Point 2 r :+ p)]
+ Algorithms.Geometry.DelaunayTriangulation.Types: edgesAsVertices :: Triangulation p r -> [(VertexID, VertexID)]
+ Algorithms.Geometry.Diameter: diameter :: (Ord r, Floating r) => [Point 2 r :+ p] -> r
+ Algorithms.Geometry.Diameter: diametralPair :: (Ord r, Num r) => [Point 2 r :+ p] -> Maybe (Point 2 r :+ p, Point 2 r :+ p)
+ Algorithms.Geometry.Diameter.ConvexHull: diameter :: (Ord r, Floating r) => [Point 2 r :+ p] -> r
+ Algorithms.Geometry.Diameter.ConvexHull: diametralPair :: (Ord r, Num r) => [Point 2 r :+ p] -> Maybe (Point 2 r :+ p, Point 2 r :+ p)
+ Algorithms.Geometry.EuclideanMST: euclideanMST :: (Ord r, Fractional r) => NonEmpty (Point 2 r :+ p) -> Tree (Point 2 r :+ p)
+ Algorithms.Geometry.LineSegmentIntersection: Associated :: Set' (LineSegment 2 p r) -> Set' (LineSegment 2 p r) -> Associated p r
+ Algorithms.Geometry.LineSegmentIntersection: IntersectionPoint :: !Point 2 r -> !Associated p r -> IntersectionPoint p r
+ Algorithms.Geometry.LineSegmentIntersection: [_associatedSegs] :: IntersectionPoint p r -> !Associated p r
+ Algorithms.Geometry.LineSegmentIntersection: [_endPointOf] :: Associated p r -> Set' (LineSegment 2 p r)
+ Algorithms.Geometry.LineSegmentIntersection: [_interiorTo] :: Associated p r -> Set' (LineSegment 2 p r)
+ Algorithms.Geometry.LineSegmentIntersection: [_intersectionPoint] :: IntersectionPoint p r -> !Point 2 r
+ Algorithms.Geometry.LineSegmentIntersection: associated :: Ord r => [LineSegment 2 p r] -> [LineSegment 2 p r] -> Associated p r
+ Algorithms.Geometry.LineSegmentIntersection: data Associated p r
+ Algorithms.Geometry.LineSegmentIntersection: data IntersectionPoint p r
+ Algorithms.Geometry.LineSegmentIntersection: isEndPointIntersection :: Associated p r -> Bool
+ Algorithms.Geometry.LineSegmentIntersection: type Compare a = a -> a -> Ordering
+ Algorithms.Geometry.LineSegmentIntersection: type Intersections p r = Map (Point 2 r) (Associated p r)
+ Algorithms.Geometry.LineSegmentIntersection.BooleanSweep: hasIntersections :: (Ord r, Num r) => [LineSegment 2 p r] -> Bool
+ Algorithms.Geometry.LineSegmentIntersection.BooleanSweep: segmentsOverlap :: (Num r, Ord r) => LineSegment 2 p r -> LineSegment 2 p r -> Bool
+ Algorithms.Geometry.PolygonTriangulation.EarClip: earClip :: (Num r, Ord r) => SimplePolygon p r -> [(Int, Int, Int)]
+ Algorithms.Geometry.PolygonTriangulation.EarClip: earClipHashed :: Real r => SimplePolygon p r -> [(Int, Int, Int)]
+ Algorithms.Geometry.PolygonTriangulation.EarClip: earClipRandom :: (Num r, Ord r) => SimplePolygon p r -> [(Int, Int, Int)]
+ Algorithms.Geometry.PolygonTriangulation.EarClip: earClipRandomHashed :: Real r => SimplePolygon p r -> [(Int, Int, Int)]
+ Algorithms.Geometry.PolygonTriangulation.EarClip: zHash :: V2 Word -> Word
+ Algorithms.Geometry.PolygonTriangulation.EarClip: zUnHash :: Word -> V2 Word
+ Algorithms.Geometry.SSSP: instance Data.FingerTree.Measured (Algorithms.Geometry.SSSP.MinMax r) (Algorithms.Geometry.SSSP.Index r)
+ Algorithms.Geometry.SSSP: instance GHC.Base.Monoid (Algorithms.Geometry.SSSP.MinMax r)
+ Algorithms.Geometry.SSSP: instance GHC.Base.Semigroup (Algorithms.Geometry.SSSP.MinMax r)
+ Algorithms.Geometry.SSSP: instance GHC.Classes.Eq (Algorithms.Geometry.SSSP.Index r)
+ Algorithms.Geometry.SSSP: instance GHC.Show.Show (Algorithms.Geometry.SSSP.Dual r)
+ Algorithms.Geometry.SSSP: instance GHC.Show.Show (Algorithms.Geometry.SSSP.DualTree r)
+ Algorithms.Geometry.SSSP: instance GHC.Show.Show (Algorithms.Geometry.SSSP.Funnel r)
+ Algorithms.Geometry.SSSP: instance GHC.Show.Show (Algorithms.Geometry.SSSP.Index r)
+ Algorithms.Geometry.SSSP: instance GHC.Show.Show (Algorithms.Geometry.SSSP.MinMax r)
+ Algorithms.Geometry.SSSP: instance GHC.Show.Show Algorithms.Geometry.SSSP.SplitDirection
+ Algorithms.Geometry.SSSP: sssp :: (Ord r, Fractional r) => PlaneGraph s Int PolygonEdgeType PolygonFaceData r -> SSSP
+ Algorithms.Geometry.SSSP: triangulate :: (Ord r, Fractional r) => SimplePolygon p r -> PlaneGraph s Int PolygonEdgeType PolygonFaceData r
+ Algorithms.Geometry.SSSP: type SSSP = Vector Int
+ Algorithms.Geometry.SSSP: visibilityDual :: forall s r. (Ord r, Fractional r) => PlaneGraph s Int PolygonEdgeType PolygonFaceData r -> Dual r
+ Algorithms.Geometry.SSSP: visibilityFinger :: forall r. (Fractional r, Ord r, Show r) => Dual r -> [Either (Int, Int, Int) (Point 2 r)]
+ Algorithms.Geometry.SSSP: visibilitySensitive :: forall s r. (Ord r, Fractional r, Show r) => PlaneGraph s Int PolygonEdgeType PolygonFaceData r -> SimplePolygon () r
+ Algorithms.Geometry.SSSP.Naive: sssp :: (Real r, Fractional r) => SimplePolygon p r -> SSSP
+ Algorithms.Geometry.SSSP.Naive: sssp' :: (Real r, Fractional r) => SimplePolygon p r -> Vector SSSP
+ Algorithms.Geometry.SmallestEnclosingBall: DiskResult :: Disk () r -> TwoOrThree (Point 2 r :+ p) -> DiskResult p r
+ Algorithms.Geometry.SmallestEnclosingBall: Three :: !a -> !a -> !a -> TwoOrThree a
+ Algorithms.Geometry.SmallestEnclosingBall: Two :: !a -> !a -> TwoOrThree a
+ Algorithms.Geometry.SmallestEnclosingBall: [_definingPoints] :: DiskResult p r -> TwoOrThree (Point 2 r :+ p)
+ Algorithms.Geometry.SmallestEnclosingBall: [_enclosingDisk] :: DiskResult p r -> Disk () r
+ Algorithms.Geometry.SmallestEnclosingBall: data DiskResult p r
+ Algorithms.Geometry.SmallestEnclosingBall: data TwoOrThree a
+ Algorithms.Geometry.SmallestEnclosingBall: definingPoints :: forall p_a2IBQ r_a2IBR p_a2IUw. Lens (DiskResult p_a2IBQ r_a2IBR) (DiskResult p_a2IUw r_a2IBR) (TwoOrThree ((:+) (Point 2 r_a2IBR) p_a2IBQ)) (TwoOrThree ((:+) (Point 2 r_a2IBR) p_a2IUw))
+ Algorithms.Geometry.SmallestEnclosingBall: enclosingDisk :: forall p_a2IBQ r_a2IBR. Lens' (DiskResult p_a2IBQ r_a2IBR) (Disk () r_a2IBR)
+ Algorithms.Geometry.SmallestEnclosingBall: twoOrThreeFromList :: [a] -> Either String (TwoOrThree a)
+ Algorithms.Geometry.VisibilityPolygon.Lee: compareAroundEndPoint :: forall p r e. (Ord r, Fractional r) => Point 2 r -> (LineSegment 2 p r :+ e) -> (LineSegment 2 p r :+ e) -> Ordering
+ Algorithms.Geometry.VisibilityPolygon.Lee: instance (GHC.Show.Show r, GHC.Show.Show p, GHC.Show.Show e) => GHC.Show.Show (Algorithms.Geometry.VisibilityPolygon.Lee.Event p e r)
+ Algorithms.Geometry.VisibilityPolygon.Lee: instance GHC.Classes.Eq a => GHC.Classes.Eq (Algorithms.Geometry.VisibilityPolygon.Lee.Action a)
+ Algorithms.Geometry.VisibilityPolygon.Lee: instance GHC.Classes.Ord a => GHC.Classes.Ord (Algorithms.Geometry.VisibilityPolygon.Lee.Action a)
+ Algorithms.Geometry.VisibilityPolygon.Lee: instance GHC.Show.Show a => GHC.Show.Show (Algorithms.Geometry.VisibilityPolygon.Lee.Action a)
+ Algorithms.Geometry.VisibilityPolygon.Lee: type Definer p e r = Either p (Point 2 r :+ p, LineSegment 2 p r :+ e)
+ Algorithms.Geometry.VisibilityPolygon.Lee: type StarShapedPolygon p r = SimplePolygon p r
+ Algorithms.Geometry.VisibilityPolygon.Lee: type VisibilityPolygon p e r = StarShapedPolygon (Definer p e r) r
+ Algorithms.Geometry.VisibilityPolygon.Lee: visibilityPolygon :: forall p t r. (Ord r, Fractional r) => Point 2 r -> Polygon t p r -> StarShapedPolygon (Definer p () r) r
+ Algorithms.Geometry.VisibilityPolygon.Lee: visibilitySweep :: forall p r e. (Ord r, Fractional r) => Vector 2 r -> Maybe (Point 2 r) -> Point 2 r -> [LineSegment 2 p r :+ e] -> [Point 2 r :+ Definer p e r]
+ Algorithms.Geometry.WSPD: Level :: Int -> Maybe Int -> Level
+ Algorithms.Geometry.WSPD: NodeData :: !Int -> !Box d () r -> !a -> NodeData d r a
+ Algorithms.Geometry.WSPD: [_unLevel] :: Level -> Int
+ Algorithms.Geometry.WSPD: [_widestDim] :: Level -> Maybe Int
+ Algorithms.Geometry.WSPD: data Level
+ Algorithms.Geometry.WSPD: data NodeData d r a
+ Algorithms.Geometry.WSPD: distributePoints :: (Arity d, Show r, Show p) => Int -> Vector (Maybe Level) -> Vector d (PointSeq d (Idx :+ p) r) -> Vector (Vector d (PointSeq d (Idx :+ p) r))
+ Algorithms.Geometry.WSPD: distributePoints' :: Int -> Vector (Maybe Level) -> PointSeq d (Idx :+ p) r -> Vector (PointSeq d (Idx :+ p) r)
+ Algorithms.Geometry.WSPD: fairSplitTree :: (Fractional r, Ord r, Arity d, 1 <= d, Show r, Show p) => NonEmpty (Point d r :+ p) -> SplitTree d p r ()
+ Algorithms.Geometry.WSPD: nodeData :: forall d_a2zOP r_a2zOQ a_a2zOR a_a2zTy. Lens (NodeData d_a2zOP r_a2zOQ a_a2zOR) (NodeData d_a2zOP r_a2zOQ a_a2zTy) a_a2zOR a_a2zTy
+ Algorithms.Geometry.WSPD: reIndexPoints :: (Arity d, 1 <= d) => Vector d (PointSeq d (Idx :+ p) r) -> Vector d (PointSeq d (Idx :+ p) r)
+ Algorithms.Geometry.WSPD: type SplitTree d p r a = BinLeafTree (NodeData d r a) (Point d r :+ p)
+ Algorithms.Geometry.WSPD: type WSP d p r a = (PointSet d p r a, PointSet d p r a)
+ Algorithms.Geometry.WSPD: wellSeparatedPairs :: (Floating r, Ord r, Arity d, Arity (d + 1)) => r -> SplitTree d p r a -> [WSP d p r a]
+ Data.Geometry: findRotateTo :: ((Point 2 r :+ p) -> Bool) -> SimplePolygon p r -> Maybe (SimplePolygon p r)
+ Data.Geometry: fromCircularVector :: forall p r. (Eq r, Num r) => CircularVector (Point 2 r :+ p) -> SimplePolygon p r
+ Data.Geometry: isSimple :: (Ord r, Fractional r) => Polygon p t r -> Bool
+ Data.Geometry: maximumVertexBy :: ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering) -> Polygon t p r -> Point 2 r :+ p
+ Data.Geometry: minimumVertexBy :: ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering) -> Polygon t p r -> Point 2 r :+ p
+ Data.Geometry: outerBoundaryVector :: forall t p r. Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
+ Data.Geometry: rotateLeft :: Int -> SimplePolygon p r -> SimplePolygon p r
+ Data.Geometry: rotateRight :: Int -> SimplePolygon p r -> SimplePolygon p r
+ Data.Geometry: sameDirection :: (Eq r, Num r, Arity d) => Vector d r -> Vector d r -> Bool
+ Data.Geometry: simpleFromCircularVector :: forall p r. (Ord r, Fractional r) => CircularVector (Point 2 r :+ p) -> SimplePolygon p r
+ Data.Geometry: simpleFromPoints :: forall p r. (Ord r, Fractional r) => [Point 2 r :+ p] -> SimplePolygon p r
+ Data.Geometry: size :: Polygon t p r -> Int
+ Data.Geometry: toPoints :: Polygon t p r -> [Point 2 r :+ p]
+ Data.Geometry: toVector :: Polygon t p r -> Vector (Point 2 r :+ p)
+ Data.Geometry: unsafeFromCircularVector :: CircularVector (Point 2 r :+ p) -> SimplePolygon p r
+ Data.Geometry: unsafeFromPoints :: [Point 2 r :+ p] -> SimplePolygon p r
+ Data.Geometry: unsafeFromVector :: Vector (Point 2 r :+ p) -> SimplePolygon p r
+ Data.Geometry: unsafeOuterBoundaryVector :: forall t p r. Lens' (Polygon t p r) (CircularVector (Point 2 r :+ p))
+ Data.Geometry.Ball: instance (GHC.Classes.Ord r, GHC.Float.Floating r) => Data.Intersection.IsIntersectableWith (Data.Geometry.LineSegment.Internal.LineSegment 2 p r) (Data.Geometry.Ball.Circle q r)
+ Data.Geometry.Box.Internal: insideBox :: (Arity d, Ord r) => Point d r -> Box d p r -> Bool
+ Data.Geometry.HalfLine: instance (GHC.Classes.Eq r, GHC.Real.Fractional r) => GHC.Classes.Eq (Data.Geometry.HalfLine.HalfLine 2 r)
+ Data.Geometry.HalfLine: instance (GHC.Classes.Ord r, GHC.Real.Fractional r) => Data.Intersection.IsIntersectableWith (Data.Geometry.HalfLine.HalfLine 2 r) (Data.Geometry.Boundary.Boundary (Data.Geometry.Box.Internal.Rectangle p r))
+ Data.Geometry.HalfLine: instance (GHC.Classes.Ord r, GHC.Real.Fractional r) => Data.Intersection.IsIntersectableWith (Data.Geometry.HalfLine.HalfLine 2 r) (Data.Geometry.Box.Internal.Rectangle p r)
+ Data.Geometry.HalfLine: instance (GHC.Classes.Ord r, GHC.Real.Fractional r) => Data.Intersection.IsIntersectableWith (Data.Geometry.HalfLine.HalfLine 2 r) (Data.Geometry.HalfLine.HalfLine 2 r)
+ Data.Geometry.HalfLine: instance (GHC.Classes.Ord r, GHC.Real.Fractional r) => Data.Intersection.IsIntersectableWith (Data.Geometry.HalfLine.HalfLine 2 r) (Data.Geometry.Line.Internal.Line 2 r)
+ Data.Geometry.HalfLine: instance (GHC.Classes.Ord r, GHC.Real.Fractional r) => Data.Intersection.IsIntersectableWith (Data.Geometry.LineSegment.Internal.LineSegment 2 () r) (Data.Geometry.HalfLine.HalfLine 2 r)
+ Data.Geometry.HalfLine: instance (GHC.Classes.Ord r, GHC.Real.Fractional r, Data.Geometry.Vector.VectorFamily.Arity d) => Data.Intersection.IsIntersectableWith (Data.Geometry.Point.Internal.Point d r) (Data.Geometry.HalfLine.HalfLine d r)
+ Data.Geometry.Line.Internal: liesBelow :: (Ord r, Num r) => Point 2 r -> Line 2 r -> Bool
+ Data.Geometry.LineSegment: pattern ClosedRange :: a -> a -> Range a
+ Data.Geometry.LineSegment: pattern OpenRange :: a -> a -> Range a
+ Data.Geometry.LineSegment: pattern Range' :: a -> a -> Range a
+ Data.Geometry.LineSegment: sampleLineSegment :: (Arity d, RandomGen g, Random r) => Rand g (LineSegment d () r)
+ Data.Geometry.LineSegment: sqSegmentLength :: (Arity d, Num r) => LineSegment d p r -> r
+ Data.Geometry.LineSegment: toRange :: Interval a r -> Range (r :+ a)
+ Data.Geometry.LineSegment.Internal: Closed :: !a -> EndPoint a
+ Data.Geometry.LineSegment.Internal: Open :: !a -> EndPoint a
+ Data.Geometry.LineSegment.Internal: Range :: !EndPoint a -> !EndPoint a -> Range a
+ Data.Geometry.LineSegment.Internal: [_lower] :: Range a -> !EndPoint a
+ Data.Geometry.LineSegment.Internal: [_upper] :: Range a -> !EndPoint a
+ Data.Geometry.LineSegment.Internal: _Range :: Iso' (Interval a r) (Range (r :+ a))
+ Data.Geometry.LineSegment.Internal: _SubLine :: (Num r, Arity d) => Iso' (LineSegment d p r) (SubLine d p r r)
+ Data.Geometry.LineSegment.Internal: asProperInterval :: Ord r => Interval p r -> Interval p r
+ Data.Geometry.LineSegment.Internal: clampTo :: Ord r => Range r -> r -> r
+ Data.Geometry.LineSegment.Internal: class HasEnd t where {
+ Data.Geometry.LineSegment.Internal: class HasStart t where {
+ Data.Geometry.LineSegment.Internal: clipLower :: Ord a => EndPoint a -> Range a -> Maybe (Range a)
+ Data.Geometry.LineSegment.Internal: clipUpper :: Ord a => EndPoint a -> Range a -> Maybe (Range a)
+ Data.Geometry.LineSegment.Internal: covers :: Ord a => Range a -> Range a -> Bool
+ Data.Geometry.LineSegment.Internal: data EndPoint a
+ Data.Geometry.LineSegment.Internal: data Interval a r
+ Data.Geometry.LineSegment.Internal: data LineSegment d p r
+ Data.Geometry.LineSegment.Internal: data Range a
+ Data.Geometry.LineSegment.Internal: end :: HasEnd t => Lens' t (EndCore t :+ EndExtra t)
+ Data.Geometry.LineSegment.Internal: endPoints :: Traversal (LineSegment d p r) (LineSegment d' q s) (Point d r :+ p) (Point d' s :+ q)
+ Data.Geometry.LineSegment.Internal: flipInterval :: Interval a r -> Interval a r
+ Data.Geometry.LineSegment.Internal: flipSegment :: LineSegment d p r -> LineSegment d p r
+ Data.Geometry.LineSegment.Internal: fromRange :: Range (r :+ a) -> Interval a r
+ Data.Geometry.LineSegment.Internal: inInterval :: Ord r => r -> Interval a r -> Bool
+ Data.Geometry.LineSegment.Internal: inRange :: Ord a => a -> Range a -> Bool
+ Data.Geometry.LineSegment.Internal: instance (Data.Geometry.Vector.VectorFamily.Arity d, Control.DeepSeq.NFData r, Control.DeepSeq.NFData p) => Control.DeepSeq.NFData (Data.Geometry.LineSegment.Internal.LineSegment d p r)
+ Data.Geometry.LineSegment.Internal: instance (GHC.Classes.Eq r, GHC.Classes.Eq p, Data.Geometry.Vector.VectorFamily.Arity d) => GHC.Classes.Eq (Data.Geometry.LineSegment.Internal.LineSegment d p r)
+ Data.Geometry.LineSegment.Internal: instance (GHC.Classes.Ord r, GHC.Num.Num r) => Data.Intersection.IsIntersectableWith (Data.Geometry.Point.Internal.Point 2 r) (Data.Geometry.LineSegment.Internal.LineSegment 2 p r)
+ Data.Geometry.LineSegment.Internal: instance (GHC.Classes.Ord r, GHC.Real.Fractional r) => Data.Intersection.IsIntersectableWith (Data.Geometry.LineSegment.Internal.LineSegment 2 p r) (Data.Geometry.Line.Internal.Line 2 r)
+ Data.Geometry.LineSegment.Internal: instance (GHC.Classes.Ord r, GHC.Real.Fractional r) => Data.Intersection.IsIntersectableWith (Data.Geometry.LineSegment.Internal.LineSegment 2 p r) (Data.Geometry.LineSegment.Internal.LineSegment 2 p r)
+ Data.Geometry.LineSegment.Internal: instance (GHC.Classes.Ord r, GHC.Real.Fractional r, Data.Geometry.Vector.VectorFamily.Arity d) => Data.Intersection.IsIntersectableWith (Data.Geometry.Point.Internal.Point d r) (Data.Geometry.LineSegment.Internal.LineSegment d p r)
+ Data.Geometry.LineSegment.Internal: instance (GHC.Num.Num r, Data.Geometry.Vector.VectorFamily.Arity d) => Data.Geometry.Line.Internal.HasSupportingLine (Data.Geometry.LineSegment.Internal.LineSegment d p r)
+ Data.Geometry.LineSegment.Internal: instance (GHC.Read.Read r, GHC.Read.Read p, Data.Geometry.Vector.VectorFamily.Arity d) => GHC.Read.Read (Data.Geometry.LineSegment.Internal.LineSegment d p r)
+ Data.Geometry.LineSegment.Internal: instance (GHC.Real.Fractional r, Data.Geometry.Vector.VectorFamily.Arity d, Data.Geometry.Vector.VectorFamily.Arity (d GHC.TypeNats.+ 1)) => Data.Geometry.Transformation.IsTransformable (Data.Geometry.LineSegment.Internal.LineSegment d p r)
+ Data.Geometry.LineSegment.Internal: instance (GHC.Show.Show r, GHC.Show.Show p, Data.Geometry.Vector.VectorFamily.Arity d) => GHC.Show.Show (Data.Geometry.LineSegment.Internal.LineSegment d p r)
+ Data.Geometry.LineSegment.Internal: instance (Test.QuickCheck.Arbitrary.Arbitrary r, Test.QuickCheck.Arbitrary.Arbitrary p, GHC.Classes.Eq r, Data.Geometry.Vector.VectorFamily.Arity d) => Test.QuickCheck.Arbitrary.Arbitrary (Data.Geometry.LineSegment.Internal.LineSegment d p r)
+ Data.Geometry.LineSegment.Internal: instance Data.Geometry.Interval.HasEnd (Data.Geometry.LineSegment.Internal.LineSegment d p r)
+ Data.Geometry.LineSegment.Internal: instance Data.Geometry.Interval.HasStart (Data.Geometry.LineSegment.Internal.LineSegment d p r)
+ Data.Geometry.LineSegment.Internal: instance Data.Geometry.Point.Internal.PointFunctor (Data.Geometry.LineSegment.Internal.LineSegment d p)
+ Data.Geometry.LineSegment.Internal: instance Data.Geometry.Vector.VectorFamily.Arity d => Data.Bifunctor.Bifunctor (Data.Geometry.LineSegment.Internal.LineSegment d)
+ Data.Geometry.LineSegment.Internal: instance Data.Geometry.Vector.VectorFamily.Arity d => Data.Geometry.Box.Internal.IsBoxable (Data.Geometry.LineSegment.Internal.LineSegment d p r)
+ Data.Geometry.LineSegment.Internal: instance Data.Geometry.Vector.VectorFamily.Arity d => GHC.Base.Functor (Data.Geometry.LineSegment.Internal.LineSegment d p)
+ Data.Geometry.LineSegment.Internal: interpolate :: (Fractional r, Arity d) => r -> LineSegment d p r -> Point d r
+ Data.Geometry.LineSegment.Internal: isClosed :: EndPoint a -> Bool
+ Data.Geometry.LineSegment.Internal: isOpen :: EndPoint a -> Bool
+ Data.Geometry.LineSegment.Internal: isValid :: Ord a => Range a -> Bool
+ Data.Geometry.LineSegment.Internal: lower :: Lens' (Range a) (EndPoint a)
+ Data.Geometry.LineSegment.Internal: onSegment :: (Ord r, Fractional r, Arity d) => Point d r -> LineSegment d p r -> Bool
+ Data.Geometry.LineSegment.Internal: onSegment2 :: (Ord r, Num r) => Point 2 r -> LineSegment 2 p r -> Bool
+ Data.Geometry.LineSegment.Internal: orderedEndPoints :: Ord r => LineSegment 2 p r -> (Point 2 r :+ p, Point 2 r :+ p)
+ Data.Geometry.LineSegment.Internal: pattern ClosedInterval :: (r :+ a) -> (r :+ a) -> Interval a r
+ Data.Geometry.LineSegment.Internal: pattern ClosedLineSegment :: (Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
+ Data.Geometry.LineSegment.Internal: pattern ClosedRange :: a -> a -> Range a
+ Data.Geometry.LineSegment.Internal: pattern Interval :: EndPoint (r :+ a) -> EndPoint (r :+ a) -> Interval a r
+ Data.Geometry.LineSegment.Internal: pattern LineSegment :: EndPoint (Point d r :+ p) -> EndPoint (Point d r :+ p) -> LineSegment d p r
+ Data.Geometry.LineSegment.Internal: pattern LineSegment' :: (Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
+ Data.Geometry.LineSegment.Internal: pattern OpenInterval :: (r :+ a) -> (r :+ a) -> Interval a r
+ Data.Geometry.LineSegment.Internal: pattern OpenLineSegment :: (Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
+ Data.Geometry.LineSegment.Internal: pattern OpenRange :: a -> a -> Range a
+ Data.Geometry.LineSegment.Internal: pattern Range' :: a -> a -> Range a
+ Data.Geometry.LineSegment.Internal: prettyShow :: Show a => Range a -> String
+ Data.Geometry.LineSegment.Internal: sampleLineSegment :: (Arity d, RandomGen g, Random r) => Rand g (LineSegment d () r)
+ Data.Geometry.LineSegment.Internal: segmentLength :: (Arity d, Floating r) => LineSegment d p r -> r
+ Data.Geometry.LineSegment.Internal: shiftLeft :: Num r => r -> Range r -> Range r
+ Data.Geometry.LineSegment.Internal: shiftLeft' :: Num r => r -> Interval a r -> Interval a r
+ Data.Geometry.LineSegment.Internal: shiftRight :: Num r => r -> Range r -> Range r
+ Data.Geometry.LineSegment.Internal: sqDistanceToSeg :: (Arity d, Fractional r, Ord r) => Point d r -> LineSegment d p r -> r
+ Data.Geometry.LineSegment.Internal: sqDistanceToSegArg :: (Arity d, Fractional r, Ord r) => Point d r -> LineSegment d p r -> (r, Point d r)
+ Data.Geometry.LineSegment.Internal: sqSegmentLength :: (Arity d, Num r) => LineSegment d p r -> r
+ Data.Geometry.LineSegment.Internal: start :: HasStart t => Lens' t (StartCore t :+ StartExtra t)
+ Data.Geometry.LineSegment.Internal: toLineSegment :: (Monoid p, Num r, Arity d) => Line d r -> LineSegment d p r
+ Data.Geometry.LineSegment.Internal: toRange :: Interval a r -> Range (r :+ a)
+ Data.Geometry.LineSegment.Internal: type family StartExtra t;
+ Data.Geometry.LineSegment.Internal: unEndPoint :: Lens (EndPoint a) (EndPoint b) a b
+ Data.Geometry.LineSegment.Internal: upper :: Lens' (Range a) (EndPoint a)
+ Data.Geometry.LineSegment.Internal: validSegment :: (Eq r, Arity d) => EndPoint (Point d r :+ p) -> EndPoint (Point d r :+ p) -> Maybe (LineSegment d p r)
+ Data.Geometry.LineSegment.Internal: }
+ Data.Geometry.PlanarSubdivision.Basic: data Dart (s :: k)
+ Data.Geometry.PlanarSubdivision.Basic: data PlanarGraph (s :: k) (w :: World) v e f
+ Data.Geometry.PlanarSubdivision.Basic: newtype FaceId (s :: k) (w :: World)
+ Data.Geometry.PlanarSubdivision.Basic: newtype VertexId (s :: k) (w :: World)
+ Data.Geometry.Point: ccwCmpAround' :: (Num r, Ord r) => (Point 2 r :+ qc) -> (Point 2 r :+ p) -> (Point 2 r :+ q) -> Ordering
+ Data.Geometry.Point: ccwCmpAroundWith' :: (Ord r, Num r) => Vector 2 r -> (Point 2 r :+ c) -> (Point 2 r :+ a) -> (Point 2 r :+ b) -> Ordering
+ Data.Geometry.Point: cmpByDistanceTo' :: (Ord r, Num r, Arity d) => (Point d r :+ c) -> (Point d r :+ p) -> (Point d r :+ q) -> Ordering
+ Data.Geometry.Point: cwCmpAround' :: (Num r, Ord r) => (Point 2 r :+ qc) -> (Point 2 r :+ p) -> (Point 2 r :+ q) -> Ordering
+ Data.Geometry.Point: cwCmpAroundWith' :: (Ord r, Num r) => Vector 2 r -> (Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> Ordering
+ Data.Geometry.Point: isCoLinear :: (Eq r, Num r) => Point 2 r -> Point 2 r -> Point 2 r -> Bool
+ Data.Geometry.Point: sortAround' :: (Ord r, Num r) => (Point 2 r :+ q) -> [Point 2 r :+ p] -> [Point 2 r :+ p]
+ Data.Geometry.PointLocation.PersistentSweep: In :: InOut
+ Data.Geometry.PointLocation.PersistentSweep: Out :: InOut
+ Data.Geometry.PointLocation.PersistentSweep: PointLocationDS :: VerticalRayShootingStructure v (Dart s) r -> PlanarSubdivision s v e f r -> FaceId' s -> PointLocationDS s v e f r
+ Data.Geometry.PointLocation.PersistentSweep: dartAbove :: (Ord r, Fractional r) => Point 2 r -> PointLocationDS s v e f r -> Maybe (Dart s)
+ Data.Geometry.PointLocation.PersistentSweep: dartAboveOrOn :: (Ord r, Fractional r) => Point 2 r -> PointLocationDS s v e f r -> Maybe (Dart s)
+ Data.Geometry.PointLocation.PersistentSweep: data InOut
+ Data.Geometry.PointLocation.PersistentSweep: data PointLocationDS s v e f r
+ Data.Geometry.PointLocation.PersistentSweep: edgeOnOrAbove :: (Ord r, Fractional r) => Point 2 r -> InPolygonDS v r -> Maybe (LineSegment 2 (SP Int v) r)
+ Data.Geometry.PointLocation.PersistentSweep: faceContaining :: (Ord r, Fractional r) => Point 2 r -> PointLocationDS s v e f r -> f
+ Data.Geometry.PointLocation.PersistentSweep: faceIdContaining :: (Ord r, Fractional r) => Point 2 r -> PointLocationDS s v e f r -> FaceId' s
+ Data.Geometry.PointLocation.PersistentSweep: inPolygonDS :: (Fractional r, Ord r) => SimplePolygon v r -> InPolygonDS v r
+ Data.Geometry.PointLocation.PersistentSweep: instance Data.Foldable.Foldable Data.Geometry.PointLocation.PersistentSweep.OneOrTwo
+ Data.Geometry.PointLocation.PersistentSweep: instance Data.Traversable.Traversable Data.Geometry.PointLocation.PersistentSweep.OneOrTwo
+ Data.Geometry.PointLocation.PersistentSweep: instance GHC.Base.Functor Data.Geometry.PointLocation.PersistentSweep.OneOrTwo
+ Data.Geometry.PointLocation.PersistentSweep: instance GHC.Classes.Eq Data.Geometry.PointLocation.PersistentSweep.InOut
+ Data.Geometry.PointLocation.PersistentSweep: instance GHC.Classes.Eq a => GHC.Classes.Eq (Data.Geometry.PointLocation.PersistentSweep.OneOrTwo a)
+ Data.Geometry.PointLocation.PersistentSweep: instance GHC.Classes.Ord a => GHC.Classes.Ord (Data.Geometry.PointLocation.PersistentSweep.OneOrTwo a)
+ Data.Geometry.PointLocation.PersistentSweep: instance GHC.Read.Read a => GHC.Read.Read (Data.Geometry.PointLocation.PersistentSweep.OneOrTwo a)
+ Data.Geometry.PointLocation.PersistentSweep: instance GHC.Show.Show Data.Geometry.PointLocation.PersistentSweep.InOut
+ Data.Geometry.PointLocation.PersistentSweep: instance GHC.Show.Show a => GHC.Show.Show (Data.Geometry.PointLocation.PersistentSweep.OneOrTwo a)
+ Data.Geometry.PointLocation.PersistentSweep: instance forall k (s :: k) v e f r. (GHC.Classes.Eq r, GHC.Classes.Eq v, GHC.Classes.Eq e, GHC.Classes.Eq f) => GHC.Classes.Eq (Data.Geometry.PointLocation.PersistentSweep.PointLocationDS s v e f r)
+ Data.Geometry.PointLocation.PersistentSweep: instance forall k (s :: k) v e f r. (GHC.Show.Show r, GHC.Show.Show v, GHC.Show.Show e, GHC.Show.Show f) => GHC.Show.Show (Data.Geometry.PointLocation.PersistentSweep.PointLocationDS s v e f r)
+ Data.Geometry.PointLocation.PersistentSweep: outerFace :: forall k_a3jMS (s_a3jMD :: k_a3jMS) v_a3jME e_a3jMF f_a3jMG r_a3jMH. Getter (PointLocationDS (s_a3jMD :: k_a3jMS) v_a3jME e_a3jMF f_a3jMG r_a3jMH) (FaceId' s_a3jMD)
+ Data.Geometry.PointLocation.PersistentSweep: pointInPolygon :: (Ord r, Fractional r) => Point 2 r -> InPolygonDS v r -> InOut
+ Data.Geometry.PointLocation.PersistentSweep: pointLocationDS :: (Ord r, Fractional r) => PlanarSubdivision s v e f r -> PointLocationDS s v e f r
+ Data.Geometry.PointLocation.PersistentSweep: subdivision :: forall k_a3jMS (s_a3jMD :: k_a3jMS) v_a3jME e_a3jMF f_a3jMG r_a3jMH. Getter (PointLocationDS (s_a3jMD :: k_a3jMS) v_a3jME e_a3jMF f_a3jMG r_a3jMH) (PlanarSubdivision s_a3jMD v_a3jME e_a3jMF f_a3jMG r_a3jMH)
+ Data.Geometry.PointLocation.PersistentSweep: type InPolygonDS v r = PointLocationDS Dummy (SP Int v) () InOut r
+ Data.Geometry.PointLocation.PersistentSweep: verticalRayShootingStructure :: forall k_a3jMS (s_a3jMD :: k_a3jMS) v_a3jME e_a3jMF f_a3jMG r_a3jMH. Getter (PointLocationDS (s_a3jMD :: k_a3jMS) v_a3jME e_a3jMF f_a3jMG r_a3jMH) (VerticalRayShootingStructure v_a3jME (Dart s_a3jMD) r_a3jMH)
+ Data.Geometry.PolyLine: instance Data.Geometry.Interval.HasEnd (Data.Geometry.PolyLine.PolyLine d p r)
+ Data.Geometry.PolyLine: instance Data.Geometry.Interval.HasStart (Data.Geometry.PolyLine.PolyLine d p r)
+ Data.Geometry.Polygon: findRotateTo :: ((Point 2 r :+ p) -> Bool) -> SimplePolygon p r -> Maybe (SimplePolygon p r)
+ Data.Geometry.Polygon: fromCircularVector :: forall p r. (Eq r, Num r) => CircularVector (Point 2 r :+ p) -> SimplePolygon p r
+ Data.Geometry.Polygon: instance (GHC.Real.Fractional r, GHC.Classes.Ord r) => Data.Intersection.IsIntersectableWith (Data.Geometry.Point.Internal.Point 2 r) (Data.Geometry.Polygon.Core.Polygon t p r)
+ Data.Geometry.Polygon: isSimple :: (Ord r, Fractional r) => Polygon p t r -> Bool
+ Data.Geometry.Polygon: maximumVertexBy :: ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering) -> Polygon t p r -> Point 2 r :+ p
+ Data.Geometry.Polygon: minimumVertexBy :: ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering) -> Polygon t p r -> Point 2 r :+ p
+ Data.Geometry.Polygon: outerBoundaryVector :: forall t p r. Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
+ Data.Geometry.Polygon: rotateLeft :: Int -> SimplePolygon p r -> SimplePolygon p r
+ Data.Geometry.Polygon: rotateRight :: Int -> SimplePolygon p r -> SimplePolygon p r
+ Data.Geometry.Polygon: simpleFromCircularVector :: forall p r. (Ord r, Fractional r) => CircularVector (Point 2 r :+ p) -> SimplePolygon p r
+ Data.Geometry.Polygon: simpleFromPoints :: forall p r. (Ord r, Fractional r) => [Point 2 r :+ p] -> SimplePolygon p r
+ Data.Geometry.Polygon: size :: Polygon t p r -> Int
+ Data.Geometry.Polygon: toPoints :: Polygon t p r -> [Point 2 r :+ p]
+ Data.Geometry.Polygon: toVector :: Polygon t p r -> Vector (Point 2 r :+ p)
+ Data.Geometry.Polygon: unsafeFromCircularVector :: CircularVector (Point 2 r :+ p) -> SimplePolygon p r
+ Data.Geometry.Polygon: unsafeFromPoints :: [Point 2 r :+ p] -> SimplePolygon p r
+ Data.Geometry.Polygon: unsafeFromVector :: Vector (Point 2 r :+ p) -> SimplePolygon p r
+ Data.Geometry.Polygon: unsafeOuterBoundaryVector :: forall t p r. Lens' (Polygon t p r) (CircularVector (Point 2 r :+ p))
+ Data.Geometry.Polygon.Convex: convexPolygon :: forall t p r. (Ord r, Num r, Show r, Show p) => Polygon t p r -> ConvexPolygon p r
+ Data.Geometry.Polygon.Convex: diameter :: (Ord r, Floating r) => ConvexPolygon p r -> r
+ Data.Geometry.Polygon.Convex: diametralIndexPair :: (Ord r, Num r) => ConvexPolygon p r -> (Int, Int)
+ Data.Geometry.Polygon.Convex: diametralPair :: (Ord r, Num r) => ConvexPolygon p r -> (Point 2 r :+ p, Point 2 r :+ p)
+ Data.Geometry.Polygon.Convex: inConvex :: forall p r. (Fractional r, Ord r) => Point 2 r -> ConvexPolygon p r -> PointLocationResult
+ Data.Geometry.Polygon.Convex: isConvex :: (Ord r, Num r) => SimplePolygon p r -> Bool
+ Data.Geometry.Polygon.Convex: randomConvex :: RandomGen g => Int -> Int -> Rand g (ConvexPolygon () Rational)
+ Data.Geometry.Polygon.Convex: verifyConvex :: (Ord r, Num r) => ConvexPolygon p r -> Bool
+ Data.Geometry.Polygon.Inflate: Arc :: Point 2 r -> (Point 2 r, Point 2 r) -> Arc r
+ Data.Geometry.Polygon.Inflate: [arcCenter] :: Arc r -> Point 2 r
+ Data.Geometry.Polygon.Inflate: [arcEdge] :: Arc r -> (Point 2 r, Point 2 r)
+ Data.Geometry.Polygon.Inflate: data Arc r
+ Data.Geometry.Polygon.Inflate: inflate :: (Real r, Fractional r) => Double -> SimplePolygon () r -> SimplePolygon (Arc r) r
+ Data.Geometry.Polygon.Inflate: instance GHC.Show.Show r => GHC.Show.Show (Data.Geometry.Polygon.Inflate.Arc r)
+ Data.Geometry.Polygon.Monotone: isMonotone :: (Fractional r, Ord r) => Vector 2 r -> SimplePolygon p r -> Bool
+ Data.Geometry.Polygon.Monotone: monotoneFrom :: (Ord r, Num r) => Vector 2 r -> [Point 2 r] -> SimplePolygon () r
+ Data.Geometry.Polygon.Monotone: randomMonotone :: (RandomGen g, Random r, Ord r, Num r) => Int -> Rand g (SimplePolygon () r)
+ Data.Geometry.Polygon.Monotone: randomMonotoneDirected :: (RandomGen g, Random r, Ord r, Num r) => Int -> Vector 2 r -> Rand g (SimplePolygon () r)
+ Data.Geometry.Polygon.Monotone: randomNonZeroVector :: (RandomGen g, Random r, Eq r, Num r) => Rand g (Vector 2 r)
+ Data.Geometry.RangeTree: instance (1 GHC.TypeNats.<= d, i GHC.TypeNats.<= d, Data.Geometry.RangeTree.Query (i GHC.TypeNats.- 1) d, Data.Geometry.Vector.VectorFamily.Arity d, i GHC.Types.~ 2) => Data.Geometry.RangeTree.Query 2 d
+ Data.Geometry.RangeTree: instance forall k1 k2 r p (d :: GHC.Types.Nat) (i :: k1) (v :: k2). (GHC.Classes.Eq r, GHC.Classes.Eq p, Data.Geometry.Vector.VectorFamily.Arity d) => GHC.Classes.Eq (Data.Geometry.RangeTree.Leaf i d v p r)
+ Data.Geometry.RangeTree: instance forall k1 k2 r p (d :: GHC.Types.Nat) (i :: k1) (v :: k2). (GHC.Show.Show r, GHC.Show.Show p, Data.Geometry.Vector.VectorFamily.Arity d) => GHC.Show.Show (Data.Geometry.RangeTree.Leaf i d v p r)
+ Data.Geometry.Slab: instance (GHC.Real.Fractional r, GHC.Classes.Ord r, Data.Geometry.Slab.HasBoundingLines o) => Data.Intersection.IsIntersectableWith (Data.Geometry.LineSegment.Internal.LineSegment 2 a r) (Data.Geometry.Slab.Slab o a r)
+ Data.Geometry.Triangle: inTriangleRelaxed :: (Ord r, Num r) => Point 2 r -> Triangle 2 p r -> PointLocationResult
+ Data.Geometry.Triangle: instance (Data.Geometry.Vector.VectorFamily.Arity d, GHC.Classes.Ord r) => Data.Geometry.Box.Internal.IsBoxable (Data.Geometry.Triangle.Triangle d p r)
+ Data.Geometry.Triangle: onTriangleRelaxed :: (Ord r, Num r) => Point 2 r -> Triangle 2 p r -> Bool
+ Data.Geometry.Vector: instance Data.Geometry.Vector.VectorFamily.Arity d => Test.QuickCheck.Arbitrary.Arbitrary1 (Data.Geometry.Vector.VectorFamily.Vector d)
+ Data.Geometry.Vector: sameDirection :: (Eq r, Num r, Arity d) => Vector d r -> Vector d r -> Bool
+ Data.Geometry.Vector.VectorFamily: instance (GHC.Show.Show r, Data.Geometry.Vector.VectorFamily.Arity d) => GHC.Show.Show (Data.Geometry.Vector.VectorFamily.Vector d r)
+ Data.Geometry.Vector.VectorFamily: instance Data.Geometry.Vector.VectorFamily.Arity d => Data.Functor.Classes.Eq1 (Data.Geometry.Vector.VectorFamily.Vector d)
+ Data.Geometry.Vector.VectorFamily: instance Data.Geometry.Vector.VectorFamily.Arity d => Data.Functor.Classes.Read1 (Data.Geometry.Vector.VectorFamily.Vector d)
+ Data.Geometry.Vector.VectorFamily: instance Data.Geometry.Vector.VectorFamily.Arity d => Data.Functor.Classes.Show1 (Data.Geometry.Vector.VectorFamily.Vector d)
+ Data.Geometry.Vector.VectorFamily: instance Data.Geometry.Vector.VectorFamily.Arity d => WithIndex.FoldableWithIndex GHC.Types.Int (Data.Geometry.Vector.VectorFamily.Vector d)
+ Data.Geometry.Vector.VectorFamily: instance Data.Geometry.Vector.VectorFamily.Arity d => WithIndex.FunctorWithIndex GHC.Types.Int (Data.Geometry.Vector.VectorFamily.Vector d)
+ Data.Geometry.Vector.VectorFamily: instance Data.Geometry.Vector.VectorFamily.Arity d => WithIndex.TraversableWithIndex GHC.Types.Int (Data.Geometry.Vector.VectorFamily.Vector d)
+ Data.Geometry.Vector.VectorFamilyPeano: instance Data.Geometry.Vector.VectorFamilyPeano.ImplicitArity d => Data.Functor.Classes.Eq1 (Data.Geometry.Vector.VectorFamilyPeano.VectorFamily d)
+ Data.Geometry.Vector.VectorFixed: instance Data.Vector.Fixed.Cont.Arity d => Data.Functor.Classes.Eq1 (Data.Geometry.Vector.VectorFixed.Vector d)
+ Data.Geometry.VerticalRayShooting.PersistentSweep: VerticalRayShootingStructure :: r -> Vector (r :+ StatusStructure p e r) -> VerticalRayShootingStructure p e r
+ Data.Geometry.VerticalRayShooting.PersistentSweep: data VerticalRayShootingStructure p e r
+ Data.Geometry.VerticalRayShooting.PersistentSweep: findSlab :: Ord r => Point 2 r -> VerticalRayShootingStructure p e r -> Maybe (StatusStructure p e r)
+ Data.Geometry.VerticalRayShooting.PersistentSweep: instance (GHC.Classes.Eq r, GHC.Classes.Eq p, GHC.Classes.Eq e) => GHC.Classes.Eq (Data.Geometry.VerticalRayShooting.PersistentSweep.VerticalRayShootingStructure p e r)
+ Data.Geometry.VerticalRayShooting.PersistentSweep: instance (GHC.Show.Show r, GHC.Show.Show p, GHC.Show.Show e) => GHC.Show.Show (Data.Geometry.VerticalRayShooting.PersistentSweep.VerticalRayShootingStructure p e r)
+ Data.Geometry.VerticalRayShooting.PersistentSweep: instance GHC.Classes.Eq a => GHC.Classes.Eq (Data.Geometry.VerticalRayShooting.PersistentSweep.Action a)
+ Data.Geometry.VerticalRayShooting.PersistentSweep: instance GHC.Show.Show a => GHC.Show.Show (Data.Geometry.VerticalRayShooting.PersistentSweep.Action a)
+ Data.Geometry.VerticalRayShooting.PersistentSweep: leftMost :: forall p_a2Sdd e_a2Sde r_a2Sdf. Getter (VerticalRayShootingStructure p_a2Sdd e_a2Sde r_a2Sdf) r_a2Sdf
+ Data.Geometry.VerticalRayShooting.PersistentSweep: lookupAbove :: (Ord r, Num r) => Point 2 r -> StatusStructure p e r -> Maybe (LineSegment 2 p r :+ e)
+ Data.Geometry.VerticalRayShooting.PersistentSweep: lookupAboveOrOn :: (Ord r, Num r) => Point 2 r -> StatusStructure p e r -> Maybe (LineSegment 2 p r :+ e)
+ Data.Geometry.VerticalRayShooting.PersistentSweep: ordAt :: (Fractional r, Ord r) => r -> Compare (LineSegment 2 p r :+ e)
+ Data.Geometry.VerticalRayShooting.PersistentSweep: searchInSlab :: Num r => (Line 2 r -> Bool) -> StatusStructure p e r -> Maybe (LineSegment 2 p r :+ e)
+ Data.Geometry.VerticalRayShooting.PersistentSweep: segmentAbove :: (Ord r, Num r) => Point 2 r -> VerticalRayShootingStructure p e r -> Maybe (LineSegment 2 p r :+ e)
+ Data.Geometry.VerticalRayShooting.PersistentSweep: segmentAboveOrOn :: (Ord r, Num r) => Point 2 r -> VerticalRayShootingStructure p e r -> Maybe (LineSegment 2 p r :+ e)
+ Data.Geometry.VerticalRayShooting.PersistentSweep: sweepStruct :: forall p_a2Sdd e_a2Sde r_a2Sdf. Getter (VerticalRayShootingStructure p_a2Sdd e_a2Sde r_a2Sdf) (Vector ((:+) r_a2Sdf (StatusStructure p_a2Sdd e_a2Sde r_a2Sdf)))
+ Data.Geometry.VerticalRayShooting.PersistentSweep: type StatusStructure p e r = Set (LineSegment 2 p r :+ e)
+ Data.Geometry.VerticalRayShooting.PersistentSweep: verticalRayShootingStructure :: (Ord r, Fractional r, Foldable1 t) => t (LineSegment 2 p r :+ e) -> VerticalRayShootingStructure p e r
+ Data.Geometry.VerticalRayShooting.PersistentSweep: yCoordAt :: (Fractional r, Ord r) => r -> (LineSegment 2 p r :+ e) -> r
+ Data.PlaneGraph: data Dart (s :: k)
+ Data.PlaneGraph: data PlanarGraph (s :: k) (w :: World) v e f
+ Data.PlaneGraph: newtype FaceId (s :: k) (w :: World)
+ Data.PlaneGraph: newtype VertexId (s :: k) (w :: World)
+ Data.PlaneGraph.Core: data Dart (s :: k)
+ Data.PlaneGraph.Core: data PlanarGraph (s :: k) (w :: World) v e f
+ Data.PlaneGraph.Core: newtype FaceId (s :: k) (w :: World)
+ Data.PlaneGraph.Core: newtype VertexId (s :: k) (w :: World)
- Algorithms.Geometry.DelaunayTriangulation.Types: neighbours :: forall p_a3yrK r_a3yrL. Lens' (Triangulation p_a3yrK r_a3yrL) (Vector (CList VertexID))
+ Algorithms.Geometry.DelaunayTriangulation.Types: neighbours :: Lens' (Triangulation p r) (Vector (CList VertexID))
- Algorithms.Geometry.DelaunayTriangulation.Types: positions :: forall p_a3yrK r_a3yrL p_a3ywF. Lens (Triangulation p_a3yrK r_a3yrL) (Triangulation p_a3ywF r_a3yrL) (Vector ((:+) (Point 2 r_a3yrL) p_a3yrK)) (Vector ((:+) (Point 2 r_a3yrL) p_a3ywF))
+ Algorithms.Geometry.DelaunayTriangulation.Types: positions :: Lens (Triangulation p1 r) (Triangulation p2 r) (Vector (Point 2 r :+ p1)) (Vector (Point 2 r :+ p2))
- Algorithms.Geometry.DelaunayTriangulation.Types: vertexIds :: forall p_a3yrK r_a3yrL. Lens' (Triangulation p_a3yrK r_a3yrL) (Map (Point 2 r_a3yrL) VertexID)
+ Algorithms.Geometry.DelaunayTriangulation.Types: vertexIds :: Lens' (Triangulation p r) (Map (Point 2 r) VertexID)
- Algorithms.Geometry.LinearProgramming.Types: _NoSolution :: forall d_a2O97 r_a2O98. Prism' (LPSolution d_a2O97 r_a2O98) ()
+ Algorithms.Geometry.LinearProgramming.Types: _NoSolution :: forall d_a2Eg4 r_a2Eg5. Prism' (LPSolution d_a2Eg4 r_a2Eg5) ()
- Algorithms.Geometry.LinearProgramming.Types: _Single :: forall d_a2O97 r_a2O98. Prism' (LPSolution d_a2O97 r_a2O98) (Point d_a2O97 r_a2O98)
+ Algorithms.Geometry.LinearProgramming.Types: _Single :: forall d_a2Eg4 r_a2Eg5. Prism' (LPSolution d_a2Eg4 r_a2Eg5) (Point d_a2Eg4 r_a2Eg5)
- Algorithms.Geometry.LinearProgramming.Types: _UnBounded :: forall d_a2O97 r_a2O98. Prism' (LPSolution d_a2O97 r_a2O98) (HalfLine d_a2O97 r_a2O98)
+ Algorithms.Geometry.LinearProgramming.Types: _UnBounded :: forall d_a2Eg4 r_a2Eg5. Prism' (LPSolution d_a2Eg4 r_a2Eg5) (HalfLine d_a2Eg4 r_a2Eg5)
- Algorithms.Geometry.LinearProgramming.Types: constraints :: forall d_a2Oaq r_a2Oar. Lens' (LinearProgram d_a2Oaq r_a2Oar) [HalfSpace d_a2Oaq r_a2Oar]
+ Algorithms.Geometry.LinearProgramming.Types: constraints :: forall d_a2Ehg r_a2Ehh. Lens' (LinearProgram d_a2Ehg r_a2Ehh) [HalfSpace d_a2Ehg r_a2Ehh]
- Algorithms.Geometry.LinearProgramming.Types: objective :: forall d_a2Oaq r_a2Oar. Lens' (LinearProgram d_a2Oaq r_a2Oar) (Vector d_a2Oaq r_a2Oar)
+ Algorithms.Geometry.LinearProgramming.Types: objective :: forall d_a2Ehg r_a2Ehh. Lens' (LinearProgram d_a2Ehg r_a2Ehh) (Vector d_a2Ehg r_a2Ehh)
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: bBox :: forall d_a2JkP r_a2JkQ a_a2JkR d_a2JpH r_a2JpI. Lens (NodeData d_a2JkP r_a2JkQ a_a2JkR) (NodeData d_a2JpH r_a2JpI a_a2JkR) (Box d_a2JkP () r_a2JkQ) (Box d_a2JpH () r_a2JpI)
+ Algorithms.Geometry.WellSeparatedPairDecomposition.Types: bBox :: forall d_a2zOP r_a2zOQ a_a2zOR d_a2zTw r_a2zTx. Lens (NodeData d_a2zOP r_a2zOQ a_a2zOR) (NodeData d_a2zTw r_a2zTx a_a2zOR) (Box d_a2zOP () r_a2zOQ) (Box d_a2zTw () r_a2zTx)
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: leftPart :: forall d_a2JBS r_a2JBT p_a2JBU. Lens' (FindAndCompact d_a2JBS r_a2JBT p_a2JBU) (Seq ((:+) (Point d_a2JBS r_a2JBT) p_a2JBU))
+ Algorithms.Geometry.WellSeparatedPairDecomposition.Types: leftPart :: forall d_a2A5J r_a2A5K p_a2A5L. Lens' (FindAndCompact d_a2A5J r_a2A5K p_a2A5L) (Seq ((:+) (Point d_a2A5J r_a2A5K) p_a2A5L))
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: nodeData :: forall d_a2JkP r_a2JkQ a_a2JkR a_a2JpJ. Lens (NodeData d_a2JkP r_a2JkQ a_a2JkR) (NodeData d_a2JkP r_a2JkQ a_a2JpJ) a_a2JkR a_a2JpJ
+ Algorithms.Geometry.WellSeparatedPairDecomposition.Types: nodeData :: forall d_a2zOP r_a2zOQ a_a2zOR a_a2zTy. Lens (NodeData d_a2zOP r_a2zOQ a_a2zOR) (NodeData d_a2zOP r_a2zOQ a_a2zTy) a_a2zOR a_a2zTy
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: rightPart :: forall d_a2JBS r_a2JBT p_a2JBU. Lens' (FindAndCompact d_a2JBS r_a2JBT p_a2JBU) (Seq ((:+) (Point d_a2JBS r_a2JBT) p_a2JBU))
+ Algorithms.Geometry.WellSeparatedPairDecomposition.Types: rightPart :: forall d_a2A5J r_a2A5K p_a2A5L. Lens' (FindAndCompact d_a2A5J r_a2A5K p_a2A5L) (Seq ((:+) (Point d_a2A5J r_a2A5K) p_a2A5L))
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: shortSide :: forall d_a2JBS r_a2JBT p_a2JBU. Lens' (FindAndCompact d_a2JBS r_a2JBT p_a2JBU) ShortSide
+ Algorithms.Geometry.WellSeparatedPairDecomposition.Types: shortSide :: forall d_a2A5J r_a2A5K p_a2A5L. Lens' (FindAndCompact d_a2A5J r_a2A5K p_a2A5L) ShortSide
- Algorithms.Geometry.WellSeparatedPairDecomposition.Types: splitDim :: forall d_a2JkP r_a2JkQ a_a2JkR. Lens' (NodeData d_a2JkP r_a2JkQ a_a2JkR) Int
+ Algorithms.Geometry.WellSeparatedPairDecomposition.Types: splitDim :: forall d_a2zOP r_a2zOQ a_a2zOR. Lens' (NodeData d_a2zOP r_a2zOQ a_a2zOR) Int
- Data.Geometry: C :: C
+ Data.Geometry: C :: C (n :: Nat)
- Data.Geometry: MKVector :: VectorFamily (Peano d) r -> Vector
+ Data.Geometry: MKVector :: VectorFamily (Peano d) r -> Vector (d :: Nat) (r :: *)
- Data.Geometry: [MultiPolygon] :: CSeq (Point 2 r :+ p) -> [Polygon Simple p r] -> Polygon Multi p r
+ Data.Geometry: [MultiPolygon] :: SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon p r
- Data.Geometry: [SimplePolygon] :: CSeq (Point 2 r :+ p) -> Polygon Simple p r
+ Data.Geometry: [SimplePolygon] :: Vertices (Point 2 r :+ p) -> SimplePolygon p r
- Data.Geometry: [_unV] :: Vector -> VectorFamily (Peano d) r
+ Data.Geometry: [_unV] :: Vector (d :: Nat) (r :: *) -> VectorFamily (Peano d) r
- Data.Geometry: _MultiPolygon :: Prism' (Polygon Multi p r) (CSeq (Point 2 r :+ p), [Polygon Simple p r])
+ Data.Geometry: _MultiPolygon :: Prism' (Polygon Multi p r) (Polygon Simple p r, [Polygon Simple p r])
- Data.Geometry: _SimplePolygon :: Prism' (Polygon Simple p r) (CSeq (Point 2 r :+ p))
+ Data.Geometry: _SimplePolygon :: Prism' (Polygon Simple p r) (Vertices (Point 2 r :+ p))
- Data.Geometry: infixl 6 ^-^
+ Data.Geometry: infixl 6 ^+^
- Data.Geometry: isCounterClockwise :: (Eq r, Fractional r) => Polygon t p r -> Bool
+ Data.Geometry: isCounterClockwise :: (Eq r, Num r) => Polygon t p r -> Bool
- Data.Geometry: onBoundary :: (Fractional r, Ord r) => Point 2 r -> Polygon t p r -> Bool
+ Data.Geometry: onBoundary :: (Num r, Ord r) => Point 2 r -> Polygon t p r -> Bool
- Data.Geometry: outerBoundary :: forall t p r. Lens' (Polygon t p r) (CSeq (Point 2 r :+ p))
+ Data.Geometry: outerBoundary :: forall t p r. Lens' (Polygon t p r) (SimplePolygon p r)
- Data.Geometry: outerBoundaryEdges :: Polygon t p r -> CSeq (LineSegment 2 p r)
+ Data.Geometry: outerBoundaryEdges :: Polygon t p r -> CircularVector (LineSegment 2 p r)
- Data.Geometry: outerVertex :: Int -> Lens' (Polygon t p r) (Point 2 r :+ p)
+ Data.Geometry: outerVertex :: Int -> Getter (Polygon t p r) (Point 2 r :+ p)
- Data.Geometry: points :: forall d_a22fG p_a22fH r_a22fI d_a22hP p_a22hQ r_a22hR. Iso (PolyLine d_a22fG p_a22fH r_a22fI) (PolyLine d_a22hP p_a22hQ r_a22hR) (LSeq 2 ((:+) (Point d_a22fG r_a22fI) p_a22fH)) (LSeq 2 ((:+) (Point d_a22hP r_a22hR) p_a22hQ))
+ Data.Geometry: points :: Iso (PolyLine d1 p1 r1) (PolyLine d2 p2 r2) (LSeq 2 (Point d1 r1 :+ p1)) (LSeq 2 (Point d2 r2 :+ p2))
- Data.Geometry: toClockwiseOrder :: (Eq r, Fractional r) => Polygon t p r -> Polygon t p r
+ Data.Geometry: toClockwiseOrder :: (Eq r, Num r) => Polygon t p r -> Polygon t p r
- Data.Geometry: toClockwiseOrder' :: (Eq r, Fractional r) => Polygon t p r -> Polygon t p r
+ Data.Geometry: toClockwiseOrder' :: (Eq r, Num r) => Polygon t p r -> Polygon t p r
- Data.Geometry: toCounterClockWiseOrder :: (Eq r, Fractional r) => Polygon t p r -> Polygon t p r
+ Data.Geometry: toCounterClockWiseOrder :: (Eq r, Num r) => Polygon t p r -> Polygon t p r
- Data.Geometry: toCounterClockWiseOrder' :: (Eq r, Fractional r) => Polygon t p r -> Polygon t p r
+ Data.Geometry: toCounterClockWiseOrder' :: (Eq r, Num r) => Polygon t p r -> Polygon t p r
- Data.Geometry: unV :: Lens (Vector d r) (Vector d s) (VectorFamily (Peano d) r) (VectorFamily (Peano d) s)
+ Data.Geometry: unV :: Iso (Vector d r) (Vector d s) (VectorFamily (Peano d) r) (VectorFamily (Peano d) s)
- Data.Geometry.Arrangement: boundedArea :: forall s_a3nHW l_a3nHX v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1. Lens' (Arrangement s_a3nHW l_a3nHX v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1) (Rectangle () r_a3nI1)
+ Data.Geometry.Arrangement: boundedArea :: forall k_a3n3p (s_a3n2V :: k_a3n3p) l_a3n2W v_a3n2X e_a3n2Y f_a3n2Z r_a3n30. Lens' (Arrangement (s_a3n2V :: k_a3n3p) l_a3n2W v_a3n2X e_a3n2Y f_a3n2Z r_a3n30) (Rectangle () r_a3n30)
- Data.Geometry.Arrangement: inputLines :: forall s_a3nHW l_a3nHX v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1. Lens' (Arrangement s_a3nHW l_a3nHX v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1) (Vector ((:+) (Line 2 r_a3nI1) l_a3nHX))
+ Data.Geometry.Arrangement: inputLines :: forall k_a3n3p (s_a3n2V :: k_a3n3p) l_a3n2W v_a3n2X e_a3n2Y f_a3n2Z r_a3n30. Lens' (Arrangement (s_a3n2V :: k_a3n3p) l_a3n2W v_a3n2X e_a3n2Y f_a3n2Z r_a3n30) (Vector ((:+) (Line 2 r_a3n30) l_a3n2W))
- Data.Geometry.Arrangement: subdivision :: forall s_a3nHW l_a3nHX v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1 v_a3nPK e_a3nPL f_a3nPM. Lens (Arrangement s_a3nHW l_a3nHX v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1) (Arrangement s_a3nHW l_a3nHX v_a3nPK e_a3nPL f_a3nPM r_a3nI1) (PlanarSubdivision s_a3nHW v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1) (PlanarSubdivision s_a3nHW v_a3nPK e_a3nPL f_a3nPM r_a3nI1)
+ Data.Geometry.Arrangement: subdivision :: forall k_a3n3p (s_a3n2V :: k_a3n3p) l_a3n2W v_a3n2X e_a3n2Y f_a3n2Z r_a3n30 v_a3naC e_a3naD f_a3naE. Lens (Arrangement (s_a3n2V :: k_a3n3p) l_a3n2W v_a3n2X e_a3n2Y f_a3n2Z r_a3n30) (Arrangement (s_a3n2V :: k_a3n3p) l_a3n2W v_a3naC e_a3naD f_a3naE r_a3n30) (PlanarSubdivision s_a3n2V v_a3n2X e_a3n2Y f_a3n2Z r_a3n30) (PlanarSubdivision s_a3n2V v_a3naC e_a3naD f_a3naE r_a3n30)
- Data.Geometry.Arrangement: unboundedIntersections :: forall s_a3nHW l_a3nHX v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1. Lens' (Arrangement s_a3nHW l_a3nHX v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1) (ArrangementBoundary s_a3nHW l_a3nHX r_a3nI1)
+ Data.Geometry.Arrangement: unboundedIntersections :: forall k_a3n3p (s_a3n2V :: k_a3n3p) l_a3n2W v_a3n2X e_a3n2Y f_a3n2Z r_a3n30. Lens' (Arrangement (s_a3n2V :: k_a3n3p) l_a3n2W v_a3n2X e_a3n2Y f_a3n2Z r_a3n30) (ArrangementBoundary s_a3n2V l_a3n2W r_a3n30)
- Data.Geometry.Arrangement.Internal: boundedArea :: forall s_a3nHW l_a3nHX v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1. Lens' (Arrangement s_a3nHW l_a3nHX v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1) (Rectangle () r_a3nI1)
+ Data.Geometry.Arrangement.Internal: boundedArea :: forall k_a3n3p (s_a3n2V :: k_a3n3p) l_a3n2W v_a3n2X e_a3n2Y f_a3n2Z r_a3n30. Lens' (Arrangement (s_a3n2V :: k_a3n3p) l_a3n2W v_a3n2X e_a3n2Y f_a3n2Z r_a3n30) (Rectangle () r_a3n30)
- Data.Geometry.Arrangement.Internal: inputLines :: forall s_a3nHW l_a3nHX v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1. Lens' (Arrangement s_a3nHW l_a3nHX v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1) (Vector ((:+) (Line 2 r_a3nI1) l_a3nHX))
+ Data.Geometry.Arrangement.Internal: inputLines :: forall k_a3n3p (s_a3n2V :: k_a3n3p) l_a3n2W v_a3n2X e_a3n2Y f_a3n2Z r_a3n30. Lens' (Arrangement (s_a3n2V :: k_a3n3p) l_a3n2W v_a3n2X e_a3n2Y f_a3n2Z r_a3n30) (Vector ((:+) (Line 2 r_a3n30) l_a3n2W))
- Data.Geometry.Arrangement.Internal: subdivision :: forall s_a3nHW l_a3nHX v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1 v_a3nPK e_a3nPL f_a3nPM. Lens (Arrangement s_a3nHW l_a3nHX v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1) (Arrangement s_a3nHW l_a3nHX v_a3nPK e_a3nPL f_a3nPM r_a3nI1) (PlanarSubdivision s_a3nHW v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1) (PlanarSubdivision s_a3nHW v_a3nPK e_a3nPL f_a3nPM r_a3nI1)
+ Data.Geometry.Arrangement.Internal: subdivision :: forall k_a3n3p (s_a3n2V :: k_a3n3p) l_a3n2W v_a3n2X e_a3n2Y f_a3n2Z r_a3n30 v_a3naC e_a3naD f_a3naE. Lens (Arrangement (s_a3n2V :: k_a3n3p) l_a3n2W v_a3n2X e_a3n2Y f_a3n2Z r_a3n30) (Arrangement (s_a3n2V :: k_a3n3p) l_a3n2W v_a3naC e_a3naD f_a3naE r_a3n30) (PlanarSubdivision s_a3n2V v_a3n2X e_a3n2Y f_a3n2Z r_a3n30) (PlanarSubdivision s_a3n2V v_a3naC e_a3naD f_a3naE r_a3n30)
- Data.Geometry.Arrangement.Internal: unboundedIntersections :: forall s_a3nHW l_a3nHX v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1. Lens' (Arrangement s_a3nHW l_a3nHX v_a3nHY e_a3nHZ f_a3nI0 r_a3nI1) (ArrangementBoundary s_a3nHW l_a3nHX r_a3nI1)
+ Data.Geometry.Arrangement.Internal: unboundedIntersections :: forall k_a3n3p (s_a3n2V :: k_a3n3p) l_a3n2W v_a3n2X e_a3n2Y f_a3n2Z r_a3n30. Lens' (Arrangement (s_a3n2V :: k_a3n3p) l_a3n2W v_a3n2X e_a3n2Y f_a3n2Z r_a3n30) (ArrangementBoundary s_a3n2V l_a3n2W r_a3n30)
- Data.Geometry.Ball: center :: forall d_a2mAY p_a2mAZ r_a2mB0 d_a2mDG p_a2mDH. Lens (Ball d_a2mAY p_a2mAZ r_a2mB0) (Ball d_a2mDG p_a2mDH r_a2mB0) ((:+) (Point d_a2mAY r_a2mB0) p_a2mAZ) ((:+) (Point d_a2mDG r_a2mB0) p_a2mDH)
+ Data.Geometry.Ball: center :: forall d_a2auB p_a2auC r_a2auD d_a2axf p_a2axg. Lens (Ball d_a2auB p_a2auC r_a2auD) (Ball d_a2axf p_a2axg r_a2auD) ((:+) (Point d_a2auB r_a2auD) p_a2auC) ((:+) (Point d_a2axf r_a2auD) p_a2axg)
- Data.Geometry.Ball: squaredRadius :: forall d_a2mAY p_a2mAZ r_a2mB0. Lens' (Ball d_a2mAY p_a2mAZ r_a2mB0) r_a2mB0
+ Data.Geometry.Ball: squaredRadius :: forall d_a2auB p_a2auC r_a2auD. Lens' (Ball d_a2auB p_a2auC r_a2auD) r_a2auD
- Data.Geometry.BezierSpline: controlPoints :: forall n_a2jaG d_a2jaH r_a2jaI n_a2jbq d_a2jbr r_a2jbs. Iso (BezierSpline n_a2jaG d_a2jaH r_a2jaI) (BezierSpline n_a2jbq d_a2jbr r_a2jbs) (LSeq ((+) 1 n_a2jaG) (Point d_a2jaH r_a2jaI)) (LSeq ((+) 1 n_a2jbq) (Point d_a2jbr r_a2jbs))
+ Data.Geometry.BezierSpline: controlPoints :: Iso (BezierSpline n1 d1 r1) (BezierSpline n2 d2 r2) (LSeq (1 + n1) (Point d1 r1)) (LSeq (1 + n2) (Point d2 r2))
- Data.Geometry.Box.Corners: northEast :: forall a_a1OzZ. Lens' (Corners a_a1OzZ) a_a1OzZ
+ Data.Geometry.Box.Corners: northEast :: forall a_a1CJS. Lens' (Corners a_a1CJS) a_a1CJS
- Data.Geometry.Box.Corners: northWest :: forall a_a1OzZ. Lens' (Corners a_a1OzZ) a_a1OzZ
+ Data.Geometry.Box.Corners: northWest :: forall a_a1CJS. Lens' (Corners a_a1CJS) a_a1CJS
- Data.Geometry.Box.Corners: southEast :: forall a_a1OzZ. Lens' (Corners a_a1OzZ) a_a1OzZ
+ Data.Geometry.Box.Corners: southEast :: forall a_a1CJS. Lens' (Corners a_a1CJS) a_a1CJS
- Data.Geometry.Box.Corners: southWest :: forall a_a1OzZ. Lens' (Corners a_a1OzZ) a_a1OzZ
+ Data.Geometry.Box.Corners: southWest :: forall a_a1CJS. Lens' (Corners a_a1CJS) a_a1CJS
- Data.Geometry.Box.Internal: cwMax :: forall a_a1xgn a_a1xxm. Iso (CWMax a_a1xgn) (CWMax a_a1xxm) a_a1xgn a_a1xxm
+ Data.Geometry.Box.Internal: cwMax :: forall a_a1jRy a_a1k8H. Iso (CWMax a_a1jRy) (CWMax a_a1k8H) a_a1jRy a_a1k8H
- Data.Geometry.Box.Internal: cwMin :: forall a_a1x1y a_a1xgh. Iso (CWMin a_a1x1y) (CWMin a_a1xgh) a_a1x1y a_a1xgh
+ Data.Geometry.Box.Internal: cwMin :: forall a_a1jCx a_a1jRs. Iso (CWMin a_a1jCx) (CWMin a_a1jRs) a_a1jCx a_a1jRs
- Data.Geometry.Box.Internal: maxP :: forall d_a1xxt p_a1xxu r_a1xxv. Lens' (Box d_a1xxt p_a1xxu r_a1xxv) ((:+) (CWMax (Point d_a1xxt r_a1xxv)) p_a1xxu)
+ Data.Geometry.Box.Internal: maxP :: forall d_a1k8O p_a1k8P r_a1k8Q. Lens' (Box d_a1k8O p_a1k8P r_a1k8Q) ((:+) (CWMax (Point d_a1k8O r_a1k8Q)) p_a1k8P)
- Data.Geometry.Box.Internal: minP :: forall d_a1xxt p_a1xxu r_a1xxv. Lens' (Box d_a1xxt p_a1xxu r_a1xxv) ((:+) (CWMin (Point d_a1xxt r_a1xxv)) p_a1xxu)
+ Data.Geometry.Box.Internal: minP :: forall d_a1k8O p_a1k8P r_a1k8Q. Lens' (Box d_a1k8O p_a1k8P r_a1k8Q) ((:+) (CWMin (Point d_a1k8O r_a1k8Q)) p_a1k8P)
- Data.Geometry.Box.Sides: east :: forall a_a1R1A. Lens' (Sides a_a1R1A) a_a1R1A
+ Data.Geometry.Box.Sides: east :: forall a_a1Fa7. Lens' (Sides a_a1Fa7) a_a1Fa7
- Data.Geometry.Box.Sides: north :: forall a_a1R1A. Lens' (Sides a_a1R1A) a_a1R1A
+ Data.Geometry.Box.Sides: north :: forall a_a1Fa7. Lens' (Sides a_a1Fa7) a_a1Fa7
- Data.Geometry.Box.Sides: south :: forall a_a1R1A. Lens' (Sides a_a1R1A) a_a1R1A
+ Data.Geometry.Box.Sides: south :: forall a_a1Fa7. Lens' (Sides a_a1Fa7) a_a1Fa7
- Data.Geometry.Box.Sides: west :: forall a_a1R1A. Lens' (Sides a_a1R1A) a_a1R1A
+ Data.Geometry.Box.Sides: west :: forall a_a1Fa7. Lens' (Sides a_a1Fa7) a_a1Fa7
- Data.Geometry.Ellipse: affineTransformation :: forall r_a2FNO r_a2GfJ. Iso (Ellipse r_a2FNO) (Ellipse r_a2GfJ) (Transformation 2 r_a2FNO) (Transformation 2 r_a2GfJ)
+ Data.Geometry.Ellipse: affineTransformation :: forall r_a2wmL r_a2wPr. Iso (Ellipse r_a2wmL) (Ellipse r_a2wPr) (Transformation 2 r_a2wmL) (Transformation 2 r_a2wPr)
- Data.Geometry.HalfLine: halfLineDirection :: forall d_a2dr4 r_a2dr5. Lens' (HalfLine d_a2dr4 r_a2dr5) (Vector d_a2dr4 r_a2dr5)
+ Data.Geometry.HalfLine: halfLineDirection :: forall d_a22jd r_a22je. Lens' (HalfLine d_a22jd r_a22je) (Vector d_a22jd r_a22je)
- Data.Geometry.HalfLine: startPoint :: forall d_a2dr4 r_a2dr5. Lens' (HalfLine d_a2dr4 r_a2dr5) (Point d_a2dr4 r_a2dr5)
+ Data.Geometry.HalfLine: startPoint :: forall d_a22jd r_a22je. Lens' (HalfLine d_a22jd r_a22je) (Point d_a22jd r_a22je)
- Data.Geometry.HalfSpace: boundingPlane :: forall d_a2fS6 r_a2fS7 d_a2fU3 r_a2fU4. Iso (HalfSpace d_a2fS6 r_a2fS7) (HalfSpace d_a2fU3 r_a2fU4) (HyperPlane d_a2fS6 r_a2fS7) (HyperPlane d_a2fU3 r_a2fU4)
+ Data.Geometry.HalfSpace: boundingPlane :: forall d_a27iP r_a27iQ d_a27kI r_a27kJ. Iso (HalfSpace d_a27iP r_a27iQ) (HalfSpace d_a27kI r_a27kJ) (HyperPlane d_a27iP r_a27iQ) (HyperPlane d_a27kI r_a27kJ)
- Data.Geometry.HyperPlane: HyperPlane :: !Point d r -> !Vector d r -> HyperPlane
+ Data.Geometry.HyperPlane: HyperPlane :: !Point d r -> !Vector d r -> HyperPlane (d :: Nat) (r :: *)
- Data.Geometry.HyperPlane: [_inPlane] :: HyperPlane -> !Point d r
+ Data.Geometry.HyperPlane: [_inPlane] :: HyperPlane (d :: Nat) (r :: *) -> !Point d r
- Data.Geometry.HyperPlane: [_normalVec] :: HyperPlane -> !Vector d r
+ Data.Geometry.HyperPlane: [_normalVec] :: HyperPlane (d :: Nat) (r :: *) -> !Vector d r
- Data.Geometry.HyperPlane: inPlane :: forall d_a2alM r_a2alN. Lens' (HyperPlane d_a2alM r_a2alN) (Point d_a2alM r_a2alN)
+ Data.Geometry.HyperPlane: inPlane :: forall d_a1Yoc r_a1Yod. Lens' (HyperPlane d_a1Yoc r_a1Yod) (Point d_a1Yoc r_a1Yod)
- Data.Geometry.HyperPlane: normalVec :: forall d_a2alM r_a2alN. Lens' (HyperPlane d_a2alM r_a2alN) (Vector d_a2alM r_a2alN)
+ Data.Geometry.HyperPlane: normalVec :: forall d_a1Yoc r_a1Yod. Lens' (HyperPlane d_a1Yoc r_a1Yod) (Vector d_a1Yoc r_a1Yod)
- Data.Geometry.Interval: _Range :: Lens' (Interval a r) (Range (r :+ a))
+ Data.Geometry.Interval: _Range :: Iso' (Interval a r) (Range (r :+ a))
- Data.Geometry.Interval.Util: unL :: forall r_avvf r_awrF. Iso (L r_avvf) (L r_awrF) (EndPoint r_avvf) (EndPoint r_awrF)
+ Data.Geometry.Interval.Util: unL :: forall r_algX r_alKv. Iso (L r_algX) (L r_alKv) (EndPoint r_algX) (EndPoint r_alKv)
- Data.Geometry.Interval.Util: unR :: forall r_awrL r_awGg. Iso (R r_awrL) (R r_awGg) (EndPoint r_awrL) (EndPoint r_awGg)
+ Data.Geometry.Interval.Util: unR :: forall r_alKB r_alXu. Iso (R r_alKB) (R r_alXu) (EndPoint r_alKB) (EndPoint r_alXu)
- Data.Geometry.IntervalTree: intervalsLeft :: forall i_aAf8 r_aAf9. Lens' (NodeData i_aAf8 r_aAf9) (Map (L r_aAf9) [i_aAf8])
+ Data.Geometry.IntervalTree: intervalsLeft :: forall i_aoYQ r_aoYR. Lens' (NodeData i_aoYQ r_aoYR) (Map (L r_aoYR) [i_aoYQ])
- Data.Geometry.IntervalTree: intervalsRight :: forall i_aAf8 r_aAf9. Lens' (NodeData i_aAf8 r_aAf9) (Map (R r_aAf9) [i_aAf8])
+ Data.Geometry.IntervalTree: intervalsRight :: forall i_aoYQ r_aoYR. Lens' (NodeData i_aoYQ r_aoYR) (Map (R r_aoYR) [i_aoYQ])
- Data.Geometry.IntervalTree: splitPoint :: forall i_aAf8 r_aAf9. Lens' (NodeData i_aAf8 r_aAf9) r_aAf9
+ Data.Geometry.IntervalTree: splitPoint :: forall i_aoYQ r_aoYR. Lens' (NodeData i_aoYQ r_aoYR) r_aoYR
- Data.Geometry.IntervalTree: unIntervalTree :: forall i_aAor r_aAos i_aAvA r_aAvB. Iso (IntervalTree i_aAor r_aAos) (IntervalTree i_aAvA r_aAvB) (BinaryTree (NodeData i_aAor r_aAos)) (BinaryTree (NodeData i_aAvA r_aAvB))
+ Data.Geometry.IntervalTree: unIntervalTree :: forall i_ap7S r_ap7T i_apeQ r_apeR. Iso (IntervalTree i_ap7S r_ap7T) (IntervalTree i_apeQ r_apeR) (BinaryTree (NodeData i_ap7S r_ap7T)) (BinaryTree (NodeData i_apeQ r_apeR))
- Data.Geometry.KDTree: Coord :: Int -> Coord
+ Data.Geometry.KDTree: Coord :: Int -> Coord (d :: Nat)
- Data.Geometry.KDTree: [unCoord] :: Coord -> Int
+ Data.Geometry.KDTree: [unCoord] :: Coord (d :: Nat) -> Int
- Data.Geometry.Line.Internal: anchorPoint :: forall d_a1nxr r_a1nxs. Lens' (Line d_a1nxr r_a1nxs) (Point d_a1nxr r_a1nxs)
+ Data.Geometry.Line.Internal: anchorPoint :: Lens' (Line d r) (Point d r)
- Data.Geometry.Line.Internal: direction :: forall d_a1nxr r_a1nxs. Lens' (Line d_a1nxr r_a1nxs) (Vector d_a1nxr r_a1nxs)
+ Data.Geometry.Line.Internal: direction :: Lens' (Line d r) (Vector d r)
- Data.Geometry.LineSegment: _Range :: Lens' (Interval a r) (Range (r :+ a))
+ Data.Geometry.LineSegment: _Range :: Iso' (Interval a r) (Range (r :+ a))
- Data.Geometry.LineSegment: isClosed :: () => EndPoint a -> Bool
+ Data.Geometry.LineSegment: isClosed :: EndPoint a -> Bool
- Data.Geometry.LineSegment: isOpen :: () => EndPoint a -> Bool
+ Data.Geometry.LineSegment: isOpen :: EndPoint a -> Bool
- Data.Geometry.LineSegment: lower :: () => Lens' (Range a) (EndPoint a)
+ Data.Geometry.LineSegment: lower :: Lens' (Range a) (EndPoint a)
- Data.Geometry.LineSegment: unEndPoint :: () => Lens (EndPoint a) (EndPoint b) a b
+ Data.Geometry.LineSegment: unEndPoint :: Lens (EndPoint a) (EndPoint b) a b
- Data.Geometry.LineSegment: upper :: () => Lens' (Range a) (EndPoint a)
+ Data.Geometry.LineSegment: upper :: Lens' (Range a) (EndPoint a)
- Data.Geometry.PlanarSubdivision.Basic: FaceId :: VertexId s (DualOf w) -> FaceId
+ Data.Geometry.PlanarSubdivision.Basic: FaceId :: VertexId s (DualOf w) -> FaceId (s :: k) (w :: World)
- Data.Geometry.PlanarSubdivision.Basic: VertexId :: Int -> VertexId
+ Data.Geometry.PlanarSubdivision.Basic: VertexId :: Int -> VertexId (s :: k) (w :: World)
- Data.Geometry.PlanarSubdivision.Basic: [_unFaceId] :: FaceId -> VertexId s (DualOf w)
+ Data.Geometry.PlanarSubdivision.Basic: [_unFaceId] :: FaceId (s :: k) (w :: World) -> VertexId s (DualOf w)
- Data.Geometry.PlanarSubdivision.Basic: [_unVertexId] :: VertexId -> Int
+ Data.Geometry.PlanarSubdivision.Basic: [_unVertexId] :: VertexId (s :: k) (w :: World) -> Int
- Data.Geometry.PlanarSubdivision.Basic: components :: forall s_a3eQC v_a3eQD e_a3eQE f_a3eQF r_a3eQG r_a3f3S. Lens (PlanarSubdivision s_a3eQC v_a3eQD e_a3eQE f_a3eQF r_a3eQG) (PlanarSubdivision s_a3eQC v_a3eQD e_a3eQE f_a3eQF r_a3f3S) (Vector (Component s_a3eQC r_a3eQG)) (Vector (Component s_a3eQC r_a3f3S))
+ Data.Geometry.PlanarSubdivision.Basic: components :: forall k_a3b3y (s_a3b2U :: k_a3b3y) v_a3b2V e_a3b2W f_a3b2X r_a3b2Y r_a3bg3. Lens (PlanarSubdivision (s_a3b2U :: k_a3b3y) v_a3b2V e_a3b2W f_a3b2X r_a3b2Y) (PlanarSubdivision (s_a3b2U :: k_a3b3y) v_a3b2V e_a3b2W f_a3b2X r_a3bg3) (Vector (Component s_a3b2U r_a3b2Y)) (Vector (Component s_a3b2U r_a3bg3))
- Data.Geometry.PlanarSubdivision.Basic: dual :: () => Getter (PlanarGraph s w v e f) (PlanarGraph s (DualOf w) f e v)
+ Data.Geometry.PlanarSubdivision.Basic: dual :: forall k (s :: k) (w :: World) v e f. Getter (PlanarGraph s w v e f) (PlanarGraph s (DualOf w) f e v)
- Data.Geometry.PlanarSubdivision.Basic: fData :: forall h_a38zf f_a38zg f_a39pF. Lens (FaceData h_a38zf f_a38zg) (FaceData h_a38zf f_a39pF) f_a38zg f_a39pF
+ Data.Geometry.PlanarSubdivision.Basic: fData :: forall h_a34Us f_a34Ut f_a35Gs. Lens (FaceData h_a34Us f_a34Ut) (FaceData h_a34Us f_a35Gs) f_a34Ut f_a35Gs
- Data.Geometry.PlanarSubdivision.Basic: holes :: forall h_a38zf f_a38zg h_a39pG. Lens (FaceData h_a38zf f_a38zg) (FaceData h_a39pG f_a38zg) (Seq h_a38zf) (Seq h_a39pG)
+ Data.Geometry.PlanarSubdivision.Basic: holes :: forall h_a34Us f_a34Ut h_a35Gt. Lens (FaceData h_a34Us f_a34Ut) (FaceData h_a35Gt f_a34Ut) (Seq h_a34Us) (Seq h_a35Gt)
- Data.Geometry.PlanarSubdivision.Basic: location :: forall r_a30z8 v_a30z9 r_a30NV. Lens (VertexData r_a30z8 v_a30z9) (VertexData r_a30NV v_a30z9) (Point 2 r_a30z8) (Point 2 r_a30NV)
+ Data.Geometry.PlanarSubdivision.Basic: location :: forall r_a2Xgg v_a2Xgh r_a2XuU. Lens (VertexData r_a2Xgg v_a2Xgh) (VertexData r_a2XuU v_a2Xgh) (Point 2 r_a2Xgg) (Point 2 r_a2XuU)
- Data.Geometry.PlanarSubdivision.Basic: rawDartData :: forall s_a3eQC v_a3eQD e_a3eQE f_a3eQF r_a3eQG e_a3f3T. Lens (PlanarSubdivision s_a3eQC v_a3eQD e_a3eQE f_a3eQF r_a3eQG) (PlanarSubdivision s_a3eQC v_a3eQD e_a3f3T f_a3eQF r_a3eQG) (Vector (Raw s_a3eQC (Dart (Wrap s_a3eQC)) e_a3eQE)) (Vector (Raw s_a3eQC (Dart (Wrap s_a3eQC)) e_a3f3T))
+ Data.Geometry.PlanarSubdivision.Basic: rawDartData :: forall k_a3b3y (s_a3b2U :: k_a3b3y) v_a3b2V e_a3b2W f_a3b2X r_a3b2Y e_a3bg4. Lens (PlanarSubdivision (s_a3b2U :: k_a3b3y) v_a3b2V e_a3b2W f_a3b2X r_a3b2Y) (PlanarSubdivision (s_a3b2U :: k_a3b3y) v_a3b2V e_a3bg4 f_a3b2X r_a3b2Y) (Vector (Raw s_a3b2U (Dart (Wrap s_a3b2U)) e_a3b2W)) (Vector (Raw s_a3b2U (Dart (Wrap s_a3b2U)) e_a3bg4))
- Data.Geometry.PlanarSubdivision.Basic: rawFaceData :: forall s_a3eQC v_a3eQD e_a3eQE f_a3eQF r_a3eQG f_a3f3U. Lens (PlanarSubdivision s_a3eQC v_a3eQD e_a3eQE f_a3eQF r_a3eQG) (PlanarSubdivision s_a3eQC v_a3eQD e_a3eQE f_a3f3U r_a3eQG) (Vector (RawFace s_a3eQC f_a3eQF)) (Vector (RawFace s_a3eQC f_a3f3U))
+ Data.Geometry.PlanarSubdivision.Basic: rawFaceData :: forall k_a3b3y (s_a3b2U :: k_a3b3y) v_a3b2V e_a3b2W f_a3b2X r_a3b2Y f_a3bg5. Lens (PlanarSubdivision (s_a3b2U :: k_a3b3y) v_a3b2V e_a3b2W f_a3b2X r_a3b2Y) (PlanarSubdivision (s_a3b2U :: k_a3b3y) v_a3b2V e_a3b2W f_a3bg5 r_a3b2Y) (Vector (RawFace s_a3b2U f_a3b2X)) (Vector (RawFace s_a3b2U f_a3bg5))
- Data.Geometry.PlanarSubdivision.Basic: rawVertexData :: forall s_a3eQC v_a3eQD e_a3eQE f_a3eQF r_a3eQG v_a3f3V. Lens (PlanarSubdivision s_a3eQC v_a3eQD e_a3eQE f_a3eQF r_a3eQG) (PlanarSubdivision s_a3eQC v_a3f3V e_a3eQE f_a3eQF r_a3eQG) (Vector (Raw s_a3eQC (VertexId' (Wrap s_a3eQC)) v_a3eQD)) (Vector (Raw s_a3eQC (VertexId' (Wrap s_a3eQC)) v_a3f3V))
+ Data.Geometry.PlanarSubdivision.Basic: rawVertexData :: forall k_a3b3y (s_a3b2U :: k_a3b3y) v_a3b2V e_a3b2W f_a3b2X r_a3b2Y v_a3bg6. Lens (PlanarSubdivision (s_a3b2U :: k_a3b3y) v_a3b2V e_a3b2W f_a3b2X r_a3b2Y) (PlanarSubdivision (s_a3b2U :: k_a3b3y) v_a3bg6 e_a3b2W f_a3b2X r_a3b2Y) (Vector (Raw s_a3b2U (VertexId' (Wrap s_a3b2U)) v_a3b2V)) (Vector (Raw s_a3b2U (VertexId' (Wrap s_a3b2U)) v_a3bg6))
- Data.Geometry.PlanarSubdivision.Basic: twin :: () => Dart s -> Dart s
+ Data.Geometry.PlanarSubdivision.Basic: twin :: forall k (s :: k). Dart s -> Dart s
- Data.Geometry.PlanarSubdivision.Basic: type FaceId' (s :: k) = FaceId s Primal
+ Data.Geometry.PlanarSubdivision.Basic: type FaceId' (s :: k) = FaceId s 'Primal
- Data.Geometry.PlanarSubdivision.Basic: type VertexId' (s :: k) = VertexId s Primal
+ Data.Geometry.PlanarSubdivision.Basic: type VertexId' (s :: k) = VertexId s 'Primal
- Data.Geometry.PlanarSubdivision.Basic: type family DataOf g i :: Type;
+ Data.Geometry.PlanarSubdivision.Basic: type family DataOf g i;
- Data.Geometry.PlanarSubdivision.Basic: vData :: forall r_a30z8 v_a30z9 v_a30NW. Lens (VertexData r_a30z8 v_a30z9) (VertexData r_a30z8 v_a30NW) v_a30z9 v_a30NW
+ Data.Geometry.PlanarSubdivision.Basic: vData :: forall r_a2Xgg v_a2Xgh v_a2XuV. Lens (VertexData r_a2Xgg v_a2Xgh) (VertexData r_a2Xgg v_a2XuV) v_a2Xgh v_a2XuV
- Data.Geometry.PlanarSubdivision.Raw: fData :: forall h_a38zf f_a38zg f_a39pF. Lens (FaceData h_a38zf f_a38zg) (FaceData h_a38zf f_a39pF) f_a38zg f_a39pF
+ Data.Geometry.PlanarSubdivision.Raw: fData :: forall h_a34Us f_a34Ut f_a35Gs. Lens (FaceData h_a34Us f_a34Ut) (FaceData h_a34Us f_a35Gs) f_a34Ut f_a35Gs
- Data.Geometry.PlanarSubdivision.Raw: faceDataVal :: forall s_a39pV f_a39pW f_a39FC. Lens (RawFace s_a39pV f_a39pW) (RawFace s_a39pV f_a39FC) (FaceData (Dart s_a39pV) f_a39pW) (FaceData (Dart s_a39pV) f_a39FC)
+ Data.Geometry.PlanarSubdivision.Raw: faceDataVal :: forall k_a35Hm (s_a35GI :: k_a35Hm) f_a35GJ f_a35Wq. Lens (RawFace (s_a35GI :: k_a35Hm) f_a35GJ) (RawFace (s_a35GI :: k_a35Hm) f_a35Wq) (FaceData (Dart s_a35GI) f_a35GJ) (FaceData (Dart s_a35GI) f_a35Wq)
- Data.Geometry.PlanarSubdivision.Raw: faceIdx :: forall s_a39pV f_a39pW. Lens' (RawFace s_a39pV f_a39pW) (Maybe (ComponentId s_a39pV, FaceId' (Wrap s_a39pV)))
+ Data.Geometry.PlanarSubdivision.Raw: faceIdx :: forall k_a35Hm (s_a35GI :: k_a35Hm) f_a35GJ. Lens' (RawFace (s_a35GI :: k_a35Hm) f_a35GJ) (Maybe (ComponentId s_a35GI, FaceId' (Wrap s_a35GI)))
- Data.Geometry.PlanarSubdivision.Raw: holes :: forall h_a38zf f_a38zg h_a39pG. Lens (FaceData h_a38zf f_a38zg) (FaceData h_a39pG f_a38zg) (Seq h_a38zf) (Seq h_a39pG)
+ Data.Geometry.PlanarSubdivision.Raw: holes :: forall h_a34Us f_a34Ut h_a35Gt. Lens (FaceData h_a34Us f_a34Ut) (FaceData h_a35Gt f_a34Ut) (Seq h_a34Us) (Seq h_a35Gt)
- Data.Geometry.Point: ccwCmpAround :: (Num r, Ord r) => (Point 2 r :+ qc) -> (Point 2 r :+ p) -> (Point 2 r :+ q) -> Ordering
+ Data.Geometry.Point: ccwCmpAround :: (Num r, Ord r) => Point 2 r -> Point 2 r -> Point 2 r -> Ordering
- Data.Geometry.Point: ccwCmpAroundWith :: (Ord r, Num r) => Vector 2 r -> (Point 2 r :+ c) -> (Point 2 r :+ a) -> (Point 2 r :+ b) -> Ordering
+ Data.Geometry.Point: ccwCmpAroundWith :: (Ord r, Num r) => Vector 2 r -> Point 2 r -> Point 2 r -> Point 2 r -> Ordering
- Data.Geometry.Point: cmpByDistanceTo :: (Ord r, Num r, Arity d) => (Point d r :+ c) -> (Point d r :+ p) -> (Point d r :+ q) -> Ordering
+ Data.Geometry.Point: cmpByDistanceTo :: (Ord r, Num r, Arity d) => Point d r -> Point d r -> Point d r -> Ordering
- Data.Geometry.Point: cwCmpAround :: (Num r, Ord r) => (Point 2 r :+ qc) -> (Point 2 r :+ p) -> (Point 2 r :+ q) -> Ordering
+ Data.Geometry.Point: cwCmpAround :: (Num r, Ord r) => Point 2 r -> Point 2 r -> Point 2 r -> Ordering
- Data.Geometry.Point: cwCmpAroundWith :: (Ord r, Num r) => Vector 2 r -> (Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> Ordering
+ Data.Geometry.Point: cwCmpAroundWith :: (Ord r, Num r) => Vector 2 r -> Point 2 r -> Point 2 r -> Point 2 r -> Ordering
- Data.Geometry.Point: sortAround :: (Ord r, Num r) => (Point 2 r :+ q) -> [Point 2 r :+ p] -> [Point 2 r :+ p]
+ Data.Geometry.Point: sortAround :: (Ord r, Num r) => Point 2 r -> [Point 2 r] -> [Point 2 r]
- Data.Geometry.Point: vector :: Lens' (Point d r) (Vector d r)
+ Data.Geometry.Point: vector :: Lens (Point d r) (Point d r') (Vector d r) (Vector d r')
- Data.Geometry.PolyLine: points :: forall d_a22fG p_a22fH r_a22fI d_a22hP p_a22hQ r_a22hR. Iso (PolyLine d_a22fG p_a22fH r_a22fI) (PolyLine d_a22hP p_a22hQ r_a22hR) (LSeq 2 ((:+) (Point d_a22fG r_a22fI) p_a22fH)) (LSeq 2 ((:+) (Point d_a22hP r_a22hR) p_a22hQ))
+ Data.Geometry.PolyLine: points :: Iso (PolyLine d1 p1 r1) (PolyLine d2 p2 r2) (LSeq 2 (Point d1 r1 :+ p1)) (LSeq 2 (Point d2 r2 :+ p2))
- Data.Geometry.Polygon: [MultiPolygon] :: CSeq (Point 2 r :+ p) -> [Polygon Simple p r] -> Polygon Multi p r
+ Data.Geometry.Polygon: [MultiPolygon] :: SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon p r
- Data.Geometry.Polygon: [SimplePolygon] :: CSeq (Point 2 r :+ p) -> Polygon Simple p r
+ Data.Geometry.Polygon: [SimplePolygon] :: Vertices (Point 2 r :+ p) -> SimplePolygon p r
- Data.Geometry.Polygon: _MultiPolygon :: Prism' (Polygon Multi p r) (CSeq (Point 2 r :+ p), [Polygon Simple p r])
+ Data.Geometry.Polygon: _MultiPolygon :: Prism' (Polygon Multi p r) (Polygon Simple p r, [Polygon Simple p r])
- Data.Geometry.Polygon: _SimplePolygon :: Prism' (Polygon Simple p r) (CSeq (Point 2 r :+ p))
+ Data.Geometry.Polygon: _SimplePolygon :: Prism' (Polygon Simple p r) (Vertices (Point 2 r :+ p))
- Data.Geometry.Polygon: fromPoints :: [Point 2 r :+ p] -> SimplePolygon p r
+ Data.Geometry.Polygon: fromPoints :: forall p r. (Eq r, Num r) => [Point 2 r :+ p] -> SimplePolygon p r
- Data.Geometry.Polygon: isCounterClockwise :: (Eq r, Fractional r) => Polygon t p r -> Bool
+ Data.Geometry.Polygon: isCounterClockwise :: (Eq r, Num r) => Polygon t p r -> Bool
- Data.Geometry.Polygon: onBoundary :: (Fractional r, Ord r) => Point 2 r -> Polygon t p r -> Bool
+ Data.Geometry.Polygon: onBoundary :: (Num r, Ord r) => Point 2 r -> Polygon t p r -> Bool
- Data.Geometry.Polygon: outerBoundary :: forall t p r. Lens' (Polygon t p r) (CSeq (Point 2 r :+ p))
+ Data.Geometry.Polygon: outerBoundary :: forall t p r. Lens' (Polygon t p r) (SimplePolygon p r)
- Data.Geometry.Polygon: outerBoundaryEdges :: Polygon t p r -> CSeq (LineSegment 2 p r)
+ Data.Geometry.Polygon: outerBoundaryEdges :: Polygon t p r -> CircularVector (LineSegment 2 p r)
- Data.Geometry.Polygon: outerVertex :: Int -> Lens' (Polygon t p r) (Point 2 r :+ p)
+ Data.Geometry.Polygon: outerVertex :: Int -> Getter (Polygon t p r) (Point 2 r :+ p)
- Data.Geometry.Polygon: toClockwiseOrder :: (Eq r, Fractional r) => Polygon t p r -> Polygon t p r
+ Data.Geometry.Polygon: toClockwiseOrder :: (Eq r, Num r) => Polygon t p r -> Polygon t p r
- Data.Geometry.Polygon: toClockwiseOrder' :: (Eq r, Fractional r) => Polygon t p r -> Polygon t p r
+ Data.Geometry.Polygon: toClockwiseOrder' :: (Eq r, Num r) => Polygon t p r -> Polygon t p r
- Data.Geometry.Polygon: toCounterClockWiseOrder :: (Eq r, Fractional r) => Polygon t p r -> Polygon t p r
+ Data.Geometry.Polygon: toCounterClockWiseOrder :: (Eq r, Num r) => Polygon t p r -> Polygon t p r
- Data.Geometry.Polygon: toCounterClockWiseOrder' :: (Eq r, Fractional r) => Polygon t p r -> Polygon t p r
+ Data.Geometry.Polygon: toCounterClockWiseOrder' :: (Eq r, Num r) => Polygon t p r -> Polygon t p r
- Data.Geometry.Polygon.Convex: bottomMost :: Ord r => CSeq (Point 2 r :+ p) -> CSeq (Point 2 r :+ p)
+ Data.Geometry.Polygon.Convex: bottomMost :: Ord r => CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
- Data.Geometry.Polygon.Convex: simplePolygon :: forall p_a2BxI r_a2BxJ p_a2BCl r_a2BCm. Iso (ConvexPolygon p_a2BxI r_a2BxJ) (ConvexPolygon p_a2BCl r_a2BCm) (SimplePolygon p_a2BxI r_a2BxJ) (SimplePolygon p_a2BCl r_a2BCm)
+ Data.Geometry.Polygon.Convex: simplePolygon :: Iso (ConvexPolygon p1 r1) (ConvexPolygon p2 r2) (SimplePolygon p1 r1) (SimplePolygon p2 r2)
- Data.Geometry.QuadTree: startingCell :: forall v_a1ZtD p_a1ZtE r_a1ZtF r_a1ZFG. Lens (QuadTree v_a1ZtD p_a1ZtE r_a1ZtF) (QuadTree v_a1ZtD p_a1ZtE r_a1ZFG) (Cell r_a1ZtF) (Cell r_a1ZFG)
+ Data.Geometry.QuadTree: startingCell :: forall v_a1NHL p_a1NHM r_a1NHN r_a1NTS. Lens (QuadTree v_a1NHL p_a1NHM r_a1NHN) (QuadTree v_a1NHL p_a1NHM r_a1NTS) (Cell r_a1NHN) (Cell r_a1NTS)
- Data.Geometry.QuadTree: tree :: forall v_a1ZtD p_a1ZtE r_a1ZtF v_a1ZFH p_a1ZFI. Lens (QuadTree v_a1ZtD p_a1ZtE r_a1ZtF) (QuadTree v_a1ZFH p_a1ZFI r_a1ZtF) (Tree v_a1ZtD p_a1ZtE) (Tree v_a1ZFH p_a1ZFI)
+ Data.Geometry.QuadTree: tree :: forall v_a1NHL p_a1NHM r_a1NHN v_a1NTT p_a1NTU. Lens (QuadTree v_a1NHL p_a1NHM r_a1NHN) (QuadTree v_a1NTT p_a1NTU r_a1NHN) (Tree v_a1NHL p_a1NHM) (Tree v_a1NTT p_a1NTU)
- Data.Geometry.QuadTree.Cell: cellWidthIndex :: forall r_a1TUJ. Lens' (Cell r_a1TUJ) WidthIndex
+ Data.Geometry.QuadTree.Cell: cellWidthIndex :: forall r_a1I3f. Lens' (Cell r_a1I3f) WidthIndex
- Data.Geometry.QuadTree.Cell: lowerLeft :: forall r_a1TUJ r_a1U5N. Lens (Cell r_a1TUJ) (Cell r_a1U5N) (Point 2 r_a1TUJ) (Point 2 r_a1U5N)
+ Data.Geometry.QuadTree.Cell: lowerLeft :: forall r_a1I3f r_a1Iee. Lens (Cell r_a1I3f) (Cell r_a1Iee) (Point 2 r_a1I3f) (Point 2 r_a1Iee)
- Data.Geometry.QuadTree.Split: _No :: forall i_a1X9q v_a1X9r p_a1X9s p_a1XfS. Prism (Split i_a1X9q v_a1X9r p_a1XfS) (Split i_a1X9q v_a1X9r p_a1X9s) p_a1XfS p_a1X9s
+ Data.Geometry.QuadTree.Split: _No :: forall i_a1Lqt v_a1Lqu p_a1LwK p_a1Lqv. Prism (Split i_a1Lqt v_a1Lqu p_a1LwK) (Split i_a1Lqt v_a1Lqu p_a1Lqv) p_a1LwK p_a1Lqv
- Data.Geometry.QuadTree.Split: _Yes :: forall i_a1X9q v_a1X9r p_a1X9s i_a1XfY v_a1XfZ. Prism (Split i_a1XfY v_a1XfZ p_a1X9s) (Split i_a1X9q v_a1X9r p_a1X9s) (v_a1XfZ, Quadrants i_a1XfY) (v_a1X9r, Quadrants i_a1X9q)
+ Data.Geometry.QuadTree.Split: _Yes :: forall i_a1LwQ v_a1LwR p_a1Lqv i_a1Lqt v_a1Lqu. Prism (Split i_a1LwQ v_a1LwR p_a1Lqv) (Split i_a1Lqt v_a1Lqu p_a1Lqv) (v_a1LwR, Quadrants i_a1LwQ) (v_a1Lqu, Quadrants i_a1Lqt)
- Data.Geometry.QuadTree.Tree: _Leaf :: forall v_a1YaG p_a1YaH. Prism' (Tree v_a1YaG p_a1YaH) p_a1YaH
+ Data.Geometry.QuadTree.Tree: _Leaf :: forall v_a1Mqj p_a1Mqk. Prism' (Tree v_a1Mqj p_a1Mqk) p_a1Mqk
- Data.Geometry.QuadTree.Tree: _Node :: forall v_a1YaG p_a1YaH v_a1Yei. Prism (Tree v_a1Yei p_a1YaH) (Tree v_a1YaG p_a1YaH) (v_a1Yei, Quadrants (Tree v_a1Yei p_a1YaH)) (v_a1YaG, Quadrants (Tree v_a1YaG p_a1YaH))
+ Data.Geometry.QuadTree.Tree: _Node :: forall v_a1MtI p_a1Mqk v_a1Mqj. Prism (Tree v_a1MtI p_a1Mqk) (Tree v_a1Mqj p_a1Mqk) (v_a1MtI, Quadrants (Tree v_a1MtI p_a1Mqk)) (v_a1Mqj, Quadrants (Tree v_a1Mqj p_a1Mqk))
- Data.Geometry.SegmentTree.Generic: assoc :: forall v_aEbu r_aEbv v_aEiG. Lens (NodeData v_aEbu r_aEbv) (NodeData v_aEiG r_aEbv) v_aEbu v_aEiG
+ Data.Geometry.SegmentTree.Generic: assoc :: forall v_atWp r_atWq v_au3o. Lens (NodeData v_atWp r_atWq) (NodeData v_au3o r_atWq) v_atWp v_au3o
- Data.Geometry.SegmentTree.Generic: atomicRange :: forall v_aEj6 r_aEj7 r_aEwY. Lens (LeafData v_aEj6 r_aEj7) (LeafData v_aEj6 r_aEwY) (AtomicRange r_aEj7) (AtomicRange r_aEwY)
+ Data.Geometry.SegmentTree.Generic: atomicRange :: forall v_au3O r_au3P r_auhl. Lens (LeafData v_au3O r_au3P) (LeafData v_au3O r_auhl) (AtomicRange r_au3P) (AtomicRange r_auhl)
- Data.Geometry.SegmentTree.Generic: leafAssoc :: forall v_aEj6 r_aEj7 v_aEwZ. Lens (LeafData v_aEj6 r_aEj7) (LeafData v_aEwZ r_aEj7) v_aEj6 v_aEwZ
+ Data.Geometry.SegmentTree.Generic: leafAssoc :: forall v_au3O r_au3P v_auhm. Lens (LeafData v_au3O r_au3P) (LeafData v_auhm r_au3P) v_au3O v_auhm
- Data.Geometry.SegmentTree.Generic: range :: forall v_aEbu r_aEbv. Lens' (NodeData v_aEbu r_aEbv) (Range r_aEbv)
+ Data.Geometry.SegmentTree.Generic: range :: forall v_atWp r_atWq. Lens' (NodeData v_atWp r_atWq) (Range r_atWq)
- Data.Geometry.SegmentTree.Generic: splitPoint :: forall v_aEbu r_aEbv. Lens' (NodeData v_aEbu r_aEbv) (EndPoint r_aEbv)
+ Data.Geometry.SegmentTree.Generic: splitPoint :: forall v_atWp r_atWq. Lens' (NodeData v_atWp r_atWq) (EndPoint r_atWq)
- Data.Geometry.SegmentTree.Generic: unSegmentTree :: forall v_aExd r_aExe v_aEFc r_aEFd. Iso (SegmentTree v_aExd r_aExe) (SegmentTree v_aEFc r_aEFd) (BinLeafTree (NodeData v_aExd r_aExe) (LeafData v_aExd r_aExe)) (BinLeafTree (NodeData v_aEFc r_aEFd) (LeafData v_aEFc r_aEFd))
+ Data.Geometry.SegmentTree.Generic: unSegmentTree :: forall v_auhA r_auhB v_aupp r_aupq. Iso (SegmentTree v_auhA r_auhB) (SegmentTree v_aupp r_aupq) (BinLeafTree (NodeData v_auhA r_auhB) (LeafData v_auhA r_auhB)) (BinLeafTree (NodeData v_aupp r_aupq) (LeafData v_aupp r_aupq))
- Data.Geometry.Slab: Slab :: Interval a r -> Slab a r
+ Data.Geometry.Slab: Slab :: Interval a r -> Slab (o :: Orthogonal) a r
- Data.Geometry.Slab: [_unSlab] :: Slab a r -> Interval a r
+ Data.Geometry.Slab: [_unSlab] :: Slab (o :: Orthogonal) a r -> Interval a r
- Data.Geometry.Slab: unSlab :: forall o_a26XO a_a26XP r_a26XQ o_a273z a_a273A r_a273B. Iso (Slab o_a26XO a_a26XP r_a26XQ) (Slab o_a273z a_a273A r_a273B) (Interval a_a26XP r_a26XQ) (Interval a_a273A r_a273B)
+ Data.Geometry.Slab: unSlab :: forall o_a1ViD a_a1ViE r_a1ViF o_a1Vof a_a1Vog r_a1Voh. Iso (Slab o_a1ViD a_a1ViE r_a1ViF) (Slab o_a1Vof a_a1Vog r_a1Voh) (Interval a_a1ViE r_a1ViF) (Interval a_a1Vog r_a1Voh)
- Data.Geometry.SubLine: line :: forall d_a1t6F p_a1t6G s_a1t6H r_a1t6I d_a1t7z r_a1t7A. Lens (SubLine d_a1t6F p_a1t6G s_a1t6H r_a1t6I) (SubLine d_a1t7z p_a1t6G s_a1t6H r_a1t7A) (Line d_a1t6F r_a1t6I) (Line d_a1t7z r_a1t7A)
+ Data.Geometry.SubLine: line :: Lens (SubLine d1 p s r1) (SubLine d2 p s r2) (Line d1 r1) (Line d2 r2)
- Data.Geometry.SubLine: subRange :: forall d_a1t6F p_a1t6G s_a1t6H r_a1t6I p_a1t7B s_a1t7C. Lens (SubLine d_a1t6F p_a1t6G s_a1t6H r_a1t6I) (SubLine d_a1t6F p_a1t7B s_a1t7C r_a1t6I) (Interval p_a1t6G s_a1t6H) (Interval p_a1t7B s_a1t7C)
+ Data.Geometry.SubLine: subRange :: Lens (SubLine d p1 s1 r) (SubLine d p2 s2 r) (Interval p1 s1) (Interval p2 s2)
- Data.Geometry.Vector: C :: C
+ Data.Geometry.Vector: C :: C (n :: Nat)
- Data.Geometry.Vector.VectorFamily: MKVector :: VectorFamily (Peano d) r -> Vector
+ Data.Geometry.Vector.VectorFamily: MKVector :: VectorFamily (Peano d) r -> Vector (d :: Nat) (r :: *)
- Data.Geometry.Vector.VectorFamily: [_unV] :: Vector -> VectorFamily (Peano d) r
+ Data.Geometry.Vector.VectorFamily: [_unV] :: Vector (d :: Nat) (r :: *) -> VectorFamily (Peano d) r
- Data.Geometry.Vector.VectorFamily: unV :: Lens (Vector d r) (Vector d s) (VectorFamily (Peano d) r) (VectorFamily (Peano d) s)
+ Data.Geometry.Vector.VectorFamily: unV :: Iso (Vector d r) (Vector d s) (VectorFamily (Peano d) r) (VectorFamily (Peano d) s)
- Data.Geometry.Vector.VectorFamilyPeano: VectorFamily :: VectorFamilyF d r -> VectorFamily
+ Data.Geometry.Vector.VectorFamilyPeano: VectorFamily :: VectorFamilyF d r -> VectorFamily (d :: PeanoNum) (r :: *)
- Data.Geometry.Vector.VectorFamilyPeano: type family VectorFamilyF (d :: PeanoNum) :: * -> *
+ Data.Geometry.Vector.VectorFamilyPeano: type family FromPeano (d :: PeanoNum) :: Nat
- Data.Geometry.Vector.VectorFixed: C :: C
+ Data.Geometry.Vector.VectorFixed: C :: C (n :: Nat)
- Data.Geometry.Vector.VectorFixed: Vector :: Vec d r -> Vector
+ Data.Geometry.Vector.VectorFixed: Vector :: Vec d r -> Vector (d :: Nat) (r :: *)
- Data.Geometry.Vector.VectorFixed: [_unV] :: Vector -> Vec d r
+ Data.Geometry.Vector.VectorFixed: [_unV] :: Vector (d :: Nat) (r :: *) -> Vec d r
- Data.PlaneGraph: FaceId :: VertexId s (DualOf w) -> FaceId
+ Data.PlaneGraph: FaceId :: VertexId s (DualOf w) -> FaceId (s :: k) (w :: World)
- Data.PlaneGraph: VertexId :: Int -> VertexId
+ Data.PlaneGraph: VertexId :: Int -> VertexId (s :: k) (w :: World)
- Data.PlaneGraph: [_unFaceId] :: FaceId -> VertexId s (DualOf w)
+ Data.PlaneGraph: [_unFaceId] :: FaceId (s :: k) (w :: World) -> VertexId s (DualOf w)
- Data.PlaneGraph: [_unVertexId] :: VertexId -> Int
+ Data.PlaneGraph: [_unVertexId] :: VertexId (s :: k) (w :: World) -> Int
- Data.PlaneGraph: dual :: () => Getter (PlanarGraph s w v e f) (PlanarGraph s (DualOf w) f e v)
+ Data.PlaneGraph: dual :: forall k (s :: k) (w :: World) v e f. Getter (PlanarGraph s w v e f) (PlanarGraph s (DualOf w) f e v)
- Data.PlaneGraph: graph :: forall s_a30Ob v_a30Oc e_a30Od f_a30Oe r_a30Of s_a30ZX v_a30ZY e_a30ZZ f_a3100 r_a3101. Iso (PlaneGraph s_a30Ob v_a30Oc e_a30Od f_a30Oe r_a30Of) (PlaneGraph s_a30ZX v_a30ZY e_a30ZZ f_a3100 r_a3101) (PlanarGraph s_a30Ob 'Primal (VertexData r_a30Of v_a30Oc) e_a30Od f_a30Oe) (PlanarGraph s_a30ZX 'Primal (VertexData r_a3101 v_a30ZY) e_a30ZZ f_a3100)
+ Data.PlaneGraph: graph :: forall k_a2XvW (s_a2Xva :: k_a2XvW) v_a2Xvb e_a2Xvc f_a2Xvd r_a2Xve k_a2XGe (s_a2XG9 :: k_a2XGe) v_a2XGa e_a2XGb f_a2XGc r_a2XGd. Iso (PlaneGraph (s_a2Xva :: k_a2XvW) v_a2Xvb e_a2Xvc f_a2Xvd r_a2Xve) (PlaneGraph (s_a2XG9 :: k_a2XGe) v_a2XGa e_a2XGb f_a2XGc r_a2XGd) (PlanarGraph s_a2Xva 'Primal (VertexData r_a2Xve v_a2Xvb) e_a2Xvc f_a2Xvd) (PlanarGraph s_a2XG9 'Primal (VertexData r_a2XGd v_a2XGa) e_a2XGb f_a2XGc)
- Data.PlaneGraph: location :: forall r_a30z8 v_a30z9 r_a30NV. Lens (VertexData r_a30z8 v_a30z9) (VertexData r_a30NV v_a30z9) (Point 2 r_a30z8) (Point 2 r_a30NV)
+ Data.PlaneGraph: location :: forall r_a2Xgg v_a2Xgh r_a2XuU. Lens (VertexData r_a2Xgg v_a2Xgh) (VertexData r_a2XuU v_a2Xgh) (Point 2 r_a2Xgg) (Point 2 r_a2XuU)
- Data.PlaneGraph: twin :: () => Dart s -> Dart s
+ Data.PlaneGraph: twin :: forall k (s :: k). Dart s -> Dart s
- Data.PlaneGraph: type FaceId' (s :: k) = FaceId s Primal
+ Data.PlaneGraph: type FaceId' (s :: k) = FaceId s 'Primal
- Data.PlaneGraph: type VertexId' (s :: k) = VertexId s Primal
+ Data.PlaneGraph: type VertexId' (s :: k) = VertexId s 'Primal
- Data.PlaneGraph: type family DataOf g i :: Type;
+ Data.PlaneGraph: type family DataOf g i;
- Data.PlaneGraph: vData :: forall r_a30z8 v_a30z9 v_a30NW. Lens (VertexData r_a30z8 v_a30z9) (VertexData r_a30z8 v_a30NW) v_a30z9 v_a30NW
+ Data.PlaneGraph: vData :: forall r_a2Xgg v_a2Xgh v_a2XuV. Lens (VertexData r_a2Xgg v_a2Xgh) (VertexData r_a2Xgg v_a2XuV) v_a2Xgh v_a2XuV
- Data.PlaneGraph.Core: FaceId :: VertexId s (DualOf w) -> FaceId
+ Data.PlaneGraph.Core: FaceId :: VertexId s (DualOf w) -> FaceId (s :: k) (w :: World)
- Data.PlaneGraph.Core: VertexId :: Int -> VertexId
+ Data.PlaneGraph.Core: VertexId :: Int -> VertexId (s :: k) (w :: World)
- Data.PlaneGraph.Core: [_unFaceId] :: FaceId -> VertexId s (DualOf w)
+ Data.PlaneGraph.Core: [_unFaceId] :: FaceId (s :: k) (w :: World) -> VertexId s (DualOf w)
- Data.PlaneGraph.Core: [_unVertexId] :: VertexId -> Int
+ Data.PlaneGraph.Core: [_unVertexId] :: VertexId (s :: k) (w :: World) -> Int
- Data.PlaneGraph.Core: dual :: () => Getter (PlanarGraph s w v e f) (PlanarGraph s (DualOf w) f e v)
+ Data.PlaneGraph.Core: dual :: forall k (s :: k) (w :: World) v e f. Getter (PlanarGraph s w v e f) (PlanarGraph s (DualOf w) f e v)
- Data.PlaneGraph.Core: fromAdjacencyLists :: (Foldable h, Functor h) => [(VertexId s w, h (VertexId s w))] -> PlanarGraph s w () () ()
+ Data.PlaneGraph.Core: fromAdjacencyLists :: forall k (s :: k) (w :: World) h. (Foldable h, Functor h) => [(VertexId s w, h (VertexId s w))] -> PlanarGraph s w () () ()
- Data.PlaneGraph.Core: graph :: forall s_a30Ob v_a30Oc e_a30Od f_a30Oe r_a30Of s_a30ZX v_a30ZY e_a30ZZ f_a3100 r_a3101. Iso (PlaneGraph s_a30Ob v_a30Oc e_a30Od f_a30Oe r_a30Of) (PlaneGraph s_a30ZX v_a30ZY e_a30ZZ f_a3100 r_a3101) (PlanarGraph s_a30Ob 'Primal (VertexData r_a30Of v_a30Oc) e_a30Od f_a30Oe) (PlanarGraph s_a30ZX 'Primal (VertexData r_a3101 v_a30ZY) e_a30ZZ f_a3100)
+ Data.PlaneGraph.Core: graph :: forall k_a2XvW (s_a2Xva :: k_a2XvW) v_a2Xvb e_a2Xvc f_a2Xvd r_a2Xve k_a2XGe (s_a2XG9 :: k_a2XGe) v_a2XGa e_a2XGb f_a2XGc r_a2XGd. Iso (PlaneGraph (s_a2Xva :: k_a2XvW) v_a2Xvb e_a2Xvc f_a2Xvd r_a2Xve) (PlaneGraph (s_a2XG9 :: k_a2XGe) v_a2XGa e_a2XGb f_a2XGc r_a2XGd) (PlanarGraph s_a2Xva 'Primal (VertexData r_a2Xve v_a2Xvb) e_a2Xvc f_a2Xvd) (PlanarGraph s_a2XG9 'Primal (VertexData r_a2XGd v_a2XGa) e_a2XGb f_a2XGc)
- Data.PlaneGraph.Core: location :: forall r_a30z8 v_a30z9 r_a30NV. Lens (VertexData r_a30z8 v_a30z9) (VertexData r_a30NV v_a30z9) (Point 2 r_a30z8) (Point 2 r_a30NV)
+ Data.PlaneGraph.Core: location :: forall r_a2Xgg v_a2Xgh r_a2XuU. Lens (VertexData r_a2Xgg v_a2Xgh) (VertexData r_a2XuU v_a2Xgh) (Point 2 r_a2Xgg) (Point 2 r_a2XuU)
- Data.PlaneGraph.Core: twin :: () => Dart s -> Dart s
+ Data.PlaneGraph.Core: twin :: forall k (s :: k). Dart s -> Dart s
- Data.PlaneGraph.Core: type FaceId' (s :: k) = FaceId s Primal
+ Data.PlaneGraph.Core: type FaceId' (s :: k) = FaceId s 'Primal
- Data.PlaneGraph.Core: type VertexId' (s :: k) = VertexId s Primal
+ Data.PlaneGraph.Core: type VertexId' (s :: k) = VertexId s 'Primal
- Data.PlaneGraph.Core: type family DataOf g i :: Type;
+ Data.PlaneGraph.Core: type family DataOf g i;
- Data.PlaneGraph.Core: vData :: forall r_a30z8 v_a30z9 v_a30NW. Lens (VertexData r_a30z8 v_a30z9) (VertexData r_a30z8 v_a30NW) v_a30z9 v_a30NW
+ Data.PlaneGraph.Core: vData :: forall r_a2Xgg v_a2Xgh v_a2XuV. Lens (VertexData r_a2Xgg v_a2Xgh) (VertexData r_a2Xgg v_a2XuV) v_a2Xgh v_a2XuV
- Graphics.Camera: cameraPosition :: forall r_a3ATc. Lens' (Camera r_a3ATc) (Point 3 r_a3ATc)
+ Graphics.Camera: cameraPosition :: Lens' (Camera r) (Point 3 r)
- Graphics.Camera: farDist :: forall r_a3ATc. Lens' (Camera r_a3ATc) r_a3ATc
+ Graphics.Camera: farDist :: Lens' (Camera r) r
- Graphics.Camera: nearDist :: forall r_a3ATc. Lens' (Camera r_a3ATc) r_a3ATc
+ Graphics.Camera: nearDist :: Lens' (Camera r) r
- Graphics.Camera: rawCameraNormal :: forall r_a3ATc. Lens' (Camera r_a3ATc) (Vector 3 r_a3ATc)
+ Graphics.Camera: rawCameraNormal :: Lens' (Camera r) (Vector 3 r)
- Graphics.Camera: rawViewUp :: forall r_a3ATc. Lens' (Camera r_a3ATc) (Vector 3 r_a3ATc)
+ Graphics.Camera: rawViewUp :: Lens' (Camera r) (Vector 3 r)
- Graphics.Camera: screenDimensions :: forall r_a3ATc. Lens' (Camera r_a3ATc) (Vector 2 r_a3ATc)
+ Graphics.Camera: screenDimensions :: Lens' (Camera r) (Vector 2 r)
- Graphics.Camera: viewPlaneDepth :: forall r_a3ATc. Lens' (Camera r_a3ATc) r_a3ATc
+ Graphics.Camera: viewPlaneDepth :: Lens' (Camera r) r

Files

README.md view
@@ -1,8 +1,9 @@ HGeometry ========= -[![Build Status](https://travis-ci.org/noinia/hgeometry.svg?branch=master)](https://travis-ci.org/noinia/hgeometry)-[![Hackage](https://img.shields.io/hackage/v/hgeometry.svg)](https://hackage.haskell.org/package/hgeometry)+![GitHub Workflow Status](https://img.shields.io/github/workflow/status/noinia/hgeometry/CI)+[![Hackage](https://img.shields.io/hackage/v/hgeometry.svg?color=success)](https://hackage.haskell.org/package/hgeometry)+[![API docs coverage](https://img.shields.io/endpoint?url=https%3A%2F%2Fnoinia.github.io%2Fhgeometry%2Fhaddock_badge.json)](https://noinia.github.io/hgeometry/doc/)  HGeometry is a library for computing with geometric objects in Haskell. It defines basic geometric types and primitives, and it@@ -34,19 +35,23 @@  HGeometry is split into a few smaller packages. In particular: -- hgeometry-combinatorial : defines some non-geometric+- hgeometry : defines the actual geometric data types, data+  structures, and algorithms,+- hgeometry-combinatorial : defines the non-geometric   (i.e. combinatorial) data types, data structures, and algorithms.+ - hgeometry-ipe : defines functions for working with [ipe](http://ipe.otfried.org) files. - hgeometry-svg : defines functions for working with svg files.-- hgeometry-interactive : defines functions for building an+- hgeometry-web : defines functions for building an   interactive viewer using [miso](https://haskell-miso.org).-- hgeometry : defines the actual geometric data types, data-  structures, and algorithms.+- hgeometry-interactive : defines functions for building an+  interactive viewer using+  [reflex-sdl2](https://hackage.haskell.org/package/reflex-sdl2). -In addition there is a [hgeometry-examples](hgeometry-examples)-package that defines some example applications, and a hgometry-test-package that contains all testcases. The latter is to work around a-bug in cabal.+In addition there are [hgeometry-examples](hgeometry-examples) and+[hgeometry-showcase](hgeometry-showcase) packages that define some+example applications, and a hgometry-test package that contains all+testcases. The latter is to work around a bug in cabal.  Available Geometric Algorithms ------------------------------@@ -56,25 +61,28 @@ implements some more advanced geometric algorithms. In particuar, the following algorithms are currently available: -* two \(O(n \log n)\) time algorithms for convex hull in-  $\mathbb{R}^2$: the typical Graham scan, and a divide and conquer algorithm,-* an \(O(n)\) expected time algorithm for smallest enclosing disk in $\mathbb{R}^$2,+* two *O(n log n)* time algorithms for convex hull in+  ℝ²: the typical Graham scan, and a divide and conquer algorithm,+* an *O(n)* expected time algorithm for smallest enclosing disk in ℝ², * the well-known Douglas Peucker polyline line simplification algorithm,-* an \(O(n \log n)\) time algorithm for computing the Delaunay triangulation-(using divide and conquer).-* an \(O(n \log n)\) time algorithm for computing the Euclidean Minimum Spanning-Tree (EMST), based on computing the Delaunay Triangulation.-* an \(O(\log^2 n)\) time algorithm to find extremal points and tangents on/to a-  convex polygon.-* An optimal \(O(n+m)\) time algorithm to compute the Minkowski sum of two convex-polygons.-* An \(O(1/\varepsilon^dn\log n)\) time algorithm for constructing a Well-Separated pair-  decomposition.-* The classic (optimal) \(O(n\log n)\) time divide and conquer algorithm to-  compute the closest pair among a set of \(n\) points in \(\mathbb{R}^2\).-* An \(O(nm)\) time algorithm to compute the discrete Fr\'echet-  distance of two sequences of points (curves) of length \(n\) and-  \(m\), respectively.+* an *O(n log n)* time algorithm for computing the Delaunay triangulation+(using divide and conquer),+* an *O(n log n)* time algorithm for computing the Euclidean Minimum Spanning+Tree (EMST), based on computing the Delaunay Triangulation,+* an *O(log n)* time algorithm to find extremal points and tangents on/to a+  convex polygon,+* an optimal *O(n+m)* time algorithm to compute the Minkowski sum of two convex+polygons,+* an *O(1/εᵈn log n)* time algorithm for constructing a Well-Separated pair+  decomposition,+* the classic (optimal) *O(n log n)* time divide and conquer algorithm to+  compute the closest pair among a set of *n* points in ℝ²,+* an *O(nm)* time algorithm to compute the discrete Fréchet+  distance of two sequences of points (curves) of length *n* and+  *m*, respectively.+* an *O(n)* time single-source shortest path algorithm on triangulated polygons.+* an *O(n log n)* time algorithm for generating random convex polygons.+* an *O(n)* time algorithm for finding the convex hull of a simple polygon.  Available Geometric Data Structures -----------------------------------@@ -85,11 +93,13 @@ * A one dimensional Segment Tree. The base tree is static. * A one dimensional Interval Tree. The base tree is static. * A KD-Tree. The base tree is static.+* An *O(n log n)* size planar point location data structure supporting+  *O(log n)* queries.  There is also support for working with planar subdivisions. As a result, [hgeometry-combinatorial] also includes a data structure for working with planar graphs. In particular, it has an `EdgeOracle` data-structure, that can be built in \(O(n)\) time that can test if the+structure, that can be built in *O(n)* time that can test if the planar graph contains an edge in constant time.  @@ -101,8 +111,8 @@ i.e. because of floating point errors one may get completely wrong results. Hence, I *strongly* advise against using `Double` or `Float` for these types. In several algorithms it is sufficient if the type `r` is-`Fractional`. Hence, you can use an exact number type such as `Rational`.-+`Fractional`. Hence, you can use an exact number type such as+`Data.RealNumber.Rational` or `Data.Ratio.Rational`.  Working with additional data ----------------------------@@ -119,14 +129,11 @@  To still allow for some extensibility our types will use the Ext (:+) type, as defined in the hgeometry-combinatorial package. For example,-our `Polygon` data type, has an extra type parameter `p` that allows-the vertices of the polygon to cary some extra information of type `p`-(for example a color, a size, or whatever).+our `LineSegment` data type, has an extra type parameter `p` that+allows the vertices of the line segment to carry some extra+information of type `p` (for example a color, a size, or+whatever). Polylines, Polylygons, Boxes, etc have similar such+parameters. -```haskell-data Polygon (t :: PolygonType) p r where-  SimplePolygon :: C.CSeq (Point 2 r :+ p)                         -> Polygon Simple p r-  MultiPolygon  :: C.CSeq (Point 2 r :+ p) -> [Polygon Simple p r] -> Polygon Multi  p r-``` In all places this extra data is accessable by the (:+) type in Data.Ext, which is essentially just a pair.
+ benchmark/Algorithms/Geometry/ClosestPair/Bench.hs view
@@ -0,0 +1,36 @@+module Algorithms.Geometry.ClosestPair.Bench where++import qualified Algorithms.Geometry.ClosestPair.DivideAndConquer as DivideAndConquer+import qualified Algorithms.Geometry.ClosestPair.Naive            as Naive++import           Control.Monad.Random+import           Data.Ext+import           Data.Geometry.Point+import           Data.Hashable+import           Data.LSeq            (LSeq)+import qualified Data.LSeq            as LSeq+import           Test.Tasty.Bench++--------------------------------------------------------------------------------++genPts                 :: (Ord r, Random r, RandomGen g)+                       => Int -> Rand g (LSeq 2 (Point 2 r :+ ()))+genPts n | n >= 2    = LSeq.promise . LSeq.fromList <$> replicateM n (fmap ext getRandom)+         | otherwise = error "genPts: Need at least 2 points"++gen :: StdGen+gen = mkStdGen (hash "closest pair")++-- | Benchmark computing the closest pair+benchmark    :: Benchmark+benchmark = bgroup "ClosestPair"+    [ bgroup (show n) (build $ evalRand (genPts @Int n) gen)+    | n <- sizes'+    ]+  where+    sizes' = [500]++    build pts = [ bench "sort"     $ nf LSeq.unstableSort pts+                , bench "Div&Conq" $ nf DivideAndConquer.closestPair pts+                , bench "Naive"    $ nf Naive.closestPair pts+                ]
+ benchmark/Algorithms/Geometry/ConvexHull/Bench.hs view
@@ -0,0 +1,65 @@+module Algorithms.Geometry.ConvexHull.Bench (benchmark) where++import qualified Algorithms.Geometry.ConvexHull.DivideAndConquer as DivideAndConquer+import qualified Algorithms.Geometry.ConvexHull.GrahamScan       as GrahamScan+import qualified Algorithms.Geometry.ConvexHull.JarvisMarch      as JarvisMarch+import qualified Algorithms.Geometry.ConvexHull.QuickHull        as QuickHull++import           Control.Monad.Random+import           Data.Double.Approximate+import           Data.Ext+import           Data.Geometry.Point+import           Data.Hashable+import           Data.List.NonEmpty       (NonEmpty (..))+import qualified Data.List.NonEmpty       as NonEmpty+import           Data.RealNumber.Rational+import           Test.Tasty.Bench++type R = RealNumber 5++--------------------------------------------------------------------------------++genPts                 :: (Ord r, Random r, RandomGen g)+                       => Int -> Rand g (NonEmpty (Point 2 r :+ ()))+genPts n = NonEmpty.fromList <$> replicateM n (fmap ext getRandom)++-- genPts'      :: (Ord r, Random r, RandomGen g) => Int+--              -> Rand g ( NonEmpty (Point 2 r :+ ())+--                    , NonEmpty (Point 2 r Multi.:+ '[])+--                    )+-- genPts' n = (\pts -> (pts, fmap (\ ~(c :+ _) -> Multi.ext c) pts)+--                ) <$> genPts n++gen :: StdGen+gen = mkStdGen (hash "convex hull")++-- | Benchmark building the convexHull+benchmark    :: Benchmark+benchmark = bgroup "ConvexHull" $+      [ bgroup ("1e"++show i ++ "/RealNumber") (convexHullFractional $ evalRand (genPts @R n) gen)+      | i <- [3, 4::Int]+      , let n = 10^i+      ] +++      [ bgroup ("1e"++show i ++ "/Int") (convexHullNum $ evalRand (genPts @Int n) gen)+      | i <- [4, 5::Int]+      , let n = 10^i+      ] +++      [ bgroup ("1e"++show i ++ "/SafeDouble") (convexHullFractional $ evalRand (genPts @SafeDouble n) gen)+      | i <- [4, 5::Int]+      , let n = 10^i+      ] +++      [ bgroup ("1e"++show i ++ "/Double") (convexHullFractional $ evalRand (genPts @Double n) gen)+      | i <- [4, 5::Int]+      , let n = 10^i ]+  where+    convexHullFractional pts =+                [ bench "GrahamScan" $ nf GrahamScan.convexHull pts+                , bench "DivideAndConquer" $ nf DivideAndConquer.convexHull pts+                , bench "QuickHull" $ nf QuickHull.convexHull pts+                , bench "JarvisMarch" $ nf JarvisMarch.convexHull pts+                ]+    convexHullNum pts =+                [ bench "GrahamScan" $ nf GrahamScan.convexHull pts+                , bench "DivideAndConquer" $ nf DivideAndConquer.convexHull pts+                , bench "JarvisMarch" $ nf JarvisMarch.convexHull pts+                ]
+ benchmark/Algorithms/Geometry/ConvexHull/GrahamFam.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE UndecidableInstances #-}+module Algorithms.Geometry.ConvexHull.GrahamFam( convexHull+                                               , upperHull+                                               , lowerHull, fromP+                                               ) where++import           Control.DeepSeq+import           Control.Lens ((^.))+import           Data.Ext+import           Data.Geometry.Point+import qualified Data.Geometry.Vector.VectorFamily as VF+import           Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NonEmpty+import           Data.Monoid+import           GHC.TypeLits+++newtype MyPoint d r = MyPoint (VF.Vector d r)++deriving instance (VF.Arity d, Eq r)  => Eq (MyPoint d r)+deriving instance (VF.Arity d, Ord r) => Ord (MyPoint d r)+deriving instance (VF.Arity d, Show r) => Show (MyPoint d r)+deriving instance (NFData (VF.Vector d r)) => NFData (MyPoint d r)++pattern MyPoint2 x y = MyPoint (VF.Vector2 x y)+++-- instance (NFData r, Arity d) => NFData (MyPoint d r)  where+--   rnf (MyPoint x y) = rnf (x,y)+--   rnf (MyP p)       = rnf p++toP                    :: MyPoint 2 r :+ e -> Point 2 r :+ e+toP (MyPoint2 x y :+ e) = Point2 x y :+ e++fromP                   :: Point 2 r :+ e -> MyPoint 2 r :+ e+fromP (Point2 x y :+ e) = MyPoint2 x y :+ e+++subt :: Num r => MyPoint 2 r -> MyPoint 2 r -> MyPoint 2 r+(MyPoint2 x y) `subt` (MyPoint2 a b) = MyPoint2 (x-a) (y-b)++newtype ConvexPolygon p r = ConvexPolygon [Point 2 r :+ p] deriving (Show,Eq,NFData)++-- | \(O(n \log n)\) time ConvexHull using Graham-Scan. The resulting polygon is+-- given in clockwise order.+convexHull            :: (Ord r, Num r)+                      => NonEmpty (MyPoint 2 r :+ p) -> ConvexPolygon p r+convexHull (p :| []) = ConvexPolygon $ [toP p]+convexHull ps        = let ps' = NonEmpty.toList . NonEmpty.sortBy incXdecY $ ps+                           uh  = NonEmpty.tail . hull' $         ps'+                           lh  = NonEmpty.tail . hull' $ reverse ps'+                       in ConvexPolygon . map toP . reverse $ lh ++ uh++upperHull  :: (Ord r, Num r) => NonEmpty (MyPoint 2 r :+ p) -> NonEmpty (MyPoint 2 r :+ p)+upperHull = hull id+++lowerHull :: (Ord r, Num r) => NonEmpty (MyPoint 2 r :+ p) -> NonEmpty (MyPoint 2 r :+ p)+lowerHull = hull reverse+++-- | Helper function so that that can compute both the upper or the lower hull, depending+-- on the function f+hull               :: (Ord r, Num r)+                   => ([MyPoint 2 r :+ p] -> [MyPoint 2 r :+ p])+                   -> NonEmpty (MyPoint 2 r :+ p) -> NonEmpty (MyPoint 2 r :+ p)+hull _ h@(_ :| []) = h+hull f pts         = hull' .  f+                   . NonEmpty.toList . NonEmpty.sortBy incXdecY $ pts++incXdecY  :: Ord r => (MyPoint 2 r) :+ p -> (MyPoint 2 r) :+ q -> Ordering+incXdecY (MyPoint2 px py :+ _) (MyPoint2 qx qy :+ _) =+  compare px qx <> compare qy py+++-- | Precondition: The list of input points is sorted+hull'          :: (Ord r, Num r) => [MyPoint 2 r :+ p] -> NonEmpty (MyPoint 2 r :+ p)+hull' (a:b:ps) = NonEmpty.fromList $ hull'' [b,a] ps+  where+    hull'' h []      = h+    hull'' h (p:ps') = hull'' (cleanMiddle (p:h)) ps'++    cleanMiddle h@[_,_]                         = h+    cleanMiddle h@(z:y:x:rest)+      | rightTurn (x^.core) (y^.core) (z^.core) = h+      | otherwise                               = cleanMiddle (z:x:rest)+    cleanMiddle _                               = error "cleanMiddle: too few points"++rightTurn       :: (Ord r, Num r) => MyPoint 2 r -> MyPoint 2 r -> MyPoint 2 r -> Bool+rightTurn a b c = ccwP a b c == CW++++ccwP :: (Ord r, Num r) => MyPoint 2 r -> MyPoint 2 r -> MyPoint 2 r -> CCW+ccwP p q r = case z `compare` 0 of+              LT -> CW+              GT -> CCW+              EQ -> CoLinear+     where++       MyPoint2 ux uy = q `subt` p+       MyPoint2 vx vy = r `subt` p+       z              = ux * vy - uy * vx
+ benchmark/Algorithms/Geometry/ConvexHull/GrahamFam6.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE UndecidableInstances #-}+module Algorithms.Geometry.ConvexHull.GrahamFam6( convexHull+                                                , upperHull+                                                , lowerHull, fromP+                                                ) where++import           Control.DeepSeq+import           Control.Lens ((^.))+import           Data.Ext+import           Data.Geometry.Point+import qualified Data.Geometry.Vector.VectorFamily6 as VF+import           Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NonEmpty+import           Data.Monoid+import           GHC.TypeLits+++newtype MyPoint d r = MyPoint (VF.Vector d r)++deriving instance (VF.Arity d, Eq r)  => Eq (MyPoint d r)+deriving instance (VF.Arity d, Ord r) => Ord (MyPoint d r)+deriving instance (VF.Arity d, Show r) => Show (MyPoint d r)+deriving instance (NFData (VF.Vector d r)) => NFData (MyPoint d r)++pattern MyPoint2 x y = MyPoint (VF.Vector2 x y)+++-- instance (NFData r, Arity d) => NFData (MyPoint d r)  where+--   rnf (MyPoint x y) = rnf (x,y)+--   rnf (MyP p)       = rnf p++toP                    :: MyPoint 2 r :+ e -> Point 2 r :+ e+toP (MyPoint2 x y :+ e) = Point2 x y :+ e++fromP                   :: Point 2 r :+ e -> MyPoint 2 r :+ e+fromP (Point2 x y :+ e) = MyPoint2 x y :+ e+++subt :: Num r => MyPoint 2 r -> MyPoint 2 r -> MyPoint 2 r+(MyPoint2 x y) `subt` (MyPoint2 a b) = MyPoint2 (x-a) (y-b)++newtype ConvexPolygon p r = ConvexPolygon [Point 2 r :+ p] deriving (Show,Eq,NFData)++-- | \(O(n \log n)\) time ConvexHull using Graham-Scan. The resulting polygon is+-- given in clockwise order.+convexHull            :: (Ord r, Num r)+                      => NonEmpty (MyPoint 2 r :+ p) -> ConvexPolygon p r+convexHull (p :| []) = ConvexPolygon $ [toP p]+convexHull ps        = let ps' = NonEmpty.toList . NonEmpty.sortBy incXdecY $ ps+                           uh  = NonEmpty.tail . hull' $         ps'+                           lh  = NonEmpty.tail . hull' $ reverse ps'+                       in ConvexPolygon . map toP . reverse $ lh ++ uh++upperHull  :: (Ord r, Num r) => NonEmpty (MyPoint 2 r :+ p) -> NonEmpty (MyPoint 2 r :+ p)+upperHull = hull id+++lowerHull :: (Ord r, Num r) => NonEmpty (MyPoint 2 r :+ p) -> NonEmpty (MyPoint 2 r :+ p)+lowerHull = hull reverse+++-- | Helper function so that that can compute both the upper or the lower hull, depending+-- on the function f+hull               :: (Ord r, Num r)+                   => ([MyPoint 2 r :+ p] -> [MyPoint 2 r :+ p])+                   -> NonEmpty (MyPoint 2 r :+ p) -> NonEmpty (MyPoint 2 r :+ p)+hull _ h@(_ :| []) = h+hull f pts         = hull' .  f+                   . NonEmpty.toList . NonEmpty.sortBy incXdecY $ pts++incXdecY  :: Ord r => (MyPoint 2 r) :+ p -> (MyPoint 2 r) :+ q -> Ordering+incXdecY (MyPoint2 px py :+ _) (MyPoint2 qx qy :+ _) =+  compare px qx <> compare qy py+++-- | Precondition: The list of input points is sorted+hull'          :: (Ord r, Num r) => [MyPoint 2 r :+ p] -> NonEmpty (MyPoint 2 r :+ p)+hull' (a:b:ps) = NonEmpty.fromList $ hull'' [b,a] ps+  where+    hull'' h []      = h+    hull'' h (p:ps') = hull'' (cleanMiddle (p:h)) ps'++    cleanMiddle h@[_,_]                         = h+    cleanMiddle h@(z:y:x:rest)+      | rightTurn (x^.core) (y^.core) (z^.core) = h+      | otherwise                               = cleanMiddle (z:x:rest)+    cleanMiddle _                               = error "cleanMiddle: too few points"++rightTurn       :: (Ord r, Num r) => MyPoint 2 r -> MyPoint 2 r -> MyPoint 2 r -> Bool+rightTurn a b c = ccwP a b c == CW++++ccwP :: (Ord r, Num r) => MyPoint 2 r -> MyPoint 2 r -> MyPoint 2 r -> CCW+ccwP p q r = case z `compare` 0 of+              LT -> CW+              GT -> CCW+              EQ -> CoLinear+     where++       MyPoint2 ux uy = q `subt` p+       MyPoint2 vx vy = r `subt` p+       z              = ux * vy - uy * vx
+ benchmark/Algorithms/Geometry/ConvexHull/GrahamFamPeano.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE UndecidableInstances #-}+module Algorithms.Geometry.ConvexHull.GrahamFamPeano( convexHull+                                                    , upperHull+                                                    , lowerHull, fromP+                                                    ) where++import           Control.DeepSeq+import           Control.Lens ((^.))+import           Data.Ext+import           Data.Geometry.Point+import qualified Data.Vector.Fixed.Cont as V+import qualified Data.Geometry.Vector.VectorFamilyPeano as VF+import           Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NonEmpty+import           Data.Monoid+import           GHC.TypeLits+import qualified Linear.V2 as V2+++newtype MyPoint d r = MyPoint (VF.VectorFamily d r)++deriving instance (VF.ImplicitArity d, Eq r)  => Eq (MyPoint d r)+deriving instance (VF.ImplicitArity d, Ord r) => Ord (MyPoint d r)+deriving instance (VF.ImplicitArity d, Show r) => Show (MyPoint d r)+deriving instance (NFData (VF.VectorFamily d r)) => NFData (MyPoint d r)++pattern Vector2 x y = VF.VectorFamily (V2.V2 x y)++pattern MyPoint2 x y = MyPoint (Vector2 x y)+++-- instance (NFData r, Arity d) => NFData (MyPoint d r)  where+--   rnf (MyPoint x y) = rnf (x,y)+--   rnf (MyP p)       = rnf p++toP                    :: MyPoint VF.Two r :+ e -> Point 2 r :+ e+toP (MyPoint2 x y :+ e) = Point2 x y :+ e++fromP                   :: Point 2 r :+ e -> MyPoint VF.Two r :+ e+fromP (Point2 x y :+ e) = MyPoint2 x y :+ e+++subt :: Num r => MyPoint VF.Two r -> MyPoint VF.Two r -> MyPoint VF.Two r+(MyPoint2 x y) `subt` (MyPoint2 a b) = MyPoint2 (x-a) (y-b)++newtype ConvexPolygon p r = ConvexPolygon [Point 2 r :+ p] deriving (Show,Eq,NFData)++-- | \(O(n \log n)\) time ConvexHull using Graham-Scan. The resulting polygon is+-- given in clockwise order.+convexHull            :: (Ord r, Num r)+                      => NonEmpty (MyPoint VF.Two r :+ p) -> ConvexPolygon p r+convexHull (p :| []) = ConvexPolygon $ [toP p]+convexHull ps        = let ps' = NonEmpty.toList . NonEmpty.sortBy incXdecY $ ps+                           uh  = NonEmpty.tail . hull' $         ps'+                           lh  = NonEmpty.tail . hull' $ reverse ps'+                       in ConvexPolygon . map toP . reverse $ lh ++ uh++upperHull  :: (Ord r, Num r) => NonEmpty (MyPoint VF.Two r :+ p) -> NonEmpty (MyPoint VF.Two r :+ p)+upperHull = hull id+++lowerHull :: (Ord r, Num r) => NonEmpty (MyPoint VF.Two r :+ p) -> NonEmpty (MyPoint VF.Two r :+ p)+lowerHull = hull reverse+++-- | Helper function so that that can compute both the upper or the lower hull, depending+-- on the function f+hull               :: (Ord r, Num r)+                   => ([MyPoint VF.Two r :+ p] -> [MyPoint VF.Two r :+ p])+                   -> NonEmpty (MyPoint VF.Two r :+ p) -> NonEmpty (MyPoint VF.Two r :+ p)+hull _ h@(_ :| []) = h+hull f pts         = hull' .  f+                   . NonEmpty.toList . NonEmpty.sortBy incXdecY $ pts++incXdecY  :: Ord r => (MyPoint VF.Two r) :+ p -> (MyPoint VF.Two r) :+ q -> Ordering+incXdecY (MyPoint2 px py :+ _) (MyPoint2 qx qy :+ _) =+  compare px qx <> compare qy py+++-- | Precondition: The list of input points is sorted+hull'          :: (Ord r, Num r) => [MyPoint VF.Two r :+ p] -> NonEmpty (MyPoint VF.Two r :+ p)+hull' (a:b:ps) = NonEmpty.fromList $ hull'' [b,a] ps+  where+    hull'' h []      = h+    hull'' h (p:ps') = hull'' (cleanMiddle (p:h)) ps'++    cleanMiddle h@[_,_]                         = h+    cleanMiddle h@(z:y:x:rest)+      | rightTurn (x^.core) (y^.core) (z^.core) = h+      | otherwise                               = cleanMiddle (z:x:rest)+    cleanMiddle _                               = error "cleanMiddle: too few points"++rightTurn       :: (Ord r, Num r) => MyPoint VF.Two r -> MyPoint VF.Two r -> MyPoint VF.Two r -> Bool+rightTurn a b c = ccwP a b c == CW++++ccwP :: (Ord r, Num r) => MyPoint VF.Two r -> MyPoint VF.Two r -> MyPoint VF.Two r -> CCW+ccwP p q r = case z `compare` 0 of+              LT -> CW+              GT -> CCW+              EQ -> CoLinear+     where++       MyPoint2 ux uy = q `subt` p+       MyPoint2 vx vy = r `subt` p+       z              = ux * vy - uy * vx
+ benchmark/Algorithms/Geometry/ConvexHull/GrahamFixed.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE UndecidableInstances #-}+module Algorithms.Geometry.ConvexHull.GrahamFixed( convexHull+                                                 , upperHull+                                                 , lowerHull, fromP+                                                 ) where++import           Control.DeepSeq+import           Control.Lens ((^.))+import           Data.Ext+import           Data.Geometry.Point+import           Data.Vector.Fixed (Arity)+import qualified Data.Geometry.Vector.VectorFixed as VF+import           Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NonEmpty+import           Data.Monoid+import           GHC.TypeLits+++newtype MyPoint d r = MyPoint (VF.Vector d r)++deriving instance (Arity d, Eq r)  => Eq (MyPoint d r)+deriving instance (Arity d, Ord r) => Ord (MyPoint d r)+deriving instance (Arity d, Show r) => Show (MyPoint d r)+deriving instance (NFData (VF.Vector d r)) => NFData (MyPoint d r)++pattern MyPoint2 x y = MyPoint (VF.Vector2 x y)+++-- instance (NFData r, Arity d) => NFData (MyPoint d r)  where+--   rnf (MyPoint x y) = rnf (x,y)+--   rnf (MyP p)       = rnf p++toP                    :: MyPoint 2 r :+ e -> Point 2 r :+ e+toP (MyPoint2 x y :+ e) = Point2 x y :+ e++fromP                   :: Point 2 r :+ e -> MyPoint 2 r :+ e+fromP (Point2 x y :+ e) = MyPoint2 x y :+ e+++subt :: Num r => MyPoint 2 r -> MyPoint 2 r -> MyPoint 2 r+(MyPoint2 x y) `subt` (MyPoint2 a b) = MyPoint2 (x-a) (y-b)++newtype ConvexPolygon p r = ConvexPolygon [Point 2 r :+ p] deriving (Show,Eq,NFData)++-- | \(O(n \log n)\) time ConvexHull using Graham-Scan. The resulting polygon is+-- given in clockwise order.+convexHull            :: (Ord r, Num r)+                      => NonEmpty (MyPoint 2 r :+ p) -> ConvexPolygon p r+convexHull (p :| []) = ConvexPolygon $ [toP p]+convexHull ps        = let ps' = NonEmpty.toList . NonEmpty.sortBy incXdecY $ ps+                           uh  = NonEmpty.tail . hull' $         ps'+                           lh  = NonEmpty.tail . hull' $ reverse ps'+                       in ConvexPolygon . map toP . reverse $ lh ++ uh++upperHull  :: (Ord r, Num r) => NonEmpty (MyPoint 2 r :+ p) -> NonEmpty (MyPoint 2 r :+ p)+upperHull = hull id+++lowerHull :: (Ord r, Num r) => NonEmpty (MyPoint 2 r :+ p) -> NonEmpty (MyPoint 2 r :+ p)+lowerHull = hull reverse+++-- | Helper function so that that can compute both the upper or the lower hull, depending+-- on the function f+hull               :: (Ord r, Num r)+                   => ([MyPoint 2 r :+ p] -> [MyPoint 2 r :+ p])+                   -> NonEmpty (MyPoint 2 r :+ p) -> NonEmpty (MyPoint 2 r :+ p)+hull _ h@(_ :| []) = h+hull f pts         = hull' .  f+                   . NonEmpty.toList . NonEmpty.sortBy incXdecY $ pts++incXdecY  :: Ord r => (MyPoint 2 r) :+ p -> (MyPoint 2 r) :+ q -> Ordering+incXdecY (MyPoint2 px py :+ _) (MyPoint2 qx qy :+ _) =+  compare px qx <> compare qy py+++-- | Precondition: The list of input points is sorted+hull'          :: (Ord r, Num r) => [MyPoint 2 r :+ p] -> NonEmpty (MyPoint 2 r :+ p)+hull' (a:b:ps) = NonEmpty.fromList $ hull'' [b,a] ps+  where+    hull'' h []      = h+    hull'' h (p:ps') = hull'' (cleanMiddle (p:h)) ps'++    cleanMiddle h@[_,_]                         = h+    cleanMiddle h@(z:y:x:rest)+      | rightTurn (x^.core) (y^.core) (z^.core) = h+      | otherwise                               = cleanMiddle (z:x:rest)+    cleanMiddle _                               = error "cleanMiddle: too few points"++rightTurn       :: (Ord r, Num r) => MyPoint 2 r -> MyPoint 2 r -> MyPoint 2 r -> Bool+rightTurn a b c = ccwP a b c == CW++++ccwP :: (Ord r, Num r) => MyPoint 2 r -> MyPoint 2 r -> MyPoint 2 r -> CCW+ccwP p q r = case z `compare` 0 of+              LT -> CW+              GT -> CCW+              EQ -> CoLinear+     where++       MyPoint2 ux uy = q `subt` p+       MyPoint2 vx vy = r `subt` p+       z              = ux * vy - uy * vx
+ benchmark/Algorithms/Geometry/ConvexHull/GrahamV2.hs view
@@ -0,0 +1,95 @@+{-# Language DeriveGeneric #-}+module Algorithms.Geometry.ConvexHull.GrahamV2( convexHull+                                              , upperHull+                                              , lowerHull, fromP+                                              ) where+++import           Control.DeepSeq+import           Control.Lens ((^.))+import           Data.Ext+import           Data.Geometry.Point+import           Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NonEmpty+import           Data.Monoid+import           GHC.Generics+import qualified Linear.V2 as V2++++newtype MyPoint r = MKPoint (V2.V2 r) deriving (Show,Eq,Ord,Generic)+-- data MyPoint r = MyPoint !r !r deriving (Show,Eq,Ord,Generic)++pattern MyPoint x y = MKPoint (V2.V2 x y)++instance NFData r => NFData (MyPoint r)+++toP (MyPoint x y :+ e) = Point2 x y :+ e+fromP (Point2 x y :+ e) = MyPoint x y :+ e++(MyPoint x y) `subt` (MyPoint a b) = MyPoint (x-a) (y-b)+++newtype ConvexPolygon p r = ConvexPolygon [Point 2 r :+ p] deriving (Show,Eq,NFData)++-- | \(O(n \log n)\) time ConvexHull using Graham-Scan. The resulting polygon is+-- given in clockwise order.+convexHull            :: (Ord r, Num r)+                      => NonEmpty (MyPoint r :+ p) -> ConvexPolygon p r+convexHull (p :| []) = ConvexPolygon $ [toP p]+convexHull ps        = let ps' = NonEmpty.toList . NonEmpty.sortBy incXdecY $ ps+                           uh  = NonEmpty.tail . hull' $         ps'+                           lh  = NonEmpty.tail . hull' $ reverse ps'+                       in ConvexPolygon . map toP . reverse $ lh ++ uh++upperHull  :: (Ord r, Num r) => NonEmpty (MyPoint r :+ p) -> NonEmpty (MyPoint r :+ p)+upperHull = hull id+++lowerHull :: (Ord r, Num r) => NonEmpty (MyPoint r :+ p) -> NonEmpty (MyPoint r :+ p)+lowerHull = hull reverse+++-- | Helper function so that that can compute both the upper or the lower hull, depending+-- on the function f+hull               :: (Ord r, Num r)+                   => ([MyPoint r :+ p] -> [MyPoint r :+ p])+                   -> NonEmpty (MyPoint r :+ p) -> NonEmpty (MyPoint r :+ p)+hull _ h@(_ :| []) = h+hull f pts         = hull' .  f+                   . NonEmpty.toList . NonEmpty.sortBy incXdecY $ pts++incXdecY  :: Ord r => (MyPoint r) :+ p -> (MyPoint r) :+ q -> Ordering+incXdecY (MyPoint px py :+ _) (MyPoint qx qy :+ _) =+  compare px qx <> compare qy py+++-- | Precondition: The list of input points is sorted+hull'          :: (Ord r, Num r) => [MyPoint r :+ p] -> NonEmpty (MyPoint r :+ p)+hull' (a:b:ps) = NonEmpty.fromList $ hull'' [b,a] ps+  where+    hull'' h []      = h+    hull'' h (p:ps') = hull'' (cleanMiddle (p:h)) ps'++    cleanMiddle h@[_,_]                         = h+    cleanMiddle h@(z:y:x:rest)+      | rightTurn (x^.core) (y^.core) (z^.core) = h+      | otherwise                               = cleanMiddle (z:x:rest)+    cleanMiddle _                               = error "cleanMiddle: too few points"++rightTurn       :: (Ord r, Num r) => MyPoint r -> MyPoint r -> MyPoint r -> Bool+rightTurn a b c = ccwP a b c == CW++++ccwP :: (Ord r, Num r) => MyPoint r -> MyPoint r -> MyPoint r -> CCW+ccwP p q r = case z `compare` 0 of+              LT -> CW+              GT -> CCW+              EQ -> CoLinear+     where++       MyPoint ux uy = q `subt` p+       MyPoint vx vy = r `subt` p+       z             = ux * vy - uy * vx
+ benchmark/Algorithms/Geometry/LineSegmentIntersection/Bench.hs view
@@ -0,0 +1,50 @@+module Algorithms.Geometry.LineSegmentIntersection.Bench (benchmark) where++import qualified Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann    as BONew+import qualified Algorithms.Geometry.LineSegmentIntersection.BentleyOttmannOld as BOOld++import           Control.DeepSeq+import           Control.Lens+import           Control.Monad.Random+import           Data.Ext+import           Data.Geometry.LineSegment+import           Data.Geometry.Point+import           Data.Hashable+import qualified Data.List                 as List+import           Data.RealNumber.Rational+import           Test.Tasty.Bench++--------------------------------------------------------------------------------++type R = RealNumber 5++benchmark :: Benchmark+benchmark = bgroup "LineSegmentIntersection"+    [ benchBuild (evalRand (genPts @R 100) gen)+    ]++gen :: StdGen+gen = mkStdGen (hash "line segment intersection")++--------------------------------------------------------------------------------++genPts                 :: (Ord r, Random r, RandomGen g)+                       => Int -> Rand g [LineSegment 2 () r]+genPts n = replicateM n sampleLineSegment++-- | Benchmark computing the closest pair+benchBuild    :: (Ord r, Fractional r, NFData r) => [LineSegment 2 () r] -> Benchmark+benchBuild ss = bgroup "LineSegs" [ bgroup (show n) (build $ take n ss)+                                  | n <- sizes' ss+                                  ]+  where+    sizes' xs = [length xs]+      -- let n = length pts in [ n*i `div` 100 | i <- [10,20,25,50,75,100]]++    build segs = [ bench "sort"     $ nf sort' segs+                 , bench "Old"      $ nf BOOld.intersections segs+                 , bench "New"      $ nf BONew.intersections segs+                 ]++sort' :: Ord r => [LineSegment 2 () r] -> [Point 2 r]+sort' = List.sort . concatMap (\s -> s^..endPoints.core)
+ benchmark/Algorithms/Geometry/LineSegmentIntersection/BentleyOttmannOld.hs view
@@ -0,0 +1,236 @@+{-# LANGUAGE ScopedTypeVariables #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--+-- The \(O((n+k)\log n)\) time line segment intersection algorithm by Bentley+-- and Ottmann.+--+--------------------------------------------------------------------------------+module Algorithms.Geometry.LineSegmentIntersection.BentleyOttmannOld where++import           Algorithms.Geometry.LineSegmentIntersection+import           Control.Lens hiding (contains)+import           Data.Ext+import qualified Data.Foldable as F+import           Data.Geometry.Interval+import           Data.Geometry.LineSegment+import           Data.Geometry.Point+import           Data.Geometry.Properties+import qualified Data.List as L+import           Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NonEmpty+import qualified Data.Map as M+import           Data.Maybe+import           Data.Ord (Down(..), comparing)+import qualified Data.OrdSeq as SS -- status struct+import qualified Data.Set as EQ -- event queue+import           Data.Vinyl+import           Data.Vinyl.CoRec++--------------------------------------------------------------------------------++-- | Compute all intersections+--+-- \(O((n+k)\log n)\), where \(k\) is the number of intersections.+intersections    :: (Ord r, Fractional r)+                 => [LineSegment 2 p r] -> Intersections p r+intersections ss = merge $ sweep pts mempty+  where+    pts = EQ.fromAscList . groupStarts . L.sort . concatMap asEventPts $ ss++-- | Computes all intersection points p s.t. p lies in the interior of at least+-- one of the segments.+--+--  \(O((n+k)\log n)\), where \(k\) is the number of intersections.+interiorIntersections :: (Ord r, Fractional r)+                       => [LineSegment 2 p r] -> Intersections p r+interiorIntersections = M.filter (not . isEndPointIntersection) . intersections++-- | Computes the event points for a given line segment+asEventPts   :: Ord r => LineSegment 2 p r -> [Event p r]+asEventPts s = let [p,q] = L.sortBy ordPoints [s^.start.core,s^.end.core]+               in [Event p (Start $ s :| []), Event q (End s)]++-- | Group the segments with the intersection points+merge :: Ord r =>  [IntersectionPoint p r] -> Intersections p r+merge = foldr (\(IntersectionPoint p a) -> M.insertWith (<>) p a) M.empty++-- | Group the startpoints such that segments with the same start point+-- correspond to one event.+groupStarts                          :: Eq r => [Event p r] -> [Event p r]+groupStarts []                       = []+groupStarts (Event p (Start s) : es) = Event p (Start ss) : groupStarts rest+  where+    (ss',rest) = L.span sameStart es+    -- sort the segs on lower endpoint+    ss         = let (x:|xs) = s in x :| (xs ++ concatMap startSegs ss')++    sameStart (Event q (Start _)) = p == q+    sameStart _                   = False+groupStarts (e : es)                 = e : groupStarts es++--------------------------------------------------------------------------------+-- * Data type for Events++-- | Type of segment+data EventType s = Start !(NonEmpty s)| Intersection | End !s deriving (Show)++instance Eq (EventType s) where+  a == b = a `compare` b == EQ++instance Ord (EventType s) where+  (Start _)    `compare` (Start _)    = EQ+  (Start _)    `compare` _            = LT+  Intersection `compare` (Start _)    = GT+  Intersection `compare` Intersection = EQ+  Intersection `compare` (End _)      = LT+  (End _)      `compare` (End _)      = EQ+  (End _)      `compare` _            = GT++-- | The actual event consists of a point and its type+data Event p r = Event { eventPoint :: !(Point 2 r)+                       , eventType  :: !(EventType (LineSegment 2 p r))+                       } deriving (Show,Eq)++instance Ord r => Ord (Event p r) where+  -- decreasing on the y-coord, then increasing on x-coord, and increasing on event-type+  (Event p s) `compare` (Event q t) = case ordPoints p q of+                                        EQ -> s `compare` t+                                        x  -> x++-- | An ordering that is decreasing on y, increasing on x+ordPoints     :: Ord r => Point 2 r -> Point 2 r -> Ordering+ordPoints a b = let f p = (Down $ p^.yCoord, p^.xCoord) in comparing f a b++-- | Get the segments that start at the given event point+startSegs   :: Event p r -> [LineSegment 2 p r]+startSegs e = case eventType e of+                Start ss -> NonEmpty.toList ss+                _        -> []++--------------------------------------------------------------------------------++-- | Compare based on the x-coordinate of the intersection with the horizontal+-- line through y+ordAt   :: (Fractional r, Ord r) => r -> Compare (LineSegment 2 p r)+ordAt y = comparing (xCoordAt y)++-- | Given a y coord and a line segment that intersects the horizontal line+-- through y, compute the x-coordinate of this intersection point.+--+-- note that we will pretend that the line segment is closed, even if it is not+xCoordAt             :: (Fractional r, Ord r) => r -> LineSegment 2 p r -> r+xCoordAt y (LineSegment' (Point2 px py :+ _) (Point2 qx qy :+ _))+      | py == qy     = px `max` qx  -- s is horizontal, and since it by the+                                    -- precondition it intersects the sweep+                                    -- line, we return the x-coord of the+                                    -- rightmost endpoint.+      | otherwise    = px + alpha * (qx - px)+  where+    alpha = (y - py) / (qy - py)++--------------------------------------------------------------------------------+-- * The Main Sweep++type EventQueue      p r = EQ.Set (Event p r)+type StatusStructure p r = SS.OrdSeq (LineSegment 2 p r)++-- | Run the sweep handling all events+sweep       :: (Ord r, Fractional r)+            => EventQueue p r -> StatusStructure p r -> [IntersectionPoint p r]+sweep eq ss = case EQ.minView eq of+    Nothing      -> []+    Just (e,eq') -> handle e eq' ss++isClosedStart                     :: Eq r => Point 2 r -> LineSegment 2 p r -> Bool+isClosedStart p (LineSegment s e)+  | p == s^.unEndPoint.core       = isClosed s+  | otherwise                     = isClosed e++-- | Handle an event point+handle                           :: forall r p. (Ord r, Fractional r)+                                 => Event p r -> EventQueue p r -> StatusStructure p r+                                 -> [IntersectionPoint p r]+handle e@(eventPoint -> p) eq ss = toReport <> sweep eq' ss'+  where+    starts                   = startSegs e+    (before,contains',after) = extractContains p ss+    (ends,contains)          = L.partition (endsAt p) contains'+    -- starting segments, exluding those that have an open starting point+    starts'  = filter (isClosedStart p) starts+    toReport = case starts' ++ contains' of+                 (_:_:_) -> [IntersectionPoint p $ associated (starts' <> ends) contains]+                 _       -> []++    -- new status structure+    ss' = before <> newSegs <> after+    newSegs = toStatusStruct p $ starts ++ contains++    -- the new eeventqueue+    eq' = foldr EQ.insert eq es+    -- the new events:+    es | F.null newSegs  = maybeToList $ app (findNewEvent p) sl sr+       | otherwise       = let s'  = fst <$> SS.minView newSegs+                               s'' = fst <$> SS.maxView newSegs+                           in catMaybes [ app (findNewEvent p) sl  s'+                                        , app (findNewEvent p) s'' sr+                                        ]+    sl = fst <$> SS.maxView before+    sr = fst <$> SS.minView after++    app f x y = do { x' <- x ; y' <- y ; f x' y'}++-- | split the status structure, extracting the segments that contain p.+-- the result is (before,contains,after)+extractContains      :: (Fractional r, Ord r)+                     => Point 2 r -> StatusStructure p r+                     -> (StatusStructure p r, [LineSegment 2 p r], StatusStructure p r)+extractContains p ss = (before, F.toList $ mid1 <> mid2, after)+  where+    (before, mid1, after') = SS.splitOn (xCoordAt $ p^.yCoord) (p^.xCoord) ss+    -- Make sure to also select the horizontal segments containing p+    (mid2, after) = SS.splitMonotonic (not . intersects p) after'++-- | Given a point and the linesegements that contain it. Create a piece of+-- status structure for it.+toStatusStruct      :: (Fractional r, Ord r)+                    => Point 2 r -> [LineSegment 2 p r] -> StatusStructure p r+toStatusStruct p xs = ss <> hors+  -- ss { SS.nav = ordAtNav $ p^.yCoord } `SS.join` hors+  where+    (hors',rest) = L.partition isHorizontal xs+    ss           = SS.fromListBy (ordAt $ maxY xs) rest+    hors         = SS.fromListBy (comparing rightEndpoint) hors'++    isHorizontal s  = s^.start.core.yCoord == s^.end.core.yCoord++    -- find the y coord of the first interesting thing below the sweep at y+    maxY = maximum . filter (< p^.yCoord)+         . concatMap (\s -> [s^.start.core.yCoord,s^.end.core.yCoord])++-- | Get the right endpoint of a segment+rightEndpoint   :: Ord r => LineSegment 2 p r -> r+rightEndpoint s = (s^.start.core.xCoord) `max` (s^.end.core.xCoord)++-- | Test if a segment ends at p+endsAt                      :: Ord r => Point 2 r -> LineSegment 2 p r -> Bool+endsAt p (LineSegment' a b) = all (\q -> ordPoints (q^.core) p /= GT) [a,b]++--------------------------------------------------------------------------------+-- * Finding New events++-- | Find all events+findNewEvent       :: (Ord r, Fractional r)+                   => Point 2 r -> LineSegment 2 p r -> LineSegment 2 p r+                   -> Maybe (Event p r)+findNewEvent p l r = match (l `intersect` r) $+     (H $ \NoIntersection -> Nothing)+  :& (H $ \q              -> if ordPoints q p == GT then Just (Event q Intersection)+                                      else Nothing)+  :& (H $ \_              -> Nothing) -- full segment intersectsions are handled+                                      -- at insertion time+  :& RNil
+ benchmark/Algorithms/Geometry/PolygonTriangulation/Bench.hs view
@@ -0,0 +1,64 @@+module Algorithms.Geometry.PolygonTriangulation.Bench where+{-+import Algorithms.Geometry.LineSegmentIntersection (hasSelfIntersections)+import qualified Algorithms.Geometry.PolygonTriangulation.MakeMonotone as New+import qualified Algorithms.Geometry.PolygonTriangulation.MakeMonotoneOld as Old+import           Benchmark.Util+import           Control.DeepSeq+import           Control.Lens+import           Data.Ext+import           Test.Tasty.Bench+import qualified Data.Foldable as F+import           Data.Geometry.Ipe+import           Data.Geometry.LineSegment+import           Data.Geometry.Polygon+import           Data.Geometry.PlanarSubdivision+import           Data.Geometry.Point+import qualified Data.LSeq as LSeq+import qualified Data.List as List+import           Data.Proxy+import           Test.QuickCheck++--------------------------------------------------------------------------------++data PX = PX++main :: IO ()+main = do+    polies <- getPolies "/home/frank/tmp/antarctica.ipe"+    defaultMain [ benchBuild polies ]++getPolies inFile = do+    ePage <- readSinglePageFile inFile+    case ePage of+      Left err                         -> error $ show err+      Right (page :: IpePage Rational) -> pure $ runPage page+  where+    runPage page =+      let polies  = page^..content.to flattenGroups.traverse._withAttrs _IpePath _asSimplePolygon+      in filter (not . hasSelfIntersections . (^.core)) polies+++process f polies = let subdivs = map (\(pg :+ _) -> f (Identity PX) pg) polies+                   in concatMap (\ps -> map (^._2.core) . F.toList . edgeSegments $ ps) subdivs++-- benchmark :: Benchmark+-- benchmark = bgroup "MakeMonotoneBench"+--     [ env (genPts (Proxy :: Proxy Rational) 100) benchBuild+--     ]++--------------------------------------------------------------------------------++-- | Benchmark computing the closest pair+benchBuild    :: (Ord r, Fractional r, NFData r) => [Polygon t () r :+ p] -> Benchmark+benchBuild ss = bgroup "MakeMonotone" [ bgroup (show n) (build $ take n ss)+                                      | n <- sizes' ss+                                      ]+  where+    sizes' xs = [length xs]+      -- let n = length pts in [ n*i `div` 100 | i <- [10,20,25,50,75,100]]++    build ps = [ bench "Old"      $ nf (process Old.makeMonotone) ps+               , bench "New"      $ nf (process New.makeMonotone) ps+               ]+-}
+ benchmark/Algorithms/Geometry/PolygonTriangulation/MakeMonotoneOld.hs view
@@ -0,0 +1,312 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell     #-}+module Algorithms.Geometry.PolygonTriangulation.MakeMonotoneOld where++import Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann (ordAt, xCoordAt)+import Algorithms.Geometry.PolygonTriangulation.Types++import           Control.Lens+import           Control.Monad                         (forM_, when)+import           Control.Monad.Reader+import           Control.Monad.State.Strict+import           Control.Monad.Writer                  (WriterT, execWriterT, tell)+import           Data.Bifunctor+import           Data.CircularSeq                      (rotateL, rotateR, zip3LWith)+import qualified Data.DList                            as DList+import           Data.Ext+import qualified Data.Foldable                         as F+import           Data.Geometry.LineSegment+import           Data.Geometry.PlanarSubdivision.Basic+import           Data.Geometry.Point+import           Data.Geometry.Polygon+import qualified Data.IntMap                           as IntMap+import qualified Data.List.NonEmpty                    as NonEmpty+import           Data.Ord                              (Down (..), comparing)+import           Data.OrdSeq                           (OrdSeq)+import qualified Data.OrdSeq                           as SS+import           Data.Util+import qualified Data.Vector                           as V+import qualified Data.Vector.Circular                  as CV+import qualified Data.Vector.Mutable                   as MV+++----------------------------------------------------------------------------------++data VertexType = Start | Merge | Split | End | Regular deriving (Show,Read,Eq)+++-- How about the hole vertices?++-- | assigns a vertex type to each vertex+--+-- pre: the polygon is given in CCW order+--+-- running time: \(O(n)\).+classifyVertices                     :: (Num r, Ord r)+                                     => Polygon t p r+                                     -> Polygon t (p :+ VertexType) r+classifyVertices p@SimplePolygon{}   = classifyVertices' p+classifyVertices (MultiPolygon vs h) = MultiPolygon vs' h'+  where+    vs' = classifyVertices' vs+    h' = map (first (&extra %~ onHole) . classifyVertices') h++    -- the roles on hole vertices are slightly different+    onHole Start   = Split+    onHole Merge   = End+    onHole Split   = Start+    onHole End     = Merge+    onHole Regular = Regular++-- | assigns a vertex type to each vertex+--+-- pre: the polygon is given in CCW order+--+-- running time: \(O(n)\).+classifyVertices'                    :: (Num r, Ord r)+                                     => SimplePolygon p r+                                     -> SimplePolygon (p :+ VertexType) r+classifyVertices' poly =+    -- SimplePolygon $ zip3LWith f (rotateL vs) vs (rotateR vs)+    unsafeFromCircularVector $ CV.zipWith3 f (CV.rotateLeft 1 vs) vs (CV.rotateRight 1 vs)+  where+    vs = poly ^. outerBoundaryVector+    -- is the angle larger than > 180 degrees+    largeInteriorAngle p c n = case ccw (p^.core) (c^.core) (n^.core) of+           CCW -> False+           CW  -> True+           _   -> error "classifyVertices -> largeInteriorAngle: colinear points"++    f p c n = c&extra %~ (:+ vt)+      where+        vt = case (p `cmpSweep` c, n `cmpSweep` c, largeInteriorAngle p c n) of+               (LT, LT, False) -> Start+               (LT, LT, True)  -> Split+               (GT, GT, False) -> End+               (GT, GT, True)  -> Merge+               _               -> Regular++++-- | p < q = p.y < q.y || p.y == q.y && p.x > q.y+cmpSweep :: Ord r => Point 2 r :+ e -> Point 2 r :+ e -> Ordering+p `cmpSweep` q =+  comparing (^.core.yCoord) p q <> comparing (Down . (^.core.xCoord)) p q+++--------------------------------------------------------------------------------++type Event r = Point 2 r :+ (Two (LineSegment 2 Int r))++data StatusStruct r = SS { _statusStruct :: !(SS.OrdSeq (LineSegment 2 Int r))+                         , _helper       :: !(IntMap.IntMap Int)+                         -- ^ for every e_i, the id of the helper vertex+                         } deriving (Show)+makeLenses ''StatusStruct++ix'   :: Int -> Lens' (V.Vector a) a+ix' i = singular (ix i)++-- | Given a polygon, find a set of non-intersecting diagonals that partition+-- the polygon into y-monotone pieces.+--+-- running time: \(O(n\log n)\)+computeDiagonals    :: forall t r p. (Fractional r, Ord r)+                    => Polygon t p r -> [LineSegment 2 p r]+computeDiagonals p' = map f . sweep+                    . NonEmpty.sortBy (flip cmpSweep)+                    . polygonVertices . withIncidentEdges+                    . first (^._1) $ pg+  where+    -- remaps to get the p value rather than the vertexId+    f = first (\i -> vertexInfo^.ix' i._2)++    pg :: Polygon t (SP Int (p :+ VertexType)) r+    pg = numberVertices . classifyVertices . toCounterClockWiseOrder $ p'+    vertexInfo :: V.Vector (STR (Point 2 r) p VertexType)+    vertexInfo = let vs = polygonVertices pg+                     n  = F.length vs+                 in V.create $ do+                   v <- MV.new n+                   forM_ vs $ \(pt :+ SP i (p :+ vt)) ->+                     MV.write v i (STR pt p vt)+                   return v++    initialSS = SS mempty mempty++    sweep  es = flip runReader vertexInfo $ evalStateT (sweep' es) initialSS+    sweep' es = DList.toList <$> execWriterT (sweep'' es)++    sweep'' :: NonEmpty.NonEmpty (Event r) -> Sweep p r ()+    sweep'' = mapM_ handle++-- | Computes a set of diagionals that decompose the polygon into y-monotone+-- pieces.+--+-- running time: \(O(n\log n)\)+makeMonotone      :: (Fractional r, Ord r)+                  => proxy s -> Polygon t p r+                  -> PlanarSubdivision s p PolygonEdgeType PolygonFaceData r+makeMonotone px pg = let (e:es) = listEdges pg+                     in constructSubdivision px e es (computeDiagonals pg)++type Sweep p r = WriterT (DList.DList (LineSegment 2 Int r))+                   (StateT (StatusStruct r)+                     (Reader (V.Vector (VertexInfo p r))))++type VertexInfo p r = STR (Point 2 r) p VertexType+++tell' :: LineSegment 2 Int r -> Sweep p r ()+tell' = tell . DList.singleton++getIdx :: Event r -> Int+getIdx = view (extra._1.end.extra)++getVertexType   :: Int -> Sweep p r VertexType+getVertexType v = asks (^.ix' v._3)++getEventType :: Event r -> Sweep p r VertexType+getEventType = getVertexType . getIdx++handle   :: (Fractional r, Ord r) => Event r -> Sweep p r ()+handle e = let i = getIdx e in getEventType e >>= \case+    Start   -> handleStart   i e+    End     -> handleEnd     i e+    Split   -> handleSplit   i e+    Merge   -> handleMerge   i e+    Regular | isLeftVertex i e -> handleRegularL i e+            | otherwise        -> handleRegularR i e+++insertAt   :: (Ord r, Fractional r) => Point 2 r -> LineSegment 2 q r+           -> OrdSeq (LineSegment 2 q r) -> OrdSeq (LineSegment 2 q r)+insertAt v = SS.insertBy (ordAt $ v^.yCoord)++deleteAt   :: (Fractional r, Ord r) => Point 2 r -> LineSegment 2 p r+           -> OrdSeq (LineSegment 2 p r) -> OrdSeq (LineSegment 2 p r)+deleteAt v = SS.deleteAllBy (ordAt $ v^.yCoord)+++handleStart              :: (Fractional r, Ord r)+                         => Int -> Event r -> Sweep p r ()+handleStart i (v :+ adj) = modify $ \(SS t h) ->+                                SS (insertAt v (adj^._2) t)+                                   (IntMap.insert i i h)++handleEnd              :: (Fractional r, Ord r)+                       => Int -> Event r -> Sweep p r ()+handleEnd i (v :+ adj) = do let iPred = adj^._1.start.extra  -- i-1+                            -- lookup p's helper; if it is a merge vertex+                            -- we insert a new segment+                            tellIfMerge i v iPred+                            -- delete e_{i-1} from the status struct+                            modify $ \ss ->+                              ss&statusStruct %~ deleteAt v (adj^._1)++-- | Adds edge (i,j) if e_j's helper is a merge vertex+tellIfMerge       :: Int -> Point 2 r -> Int -> Sweep p r ()+tellIfMerge i v j = do SP u ut <- getHelper j+                       when (ut == Merge) (tell' $ ClosedLineSegment (v :+ i) u)++-- | Get the helper of edge i, and its vertex type+getHelper   :: Int -> Sweep p r (SP (Point 2 r :+ Int) VertexType)+getHelper i = do ui         <- gets (^?!helper.ix i)+                 STR u _ ut <- asks (^.ix' ui)+                 pure $ SP (u :+ ui) ut+++lookupLE     :: (Ord r, Fractional r)+             => Point 2 r -> OrdSeq (LineSegment 2 Int r)+             -> Maybe (LineSegment 2 Int r)+lookupLE v s = let (l,m,_) = SS.splitOn (xCoordAt $ v^.yCoord) (v^.xCoord) s+               in SS.lookupMax (l <> m)+++handleSplit              :: (Fractional r, Ord r) => Int -> Event r -> Sweep p r ()+handleSplit i (v :+ adj) = do ej <- gets $ \ss -> ss^?!statusStruct.to (lookupLE v)._Just+                              let j = ej^.start.extra+                              SP u _ <- getHelper j+                              -- update the status struct:+                              -- insert the new edge into the status Struct and+                              -- set the helper of e_j to be v_i+                              modify $ \(SS t h) ->+                                SS (insertAt v (adj^._2) t)+                                   (IntMap.insert i i . IntMap.insert j i $ h)+                              -- return the diagonal+                              tell' $ ClosedLineSegment (v :+ i) u++handleMerge              :: (Fractional r, Ord r) => Int -> Event r -> Sweep p r ()+handleMerge i (v :+ adj) = do let ePred = adj^._1.start.extra -- i-1+                              tellIfMerge i v ePred+                              -- delete e_{i-1} from the status struct+                              modify $ \ss -> ss&statusStruct %~ deleteAt v (adj^._1)+                              connectToLeft i v++-- | finds the edge j to the left of v_i, and connect v_i to it if the helper+-- of j is a merge vertex+connectToLeft     :: (Fractional r, Ord r) => Int -> Point 2 r -> Sweep p r ()+connectToLeft i v = do ej <- gets $ \ss -> ss^?!statusStruct.to (lookupLE v)._Just+                       let j = ej^.start.extra+                       tellIfMerge i v j+                       modify $ \ss -> ss&helper %~ IntMap.insert j i++-- | returns True if v the interior of the polygon is to the right of v+isLeftVertex              :: Ord r => Int -> Event r -> Bool+isLeftVertex i (v :+ adj) = case (adj^._1.start) `cmpSweep` (v :+ i) of+                              GT -> True+                              _  -> False+  -- if the predecessor occurs before the sweep, this must be a left vertex++handleRegularL              :: (Fractional r, Ord r) => Int -> Event r -> Sweep p r ()+handleRegularL i (v :+ adj) = do let ePred = adj^._1.start.extra -- i-1+                                 tellIfMerge i v ePred+                                 -- delete e_{i-1} from the status struct+                                 modify $ \ss ->+                                   ss&statusStruct %~ deleteAt v (adj^._1)+                                 -- insert a e_i in the status struct, and set its helper+                                 -- to be v_i+                                 modify $ \(SS t h) ->+                                     SS (insertAt v (adj^._2) t)+                                        (IntMap.insert i i h)++handleRegularR            :: (Fractional r, Ord r) => Int -> Event r -> Sweep p r ()+handleRegularR i (v :+ _) = connectToLeft i v+++++--------------------------------------------------------------------------------+++-- testPolygon :: SimplePolygon Int Rational+-- testPolygon = fromPoints [ Point2 20 20 :+ 1+--                          , Point2 18 19 :+ 2+--                          , Point2 16 25 :+ 3+--                          , Point2 13 23 :+ 4+--                          , Point2 10 24 :+ 5+--                          , Point2 6  22 :+ 6+--                          , Point2 8  21 :+ 7+--                          , Point2 7  18 :+ 8+--                          , Point2 2  19 :+ 9+--                          , Point2 1  10 :+ 10+--                          , Point2 3  5  :+ 11+--                          , Point2 11 7  :+ 12+--                          , Point2 15 1  :+ 13+--                          , Point2 12 15 :+ 14+--                          , Point2 15 12 :+ 15+--                          ]++-- vertexTypes = [Start,Merge,Start,Merge,Start,Regular,Regular,Merge,Start,Regular,End,Split,End,Split,End]+++-- loadT = do pgs <- readAllFrom "/Users/frank/tmp/testPoly.ipe"+--                         :: IO [SimplePolygon () Rational :+ IpeAttributes Path Rational]+--            mapM_ print pgs+--            let diags = map (computeDiagonals . (^.core)) pgs+--                f = asIpeGroup . map (asIpeObject' mempty)+--                out = [ asIpeGroup $ map (\(pg :+ a) -> asIpeObject pg a) pgs+--                      , asIpeGroup $ map f diags+--                      ]+--                outFile = "/Users/frank/tmp/out.ipe"+--            writeIpeFile outFile . singlePageFromContent $ out
+ benchmark/Benchmark/Util.hs view
@@ -0,0 +1,7 @@+module Benchmark.Util where++++-- | Generates different size benchmarks+sizes    :: Foldable f => f a -> [Int]+sizes xs = let n = length xs in (\i -> n*i `div` 100) <$> [5,10..100]
+ benchmark/Benchmarks.hs view
@@ -0,0 +1,10 @@+module Main where++import qualified Algorithms.Geometry.ClosestPair.Bench as CP+import qualified Algorithms.Geometry.LineSegmentIntersection.Bench as Line+-- import qualified Algorithms.Geometry.PolygonTriangulation.Bench as M+import qualified Algorithms.Geometry.ConvexHull.Bench as M+import           Test.Tasty.Bench++main :: IO ()+main = defaultMain [ CP.benchmark, M.benchmark, Line.benchmark ]
+ benchmark/Data/Geometry/IntervalTreeBench.hs view
@@ -0,0 +1,75 @@+module Data.Geometry.IntervalTreeBench where++import           Benchmark.Util+import           Control.DeepSeq+import           Control.Lens+import           Test.Tasty.Bench+import           Data.Ext+import           Data.Geometry.Interval+import qualified Data.Geometry.IntervalTree as IT+import           Data.Geometry.SegmentTree (I(..))+import qualified Data.Geometry.SegmentTree as SegTree+import qualified Data.List.NonEmpty as NonEmpty+import           Debug.Trace+import           Test.QuickCheck++--------------------------------------------------------------------------------++main :: IO ()+main = defaultMain [ intervalBench ]++intervalBench :: Benchmark+intervalBench = bgroup "IntervalTree"+    [ -- env (genIntervals (I (5 :: Int)) 1000) benchBuild+      -- env (genIntervals (I (5 :: Int)) 100) benchQueryIT+    ]++--------------------------------------------------------------------------------++-- | generates n random intervals+genIntervals                  :: (Ord r, Arbitrary r)+                              => proxy r -> Int -> IO [Interval () r]+genIntervals _ n | n <= 0     = error "genIntervals: need n > 0"+                 | otherwise  = generate (vectorOf n arbitrary)++genQueries                      :: (Ord r, Arbitrary r)+                                => proxy r -> Int -> IO [r]+genQueries _ n | n <= 0     = error "genQueries: need n > 0"+               | otherwise  = generate (vectorOf n arbitrary)+++-- genQuerySetup     :: (Ord r, Arbitrary r)+--                   => proxy r -> Int -> IO (Int,IT.IntervalTree (I (Interval () r)) r, [r])+-- genQuerySetup p n = (\is qs -> (n, IT.fromIntervals . fmap I $ is, qs))+--                  <$> genIntervals p n+--                  <*> genQueries   p n+++-- | Benchmark building the interval tree+benchBuild    :: (Ord r, NFData r) => [Interval () r] -> Benchmark+benchBuild is = bgroup "build" [ bench (show n) $ nf IT.fromIntervals (take n is')+                               | n <- sizes is+                               ]+  where+    is' = I <$> is++-- benchQueryIT    :: (Ord r, Arbitrary r, NFData r) => [Interval () r] -> Benchmark+-- benchQueryIT is = bgroup "queries"+--     [ env (setup' n) (\(t,qs) ->+--                         bench ("queries on size" ++ show n) $ whnf (queryAll t) qs)+--     | n <- sizes is+--     ]+--   where+--     is'        = I <$> is+--     r          = is^.to head.start.core+--     setup' n  = traceShow "setup" $ setup n++--     setup n    = (IT.fromIntervals (take n is'),) <$> genQueries (I r) 100000+--     queryAll t = map (flip IT.search t)+++-- benchQueryIT          :: Ord r+--                       => (Int, IT.IntervalTree (I (Interval () r)) r, [r]) -> Benchmark+-- benchQueryIT (n,t,qs) = bgroup "queries" [ bench "query" $ whnf (flip IT.search t) q+--                                          | q <- qs+--                                          ]
+ benchmark/Data/Geometry/Vector/VectorFamily6.hs view
@@ -0,0 +1,257 @@+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE UndecidableInstances #-}+module Data.Geometry.Vector.VectorFamily6 where++import           Control.Applicative (liftA2)+import           Control.DeepSeq+import           Control.Lens hiding (element)+-- import           Data.Aeson (ToJSON(..),FromJSON(..))+import qualified Data.Foldable as F+import qualified Data.Geometry.Vector.VectorFixed as FV+import           Data.Maybe (fromMaybe)+import           Data.Proxy+import           Data.Traversable (foldMapDefault,fmapDefault)+import qualified Data.Vector.Fixed as V+import           Data.Vector.Fixed.Cont (Peano(..), PeanoNum(..), Fun(..))+import           GHC.TypeLits+import           Linear.Affine (Affine(..))+import           Linear.Metric+import qualified Linear.V2 as L2+import qualified Linear.V3 as L3+import qualified Linear.V4 as L4+import           Linear.Vector++--------------------------------------------------------------------------------+-- * d dimensional Vectors+++type One = S Z+type Two = S One+type Three = S Two+type Four = S Three+type Many d = S (S (S (S (S d))))+++type family FromPeano (d :: PeanoNum) :: Nat where+  FromPeano Z     = 0+  FromPeano (S d) = 1 + FromPeano d+++data SingPeano (d :: PeanoNum) where+  SZ :: SingPeano Z+  SS :: !(SingPeano d) -> SingPeano (S d)++class ImplicitPeano (d :: PeanoNum) where+  implicitPeano :: SingPeano d+instance ImplicitPeano Z where+  implicitPeano = SZ+instance ImplicitPeano d => ImplicitPeano (S d) where+  implicitPeano = SS implicitPeano++-- | Mapping between the implementation type, and the actual implementation.+type family VectorFamilyF (d :: PeanoNum) :: * -> * where+  VectorFamilyF Z        = Const ()+  VectorFamilyF One      = Identity+  VectorFamilyF Two      = L2.V2+  VectorFamilyF Three    = L3.V3+  VectorFamilyF Four     = L4.V4+  VectorFamilyF (Many d) = FV.Vector (FromPeano (Many d))+++-- | Datatype representing d dimensional vectors. The default implementation is+-- based n VectorFixed. However, for small vectors we automatically select a+-- more efficient representation.+newtype VectorFamily (d :: PeanoNum) (r :: *) =+  VectorFamily { _unVF :: VectorFamilyF d r }++type ImplicitArity d = (ImplicitPeano d, V.Arity (FromPeano d))++++instance (Eq r, ImplicitArity d) => Eq (VectorFamily d r) where+  (VectorFamily u) == (VectorFamily v) = case (implicitPeano :: SingPeano d) of+        SZ                         -> u == v+        (SS SZ)                    -> u == v+        (SS (SS SZ))               -> u == v+        (SS (SS (SS SZ)))          -> u == v+        (SS (SS (SS (SS SZ))))     -> u == v+        (SS (SS (SS (SS (SS _))))) -> u == v+  {-# INLINE (==) #-}++instance (Ord r, ImplicitArity d) => Ord (VectorFamily d r) where+  (VectorFamily u) `compare` (VectorFamily v) = case (implicitPeano :: SingPeano d) of+        SZ                         -> u `compare` v+        (SS SZ)                    -> u `compare` v+        (SS (SS SZ))               -> u `compare` v+        (SS (SS (SS SZ)))          -> u `compare` v+        (SS (SS (SS (SS SZ))))     -> u `compare` v+        (SS (SS (SS (SS (SS _))))) -> u `compare` v+  {-# INLINE compare #-}+++instance ImplicitArity d => Functor (VectorFamily d) where+  fmap f = VectorFamily . g f . _unVF+    where g = case (implicitPeano :: SingPeano d) of+                SZ                         -> fmap+                (SS SZ)                    -> fmap+                (SS (SS SZ))               -> fmap+                (SS (SS (SS SZ)))          -> fmap+                (SS (SS (SS (SS SZ))))     -> fmap+                (SS (SS (SS (SS (SS _))))) -> fmap+  {-# INLINE fmap #-}+++instance ImplicitArity d => Foldable (VectorFamily d) where+  foldMap f = g f . _unVF+    where g = case (implicitPeano :: SingPeano d) of+                SZ                         -> foldMap+                (SS SZ)                    -> foldMap+                (SS (SS SZ))               -> foldMap+                (SS (SS (SS SZ)))          -> foldMap+                (SS (SS (SS (SS SZ))))     -> foldMap+                (SS (SS (SS (SS (SS _))))) -> foldMap+  {-# INLINE foldMap #-}++instance ImplicitArity d => Traversable (VectorFamily d) where+  traverse f = fmap VectorFamily . g f . _unVF+    where g = case (implicitPeano :: SingPeano d) of+                SZ                         -> traverse+                (SS SZ)                    -> traverse+                (SS (SS SZ))               -> traverse+                (SS (SS (SS SZ)))          -> traverse+                (SS (SS (SS (SS SZ))))     -> traverse+                (SS (SS (SS (SS (SS _))))) -> traverse+  {-# INLINE traverse #-}++instance ImplicitArity d => Applicative (VectorFamily d) where+  pure = VectorFamily . case (implicitPeano :: SingPeano d) of+                SZ                         -> pure+                (SS SZ)                    -> pure+                (SS (SS SZ))               -> pure+                (SS (SS (SS SZ)))          -> pure+                (SS (SS (SS (SS SZ))))     -> pure+                (SS (SS (SS (SS (SS _))))) -> pure+  {-# INLINE pure #-}+  liftA2 f (VectorFamily u) (VectorFamily v) = VectorFamily $+      case (implicitPeano :: SingPeano d) of+                SZ                         -> liftA2 f u v+                (SS SZ)                    -> liftA2 f u v+                (SS (SS SZ))               -> liftA2 f u v+                (SS (SS (SS SZ)))          -> liftA2 f u v+                (SS (SS (SS (SS SZ))))     -> liftA2 f u v+                (SS (SS (SS (SS (SS _))))) -> liftA2 f u v+  {-# INLINE liftA2 #-}+++++type instance V.Dim (VectorFamily d)  = FromPeano d+++++instance ImplicitArity d => V.Vector (VectorFamily d) r where+  construct = fmap VectorFamily $ case (implicitPeano :: SingPeano d) of+                SZ                         -> Fun $ Const ()+                (SS SZ)                    -> V.construct+                (SS (SS SZ))               -> Fun L2.V2+                (SS (SS (SS SZ)))          -> Fun L3.V3+                (SS (SS (SS (SS SZ))))     -> Fun L4.V4+                (SS (SS (SS (SS (SS _))))) -> V.construct+  {-# INLINE construct #-}+  inspect (VectorFamily v) ff@(Fun f) = case (implicitPeano :: SingPeano d) of+                SZ                         -> f+                (SS SZ)                    -> V.inspect v ff+                (SS (SS SZ))               -> let (L2.V2 x y) = v     in f x y+                (SS (SS (SS SZ)))          -> let (L3.V3 x y z) = v   in f x y z+                (SS (SS (SS (SS SZ))))     -> let (L4.V4 x y z w) = v in f x y z w+                (SS (SS (SS (SS (SS _))))) -> V.inspect v ff+  {-# INLINE inspect #-}+  -- basicIndex (VectorFamily v) i = case (implicitPeano :: SingPeano d) of+  --               SZ                         -> err+  --               (SS SZ)                    -> if i == 0 then runIdentity v else err+  --               (SS (SS SZ))               -> let (L2.V2 x y) = v     in f x y+  --               (SS (SS (SS SZ)))          -> let (L3.V3 x y z) = v   in f x y z+  --               (SS (SS (SS (SS SZ))))     -> let (L4.V4 x y z w) = v in f x y z w+  --               (SS (SS (SS (SS (SS _))))) -> V.basicIndex v i+  --   where+  --     err = error "VectorFamily: basicIndex out of range"+  -- {-# INLINE basicIndex #-}+++instance (ImplicitArity d, Show r) => Show (VectorFamily d r) where+  show v = mconcat [ "Vector", show $ F.length v , " "+                   , show $ F.toList v ]++deriving instance (NFData (VectorFamilyF d r)) => NFData (VectorFamily d r)+++type instance Index   (VectorFamily d r) = Int+type instance IxValue (VectorFamily d r) = r++--------------------------------------------------------------------------------+++newtype Vector (d :: Nat) (r :: *) = MKVector { _unV :: VectorFamily (Peano d) r }++type instance V.Dim (Vector d)  = d+++type instance Index   (Vector d r) = Int+type instance IxValue (Vector d r) = r++type Arity d = ImplicitArity (Peano d)++deriving instance (Eq r,  Arity d) => Eq  (Vector d r)+deriving instance (Ord r, Arity d) => Ord (Vector d r)++deriving instance Arity d => Functor     (Vector d)+deriving instance Arity d => Foldable    (Vector d)+deriving instance Arity d => Traversable (Vector d)++instance (Arity d, Show r) => Show (Vector d r) where+  show v = mconcat [ "Vector", show $ F.length v , " "+                   , show $ F.toList v ]+++deriving instance (NFData (VectorFamily (Peano d) r)) => NFData (Vector d r)+++++--------------------------------------------------------------------------------+-- * Convenience "constructors"++pattern Vector   :: VectorFamilyF (Peano d) r -> Vector d r+pattern Vector v = MKVector (VectorFamily v)++pattern Vector1   :: r -> Vector 1 r+pattern Vector1 x = (Vector (Identity x))++pattern Vector2     :: r -> r -> Vector 2 r+pattern Vector2 x y = (Vector (L2.V2 x y))++pattern Vector3        :: r -> r -> r -> Vector 3 r+pattern Vector3 x y z  = (Vector (L3.V3 x y z))++pattern Vector4         :: r -> r -> r -> r -> Vector 4 r+pattern Vector4 x y z w = (Vector (L4.V4 x y z w))++--------------------------------------------------------------------------------++-- -- destruct            :: (Vec d r, Vec (d + 1) r, 1 <= (d + 1))+-- --                     => Vector (d + 1) r -> (r, Vector d r)+-- -- destruct (Vector v) = (V.head v, Vector $ V.tail v)+++-- -- -- vectorFromList :: Arity d => [a] -> Maybe (Vector d a)+-- -- vectorFromList = fmap Vector . V.fromListM++-- -- vectorFromListUnsafe :: V.Arity d => [a] -> Vector d a+-- -- vectorFromListUnsafe = Vector . V.fromList++ --------------------------------------------------------------------------------++-- | Cross product of two three-dimensional vectors+cross       :: Num r => Vector 3 r -> Vector 3 r -> Vector 3 r+(Vector u) `cross` (Vector v) = Vector $ u `L3.cross` v
changelog.org view
@@ -2,6 +2,32 @@  * Changelog +** 0.12++- New website: https://hgeometry.org/+- Switch polygon implementation from a circular seq to a circular vector.+- Hide polygon implementation details.+- Enforce CCW polygon order by default.+- Fix bug in Data.Geometry.Polygon.Convex.extremes/maxInDirection.+- Fix bug in pointInPolygon in case of degenerate situations.+- Fix Read/Show instances for Point and Polygon such that 'read.show = id'.+- Improved numerical robustness.+- Random generation of monotone polygons. Thanks to @1ndy.+- Random and uniform generation of convex polygons.+- More IsIntersectableWith instances+- Updated Show/Read instances for LineSegments+- New algorithm: Visibility polygon in O(n log n) time.+- New algorithm: Earclip triangulation in O(n^2) time worst case, O(n)+  time expected case.+- New algorithm: Single-source shortest path in O(n) time.+- New algorithm: Planar point locator in O(log n) time.+- New algorithm: Point set diameter in O(n log n) time.+- New algorithm: Convex hull of a polygon in O(n) time.+- New algorithm: Diameter of a convex polygon in O(n) time.+- New algorithm: Check if a point lies inside a convex polygon in O(n)+  time.+- New algorithm: Discrete Frechet distance in O(n^2) time.+ ** 0.11  - Removed Functor instance from Triangle and replaced it with Bifunctor/Bifoldable/Bitraversable
doctests.hs view
@@ -29,7 +29,6 @@           , "DeriveFunctor"           , "DeriveFoldable"           , "DeriveTraversable"-          , "AutoDeriveTypeable"           , "DeriveGeneric"           , "FlexibleInstances"           , "FlexibleContexts"@@ -70,4 +69,5 @@   , "Algorithms.Geometry.ConvexHull.JarvisMarch"    , "Algorithms.Geometry.SoS.Orientation"+  , "Algorithms.Geometry.InPolygon"   ]
hgeometry.cabal view
@@ -1,5 +1,5 @@ name:                hgeometry-version:             0.11.0.0+version:             0.12.0.0 synopsis:            Geometric Algorithms, Data structures, and Data types. description:   HGeometry provides some basic geometry types, and geometric algorithms and@@ -19,28 +19,6 @@ category:            Geometry build-type:          Simple -data-files:          test/Algorithms/Geometry/LineSegmentIntersection/manual.ipe-                     test/Algorithms/Geometry/LineSegmentIntersection/selfIntersections.ipe-                     test/Algorithms/Geometry/LowerEnvelope/manual.ipe-                     test/Algorithms/Geometry/PolygonTriangulation/monotone.ipe-                     test/Algorithms/Geometry/PolygonTriangulation/simplepolygon6.ipe-                     test/Algorithms/Geometry/SmallestEnclosingDisk/manual.ipe-                     test/Algorithms/Geometry/LinearProgramming/manual.ipe-                     test/Algorithms/Geometry/RedBlueSeparator/manual.ipe-                     test/Data/Geometry/pointInPolygon.ipe-                     test/Data/Geometry/pointInTriangle.ipe-                     test/Data/Geometry/Polygon/star_shaped.ipe-                     test/Data/Geometry/Polygon/Convex/convexTests.ipe-                     test/Data/Geometry/arrangement.ipe-                     test/Data/Geometry/arrangement.ipe.out.ipe-                     test/Data/PlaneGraph/myPlaneGraph.yaml-                     test/Data/PlaneGraph/small.yaml-                     test/Data/PlaneGraph/testsegs.png--                     -- in the future (cabal >=2.4) we can use-                     -- examples/**/*.in-                     -- examples/**/*.out- extra-source-files:  README.md                      changelog.org @@ -52,6 +30,10 @@   type:     git   location: https://github.com/noinia/hgeometry +flag planargraph+  default: False+  manual: True+ library   ghc-options: -O2 -Wall -fno-warn-unticked-promoted-constructors -fno-warn-type-defaults @@ -84,6 +66,7 @@                     Data.Geometry.Line                     Data.Geometry.Line.Internal                     Data.Geometry.LineSegment+                    Data.Geometry.LineSegment.Internal                     Data.Geometry.SubLine                     Data.Geometry.HalfLine                     Data.Geometry.PolyLine@@ -101,7 +84,9 @@                     Data.Geometry.Ellipse                      Data.Geometry.Polygon+                    Data.Geometry.Polygon.Inflate                     Data.Geometry.Polygon.Convex+                    Data.Geometry.Polygon.Monotone                      Data.Geometry.BezierSpline @@ -132,10 +117,16 @@                     Data.Geometry.QuadTree.Split                     Data.Geometry.QuadTree.Tree +                    Data.Geometry.PointLocation+                    Data.Geometry.PointLocation.PersistentSweep +                    Data.Geometry.VerticalRayShooting+                    Data.Geometry.VerticalRayShooting.PersistentSweep+                     -- * Algorithms                      -- * Geometric Algorithms+                    Algorithms.Geometry.ConvexHull                     Algorithms.Geometry.ConvexHull.GrahamScan                     Algorithms.Geometry.ConvexHull.DivideAndConquer                     Algorithms.Geometry.ConvexHull.QuickHull@@ -144,7 +135,7 @@                      Algorithms.Geometry.LowerEnvelope.DualCH -                    Algorithms.Geometry.SmallestEnclosingBall.Types+                    Algorithms.Geometry.SmallestEnclosingBall                     Algorithms.Geometry.SmallestEnclosingBall.RIC                     Algorithms.Geometry.SmallestEnclosingBall.Naive @@ -154,12 +145,16 @@                      Algorithms.Geometry.PolyLineSimplification.DouglasPeucker +                    Algorithms.Geometry.EuclideanMST                     Algorithms.Geometry.EuclideanMST.EuclideanMST +                    Algorithms.Geometry.WSPD                     Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD                     Algorithms.Geometry.WellSeparatedPairDecomposition.Types +                    Algorithms.Geometry.Diameter                     Algorithms.Geometry.Diameter.Naive+                    Algorithms.Geometry.Diameter.ConvexHull                      -- Algorithms.Geometry.Sweep @@ -167,14 +162,16 @@                     Algorithms.Geometry.PolygonTriangulation.Triangulate                     Algorithms.Geometry.PolygonTriangulation.MakeMonotone                     Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone+                    Algorithms.Geometry.PolygonTriangulation.EarClip                      Algorithms.Geometry.LineSegmentIntersection                     Algorithms.Geometry.LineSegmentIntersection.Naive                     Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann-                    Algorithms.Geometry.LineSegmentIntersection.Types+                    Algorithms.Geometry.LineSegmentIntersection.BooleanSweep                      -- Algorithms.Geometry.HiddenSurfaceRemoval.HiddenSurfaceRemoval +                    Algorithms.Geometry.ClosestPair                     Algorithms.Geometry.ClosestPair.Naive                     Algorithms.Geometry.ClosestPair.DivideAndConquer @@ -185,6 +182,9 @@                      Algorithms.Geometry.FrechetDistance.Discrete +                    Algorithms.Geometry.VisibilityPolygon.Lee+                    Algorithms.Geometry.SSSP+                    Algorithms.Geometry.SSSP.Naive                      -- * Embedded Planar Graphs                     Data.PlaneGraph@@ -202,8 +202,13 @@                     -- * Implementation Internals of Polygons                     Data.Geometry.Polygon.Core                     Data.Geometry.Polygon.Extremes+                    Algorithms.Geometry.InPolygon +                    Algorithms.Geometry.LineSegmentIntersection.Types+                    Algorithms.Geometry.SmallestEnclosingBall.Types +                    Algorithms.Geometry.WSPD.Types+                     Data.Geometry.Point.Internal                     Data.Geometry.Point.Orientation                     Data.Geometry.Point.Quadrants@@ -222,7 +227,7 @@   -- other-extensions:   build-depends:                 base                    >= 4.11      &&     < 5-              , hgeometry-combinatorial >= 0.11.0.0+              , hgeometry-combinatorial >= 0.12.0.0                , bifunctors              >= 4.1               , bytestring              >= 0.10@@ -251,9 +256,12 @@               -- , ghc-typelits-natnormalise >= 0.6               -- , ghc-typelits-knownnat     >= 0.6 -              , vector                  >= 0.11+              , vector                  >= 0.11 && < 0.12.2.0               , data-clist              >= 0.1.2.3+              , vector-circular         >= 0.1.2+              , nonempty-vector         >= 0.2.0.0               , text                    >= 1.1.1.0+              , vector-algorithms                , aeson                   >= 1.0               , yaml                    >= 0.8@@ -304,5 +312,111 @@                , doctest             >= 0.8                , doctest-discover                , QuickCheck+               , quickcheck-instances    default-language:    Haskell2010++benchmark benchmarks++  hs-source-dirs: benchmark++  main-is: Benchmarks.hs+  type: exitcode-stdio-1.0++  other-modules: Benchmark.Util+                 Algorithms.Geometry.ConvexHull.Bench+                 Algorithms.Geometry.ConvexHull.GrahamV2+                 Algorithms.Geometry.ConvexHull.GrahamFam+                 Algorithms.Geometry.ConvexHull.GrahamFamPeano+                 Algorithms.Geometry.ConvexHull.GrahamFixed+                 Data.Geometry.Vector.VectorFamily6+                 Algorithms.Geometry.ConvexHull.GrahamFam6+                 Data.Geometry.IntervalTreeBench+                 -- Demo.ExpectedPairwiseDistance+                 -- Demo.TriangulateWorld+                 -- WSPDBench+                 Algorithms.Geometry.ClosestPair.Bench++                 Algorithms.Geometry.LineSegmentIntersection.Bench+                 Algorithms.Geometry.LineSegmentIntersection.BentleyOttmannOld++                 Algorithms.Geometry.PolygonTriangulation.Bench+                 Algorithms.Geometry.PolygonTriangulation.MakeMonotoneOld+++  build-depends:+                base+              , tasty-bench+              , fixed-vector+              , linear+              , semigroups+              , deepseq+              , deepseq-generics+              , hgeometry+              , hgeometry-combinatorial+              , lens+              , semigroupoids+              , QuickCheck+              , bytestring+              , containers+              , optparse-applicative+              , vinyl+              , vector+              , dlist+              , mtl+              , vector-circular+              , MonadRandom+              , hashable+++  ghc-options: -Wall -O2 -rtsopts -fno-warn-unticked-promoted-constructors++  default-language:    Haskell2010++  default-extensions: TypeFamilies+                    , GADTs+                    , KindSignatures+                    , DataKinds+                    , TypeOperators+                    , ConstraintKinds+                    , PolyKinds+                    , RankNTypes+                    , TypeApplications+                    , ScopedTypeVariables++                    , PatternSynonyms+                    , ViewPatterns+                    , LambdaCase+                    , TupleSections+++                    , StandaloneDeriving+                    , GeneralizedNewtypeDeriving+                    , DeriveFunctor+                    , DeriveFoldable+                    , DeriveTraversable++                    , FlexibleInstances+                    , FlexibleContexts+                    , MultiParamTypeClasses++executable planargraph+  main-is: planargraph.hs+  if flag(planargraph)+    buildable: True+  else+    buildable: False+  default-language:     Haskell2010+  build-depends:  base,+                  vector,+                  vector-circular,+                  linear,+                  text,+                  hashable,+                  lens,+                  directory,+                  filepath,+                  hgeometry,+                  hgeometry-combinatorial,+                  reanimate,+                  reanimate-svg
+ planargraph.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+module Main where++import Data.PlanarGraph.Immutable+import qualified Data.PlanarGraph.Mutable as Mut++import           Control.Lens          ()+import           Control.Monad.ST+import           Data.Ext+import           Data.Foldable         as F+import           Data.Geometry.Point+import           Data.Geometry.Polygon+import           Data.STRef+import           Data.Hashable+import qualified Data.Text             as T+import qualified Data.Vector           as V+import qualified Data.Vector.Circular  as CV+import           Graphics.SvgTree      (Number (..))+import           Linear.Metric+import           Linear.V2+import           Linear.Vector+import           Reanimate+import           Reanimate.Animation+import           System.Directory+import           System.FilePath+import Debug.Trace++graphs :: [PlanarGraph]+graphs =+  [ pgFromFaces [[0..2]]+  , pgFromFaces [[1,2,3]]+  , pgFromFaces [[0..3]]+  , pgFromFaces [[0..3],[4,3,2,1]]+  , let pg = pgFromFaces [[0..3]]+    in pgMutate pg $ \pg' -> do+          let he0 = Mut.halfEdgeFromId 0 pg'+              he4 = Mut.halfEdgeFromId 4 pg'+          _newEdge <- Mut.pgConnectVertices he0 he4+          return ()+  , pgFromFaces [[0,4,1],[0,1,2],[4,3,1],[4,5,3],[3,5,2],[2,5,0]]+  ]++main :: IO ()+-- main = reanimate $ staticFrame (1/60) (fst test2)+main = do+  forM_ graphs savePlanarGraphSVG++-- test1 = renderPlanarGraph (pgFromFaces [[0..2]])+-- test2 = renderPlanarGraph (pgFromFaces [[0..3],[4,3,2,1]])++savePlanarGraphSVG :: PlanarGraph -> IO ()+savePlanarGraphSVG pg = do+    writeFile fileName svgOutput+    writeFile compactName compactOutput+  where+    svgOutput = renderSvg (Just $ Num 300) (Just $ Num 300) svg+    compactOutput = renderSvg (Just $ Num 300) (Just $ Num 300) compactSvg+    fileName = "planargraph-" ++ show (hash pg) <.> "svg"+    compactName = "planargraph-" ++ show (hash pg) <.> "compact" <.> "svg"+    defOpts = RenderOptions { disableHalfEdges = False }+    compactOpts = RenderOptions { disableHalfEdges = True }+    svg = renderPlanarGraph defOpts pg+    compactSvg = renderPlanarGraph compactOpts pg++data RenderOptions = RenderOptions+  { disableHalfEdges :: Bool }++renderPlanarGraph :: RenderOptions -> PlanarGraph -> SVG+renderPlanarGraph RenderOptions{..} pg = svg+  where+    vs = tutteEmbedding pg+    faces = pgFaces pg+    svg =+        withViewBox (screenBottom, screenBottom, screenHeight, screenHeight) $+        mkGroup+        [ mkBackground bgColor+        , mkGroup+          [ translate (x*scaleFactor) (y*scaleFactor) $+            mkGroup+            [ label+            , withFillOpacity 0 $ withStrokeColor "black" $ withStrokeWidth strokeWidth $+              -- mkRect (strokeWidth+svgWidth label*1.5) (strokeWidth+svgHeight label*1.5)+              translate 0 (-(svgHeight label+0.1)/2) $+              center $ mkLine (0,0) (svgWidth label*1.2,0)+            ]+          | face <- faces+          , let boundary = faceBoundary face pg+                poly = simpleFromPoints $ map ext+                        [ Point2 x y+                        | vId <- boundary+                        , let V2 x y = vs V.! vertexId vId+                        ]+                Point2 x y = centroid poly+                label = scale 0.5 $ center $ latex (T.pack $ show $ faceId face)+          ]+        , mkGroup+          [ mkGroup $+            [ withStrokeColor "black" $+              mkLine (tipX*scaleFactor, tipY*scaleFactor) (tailX*scaleFactor, tailY*scaleFactor)+            ] ++ if disableHalfEdges+              then []+              else +                [ translate (halfX*scaleFactor + angY) (halfY*scaleFactor - angX) $+                  labelTwin+                , translate (halfX*scaleFactor - angY) (halfY*scaleFactor + angX) $+                  labelEdge+                ]+          | edge <- pgEdges pg+          , let (tip, tail) = edgeHalfEdges edge+                V2 tipX tipY = vs V.! vertexId (halfEdgeVertex tip pg)+                V2 tailX tailY = vs V.! vertexId (halfEdgeVertex tail pg)+                (halfX,halfY) = (tipX + (tailX-tipX)/2, tipY + (tailY-tipY)/2)+                labelEdge = scale 0.4 $ center $ latex (T.pack $ show $ halfEdgeId tip)+                labelTwin = scale 0.4 $ center $ latex (T.pack $ show $ halfEdgeId tail)+                V2 angX angY = signorm (V2 tipX tipY - V2 tailX tailY) ^* 0.3+          ]+        , mkGroup+          [ translate (x*scaleFactor) (y*scaleFactor) $+            mkGroup+            [ withFillOpacity 1 $ withFillColor "white" $ withStrokeColor "black" $+              mkCircle 0.3+            , label ]+          | v <- map vertexId $ pgVertices pg+          , let V2 x y = vs V.! v+                label = scaleToWidth 0.2 $ center $ latex (T.pack $ show v)+          ]+        ]++strokeWidth = defaultStrokeWidth*0.5++bgColor :: String+bgColor = "white"++scaleFactor :: Double+scaleFactor = screenTop*0.8
+ src/Algorithms/Geometry/ClosestPair.hs view
@@ -0,0 +1,14 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.ClosestPair+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--+-- \(O(n\log n)\) time algorithm to compute the+-- closest pair among a set of \(n\) points in \(\mathbb{R}^2\).+--+--------------------------------------------------------------------------------+module Algorithms.Geometry.ClosestPair( closestPair ) where++import Algorithms.Geometry.ClosestPair.DivideAndConquer
src/Algorithms/Geometry/ClosestPair/DivideAndConquer.hs view
@@ -36,7 +36,7 @@ -- | Classical divide and conquer algorithm to compute the closest pair among -- \(n\) points. ----- running time: \(O(n)\)+-- running time: \(O(n \log n)\) closestPair :: (Ord r, Num r) => LSeq 2 (Point 2 r :+ p) -> Two (Point 2 r :+ p) closestPair = f . divideAndConquer1 mkCCP . toNonEmpty             . LSeq.unstableSortBy (comparing (^.core))@@ -100,8 +100,8 @@              -> CP (Point 2 r :+ p) r run cp'' r ls =       runWhile cp'' ls-               (\cp l -> (ValT $ sqVertDist r l) < getDist cp) -- r and l inverted-                                                               -- by design+               (\cp l -> ValT (sqVertDist r l) < getDist cp) -- r and l inverted+                                                             -- by design                (\cp l -> minBy getDist cp (ValT $ SP (Two l r) (dist l r)))   where     dist (p :+ _) (q :+ _) = squaredEuclideanDist p q
+ src/Algorithms/Geometry/ConvexHull.hs view
@@ -0,0 +1,10 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.ConvexHull+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--------------------------------------------------------------------------------+module Algorithms.Geometry.ConvexHull( convexHull ) where++import Algorithms.Geometry.ConvexHull.GrahamScan
src/Algorithms/Geometry/ConvexHull/DivideAndConquer.hs view
@@ -28,10 +28,10 @@ -- | \(O(n \log n)\) time ConvexHull using divide and conquer. The resulting polygon is -- given in clockwise order. convexHull           :: (Ord r, Num r) => NonEmpty (Point 2 r :+ p) -> ConvexPolygon p r-convexHull (p :| []) = ConvexPolygon . fromPoints $ [p]+convexHull (p :| []) = ConvexPolygon . unsafeFromPoints $ [p] convexHull pts       = combine . (upperHull' &&& lowerHull') . NonEmpty.sortBy incXdecY $ pts   where-    combine (l:|uh,_:|lh) = ConvexPolygon . fromPoints $ l : uh <> reverse (init lh)+    combine (l:|uh,_:|lh) = ConvexPolygon . unsafeFromPoints $ l : uh <> reverse (init lh)  ---------------------------------------- -- * Computing a lower hull@@ -72,10 +72,10 @@ hull               :: (NonEmpty p -> NonEmpty p -> Two (p :+ [p]))                    -> NonEmpty p -> NonEmpty p -> NonEmpty p hull tangent lh rh = let Two (l :+ lh') (r :+ rh') = tangent (NonEmpty.reverse lh) rh-                     in NonEmpty.fromList $ (reverse lh') <> [l,r] <> rh'+                     in NonEmpty.fromList $ reverse lh' <> [l,r] <> rh'  -------------------------------------------------------------------------------- -incXdecY  :: Ord r => (Point 2 r) :+ p -> (Point 2 r) :+ q -> Ordering+incXdecY  :: Ord r => Point 2 r :+ p -> Point 2 r :+ q -> Ordering incXdecY (Point2 px py :+ _) (Point2 qx qy :+ _) =   compare px qx <> compare qy py
src/Algorithms/Geometry/ConvexHull/GrahamScan.hs view
@@ -1,3 +1,10 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.ConvexHull.GrahamScan+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Algorithms.Geometry.ConvexHull.GrahamScan( convexHull                                                 , upperHull, upperHull'                                                 , lowerHull, lowerHull'@@ -18,11 +25,11 @@ -- given in clockwise order. convexHull            :: (Ord r, Num r)                       => NonEmpty (Point 2 r :+ p) -> ConvexPolygon p r-convexHull (p :| []) = ConvexPolygon . fromPoints $ [p]+convexHull (p :| []) = ConvexPolygon . unsafeFromPoints $ [p] convexHull ps        = let ps' = NonEmpty.toList . NonEmpty.sortBy incXdecY $ ps                            uh  = NonEmpty.tail . hull' $         ps'                            lh  = NonEmpty.tail . hull' $ reverse ps'-                       in ConvexPolygon . fromPoints . reverse $ lh ++ uh+                       in ConvexPolygon . unsafeFromPoints . reverse $ lh ++ uh  -- | Computes the upper hull. The upper hull is given from left to right. --@@ -83,7 +90,7 @@ hull f pts         = hull' .  f                    . NonEmpty.toList . NonEmpty.sortBy incXdecY $ pts -incXdecY  :: Ord r => (Point 2 r) :+ p -> (Point 2 r) :+ q -> Ordering+incXdecY  :: Ord r => Point 2 r :+ p -> Point 2 r :+ q -> Ordering incXdecY (Point2 px py :+ _) (Point2 qx qy :+ _) =   compare px qx <> compare qy py @@ -126,6 +133,9 @@       | rightTurn (x^.core) (y^.core) (z^.core) = h       | otherwise                               = cleanMiddle (z:x:rest)     cleanMiddle _                               = error "cleanMiddle: too few points"+hull' _ = error+  "Algorithms.Geometry.ConvexHull.GrahamScan.hull' requires a list with at least \+  \two elements."  rightTurn       :: (Ord r, Num r) => Point 2 r -> Point 2 r -> Point 2 r -> Bool rightTurn a b c = ccw a b c == CW
src/Algorithms/Geometry/ConvexHull/JarvisMarch.hs view
@@ -1,3 +1,10 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.ConvexHull.JarvisMarch+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Algorithms.Geometry.ConvexHull.JarvisMarch(     convexHull @@ -8,7 +15,6 @@  import           Control.Lens ((^.)) import           Data.Bifunctor-import           Data.Either (either) import           Data.Ext import           Data.Foldable import           Data.Geometry.Point@@ -30,8 +36,8 @@ -- and \(h\) is the complexity of the hull. convexHull            :: (Ord r, Num r)                       => NonEmpty (Point 2 r :+ p) -> ConvexPolygon p r-convexHull (p :| []) = ConvexPolygon . fromPoints $ [p]-convexHull pts       = ConvexPolygon . fromPoints $ uh <> reverse lh+convexHull (p :| []) = ConvexPolygon . unsafeFromPoints $ [p]+convexHull pts       = ConvexPolygon . unsafeFromPoints $ uh <> reverse lh   where     lh = case NonEmpty.nonEmpty (NonEmpty.init $ lowerHull pts) of            Nothing       -> []@@ -93,13 +99,13 @@ -- with minimum slope w.r.t. the given point. steepestCcwFrom   :: (Ord r, Num r)                => (Point 2 r :+ a) -> NonEmpty (Point 2 r :+ b)  -> Point 2 r :+ b-steepestCcwFrom p = List.minimumBy (ccwCmpAroundWith (Vector2 0 (-1)) p)+steepestCcwFrom p = List.minimumBy (ccwCmpAroundWith' (Vector2 0 (-1)) p)  -- | Find the next point in clockwise order, i.e. the point -- with maximum slope w.r.t. the given point. steepestCwFrom   :: (Ord r, Num r)                => (Point 2 r :+ a) -> NonEmpty (Point 2 r :+ b)  -> Point 2 r :+ b-steepestCwFrom p = List.minimumBy (cwCmpAroundWith (Vector2 0 1) p)+steepestCwFrom p = List.minimumBy (cwCmpAroundWith' (Vector2 0 1) p)  repeatedly       :: (a -> a -> Ordering) -> (a -> NonEmpty a -> a) -> a -> [a] -> NonEmpty a repeatedly cmp f = go@@ -126,7 +132,7 @@   where     go (x :| xs) = case NonEmpty.nonEmpty xs of                      Nothing  -> b x-                     Just xs' -> x `f` (go xs')+                     Just xs' -> x `f` go xs'  -- | extracts all minima from the list. The result consists of the -- list of minima, and all remaining points. Both lists are returned
src/Algorithms/Geometry/ConvexHull/Naive.hs view
@@ -1,3 +1,10 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.ConvexHull.Naive+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Algorithms.Geometry.ConvexHull.Naive( ConvexHull                                            , lowerHull', lowerHullAll @@ -14,10 +21,9 @@ import           Data.Geometry.Triangle import           Data.Geometry.Vector import           Data.Intersection(intersects)-import qualified Data.List as List import           Data.List.NonEmpty (NonEmpty(..))-import qualified Data.List.NonEmpty as NonEmpty-import           Data.Maybe (listToMaybe, isNothing)+import           Data.List (find)+import           Data.Maybe (isNothing) import           Data.Util -------------------------------------------------------------------------------- @@ -50,15 +56,14 @@   -killOverlapping :: (Ord r, Fractional r) => [Triangle 3 p r] -> [Triangle 3 p r]-killOverlapping = foldr keepIfNotOverlaps []+_killOverlapping :: (Ord r, Fractional r) => [Triangle 3 p r] -> [Triangle 3 p r]+_killOverlapping = foldr keepIfNotOverlaps []   where     keepIfNotOverlaps t ts | any (t `overlaps`) ts = ts                            | otherwise             = t:ts --t1@(Triangle p q r) `overlaps` t2@(Triangle a b c) = upperHalfSpaceOf t1 == upperHalfSpaceOf t2-                                                  && False+overlaps :: (Fractional r, Ord r) => Triangle 3 p1 r -> Triangle 3 p2 r -> Bool+t1 `overlaps` t2 = upperHalfSpaceOf t1 == upperHalfSpaceOf t2 && False   @@ -72,10 +77,10 @@ -- Nothing -- >>> let t = (Triangle (ext origin) (ext $ Point3 1 0 0) (ext $ Point3 0 1 0)) -- >>> isValidTriangle t [ext $ Point3 5 5 (-10)]--- Just (Point3 [5,5,-10] :+ ())+-- Just (Point3 5 5 (-10) :+ ()) isValidTriangle   :: (Num r, Ord r)                   => Triangle 3 p r -> [Point 3 r :+ q] -> Maybe (Point 3 r :+ q)-isValidTriangle t = listToMaybe . filter (\a -> not $ (a^.core) `intersects` h)+isValidTriangle t = find (\a -> not $ (a^.core) `intersects` h)   where     h = upperHalfSpaceOf t @@ -83,7 +88,7 @@ -- | Computes the halfspace above the triangle. -- -- >>> upperHalfSpaceOf (Triangle (ext $ origin) (ext $ Point3 10 0 0) (ext $ Point3 0 10 0))--- HalfSpace {_boundingPlane = HyperPlane {_inPlane = Point3 [0,0,0], _normalVec = Vector3 [0,0,100]}}+-- HalfSpace {_boundingPlane = HyperPlane {_inPlane = Point3 0 0 0, _normalVec = Vector3 0 0 100}} upperHalfSpaceOf                  :: (Ord r, Num r) => Triangle 3 p r -> HalfSpace 3 r upperHalfSpaceOf (Triangle p q r) = HalfSpace h   where
src/Algorithms/Geometry/ConvexHull/QuickHull.hs view
@@ -1,6 +1,13 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.ConvexHull.QuickHull+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Algorithms.Geometry.ConvexHull.QuickHull( convexHull ) where -import           Control.Lens ((^.),(&),(.~))+import           Control.Lens ((^.)) import           Data.Ext import qualified Data.Foldable as F import           Data.Geometry.Line@@ -26,9 +33,9 @@ -- running time: \(O(n^2)\) convexHull            :: (Ord r, Fractional r, Show r, Show p)                       => NonEmpty (Point 2 r :+ p) -> ConvexPolygon p r-convexHull (p :| []) = ConvexPolygon . fromPoints $ [p]-convexHull ps        = ConvexPolygon . fromPoints-                     $ [l] <> hull l r above <> [r] <> (reverse $ hull l r below)+convexHull (p :| []) = ConvexPolygon . unsafeFromPoints $ [p]+convexHull ps        = ConvexPolygon . unsafeFromPoints+                     $ [l] <> hull l r above <> [r] <> reverse (hull l r below)   where     STR l r mids  = findExtremes ps     m             = lineThrough (l^.core) (r^.core)@@ -59,7 +66,7 @@ --                          in STR l r [p | p <- F.toList pts, p /=. l, p /=. r]  -incXdecY  :: Ord r => (Point 2 r) :+ p -> (Point 2 r) :+ q -> Ordering+incXdecY  :: Ord r => Point 2 r :+ p -> Point 2 r :+ q -> Ordering incXdecY (Point2 px py :+ _) (Point2 qx qy :+ _) =   compare px qx <> compare qy py
src/Algorithms/Geometry/DelaunayTriangulation/DivideAndConquer.hs view
@@ -1,30 +1,40 @@ {-# LANGUAGE ScopedTypeVariables #-}-module Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer where+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--------------------------------------------------------------------------------+module Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer+  (+    -- * Divide & Conqueror Delaunay Triangulation+    delaunayTriangulation+  ) where -import           Algorithms.Geometry.ConvexHull.GrahamScan as GS+import           Algorithms.Geometry.ConvexHull.GrahamScan       as GS import           Algorithms.Geometry.DelaunayTriangulation.Types import           Control.Lens import           Control.Monad.Reader import           Control.Monad.State import           Data.BinaryTree-import qualified Data.CircularList as CL-import qualified Data.CircularList.Util as CU-import qualified Data.CircularSeq as CS+import qualified Data.CircularList                               as CL+import qualified Data.CircularList.Util                          as CU import           Data.Ext-import qualified Data.Foldable as F-import           Data.Function (on)-import           Data.Geometry hiding (rotateTo)-import           Data.Geometry.Ball (disk, insideBall)-import           Data.Geometry.Polygon-import           Data.Geometry.Polygon.Convex (ConvexPolygon(..), simplePolygon)-import qualified Data.Geometry.Polygon.Convex as Convex-import qualified Data.IntMap.Strict as IM-import qualified Data.List as L-import qualified Data.List.NonEmpty as NonEmpty-import qualified Data.Map as M-import           Data.Maybe (fromJust, fromMaybe)+import qualified Data.Foldable                                   as F+import           Data.Function                                   (on)+import           Data.Geometry                                   hiding (rotateTo)+import           Data.Geometry.Ball                              (disk, insideBall)+import           Data.Geometry.Polygon.Convex                    (ConvexPolygon (..), simplePolygon)+import qualified Data.Geometry.Polygon.Convex                    as Convex+import qualified Data.IntMap.Strict                              as IM+import qualified Data.List                                       as L+import qualified Data.List.NonEmpty                              as NonEmpty+import qualified Data.Map                                        as M+import           Data.Maybe                                      (fromJust, fromMaybe) import           Data.Measured.Size-import qualified Data.Vector as V+import qualified Data.Vector                                     as V+import qualified Data.Vector.Circular.Util                       as CV  ------------------------------------------------------------------------------- -- * Divide & Conqueror Delaunay Triangulation@@ -42,7 +52,6 @@ -- -- Rotating Right <-> rotate clockwise - -- | Computes the delaunay triangulation of a set of points. -- -- Running time: \(O(n \log n)\)@@ -73,7 +82,7 @@ delaunayTriangulation' pts mapping'@(vtxMap,_)   | size' pts == 1 = let (Leaf p) = pts                          i        = lookup' vtxMap (p^.core)-                     in (IM.singleton i CL.empty, ConvexPolygon $ fromPoints [withID p i])+                     in (IM.singleton i CL.empty, ConvexPolygon $ unsafeFromPoints [withID p i])   | size' pts <= 3 = let pts'  = NonEmpty.fromList                                . map (\p -> withID p (lookup' vtxMap (p^.core)))                                . F.toList $ pts@@ -99,8 +108,8 @@ -- pre: at least two elements fromHull              :: Ord r => Mapping p r -> ConvexPolygon (p :+ q) r -> Adj fromHull (vtxMap,_) p = let vs@(u:v:vs') = map (lookup' vtxMap . (^.core))-                                         . F.toList . CS.rightElements-                                         $ p^.simplePolygon.outerBoundary+                                         . F.toList . CV.rightElements+                                         $ p^.simplePolygon.outerBoundaryVector                             es           = zipWith3 f vs (tail vs ++ [u]) (vs' ++ [u,v])                             f prv c nxt  = (c,CL.fromList . L.nub $ [prv, nxt])                         in IM.fromList es@@ -138,8 +147,8 @@   | otherwise   = do                      insert l r                      -- Get the neighbours of r and l along the convex hull-                     r1 <- pred' . rotateTo l . lookup'' r <$> get-                     l1 <- succ' . rotateTo r . lookup'' l <$> get+                     r1 <- gets (pred' . rotateTo l . lookup'' r)+                     l1 <- gets (succ' . rotateTo r . lookup'' l)                       (r1',a) <- rotateR l r r1                      (l1',b) <- rotateL l r l1@@ -152,7 +161,7 @@                      moveUp ut l' r'  --- | ''rotates'' around r and removes all neighbours of r that violate the+-- | \'rotates\' around r and removes all neighbours of r that violate the -- delaunay condition. Returns the first vertex (as a Neighbour of r) that -- should remain in the Delaunay Triangulation, as well as a boolean A that -- helps deciding if we merge up by rotating left or rotating right (See@@ -199,12 +208,12 @@ -- by the first three points. qTest         :: (Ord r, Fractional r)               => VertexID -> VertexID -> Vertex -> Vertex -> Merge p r Bool-qTest h i j k = withPtMap . snd . fst <$> ask+qTest h i j k = asks (withPtMap . snd . fst)   where     withPtMap ptMap = let h' = ptMap V.! h                           i' = ptMap V.! i-                          j' = ptMap V.! (focus' j)-                          k' = ptMap V.! (focus' k)+                          j' = ptMap V.! focus' j+                          k' = ptMap V.! focus' k                       in not . maybe True ((k'^.core) `insideBall`) $ disk' h' i' j'     disk' p q r = disk (p^.core) (q^.core) (r^.core) @@ -233,8 +242,8 @@                       . IM.adjustWithKey (insert'' u) v   where     -- inserts b into the adjacency list of a-    insert'' bi ai = CU.insertOrdBy (cwCmpAround' (ptMap V.! ai) `on` (ptMap V.!)) bi-    cwCmpAround' c p q = cwCmpAround c p q <> cmpByDistanceTo c p q+    insert'' bi ai = CU.insertOrdBy (cmp (ptMap V.! ai) `on` (ptMap V.!)) bi+    cmp c p q = cwCmpAround' c p q <> cmpByDistanceTo' c p q   -- | Deletes an edge@@ -247,7 +256,7 @@ -- | Lifted version of Convex.IsLeftOf isLeftOf           :: (Ord r, Num r)                    => VertexID -> (VertexID, VertexID) -> Merge p r Bool-p `isLeftOf` (l,r) = withPtMap . snd . fst <$> ask+p `isLeftOf` (l,r) = asks (withPtMap . snd . fst)   where     withPtMap ptMap = (ptMap V.! p) `isLeftOf'` (ptMap V.! l, ptMap V.! r)     a `isLeftOf'` (b,c) = ccw' b c a == CCW@@ -255,7 +264,7 @@ -- | Lifted version of Convex.IsRightOf isRightOf           :: (Ord r, Num r)                     => VertexID -> (VertexID, VertexID) -> Merge p r Bool-p `isRightOf` (l,r) = withPtMap . snd . fst <$> ask+p `isRightOf` (l,r) = asks (withPtMap . snd . fst)   where     withPtMap ptMap = (ptMap V.! p) `isRightOf'` (ptMap V.! l, ptMap V.! r)     a `isRightOf'` (b,c) = ccw' b c a == CW@@ -271,7 +280,7 @@ size' (Leaf _)     = 1 size' (Node _ s _) = s --- | an 'unsafe' version of rotateTo that assumes the element to rotate to+-- | an \'unsafe\' version of rotateTo that assumes the element to rotate to -- occurs in the list. rotateTo   :: Eq a => a -> CL.CList a -> CL.CList a rotateTo x = fromJust . CL.rotateTo x@@ -284,6 +293,7 @@ succ' :: CL.CList a -> CL.CList a succ' = CL.rotL +-- | Return the focus of the CList, throwing an exception if the list is empty. focus' :: CL.CList a -> a focus' = fromJust . CL.focus @@ -296,4 +306,4 @@ withID p i = p&extra %~ (:+i)  lookup'' :: Int -> IM.IntMap a -> a-lookup'' k m = fromJust . IM.lookup k $ m+lookup'' k m = m IM.! k
src/Algorithms/Geometry/DelaunayTriangulation/Naive.hs view
@@ -1,3 +1,10 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.DelaunayTriangulation.Naive+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Algorithms.Geometry.DelaunayTriangulation.Naive where  import           Algorithms.Geometry.DelaunayTriangulation.Types@@ -17,7 +24,7 @@  -------------------------------------------------------------------------------- --- | Naive O(n^4) time implementation of the delaunay triangulation. Simply+-- | Naive \( O(n^4) \) time implementation of the delaunay triangulation. Simply -- tries each triple (p,q,r) and tests if it is delaunay, i.e. if there are no -- other points in the circle defined by p, q, and r. --@@ -52,14 +59,14 @@     addAt    v i j = updateAt v i (j:)      -- convert to a CList, sorted in CCW order around point u-    toCList u = C.fromList . sortAround' m u+    toCList u = C.fromList . sortAroundMapping m u  -- | Given a particular point u and a list of points vs, sort the points vs in -- CW order around u.--- running time: O(m log m), where m=|vs| is the number of vertices to sort.-sortAround'               :: (Num r, Ord r)+-- running time: \( O(m log m) \), where m=|vs| is the number of vertices to sort.+sortAroundMapping               :: (Num r, Ord r)                           => Mapping p r -> VertexID -> [VertexID] -> [VertexID]-sortAround' (_,ptsV) u vs = reverse . map (^.extra) $ sortAround (f u) (map f vs)+sortAroundMapping (_,ptsV) u vs = reverse . map (^.extra) $ sortAround' (f u) (map f vs)   where     f v = (ptsV V.! v)&extra .~ v @@ -71,8 +78,7 @@                -- we sort, group, and take the head of the lists  --- | Test if the given three points form a triangle in the delaunay triangulation.--- running time: O(n)+-- | \( O(n) \) Test if the given three points form a triangle in the delaunay triangulation. isDelaunay                :: (Fractional r, Ord r)                           => Mapping p r -> VertexID -> VertexID -> VertexID -> Bool isDelaunay (_,ptsV) p q r = case disk (pt p) (pt q) (pt r) of
src/Algorithms/Geometry/DelaunayTriangulation/Types.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ScopedTypeVariables #-} -------------------------------------------------------------------------------- -- |@@ -10,7 +9,20 @@ -- Defines some geometric types used in the delaunay triangulation -- ---------------------------------------------------------------------------------module Algorithms.Geometry.DelaunayTriangulation.Types where+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@@ -19,7 +31,7 @@ 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.Map.Strict as SM import qualified Data.PlaneGraph  as PG import qualified Data.PlanarGraph as PPG import qualified Data.Vector as V@@ -32,12 +44,13 @@ -- : 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 --- | Rotating Right <-> rotate clockwise-+-- | 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@@ -47,35 +60,48 @@                                        , _neighbours :: V.Vector (C.CList VertexID)                                        }                          deriving (Show,Eq)-makeLenses ''Triangulation -type instance NumType   (Triangulation p r) = r-type instance Dimension (Triangulation p r) = 2+-- | Mapping between triangulated points and their internal VertexID.+vertexIds :: Lens' (Triangulation p r) (M.Map (Point 2 r) VertexID)+vertexIds = lens _vertexIds (\(Triangulation _v p n) v -> Triangulation v p 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 = lens _positions (\(Triangulation v _p n) p -> Triangulation v p n) -type Mapping p r = (M.Map (Point 2 r) VertexID, V.Vector (Point 2 r :+ p))+-- | Point neighbours indexed by VertexID.+neighbours :: Lens' (Triangulation p r) (V.Vector (C.CList VertexID))+neighbours = lens _neighbours (\(Triangulation v p _n) n -> Triangulation v p 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 . triangulationEdges  -triangulationEdges   :: Triangulation p r -> [(Point 2 r :+ p, Point 2 r :+ p)]-triangulationEdges t = let pts = _positions t-                       in map (\(u,v) -> (pts V.! u, pts V.! v)) . tEdges $ t +-- showDT :: (Show p, Show r)  => Triangulation p r -> IO ()+-- showDT = mapM_ print . edgesAsPoints -tEdges :: Triangulation p r -> [(VertexID,VertexID)]-tEdges = concatMap (\(i,ns) -> map (i,) . filter (> i) . C.toList $ ns)+{- HLINT ignore edgesAsPoints -}+-- | List add edges as point pairs.+edgesAsPoints   :: Triangulation p r -> [(Point 2 r :+ p, Point 2 r :+ p)]+edgesAsPoints t = let pts = _positions t+                       in map (\(u,v) -> (pts V.! u, pts V.! v)) . edgesAsVertices $ t++-- | List add edges as VertexID pairs.+edgesAsVertices :: Triangulation p r -> [(VertexID,VertexID)]+edgesAsVertices = concatMap (\(i,ns) -> map (i,) . filter (> i) . C.toList $ ns)        . zip [0..] . V.toList . _neighbours  -------------------------------------------------------------------------------- -data ST a b c = ST { fst' :: !a, snd' :: !b , trd' :: !c}+-- data ST a b c = ST { fst' :: !a, snd' :: !b , trd' :: !c} -type ArcID = Int+-- type ArcID = Int  -- | ST' is a strict triple (m,a,x) containing: --@@ -83,7 +109,7 @@ --            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+-- type ST' a = ST (SM.Map (VertexID,VertexID) ArcID) ArcID a   -- | convert the triangulation into a planarsubdivision
+ src/Algorithms/Geometry/Diameter.hs view
@@ -0,0 +1,13 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.Diameter+-- Copyright   :  (C) David Himmelstrup+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals, David Himmelstrup+--------------------------------------------------------------------------------+module Algorithms.Geometry.Diameter+  ( diameter+  , diametralPair+  ) where++import Algorithms.Geometry.Diameter.ConvexHull
+ src/Algorithms/Geometry/Diameter/ConvexHull.hs view
@@ -0,0 +1,35 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.Diameter.ConvexHull+-- Copyright   :  (C) David Himmelstrup+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals, David Himmelstrup+--------------------------------------------------------------------------------+module Algorithms.Geometry.Diameter.ConvexHull+  ( diameter+  , diametralPair+  ) where++import           Algorithms.Geometry.ConvexHull.GrahamScan (convexHull)+import qualified Algorithms.Geometry.Diameter.Naive        as Naive+import           Control.Lens                              ((^.))+import           Data.Ext                                  (core, type (:+))+import           Data.Geometry                             (Point, euclideanDist)+import qualified Data.Geometry.Polygon.Convex              as Convex+import qualified Data.List.NonEmpty                        as NonEmpty++--------------------------------------------------------------------------------++-- | Computes the Euclidean diameter by first finding the convex hull.+--+-- running time: \(O(n \log n)\)+diameter :: (Ord r, Floating r) => [Point 2 r :+ p] -> r+diameter = maybe 0 (\(p,q) -> euclideanDist (p^.core) (q^.core)) . diametralPair++-- | Computes the Euclidean diameter by first finding the convex hull.+--+-- running time: \(O(n \log n)\)+diametralPair :: (Ord r, Num r)+                   => [Point 2 r :+ p] -> Maybe (Point 2 r :+ p, Point 2 r :+ p)+diametralPair lst@(_:_:_:_) = Just . Convex.diametralPair $ convexHull $ NonEmpty.fromList lst+diametralPair lst           = Naive.diametralPair lst
src/Algorithms/Geometry/Diameter/Naive.hs view
@@ -1,3 +1,10 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.Diameter.Naive+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Algorithms.Geometry.Diameter.Naive where  import Control.Lens@@ -7,6 +14,9 @@  -------------------------------------------------------------------------------- +-- | Computes the Euclidean diameter by naively trying all pairs.+--+-- running time: \(O(n^2)\) diameter :: (Ord r, Floating r, Arity d) => [Point d r :+ p] -> r diameter = maybe 0 (\(p,q) -> euclideanDist (p^.core) (q^.core)) . diametralPair
+ src/Algorithms/Geometry/EuclideanMST.hs view
@@ -0,0 +1,47 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.EuclideanMST+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--+-- \(O(n\log n)\) time algorithm algorithm to compute the Euclidean minimum+-- spanning tree of a set of \(n\) points in \(\mathbb{R}^2\).+--+--------------------------------------------------------------------------------+module Algorithms.Geometry.EuclideanMST ( euclideanMST ) where++import           Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer+import           Algorithms.Geometry.DelaunayTriangulation.Types+import           Algorithms.Graph.MST+import           Control.Lens+import           Data.Ext+import           Data.Geometry+import qualified Data.List.NonEmpty as NonEmpty+import           Data.PlaneGraph+import           Data.Proxy+import           Data.Tree++--------------------------------------------------------------------------------++-- | Computes the Euclidean Minimum Spanning Tree. We compute the Delaunay+-- Triangulation (DT), and then extract the EMST. Hence, the same restrictions+-- apply as for the DT:+--+-- pre: the input is a *SET*, i.e. contains no duplicate points. (If the input+-- does contain duplicate points, the implementation throws them away)+--+-- running time: \(O(n \log n)\)+euclideanMST     :: (Ord r, Fractional r)+                 => NonEmpty.NonEmpty (Point 2 r :+ p) -> Tree (Point 2 r :+ p)+euclideanMST pts = (\v -> g^.locationOf v :+ g^.dataOf v) <$> t+  where+    -- since we care only about the relative order of the edges we can use the+    -- squared Euclidean distance rather than the Euclidean distance, thus+    -- avoiding the Floating constraint+    g = withEdgeDistances squaredEuclideanDist . toPlaneGraph (Proxy :: Proxy MSTW)+      . delaunayTriangulation $ pts+    t = mst $ g^.graph+++data MSTW
src/Algorithms/Geometry/EuclideanMST/EuclideanMST.hs view
@@ -9,39 +9,9 @@ -- spanning tree of a set of \(n\) points in \(\mathbb{R}^2\). -- ---------------------------------------------------------------------------------module Algorithms.Geometry.EuclideanMST.EuclideanMST where--import           Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer-import           Algorithms.Geometry.DelaunayTriangulation.Types-import           Algorithms.Graph.MST-import           Control.Lens-import           Data.Ext-import           Data.Geometry-import qualified Data.List.NonEmpty as NonEmpty-import           Data.PlaneGraph-import           Data.Proxy-import           Data.Tree-------------------------------------------------------------------------------------- | Computes the Euclidean Minimum Spanning Tree. We compute the Delaunay--- Triangulation (DT), and then extract the EMST. Hence, the same restrictions--- apply as for the DT:------ pre: the input is a *SET*, i.e. contains no duplicate points. (If the input--- does contain duplicate points, the implementation throws them away)------ running time: \(O(n \log n)\)-euclideanMST     :: (Ord r, Fractional r)-                 => NonEmpty.NonEmpty (Point 2 r :+ p) -> Tree (Point 2 r :+ p)-euclideanMST pts = (\v -> g^.locationOf v :+ g^.dataOf v) <$> t-  where-    -- since we care only about the relative order of the edges we can use the-    -- squared Euclidean distance rather than the Euclidean distance, thus-    -- avoiding the Floating constraint-    g = withEdgeDistances squaredEuclideanDist . toPlaneGraph (Proxy :: Proxy MSTW)-      . delaunayTriangulation $ pts-    t = mst $ g^.graph-+module Algorithms.Geometry.EuclideanMST.EuclideanMST+  {-# DEPRECATED "This module will be deleted after 2021-06-01. \+                 \Use Algorithms.Geometry.EuclideanMST instead." #-}+  ( module Algorithms.Geometry.EuclideanMST ) where -data MSTW+import Algorithms.Geometry.EuclideanMST
src/Algorithms/Geometry/FrechetDistance/Discrete.hs view
@@ -1,3 +1,10 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.FrechetDistance.Discrete+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Algorithms.Geometry.FrechetDistance.Discrete( discreteFrechetDistance                                                    , discreteFrechetDistanceWith                                                    ) where
+ src/Algorithms/Geometry/InPolygon.hs view
@@ -0,0 +1,155 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.InPolygon+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--+-- Testing if a point lies in a polygon+--+--------------------------------------------------------------------------------+module Algorithms.Geometry.InPolygon+  ( inPolygon+  , insidePolygon+  , onBoundary+  ) where++import           Control.Lens++import           Data.Ext+import qualified Data.Foldable as F+import           Data.Geometry.Boundary+import           Data.Geometry.Line+import           Data.Geometry.LineSegment+import           Data.Geometry.Point+import           Data.Geometry.Polygon.Core+import           Data.Geometry.Properties++import qualified Data.List.Util as List+import           Data.Maybe (mapMaybe)+import           Data.Vinyl.CoRec (asA)+--------------------------------------------------------------------------------++{- $setup+>>> import Data.RealNumber.Rational+>>> import Data.Foldable+>>> import Control.Lens.Extras+>>> :{+-- import qualified Data.Vector.Circular as CV+let simplePoly :: SimplePolygon () (RealNumber 10)+    simplePoly = fromPoints . map ext $+      [ Point2 0 0+      , Point2 10 0+      , Point2 10 10+      , Point2 5 15+      , Point2 1 11+      ]+    simpleTriangle :: SimplePolygon () (RealNumber 10)+    simpleTriangle = fromPoints  . map ext $+      [ Point2 0 0, Point2 2 0, Point2 1 1]+    multiPoly :: MultiPolygon () (RealNumber 10)+    multiPoly = MultiPolygon+      (fromPoints . map ext $ [Point2 (-1) (-1), Point2 3 (-1), Point2 2 2])+      [simpleTriangle]+:} -}+++-- | \( 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+onBoundary        :: (Num r, Ord r) => Point 2 r -> Polygon t p r -> Bool+q `onBoundary` pg = any (q `intersects`) es+  where+    out = pg^.outerBoundary+    es = concatMap (F.toList . outerBoundaryEdges) $ out : holeList pg++-- | 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+inPolygon             :: forall t p r. (Fractional r, Ord r)+                      => Point 2 r -> Polygon t p r -> PointLocationResult+q `inPolygon` pg+  | q `onBoundary` pg = OnBoundary+  | inHole            = Outside+  | otherwise         = q `inPolygon'` (pg^.outerBoundary)+  where+    inHole = any (q `insidePolygon`) $ holeList pg++-- | Returns true if the point lies in the polygon+-- pre: point lies inside or outside the polygon, not on its boundary.+inPolygon'        :: forall p r. (Fractional r, Ord r)+                  => Point 2 r -> SimplePolygon p r+                  -> PointLocationResult+q `inPolygon'` pg = if odd . length . mapMaybe intersectionPoint $ ups <> downs+                    then Inside else Outside+  where+    -- we don't care about horizontal edges+    (ups',_horizontals,downs') = partitionEdges . listEdges $ pg+    partitionEdges = List.partition3 $ \s -> (s^.end.core.yCoord) `compare` (s^.start.core.yCoord)++    -- upward edges include start, exclude end+    ups   = map (\(LineSegment' a b) -> LineSegment (Closed a) (Open b)) ups'+    -- downward edges exclude start, include end+    downs = map (\(LineSegment' a b) -> LineSegment (Open a) (Closed b)) downs'++    -- Given an edge, compute the intersection point (if a point) with+    -- the line through the query point, and test if it lies strictly+    -- right of q.+    --+    -- See http://geomalgorithms.com/a03-_inclusion.html for more information.+    intersectionPoint =  F.find (\p -> p^.xCoord > q^.xCoord) . asA @(Point 2 r) . (`intersect` l)+    l = horizontalLine $ q^.yCoord+++-- | Test if a point lies strictly inside the polgyon.+insidePolygon        :: (Fractional r, Ord r) => Point 2 r -> Polygon t p r -> Bool+q `insidePolygon` pg = q `inPolygon` pg == Inside+++-- testQ = map (`inPolygon` testPoly) [ Point2 1 1    -- Inside+--                                    , Point2 0 0    -- OnBoundary+--                                    , Point2 5 14   -- Inside+--                                    , Point2 5 10   -- Inside+--                                    , Point2 10 5   -- OnBoundary+--                                    , Point2 20 5   -- Outside+--                                    ]++-- testPoly :: SimplePolygon () Rational+-- testPoly = fromPoints . map ext $ [ Point2 0 0+--                                                   , Point2 10 0+--                                                   , Point2 10 10+--                                                   , Point2 5 15+--                                                   , Point2 1 11+--                                                   ]
src/Algorithms/Geometry/LineSegmentIntersection.hs view
@@ -1,6 +1,23 @@-module Algorithms.Geometry.LineSegmentIntersection where+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.LineSegmentIntersection+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--------------------------------------------------------------------------------+module Algorithms.Geometry.LineSegmentIntersection+  ( hasInteriorIntersections+  , hasSelfIntersections+  , Intersections+  , Associated(..)+  , IntersectionPoint(..)+  , isEndPointIntersection+  , associated+  , Compare+  ) where  import qualified Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann as BO+import           Algorithms.Geometry.LineSegmentIntersection.Types import           Data.Geometry.LineSegment import           Data.Geometry.Polygon
src/Algorithms/Geometry/LineSegmentIntersection/BentleyOttmann.hs view
@@ -10,7 +10,13 @@ -- and Ottmann. -- ---------------------------------------------------------------------------------module Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann where+module Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann+  ( intersections+  , interiorIntersections+    -- FIXME: Move ordAt and xCoordAt to Data.Geometry.LineSegment?+  , ordAt+  , xCoordAt+  ) where  import           Algorithms.Geometry.LineSegmentIntersection.Types import           Control.Lens hiding (contains)@@ -194,7 +200,7 @@   where     (before, mid1, after') = SS.splitOn (xCoordAt $ p^.yCoord) (p^.xCoord) ss     -- Make sure to also select the horizontal segments containing p-    (mid2, after) = SS.spanAntitone (\s -> p `onSegment` s) after'+    (mid2, after) = SS.spanAntitone (intersects p) after'   -- | Given a point and the linesegements that contain it. Create a piece of@@ -230,9 +236,9 @@                    => Point 2 r -> LineSegment 2 p r -> LineSegment 2 p r                    -> Maybe (Event p r) findNewEvent p l r = match (l `intersect` r) $-     (H $ \NoIntersection -> Nothing)-  :& (H $ \q              -> if ordPoints q p == GT then Just (Event q Intersection)-                                      else Nothing)-  :& (H $ \_              -> Nothing) -- full segment intersectsions are handled-                                      -- at insertion time+     H (const Nothing) -- NoIntersection+  :& H (\q -> if ordPoints q p == GT then Just (Event q Intersection)+                                     else Nothing)+  :& H (const Nothing) -- full segment intersectsions are handled+                       -- at insertion time   :& RNil
+ src/Algorithms/Geometry/LineSegmentIntersection/BooleanSweep.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE ScopedTypeVariables #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.LineSegmentIntersection.BooleanSweep+-- Copyright   :  (C) Frank Staals, David Himmelstrup+-- License     :  see the LICENSE file+-- Maintainer  :  David Himmelstrup+--+-- \( O(n \log n) \) algorithm for determining if any two line segments overlap.+--+-- Shamos and Hoey.+--+--------------------------------------------------------------------------------+module Algorithms.Geometry.LineSegmentIntersection.BooleanSweep+  ( hasIntersections+  , segmentsOverlap+  ) where++import           Control.Lens              hiding (contains)+import           Data.Ext+import           Data.Geometry.Interval+import           Data.Geometry.Line+import           Data.Geometry.LineSegment+import           Data.Geometry.Point+import           Data.Geometry.Triangle+import qualified Data.List                 as L+import           Data.Maybe+import           Data.Ord                  (Down (..), comparing)+import qualified Data.Set                  as SS+import qualified Data.Set.Util             as SS++-- import           Data.RealNumber.Rational+-- import Debug.Trace++--------------------------------------------------------------------------------++-- | Tests if there are any intersections.+--+-- \(O(n\log n)\)+hasIntersections    :: (Ord r, Num r)+                 => [LineSegment 2 p r] -> Bool+hasIntersections ss = sweep pts SS.empty+  where+    pts = L.sortBy ordEvents . concatMap asEventPts $ ss++-- | Computes the event points for a given line segment+asEventPts   :: Ord r => LineSegment 2 p r -> [Event p r]+asEventPts s =+  case ordPoints (s^.start.core) (s^.end.core) of+    LT -> [Insert s, Delete s]+    _  -> let LineSegment a b = s+              s' = LineSegment b a+          in [Insert s', Delete s']++--------------------------------------------------------------------------------+-- * Data type for Events++-- | The actual event consists of a point and its type+data Event p r = Insert (LineSegment 2 p r) | Delete (LineSegment 2 p r)++eventPoint :: Event p r -> Point 2 r+eventPoint (Insert l) = l^.start.core+eventPoint (Delete l) = l^.end.core++-- Sort order:+--  1. Y-coord. Larger Ys before smaller.+--  2. X-coord. Smaller Xs before larger.+--  3. Type: Inserts before deletions+ordEvents :: (Num r, Ord r) => Event p r -> Event p r -> Ordering+ordEvents e1 e2 = ordPoints (eventPoint e1) (eventPoint e2) <> cmpType e1 e2+  where+    cmpType Insert{} Delete{} = LT+    cmpType Delete{} Insert{} = GT+    cmpType _ _               = EQ++-- | An ordering that is decreasing on y, increasing on x+ordPoints     :: Ord r => Point 2 r -> Point 2 r -> Ordering+ordPoints a b = let f p = (Down $ p^.yCoord, p^.xCoord) in comparing f a b++--------------------------------------------------------------------------------+-- * The Main Sweep++type StatusStructure p r = SS.Set (LineSegment 2 p r)++-- | Run the sweep handling all events+sweep :: forall r p. (Ord r, Num r)+      => [Event p r] -> StatusStructure p r+      -> Bool+sweep [] _ = False+sweep (Delete l:eq) ss =+    overlaps || sweep eq ss'+  where+    p = l^.end.core+    (before,_contains,after) = splitBeforeAfter p ss+    overlaps = fromMaybe False (segmentsOverlap <$> sl <*> sr)+    sl = SS.lookupMax before+    sr = SS.lookupMin after+    ss' = before `SS.join` after+sweep (Insert l@(LineSegment startPoint _endPoint):eq) ss =+    endOverlap || overlaps || sweep eq ss'+  where+    p = l^.start.core+    (before,contains,after) = splitBeforeAfter p ss+    endOverlap =+      (not (null contains) && isClosed startPoint)+    overlaps = or [ fromMaybe False (segmentsOverlap l <$> sl)+                  , fromMaybe False (segmentsOverlap l <$> sr) ]+    sl = SS.lookupMax before+    sr = SS.lookupMin after+    ss' = before `SS.join` SS.singleton l `SS.join` after++-- | split the status structure around p.+-- the result is (before,contains,after)+splitBeforeAfter      :: (Num r, Ord r)+                     => Point 2 r -> StatusStructure p r+                     -> (StatusStructure p r, [LineSegment 2 p r],StatusStructure p r)+splitBeforeAfter p ss = (before, filter (not . endsAt p) $ SS.toList contains, after)+  where+    (before,contains,after) = SS.splitBy cmpLine ss+    cmpLine line+      | isHorizontal line =+        let [_top,bot] = L.sortBy ordPoints [line^.start.core,line^.end.core] in+        (bot^.xCoord) `compare` (p^.xCoord)+    cmpLine line =+      let [top,bot] = L.sortBy ordPoints [line^.start.core,line^.end.core] in+      case ccw bot top p of+        CW       -> LT+        CoLinear -> EQ+        CCW      -> GT+++isHorizontal :: Eq r => LineSegment 2 p r -> Bool+isHorizontal s  = s^.start.core.yCoord == s^.end.core.yCoord++-- | Test if a segment ends at p+endsAt                     :: Ord r => Point 2 r -> LineSegment 2 p r -> Bool+endsAt p (LineSegment _ b) = fmap (view core) b == Open p++--------------------------------------------------------------------------------+-- * Finding New events++segmentsOverlap :: (Num r, Ord r) => LineSegment 2 p r -> LineSegment 2 p r -> Bool+segmentsOverlap a@(LineSegment aStart aEnd) b =+    (isClosed aStart && (aStart^.unEndPoint.core) `onSegment2` b) ||+    (isClosed aEnd && (aEnd^.unEndPoint.core) `onSegment2` b) ||+    (opposite (ccw' (a^.start) (b^.start) (a^.end)) (ccw' (a^.start) (b^.end) (a^.end)) &&+    not (onTriangleRelaxed (a^.end.core) t1) &&+    not (onTriangleRelaxed (a^.start.core) t2))+  where+    opposite CW CCW = True+    opposite CCW CW = True+    opposite _ _    = False+    t1 = Triangle (a^.start) (b^.start) (b^.end)+    t2 = Triangle (a^.end) (b^.start) (b^.end)++-- Copied from Data.Geometry.LineSegment.Internal. Delete when PR#62 is merged.+onSegment2                          :: (Ord r, Num r)+                                    => Point 2 r -> LineSegment 2 p r -> Bool+p `onSegment2` s@(LineSegment u v) = case ccw' (ext p) (u^.unEndPoint) (v^.unEndPoint) of+    CoLinear -> let su = p `onSide` lu+                    sv = p `onSide` lv+                in su /= sv+                && ((su == OnLine) `implies` isClosed u)+                && ((sv == OnLine) `implies` isClosed v)+    _        -> False+  where+    (Line _ w) = perpendicularTo $ supportingLine s+    lu = Line (u^.unEndPoint.core) w+    lv = Line (v^.unEndPoint.core) w++    a `implies` b = b || not a
src/Algorithms/Geometry/LineSegmentIntersection/Naive.hs view
@@ -1,5 +1,9 @@ {-# LANGUAGE ScopedTypeVariables #-}-module Algorithms.Geometry.LineSegmentIntersection.Naive where+-- | Line segment intersections in \(O(n^2)\) by checking+--   all pairs.+module Algorithms.Geometry.LineSegmentIntersection.Naive+  ( intersections+  ) where  import           Algorithms.Geometry.LineSegmentIntersection.Types import           Control.Lens@@ -25,9 +29,9 @@                  => (LineSegment 2 p r, LineSegment 2 p r)                  -> Intersections p r -> Intersections p r collect (s,s') m = match (s `intersect` s') $-     (H $ \NoIntersection -> m)-  :& (H $ \p              -> handlePoint s s' p $ m)-  :& (H $ \s''            -> foldr (handlePoint s s') m [s''^.start.core, s''^.end.core])+     H (\NoIntersection -> m)+  :& H (\p              -> handlePoint s s' p m)+  :& H (\s''            -> foldr (handlePoint s s') m [s''^.start.core, s''^.end.core])   :& RNil  -- | Add s and s' to the map with key p
src/Algorithms/Geometry/LineSegmentIntersection/Types.hs view
@@ -1,4 +1,11 @@ {-# LANGUAGE TemplateHaskell #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.LineSegmentIntersection.Types+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Algorithms.Geometry.LineSegmentIntersection.Types where  import           Control.DeepSeq
src/Algorithms/Geometry/LinearProgramming/LP2DRIC.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE PackageImports #-} -------------------------------------------------------------------------------- -- | -- Module      :  Algorithms.Geometry.LinearProgramming.LP2DRIC@@ -37,13 +38,13 @@ import           Data.Util import           Data.Vinyl import           Data.Vinyl.CoRec-import           System.Random.Shuffle+import "hgeometry-combinatorial" System.Random.Shuffle  --------------------------------------------------------------------------------  -- | Solve a linear program-solveLinearProgram :: MonadRandom m => LinearProgram 2 r -> m (LPSolution 2 r)-solveLinearProgram = undefined+_solveLinearProgram :: MonadRandom m => LinearProgram 2 r -> m (LPSolution 2 r)+_solveLinearProgram = undefined   -- | Solves a bounded linear program in 2d. Returns Nothing if there is no@@ -115,20 +116,20 @@               => Line 2 r               -> [HalfSpace 2 r]               -> Maybe [HalfLine 2 r]-collectOn l = sequence . mapMaybe collect . map (l `intersect`)+collectOn l = sequence . mapMaybe (collect . (l `intersect`))   where     collect   :: Intersection (Line 2 r) (HalfSpace 2 r) -> Maybe (Maybe (HalfLine 2 r))     collect r = match r $-         (H $ \NoIntersection -> Just Nothing)-      :& (H $ \hl             -> Just $ Just hl)-      :& (H $ \_              -> Nothing)+         H (const $ Just Nothing) -- NoIntersection+      :& H (Just . Just)          -- HalfLine+      :& H (const Nothing)        -- Line       :& RNil   -- | Given a vector v and two points a and b, determine which is smaller in direction v. cmpHalfPlane       :: (Ord r, Num r, Arity d)                    => Vector d r -> Point d r -> Point d r -> Ordering-cmpHalfPlane v a b = case a `inHalfSpace` (HalfSpace $ HyperPlane b $ v) of+cmpHalfPlane v a b = case a `inHalfSpace` HalfSpace (HyperPlane b v) of                        Inside     -> GT                        OnBoundary -> EQ                        Outside    -> LT@@ -147,7 +148,7 @@ commonIntersection                :: (Ord r, Num r, Arity d)                                   => Line d r                                   -> NonEmpty.NonEmpty (HalfLine d r :+ a)-                                  -> Either (Two ((HalfLine d r :+ a)))+                                  -> Either (Two (HalfLine d r :+ a))                                             (OneOrTwo (Point d r :+ a)) commonIntersection (Line _ v) hls = case (nh,ph) of      (Nothing,Nothing) -> error "absurd; this case cannot occur"@@ -159,7 +160,7 @@                             GT -> Right . Right $ Two (extract p) (extract n)   where     extract = over core (^.startPoint)-    (pos,neg) = NonEmpty.partition (\hl -> hl^.core.halfLineDirection == v) $ hls+    (pos,neg) = NonEmpty.partition (\hl -> hl^.core.halfLineDirection == v) hls     ph = maximumBy' (cmpHalfPlane' v) pos     nh = maximumBy' (flip $ cmpHalfPlane' v) neg @@ -219,7 +220,9 @@   where     Just p = asA @(Point 2 r)            $ (m1^.boundingPlane._asLine) `intersect` (m2^.boundingPlane._asLine)-+initialize _ = error+  "Algorithms.Geometry.LinearProgramming.LP2DRIC.initialize requires \+  \at least two constraints."   --------------------------------------------------------------------------------@@ -234,13 +237,13 @@ -- - \(c \cdot d > 0\), and -- - \(d \cdot n(h) \geq 0\), wherefor every half space \(h\). ---findD                      :: (Ord r, Fractional r)+_findD                      :: (Ord r, Fractional r)                            => LinearProgram 2 r -> Maybe (Vector 2 r)-findD (LinearProgram c hs) = do hls <- collectOn nl hs'-                                d   <- toVec <$> oneDLinearProgramming v nl hls-                                       -- the direction v here does not really matter-                                if c `dot` d > 0 then pure d-                                                 else Nothing+_findD (LinearProgram c hs) = do hls <- collectOn nl hs'+                                 d   <- toVec <$> oneDLinearProgramming v nl hls+                                        -- the direction v here does not really matter+                                 if c `dot` d > 0 then pure d+                                                  else Nothing   where     -- we interpret the points on nl as directions w.r.t the origin     nl@(Line _ v) = perpendicularTo (Line (origin .+^ c) c)@@ -248,14 +251,14 @@      -- every halfspace creates an allowed set of directions, modelled by a     -- half-line on nl-    toHL h = let n              = h^.boundingPlane.normalVec+    toHL h = let _n              = h^.boundingPlane.normalVec              in undefined   -- | Either finds an unbounded Haflline, or evidence the two halfspaces that provide -- evidence that no solution exists-findUnBoundedHalfLine :: LinearProgram 2 r -> Either (Two (HalfSpace 2 r)) (HalfLine 2 r)-findUnBoundedHalfLine = undefined -- use findD then find the starting point+_findUnBoundedHalfLine :: LinearProgram 2 r -> Either (Two (HalfSpace 2 r)) (HalfLine 2 r)+_findUnBoundedHalfLine = undefined -- use findD then find the starting point
src/Algorithms/Geometry/LowerEnvelope/DualCH.hs view
@@ -1,4 +1,11 @@ {-# LANGUAGE ScopedTypeVariables #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.LowerEnvelope.DualCH+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Algorithms.Geometry.LowerEnvelope.DualCH where  import Data.Maybe(fromJust)
src/Algorithms/Geometry/PolyLineSimplification/DouglasPeucker.hs view
@@ -1,3 +1,10 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.PolyLineSimplification.DouglasPeucker+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Algorithms.Geometry.PolyLineSimplification.DouglasPeucker where  import           Control.Lens hiding (only)@@ -18,7 +25,7 @@ -- vertices from pl) s.t. all other vertices are within dist eps to the -- original polyline. ----- Running time: O(n^2) worst case, O(n log n) expected.+-- Running time: \( O(n^2) \) worst case, \( O(n log n) \) expected. douglasPeucker         :: (Ord r, Fractional r, Arity d)                        => r -> PolyLine d p r -> PolyLine d p r douglasPeucker eps pl
+ src/Algorithms/Geometry/PolygonTriangulation/EarClip.hs view
@@ -0,0 +1,525 @@+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.PolygonTriangulation.EarClip+-- Copyright   :  (C) David Himmelstrup+-- License     :  see the LICENSE file+-- Maintainer  :  David Himmelstrup+--+-- Ear clipping triangulation algorithms. The baseline algorithm runs in \( O(n^2) \)+-- but has a low constant factor overhead. The z-order hashed variant runs in+-- \( O(n \log n) \).+--+-- References:+--+--  1. https://en.wikipedia.org/wiki/Polygon_triangulation#Ear_clipping_method+--  2. https://en.wikipedia.org/wiki/Z-order_curve+--+--------------------------------------------------------------------------------+module Algorithms.Geometry.PolygonTriangulation.EarClip+  ( earClip+  , earClipRandom+  , earClipHashed+  , earClipRandomHashed+  , zHash+  , zUnHash+  ) where++import           Control.Lens                 ((^.))+import           Control.Monad.Identity+import           Control.Monad.ST             (ST, runST)+import           Control.Monad.ST.Unsafe      (unsafeInterleaveST)+import           Data.Bits+import           Data.Ext+import           Data.Geometry.Boundary       (PointLocationResult (Outside))+import           Data.Geometry.Point          (Point (Point2), ccw', pattern CCW)+import           Data.Geometry.Polygon+import           Data.Geometry.Box+import           Data.Geometry.Triangle       (Triangle (Triangle), inTriangleRelaxed)+import           Data.STRef+import           Data.Vector                  (Vector)+import qualified Data.Vector                  as V+import qualified Data.Vector.Algorithms.Intro as Algo+import qualified Data.Vector.Circular         as CV+import qualified Data.Vector.NonEmpty         as NE+import qualified Data.Vector.Unboxed          as U+import qualified Data.Vector.Unboxed.Mutable  as MU+import           GHC.Exts                     (build)+import           Linear.V2+import           System.Random                (mkStdGen, randomR)++{-+  We can check if a vertex is an ear in O(n) time. Checking all vertices will definitely+  yield at least one ear in O(n^2) time. So, finding N ears will take O(n^3) if done naively.++  Keeping a separate list of possible ears will improve matters. For each possible ear,+  we check if the vertex really is an ear or not. If it isn't, it is deleted from the+  list of possible ears. If it /is/ an ear, the vertex is cut and the neighbours are+  added back to the list of possible ears (if they aren't in the list already).++  So, start with a list of N possible ears, and we might add two vertices to the list+  ever time we find an ear. Since there are only N ears to be found, only 2*N vertices+  can be added to the list of possible ears in the worst case scenario. The list is+  therefore bounded to 3*N and finding all ears is therefore O(n^2).++  Note: When checking if a vertex is an ear, it is sufficient to check against+        reflex vertices. Some implementations keep a separate list of reflex+        vertices for this reason but it does increase the constant factor+        overhead. I think it's better to keep the constant factor low for small values+        of N and use the hashed algorithm for larger values of N.+-}+-- | \( O(n^2) \)+--+--   Returns triangular faces using absolute polygon point indices.+earClip :: (Num r, Ord r) => SimplePolygon p r -> [(Int,Int,Int)]+earClip poly = build gen+  where+    vs = NE.toVector $ CV.vector $ poly^.outerBoundaryVector+    gen :: ((Int,Int,Int) -> b -> b) -> b -> b+    gen cons nil = runST $ do+      vertices <- mutListFromVector vs+      possibleEars <- mutListClone vertices+      let worker len focus = do+            prev <- mutListPrev vertices focus+            next <- mutListNext vertices focus+            if len == 3+              then+                return $ cons (prev, focus, next) nil+              else do+                prevEar <- mutListPrev possibleEars focus+                nextEar <- mutListNext possibleEars focus+                isEar <- earCheck vertices prev focus next+                if isEar+                  then do+                    mutListDelete possibleEars prevEar nextEar+                    mutListDelete vertices prev next -- remove ear++                    case (prevEar /= prev, nextEar /= next) of+                      (True, True)  -> do+                        mutListInsert possibleEars prevEar nextEar prev+                        mutListInsert possibleEars prev nextEar next+                      (True, False) -> do+                        mutListInsert possibleEars prevEar nextEar prev+                      (False, True) -> do+                        mutListInsert possibleEars prevEar nextEar next+                      (False, False) -> return ()++                    cons (prev, focus, next)+                      <$> unsafeInterleaveST (worker (len-1) nextEar)+                  else do -- not an ear+                    mutListDelete possibleEars prevEar nextEar -- remove vertex+                    worker len nextEar+      worker (V.length vs) 0++-- | \( O(n^2) \)+--+--   Returns triangular faces using absolute polygon point indices.+earClipRandom :: (Num r, Ord r) => SimplePolygon p r -> [(Int,Int,Int)]+earClipRandom poly = build gen+  where+    vs = NE.toVector $ CV.vector $ poly^.outerBoundaryVector+    gen :: ((Int,Int,Int) -> b -> b) -> b -> b+    gen cons nil = runST $ do+      vertices <- mutListFromVector vs+      possibleEars <- mutListClone vertices+      shuffled <- newShuffled (V.length vs)+      let worker len = do+            focus <- popShuffled shuffled+            prev <- mutListPrev vertices focus+            next <- mutListNext vertices focus+            if len == 3+              then+                return $ cons (prev, focus, next) nil+              else do+                prevEar <- mutListPrev possibleEars focus+                nextEar <- mutListNext possibleEars focus+                isEar <- earCheck vertices prev focus next+                if isEar+                  then do+                    mutListDelete possibleEars prevEar nextEar+                    mutListDelete vertices prev next -- remove ear++                    case (prevEar /= prev, nextEar /= next) of+                      (True, True)  -> do+                        pushShuffled shuffled prev+                        pushShuffled shuffled next+                        mutListInsert possibleEars prevEar nextEar prev+                        mutListInsert possibleEars prev nextEar next+                      (True, False) -> do+                        pushShuffled shuffled prev+                        mutListInsert possibleEars prevEar nextEar prev+                      (False, True) -> do+                        pushShuffled shuffled next+                        mutListInsert possibleEars prevEar nextEar next+                      (False, False) -> return ()++                    cons (prev, focus, next)+                      <$> unsafeInterleaveST (worker (len-1))+                  else do -- not an ear+                    mutListDelete possibleEars prevEar nextEar -- remove vertex+                    worker len+      worker (V.length vs)++-- | \( O(n \log n) \) expected time.+--+--   Returns triangular faces using absolute polygon point indices.+earClipHashed :: Real r => SimplePolygon p r -> [(Int,Int,Int)]+earClipHashed poly = build gen+  where+    vs = NE.toVector $ CV.vector $ poly^.outerBoundaryVector+    n = V.length vs+    hasher = zHashGen vs+    zHashVec = U.generate n $ \i -> hasher (V.unsafeIndex vs i ^. core)+    gen :: ((Int,Int,Int) -> b -> b) -> b -> b+    gen cons nil = runST $ do+      vertices <- mutListFromVector vs+      zHashes <- mutListSort zHashVec+      possibleEars <- mutListClone vertices+      let worker len focus = do+            prev <- mutListPrev vertices focus+            next <- mutListNext vertices focus+            if len == 3+              then+                return $ cons (prev, focus, next) nil+              else do+                prevEar <- mutListPrev possibleEars focus+                nextEar <- mutListNext possibleEars focus+                isEar <- earCheckHashed hasher vertices zHashes prev focus next+                if isEar+                  then do+                    mutListDelete possibleEars prevEar nextEar+                    mutListDelete vertices prev next -- remove ear+                    mutListDeleteFocus zHashes focus++                    case (prevEar /= prev, nextEar /= next) of+                      (True, True)  -> do+                        mutListInsert possibleEars prevEar nextEar prev+                        mutListInsert possibleEars prev nextEar next+                      (True, False) -> do+                        mutListInsert possibleEars prevEar nextEar prev+                      (False, True) -> do+                        mutListInsert possibleEars prevEar nextEar next+                      (False, False) -> return ()++                    cons (prev, focus, next)+                      <$> unsafeInterleaveST (worker (len-1) nextEar)+                  else do -- not an ear+                    mutListDelete possibleEars prevEar nextEar -- remove vertex+                    worker len nextEar+      worker n 0++-- | \( O(n \log n) \) expected time.+--+--   Returns triangular faces using absolute polygon point indices.+earClipRandomHashed :: Real r => SimplePolygon p r -> [(Int,Int,Int)]+earClipRandomHashed poly = build gen+  where+    vs = NE.toVector $ CV.vector $ poly^.outerBoundaryVector+    n = V.length vs+    hasher = zHashGen vs+    zHashVec = U.generate n $ \i -> hasher (V.unsafeIndex vs i ^. core)+    gen :: ((Int,Int,Int) -> b -> b) -> b -> b+    gen cons nil = runST $ do+      vertices <- mutListFromVector vs+      zHashes <- mutListSort zHashVec+      possibleEars <- mutListClone vertices+      shuffled <- newShuffled (V.length vs)+      let worker len = do+            focus <- popShuffled shuffled+            prev <- mutListPrev vertices focus+            next <- mutListNext vertices focus+            if len == 3+              then+                return $ cons (prev, focus, next) nil+              else do+                prevEar <- mutListPrev possibleEars focus+                nextEar <- mutListNext possibleEars focus+                isEar <- earCheckHashed hasher vertices zHashes prev focus next+                if isEar+                  then do+                    mutListDelete possibleEars prevEar nextEar+                    mutListDelete vertices prev next -- remove ear+                    mutListDeleteFocus zHashes focus++                    case (prevEar /= prev, nextEar /= next) of+                      (True, True)  -> do+                        pushShuffled shuffled prev+                        pushShuffled shuffled next+                        mutListInsert possibleEars prevEar nextEar prev+                        mutListInsert possibleEars prev nextEar next+                      (True, False) -> do+                        pushShuffled shuffled prev+                        mutListInsert possibleEars prevEar nextEar prev+                      (False, True) -> do+                        pushShuffled shuffled next+                        mutListInsert possibleEars prevEar nextEar next+                      (False, False) -> return ()++                    cons (prev, focus, next)+                      <$> unsafeInterleaveST (worker (len-1))+                  else do -- not an ear+                    mutListDelete possibleEars prevEar nextEar -- remove vertex+                    worker len+      worker n++-------------------------------------------------------------------------------+-- Bounding box++-- Returns (minX, widthX, minY, heightY)+zHashGen :: Real r => V.Vector (Point 2 r :+ p) -> (Point 2 r -> Word)+zHashGen v = zHashPoint bounds+  where+    bounds = (minX, realToFrac (maxX-minX), minY, realToFrac (maxY-minY))+    bb = V.foldl1' (<>) $ V.map boundingBox v+    Point2 minX minY = minPoint bb ^. core+    Point2 maxX maxY = minPoint bb ^. core++-------------------------------------------------------------------------------+-- Z-Order+-- https://en.wikipedia.org/wiki/Z-order_curve++zHashPoint :: Real r => (r,Double,r,Double) -> Point 2 r -> Word+zHashPoint (minX, widthX, minY, heightY) (Point2 x y) =+    zHash (V2 x' y')+  where+    x' = round (realToFrac (x-minX) / widthX * zHashMax)+    y' = round (realToFrac (y-minY) / heightY * zHashMax)++zHashMax :: Double+zHashMax = realToFrac zHashMaxW++zHashMaxW :: Word+zHashMaxW = if finiteBitSize zHashMaxW == 32 then 0xFFFF else 0xFFFFFFFF++-- | O(1) Z-Order hash the first half-world of each coordinate.+zHash :: V2 Word -> Word+zHash (V2 a b) = zHashSingle a .|. (unsafeShiftL (zHashSingle b) 1)++-- | O(1) Reverse z-order hash.+zUnHash :: Word -> V2 Word+zUnHash z =+  V2 (zUnHashSingle z) (zUnHashSingle (unsafeShiftR z 1))++zHashSingle :: Word -> Word+zHashSingle w+  | finiteBitSize w == 32 = zHashSingle32 w+  | otherwise             = zHashSingle64 w++zUnHashSingle :: Word -> Word+zUnHashSingle w+  | finiteBitSize w == 32 = zUnHashSingle32 w+  | otherwise             = zUnHashSingle64 w++zHashSingle32 :: Word -> Word+zHashSingle32 w = runIdentity $ do+    w <- pure $ w .&. 0x0000FFFF+    w <- pure $ (w .|. unsafeShiftL w 8)  .&. 0x00FF00FF+    w <- pure $ (w .|. unsafeShiftL w 4)  .&. 0x0F0F0F0F+    w <- pure $ (w .|. unsafeShiftL w 2)  .&. 0x33333333+    w <- pure $ (w .|. unsafeShiftL w 1)  .&. 0x55555555+    pure w++zUnHashSingle32 :: Word -> Word+zUnHashSingle32 w = runIdentity $ do+    w <- pure $ w .&. 0x55555555+    w <- pure $ (w .|. unsafeShiftR w 1)  .&. 0x33333333+    w <- pure $ (w .|. unsafeShiftR w 2)  .&. 0x0F0F0F0F+    w <- pure $ (w .|. unsafeShiftR w 4)  .&. 0x00FF00FF+    w <- pure $ (w .|. unsafeShiftR w 8)  .&. 0x0000FFFF+    pure w++zHashSingle64 :: Word -> Word+zHashSingle64 w = runIdentity $ do+    w <- pure $ w .&. 0x00000000FFFFFFFF+    w <- pure $ (w .|. unsafeShiftL w 16) .&. 0x0000FFFF0000FFFF+    w <- pure $ (w .|. unsafeShiftL w 8)  .&. 0x00FF00FF00FF00FF+    w <- pure $ (w .|. unsafeShiftL w 4)  .&. 0x0F0F0F0F0F0F0F0F+    w <- pure $ (w .|. unsafeShiftL w 2)  .&. 0x3333333333333333+    w <- pure $ (w .|. unsafeShiftL w 1)  .&. 0x5555555555555555+    pure w++zUnHashSingle64 :: Word -> Word+zUnHashSingle64 w = runIdentity $ do+    w <- pure $ w .&. 0x5555555555555555+    w <- pure $ (w .|. unsafeShiftR w 1) .&. 0x3333333333333333+    w <- pure $ (w .|. unsafeShiftR w 2)  .&. 0x0F0F0F0F0F0F0F0F+    w <- pure $ (w .|. unsafeShiftR w 4)  .&. 0x00FF00FF00FF00FF+    w <- pure $ (w .|. unsafeShiftR w 8)  .&. 0x0000FFFF0000FFFF+    w <- pure $ (w .|. unsafeShiftR w 16)  .&. 0x00000000FFFFFFFF+    pure w++-------------------------------------------------------------------------------+-- Shuffled++data Shuffled s = Shuffled+  { shuffleCount  :: STRef s Int+  , shuffleVector :: MU.MVector s Int }++newShuffled :: Int -> ST s (Shuffled s)+newShuffled len = Shuffled <$> newSTRef len <*> U.unsafeThaw (U.enumFromN 0 len)++popShuffled :: Shuffled s -> ST s Int+popShuffled Shuffled{..} = do+  count <- readSTRef shuffleCount+  writeSTRef shuffleCount (count-1)+  let idx = fst $ randomR (0, count-1) (mkStdGen count)+  val <- MU.unsafeRead shuffleVector idx+  MU.unsafeWrite shuffleVector idx =<< MU.unsafeRead shuffleVector (count-1)+  pure val++pushShuffled :: Shuffled s -> Int -> ST s ()+pushShuffled (Shuffled ref vector) val = do+  count <- readSTRef ref+  writeSTRef ref (count+1)+  MU.unsafeWrite vector count val++-------------------------------------------------------------------------------+-- MutList++data MutList s a = MutList+  { mutListIndex   :: (Int -> a)+  , mutListNextVec :: MU.MVector s Int+  , mutListPrevVec :: MU.MVector s Int+  }++-- O(n)+mutListFromVector :: Vector a -> ST s (MutList s a)+mutListFromVector vec = MutList (V.unsafeIndex vec)+  <$> do+    arr <- U.unsafeThaw (U.enumFromN 1 (V.length vec))+    MU.unsafeWrite arr (V.length vec-1) 0+    pure arr+  <*> do+    arr <- U.unsafeThaw (U.enumFromN (-1) (V.length vec))+    MU.unsafeWrite arr 0 (V.length vec-1)+    pure arr++mutListClone :: MutList s a -> ST s (MutList s a)+mutListClone (MutList vec nextVec prevVec) = MutList vec+  <$> MU.clone nextVec+  <*> MU.clone prevVec++mutListNext :: MutList s a -> Int -> ST s Int+mutListNext m idx = MU.unsafeRead (mutListNextVec m) idx++mutListPrev :: MutList s a -> Int -> ST s Int+mutListPrev m idx = MU.unsafeRead (mutListPrevVec m) idx++mutListDelete :: MutList s a -> Int -> Int -> ST s ()+mutListDelete m prev next = do+  MU.unsafeWrite (mutListNextVec m) prev next+  MU.unsafeWrite (mutListPrevVec m) next prev++mutListDeleteFocus :: MutList s a -> Int -> ST s ()+mutListDeleteFocus m focus = do+  prev <- mutListPrev m focus+  next <- mutListNext m focus+  unless (prev == -1) $+    MU.unsafeWrite (mutListNextVec m) prev next+  unless (next == -1) $+    MU.unsafeWrite (mutListPrevVec m) next prev++mutListInsert :: MutList s a -> Int -> Int -> Int -> ST s ()+mutListInsert m before after elt = do+  MU.unsafeWrite (mutListNextVec m) before elt  -- before.next = elt+  MU.unsafeWrite (mutListNextVec m) elt after   -- elt.next = after+  MU.unsafeWrite (mutListPrevVec m) after elt   -- after.prev = elt+  MU.unsafeWrite (mutListPrevVec m) elt before  -- elt.prev = before++mutListSort :: (Ord a, MU.Unbox a) => U.Vector a -> ST s (MutList s a)+mutListSort vec = do+    sorted <- do+      arr <- U.unsafeThaw $ (U.enumFromN 0 n :: U.Vector Int)+      Algo.sortBy (\a b -> compare (U.unsafeIndex vec a) (U.unsafeIndex vec b)) arr+      U.unsafeFreeze arr++    next <- MU.new n+    prev <- MU.new n+    MU.write next+      (U.unsafeIndex sorted (n-1))+      (-1)+    forM_ [0..n-2] $ \i -> do+      MU.write next+        (U.unsafeIndex sorted i)+        (U.unsafeIndex sorted (i+1))+    MU.write prev+      (U.unsafeIndex sorted 0)+      (-1)+    forM_ [1..n-1] $ \i -> do+      MU.write prev+        (U.unsafeIndex sorted i)+        (U.unsafeIndex sorted (i-1))+    pure $ MutList (U.unsafeIndex vec) next prev+  where+    n = U.length vec++-------------------------------------------------------------------------------+-- Ear checking++-- O(n)+earCheck :: (Num r, Ord r) => MutList s (Point 2 r :+ p) -> Int -> Int -> Int -> ST s Bool+earCheck vertices a b c = do+  let pointA = mutListIndex vertices a+      pointB = mutListIndex vertices b+      pointC = mutListIndex vertices c+      trig = Triangle pointA pointB pointC++  let loop elt | elt == a = pure True+      loop elt = do+        let point = mutListIndex vertices elt ^. core+        case inTriangleRelaxed point trig of+          Outside -> loop =<< mutListNext vertices elt+          _       -> pure False+  if ccw' pointA pointB pointC == CCW+    then loop =<< mutListNext vertices c+    else pure False++-- showBinary :: (Integral a, Show a) => a -> String+-- showBinary i = showIntAtBase 2 intToDigit i ""++earCheckHashed :: Real r => (Point 2 r -> Word) -> MutList s (Point 2 r :+ p) -> MutList s Word -> Int -> Int -> Int -> ST s Bool+earCheckHashed hasher vertices zHashes a b c = do+  let pointA = mutListIndex vertices a+      pointB = mutListIndex vertices b+      pointC = mutListIndex vertices c+      trig = Triangle pointA pointB pointC+      trigBB = boundingBox trig+      lowPt = minPoint trigBB ^. core+      highPt = maxPoint trigBB ^. core+      -- (lowPt, highPt) = triangleBoundingBox trig++      minZ = hasher lowPt+      maxZ = hasher highPt++  let upwards up+        | up == -1 || upZ > maxZ = pure True+        | inTriangleRelaxed pointUp trig /= Outside = pure False+        | otherwise = upwards =<< mutListNext zHashes up+        where+          upZ = mutListIndex zHashes up+          pointUp = mutListIndex vertices up ^. core+      downwards down+        | down == -1 || downZ < minZ = pure True+        | inTriangleRelaxed pointDown trig /= Outside = pure False+        | otherwise = downwards =<< mutListPrev zHashes down+        where+          downZ = mutListIndex zHashes down+          pointDown = mutListIndex vertices down ^. core+      bidirectional up down+        | up == -1   || upZ > maxZ   = downwards down+        | down == -1 || downZ < minZ = upwards up+        | up /= a && up /= b && inTriangleRelaxed pointUp trig /= Outside = pure False+        | down /= a && down /= b && inTriangleRelaxed pointDown trig /= Outside = pure False+        | otherwise = do+          up' <- mutListNext zHashes up+          down' <- mutListPrev zHashes down+          bidirectional up' down'+        where+          upZ = mutListIndex zHashes up+          downZ = mutListIndex zHashes down+          pointUp = mutListIndex vertices up ^. core+          pointDown = mutListIndex vertices down ^. core+  if ccw' pointA pointB pointC == CCW+    then bidirectional b b+    else pure False
src/Algorithms/Geometry/PolygonTriangulation/MakeMonotone.hs view
@@ -1,5 +1,12 @@-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell     #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.PolygonTriangulation.MakeMonotone+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Algorithms.Geometry.PolygonTriangulation.MakeMonotone( makeMonotone                                                             , computeDiagonals @@ -8,35 +15,33 @@                                                             , classifyVertices                                                             ) where -import           Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann ( xCoordAt-                                                                            , ordAt)-import           Algorithms.Geometry.PolygonTriangulation.Types+import Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann (ordAt, xCoordAt)+import Algorithms.Geometry.PolygonTriangulation.Types+ import           Control.Lens-import           Control.Monad (forM_, when) import           Control.Monad.Reader import           Control.Monad.State.Strict-import           Control.Monad.Writer (WriterT, execWriterT,tell)+import           Control.Monad.Writer                  (WriterT, execWriterT, tell) import           Data.Bifunctor-import           Data.CircularSeq (rotateL, rotateR, zip3LWith)-import qualified Data.DList as DList+import qualified Data.DList                            as DList import           Data.Ext-import qualified Data.Foldable as F+import qualified Data.Foldable                         as F import           Data.Geometry.LineSegment import           Data.Geometry.PlanarSubdivision.Basic import           Data.Geometry.Point import           Data.Geometry.Polygon-import qualified Data.IntMap as IntMap-import qualified Data.List.NonEmpty as NonEmpty-import           Data.Ord (comparing, Down(..))-import qualified Data.Set as SS-import qualified Data.Set.Util as SS+import qualified Data.IntMap                           as IntMap+import qualified Data.List.NonEmpty                    as NonEmpty+import           Data.Ord                              (Down (..), comparing)+import qualified Data.Set                              as SS+import qualified Data.Set.Util                         as SS import           Data.Util-import qualified Data.Vector as V-import qualified Data.Vector.Mutable as MV+import qualified Data.Vector                           as V+import qualified Data.Vector.Circular                  as CV+import qualified Data.Vector.Mutable                   as MV   -- import Debug.Trace--- import qualified          Data.CircularSeq as CC ----------------------------------------------------------------------------------  data VertexType = Start | Merge | Split | End | Regular deriving (Show,Read,Eq)@@ -49,10 +54,10 @@ classifyVertices                     :: (Num r, Ord r)                                      => Polygon t p r                                      -> Polygon t (p :+ VertexType) r-classifyVertices p@(SimplePolygon _) = classifyVertices' p+classifyVertices p@SimplePolygon{}   = classifyVertices' p classifyVertices (MultiPolygon vs h) = MultiPolygon vs' h'   where-    (SimplePolygon vs') = classifyVertices' $ SimplePolygon vs+    vs' = classifyVertices' vs     h' = map (first (&extra %~ onHole) . classifyVertices') h      -- the roles on hole vertices are slightly different@@ -70,9 +75,10 @@ classifyVertices'                    :: (Num r, Ord r)                                      => SimplePolygon p r                                      -> SimplePolygon (p :+ VertexType) r-classifyVertices' (SimplePolygon vs) =-    SimplePolygon $ zip3LWith f (rotateL vs) vs (rotateR vs)+classifyVertices' poly =+    unsafeFromCircularVector $ CV.zipWith3 f (CV.rotateLeft 1 vs) vs (CV.rotateRight 1 vs)   where+    vs = poly ^. outerBoundaryVector     -- is the angle larger than > 180 degrees     largeInteriorAngle p c n = case ccw (p^.core) (c^.core) (n^.core) of            CCW -> False@@ -98,7 +104,7 @@  -------------------------------------------------------------------------------- -type Event r = Point 2 r :+ (Two (LineSegment 2 Int r))+type Event r = Point 2 r :+ Two (LineSegment 2 Int r)  data StatusStruct r = SS { _statusStruct :: !(SS.Set (LineSegment 2 Int r))                          , _helper       :: !(IntMap.IntMap Int)@@ -109,6 +115,7 @@ ix'   :: Int -> Lens' (V.Vector a) a ix' i = singular (ix i) +{- HLINT ignore computeDiagonals -} -- | Given a polygon, find a set of non-intersecting diagonals that partition -- the polygon into y-monotone pieces. --
src/Algorithms/Geometry/PolygonTriangulation/Triangulate.hs view
@@ -1,3 +1,10 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.PolygonTriangulation.Triangulate+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Algorithms.Geometry.PolygonTriangulation.Triangulate where  @@ -11,7 +18,6 @@ import           Data.Geometry.LineSegment import           Data.Geometry.PlanarSubdivision.Basic import           Data.Geometry.Polygon-import           Data.PlaneGraph (PlaneGraph)  --------------------------------------------------------------------------------
src/Algorithms/Geometry/PolygonTriangulation/TriangulateMonotone.hs view
@@ -1,23 +1,45 @@-module Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone where+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--------------------------------------------------------------------------------+module Algorithms.Geometry.PolygonTriangulation.TriangulateMonotone+  ( MonotonePolygon+  , triangulate+  , triangulate'+  , computeDiagonals+  -- , LR(..)+  -- , P+  -- , Stack+  -- , chainOf+  -- , toVtx+  -- , seg+  -- , process+  -- , isInside+  -- , mergeBy+  -- , splitPolygon+  ) where +import           Algorithms.Geometry.PolygonTriangulation.Types import           Control.Lens-import           Data.Bifunctor-import qualified Data.CircularSeq as C import           Data.Ext-import qualified Data.Foldable as F+import qualified Data.Foldable                                  as F import           Data.Geometry.LineSegment+import           Data.Geometry.PlanarSubdivision.Basic          (PlanarSubdivision, PolygonFaceData) import           Data.Geometry.Point import           Data.Geometry.Polygon-import qualified Data.List as L-import           Data.Ord (comparing, Down(..))+import qualified Data.List                                      as L+import           Data.Ord                                       (Down (..), comparing)+import           Data.PlaneGraph                                (PlaneGraph) import           Data.Util-import           Algorithms.Geometry.PolygonTriangulation.Types-import           Data.PlaneGraph (PlaneGraph)-import           Data.Geometry.PlanarSubdivision.Basic(PolygonFaceData, PlanarSubdivision)+import qualified Data.Vector.Circular.Util                      as CV  -------------------------------------------------------------------------------- ---+-- | Y-monotone polygon. All straight horizontal lines intersects the polygon+--   no more than twice. type MonotonePolygon p r = SimplePolygon p r  data LR = L | R deriving (Show,Eq)@@ -126,19 +148,18 @@ -- running time: \(O(n)\) splitPolygon    :: Ord r => MonotonePolygon p r                 -> ([Point 2 r :+ (LR :+ p)], [Point 2 r :+ (LR :+ p)])-splitPolygon pg = bimap (f L) (f R)-                . second reverse+splitPolygon pg = bimap (f L) (f R . reverse)                 . L.break (\v -> v^.core == vMinY)-                . F.toList . C.rightElements $ vs'+                . F.toList . CV.rightElements $ vs'   where     f x = map (&extra %~ (x :+))     -- rotates the list to the vtx with max ycoord-    Just vs' = C.findRotateTo (\v -> v^.core == vMaxY)-             $ pg^.outerBoundary+    Just vs' = CV.findRotateTo (\v -> v^.core == vMaxY)+             $ pg^.outerBoundaryVector     vMaxY = getY F.maximumBy     vMinY = getY F.minimumBy     swap' (Point2 x y) = Point2 y x-    getY ff = let p = ff (comparing (^.core.to swap')) $ pg^.outerBoundary+    getY ff = let p = ff (comparing (^.core.to swap')) $ pg^.outerBoundaryVector               in p^.core  @@ -156,15 +177,15 @@   -testPoly5 :: SimplePolygon () Rational-testPoly5 = toCounterClockWiseOrder . fromPoints $ map ext $ [ Point2 176 736-                                                             , Point2 240 688-                                                             , Point2 240 608-                                                             , Point2 128 576-                                                             , Point2 64 640-                                                             , Point2 80 720-                                                             , Point2 128 752-                                                             ]+-- testPoly5 :: SimplePolygon () Rational+-- testPoly5 = toCounterClockWiseOrder . fromPoints $ map ext [ Point2 176 736+--                                                            , Point2 240 688+--                                                            , Point2 240 608+--                                                            , Point2 128 576+--                                                            , Point2 64 640+--                                                            , Point2 80 720+--                                                            , Point2 128 752+--                                                            ]   -- testPoly5 :: SimplePolygon () Rational
src/Algorithms/Geometry/PolygonTriangulation/Types.hs view
@@ -1,4 +1,11 @@ {-# LANGUAGE ScopedTypeVariables #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.PolygonTriangulation.Types+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Algorithms.Geometry.PolygonTriangulation.Types where  import           Control.Lens@@ -15,6 +22,7 @@  -------------------------------------------------------------------------------- +-- | After triangulation, edges are either from the original polygon or a new diagonal. data PolygonEdgeType = Original | Diagonal                      deriving (Show,Read,Eq)
src/Algorithms/Geometry/RedBlueSeparator/RIC.hs view
@@ -65,11 +65,11 @@                 -> g (Point 2 r :+ blueData)                 -> m (Maybe (Line 2 r)) separatingLine' reds blues = case verticalSeparatingLine reds blues of-    SP Nothing ((r:+_),(b :+ _)) -> separatingLine'' r b reds blues+    SP Nothing (r:+_,b :+ _) -> separatingLine'' r b reds blues       -- observe that if r and b were vertically above each other then we would       -- have found a separating line. So r and b are not vertically       -- aligned. Hence we satisfy the precondition.-    SP ml@(Just _) _             -> pure ml  -- already found a line+    SP ml@(Just _) _         -> pure ml  -- already found a line   -- | given a red and blue point that are *NOT* vertically alligned, and all red
+ src/Algorithms/Geometry/SSSP.hs view
@@ -0,0 +1,454 @@+{-# LANGUAGE RecordWildCards #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.SSSP+-- Copyright   :  (C) David Himmelstrup+-- License     :  see the LICENSE file+-- Maintainer  :  David Himmelstrup+--------------------------------------------------------------------------------+module Algorithms.Geometry.SSSP+  ( SSSP+  , triangulate+  , sssp+  , visibilityDual+  , visibilityFinger+  , visibilitySensitive+  ) where++import Algorithms.Geometry.PolygonTriangulation.Triangulate (triangulate')+import Algorithms.Geometry.PolygonTriangulation.Types       (PolygonEdgeType)++import           Algorithms.Graph.DFS            (adjacencyLists, dfs', dfsSensitive)+import           Control.Lens                    ((^.))+import           Data.Bitraversable+import           Data.Either+import           Data.Ext                        (ext, extra, type (:+) (..))+import qualified Data.FingerTree                 as F+import           Data.Geometry.Line              (lineThrough)+import           Data.Geometry.LineSegment       (LineSegment (ClosedLineSegment, LineSegment))+import           Data.Geometry.PlanarSubdivision (PolygonFaceData (..))+import           Data.Geometry.Point             (Point, ccw, pattern CCW, pattern CW)+import           Data.Geometry.Polygon+import           Data.Intersection+import           Data.List                       (sortOn, (\\))+import           Data.Maybe                      (fromMaybe)+import           Data.PlanarGraph                (PlanarGraph)+import qualified Data.PlanarGraph                as Graph+import           Data.PlaneGraph                 (FaceId (..), PlaneGraph, VertexData (..),+                                                  VertexId, VertexId', dual, graph, incidentEdges,+                                                  leftFace, vertices)+import qualified Data.PlaneGraph                 as PlaneGraph+import           Data.Proxy+import           Data.Tree                       (Tree (Node))+import qualified Data.Vector                     as V+import qualified Data.Vector.Circular            as CV+import qualified Data.Vector.Circular.Util       as CV+import           Data.Vector.Unboxed             (Vector)+import qualified Data.Vector.Unboxed             as VU+import           Data.Vinyl+import           Data.Vinyl.CoRec++{-+type AbsOffset = Int++data TriangulatedPolygon t p r = TriangulatedPolygon+  { triangulatedMap   :: Map AbsOffset (VertexId () Primal)+  , triangulatedGraph :: PlaneGraph () AbsOffset PolygonEdgeType PolygonFaceData r+  , triangulatedPolygon :: Polygon t p r+  }+-}++++-- | Single-source shortest paths tree. Both keys and values are vertex offset ints.+--+--   @parentOf(i) = sssp[i]@+type SSSP = Vector Int++-- FIXME: The code for generating the dual cannot deal with offsets so+--        we're running 'unsafeFromPoints . toPoints' to reset the polygon.+--        Super silly. Please fix.+-- | \( O(n \log n) \)+triangulate :: (Ord r, Fractional r) => SimplePolygon p r -> PlaneGraph s Int PolygonEdgeType PolygonFaceData r+triangulate p =+  let poly' = snd $ bimapAccumL (\a _ -> (a+1,a)) (,) 0 $ unsafeFromPoints $ toPoints p+  in triangulate' Proxy poly'++-- | \( O(n) \) Single-Source shortest path.+sssp :: (Ord r, Fractional r)+  => PlaneGraph s Int PolygonEdgeType PolygonFaceData r+  -> SSSP+sssp trig =+    ssspFinger d+  where+    Just v0 = fst <$> V.find (\(_vid, VertexData _ idx) -> idx == 0) (vertices trig)+    v0i = incidentEdges v0 trig+    Just (FaceId firstFace) = V.find (/= FaceId outer) $ V.map (`leftFace` trig) v0i+    FaceId outer = PlaneGraph.outerFaceId trig+    dualGraph = trig^.graph.dual+    dualTree' = dfs' (V.map (filter (/= outer)) $ adjacencyLists dualGraph) firstFace+    dualVS = fmap (\v -> toCCW $ PlaneGraph.boundaryVertices (FaceId v) trig) dualTree'+    trigTree = toTrigTree trig dualVS+    d = mkDual trigTree++    toCCW v =+      let cv = CV.reverse $ CV.unsafeFromVector v+      in CV.toVector $ fromMaybe cv $ CV.findRotateTo (== v0) cv++{-+1. Find the starting face.+-}+visibilitySensitive :: forall s r. (Ord r, Fractional r, Show r)+  => PlaneGraph s Int PolygonEdgeType PolygonFaceData r+  -> SimplePolygon () r+visibilitySensitive = fromPoints . map ext . rights . visibilityFinger . visibilityDual+++visibilityDual :: forall s r. (Ord r, Fractional r)+  => PlaneGraph s Int PolygonEdgeType PolygonFaceData r+  -> Dual r+visibilityDual trig = d+  where+    Just v0 = fst <$> V.find (\(_vid, VertexData _ idx) -> idx == 0) (vertices trig)+    v0i = incidentEdges v0 trig++    outer :: VertexId s Graph.Dual+    FaceId outer = PlaneGraph.outerFaceId trig++    firstFace :: VertexId s Graph.Dual+    Just (FaceId firstFace) = V.find (/= FaceId outer) $ V.map (`leftFace` trig) v0i++    dualGraph :: PlanarGraph s Graph.Dual PolygonFaceData PolygonEdgeType (VertexData r Int)+    dualGraph = trig^.graph.dual++    dualTree' :: Tree (VertexId s Graph.Dual)+    dualTree' = dfsSensitive neigh firstFace++    neigh :: VertexId s Graph.Dual -> [VertexId s Graph.Dual]+    neigh v = V.toList $ V.filter (/=outer) $ Graph.neighboursOf v dualGraph++    dualVS :: Tree (V.Vector (VertexId' s))+    dualVS = fmap (\v -> toCCW $ PlaneGraph.boundaryVertices (FaceId v) trig) dualTree'++    trigTree :: Tree (Index r, Index r, Index r)+    trigTree = toTrigTree trig dualVS++    d :: Dual r+    d = mkDual trigTree++    toCCW v =+      let cv = CV.reverse $ CV.unsafeFromVector v+      in CV.toVector $ fromMaybe cv $ CV.findRotateTo (== v0) cv++++visibilityFinger :: forall r. (Fractional r, Ord r, Show r) => Dual r -> [Either (Int, Int, Int) (Point 2 r)]+visibilityFinger d =+    case d of+      Dual (a,b,c) ab bc ca ->+        Left (indexExtra a, indexExtra b, indexExtra c) :+        worker (Funnel (F.singleton b) a F.empty) ab +++        worker (Funnel (F.singleton c) a (F.singleton b)) bc +++        worker (Funnel F.empty a (F.singleton c)) ca+  where+    -- Final edge is the leftmost of each funnel.+    -- The most visible are the rightmost of each funnel.+    -- Cut line segment.+    worker f EmptyDual =+      let edgeA = ringAccess $ funnelRightTop f+          edgeB = ringAccess $ funnelLeftTop f+          edge = ClosedLineSegment (ext edgeA) (ext edgeB)+          coneA = ringAccess $ funnelRightBottom f+          coneB = ringAccess $ funnelLeftBottom f+          lineA = lineThrough (ringAccess $ funnelCusp f) coneA+          lineB = lineThrough (ringAccess $ funnelCusp f) coneB+          -- findIntersection :: Line 2 r -> Point 2 r+          findIntersection line =+            match (edge `intersect` line) $+               H (\NoIntersection -> error "no intersection")+            :& H (\pt -> Right pt)+            :& H (\LineSegment{} -> error "line intersection")+            :& RNil+      in [if edgeA == coneA then Right coneA else findIntersection lineA] +++         if edgeB == coneB then [] else [findIntersection lineB]+    worker f (NodeDual x l r) =+      Left (indexExtra $ fromMaybe (funnelCusp f) $ chainTop (funnelRight f)+           ,indexExtra x+           ,indexExtra $ fromMaybe (funnelCusp f) $ chainTop (funnelLeft f)) :+      case splitFunnel x f of+        (_v, fL, fR, dir) -> case dir of+          -- 'x' is to the left of the visibility cone. Everything further to the left cannot+          -- be visible to just go right.+          SplitLeft  -> worker fR r -- assert cusp of fR == cusp of f+          -- 'x' is visible from our cusp. Add it to the output and go both to the left and right.+          NoSplit    -> worker fR r ++ [Right (ringAccess x)] ++ worker fL l+          -- 'x' is to the right of the visibility cone. Everything further to the right cannot+          -- be visible to just go left.+          SplitRight -> worker fL l -- assert cusp of fL == cusp of f+++--------------------------------------------------------------------------------+-- SSSP (with fingertree) implementation++++++data MinMax r = MinMax (Index r) (Index r) | MinMaxEmpty deriving (Show)+instance Semigroup (MinMax r) where+  MinMaxEmpty <> b = b+  a <> MinMaxEmpty = a+  MinMax a _b <> MinMax _c d+    = MinMax a d+instance Monoid (MinMax r) where+  mempty = MinMaxEmpty++-- Including the 'Point 2 r' here means we don't have to look it up.+-- This mattered since lookups used to be O(log n) rather than O(1).+newtype Index r = Index (Point 2 r :+ Int) -- deriving (Show)++instance Show (Index r) where+  show = show . indexExtra++indexExtra :: Index r -> Int+indexExtra (Index p) = p^.extra++instance Eq (Index r) where+  Index (_ :+ a) == Index (_ :+ b) = a == b++type Chain r = F.FingerTree (MinMax r) (Index r)+data Funnel r = Funnel+  { funnelLeft  :: Chain r -- Left-most element is furthest away from cusp.+  , funnelCusp  :: Index r+  , funnelRight :: Chain r -- Left-most element is furthest away from cusp.+  } deriving (Show)++-- Left side of the funnel, furthest away from the cusp.+funnelLeftTop :: Funnel r -> Index r+funnelLeftTop f = fromMaybe (funnelCusp f) $ chainTop (funnelLeft f)++-- Left side of the funnel, closest to the cusp.+funnelLeftBottom :: Funnel r -> Index r+funnelLeftBottom f = fromMaybe (funnelCusp f) $ chainBottom (funnelLeft f)++-- Right side of the funnel, furthest away from the cusp.+funnelRightTop :: Funnel r -> Index r+funnelRightTop f = fromMaybe (funnelCusp f) $ chainTop (funnelRight f)++-- Right side of the funnel, closest to the cusp.+funnelRightBottom :: Funnel r -> Index r+funnelRightBottom f = fromMaybe (funnelCusp f) $ chainBottom (funnelRight f)++-- Element closest to the cusp.+chainBottom :: Chain r -> Maybe (Index r)+chainBottom chain = case F.viewl chain of+  F.EmptyL   -> Nothing+  elt F.:< _ -> Just elt++-- Element furthest away from the cusp.+chainTop :: Chain r -> Maybe (Index r)+chainTop chain = case F.viewr chain of+  F.EmptyR   -> Nothing+  _ F.:> elt -> Just elt++instance F.Measured (MinMax r) (Index r) where+  measure i = MinMax i i++data SplitDirection = SplitLeft | NoSplit | SplitRight+  deriving (Show)++-- Split a funnel w.r.t. a point 'x'. There are three cases:+--   1. 'x' is visible from the cusp.+--   2. the path to 'x' hits the left side of the funnel.+--   3. the path to 'x' hits the right side of the funnel.+--+-- ********************************************************+-- Drawing guide:+--                       \     /+-- left side of funnel -> \   / <- right side of funnel+--                         \ /+--                          * <- cusp+-- ********************************************************+--+-- Case 1:+--      x+--   \     /+--    \   /+--     \ /+--      *+--+-- Case 2:+--+-- x+--   \     /+--    \   /+--     \ /+--      *+--+-- Case 3:+--+--           x+--   \     /+--    \   /+--     \ /+--      *+--+-- If 'x' is visible from the cusp, then the shortest path is a straight line and we're done.+-- If 'x' is not visible from the cusp, then we find the first point up the funnel where+-- 'x' becomes visible. We'll use a fingertree to find the point in O(log(min(n,m))). Because+-- of math, this adds up to O(n) for the entire SSSP tree.+--+-- Once we've found the first point that can see 'x', we split the funnel in two: One funnel+-- that will be used for points to the left of 'x' and one funnel for points to the right of+-- 'x'. Oh, "left" and "right" here are used to indicate branches in the dual tree.+splitFunnel :: (Fractional r, Ord r) => Index r -> Funnel r -> (Index r, Funnel r, Funnel r, SplitDirection)+splitFunnel x Funnel{..}+    | isOnLeftChain =+      case doSearch isRightTurn funnelLeft of+        (lower, t, upper) ->+          ( t+          , Funnel upper t (F.singleton x)+          , Funnel (lower F.|> t F.|> x) funnelCusp funnelRight+          , SplitLeft)+    | isOnRightChain =+      case doSearch isLeftTurn funnelRight of+        (lower, t, upper) ->+          ( t+          , Funnel funnelLeft funnelCusp (lower F.|> t F.|> x)+          , Funnel (F.singleton x) t upper+          , SplitRight)+    | otherwise =+      ( funnelCusp+      , Funnel funnelLeft funnelCusp (F.singleton x)+      , Funnel (F.singleton x) funnelCusp funnelRight+      , NoSplit)+  where+    isOnLeftChain  = fromMaybe False $+      isLeftTurnOrLinear cuspElt <$> leftElt <*> pure targetElt+    isOnRightChain = fromMaybe False $+      isRightTurnOrLinear cuspElt <$> rightElt <*> pure targetElt+    doSearch fn chain =+      case F.search (searchChain fn) chain of+        F.Position lower t upper -> (lower, t, upper)+        F.OnLeft                 -> error "cannot happen"+        F.OnRight                -> error "cannot happen"+        F.Nowhere                -> error "cannot happen"+    searchChain _ MinMaxEmpty _             = False+    searchChain _ _ MinMaxEmpty             = True+    searchChain check (MinMax _ l) (MinMax r _) =+      check (ringAccess l) (ringAccess r) targetElt+    cuspElt   = ringAccess funnelCusp+    targetElt = ringAccess x+    leftElt   = ringAccess <$> chainBottom funnelLeft+    rightElt  = ringAccess <$> chainBottom funnelRight++-- FIXME: Turning a list of pairs into a vector is incredibly inefficient.+--        Would be much faster to write directly into a mutable vector and+--        then freeze it at the end.+-- \( O(n) \)+ssspFinger :: (Fractional r, Ord r) => Dual r -> SSSP+ssspFinger d = toSSSP $+    case d of+      Dual (a,b,c) ab bc ca ->+        (a, a) :+        (b, a) :+        (c, a) :+        loopLeft a c ca +++        worker (Funnel (F.singleton c) a (F.singleton b)) bc +++        loopRight a b ab+  where+    toSSSP :: [(Index r,Index r)] -> SSSP+    toSSSP lst =+      VU.fromList . map snd . sortOn fst $+      [ (a,b) | (Index (_ :+ a), Index (_ :+ b)) <- lst ]+    loopLeft a outer l =+      case l of+        EmptyDual -> []+        NodeDual x l' r' ->+          (x,a) :+          worker (Funnel (F.singleton x) a (F.singleton outer)) r' +++          loopLeft a x l'+    loopRight a outer r =+      case r of+        EmptyDual -> []+        NodeDual x l' r' ->+          (x, a) :+          worker (Funnel (F.singleton outer) a (F.singleton x)) l' +++          loopRight a x r'+    worker _ EmptyDual = []+    worker f (NodeDual x l r) =+      case splitFunnel x f of+        (v, fL, fR, _) ->+          (x, v) :+          worker fL l +++          worker fR r+++--------------------------------------------------------------------------------+-- Duals++++data Dual r = Dual (Index r, Index r, Index r) -- (a,b,c)+                   (DualTree r) -- borders ab+                   (DualTree r) -- borders bc+                   (DualTree r) -- borders ca+  deriving (Show)++data DualTree r+  = EmptyDual+  | NodeDual (Index r) -- axb triangle, a and b are from parent.+      (DualTree r) -- borders xb+      (DualTree r) -- borders ax+  deriving (Show)++toTrigTree :: PlaneGraph s Int PolygonEdgeType PolygonFaceData r+           -> Tree (V.Vector (VertexId' s))+           -> Tree (Index r,Index r,Index r)+toTrigTree trig = fmap toTrig . fmap (fmap toDat)+  where+    toTrig v = case V.toList v of+      [a,b,c] -> (a,b,c)+      _       -> error "Algorithms.Geometry.SSSP: Invalid triangulation."+    toDat v = Index $ PlaneGraph.vtxDataToExt (trig ^. PlaneGraph.vertexDataOf v)++-- pp :: Show a => Tree a -> IO ()+-- pp = putStrLn . drawTree . fmap show++mkDual :: Tree (Index r,Index r,Index r) -> Dual r+mkDual (Node (a,b,c) forest) =+    Dual (a, b, c)+      (dualTree a b forest)+      (dualTree b c forest)+      (dualTree c a forest)++dualTree :: Index r -> Index r -> [Tree (Index r,Index r,Index r)] -> DualTree r+dualTree p1 p2 (Node (a,b,c) sub:xs) =+  case [a,b,c] \\ [p1,p2] of+    [x] -> NodeDual x (dualTree x p2 sub) (dualTree p1 x sub)+    _   -> dualTree p1 p2 xs+dualTree _p1 _p2 [] = EmptyDual++++++--------------------------------------------------------------------------------+-- Helpers++ringAccess :: Index r -> Point 2 r+ringAccess (Index (pt :+ _idx)) = pt++isRightTurnOrLinear :: (Ord r, Num r) => Point 2 r -> Point 2 r -> Point 2 r -> Bool+isRightTurnOrLinear p1 p2 p3 = not $ isLeftTurn p1 p2 p3++isLeftTurnOrLinear :: (Ord r, Num r) => Point 2 r -> Point 2 r -> Point 2 r -> Bool+isLeftTurnOrLinear p1 p2 p3 = not $ isRightTurn p1 p2 p3++isLeftTurn :: (Ord r, Num r) => Point 2 r -> Point 2 r -> Point 2 r -> Bool+isLeftTurn p1 p2 p3 =+  ccw p1 p2 p3 == CCW++isRightTurn :: (Ord r, Num r) => Point 2 r -> Point 2 r -> Point 2 r -> Bool+isRightTurn p1 p2 p3 =+  ccw p1 p2 p3 == CW
+ src/Algorithms/Geometry/SSSP/Naive.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE ParallelListComp #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.SSSP.Naive+-- Copyright   :  (C) David Himmelstrup+-- License     :  see the LICENSE file+-- Maintainer  :  David Himmelstrup+--------------------------------------------------------------------------------+module Algorithms.Geometry.SSSP.Naive+  ( sssp+  , sssp'+  ) where++import           Algorithms.FloydWarshall  (floydWarshall, mkGraph, mkIndex)+import           Control.Lens+import           Control.Monad.ST          (runST)+import           Data.Ext                  (_core, core)+import qualified Data.Foldable             as F+import           Data.Geometry.Interval    (EndPoint (Closed, Open), end, start)+import           Data.Geometry.LineSegment (LineSegment (..), sqSegmentLength)+import           Data.Geometry.Point       (ccwCmpAroundWith')+import           Data.Geometry.Polygon     (SimplePolygon, listEdges, outerBoundaryVector)+import           Data.Intersection         (IsIntersectableWith (intersect),+                                            NoIntersection (NoIntersection))+import           Data.Vector               (Vector)+import qualified Data.Vector               as V+import qualified Data.Vector.Circular      as CV+import qualified Data.Vector.Unboxed       as VU+import           Data.Vinyl                (Rec (RNil, (:&)))+import           Data.Vinyl.CoRec          (Handler (H), match)+import           Linear.Affine             ((.-.))++type SSSP = VU.Vector Int++-- | \( O(n^3) \) Single-Source Shortest Path.+sssp :: (Real r, Fractional r) => SimplePolygon p r -> SSSP+sssp p = V.head . sssp' $ p++-- | \( O(n^3) \) Single-Source Shortest Path from all vertices.+sssp' :: (Real r, Fractional r) => SimplePolygon p r -> Vector SSSP+sssp' p = runST $ do+    -- Create an n*n matrix containing paths and distances between vertices.+    graph <- mkGraph n infinity (visibleEdges p)+    -- Use FloydWarshall O(n^3) to complete the matrix.+    floydWarshall n graph+    -- Create a tree describing the shortest path from any node to the 0th node.+    g <- VU.unsafeFreeze graph+    pure $ V.generate n $ \origin ->+      VU.generate n $ \i ->+        let (_dist, next) = g VU.! mkIndex n (i, origin)+        in next+  where+    infinity = read "Infinity" :: Double+    n = F.length (p ^. outerBoundaryVector)++-- \( O(n^3) \)+visibleEdges :: (Real r, Fractional r) => SimplePolygon p r -> [(Int, Int, Double)]+visibleEdges p = concat+  [+    [ (i, j, sqrt (realToFrac (sqSegmentLength line)))+    | j <- [i+2 .. n-1]+    , let endPt = CV.index vs j+    , let line = LineSegment (Closed pt) (Open endPt)+      -- Check if the line goes through the inside of the polygon.+    , ccwCmpAroundWith' ((_core prev) .-. (_core pt)) pt endPt next == GT+      -- Check if there are any intersections not the line end points.+    , not (interiorIntersection line edges)+    ]+  | i <- [0 .. n-1]+  , let pt = CV.index vs i+        prev = CV.index vs (i-1)+        next = CV.index vs (i+1)+  ] +++  [ (i,(i+1)`mod`n,sqrt (realToFrac (sqSegmentLength edge)))+  | (i, edge) <- zip [0..] edges+  ]+  where+    vs = p^.outerBoundaryVector+    n = F.length vs+    edges = listEdges p++interiorIntersection :: (Ord r, Fractional r) => LineSegment 2 p r -> [LineSegment 2 p r] -> Bool+interiorIntersection _ [] = False+interiorIntersection l (x:xs) =+  match (l `intersect` x) (+       H (\NoIntersection -> False)+    :& H (\pt -> pt /= l^.start.core && pt /= l^.end.core)+    :& H (\line -> sqSegmentLength line /= 0)+    :& RNil)+  || interiorIntersection l xs
+ src/Algorithms/Geometry/SmallestEnclosingBall.hs view
@@ -0,0 +1,20 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.SmallestEnclosingBall+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--+-- Types to represent the smallest enclosing disk of a set of points in+-- \(\mathbb{R}^2\)+--+--------------------------------------------------------------------------------+module Algorithms.Geometry.SmallestEnclosingBall+  ( DiskResult(..)+  , enclosingDisk+  , definingPoints+  , TwoOrThree(..)+  , twoOrThreeFromList+  ) where++import           Algorithms.Geometry.SmallestEnclosingBall.Types
src/Algorithms/Geometry/SmallestEnclosingBall/Naive.hs view
@@ -9,9 +9,10 @@ -- points in \(\mathbb{R}^2\) -- ---------------------------------------------------------------------------------module Algorithms.Geometry.SmallestEnclosingBall.Naive( smallestEnclosingDisk-                                                      , enclosesAll-                                                      ) where+module Algorithms.Geometry.SmallestEnclosingBall.Naive+  ( smallestEnclosingDisk+  , enclosesAll+  ) where  -- just for the types import Control.Lens@@ -26,7 +27,7 @@ import qualified Data.Util as Util -------------------------------------------------------------------------------- --- | Horrible O(n^4) implementation that simply tries all disks, checks if they+-- | Horrible \( O(n^4) \) implementation that simply tries all disks, checks if they -- enclose all points, and takes the largest one. Basically, this is only useful -- to check correctness of the other algorithm(s) smallestEnclosingDisk          :: (Ord r, Fractional r)@@ -44,6 +45,7 @@ triplets pts = [DiskResult (disk' a b c) (Three a b c)                | Util.Three a b c <- uniqueTriplets pts] +{- HLINT ignore disk' -} disk'       :: (Ord r, Fractional r)             => Point 2 r :+ p -> Point 2 r :+ p -> Point 2 r :+ p -> Disk () r disk' a b c = fromMaybe degen $ disk (a^.core) (b^.core) (c^.core)@@ -56,7 +58,7 @@ smallestEnclosingDisk'     :: (Ord r, Num r)                            => [Point 2 r :+ p] -> [DiskResult p r] -> DiskResult p r smallestEnclosingDisk' pts = minimumBy (compare `on` (^.enclosingDisk.squaredRadius))-                           . filter (flip enclosesAll pts)+                           . filter (`enclosesAll` pts)  -- | check if a disk encloses all points enclosesAll   :: (Num r, Ord r) => DiskResult p r -> [Point 2 r :+ q] -> Bool
src/Algorithms/Geometry/SmallestEnclosingBall/RIC.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveFunctor  #-}-{-# LANGUAGE TemplateHaskell  #-} -------------------------------------------------------------------------------- -- | -- Module      :  Algorithms.Geometry.SmallestEnclosingBall.RIC@@ -31,8 +29,8 @@ import           Data.Ord (comparing) import           System.Random.Shuffle (shuffle) -import Data.RealNumber.Rational-import Debug.Trace+-- import Data.RealNumber.Rational+-- import Debug.Trace  -------------------------------------------------------------------------------- @@ -48,8 +46,8 @@                                 => [Point 2 r :+ p]                                 -> m (DiskResult p r) -smallestEnclosingDisk pts@(_:_:_) = ((\(p:q:pts') -> smallestEnclosingDisk' p q pts')-                                    . F.toList) <$> shuffle pts+smallestEnclosingDisk pts@(_:_:_) = (\(p:q:pts') -> smallestEnclosingDisk' p q pts')+                                    . F.toList <$> shuffle pts smallestEnclosingDisk _           = error "smallestEnclosingDisk: Too few points"  -- | Smallest enclosing disk.
src/Algorithms/Geometry/SmallestEnclosingBall/Types.hs view
@@ -27,11 +27,11 @@   foldMap f (Two   a b)   = f a <> f b   foldMap f (Three a b c) = f a <> f b <> f c --fromList         :: [a] -> Either String (TwoOrThree a)-fromList [a,b]   = Right $ Two a b-fromList [a,b,c] = Right $ Three a b c-fromList _       = Left "Wrong number of elements"+-- | Construct datatype from list with exactly two or three elements.+twoOrThreeFromList         :: [a] -> Either String (TwoOrThree a)+twoOrThreeFromList [a,b]   = Right $ Two a b+twoOrThreeFromList [a,b,c] = Right $ Three a b c+twoOrThreeFromList _       = Left "Wrong number of elements"
src/Algorithms/Geometry/SoS.hs view
@@ -22,12 +22,6 @@ import Algorithms.Geometry.SoS.Orientation import Algorithms.Geometry.SoS.Determinant import Algorithms.Geometry.SoS.Sign-import Control.CanAquire-import Control.Lens-import Data.Ext-import Data.Geometry.Point.Internal-import Data.Geometry.Properties-import Data.Geometry.Vector  --------------------------------------------------------------------------------
src/Algorithms/Geometry/SoS/AsPoint.hs view
@@ -1,9 +1,7 @@ module Algorithms.Geometry.SoS.AsPoint where  import           Control.CanAquire-import           Control.Lens import           Data.Ext-import           Data.Geometry.Point.Class import           Data.Geometry.Point.Internal import           Data.Geometry.Properties import           Data.Geometry.Vector@@ -18,7 +16,7 @@ instance HasIndex (P i d r) i where   indexOf (P i) = i -instance Int `CanAquire` (Point d r) => (P Int d r) `CanAquire` (Point d r) where+instance Int `CanAquire` Point d r => P Int d r `CanAquire` Point d r where   aquire (P i) = aquire i  type instance NumType   (P i d r) = r@@ -26,4 +24,4 @@  asPointWithIndex       :: (Arity d, i `CanAquire` Point d r)                        => P i d r -> Point d r :+ SoSIndex i-asPointWithIndex (P i) = aquire i :+ (SoSIndex i)+asPointWithIndex (P i) = aquire i :+ SoSIndex i
src/Algorithms/Geometry/SoS/Expr.hs view
@@ -3,7 +3,6 @@  import           Control.Lens import qualified Data.List as List-import           Data.List.NonEmpty (NonEmpty(..),nonEmpty)  -------------------------------------------------------------------------------- @@ -36,6 +35,8 @@  instance (Num r) => Num (Expr i r) where   fromInteger = Constant . fromInteger+  abs _ = error "'abs' not defined for Algorithms.Geometry.SoS.Expr.Expr"+  signum _ = error "'signum' not defined for Algorithms.Geometry.SoS.Expr.Expr"   negate      = \case     Negate e -> e     e        -> Negate e
src/Algorithms/Geometry/SoS/Orientation.hs view
@@ -59,7 +59,7 @@ -- | Given an input point, transform its number type to include -- symbolic $\varepsilon$ expressions so that we can use SoS. toSymbolic          :: (Ord i, Arity d) => Point d r :+ i -> Point d (Symbolic (i,Int) r)-toSymbolic (p :+ i) = p&vector' %~ imap (\j x -> symbolic x (i,j))+toSymbolic (p :+ i) = p&vector %~ imap (\j x -> symbolic x (i,j))  -- | Given a point q and a vector of d points defining a hyperplane, -- test on which side of the hyperplane q lies.@@ -80,4 +80,4 @@ -- in a homogeneous matrix represetnation. I.e. we add a 1 as an -- additonal column at the end. mkLambdaRow :: (Num r, Arity d, Arity (d+1)) => Point d r -> Vector (d+1) r-mkLambdaRow = flip snoc 1 . view vector'+mkLambdaRow = flip snoc 1 . view vector
src/Algorithms/Geometry/SoS/Sign.hs view
@@ -8,6 +8,7 @@ -- | The sign of an expression data Sign = Negative | Positive deriving (Show,Eq,Ord,Enum,Bounded) +-- | Flip Positive <=> Negative. flipSign :: Sign -> Sign flipSign = \case   Negative -> Positive
src/Algorithms/Geometry/SoS/Symbolic.hs view
@@ -1,3 +1,11 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.SoS.Symbolic+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--+-------------------------------------------------------------------------------- module Algorithms.Geometry.SoS.Symbolic(     EpsFold   , eps, mkEpsFold@@ -21,8 +29,7 @@ import qualified Data.Map as Map import qualified Data.Map.Merge.Strict as Map import           Data.Maybe (isNothing)-import           Data.Word-import           Test.QuickCheck (Arbitrary(..), listOf, suchThat)+import           Test.QuickCheck (Arbitrary(..), listOf) import           Test.QuickCheck.Instances ()  --------------------------------------------------------------------------------@@ -150,7 +157,7 @@     -- biggest of those terms is the pair whose indices comes first.  instance (Arbitrary i, Ord i) => Arbitrary (EpsFold i) where-  arbitrary = (mkEpsFold . take 4) <$> listOf arbitrary+  arbitrary = mkEpsFold . take 4 <$> listOf arbitrary   -- | Test if the epsfold has no pertubation at all (i.e. if it is \(\Pi_{\emptyset}\)@@ -332,7 +339,7 @@   (Bag m) <> (Bag m') = Bag $ Map.unionWith (\d d' -> d + d' + 1) m m'  instance Ord k => Monoid (Bag k) where-  mempty = Bag $ Map.empty+  mempty = Bag Map.empty  -- | Computes the difference of the two maps difference                   :: Ord a => Bag a -> Bag a -> Bag a
+ src/Algorithms/Geometry/VisibilityPolygon/Lee.hs view
@@ -0,0 +1,537 @@+{-# LANGUAGE TemplateHaskell #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.VisibilityPolygon.Lee+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--+-- \(O(n\log n)\) time algorithm to compute the visibility polygon of+-- a point inside a polygon (possibly containing holes) with \(n\)+-- vertices, or among a set of \(n\) disjoint segments. The alogirhtm+-- used is the the rotational sweepline algorithm by Lee, described+-- in:+--+-- D. T. Lee. Proximity and reachability in the plane. Report R-831, Dept. Elect.+-- Engrg., Univ. Illinois, Urbana, IL, 1978.+--+--------------------------------------------------------------------------------+module Algorithms.Geometry.VisibilityPolygon.Lee+  ( visibilityPolygon+  , visibilitySweep+  , VisibilityPolygon+  , Definer, StarShapedPolygon+  , compareAroundEndPoint+  ) where++import           Control.Lens+import           Control.Monad ((<=<))+import           Data.Bifunctor (first)+import           Data.Ext+import qualified Data.Foldable as F+import           Data.Function (on)+import           Data.Geometry.HalfLine+import           Data.Geometry.Line+import           Data.Geometry.LineSegment+import           Data.Geometry.Point+import           Data.Geometry.Polygon+import           Data.Geometry.Vector+import           Data.Intersection+import qualified Data.List as List+import qualified Data.List.Util as List+import           Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NonEmpty+import           Data.Maybe (mapMaybe, isJust)+import           Data.Ord (comparing)+import           Data.RealNumber.Rational+import           Data.Semigroup.Foldable+import qualified Data.Set as Set+import qualified Data.Set.Util as Set+import           Data.Util+import           Data.Vinyl.CoRec+import           Debug.Trace++type R = RealNumber 5++--------------------------------------------------------------------------------++type StarShapedPolygon p r = SimplePolygon p r++-- | Vertices of the visibility polgyon are either original vertices+-- or defined by some vertex and an edge+type Definer p e r = Either p (Point 2 r :+ p,LineSegment 2 p r :+ e)++type VisibilityPolygon p e r = StarShapedPolygon (Definer p e r) r++-- | We either insert or delete segments+data Action a = Insert a | Delete a deriving (Show,Eq,Ord)++isInsert :: Action a -> Bool+isInsert = \case+  Insert _ -> True+  Delete _ -> False++extract :: Action a -> a+extract = \case+  Insert x -> x+  Delete x -> x++-- | An event corresponds to some orientation at which the set of segments+-- intersected by the ray changes (this orientation is defined by a point)+data Event p e r = Event { _eventVtx :: Point 2 r :+ p+                         , _actions  :: NonEmpty (Action (LineSegment 2 p r :+ e))+                         } deriving Show+makeLenses ''Event++-- | The status structure maintains the subset of segments currently+-- intersected by the ray that starts in the query point q, in order+-- of increasing distance along the ray.+type Status p e r = Set.Set (LineSegment 2 p r :+ e)++++--------------------------------------------------------------------------------+++++-- | Computes the visibility polygon of a point q in a polygon with+-- \(n\) vertices.+--+-- pre: q lies strictly inside the polygon+--+-- running time: \(O(n\log n)\)+visibilityPolygon      :: forall p t r. (Ord r, Fractional r)+                       => Point 2 r+                       -> Polygon t p r+                       -> StarShapedPolygon (Definer p () r) r+visibilityPolygon q pg =+    fromPoints . visibilitySweep v Nothing q . map ext . closedEdges $ pg+  where+    v = uncurry (startingDirection q) . consecutive q . polygonVertices $ pg++++++++++++++++++++++++-- | Computes the visibility polgyon from a vertex+visibilityPolygonFromVertex      :: forall p t r. (Ord r, Fractional r, Show r, Show p)+                                 => Polygon t p r+                                 -> Int -- ^ from the i^th vertex on the outer boundary+                                 -> VisibilityPolygon p () r+visibilityPolygonFromVertex pg i =+    fromPoints . visibilitySweep sv (Just w) v . map ext $ segs+  where+    (v :+ _) = pg^.outerVertex i+    (w :+ _) = pg^.outerVertex (i-1)+    (u :+ _)  = pg^.outerVertex (i+1)++    -- rotates the polygon so that u becomes the focus, and gets all+    -- other vertices. Takes the next CCW vertex around v, starting+    -- form the direction indicated by v.+    z = let u' :| rest = traceShowIdWith "vertices"+                       $  polygonVertices $ pg&outerBoundary %~ rotateRight (i+1)+        in traceShowIdWith "z" $ consecutiveFrom (u .-. v) v (List.init rest)+           -- the last vertex in rest is v; so kill that++    sv = startingDirection v u z++    segs = map (first (^._2))+         . filter (not . incidentTo i)+         . closedEdges $ numberVertices pg++visibilityPolygonFromVertex' q sv mt segs = sweep q statusStruct (traceShowIdWith "events" events)+  where+    v      = undefined++    -- lazily test if the segment intersects the initial ray+    segs'  = labelWithDistances q initialRay segs++    events = computeEvents q sv (untilEnd q sv mt) segs'+        -- take only until the end of the range (if defined)++    initialRay = traceShowIdWith "ray" $ HalfLine q sv+    statusStruct = traceShowIdWith "initialSS" $ mkInitialSS segs'+++-- | Test if the line segment is incident to a point with the given+-- index.+incidentTo     :: Int -> LineSegment 2 (SP Int a) r -> Bool+incidentTo i s = s^.start.extra._1 == i || s^.end.extra._1 == i++++++++++-- | computes a (partial) visibility polygon of a set of \(n\)+-- disjoint segments. The input segments are allowed to share+-- endpoints, but no intersections or no endpoints in the interior of+-- other segments. The input vector indicates the starting direction,+-- the Maybe point indicates up to which point/dicrection (CCW) of the+-- starting vector we should compute the visibility polygon.+--+-- pre : - all line segments are considered closed.+--       - no singleton linesegments exactly pointing away from q.+--       - for every orientattion the visibility is blocked somewhere, i.e.+--            no rays starting in the query point q that are disjoint from all segments.+--       - no vertices at staring direction sv+--+-- running time: \(O(n\log n)\)+visibilitySweep              :: forall p r e. (Ord r, Fractional r)+                             => Vector 2 r -- ^ starting direction of the sweep+                             -> Maybe (Point 2 r)+                             -- ^ -- point indicating the last point to sweep to+                             -> Point 2 r -- ^ the point form which we compute the visibility polgyon+                             -> [LineSegment 2 p r :+ e]+                             -> [Point 2 r :+ Definer p e r]+visibilitySweep sv mt q segs = sweep q statusStruct events+  where+    -- lazily test if the segment intersects the initial ray+    segs'  = labelWithDistances q initialRay segs+    events = computeEvents q sv (untilEnd q sv mt) segs'++    initialRay = HalfLine q sv+    statusStruct = mkInitialSS segs'++-- | Take until the ending point if defined. We can use that the list+-- of events appears in sorted order in the cyclic orientation around+-- the query point q+untilEnd      :: (Ord r, Num r)+              => Point 2 r -- ^ query point+              -> Vector 2 r -- ^ starting direction+              -> Maybe (Point 2 r) -- ^ possible ending point+              -> [Event a e r] -> [Event a e r]+untilEnd q sv = \case+  Nothing -> id+  Just t  -> List.takeWhile (\e -> ccwCmpAroundWith' sv (ext q) (e^.eventVtx) (ext t) == LT)++-- | Runs the actual sweep+sweep                :: (Foldable t, Ord r, Fractional r)+                     => Point 2 r    -- ^ query point+                     -> Status p e r -- ^ initial status structure+                     -> t (Event p e r) -- ^ events to handle+                     -> [Point 2 r :+ Definer p e r]+sweep q statusStruct = snd . List.foldl' (handleEvent q) (statusStruct,[])+++-- | Computes the events in the sweep+computeEvents                :: (Ord r, Num r, Foldable t)+                             => Point 2 r -- ^ query point+                             -> Vector 2 r -- ^ starting direction+                             -> ([Event p1 e1 r] -> [Event p2 e2 r]) -- ^ until where to take the vents+                             -> t (LineSegment 2 p1 r :+ (Maybe r, e1))+                             -> [Event p2 e2 r]+computeEvents q sv takeUntil =+     map (combine q)+   . List.groupBy' (\a b -> ccwCmpAroundWith' sv (ext q) (a^.eventVtx) (b^.eventVtx))+   . takeUntil+   . List.sortBy (cmp `on` (^.eventVtx))+   . concatMap (mkEvent sv q)+  where+    cmp = ccwCmpAroundWith' sv (ext q) <> cmpByDistanceTo' (ext q)++-- | Given multiple events happening at the same orientation, combine+-- them into a single event.+combine      :: (Ord r, Num r) => Point 2 r -> NonEmpty (Event p e r) -> Event p e r+combine q es = Event p acts+  where+    acts = foldMap1 (^.actions) es+    p    = F.minimumBy (cmpByDistanceTo' (ext q)) . fmap (^.eventVtx) $ es++-- | Constructs the at most two events resulting from this segement.+mkEvent                                      :: (Ord r, Num r)+                                             => Vector 2 r -- ^ starting direction+                                             -> Point 2 r  -- ^ query point+                                             -> LineSegment 2 p r :+ (Maybe r, e)+                                             -> [Event p e r]+mkEvent sv q (s@(LineSegment' u v) :+ (d,e)) = case cmp u v of+                                                 LT -> [ Event u insert+                                                       , Event v delete+                                                       ]+                                                 GT -> [ Event v insert+                                                       , Event u delete+                                                       ]+                                                 EQ -> [] -- zero length segment, just skip+  where+    cmp = ccwCmpAroundWith' sv (ext q) <> cmpByDistanceTo' (ext q)+    s'  = s :+ e++    insert = (if isJust d then Delete s' else Insert s') :| []+    delete = (if isJust d then Insert s' else Delete s') :| []+++-- | Handles an event, computes the new status structure and output polygon.+handleEvent                                  :: (Ord r, Fractional r)+                                             => Point 2 r+                                             -> (Status p e r, [Point 2 r :+ Definer p e r])+                                             -> Event p e r+                                             -> (Status p e r, [Point 2 r :+ Definer p e r])+handleEvent q (ss,out) (Event (p :+ z) acts) = (ss', newVtx <> out)+  where+    (ins,dels) = bimap (map extract) (map extract) . NonEmpty.partition isInsert $ acts++    ss' = flip (foldr (insertAt q p)) ins+        . flip (foldr (deleteAt q p)) dels+        $ ss++    newVtx = let (a :+ sa) = firstHitAt' q p ss+                 (b :+ sb) = firstHitAt' q p ss'+                 ae        = valOf a sa+                 be        = valOf b sb+             in case (a /= b, a == p) of+                  (True, _)     -> -- new window of the output polygon discovered+                                   -- figure out who is the closest vertex, (the reflex vtx)+                                   -- and add the appropriate two vertices+                    case squaredEuclideanDist q a < squaredEuclideanDist q b of+                      True  -> [ b :+ Right (a :+ ae, sb)+                               , a :+ Left  ae  -- a must be a vertex!+                               ]+                      False -> [ b :+ Left  be+                               , a :+ Right (b :+ be, sa)+                               ]+                  (False,True)  -> [ p :+ Left z]+                    -- sweeping over a regular vertex of the visibility polygon+                  (False,False) -> []    -- sweeping over a vertex not in output++    valOf a (LineSegment' (b :+ be) (_ :+ ce) :+ _ ) | a == b    = be+                                                     | otherwise = ce++++--------------------------------------------------------------------------------++-- | Given two points q and p, and a status structure retrieve the+-- first segment in the status structure intersected by the ray from q+-- through p.+--+-- pre: all segments in the status structure should intersect the ray+--      from q through p (in a point), in that order.+--+-- running time: \(O(\log n)\)+firstHitAt     :: forall p r e. (Ord r, Fractional r)+               => Point 2 r -> Point 2 r+               -> Status p e r+               -> Maybe (Point 2 r :+ LineSegment 2 p r :+ e)+firstHitAt q p = computeIntersectionPoint <=< Set.lookupMin+  where+    computeIntersectionPoint s = fmap (:+ s) . asA @(Point 2 r)+                               $ supportingLine (s^.core) `intersect` lineThrough p q++-- | Given two points q and p, and a status structure retrieve the+-- first segment in the status structure intersected by the ray from q+-- through p.+--+-- pre: - all segments in the status structure should intersect the ray+--        from q through p (in a point), in that order.+--      - the status structure is non-empty+--+-- running time: \(O(\log n)\)+firstHitAt'        :: forall p r e. (Ord r, Fractional r)+                  => Point 2 r -> Point 2 r+                  -> Status p e r+                  -> Point 2 r :+ LineSegment 2 p r :+ e+firstHitAt' q p s = case firstHitAt q p s of+                      Just x  -> x+                      Nothing -> error "firstHitAt: precondition failed!"++--------------------------------------------------------------------------------+-- * Status Structure Operations++-- | Insert a new segment into the status structure, depending on the+-- (distance from q to to the) intersection point with the ray from q+-- through p+--+-- pre: all segments in the status structure should intersect the ray+--      from q through p, in that order.+--+-- \(O(\log n)\)+insertAt     :: (Ord r, Fractional r)+             => Point 2 r -> Point 2 r -> LineSegment 2 p r :+ e+             -> Status p e r -> Status p e r+insertAt q p = Set.insertBy (compareByDistanceToAt q p <> flip (compareAroundEndPoint q))+  -- if two segments have the same distance, they must share and endpoint+  -- so we use the CCW ordering around this common endpoint to determine+  -- the order.++-- | Delete a segment from the status structure, depending on the+-- (distance from q to to the) intersection point with the ray from q+-- through p+--+-- pre: all segments in the status structure should intersect the ray+--      from q through p, in that order.+--+-- \(O(\log n)\)+deleteAt     :: (Ord r, Fractional r)+             => Point 2 r -> Point 2 r -> LineSegment 2 p r :+ e+             -> Status p e r -> Status p e r+deleteAt q p = Set.deleteAllBy (compareByDistanceToAt q p <> compareAroundEndPoint q)+  -- if two segments have the same distance, we use the ccw order around their common+  -- (end) point.++-- FIXME: If there are somehow segmetns that would continue at p as+-- well, they are also deleted.+++-- | Given a list of line segments, each labeled with the distance+-- from their intersection point with the initial ray to the query+-- point, build the initial status structure.+mkInitialSS :: forall r p e. (Ord r, Fractional r)+            => [ LineSegment 2 p r :+ (Maybe r, e)] -> Status p e r+mkInitialSS = Set.mapMonotonic (^.extra)+            . foldr (Set.insertBy $ comparing (^.core)) Set.empty+            . mapMaybe (\(s :+ (md,e)) -> (:+ (s :+ e)) <$> md)++-- | Given q, the initial ray, and a segment s, computes if the+-- segment intersects the initial, rightward ray starting in q, and if+-- so returns the (squared) distance from q to that point together+-- with the segment.+initialIntersection         :: forall r p. (Ord r, Fractional r)+                            => Point 2 r -> HalfLine 2 r -> LineSegment 2 p r+                            -> Maybe r+initialIntersection q ray s =+    case asA @(Point 2 r) $ seg `intersect` ray of+      Nothing -> Nothing+      Just z  -> Just $ squaredEuclideanDist q z+  where+    seg = first (const ()) s++-- | Labels the segments with the distance from q to their+-- intersection point with the ray.+labelWithDistances       :: (Ord r, Fractional r)+                         => Point 2 r -> HalfLine 2 r -> [LineSegment 2 p r :+ b]+                         -> [LineSegment 2 p r :+ (Maybe r, b)]+labelWithDistances q ray = map (\(s :+ e) -> s :+ (initialIntersection q ray s, e))++--------------------------------------------------------------------------------+-- * Comparators for the rotating ray++-- | Given two points q and p, and two segments a and b that are guaranteed to+-- intersect the ray from q through p once, order the segments by their+-- intersection point+compareByDistanceToAt     :: forall p r e. (Ord r, Fractional r)+                          => Point 2 r -> Point 2 r+                          -> LineSegment 2 p r :+ e+                          -> LineSegment 2 p r :+ e+                          -> Ordering+compareByDistanceToAt q p = comparing f+  where+    f (s :+ _) = fmap (squaredEuclideanDist q)+               . asA @(Point 2 r)+               $ supportingLine s `intersect` lineThrough p q++-- | Given two segments that share an endpoint, order them by their+-- order around this common endpoint. I.e. if uv and uw share endpoint+-- u we uv is considered smaller iff v is smaller than w in the+-- counterclockwise order around u (treating the direction from q to+-- the common endpoint as zero).+compareAroundEndPoint  :: forall p r e. (Ord r, Fractional r)+                       => Point 2 r+                       -> LineSegment 2 p r :+ e+                       -> LineSegment 2 p r :+ e+                       -> Ordering+compareAroundEndPoint q+                      (LineSegment' a b :+ _)+                      (LineSegment' s t :+ _)+    -- traceshow ("comapreAroundEndPoint ", sa, sb) False = undefined+    | a^.core == s^.core = ccwCmpAroundWith' (a^.core .-. q) a b t+    | a^.core == t^.core = ccwCmpAroundWith' (a^.core .-. q) a b s+    | b^.core == s^.core = ccwCmpAroundWith' (b^.core .-. q) b a t+    | b^.core == t^.core = ccwCmpAroundWith' (b^.core .-. q) b a s+    | otherwise          = error "compareAroundEndPoint: precondition failed!"++--------------------------------------------------------------------------------+-- * Helper functions for polygon operations++-- | Given q, and two consecutive points u and v, Computes a direction+-- for the initial ray, i.e. a "generic" ray that does not go through+-- any vertices.+startingDirection       :: Fractional r => Point 2 r -> Point 2 r -> Point 2 r -> Vector 2 r+startingDirection q u w = v .-. q+  where+    v = u .+^ ((w .-. u) ^/ 2) -- point in the middle between u and w+        -- note: the segment between u and w could pass on the wrong side of q+        -- (i.e. so that does not "cover" the CCW but the CW range between u and w)+        -- however, in that case there is apparently nothing on the CCW side opposite+        -- to v, as u and w are supposed to be the first two events. This means the+        -- precondition does not hold.++-- | finds two consecutive vertices in the clockwise order around the+-- given point q. I.e. there are no other points in between the two+-- returned points.+consecutive                   :: (Ord r, Num r) => Point 2 r -> NonEmpty (Point 2 r :+ p)+                              -> (Point 2 r, Point 2 r)+consecutive q ((p :+ _):|pts) = (p,consecutiveFrom (p .-. q) q pts)++-- | pre: input list is non-empty+consecutiveFrom     :: (Ord r, Num r)+                    => Vector 2 r -- ^ starting vector+                    -> Point 2 r -- ^ query point+                    -> [Point 2 r :+ p] -> Point 2 r+consecutiveFrom v q = view core . List.minimumBy (ccwCmpAroundWith' v (ext q))++-- | Gets the edges of the polygon as closed line segments.+closedEdges :: Polygon t p r -> [LineSegment 2 p r]+closedEdges = map asClosed . listEdges+  where+    asClosed (LineSegment' u v) = ClosedLineSegment u v+++--------------------------------------------------------------------------------+-- * Generic Helper functions++++--------------------------------------------------------------------------------++test :: StarShapedPolygon (Definer Int () R) R+test = visibilityPolygon origin testPg++testVtx = visibilityPolygonFromVertex testPg 0++testPg :: SimplePolygon Int R+testPg = fromPoints $ zipWith (:+) [ Point2 3    1+                                   , Point2 3    2+                                   , Point2 4    2+                                   , Point2 2    4+                                   , Point2 (-1) 4+                                   , Point2 1    2+                                   , Point2 (-3) (-1)+                                   , Point2 4    (-1)+                                   ] [1..]++testPg2 :: SimplePolygon Int R+testPg2 = fromPoints $ zipWith (:+) [ Point2 3    1+                                    , Point2 3    2+                                    , Point2 4    2+                                    , Point2 2    4+                                    , Point2 (-1) 4+                                    , Point2 1    2.1+                                    , Point2 (-3) (-1)+                                    , Point2 4    (-1)+                                    ] [1..]++++traceShowIdWith x y = traceShow (show x,y) y
+ src/Algorithms/Geometry/WSPD.hs view
@@ -0,0 +1,474 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Algorithms.Geometry.WSPD+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--+-- Algorithm to construct a well separated pair decomposition (wspd).+--+--------------------------------------------------------------------------------+module Algorithms.Geometry.WSPD+  ( fairSplitTree+  , wellSeparatedPairs+  , NodeData(NodeData)+  , WSP+  , SplitTree+  , nodeData+  , Level(..)+  , reIndexPoints+  , distributePoints+  , distributePoints'+  ) where++import           Algorithms.Geometry.WSPD.Types+import           Control.Lens hiding (Level, levels)+import           Control.Monad.Reader+import           Control.Monad.ST (ST,runST)+import           Data.BinaryTree+import           Data.Ext+import qualified Data.Foldable as F+import           Data.Geometry.Box+import           Data.Geometry.Point+-- import           Data.Geometry.Properties+-- import           Data.Geometry.Transformation+import           Data.Geometry.Vector+import qualified Data.Geometry.Vector as GV+import qualified Data.IntMap.Strict as IntMap+import qualified Data.LSeq as LSeq+import           Data.LSeq (LSeq, toSeq,pattern (:<|))+import qualified Data.List as L+import qualified Data.List.NonEmpty as NonEmpty+import           Data.Maybe+import           Data.Ord (comparing)+import           Data.Range+import qualified Data.Range as Range+import qualified Data.Sequence as S+import qualified Data.Vector as V+import qualified Data.Vector.Mutable as MV+import           GHC.TypeLits++-- import           Debug.Trace++--------------------------------------------------------------------------------++-- | Construct a split tree+--+-- running time: \(O(n \log n)\)+fairSplitTree     :: (Fractional r, Ord r, Arity d, 1 <= d+                     , Show r, Show p+                     )+                  => NonEmpty.NonEmpty (Point d r :+ p) -> SplitTree d p r ()+fairSplitTree pts = foldUp node' Leaf $ fairSplitTree' n pts'+  where+    pts' = imap sortOn . pure . g $ pts+    n    = length $ pts'^.GV.element (C :: C 0)++    sortOn' i = NonEmpty.sortWith (^.core.unsafeCoord i)+    sortOn  i = LSeq.fromNonEmpty . sortOn' (i + 1)+    -- sorts the points on the first coordinate, and then associates each point+    -- with an index,; its rank in terms of this first coordinate.+    g = NonEmpty.zipWith (\i (p :+ e) -> p :+ (i :+ e)) (NonEmpty.fromList [0..])+      . sortOn' 1++    -- node' :: b -> a -> b -> b+    -- node'       :: SplitTree d p r () -> Int -> SplitTree d p r () -> SplitTree d p r ()+    node' l j r = Node l (NodeData j (bbOf l <> bbOf r) ()) r+++-- | Given a split tree, generate the Well separated pairs+--+-- running time: \(O(s^d n)\)+wellSeparatedPairs   :: (Floating r, Ord r, Arity d, Arity (d + 1))+                     => r -> SplitTree d p r a -> [WSP d p r a]+wellSeparatedPairs s = f+  where+    f (Leaf _)     = []+    f (Node l _ r) = findPairs s l r ++ f l ++ f r++++-- -- | Given a split tree, generate the well separated pairs such that one set is+-- -- a singleton.+-- -- running time: \(O(s^d n\log n)\)+-- wellSeparatedPairSingletons   :: (Fractional r, Ord r, AlwaysTrueWSPD d)+--                               => r -> SplitTree d p r a -> [(Point d r :+ p, PointSet d p r (Sized a))]+-- wellSeparatedPairSingletons s t = concatMap split $ wellSeparatedPairs s t'+--   where+--     split (l,r) = undefined+--       -- | measure l <= measure r = map (,r) $ F.toList l+--       -- | otherwise              = map (,l) $ F.toList r+--     t' = foldUpData (\l nd r -> )++--     t+++--------------------------------------------------------------------------------+-- * Building the split tree++-- | Given the points, sorted in every dimension, recursively build a split tree+--+-- The algorithm works in rounds. Each round takes \( O(n) \) time, and halves the+-- number of points. Thus, the total running time is \( O(n log n) \).+--+-- The algorithm essentially builds a path in the split tree; at every node on+-- the path that we construct, we split the point set into two sets (L,R)+-- according to the longest side of the bounding box.+--+-- The smaller set is "assigned" to the current node and set asside. We+-- continue to build the path with the larger set until the total number of+-- items remaining is less than n/2.+--+-- To start the next round, each node on the path needs to have the points+-- assigned to that node, sorted in each dimension (i.e. the Vector+-- (PointSeq))'s. Since we have the level assignment, we can compute these+-- lists by traversing each original input list (i.e. one for every dimension)+-- once, and partition the points based on their level assignment.+fairSplitTree'       :: (Fractional r, Ord r, Arity d, 1 <= d+                        , Show r, Show p+                        )+                     => Int -> GV.Vector d (PointSeq d (Idx :+ p) r)+                     -> BinLeafTree Int (Point d r :+ p)+fairSplitTree' n pts+    | n <= 1    = let p = LSeq.head $ pts^.GV.element (C :: C 0) in Leaf (dropIdx p)+    | otherwise = foldr node' (V.last path) $ V.zip nodeLevels (V.init path)+  where+    -- note that points may also be assigned level 'Nothing'.+    (levels, nodeLevels'@(maxLvl NonEmpty.:| _)) = runST $ do+        lvls  <- MV.replicate n Nothing+        ls    <- runReaderT (assignLevels (n `div` 2) 0 pts (Level 0 Nothing) []) lvls+        lvls' <- V.unsafeFreeze lvls+        pure (lvls',ls)++    -- TODO: We also need to report the levels in the order in which they are+    -- assigned to nodes++    nodeLevels = V.fromList . L.reverse . NonEmpty.toList $ nodeLevels'++    -- levels = traceShow ("Levels",levels',maxLvl) levels'++    -- path = traceShow ("path", path',nodeLevels) path'+    distrPts = distributePoints (1 + maxLvl^.unLevel) levels pts++    path = recurse <$> distrPts -- (traceShow ("distributed pts",distrPts) distrPts)++    -- node' (lvl,lc) rc | traceShow ("node' ",lvl,lc,rc) False = undefined+    node' (lvl,lc) rc = case lvl^?widestDim._Just of+                          Nothing -> error "Unknown widest dimension"+                          Just j  -> Node lc j rc+    recurse pts' = fairSplitTree' (length $ pts'^.GV.element (C :: C 0))+                                  (reIndexPoints pts')++-- | Assign the points to their the correct class. The 'Nothing' class is+-- considered the last class+distributePoints          :: (Arity d , Show r, Show p)+                          => Int -> V.Vector (Maybe Level)+                          -> GV.Vector d (PointSeq d (Idx :+ p) r)+                          -> V.Vector (GV.Vector d (PointSeq d (Idx :+ p) r))+distributePoints k levels = transpose . fmap (distributePoints' k levels)++transpose :: Arity d => GV.Vector d (V.Vector a) -> V.Vector (GV.Vector d a)+transpose = V.fromList . map GV.vectorFromListUnsafe . L.transpose+          . map V.toList . F.toList++-- | Assign the points to their the correct class. The 'Nothing' class is+-- considered the last class+distributePoints'              :: Int                      -- ^ number of classes+                               -> V.Vector (Maybe Level)   -- ^ level assignment+                               -> PointSeq d (Idx :+ p) r  -- ^ input points+                               -> V.Vector (PointSeq d (Idx :+ p) r)+distributePoints' k levels pts+  = fmap fromSeqUnsafe $ V.create $ do+    v <- MV.replicate k mempty+    forM_ pts $ \p ->+      append v (level p) p+    pure v+  where+    level p = maybe (k-1) _unLevel $ levels V.! (p^.extra.core)+    append v i p = MV.read v i >>= MV.write v i . (S.|> p)++fromSeqUnsafe :: S.Seq a -> LSeq n a+fromSeqUnsafe = LSeq.promise . LSeq.fromSeq++-- | Given a sequence of points, whose index is increasing in the first+-- dimension, i.e. if idx p < idx q, then p[0] < q[0].+-- Reindex the points so that they again have an index+-- in the range [0,..,n'], where n' is the new number of points.+--+-- running time: O(n' * d) (more or less; we are actually using an intmap for+-- the lookups)+--+-- alternatively: I can unsafe freeze and thaw an existing vector to pass it+-- along to use as mapping. Except then I would have to force the evaluation+-- order, i.e. we cannot be in 'reIndexPoints' for two of the nodes at the same+-- time.+--+-- so, basically, run reIndex points in ST as well.+reIndexPoints      :: (Arity d, 1 <= d)+                   => GV.Vector d (PointSeq d (Idx :+ p) r)+                   -> GV.Vector d (PointSeq d (Idx :+ p) r)+reIndexPoints ptsV = fmap reIndex ptsV+  where+    pts = ptsV^.GV.element (C :: C 0)++    reIndex = fmap (\p -> p&extra.core %~ fromJust . flip IntMap.lookup mapping')+    mapping' = IntMap.fromAscList $ zip (map (^.extra.core) . F.toList $ pts) [0..]++-- | ST monad with access to the vector storign the level of the points.+type RST s = ReaderT (MV.MVector s (Maybe Level)) (ST s)++{- HLINT ignore assignLevels -}+-- | Assigns the points to a level. Returns the list of levels used. The first+-- level in the list is the level assigned to the rest of the nodes. Their+-- level is actually still set to Nothing in the underlying array.+assignLevels                  :: (Fractional r, Ord r, Arity d+                                 , Show r, Show p+                                 )+                              => Int -- ^ Number of items we need to collect+                              -> Int -- ^ Number of items we collected so far+                              -> GV.Vector d (PointSeq d (Idx :+ p) r)+                              -> Level -- ^ next level to use+                              -> [Level] -- ^ Levels used so far+                              -> RST s (NonEmpty.NonEmpty Level)+assignLevels h m pts l prevLvls+  | m >= h    = pure (l NonEmpty.:| prevLvls)+  | otherwise = do+    pts' <- compactEnds pts+    -- find the widest dimension j = i+1+    let j    = widestDimension pts'+        i    = j - 1 -- traceShow  ("i",j,pts') j - 1+        extJ = (extends pts')^.ix' i+        mid  = midPoint extJ++    -- find the set of points that we have to delete, by looking at the sorted+    -- list L_j. As a side effect, this will remove previously assigned points+    -- from L_j.+    (lvlJPts,deletePts) <- findAndCompact j (pts'^.ix' i) mid+    let pts''     = pts'&ix' i .~ lvlJPts+        l'        = l&widestDim ?~ j+    forM_ deletePts $ \p ->+      assignLevel p l'+    assignLevels h (m + length deletePts) pts'' (nextLevel l) (l' : prevLvls)++-- | Remove already assigned pts from the ends of all vectors.+compactEnds        :: Arity d+                   => GV.Vector d (PointSeq d (Idx :+ p) r)+                   -> RST s (GV.Vector d (PointSeq d (Idx :+ p) r))+compactEnds = traverse compactEnds'++-- | Assign level l to point p+assignLevel     :: (c :+ (Idx :+ p)) -> Level -> RST s ()+assignLevel p l = ask >>= \levels -> lift $ MV.write levels (p^.extra.core) (Just l)++-- | Get the level of a point+levelOf   :: (c :+ (Idx :+ p)) -> RST s (Maybe Level)+levelOf p = ask >>= \levels -> lift $ MV.read levels (p^.extra.core)++-- | Test if the point already has a level assigned to it.+hasLevel :: c :+ (Idx :+ p) -> RST s Bool+hasLevel = fmap isJust . levelOf++-- | Remove allready assigned points from the sequence+--+-- pre: there are points remaining+compactEnds'              :: PointSeq d (Idx :+ p) r+                          -> RST s (PointSeq d (Idx :+ p) r)+compactEnds' (l0 :<| s0) = fmap fromSeqUnsafe . goL $ l0 S.<| toSeq s0+  where+    goL s@(S.viewl -> l S.:< s') = hasLevel l >>= \case+                                     False -> goR s+                                     True  -> goL s'+    goL _ = error "Unreachable, but cannot prove it in Haskell"+    goR s@(S.viewr -> s' S.:> r) = hasLevel r >>= \case+                                     False -> pure s+                                     True  -> goR s'+    goR _ = error "Unreachable, but cannot prove it in Haskell"+++-- | Given the points, ordered by their j^th coordinate, split the point set+-- into a "left" and a "right" half, i.e. the points whose j^th coordinate is+-- at most the given mid point m, and the points whose j^th coordinate is+-- larger than m.+--+-- We return a pair (Largest set, Smallest set)+--+--+--fi ndAndCompact works by simultaneously traversing the points from left to+-- right, and from right to left. As soon as we find a point crossing the mid+-- point we stop and return. Thus, in principle this takes only O(|Smallest+-- set|) time.+--+-- running time: O(|Smallest set|) + R, where R is the number of *old* points+-- (i.e. points that should have been removed) in the list.+findAndCompact                   :: (Ord r, Arity d+                                    , Show r, Show p+                                    )+                                 => Int+                                    -- ^ the dimension we are in, i.e. so that we know+                                    -- which coordinate of the point to compare+                                 -> PointSeq d (Idx :+ p) r+                                 -> r -- ^ the mid point+                                 -> RST s ( PointSeq d (Idx :+ p) r+                                          , PointSeq d (Idx :+ p) r+                                          )+findAndCompact j (l0 :<| s0) m = fmap select . stepL $ l0 S.<| toSeq s0+  where+    -- stepL and stepR together build a data structure (FAC l r S) that+    -- contains the left part of the list, i.e. the points before midpoint, and+    -- the right part of the list., and a value S that indicates which part is+    -- the short side.++    -- stepL takes a step on the left side of the list; if the left point l+    -- already has been assigned, we continue waling along (and "ignore" the+    -- point). If it has not been assigned, and is before the mid point, we+    -- take a step from the right, and add l onto the left part. If it is+    -- larger than the mid point, we have found our split.+    -- stepL :: S.Seq (Point d r :+ (Idx :+ p)) -> ST s (FindAndCompact d r (Idx :+ p))+    stepL s = case S.viewl s of+      S.EmptyL  -> pure $ FAC mempty mempty L+      l S.:< s' -> hasLevel l >>= \case+                     False -> if l^.core.unsafeCoord j <= m+                                 then addL l <$> stepR s'+                                 else pure $ FAC mempty s L+                     True  -> stepL s' -- delete, continue left++    -- stepR :: S.Seq (Point d r :+ (Idx :+ p)) -> ST s (FindAndCompact d r (Idx :+ p))+    stepR s = case S.viewr s of+      S.EmptyR  -> pure $ FAC mempty mempty R+      s' S.:> r -> hasLevel r >>= \case+                     False -> if r^.core.unsafeCoord j >= m+                                 then addR r <$> stepL s'+                                 else pure $ FAC s mempty R+                     True  -> stepR s'+++    addL l x = x&leftPart  %~ (l S.<|)+    addR r x = x&rightPart %~ (S.|> r)++    select = over both fromSeqUnsafe . select'++    -- select' f | traceShow ("select'", f) False = undefined+    select' (FAC l r L) = (r, l)+    select' (FAC l r R) = (l, r)+++-- | Find the widest dimension of the point set+--+-- pre: points are sorted according to their dimension+widestDimension :: (Num r, Ord r, Arity d) => GV.Vector d (PointSeq d p r) -> Int+widestDimension = fst . L.maximumBy (comparing snd) . zip [1..] . F.toList . widths++widths :: (Num r, Arity d) => GV.Vector d (PointSeq d p r) -> GV.Vector d r+widths = fmap Range.width . extends+++{- HLINT ignore extends -}+-- | get the extends of the set of points in every dimension, i.e. the left and+-- right boundaries.+--+-- pre: points are sorted according to their dimension+extends :: Arity d => GV.Vector d (PointSeq d p r) -> GV.Vector d (Range r)+extends = imap (\i pts ->+                     ClosedRange ((LSeq.head pts)^.core.unsafeCoord (i + 1))+                                 ((LSeq.last pts)^.core.unsafeCoord (i + 1)))+++--------------------------------------------------------------------------------+-- * Finding Well Separated Pairs++findPairs                     :: (Floating r, Ord r, Arity d, Arity (d + 1))+                              => r -> SplitTree d p r a -> SplitTree d p r a+                              -> [WSP d p r a]+findPairs s l r+  | areWellSeparated' s l r   = [(l,r)]+  | maxWidth l <=  maxWidth r = concatMap (findPairs s l) $ children' r+  | otherwise                 = concatMap (findPairs s r) $ children' l+++-- -- | Test if the two sets are well separated with param s+-- areWellSeparated                     :: (Arity d, Arity (d + 1), Fractional r, Ord r)+--                                      => r -- ^ separation factor+--                                      -> SplitTree d p r a+--                                      -> SplitTree d p r a -> Bool+-- areWellSeparated _ (Leaf _) (Leaf _) = True+-- areWellSeparated s l        r        = boxBox s (bbOf l)   (bbOf r)+++-- areWellSeparated s (Leaf p)      (Node _ nd _) = pointBox s (p^.core) (nd^.bBox)+-- areWellSeparated s (Node _ nd _) (Leaf p)      = pointBox s (p^.core) (nd^.bBox)+-- areWellSeparated s (Node _ ld _) (Node _ rd _) = boxBox   s (ld^.bBox) (rd^.bBox)++{- HLINT ignore boxBox -}+-- -- | Test if the point and the box are far enough appart+-- pointBox       :: (Fractional r, Ord r, AlwaysTruePFT d, AlwaysTrueTransformation d)+--                => r -> Point d r -> Box d p r -> Bool+-- pointBox s p b = not $ p `inBox` b'+--   where+--     v  = (centerPoint b)^.vector+--     b' = translateBy v . scaleUniformlyBy s . translateBy ((-1) *^ v) $ b++-- -- | Test if the two boxes are sufficiently far appart+-- boxBox         :: (Fractional r, Ord r, Arity d, Arity (d + 1))+--                => r -> Box d p r -> Box d p r -> Bool+-- boxBox s lb rb = boxBox' lb rb && boxBox' rb lb+--   where+--     boxBox' b' b = not $ b' `intersects` bOut+--       where+--         v    = (centerPoint b)^.vector+--         bOut = translateBy v . scaleUniformlyBy s . translateBy ((-1) *^ v) $ b++--------------------------------------------------------------------------------+-- * Alternative def if wellSeparated that uses fractional+++areWellSeparated'                     :: (Floating r, Ord r, Arity d)+                                      => r+                                      -> SplitTree d p r a+                                      -> SplitTree d p r a+                                      -> Bool+areWellSeparated' _ (Leaf _) (Leaf _) = True+areWellSeparated' s l        r        = boxBox1 s (bbOf l) (bbOf r)++-- (Leaf p)      (Node _ nd _) = pointBox' s (p^.core) (nd^.bBox)+-- areWellSeparated' s (Node _ nd _) (Leaf p)      = pointBox' s (p^.core) (nd^.bBox)+-- areWellSeparated' s (Node _ ld _) (Node _ rd _) = boxBox'   s (ld^.bBox) (rd^.bBox)++boxBox1         :: (Floating r, Ord r, Arity d) => r -> Box d p r -> Box d p r -> Bool+boxBox1 s lb rb = euclideanDist (centerPoint lb) (centerPoint rb) >= (s+1)*d+  where+    diam b = euclideanDist (b^.minP.core.cwMin) (b^.maxP.core.cwMax)+    d      = max (diam lb) (diam rb)+++++--------------------------------------------------------------------------------+-- * Helper stuff+++-- | Computes the maximum width of a splitTree+maxWidth                             :: (Arity d, Num r)+                                     => SplitTree d p r a -> r+maxWidth (Leaf _)                    = 0+maxWidth (Node _ (NodeData i b _) _) = fromJust $ widthIn' i b++-- | 'Computes' the bounding box of a split tree+bbOf                             :: Ord r => SplitTree d p r a -> Box d () r+bbOf (Leaf p)                    = boundingBox $ p^.core+bbOf (Node _ (NodeData _ b _) _) = b+++children'              :: BinLeafTree v a -> [BinLeafTree v a]+children' (Leaf _)     = []+children' (Node l _ r) = [l,r]+++-- | Turn a traversal into lens+ix'   :: (Arity d, KnownNat d) => Int -> Lens' (GV.Vector d a) a+ix' i = singular (GV.element' i)+++dropIdx                 :: core :+ (t :+ extra) -> core :+ extra+dropIdx (p :+ (_ :+ e)) = p :+ e++--------------------------------------------------------------------------------
+ src/Algorithms/Geometry/WSPD/Types.hs view
@@ -0,0 +1,85 @@+{-# 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 { _splitDim :: !Int+                               , _bBox     :: !(Box d () r)+                               , _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++instance Functor (NodeData d r) where+  fmap = Tr.fmapDefault++instance Foldable (NodeData d r) where+  foldMap = Tr.foldMapDefault++instance Traversable (NodeData d r) where+  traverse f (NodeData d b x) = NodeData d b <$> f x++--------------------------------------------------------------------------------+-- * Implementation types++-- | Non-empty sequence of points.+type PointSeq d p r = LSeq.LSeq 1 (Point d r :+ p)+++data Level = Level { _unLevel   :: Int+                   , _widestDim :: Maybe Int+                   } deriving (Show,Eq,Ord)+makeLenses ''Level++nextLevel             :: Level -> Level+nextLevel (Level i _) = Level (i+1) Nothing+++type Idx = Int+++data ShortSide = L | R deriving (Show,Eq)++data FindAndCompact d r p = FAC { _leftPart  :: !(S.Seq (Point d r :+ p))+                                , _rightPart :: !(S.Seq (Point d r :+ p))+                                , _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
src/Algorithms/Geometry/WellSeparatedPairDecomposition/Types.hs view
@@ -10,75 +10,11 @@ -- Data types that can represent a well separated pair decomposition (wspd). -- ---------------------------------------------------------------------------------module Algorithms.Geometry.WellSeparatedPairDecomposition.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 { _splitDim :: !Int-                               , _bBox     :: !(Box d () r)-                               , _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--instance Functor (NodeData d r) where-  fmap = Tr.fmapDefault--instance Foldable (NodeData d r) where-  foldMap = Tr.foldMapDefault--instance Traversable (NodeData d r) where-  traverse f (NodeData d b x) = NodeData d b <$> f x------------------------------------------------------------------------------------- * Implementation types--type PointSeq d p r = LSeq.LSeq 1 (Point d r :+ p)---data Level = Level { _unLevel   :: Int-                   , _widestDim :: Maybe Int-                   } deriving (Show,Eq,Ord)-makeLenses ''Level--nextLevel             :: Level -> Level-nextLevel (Level i _) = Level (i+1) Nothing----type Idx = Int---data ShortSide = L | R deriving (Show,Eq)--data FindAndCompact d r p = FAC { _leftPart  :: !(S.Seq (Point d r :+ p))-                                , _rightPart :: !(S.Seq (Point d r :+ p))-                                , _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)+-- FIXME: This module should be internal and not exposed. Fix after 2021-06-01.+module Algorithms.Geometry.WellSeparatedPairDecomposition.Types+  {-# DEPRECATED "This module will be deleted after 2021-06-01. \+                 \Use Algorithms.Geometry.WSPD instead." #-}+  ( module Algorithms.Geometry.WSPD.Types )+  where -makeLenses ''FindAndCompact+import Algorithms.Geometry.WSPD.Types
src/Algorithms/Geometry/WellSeparatedPairDecomposition/WSPD.hs view
@@ -8,453 +8,10 @@ -- Algorithm to construct a well separated pair decomposition (wspd). -- ---------------------------------------------------------------------------------module Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD where--import           Algorithms.Geometry.WellSeparatedPairDecomposition.Types-import           Control.Lens hiding (Level, levels)-import           Control.Monad.Reader-import           Control.Monad.ST (ST,runST)-import           Data.BinaryTree-import           Data.Ext-import qualified Data.Foldable as F-import           Data.Geometry.Box-import           Data.Geometry.Point-import           Data.Geometry.Properties-import           Data.Geometry.Transformation-import           Data.Geometry.Vector-import qualified Data.Geometry.Vector as GV-import qualified Data.IntMap.Strict as IntMap-import qualified Data.LSeq as LSeq-import           Data.LSeq (LSeq,toSeq,ViewL(..),ViewR(..),pattern (:<|))-import qualified Data.List as L-import qualified Data.List.NonEmpty as NonEmpty-import           Data.Maybe-import           Data.Ord (comparing)-import           Data.Range-import qualified Data.Range as Range-import qualified Data.Sequence as S-import qualified Data.Vector as V-import qualified Data.Vector.Mutable as MV-import           GHC.TypeLits--import           Debug.Trace-------------------------------------------------------------------------------------- | Construct a split tree------ running time: \(O(n \log n)\)-fairSplitTree     :: (Fractional r, Ord r, Arity d, 1 <= d-                     , Show r, Show p-                     )-                  => NonEmpty.NonEmpty (Point d r :+ p) -> SplitTree d p r ()-fairSplitTree pts = foldUp node' Leaf $ fairSplitTree' n pts'+module Algorithms.Geometry.WellSeparatedPairDecomposition.WSPD+  {-# DEPRECATED "This module will be deleted after 2021-06-01. \+                 \Use Algorithms.Geometry.WSPD instead." #-}+  ( module Algorithms.Geometry.WSPD )   where-    pts' = imap sortOn . pure . g $ pts-    n    = length $ pts'^.GV.element (C :: C 0) -    sortOn' i = NonEmpty.sortWith (^.core.unsafeCoord i)-    sortOn  i = LSeq.fromNonEmpty . sortOn' (i + 1)-    -- sorts the points on the first coordinate, and then associates each point-    -- with an index,; its rank in terms of this first coordinate.-    g = NonEmpty.zipWith (\i (p :+ e) -> p :+ (i :+ e)) (NonEmpty.fromList [0..])-      . sortOn' 1--    -- node' :: b -> a -> b -> b-    -- node'       :: SplitTree d p r () -> Int -> SplitTree d p r () -> SplitTree d p r ()-    node' l j r = Node l (NodeData j (bbOf l <> bbOf r) ()) r----- | Given a split tree, generate the Well separated pairs------ running time: \(O(s^d n)\)-wellSeparatedPairs   :: (Floating r, Ord r, Arity d, Arity (d + 1))-                     => r -> SplitTree d p r a -> [WSP d p r a]-wellSeparatedPairs s = f-  where-    f (Leaf _)     = []-    f (Node l _ r) = findPairs s l r ++ f l ++ f r------ -- | Given a split tree, generate the well separated pairs such that one set is--- -- a singleton.--- -- running time: \(O(s^d n\log n)\)--- wellSeparatedPairSingletons   :: (Fractional r, Ord r, AlwaysTrueWSPD d)---                               => r -> SplitTree d p r a -> [(Point d r :+ p, PointSet d p r (Sized a))]--- wellSeparatedPairSingletons s t = concatMap split $ wellSeparatedPairs s t'---   where---     split (l,r) = undefined---       -- | measure l <= measure r = map (,r) $ F.toList l---       -- | otherwise              = map (,l) $ F.toList r---     t' = foldUpData (\l nd r -> )----     t-------------------------------------------------------------------------------------- * Building the split tree---- | Given the points, sorted in every dimension, recursively build a split tree------ The algorithm works in rounds. Each round takes O(n) time, and halves the--- number of points. Thus, the total running time is O(n log n).------ The algorithm essentially builds a path in the split tree; at every node on--- the path that we construct, we split the point set into two sets (L,R)--- according to the longest side of the bounding box.------ The smaller set is "assigned" to the current node and set asside. We--- continue to build the path with the larger set until the total number of--- items remaining is less than n/2.------ To start the next round, each node on the path needs to have the points--- assigned to that node, sorted in each dimension (i.e. the Vector--- (PointSeq))'s. Since we have the level assignment, we can compute these--- lists by traversing each original input list (i.e. one for every dimension)--- once, and partition the points based on their level assignment.-fairSplitTree'       :: (Fractional r, Ord r, Arity d, 1 <= d-                        , Show r, Show p-                        )-                     => Int -> GV.Vector d (PointSeq d (Idx :+ p) r)-                     -> BinLeafTree Int (Point d r :+ p)-fairSplitTree' n pts-    | n <= 1    = let p = LSeq.head $ pts^.GV.element (C :: C 0) in Leaf (dropIdx p)-    | otherwise = foldr node' (V.last path) $ V.zip nodeLevels (V.init path)-  where-    -- note that points may also be assigned level 'Nothing'.-    (levels, nodeLevels'@(maxLvl NonEmpty.:| _)) = runST $ do-        lvls  <- MV.replicate n Nothing-        ls    <- runReaderT (assignLevels (n `div` 2) 0 pts (Level 0 Nothing) []) lvls-        lvls' <- V.unsafeFreeze lvls-        pure (lvls',ls)--    -- TODO: We also need to report the levels in the order in which they are-    -- assigned to nodes--    nodeLevels = V.fromList . L.reverse . NonEmpty.toList $ nodeLevels'--    -- levels = traceShow ("Levels",levels',maxLvl) levels'--    -- path = traceShow ("path", path',nodeLevels) path'-    distrPts = distributePoints (1 + maxLvl^.unLevel) levels pts--    path = recurse <$> distrPts -- (traceShow ("distributed pts",distrPts) distrPts)--    -- node' (lvl,lc) rc | traceShow ("node' ",lvl,lc,rc) False = undefined-    node' (lvl,lc) rc = case lvl^?widestDim._Just of-                          Nothing -> error "Unknown widest dimension"-                          Just j  -> Node lc j rc-    recurse pts' = fairSplitTree' (length $ pts'^.GV.element (C :: C 0))-                                  (reIndexPoints pts')---- | Assign the points to their the correct class. The 'Nothing' class is--- considered the last class-distributePoints          :: (Arity d , Show r, Show p)-                          => Int -> V.Vector (Maybe Level)-                          -> GV.Vector d (PointSeq d (Idx :+ p) r)-                          -> V.Vector (GV.Vector d (PointSeq d (Idx :+ p) r))-distributePoints k levels = transpose . fmap (distributePoints' k levels)--transpose :: Arity d => GV.Vector d (V.Vector a) -> V.Vector (GV.Vector d a)-transpose = V.fromList . map GV.vectorFromListUnsafe . L.transpose-          . map V.toList . F.toList---- | Assign the points to their the correct class. The 'Nothing' class is--- considered the last class-distributePoints'              :: Int                      -- ^ number of classes-                               -> V.Vector (Maybe Level)   -- ^ level assignment-                               -> PointSeq d (Idx :+ p) r  -- ^ input points-                               -> V.Vector (PointSeq d (Idx :+ p) r)-distributePoints' k levels pts-  | otherwise-  = fmap fromSeqUnsafe $ V.create $ do-    v <- MV.replicate k mempty-    forM_ pts $ \p ->-      append v (level p) p-    pure v-  where-    level p = maybe (k-1) _unLevel $ levels V.! (p^.extra.core)-    append v i p = MV.read v i >>= MV.write v i . (S.|> p)--fromSeqUnsafe = LSeq.promise . LSeq.fromSeq---- | Given a sequence of points, whose index is increasing in the first--- dimension, i.e. if idx p < idx q, then p[0] < q[0].--- Reindex the points so that they again have an index--- in the range [0,..,n'], where n' is the new number of points.------ running time: O(n' * d) (more or less; we are actually using an intmap for--- the lookups)------ alternatively: I can unsafe freeze and thaw an existing vector to pass it--- along to use as mapping. Except then I would have to force the evaluation--- order, i.e. we cannot be in 'reIndexPoints' for two of the nodes at the same--- time.------ so, basically, run reIndex points in ST as well.-reIndexPoints      :: (Arity d, 1 <= d)-                   => GV.Vector d (PointSeq d (Idx :+ p) r)-                   -> GV.Vector d (PointSeq d (Idx :+ p) r)-reIndexPoints ptsV = fmap reIndex ptsV-  where-    pts = ptsV^.GV.element (C :: C 0)--    reIndex = fmap (\p -> p&extra.core %~ fromJust . flip IntMap.lookup mapping')-    mapping' = IntMap.fromAscList $ zip (map (^.extra.core) . F.toList $ pts) [0..]---- | ST monad with access to the vector storign the level of the points.-type RST s = ReaderT (MV.MVector s (Maybe Level)) (ST s)---- | Assigns the points to a level. Returns the list of levels used. The first--- level in the list is the level assigned to the rest of the nodes. Their--- level is actually still set to Nothing in the underlying array.-assignLevels                  :: (Fractional r, Ord r, Arity d-                                 , Show r, Show p-                                 )-                              => Int -- ^ Number of items we need to collect-                              -> Int -- ^ Number of items we collected so far-                              -> GV.Vector d (PointSeq d (Idx :+ p) r)-                              -> Level -- ^ next level to use-                              -> [Level] -- ^ Levels used so far-                              -> RST s (NonEmpty.NonEmpty Level)-assignLevels h m pts l prevLvls-  | m >= h    = pure (l NonEmpty.:| prevLvls)-  | otherwise = do-    pts' <- compactEnds pts-    -- find the widest dimension j = i+1-    let j    = widestDimension pts'-        i    = j - 1 -- traceShow  ("i",j,pts') j - 1-        extJ = (extends pts')^.ix' i-        mid  = midPoint extJ--    -- find the set of points that we have to delete, by looking at the sorted-    -- list L_j. As a side effect, this will remove previously assigned points-    -- from L_j.-    (lvlJPts,deletePts) <- findAndCompact j (pts'^.ix' i) mid-    let pts''     = pts'&ix' i .~ lvlJPts-        l'        = l&widestDim .~ Just j-    forM_ deletePts $ \p ->-      assignLevel p l'-    assignLevels h (m + length deletePts) pts'' (nextLevel l) (l' : prevLvls)---- | Remove already assigned pts from the ends of all vectors.-compactEnds        :: Arity d-                   => GV.Vector d (PointSeq d (Idx :+ p) r)-                   -> RST s (GV.Vector d (PointSeq d (Idx :+ p) r))-compactEnds = traverse compactEnds'---- | Assign level l to point p-assignLevel     :: (c :+ (Idx :+ p)) -> Level -> RST s ()-assignLevel p l = ask >>= \levels -> lift $ MV.write levels (p^.extra.core) (Just l)---- | Get the level of a point-levelOf   :: (c :+ (Idx :+ p)) -> RST s (Maybe Level)-levelOf p = ask >>= \levels -> lift $ MV.read levels (p^.extra.core)---- | Test if the point already has a level assigned to it.-hasLevel :: c :+ (Idx :+ p) -> RST s Bool-hasLevel = fmap isJust . levelOf---- | Remove allready assigned points from the sequence------ pre: there are points remaining-compactEnds'              :: PointSeq d (Idx :+ p) r-                          -> RST s (PointSeq d (Idx :+ p) r)-compactEnds' (l0 :<| s0) = fmap fromSeqUnsafe . goL $ l0 S.<| toSeq s0-  where-    goL s@(S.viewl -> l S.:< s') = hasLevel l >>= \case-                                     False -> goR s-                                     True  -> goL s'-    goR s@(S.viewr -> s' S.:> r) = hasLevel r >>= \case-                                     False -> pure s-                                     True  -> goR s'----- | Given the points, ordered by their j^th coordinate, split the point set--- into a "left" and a "right" half, i.e. the points whose j^th coordinate is--- at most the given mid point m, and the points whose j^th coordinate is--- larger than m.------ We return a pair (Largest set, Smallest set)---------fi ndAndCompact works by simultaneously traversing the points from left to--- right, and from right to left. As soon as we find a point crossing the mid--- point we stop and return. Thus, in principle this takes only O(|Smallest--- set|) time.------ running time: O(|Smallest set|) + R, where R is the number of *old* points--- (i.e. points that should have been removed) in the list.-findAndCompact                   :: (Ord r, Arity d-                                    , Show r, Show p-                                    )-                                 => Int-                                    -- ^ the dimension we are in, i.e. so that we know-                                    -- which coordinate of the point to compare-                                 -> PointSeq d (Idx :+ p) r-                                 -> r -- ^ the mid point-                                 -> RST s ( PointSeq d (Idx :+ p) r-                                          , PointSeq d (Idx :+ p) r-                                          )-findAndCompact j (l0 :<| s0) m = fmap select . stepL $ l0 S.<| toSeq s0-  where-    -- stepL and stepR together build a data structure (FAC l r S) that-    -- contains the left part of the list, i.e. the points before midpoint, and-    -- the right part of the list., and a value S that indicates which part is-    -- the short side.--    -- stepL takes a step on the left side of the list; if the left point l-    -- already has been assigned, we continue waling along (and "ignore" the-    -- point). If it has not been assigned, and is before the mid point, we-    -- take a step from the right, and add l onto the left part. If it is-    -- larger than the mid point, we have found our split.-    -- stepL :: S.Seq (Point d r :+ (Idx :+ p)) -> ST s (FindAndCompact d r (Idx :+ p))-    stepL s = case S.viewl s of-      S.EmptyL  -> pure $ FAC mempty mempty L-      l S.:< s' -> hasLevel l >>= \case-                     False -> if l^.core.unsafeCoord j <= m-                                 then addL l <$> stepR s'-                                 else pure $ FAC mempty s L-                     True  -> stepL s' -- delete, continue left--    -- stepR :: S.Seq (Point d r :+ (Idx :+ p)) -> ST s (FindAndCompact d r (Idx :+ p))-    stepR s = case S.viewr s of-      S.EmptyR  -> pure $ FAC mempty mempty R-      s' S.:> r -> hasLevel r >>= \case-                     False -> if r^.core.unsafeCoord j >= m-                                 then addR r <$> stepL s'-                                 else pure $ FAC s mempty R-                     True  -> stepR s'---    addL l x = x&leftPart  %~ (l S.<|)-    addR r x = x&rightPart %~ (S.|> r)--    select = over both fromSeqUnsafe . select'--    -- select' f | traceShow ("select'", f) False = undefined-    select' (FAC l r L) = (r, l)-    select' (FAC l r R) = (l, r)----- | Find the widest dimension of the point set------ pre: points are sorted according to their dimension-widestDimension :: (Num r, Ord r, Arity d) => GV.Vector d (PointSeq d p r) -> Int-widestDimension = fst . L.maximumBy (comparing snd) . zip [1..] . F.toList . widths--widths :: (Num r, Arity d) => GV.Vector d (PointSeq d p r) -> GV.Vector d r-widths = fmap Range.width . extends------ | get the extends of the set of points in every dimension, i.e. the left and--- right boundaries.------ pre: points are sorted according to their dimension-extends :: Arity d => GV.Vector d (PointSeq d p r) -> GV.Vector d (Range r)-extends = imap (\i pts ->-                     ClosedRange ((LSeq.head pts)^.core.unsafeCoord (i + 1))-                                 ((LSeq.last pts)^.core.unsafeCoord (i + 1)))-------------------------------------------------------------------------------------- * Finding Well Separated Pairs--findPairs                     :: (Floating r, Ord r, Arity d, Arity (d + 1))-                              => r -> SplitTree d p r a -> SplitTree d p r a-                              -> [WSP d p r a]-findPairs s l r-  | areWellSeparated' s l r   = [(l,r)]-  | maxWidth l <=  maxWidth r = concatMap (findPairs s l) $ children' r-  | otherwise                 = concatMap (findPairs s r) $ children' l----- | Test if the two sets are well separated with param s-areWellSeparated                     :: (Arity d, Arity (d + 1), Fractional r, Ord r)-                                     => r -- ^ separation factor-                                     -> SplitTree d p r a-                                     -> SplitTree d p r a -> Bool-areWellSeparated _ (Leaf _) (Leaf _) = True-areWellSeparated s l        r        = boxBox s (bbOf l)   (bbOf r)----- areWellSeparated s (Leaf p)      (Node _ nd _) = pointBox s (p^.core) (nd^.bBox)--- areWellSeparated s (Node _ nd _) (Leaf p)      = pointBox s (p^.core) (nd^.bBox)--- areWellSeparated s (Node _ ld _) (Node _ rd _) = boxBox   s (ld^.bBox) (rd^.bBox)----- -- | Test if the point and the box are far enough appart--- pointBox       :: (Fractional r, Ord r, AlwaysTruePFT d, AlwaysTrueTransformation d)---                => r -> Point d r -> Box d p r -> Bool--- pointBox s p b = not $ p `inBox` b'---   where---     v  = (centerPoint b)^.vector---     b' = translateBy v . scaleUniformlyBy s . translateBy ((-1) *^ v) $ b---- | Test if the two boxes are sufficiently far appart-boxBox         :: (Fractional r, Ord r, Arity d, Arity (d + 1))-               => r -> Box d p r -> Box d p r -> Bool-boxBox s lb rb = boxBox' lb rb && boxBox' rb lb-  where-    boxBox' b' b = not $ b' `intersects` bOut-      where-        v    = (centerPoint b)^.vector-        bOut = translateBy v . scaleUniformlyBy s . translateBy ((-1) *^ v) $ b------------------------------------------------------------------------------------- * Alternative def if wellSeparated that uses fractional---areWellSeparated'                     :: (Floating r, Ord r, Arity d)-                                      => r-                                      -> SplitTree d p r a-                                      -> SplitTree d p r a-                                      -> Bool-areWellSeparated' _ (Leaf _) (Leaf _) = True-areWellSeparated' s l        r        = boxBox1 s (bbOf l) (bbOf r)---- (Leaf p)      (Node _ nd _) = pointBox' s (p^.core) (nd^.bBox)--- areWellSeparated' s (Node _ nd _) (Leaf p)      = pointBox' s (p^.core) (nd^.bBox)--- areWellSeparated' s (Node _ ld _) (Node _ rd _) = boxBox'   s (ld^.bBox) (rd^.bBox)--boxBox1         :: (Floating r, Ord r, Arity d) => r -> Box d p r -> Box d p r -> Bool-boxBox1 s lb rb = euclideanDist (centerPoint lb) (centerPoint rb) >= (s+1)*d-  where-    diam b = euclideanDist (b^.minP.core.cwMin) (b^.maxP.core.cwMax)-    d      = max (diam lb) (diam rb)---------------------------------------------------------------------------------------- * Helper stuff----- | Computes the maximum width of a splitTree-maxWidth                             :: (Arity d, Num r)-                                     => SplitTree d p r a -> r-maxWidth (Leaf _)                    = 0-maxWidth (Node _ (NodeData i b _) _) = fromJust $ widthIn' i b---- | 'Computes' the bounding box of a split tree-bbOf                             :: Ord r => SplitTree d p r a -> Box d () r-bbOf (Leaf p)                    = boundingBox $ p^.core-bbOf (Node _ (NodeData _ b _) _) = b---children'              :: BinLeafTree v a -> [BinLeafTree v a]-children' (Leaf _)     = []-children' (Node l _ r) = [l,r]----- | Turn a traversal into lens-ix'   :: (Arity d, KnownNat d) => Int -> Lens' (GV.Vector d a) a-ix' i = singular (GV.element' i)---dropIdx                 :: core :+ (t :+ extra) -> core :+ extra-dropIdx (p :+ (_ :+ e)) = p :+ e----------------------------------------------------------------------------------+import Algorithms.Geometry.WSPD
src/Data/Geometry.hs view
@@ -26,7 +26,7 @@ import Data.Geometry.LineSegment import Data.Geometry.Point import Data.Geometry.PolyLine hiding (fromPoints)-import Data.Geometry.Polygon hiding (fromPoints)+import Data.Geometry.Polygon hiding (fromPoints, maximumBy, minimumBy) import Data.Geometry.Properties import Data.Geometry.Transformation -- import Linear.Affine hiding (Point, Vector, origin)
src/Data/Geometry/Arrangement/Internal.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell  #-}+{-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- -- | -- Module      :  Data.Geometry.Arrangement.Internal@@ -13,9 +13,10 @@  import           Algorithms.BinarySearch import           Control.Lens-import qualified Data.CircularSeq as CSeq+import           Data.Bifunctor+import qualified Data.CircularSeq                as CSeq import           Data.Ext-import qualified Data.Foldable as F+import qualified Data.Foldable                   as F import           Data.Geometry.Boundary import           Data.Geometry.Box import           Data.Geometry.Line@@ -23,10 +24,10 @@ import           Data.Geometry.PlanarSubdivision import           Data.Geometry.Point import           Data.Geometry.Properties-import qualified Data.List as List+import qualified Data.List                       as List import           Data.Maybe-import           Data.Ord (Down(..))-import qualified Data.Vector as V+import           Data.Ord                        (Down (..))+import qualified Data.Vector                     as V import           Data.Vinyl.CoRec  --------------------------------------------------------------------------------@@ -97,7 +98,7 @@ computeSegsAndParts rect ls = ( segs <> boundarySegs, parts')   where     segs         = map (&extra %~ Just)-                 . concatMap (\(l,ls') -> perLine rect l ls') $ makePairs ls+                 . concatMap (uncurry (perLine rect)) $ makePairs ls     boundarySegs = map (:+ Nothing) . toSegments . dupFirst $ map fst parts'     dupFirst = \case []       -> []                      xs@(x:_) -> xs ++ [x]@@ -112,7 +113,7 @@     rmDuplicates = map head . List.group     vs  = mapMaybe (m `intersectionPoint`) ls     vs' = maybe [] (\(p,q) -> [p,q]) . asA @(Point 2 r, Point 2 r)-        $ (m^.core) `intersect` (Boundary b)+        $ (m^.core) `intersect` Boundary b   intersectionPoint                   :: forall r l. (Ord r, Fractional r)@@ -121,7 +122,7 @@   toSegments      :: Ord r => [Point 2 r] -> [LineSegment 2 () r]-toSegments ps = let pts = map ext $ ps in+toSegments ps = let pts = map ext ps in   zipWith ClosedLineSegment pts (tail pts)  @@ -181,7 +182,7 @@                        => [Line 2 r :+ l] -> LineSegment 2 q r                        -> [(Point 2 r, Line 2 r :+ l)] sideIntersections ls s = let l   = supportingLine s :+ undefined-                         in List.sortOn fst . filter (flip onSegment s . fst)+                         in List.sortOn fst . filter ((`intersects` s) . fst)                           . mapMaybe (\m -> (,m) <$> l `intersectionPoint` m) $ ls  -- | Constructs the unbounded intersections. Reported in clockwise direction.@@ -192,8 +193,8 @@ unBoundedParts rect ls = [tl] <> t <> [tr] <> reverse r <> [br] <> reverse b <> [bl] <> l   where     sideIntersections' = over (traverse._2) Just . sideIntersections ls-    Sides t r b l       = fmap sideIntersections'      $ sides   rect-    Corners tl tr br bl = fmap ((,Nothing) . (^.core)) $ corners rect+    Sides t r b l       = sideIntersections'    <$> sides   rect+    Corners tl tr br bl = (,Nothing) . (^.core) <$> corners rect   -- | Links the vertices  of the outer boundary with those in the subdivision@@ -212,10 +213,10 @@ makePairs = go   where     go []     = []-    go (x:xs) = (x,xs) : map (\(y,ys) -> (y,x:ys)) (go xs)+    go (x:xs) = (x,xs) : map (second (x:)) (go xs) -allPairs    :: [a] -> [(a,a)]-allPairs ys = go ys+allPairs :: [a] -> [(a,a)]+allPairs = go   where     go []     = []     go (x:xs) = map (x,) xs ++ go xs@@ -244,7 +245,7 @@                 => Line 2 r -> Arrangement s l v (Maybe e) f r -> Maybe (Dart s) findStart l arr = do     (p,_)   <- asA @(Point 2 r, Point 2 r) $-                 l `intersect` (Boundary $ arr^.boundedArea)+                 l `intersect` Boundary (arr^.boundedArea)     (_,v,_) <- findStartVertex p arr     findStartDart (arr^.subdivision) v @@ -264,13 +265,13 @@                       -> Maybe (Point 2 r, VertexId' s, Maybe (Line 2 r :+ l)) findStartVertex p arr = do     ss <- findSide p-    i  <- binarySearchVec (pred' ss) (arr^.unboundedIntersections)+    i  <- binarySearchIdxIn (pred' ss) (arr^.unboundedIntersections)     pure $ arr^.unboundedIntersections.singular (ix i)   where     Sides t r b l = sides'' $ arr^.boundedArea     sides''       = fmap (\(ClosedLineSegment a c) -> LineSegment (Closed a) (Open c)) . sides -    findSide q = fmap fst . List.find (onSegment q . snd) $ zip [1..] [t,r,b,l]+    findSide q = fmap fst . List.find (intersects q. snd) $ zip [1..] [t,r,b,l]      pred' ss (q,_,_) = let Just j = findSide q                            x      = before (ss,p) (j,q)
src/Data/Geometry/Ball.hs view
@@ -75,6 +75,7 @@  -- * Querying if a point lies in a ball +-- | Query location of a point relative to a d-dimensional ball. inBall                 :: (Arity d, Ord r, Num r)                        => Point d r -> Ball d p r -> PointLocationResult p `inBall` (Ball c sr) = case qdA p (c^.core) `compare` sr of@@ -148,17 +149,18 @@ pattern Circle c r = Sphere c r {-# COMPLETE Circle #-} +{- HLINT ignore disk -} -- | Given three points, get the disk through the three points. If the three -- input points are colinear we return Nothing -- -- >>> disk (Point2 0 10) (Point2 10 0) (Point2 (-10) 0)--- Just (Ball {_center = Point2 [0.0,0.0] :+ (), _squaredRadius = 100.0})+-- Just (Ball {_center = Point2 0.0 0.0 :+ (), _squaredRadius = 100.0}) disk       :: (Eq r, Fractional r)            => Point 2 r -> Point 2 r -> Point 2 r -> Maybe (Disk () r) disk p q r = match (f p `intersect` f q) $-       (H $ \NoIntersection -> Nothing)-    :& (H $ \c@(Point _)    -> Just $ Ball (ext c) (qdA c p))-    :& (H $ \_              -> Nothing)+       H (\NoIntersection -> Nothing)+    :& H (\c@Point{}      -> Just $ Ball (ext c) (qdA c p))+    :& H (\_              -> Nothing)     :& RNil        -- If the intersection is not a point, The two lines f p and f q are        -- parallel, that means the three input points where colinear.@@ -196,7 +198,7 @@                                                        ]  -instance (Ord r, Floating r) => (Line 2 r) `IsIntersectableWith` (Circle p r) where+instance (Ord r, Floating r) => Line 2 r `IsIntersectableWith` Circle p r where    nonEmptyIntersection = defaultNonEmptyIntersection @@ -238,16 +240,16 @@                                                                 ]  -instance (Ord r, Floating r) => (LineSegment 2 p r) `IsIntersectableWith` (Circle q r) where+instance (Ord r, Floating r) => LineSegment 2 p r `IsIntersectableWith` Circle q r where    nonEmptyIntersection = defaultNonEmptyIntersection    s `intersect` c = match (supportingLine s `intersect` c) $-       (H $ \NoIntersection -> coRec NoIntersection)-    :& (H $ \(Touching p)   -> if p `onSegment` s then coRec $ Touching p+       H (\NoIntersection -> coRec NoIntersection)+    :& H (\(Touching p)   -> if p `intersects` s then coRec $ Touching p                                                  else  coRec   NoIntersection        )-    :& (H $ \(p,q)          -> case (p `onSegment` s, q `onSegment` s) of+    :& H (\(p,q)          -> case (p `intersects` s, q `intersects` s) of                                  (False,False) -> coRec NoIntersection                                  (False,True)  -> coRec q                                  (True, False) -> coRec p
src/Data/Geometry/BezierSpline.hs view
@@ -1,5 +1,11 @@ {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE TemplateHaskell #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.BezierSpline+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.BezierSpline(     BezierSpline (BezierSpline)   , controlPoints@@ -34,18 +40,22 @@  -- | Datatype representing a Bezier curve of degree \(n\) in \(d\)-dimensional space. newtype BezierSpline n d r = BezierSpline { _controlPoints :: LSeq (1+n) (Point d r) }-makeLenses ''BezierSpline+-- makeLenses ''BezierSpline +-- | Bezier control points. With n degrees, there are n+1 control points.+controlPoints :: Iso (BezierSpline n1 d1 r1) (BezierSpline n2 d2 r2) (LSeq (1+n1) (Point d1 r1)) (LSeq (1+n2) (Point d2 r2))+controlPoints = iso _controlPoints BezierSpline+ -- | Quadratic Bezier Spline pattern Bezier2      :: Point d r -> Point d r -> Point d r -> BezierSpline 2 d r-pattern Bezier2 p q r <- ((F.toList . LSeq.take 3 . _controlPoints) -> [p,q,r])+pattern Bezier2 p q r <- (F.toList . LSeq.take 3 . _controlPoints -> [p,q,r])   where     Bezier2 p q r = fromPointSeq . Seq.fromList $ [p,q,r] {-# COMPLETE Bezier2 #-}  -- | Cubic Bezier Spline pattern Bezier3         :: Point d r -> Point d r -> Point d r -> Point d r -> BezierSpline 3 d r-pattern Bezier3 p q r s <- ((F.toList . LSeq.take 4 . _controlPoints) -> [p,q,r,s])+pattern Bezier3 p q r s <- (F.toList . LSeq.take 4 . _controlPoints -> [p,q,r,s])   where     Bezier3 p q r s = fromPointSeq . Seq.fromList $ [p,q,r,s] {-# COMPLETE Bezier3 #-}@@ -97,7 +107,7 @@      blend p q = p .+^ t *^ (q .-. p) -+-- | Tangent to the bezier spline at the starting point. tangent   :: (Arity d, Num r, 1 <= n) => BezierSpline n d r -> Vector d r tangent b = b^?!controlPoints.ix 1  .-. b^?!controlPoints.ix 0
src/Data/Geometry/Boundary.hs view
@@ -1,3 +1,10 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.Boundary+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.Boundary where  import Control.Lens (iso,Iso)
src/Data/Geometry/Box/Corners.hs view
@@ -1,4 +1,11 @@ {-# LANGUAGE TemplateHaskell  #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.Box.Corners+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.Box.Corners( Corners(Corners), northWest, northEast, southEast, southWest                                 , corners, cornersInDirection                                 ) where@@ -51,6 +58,7 @@  -------------------------------------------------------------------------------- +{- HLINT ignore corners -} -- | Get the corners of a rectangle, the order is: -- (TopLeft, TopRight, BottomRight, BottomLeft). -- The extra values in the Top points are taken from the Top point,@@ -59,8 +67,8 @@ corners r     = let w = width r                     p = (_maxP r)&core %~ _cwMax                     q = (_minP r)&core %~ _cwMin-                in Corners (p&core.xCoord %~ (subtract w)) p-                           (q&core.xCoord %~ (+ w))        q+                in Corners (p&core.xCoord %~ subtract w) p+                           (q&core.xCoord %~ (+ w))      q   --------------------------------------------------------------------------------
src/Data/Geometry/Box/Internal.hs view
@@ -89,6 +89,7 @@                   in fromExtent $ FV.zipWith f (toVec c) ((/2) <$> ws)  +{- HLINT ignore centerPoint -} -- | Center of the box centerPoint   :: (Arity d, Fractional r) => Box d p r -> Point d r centerPoint b = Point $ w V.^/ 2@@ -105,7 +106,7 @@  type instance IntersectionOf (Box d p r) (Box d q r) = '[ NoIntersection, Box d () r] -instance (Ord r, Arity d) => (Box d p r) `IsIntersectableWith` (Box d q r) where+instance (Ord r, Arity d) => Box d p r `IsIntersectableWith` Box d q r where   nonEmptyIntersection = defaultNonEmptyIntersection    bx `intersect` bx' = f . sequence $ FV.zipWith intersect' (extent bx) (extent bx')@@ -144,7 +145,7 @@  type instance IntersectionOf (Point d r) (Box d p r) = '[ NoIntersection, Point d r] -instance (Arity d, Ord r) => (Point d r) `IsIntersectableWith` (Box d p r) where+instance (Arity d, Ord r) => Point d r `IsIntersectableWith` Box d p r where   nonEmptyIntersection = defaultNonEmptyIntersection   p `intersect` b     | not $ p `inBox` b = coRec NoIntersection@@ -187,12 +188,25 @@ inBox :: (Arity d, Ord r) => Point d r -> Box d p r -> Bool p `inBox` b = FV.and . FV.zipWith R.inRange (toVec p) . extent $ b ++-- | Check if a point lies strictly inside a box (i.e. not on its boundary)+--+-- >>> origin `inBox` (boundingBoxList' [Point3 1 2 3, Point3 10 20 30] :: Box 3 () Int)+-- False+-- >>> origin `inBox` (boundingBoxList' [Point3 (-1) (-2) (-3), Point3 10 20 30] :: Box 3 () Int)+-- True+insideBox :: (Arity d, Ord r) => Point d r -> Box d p r -> Bool+p `insideBox` b = FV.and . FV.zipWith R.inRange (toVec p) . fmap toOpenRange . extent $ b+  where+    toOpenRange (R.Range' l r) = R.OpenRange l r++ -- | Get a vector with the extent of the box in each dimension. Note that the -- resulting vector is 0 indexed whereas one would normally count dimensions -- starting at zero. -- -- >>> extent (boundingBoxList' [Point3 1 2 3, Point3 10 20 30] :: Box 3 () Int)--- Vector3 [Range (Closed 1) (Closed 10),Range (Closed 2) (Closed 20),Range (Closed 3) (Closed 30)]+-- Vector3 (Range (Closed 1) (Closed 10)) (Range (Closed 2) (Closed 20)) (Range (Closed 3) (Closed 30)) extent                                 :: Arity d                                        => Box d p r -> Vector d (R.Range r) extent (Box (CWMin a :+ _) (CWMax b :+ _)) = FV.zipWith R.ClosedRange (toVec a) (toVec b)@@ -201,7 +215,7 @@ -- whereas one would normally count dimensions starting at zero. -- -- >>> size (boundingBoxList' [origin, Point3 1 2 3] :: Box 3 () Int)--- Vector3 [1,2,3]+-- Vector3 1 2 3 size :: (Arity d, Num r) => Box d p r -> Vector d r size = fmap R.width . extent @@ -233,6 +247,7 @@  type Rectangle = Box 2 +-- | -- >>> width (boundingBoxList' [origin, Point2 1 2] :: Rectangle () Int) -- 1 -- >>> width (boundingBoxList' [origin] :: Rectangle () Int)@@ -240,6 +255,7 @@ width :: Num r => Rectangle p r -> r width = widthIn (C :: C 1) +-- | -- >>> height (boundingBoxList' [origin, Point2 1 2] :: Rectangle () Int) -- 2 -- >>> height (boundingBoxList' [origin] :: Rectangle () Int)@@ -256,7 +272,7 @@ class IsBoxable g where   boundingBox :: Ord (NumType g) => g -> Box (Dimension g) () (NumType g) -+-- | Create a bounding box that encapsulates a list of objects. boundingBoxList :: (IsBoxable g, F.Foldable1 c, Ord (NumType g), Arity (Dimension g))                 => c g -> Box (Dimension g) () (NumType g) boundingBoxList = F.foldMap1 boundingBox
src/Data/Geometry/Box/Sides.hs view
@@ -1,4 +1,11 @@ {-# LANGUAGE TemplateHaskell  #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.Box.Sides+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.Box.Sides( Sides(Sides), north, east, south, west                               , topSide, bottomSide, leftSide, rightSide                               , sides, sides'
src/Data/Geometry/Directions.hs view
@@ -1,22 +1,29 @@-{-# LANGUAGE TemplateHaskell  #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.Directions+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--+-------------------------------------------------------------------------------- module Data.Geometry.Directions( CardinalDirection(..)-                               , _North, _East, _South, _West+                               -- , _North, _East, _South, _West                                , oppositeDirection                                  , InterCardinalDirection(..)-                                , _NorthWest, _NorthEast, _SouthEast, _SouthWest+                                -- , _NorthWest, _NorthEast, _SouthEast, _SouthWest                                  , interCardinalsOf                                 ) where -import Control.Lens (makePrisms) import Data.Util import GHC.Generics (Generic)  -------------------------------------------------------------------------------- +-- | The four cardinal directions. data CardinalDirection = North | East | South | West deriving (Show,Read,Eq,Ord,Enum,Bounded)-makePrisms ''CardinalDirection+-- makePrisms ''CardinalDirection  -------------------------------------------------------------------------------- -- * Functions on Cardinal Directions@@ -34,7 +41,7 @@ -- | Intercardinal directions data InterCardinalDirection = NorthWest | NorthEast | SouthEast | SouthWest   deriving (Show,Read,Eq,Ord,Enum,Generic)-makePrisms ''InterCardinalDirection+-- makePrisms ''InterCardinalDirection  -------------------------------------------------------------------------------- -- * Functions on InterCardinal Directions
src/Data/Geometry/Duality.hs view
@@ -1,3 +1,10 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.Duality+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.Duality where  import Data.Geometry.Line
src/Data/Geometry/Ellipse.hs view
@@ -1,4 +1,11 @@ {-# LANGUAGE TemplateHaskell #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.Ellipse+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.Ellipse(     Ellipse(Ellipse)   , affineTransformation@@ -18,7 +25,7 @@  -------------------------------------------------------------------------------- --- | A typre representing planar ellipses+-- | A type representing planar ellipses newtype Ellipse r = Ellipse { _affineTransformation :: Transformation 2 r }                    deriving (Show,Eq,Functor,Foldable,Traversable) makeLenses ''Ellipse
src/Data/Geometry/HalfLine.hs view
@@ -1,13 +1,25 @@-{-# LANGUAGE TemplateHaskell  #-}+{-# LANGUAGE DeriveAnyClass       #-}+{-# LANGUAGE TemplateHaskell      #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE DeriveAnyClass #-}-module Data.Geometry.HalfLine where-+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.HalfLine+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--------------------------------------------------------------------------------+module Data.Geometry.HalfLine( HalfLine(HalfLine)+                             , startPoint, halfLineDirection+                             , toHalfLine+                             , halfLineToSubLine, fromSubLine+                             ) where  import           Control.DeepSeq import           Control.Lens import           Data.Ext import qualified Data.Foldable as F+import           Data.Geometry.Boundary+import           Data.Geometry.Box import           Data.Geometry.Interval import           Data.Geometry.Line import           Data.Geometry.LineSegment@@ -18,6 +30,9 @@ import           Data.Geometry.Vector import qualified Data.Traversable as T import           Data.UnBounded+import qualified Data.Vector.Fixed as FV+import           Data.Vinyl+import           Data.Vinyl.CoRec import           GHC.Generics (Generic) import           GHC.TypeLits @@ -41,6 +56,14 @@ type instance NumType   (HalfLine d r) = r  +instance {-# OVERLAPPING #-} (Eq r, Fractional r) => Eq (HalfLine 2 r) where+  (HalfLine p u) == (HalfLine q v) =+      p == q && -- Same starting point.+      isCoLinear p (Point u) (Point v) && -- Directions are on the same line.+      sameSigns -- Directions point in the same quadrant.+    where+      sameSigns = F.and $ FV.zipWith (\a b -> signum a==signum b) u v+ instance (Eq r, Fractional r, Arity d) => Eq (HalfLine d r) where   (HalfLine p u) == (HalfLine q v) = let lam = scalarMultiple u v                                      in p == q && (signum <$> lam) == Just 1@@ -77,9 +100,9 @@    (MinInfinity, Val x) -> Just $ HalfLine (pointAt x l) ((-1) *^ l^.direction)    _                    -> Nothing -type instance IntersectionOf (HalfLine 2 r) (Line 2 r) = [ NoIntersection-                                                         , Point 2 r-                                                         , HalfLine 2 r+type instance IntersectionOf (HalfLine d r) (Line d r) = [ NoIntersection+                                                         , Point d r+                                                         , HalfLine d r                                                          ]  type instance IntersectionOf (HalfLine 2 r) (HalfLine 2 r) = [ NoIntersection@@ -88,88 +111,119 @@                                                              , HalfLine 2 r                                                              ] -type instance IntersectionOf (HalfLine 2 r) (LineSegment 2 p r) = [ NoIntersection+type instance IntersectionOf (LineSegment 2 p r) (HalfLine 2 r) = [ NoIntersection                                                                   , Point 2 r                                                                   , LineSegment 2 () r                                                                   ] +type instance IntersectionOf (Point d r) (HalfLine d r) = [ NoIntersection+                                                          , Point d r+                                                          ] --- instance (Ord r, Fractional r) => (HalfLine 2 r) `IsIntersectableWith` (Line 2 r) where-  -- hl `intersect` l = match (halfLineToSubLine hl, l) +instance (Ord r, Fractional r) => HalfLine 2 r `IsIntersectableWith` Line 2 r where+  nonEmptyIntersection = defaultNonEmptyIntersection+  hl `intersect` l = match (supportingLine hl `intersect` l) $+       H (\NoIntersection -> coRec NoIntersection)+    :& H (\p              -> if onHalfLine p hl then coRec p else coRec NoIntersection)+    :& H (\_l'            -> coRec hl)+    :& RNil --- instance (Ord r, Fractional r) => (HalfLine 2 r) `IsIntersectableWith` (Line 2 r) where---   data Intersection (HalfLine 2 r) (Line 2 r) = NoHalfLineLineIntersection---                                               | HalfLineLineIntersection !(Point 2 r)---                                               | HalfLineLineOverlap      !(HalfLine 2 r)---                                               deriving (Show,Eq) ---   nonEmptyIntersection NoHalfLineLineIntersection = False---   nonEmptyIntersection _                          = True ---   hl `intersect` l = case supportingLine hl `intersect` l of---     SameLine _             -> HalfLineLineOverlap hl---     LineLineIntersection p -> if p `onHalfLine` hl then HalfLineLineIntersection p---                                                    else NoHalfLineLineIntersection---     ParallelLines          -> NoHalfLineLineIntersection+instance (Ord r, Fractional r) => HalfLine 2 r `IsIntersectableWith` HalfLine 2 r where+  nonEmptyIntersection = defaultNonEmptyIntersection+  la@(HalfLine a va) `intersect` lb@(HalfLine b vb) =+    match (supportingLine la `intersect` supportingLine lb) $+         H (\NoIntersection -> coRec NoIntersection)+      :& H (\p              -> if onHalfLine p la && onHalfLine p lb+                               then coRec p else coRec NoIntersection)+      :& H (\_line          -> case ( a `onHalfLine ` lb+                                    , b `onHalfLine ` la+                                    , va `sameDirection` vb+                                    ) of+                                 (False,False,_)   -> coRec NoIntersection+                                 (True,True,True)  -> coRec la -- exact same halfline!+                                 (True,True,False) -> coRec $ ClosedLineSegment (ext a) (ext b)+                                 (True,_,True)     -> coRec la+                                 (_,True,True)     -> coRec lb+                                 (_,_,False)       -> error "HalfLine x Halfline intersection: impossible"+                                   -- it is impossible for a to be on+                                   -- lb, while b does not lie on la, while having different+                                   -- orientations +           )+      :& RNil --- instance (Ord r, Fractional r) => (HalfLine 2 r) `IsIntersectableWith` (HalfLine 2 r) where---   data Intersection (HalfLine 2 r) (HalfLine 2 r) = NoHalfLineHalfLineIntersection---                                                   | HLHLIntersectInPoint    !(Point 2 r)---                                                   | HLHLIntersectInSegment  !(LineSegment 2 () r)---                                                   | HLHLIntersectInHalfLine !(HalfLine 2 r)---                                                   deriving (Show,Eq)+instance (Ord r, Fractional r) => LineSegment 2 () r `IsIntersectableWith` HalfLine 2 r where+  nonEmptyIntersection = defaultNonEmptyIntersection ---   nonEmptyIntersection NoHalfLineHalfLineIntersection = False---   nonEmptyIntersection _                              = True+  seg@(LineSegment s t) `intersect` hl@(HalfLine o _) =+    match (supportingLine seg `intersect` supportingLine hl) $+          H (\NoIntersection -> coRec NoIntersection)+      :&  H (\p              -> if onHalfLine p hl && p `intersects` seg then coRec p+                                                                         else coRec NoIntersection+            )+      :& H (\_line           -> case (o `intersects` seg, onHalfLine (t^.unEndPoint.core) hl) of+                                  (False,False) -> coRec NoIntersection+                                  (False,True)  -> coRec seg+                                  (True,True)   -> coRec $ LineSegment (Closed $ ext o) t+                                  (True,False)  -> coRec $ LineSegment s (Closed $ ext o)+           )+      :& RNil ---   hl' `intersect` hl = case supportingLine hl' `intersect` supportingLine hl of---     ParallelLines          -> NoHalfLineHalfLineIntersection---     LineLineIntersection p -> if p `onHalfLine` hl' && p `onHalfLine` hl then HLHLIntersectInPoint p---                                                                          else NoHalfLineHalfLineIntersection---     SameLine _             -> let p   = _startPoint hl'---                                   q   = _startPoint hl---                                   seg = LineSegment (p :+ ()) (q :+ ())---                               in case (p `onHalfLine` hl, q `onHalfLine` hl') of---                                    (False,False) -> NoHalfLineHalfLineIntersection---                                    (False,True)  -> HLHLIntersectInHalfLine hl---                                    (True, False) -> HLHLIntersectInHalfLine hl'---                                    (True, True)  -> if hl == hl' then HLHLIntersectInHalfLine hl---                                                                  else HLHLIntersectInSegment seg +instance (Ord r, Fractional r, Arity d) => Point d r `IsIntersectableWith` HalfLine d r where+  nonEmptyIntersection = defaultNonEmptyIntersection+  intersects = onHalfLine+  p `intersect` hl | p `intersects` hl = coRec p+                   | otherwise         = coRec NoIntersection  --- instance (Ord r, Fractional r) => (LineSegment 2 p r) `IsIntersectableWith` (HalfLine 2 r) where---   data Intersection (LineSegment 2 p r) (HalfLine 2 r) = NoSegmentHalfLineIntersection---                                                        | SegmentHalfLineIntersection !(Point 2 r)---                                                        | SegmentOnHalfLine           !(LineSegment 2 () r) ---   nonEmptyIntersection NoSegmentHalfLineIntersection = False---   nonEmptyIntersection _                             = True+type instance IntersectionOf (HalfLine 2 r) (Boundary (Rectangle p r)) =+  [ NoIntersection, Point 2 r, (Point 2 r, Point 2 r) , LineSegment 2 () r] ---   s `intersect` hl = case supportingLine s `intersect` supportingLine hl of---     ParallelLines          -> NoSegmentHalfLineIntersection---     LineLineIntersection p -> if p `onSegment` s && p `onHalfLine` hl then SegmentHalfLineIntersection p---                                                                       else NoSegmentHalfLineIntersection---     SameLine _             -> let p = s  ^.start.core---                                   q = s  ^.end.core---                                   r = hl ^.start.core---                                   seg a b = LineSegment (a :+ ()) (b :+ ())---                               in case (p `onHalfLine` hl, q `onHalfLine` hl) of---                                    (False, False)   -> NoSegmentHalfLineIntersection---                                    (False, True)    -> SegmentOnHalfLine $ seg r q---                                    (True,  False)   -> SegmentOnHalfLine $ seg p r---                                    (True,  True)    -> SegmentOnHalfLine $ seg p q+type instance IntersectionOf (HalfLine 2 r) (Rectangle p r) = [ NoIntersection+                                                              , Point 2 r+                                                              , LineSegment 2 () r+                                                              ] +instance (Ord r, Fractional r)+         => HalfLine 2 r `IsIntersectableWith` Boundary (Rectangle p r) where+  nonEmptyIntersection = defaultNonEmptyIntersection +  hl@(HalfLine o v) `intersect` br = match (Line o v `intersect` br) $+       H coRec -- NoIntersection+    :& H (\p -> if p `intersects` hl then coRec p else coRec NoIntersection)+    :& H (\(p,q) -> case (p `intersects` hl, q `intersects` hl) of+                      (False,False) -> coRec NoIntersection+                      (False,True)  -> coRec q+                      (True,False)  -> coRec p+                      (True,True)   -> coRec (p,q))+    :& H (\s@(LineSegment' p q) -> case ((p^.core) `intersects` hl, (q^.core) `intersects` hl) of+                      (False,False) -> coRec NoIntersection+                      (False,True)  -> coRec $ ClosedLineSegment (ext o) q+                      (True,False)  -> coRec $ ClosedLineSegment (ext o) p+                      (True,True)   -> coRec s)+    :& RNil +instance (Ord r, Fractional r)+         => HalfLine 2 r `IsIntersectableWith` Rectangle p r where+  nonEmptyIntersection = defaultNonEmptyIntersection +  hl@(HalfLine o _) `intersect` rect  = match (hl `intersect` Boundary rect) $+       H coRec -- NoIntersection+    :& H (\p -> if o `insideBox` rect then coRec (ClosedLineSegment (ext o) (ext p))+                                      else coRec p -- p is on the boundary+         )+    :& H (\(p,q) -> coRec $ ClosedLineSegment (ext p) (ext q))+    :& H coRec -- LineSegment+    :& RNil+ -- | Test if a point lies on a half-line onHalfLine :: (Ord r, Fractional r, Arity d) => Point d r -> HalfLine d r -> Bool p `onHalfLine` (HalfLine q v) = maybe False (>= 0) $ scalarMultiple (p .-. q) v--
src/Data/Geometry/HalfSpace.hs view
@@ -59,7 +59,7 @@ instance (Arity d, Eq r, Fractional r) => Eq (HalfSpace d r) where   (HalfSpace h) == (HalfSpace h') = let u = h^.normalVec                                         v = h'^.normalVec-                                        d = quadrance (u ^+^ v) - (quadrance u)+                                        d = quadrance (u ^+^ v) - quadrance u                                     in h == h' && signum d == 1  --------------------------------------------------------------------------------@@ -67,18 +67,18 @@ type HalfPlane = HalfSpace 2  -+{- HLINT ignore leftOf -} -- | Get the halfplane left of a line (i.e. "above") a line -- -- >>> leftOf $ horizontalLine 4--- HalfSpace {_boundingPlane = HyperPlane {_inPlane = Point2 [0,4], _normalVec = Vector2 [0,1]}}+-- HalfSpace {_boundingPlane = HyperPlane {_inPlane = Point2 0 4, _normalVec = Vector2 0 1}} leftOf   :: Num r => Line 2 r -> HalfPlane r leftOf l = (rightOf l)&boundingPlane.normalVec %~ ((-1) *^)  -- | Get the halfplane right of a line (i.e. "below") a line -- -- >>> rightOf $ horizontalLine 4--- HalfSpace {_boundingPlane = HyperPlane {_inPlane = Point2 [0,4], _normalVec = Vector2 [0,-1]}}+-- HalfSpace {_boundingPlane = HyperPlane {_inPlane = Point2 0 4, _normalVec = Vector2 0 (-1)}} rightOf   :: Num r => Line 2 r -> HalfPlane r rightOf l = HalfSpace $ l^.re _asLine @@ -116,13 +116,13 @@   nonEmptyIntersection = defaultNonEmptyIntersection    l@(Line o v) `intersect` h = match (l `intersect` m) $-         (H $ \NoIntersection -> if o `intersects` h+         H (\NoIntersection -> if o `intersects` h                                    then coRec l                                    else coRec NoIntersection)-      :& (H $ \p              -> if (p .+^ v) `intersects` h+      :& H (\p              -> if (p .+^ v) `intersects` h                                    then coRec $ HalfLine p v                                    else coRec $ HalfLine p ((-1) *^ v))-      :& (H $ \_l             -> coRec l)+      :& H (\_l             -> coRec l)       :& RNil     where       m = h^.boundingPlane._asLine
src/Data/Geometry/HyperPlane.hs view
@@ -1,6 +1,13 @@ {-# LANGUAGE DeriveAnyClass  #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TemplateHaskell  #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.HyperPlane+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.HyperPlane where  import Control.DeepSeq@@ -77,7 +84,7 @@ -- the normal vector of the resulting plane is pointing "upwards". -- -- >>> from3Points origin (Point3 1 0 0) (Point3 0 1 0)--- HyperPlane {_inPlane = Point3 [0,0,0], _normalVec = Vector3 [0,0,1]}+-- HyperPlane {_inPlane = Point3 0 0 0, _normalVec = Vector3 0 0 1} from3Points       :: Num r => Point 3 r -> Point 3 r -> Point 3 r -> HyperPlane 3 r from3Points p q r = let u = q .-. p                         v = r .-. p@@ -97,7 +104,7 @@  type instance IntersectionOf (Line 3 r) (Plane r) = [NoIntersection, Point 3 r, Line 3 r] -instance (Eq r, Fractional r) => (Line 3 r) `IsIntersectableWith` (Plane r) where+instance (Eq r, Fractional r) => Line 3 r `IsIntersectableWith` Plane r where   nonEmptyIntersection = defaultNonEmptyIntersection   l@(Line p v) `intersect` (HyperPlane q n)       | denum == 0 = if num == 0 then coRec l else coRec NoIntersection@@ -140,7 +147,7 @@ -- y-axis. -- -- >>> planeCoordinatesWith (Plane origin (Vector3 0 0 1)) (Vector3 0 1 0) (Point3 10 10 0)--- Point2 [10.0,10.0]+-- Point2 10.0 10.0 planeCoordinatesWith       :: Fractional r => Plane r -> Vector 3 r -> Point 3 r -> Point 2 r planeCoordinatesWith h vup = projectPoint . transformBy (planeCoordinatesTransform h vup)
src/Data/Geometry/Interval.hs view
@@ -1,15 +1,17 @@-{-# LANGUAGE TemplateHaskell  #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.Interval+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.Interval(-                             -- * 1 dimensional Intervals-                               Interval+                               -- * 1 dimensional Intervals+                               Interval (Interval, OpenInterval,ClosedInterval)                              , fromRange, toRange                              , _Range -                             , pattern OpenInterval-                             , pattern ClosedInterval-                             , pattern Interval--                             -- * querying the start and end of intervals+                               -- * querying the start and end of intervals                              , HasStart(..), HasEnd(..)                              -- * Working with intervals                              , inInterval@@ -21,18 +23,18 @@                              ) where  import           Control.DeepSeq-import           Control.Lens (lens, (^.),(%~),(&), Lens')+import           Control.Lens             (Iso', Lens', iso, (%~), (&), (^.)) import           Data.Bifunctor import           Data.Bitraversable import           Data.Ext-import qualified Data.Foldable as F+import qualified Data.Foldable            as F import           Data.Geometry.Properties import           Data.Range-import           Data.Semigroup(Arg(..))-import qualified Data.Traversable as T+import           Data.Semigroup           (Arg (..))+import qualified Data.Traversable         as T import           Data.Vinyl import           Data.Vinyl.CoRec-import           GHC.Generics (Generic)+import           GHC.Generics             (Generic) import           Test.QuickCheck  --------------------------------------------------------------------------------@@ -42,11 +44,16 @@ -- We can think of an interval being defined as: -- -- >>> data Interval a r = Interval (EndPoint (r :+ a)) (EndPoint (r :+ a))-newtype Interval a r = GInterval { toRange :: Range (r :+ a) }+newtype Interval a r = GInterval (Range (r :+ a))                      deriving (Eq,Generic,Arbitrary) -_Range :: Lens' (Interval a r) (Range (r :+ a))-_Range = lens toRange (const GInterval)+-- | Cast an interval to a range.+toRange :: Interval a r -> Range (r :+ a)+toRange (GInterval r) = r++-- | Intervals and ranges are isomorphic.+_Range :: Iso' (Interval a r) (Range (r :+ a))+_Range = iso toRange fromRange {-# INLINE _Range #-}  -- | Constrct an interval from a Range@@ -78,7 +85,7 @@ --  inInterval and inRange is that the extra value is *not* used in the --  comparison with inInterval, whereas it is in inRange. inInterval       :: Ord r => r -> Interval a r -> Bool-x `inInterval` r = x `inRange` (fmap (^.core) $ r^._Range )+x `inInterval` r = x `inRange` fmap (^.core) (r^._Range )   pattern OpenInterval       :: (r :+ a) -> (r :+ a) -> Interval a r@@ -122,14 +129,14 @@  type instance IntersectionOf (Interval a r) (Interval a r) = [NoIntersection, Interval a r] -instance Ord r => (Interval a r) `IsIntersectableWith` (Interval a r) where+instance Ord r => Interval a r `IsIntersectableWith` Interval a r where    nonEmptyIntersection = defaultNonEmptyIntersection    (GInterval r) `intersect` (GInterval s) = match (r' `intersect` s') $-         (H $ \NoIntersection -> coRec NoIntersection)-      :& (H $ \(Range l u)    -> coRec . GInterval $ Range (l&unEndPoint %~ g)-                                                           (u&unEndPoint %~ g) )+         H (\NoIntersection -> coRec NoIntersection)+      :& H (\(Range l u)    -> coRec . GInterval $ Range (l&unEndPoint %~ g)+                                                         (u&unEndPoint %~ g) )       :& RNil     where       f x = Arg (x^.core) x
src/Data/Geometry/Interval/Util.hs view
@@ -1,4 +1,12 @@ {-# LANGUAGE TemplateHaskell #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.Interval.Util+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--+-------------------------------------------------------------------------------- module Data.Geometry.Interval.Util where  import Control.DeepSeq
src/Data/Geometry/IntervalTree.hs view
@@ -1,4 +1,11 @@ {-# LANGUAGE TemplateHaskell #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.IntervalTree+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.IntervalTree( NodeData(..)                                  , splitPoint, intervalsLeft, intervalsRight                                  , IntervalTree(..), unIntervalTree@@ -44,8 +51,8 @@ -- -- \(O(n)\) createTree     :: Ord r => [r] -> IntervalTree i r-createTree pts = IntervalTree . asBalancedBinTree-               . map (\m -> NodeData m mempty mempty) $ pts+createTree = IntervalTree . asBalancedBinTree+             . map (\m -> NodeData m mempty mempty)   -- | Build an interval tree
src/Data/Geometry/KDTree.hs view
@@ -1,25 +1,31 @@-{-# LANGUAGE UndecidableInstances  #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE UndecidableInstances #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.KDTree+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.KDTree where -import           Control.Lens hiding (imap, element, Empty, (:<))+import           Control.Lens             hiding (Empty, element, imap, (:<)) import           Data.BinaryTree-import           Unsafe.Coerce(unsafeCoerce) import           Data.Ext-import qualified Data.Foldable as F+import qualified Data.Foldable            as F import           Data.Geometry.Box import           Data.Geometry.Point import           Data.Geometry.Properties import           Data.Geometry.Vector-import qualified Data.List.NonEmpty as NonEmpty-import           Data.Maybe (fromJust)+import           Data.LSeq                (LSeq, pattern (:<|))+import qualified Data.LSeq                as LSeq+import qualified Data.List.NonEmpty       as NonEmpty import           Data.Proxy-import           Data.LSeq (LSeq, pattern (:<|))-import qualified Data.LSeq as LSeq import           Data.Util-import qualified Data.Vector.Fixed as FV+import qualified Data.Vector.Fixed        as FV import           GHC.TypeLits-import           Prelude hiding (replicate)+import           Prelude                  hiding (replicate)+import           Unsafe.Coerce            (unsafeCoerce)  -------------------------------------------------------------------------------- @@ -165,7 +171,7 @@   where     -- i = traceShow (c,j) j -    m = let xs = fromJust $ pts^?element' (i-1)+    m = let xs = pts^?!element' (i-1)         in xs `LSeq.index` (F.length xs `div` 2)      -- Since the input seq has >= 2 elems, F.length xs / 2 >= 1. It follows
src/Data/Geometry/Line.hs view
@@ -48,14 +48,14 @@ type instance IntersectionOf (Point d r) (Line d r) = [NoIntersection, Point d r]  -instance (Eq r, Fractional r, Arity d) => (Point d r) `IsIntersectableWith` (Line d r) where+instance (Eq r, Fractional r, Arity d) => Point d r `IsIntersectableWith` Line d r where   nonEmptyIntersection = defaultNonEmptyIntersection   intersects = onLine   p `intersect` l | p `intersects` l = coRec p                   | otherwise        = coRec NoIntersection  instance {-# OVERLAPPING #-} (Ord r, Num r)-        => (Point 2 r) `IsIntersectableWith` (Line 2 r) where+        => Point 2 r `IsIntersectableWith` Line 2 r where   nonEmptyIntersection = defaultNonEmptyIntersection   intersects = onLine2   p `intersect` l | p `intersects` l = coRec p@@ -67,7 +67,7 @@   instance (Ord r, Fractional r)-         => (Line 2 r) `IsIntersectableWith` (Boundary (Rectangle p r)) where+         => Line 2 r `IsIntersectableWith` Boundary (Rectangle p r) where   nonEmptyIntersection = defaultNonEmptyIntersection    line' `intersect` (Boundary rect)  = case asAP segP of@@ -104,12 +104,12 @@   instance (Ord r, Fractional r)-         => (Line 2 r) `IsIntersectableWith` (Rectangle p r) where+         => Line 2 r `IsIntersectableWith` Rectangle p r where   nonEmptyIntersection = defaultNonEmptyIntersection -  line' `intersect` rect  = match (line' `intersect` (Boundary rect)) $-       (H $ \NoIntersection -> coRec NoIntersection)-    :& (H $ \p@(Point2 _ _) -> coRec p)-    :& (H $ \(p,q)          -> coRec $ ClosedLineSegment (ext p) (ext q))-    :& (H $ \s              -> coRec s)+  line' `intersect` rect  = match (line' `intersect` Boundary rect) $+       H coRec -- NoIntersection+    :& H coRec -- Point2+    :& H (\(p,q)          -> coRec $ ClosedLineSegment (ext p) (ext q))+    :& H coRec -- LineSegment     :& RNil
src/Data/Geometry/Line/Internal.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE TemplateHaskell  #-} {-# LANGUAGE DeriveAnyClass  #-} {-# LANGUAGE UndecidableInstances #-} --------------------------------------------------------------------------------@@ -34,8 +33,15 @@ data Line d r = Line { _anchorPoint :: !(Point  d r)                      , _direction   :: !(Vector d r)                      } deriving Generic-makeLenses ''Line +-- | Line anchor point.+anchorPoint :: Lens' (Line d r) (Point d r)+anchorPoint = lens _anchorPoint (\line pt -> line{_anchorPoint=pt})++-- | Line direction.+direction :: Lens' (Line d r) (Vector d r)+direction = lens _direction (\line dir -> line{_direction=dir})+ instance (Show r, Arity d) => Show (Line d r) where   show (Line p v) = concat [ "Line (", show p, ") (", show v, ")" ] @@ -69,9 +75,11 @@ lineThrough     :: (Num r, Arity d) => Point d r -> Point d r -> Line d r lineThrough p q = Line p (q .-. p) +-- | Vertical line with a given X-coordinate. verticalLine   :: Num r => r -> Line 2 r verticalLine x = Line (Point2 x 0) (Vector2 0 1) +-- | Horizontal line with a given Y-coordinate. horizontalLine   :: Num r => r -> Line 2 r horizontalLine y = Line (Point2 0 y) (Vector2 1 0) @@ -80,7 +88,7 @@ -- oriented such that v points into the left halfplane of m. -- -- >>> perpendicularTo $ Line (Point2 3 4) (Vector2 (-1) 2)--- Line (Point2 [3,4]) (Vector2 [-2,-1])+-- Line (Point2 3 4) (Vector2 (-2) (-1)) perpendicularTo                           :: Num r => Line 2 r -> Line 2 r perpendicularTo (Line p ~(Vector2 vx vy)) = Line p (Vector2 (-vy) vx) @@ -137,15 +145,24 @@ toOffset p (Line q v) = scalarMultiple (p .-. q) v  --- | Given point p *on* a line (Line q v), Get the scalar lambda s.t.--- p = q + lambda v. (So this is an unsafe version of 'toOffset')+-- | Given point p near a line (Line q v), get the scalar lambda s.t.+-- the distance between 'p' and 'q + lambda v' is minimized. ----- pre: the input point p lies on the line l.+-- >>> toOffset' (Point2 1 1) (lineThrough origin $ Point2 10 10)+-- 0.1+--+-- >>> toOffset' (Point2 5 5) (lineThrough origin $ Point2 10 10)+-- 0.5+--+-- \<6,4\> is not on the line but we can still point closest to it.+-- >>> toOffset' (Point2 6 4) (lineThrough origin $ Point2 10 10)+-- 0.5 toOffset'             :: (Eq r, Fractional r, Arity d) => Point d r -> Line d r -> r-toOffset' p = fromJust' . toOffset p-  where-    fromJust' (Just x) = x-    fromJust' _        = error "toOffset: Nothing"+toOffset' p (Line q v) = dot (p .-. q) v / quadrance v+-- toOffset' p = fromJust' . toOffset p+--   where+--     fromJust' (Just x) = x+--     fromJust' _        = error "toOffset: Nothing"   -- | The intersection of two lines is either: NoIntersection, a point or a line.@@ -154,7 +171,7 @@                                                      , Line 2 r                                                      ] -instance (Eq r, Fractional r) => (Line 2 r) `IsIntersectableWith` (Line 2 r) where+instance (Eq r, Fractional r) => Line 2 r `IsIntersectableWith` Line 2 r where     nonEmptyIntersection = defaultNonEmptyIntersection@@ -207,6 +224,7 @@ fromLinearFunction     :: Num r => r -> r -> Line 2 r fromLinearFunction a b = Line (Point2 0 b) (Vector2 1 a) +{- HLINT ignore toLinearFunction -} -- | get values a,b s.t. the input line is described by y = ax + b. -- returns Nothing if the line is vertical toLinearFunction                             :: forall r. (Fractional r, Eq r)@@ -274,6 +292,9 @@ liesAbove       :: (Ord r, Num r) => Point 2 r -> Line 2 r -> Bool q `liesAbove` l = q `onSideUpDown` l == Above +-- | Test if the query point q lies (strictly) above line l+liesBelow      :: (Ord r, Num r) => Point 2 r -> Line 2 r -> Bool+q `liesBelow` l = q `onSideUpDown` l == Below  -- | Get the bisector between two points bisector     :: Fractional r => Point 2 r -> Point 2 r -> Line 2 r
src/Data/Geometry/LineSegment.hs view
@@ -10,306 +10,22 @@ -- Line segment data type and some basic functions on line segments -- ---------------------------------------------------------------------------------module Data.Geometry.LineSegment( LineSegment-                                , pattern LineSegment-                                , pattern LineSegment'-                                , pattern ClosedLineSegment-                                , pattern OpenLineSegment-                                , endPoints--                                , _SubLine-                                , module Data.Geometry.Interval---                                , toLineSegment-                                , onSegment-                                , orderedEndPoints-                                , segmentLength-                                , sqDistanceToSeg, sqDistanceToSegArg-                                , flipSegment--                                , interpolate-                                ) where--import           Control.Arrow ((&&&))-import           Control.DeepSeq-import           Control.Lens-import           Data.Ext-import qualified Data.Foldable as F-import           Data.Geometry.Box.Internal-import           Data.Geometry.Interval hiding (width, midPoint)-import           Data.Geometry.Line.Internal-import           Data.Geometry.Point-import           Data.Geometry.Properties-import           Data.Geometry.SubLine-import           Data.Geometry.Transformation-import           Data.Geometry.Vector-import           Data.Ord (comparing)-import           Data.Vinyl-import           Data.Vinyl.CoRec-import           GHC.TypeLits-import           Test.QuickCheck(Arbitrary(..))------------------------------------------------------------------------------------- * d-dimensional LineSegments----- | Line segments. LineSegments have a start and end point, both of which may--- contain additional data of type p. We can think of a Line-Segment being defined as--------- >>>  data LineSegment d p r = LineSegment (EndPoint (Point d r :+ p)) (EndPoint (Point d r :+ p))-newtype LineSegment d p r = GLineSegment { _unLineSeg :: Interval p (Point d r)}--makeLenses ''LineSegment----- | Pattern that essentially models the line segment as a:------ >>> data LineSegment d p r = LineSegment (EndPoint (Point d r :+ p)) (EndPoint (Point d r :+ p))-pattern LineSegment           :: EndPoint (Point d r :+ p)-                              -> EndPoint (Point d r :+ p)-                              -> LineSegment d p r-pattern LineSegment       s t = GLineSegment (Interval s t)-{-# COMPLETE LineSegment #-}---- | Gets the start and end point, but forgetting if they are open or closed.-pattern LineSegment'          :: Point d r :+ p-                              -> Point d r :+ p-                              -> LineSegment d p r-pattern LineSegment'      s t <- ((^.start) &&& (^.end) -> (s,t))-{-# COMPLETE LineSegment' #-}--pattern ClosedLineSegment     :: Point d r :+ p -> Point d r :+ p -> LineSegment d p r-pattern ClosedLineSegment s t = GLineSegment (ClosedInterval s t)-{-# COMPLETE ClosedLineSegment #-}--pattern OpenLineSegment     :: Point d r :+ p -> Point d r :+ p -> LineSegment d p r-pattern OpenLineSegment s t = GLineSegment (OpenInterval s t)-{-# COMPLETE OpenLineSegment #-}----type instance Dimension (LineSegment d p r) = d-type instance NumType   (LineSegment d p r) = r--instance HasStart (LineSegment d p r) where-  type StartCore  (LineSegment d p r) = Point d r-  type StartExtra (LineSegment d p r) = p-  start = unLineSeg.start--instance HasEnd (LineSegment d p r) where-  type EndCore  (LineSegment d p r) = Point d r-  type EndExtra (LineSegment d p r) = p-  end = unLineSeg.end--instance (Arbitrary r, Arbitrary p, Arity d) => Arbitrary (LineSegment d p r) where-  arbitrary = LineSegment <$> arbitrary <*> arbitrary--deriving instance (Arity d, NFData r, NFData p) => NFData (LineSegment d p r)----- | Traversal to access the endpoints. Note that this traversal--- allows you to change more or less everything, even the dimension--- and the numeric type used, but it preservers if the segment is open--- or closed.-endPoints :: Traversal (LineSegment d p r) (LineSegment d' q s)-                       (Point d r :+ p)    (Point d' s :+ q)-endPoints = \f (LineSegment p q) -> LineSegment <$> traverse f p-                                                <*> traverse f q--_SubLine :: (Num r, Arity d) => Iso' (LineSegment d p r) (SubLine d p r r)-_SubLine = iso segment2SubLine subLineToSegment-{-# INLINE _SubLine #-}--segment2SubLine    :: (Num r, Arity d)-                   => LineSegment d p r -> SubLine d p r r-segment2SubLine ss = SubLine (Line p (q .-. p)) (Interval s e)-  where-    p = ss^.start.core-    q = ss^.end.core-    (Interval a b)  = ss^.unLineSeg-    s = a&unEndPoint.core .~ 0-    e = b&unEndPoint.core .~ 1--subLineToSegment    :: (Num r, Arity d) => SubLine d p r r -> LineSegment d p r-subLineToSegment sl = let (Interval s' e') = (fixEndPoints sl)^.subRange-                          s = s'&unEndPoint %~ (^.extra)-                          e = e'&unEndPoint %~ (^.extra)-                      in LineSegment s e--instance (Num r, Arity d) => HasSupportingLine (LineSegment d p r) where-  supportingLine s = lineThrough (s^.start.core) (s^.end.core)---instance (Show r, Show p, Arity d) => Show (LineSegment d p r) where-  show ~(LineSegment p q) = concat ["LineSegment (", show p, ") (", show q, ")"]--deriving instance (Eq r, Eq p, Arity d)     => Eq (LineSegment d p r)--- deriving instance (Ord r, Ord p, Arity d)   => Ord (LineSegment d p r)-deriving instance Arity d                   => Functor (LineSegment d p)--instance PointFunctor (LineSegment d p) where-  pmap f ~(LineSegment s e) = LineSegment (s&unEndPoint.core %~ f)-                                          (e&unEndPoint.core %~ f)--instance Arity d => IsBoxable (LineSegment d p r) where-  boundingBox l = boundingBox (l^.start.core) <> boundingBox (l^.end.core)--instance (Fractional r, Arity d, Arity (d + 1)) => IsTransformable (LineSegment d p r) where-  transformBy = transformPointFunctor--instance Arity d => Bifunctor (LineSegment d) where-  bimap f g (GLineSegment i) = GLineSegment $ bimap f (fmap g) i------ ** Converting between Lines and LineSegments---- | Directly convert a line into a line segment.-toLineSegment            :: (Monoid p, Num r, Arity d) => Line d r -> LineSegment d p r-toLineSegment (Line p v) = ClosedLineSegment (p       :+ mempty)-                                             (p .+^ v :+ mempty)---- *** Intersecting LineSegments--type instance IntersectionOf (LineSegment 2 p r) (LineSegment 2 p r) = [ NoIntersection-                                                                       , Point 2 r-                                                                       , LineSegment 2 p r-                                                                       ]--type instance IntersectionOf (LineSegment 2 p r) (Line 2 r) = [ NoIntersection-                                                              , Point 2 r-                                                              , LineSegment 2 p r-                                                              ]---instance (Ord r, Fractional r) =>-         (LineSegment 2 p r) `IsIntersectableWith` (LineSegment 2 p r) where-  nonEmptyIntersection = defaultNonEmptyIntersection--  a `intersect` b = match ((a^._SubLine) `intersect` (b^._SubLine)) $-         (H coRec)-      :& (H coRec)-      :& (H $ coRec . subLineToSegment)-      :& RNil--instance (Ord r, Fractional r) =>-         (LineSegment 2 p r) `IsIntersectableWith` (Line 2 r) where-  nonEmptyIntersection = defaultNonEmptyIntersection--  s `intersect` l = let ubSL = s^._SubLine.re _unBounded.to dropExtra-                    in match (ubSL `intersect` (fromLine l)) $-                            (H   coRec)-                         :& (H $ coRec)-                         :& (H $ const (coRec s))-                         :& RNil---- * Functions on LineSegments---- | Test if a point lies on a line segment.------ >>> (Point2 1 0) `onSegment` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))--- True--- >>> (Point2 1 1) `onSegment` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))--- False--- >>> (Point2 5 0) `onSegment` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))--- False--- >>> (Point2 (-1) 0) `onSegment` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))--- False--- >>> (Point2 1 1) `onSegment` (ClosedLineSegment (origin :+ ()) (Point2 3 3 :+ ()))--- True------ Note that the segments are assumed to be closed. So the end points lie on the segment.------ >>> (Point2 2 0) `onSegment` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))--- True--- >>> origin `onSegment` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))--- True--------- This function works for arbitrary dimensons.------ >>> (Point3 1 1 1) `onSegment` (ClosedLineSegment (origin :+ ()) (Point3 3 3 3 :+ ()))--- True--- >>> (Point3 1 2 1) `onSegment` (ClosedLineSegment (origin :+ ()) (Point3 3 3 3 :+ ()))--- False-onSegment       :: (Ord r, Fractional r, Arity d)-                => Point d r -> LineSegment d p r -> Bool-p `onSegment` l = let s          = l^.start.core-                      t          = l^.end.core-                      inRange' x = 0 <= x && x <= 1-                  in-                  if s == t -- zero length segment-                  then p == s-                  else maybe False inRange' $ scalarMultiple (p .-. s) (t .-. s)----- | The left and right end point (or left below right if they have equal x-coords)-orderedEndPoints   :: Ord r => LineSegment 2 p r -> (Point 2 r :+ p, Point 2 r :+ p)-orderedEndPoints s = if pc <= qc then (p, q) else (q,p)-  where-    p@(pc :+ _) = s^.start-    q@(qc :+ _) = s^.end----- | Length of the line segment-segmentLength                     :: (Arity d, Floating r) => LineSegment d p r -> r-segmentLength ~(LineSegment' p q) = distanceA (p^.core) (q^.core)----- | Squared distance from the point to the Segment s. The same remark as for--- the 'sqDistanceToSegArg' applies here.-sqDistanceToSeg   :: (Arity d, Fractional r, Ord r) => Point d r -> LineSegment d p r -> r-sqDistanceToSeg p = fst . sqDistanceToSegArg p----- | Squared distance from the point to the Segment s, and the point on s--- realizing it.  Note that if the segment is *open*, the closest point--- returned may be one of the (open) end points, even though technically the--- end point does not lie on the segment. (The true closest point then lies--- arbitrarily close to the end point).-sqDistanceToSegArg     :: (Arity d, Fractional r, Ord r)-                       => Point d r -> LineSegment d p r -> (r, Point d r)-sqDistanceToSegArg p s = let m  = sqDistanceToArg p (supportingLine s)-                             xs = m : map (\(q :+ _) -> (qdA p q, q)) [s^.start, s^.end]-                         in   F.minimumBy (comparing fst)-                            . filter (flip onSegment s . snd) $ xs---- | flips the start and end point of the segment-flipSegment   :: LineSegment d p r -> LineSegment d p r-flipSegment s = let p = s^.start-                    q = s^.end-                in (s&start .~ q)&end .~ p---- testSeg :: LineSegment 2 () Rational--- testSeg = LineSegment (Open $ ext origin)  (Closed $ ext (Point2 10 0))---- horL' :: Line 2 Rational--- horL' = horizontalLine 0---- testI = testSeg `intersect` horL'-+module Data.Geometry.LineSegment+  ( LineSegment(LineSegment, LineSegment', ClosedLineSegment, OpenLineSegment)+  , endPoints --- ff = bimap (fmap Val) (const ())+  , _SubLine+  , module Data.Geometry.Interval --- ss' = let (LineSegment p q) = testSeg in---       LineSegment (p&unEndPoint %~ ff)---                   (q&unEndPoint %~ ff)+  , toLineSegment+  , orderedEndPoints+  , segmentLength+  , sqSegmentLength+  , sqDistanceToSeg, sqDistanceToSegArg+  , flipSegment --- ss'' = ss'^._SubLine+  , interpolate, sampleLineSegment+  ) where --- | Linearly interpolate the two endpoints with a value in the range [0,1]------ >>> interpolate 0.5 $ ClosedLineSegment (ext $ origin) (ext $ Point2 10.0 10.0)--- Point2 [5.0,5.0]--- >>> interpolate 0.1 $ ClosedLineSegment (ext $ origin) (ext $ Point2 10.0 10.0)--- Point2 [1.0,1.0]--- >>> interpolate 0 $ ClosedLineSegment (ext $ origin) (ext $ Point2 10.0 10.0)--- Point2 [0.0,0.0]--- >>> interpolate 1 $ ClosedLineSegment (ext $ origin) (ext $ Point2 10.0 10.0)--- Point2 [10.0,10.0]-interpolate                      :: (Fractional r, Arity d) => r -> LineSegment d p r -> Point d r-interpolate t (LineSegment' p q) = Point $ (asV p ^* (1-t)) ^+^ (asV q ^* t)-  where-    asV = (^.core.vector)+import Data.Geometry.Interval hiding (width, midPoint)+import Data.Geometry.LineSegment.Internal
+ src/Data/Geometry/LineSegment/Internal.hs view
@@ -0,0 +1,406 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.LineSegment.Internal+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--+-- Line segment data type and some basic functions on line segments+--+--------------------------------------------------------------------------------+module Data.Geometry.LineSegment.Internal+  ( LineSegment(LineSegment, LineSegment', ClosedLineSegment, OpenLineSegment)+  , endPoints++  , _SubLine+  , module Data.Geometry.Interval+++  , toLineSegment+  , onSegment, onSegment2+  , orderedEndPoints+  , segmentLength+  , sqSegmentLength+  , sqDistanceToSeg, sqDistanceToSegArg+  , flipSegment++  , interpolate+  , validSegment+  , sampleLineSegment+  ) where++import           Control.Arrow ((&&&))+import           Control.DeepSeq+import           Control.Lens+import           Control.Monad.Random+import           Data.Ext+import qualified Data.Foldable as F+import           Data.Geometry.Box.Internal+import           Data.Geometry.Interval hiding (width, midPoint)+import           Data.Geometry.Line.Internal+import           Data.Geometry.Point+import           Data.Geometry.Properties+import           Data.Geometry.SubLine+import           Data.Geometry.Transformation+import           Data.Geometry.Vector+import           Data.Ord (comparing)+import           Data.Vinyl+import           Data.Vinyl.CoRec+import           GHC.TypeLits+import           Test.QuickCheck (Arbitrary(..), suchThatMap)+import           Text.Read++--------------------------------------------------------------------------------+-- * d-dimensional LineSegments+++-- | Line segments. LineSegments have a start and end point, both of which may+-- contain additional data of type p. We can think of a Line-Segment being defined as+--+--+-- >>>  data LineSegment d p r = LineSegment (EndPoint (Point d r :+ p)) (EndPoint (Point d r :+ p))+--+-- it is assumed that the two endpoints of the line segment are disjoint. This is not checked.+newtype LineSegment d p r = GLineSegment { _unLineSeg :: Interval p (Point d r) }++makeLenses ''LineSegment+++pattern LineSegment           :: EndPoint (Point d r :+ p)+                              -> EndPoint (Point d r :+ p)+                              -> LineSegment d p r+pattern LineSegment       s t = GLineSegment (Interval s t)+{-# COMPLETE LineSegment #-}++-- | Gets the start and end point, but forgetting if they are open or closed.+pattern LineSegment'          :: Point d r :+ p+                              -> Point d r :+ p+                              -> LineSegment d p r+pattern LineSegment'      s t <- ((^.start) &&& (^.end) -> (s,t))+{-# COMPLETE LineSegment' #-}++pattern ClosedLineSegment     :: Point d r :+ p -> Point d r :+ p -> LineSegment d p r+pattern ClosedLineSegment s t = GLineSegment (ClosedInterval s t)+{-# COMPLETE ClosedLineSegment #-}++pattern OpenLineSegment     :: Point d r :+ p -> Point d r :+ p -> LineSegment d p r+pattern OpenLineSegment s t = GLineSegment (OpenInterval s t)+{-# COMPLETE OpenLineSegment #-}++++type instance Dimension (LineSegment d p r) = d+type instance NumType   (LineSegment d p r) = r++instance HasStart (LineSegment d p r) where+  type StartCore  (LineSegment d p r) = Point d r+  type StartExtra (LineSegment d p r) = p+  start = unLineSeg.start++instance HasEnd (LineSegment d p r) where+  type EndCore  (LineSegment d p r) = Point d r+  type EndExtra (LineSegment d p r) = p+  end = unLineSeg.end++instance (Arbitrary r, Arbitrary p, Eq r, Arity d) => Arbitrary (LineSegment d p r) where+  arbitrary = suchThatMap ((,) <$> arbitrary <*> arbitrary)+                          (uncurry validSegment)+++deriving instance (Arity d, NFData r, NFData p) => NFData (LineSegment d p r)++sampleLineSegment :: (Arity d, RandomGen g, Random r) => Rand g (LineSegment d () r)+sampleLineSegment = do+  a <- ext <$> getRandom+  a' <- getRandom+  b <- ext <$> getRandom+  b' <- getRandom+  pure $ LineSegment (if a' then Open a else Closed a) (if b' then Open b else Closed b)+++{- HLINT ignore endPoints -}+-- | Traversal to access the endpoints. Note that this traversal+-- allows you to change more or less everything, even the dimension+-- and the numeric type used, but it preservers if the segment is open+-- or closed.+endPoints :: Traversal (LineSegment d p r) (LineSegment d' q s)+                       (Point d r :+ p)    (Point d' s :+ q)+endPoints = \f (LineSegment p q) -> LineSegment <$> traverse f p+                                                <*> traverse f q++_SubLine :: (Num r, Arity d) => Iso' (LineSegment d p r) (SubLine d p r r)+_SubLine = iso segment2SubLine subLineToSegment+{-# INLINE _SubLine #-}++segment2SubLine    :: (Num r, Arity d)+                   => LineSegment d p r -> SubLine d p r r+segment2SubLine ss = SubLine (Line p (q .-. p)) (Interval s e)+  where+    p = ss^.start.core+    q = ss^.end.core+    (Interval a b)  = ss^.unLineSeg+    s = a&unEndPoint.core .~ 0+    e = b&unEndPoint.core .~ 1++{- HLINT ignore subLineToSegment -}+subLineToSegment    :: (Num r, Arity d) => SubLine d p r r -> LineSegment d p r+subLineToSegment sl = let Interval s' e' = (fixEndPoints sl)^.subRange+                          s = s'&unEndPoint %~ (^.extra)+                          e = e'&unEndPoint %~ (^.extra)+                      in LineSegment s e++instance (Num r, Arity d) => HasSupportingLine (LineSegment d p r) where+  supportingLine s = lineThrough (s^.start.core) (s^.end.core)+++instance (Show r, Show p, Arity d) => Show (LineSegment d p r) where+  showsPrec d (LineSegment p' q') = case (p',q') of+      (Closed p, Closed q) -> f "ClosedLineSegment" p q+      (Open p, Open q)     -> f "OpenLineSegment"   p q+      (p,q)                -> f "LineSegment"       p q+    where+      app_prec = 10+      f        :: (Show a, Show b) => String -> a -> b -> String -> String+      f cn p q = showParen (d > app_prec) $+                     showString cn . showString " "+                   . showsPrec (app_prec+1) p+                   . showString " "+                   . showsPrec (app_prec+1) q++instance (Read r, Read p, Arity d) => Read (LineSegment d p r) where+  readPrec = parens $ (prec app_prec $ do+                                  Ident "ClosedLineSegment" <- lexP+                                  p <- step readPrec+                                  q <- step readPrec+                                  return (ClosedLineSegment p q))+                       ++++                       (prec app_prec $ do+                                  Ident "OpenLineSegment" <- lexP+                                  p <- step readPrec+                                  q <- step readPrec+                                  return (OpenLineSegment p q))+                       ++++                       (prec app_prec $ do+                                  Ident "LineSegment" <- lexP+                                  p <- step readPrec+                                  q <- step readPrec+                                  return (LineSegment p q))+    where app_prec = 10+++deriving instance (Eq r, Eq p, Arity d)     => Eq (LineSegment d p r)+-- deriving instance (Ord r, Ord p, Arity d)   => Ord (LineSegment d p r)+deriving instance Arity d                   => Functor (LineSegment d p)++instance PointFunctor (LineSegment d p) where+  pmap f ~(LineSegment s e) = LineSegment (s&unEndPoint.core %~ f)+                                          (e&unEndPoint.core %~ f)++instance Arity d => IsBoxable (LineSegment d p r) where+  boundingBox l = boundingBox (l^.start.core) <> boundingBox (l^.end.core)++instance (Fractional r, Arity d, Arity (d + 1)) => IsTransformable (LineSegment d p r) where+  transformBy = transformPointFunctor++instance Arity d => Bifunctor (LineSegment d) where+  bimap f g (GLineSegment i) = GLineSegment $ bimap f (fmap g) i++++-- ** Converting between Lines and LineSegments++-- | Directly convert a line into a line segment.+toLineSegment            :: (Monoid p, Num r, Arity d) => Line d r -> LineSegment d p r+toLineSegment (Line p v) = ClosedLineSegment (p       :+ mempty)+                                             (p .+^ v :+ mempty)++-- *** Intersecting LineSegments++type instance IntersectionOf (Point d r) (LineSegment d p r) = [ NoIntersection+                                                               , Point d r+                                                               ]++type instance IntersectionOf (LineSegment 2 p r) (LineSegment 2 p r) = [ NoIntersection+                                                                       , Point 2 r+                                                                       , LineSegment 2 p r+                                                                       ]++type instance IntersectionOf (LineSegment 2 p r) (Line 2 r) = [ NoIntersection+                                                              , Point 2 r+                                                              , LineSegment 2 p r+                                                              ]+++instance {-# OVERLAPPING #-} (Ord r, Num r)+         => Point 2 r `IsIntersectableWith` LineSegment 2 p r where+  nonEmptyIntersection = defaultNonEmptyIntersection+  intersects = onSegment2+  p `intersect` seg | p `intersects` seg = coRec p+                    | otherwise          = coRec NoIntersection++instance {-# OVERLAPPABLE #-} (Ord r, Fractional r, Arity d)+         => Point d r `IsIntersectableWith` LineSegment d p r where+  nonEmptyIntersection = defaultNonEmptyIntersection+  intersects = onSegment+  p `intersect` seg | p `intersects` seg = coRec p+                    | otherwise          = coRec NoIntersection++-- | Test if a point lies on a line segment.+--+-- As a user, you should typically just use 'intersects' instead.+onSegment :: (Ord r, Fractional r, Arity d) => Point d r -> LineSegment d p r -> Bool+p `onSegment` (LineSegment up vp) =+      maybe False inRange' (scalarMultiple (p .-. u) (v .-. u))+    where+      u = up^.unEndPoint.core+      v = vp^.unEndPoint.core++      atMostUpperBound  = if isClosed vp then (<= 1) else (< 1)+      atLeastLowerBound = if isClosed up then (0 <=) else (0 <)++      inRange' x = atLeastLowerBound x && atMostUpperBound x+  -- the type of test we use for the 2D version might actually also+  -- work in higher dimensions that might allow us to drop the+  -- Fractional constraint++++instance (Ord r, Fractional r) =>+         LineSegment 2 p r `IsIntersectableWith` LineSegment 2 p r where+  nonEmptyIntersection = defaultNonEmptyIntersection++  a `intersect` b = match ((a^._SubLine) `intersect` (b^._SubLine)) $+         H coRec+      :& H coRec+      :& H (coRec . subLineToSegment)+      :& RNil++instance (Ord r, Fractional r) =>+         LineSegment 2 p r `IsIntersectableWith` Line 2 r where+  nonEmptyIntersection = defaultNonEmptyIntersection++  s `intersect` l = let ubSL = s^._SubLine.re _unBounded.to dropExtra+                    in match (ubSL `intersect` fromLine l) $+                            H  coRec+                         :& H  coRec+                         :& H (const (coRec s))+                         :& RNil++++-- * Functions on LineSegments++-- | Test if a point lies on a line segment.+--+-- >>> (Point2 1 0) `onSegment2` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))+-- True+-- >>> (Point2 1 1) `onSegment2` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))+-- False+-- >>> (Point2 5 0) `onSegment2` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))+-- False+-- >>> (Point2 (-1) 0) `onSegment2` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))+-- False+-- >>> (Point2 1 1) `onSegment2` (ClosedLineSegment (origin :+ ()) (Point2 3 3 :+ ()))+-- True+-- >>> (Point2 2 0) `onSegment2` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))+-- True+-- >>> origin `onSegment2` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))+-- True+onSegment2                          :: (Ord r, Num r)+                                    => Point 2 r -> LineSegment 2 p r -> Bool+p `onSegment2` s@(LineSegment u v) = case ccw' (ext p) (u^.unEndPoint) (v^.unEndPoint) of+    CoLinear -> let su = p `onSide` lu+                    sv = p `onSide` lv+                in su /= sv+                && ((su == OnLine) `implies` isClosed u)+                && ((sv == OnLine) `implies` isClosed v)+    _        -> False+  where+    (Line _ w) = perpendicularTo $ supportingLine s+    lu = Line (u^.unEndPoint.core) w+    lv = Line (v^.unEndPoint.core) w++    a `implies` b = b || not a+++-- | The left and right end point (or left below right if they have equal x-coords)+orderedEndPoints   :: Ord r => LineSegment 2 p r -> (Point 2 r :+ p, Point 2 r :+ p)+orderedEndPoints s = if pc <= qc then (p, q) else (q,p)+  where+    p@(pc :+ _) = s^.start+    q@(qc :+ _) = s^.end+++-- | Length of the line segment+segmentLength                     :: (Arity d, Floating r) => LineSegment d p r -> r+segmentLength ~(LineSegment' p q) = distanceA (p^.core) (q^.core)++sqSegmentLength                     :: (Arity d, Num r) => LineSegment d p r -> r+sqSegmentLength ~(LineSegment' p q) = qdA (p^.core) (q^.core)++-- | Squared distance from the point to the Segment s. The same remark as for+-- the 'sqDistanceToSegArg' applies here.+sqDistanceToSeg   :: (Arity d, Fractional r, Ord r) => Point d r -> LineSegment d p r -> r+sqDistanceToSeg p = fst . sqDistanceToSegArg p+++-- | Squared distance from the point to the Segment s, and the point on s+-- realizing it.  Note that if the segment is *open*, the closest point+-- returned may be one of the (open) end points, even though technically the+-- end point does not lie on the segment. (The true closest point then lies+-- arbitrarily close to the end point).+sqDistanceToSegArg     :: (Arity d, Fractional r, Ord r)+                       => Point d r -> LineSegment d p r -> (r, Point d r)+sqDistanceToSegArg p s = let m  = sqDistanceToArg p (supportingLine s)+                             xs = m : map (\(q :+ _) -> (qdA p q, q)) [s^.start, s^.end]+                         in   F.minimumBy (comparing fst)+                            . filter (flip onSegment s . snd) $ xs++-- | flips the start and end point of the segment+flipSegment   :: LineSegment d p r -> LineSegment d p r+flipSegment s = let p = s^.start+                    q = s^.end+                in (s&start .~ q)&end .~ p++-- testSeg :: LineSegment 2 () Rational+-- testSeg = LineSegment (Open $ ext origin)  (Closed $ ext (Point2 10 0))++-- horL' :: Line 2 Rational+-- horL' = horizontalLine 0++-- testI = testSeg `intersect` horL'+++-- ff = bimap (fmap Val) (const ())++-- ss' = let (LineSegment p q) = testSeg in+--       LineSegment (p&unEndPoint %~ ff)+--                   (q&unEndPoint %~ ff)++-- ss'' = ss'^._SubLine++-- | Linearly interpolate the two endpoints with a value in the range [0,1]+--+-- >>> interpolate 0.5 $ ClosedLineSegment (ext $ origin) (ext $ Point2 10.0 10.0)+-- Point2 5.0 5.0+-- >>> interpolate 0.1 $ ClosedLineSegment (ext $ origin) (ext $ Point2 10.0 10.0)+-- Point2 1.0 1.0+-- >>> interpolate 0 $ ClosedLineSegment (ext $ origin) (ext $ Point2 10.0 10.0)+-- Point2 0.0 0.0+-- >>> interpolate 1 $ ClosedLineSegment (ext $ origin) (ext $ Point2 10.0 10.0)+-- Point2 10.0 10.0+interpolate                      :: (Fractional r, Arity d) => r -> LineSegment d p r -> Point d r+interpolate t (LineSegment' p q) = Point $ (asV p ^* (1-t)) ^+^ (asV q ^* t)+  where+    asV = (^.core.vector)+++-- | smart constructor that creates a valid segment, i.e. it validates+-- that the endpoints are disjoint.+validSegment     :: (Eq r, Arity d)+                 => EndPoint (Point d r :+ p) -> EndPoint (Point d r :+ p)+                 -> Maybe (LineSegment d p r)+validSegment u v = let s = LineSegment u v+                   in if s^.start.core /= s^.end.core then Just s else Nothing
src/Data/Geometry/Matrix.hs view
@@ -19,17 +19,18 @@   , HasDeterminant(..)   ) where -import           Control.Lens (imap)-import           Data.Geometry.Matrix.Internal (mkRow)+import           Control.Lens                           (imap)+import           Data.Coerce+import           Data.Geometry.Matrix.Internal          (mkRow) import           Data.Geometry.Vector-import           Linear.Matrix ((!*),(!*!))-import qualified Linear.Matrix as Lin-import           Unsafe.Coerce (unsafeCoerce)+import           Data.Geometry.Vector.VectorFamilyPeano+import           Linear.Matrix                          (M22, M33, M44, (!*!), (!*))+import qualified Linear.Matrix                          as Lin  -------------------------------------------------------------------------------- -- * Matrices --- | a matrix of n rows, each of m columns, storing values of type r+-- | A matrix of n rows, each of m columns, storing values of type r. newtype Matrix n m r = Matrix (Vector n (Vector m r))  deriving instance (Show r, Arity n, Arity m) => Show (Matrix n m r)@@ -39,41 +40,56 @@ deriving instance (Arity n, Arity m)         => Foldable (Matrix n m) deriving instance (Arity n, Arity m)         => Traversable (Matrix n m) +-- | Matrix product. multM :: (Arity r, Arity c, Arity c', Num a) => Matrix r c a -> Matrix c c' a -> Matrix r c' a (Matrix a) `multM` (Matrix b) = Matrix $ a !*! b +-- | Matrix * column vector. mult :: (Arity m, Arity n, Num r) => Matrix n m r -> Vector m r -> Vector n r (Matrix m) `mult` v = m !* v --- | Produces the Identity Matrix+-- | Produces the Identity Matrix. identityMatrix :: (Arity d, Num r) => Matrix d d r identityMatrix = Matrix $ imap mkRow (pure 1) +-- | Class of matrices that are invertible. class Invertible n r where   inverse' :: Matrix n n r -> Matrix n n r  instance Fractional r => Invertible 2 r where   -- >>> inverse' $ Matrix $ Vector2 (Vector2 1 2) (Vector2 3 4.0)   -- Matrix Vector2 [Vector2 [-2.0,1.0],Vector2 [1.5,-0.5]]-  inverse' (Matrix m) = Matrix . unsafeCoerce . Lin.inv22 . unsafeCoerce $ m+  inverse' = withM22 Lin.inv22  instance Fractional r => Invertible 3 r where   -- >>> inverse' $ Matrix $ Vector3 (Vector3 1 2 4) (Vector3 4 2 2) (Vector3 1 1 1.0)   -- Matrix Vector3 [Vector3 [0.0,0.5,-1.0],Vector3 [-0.5,-0.75,3.5],Vector3 [0.5,0.25,-1.5]]-  inverse' (Matrix m) = Matrix . unsafeCoerce . Lin.inv33 . unsafeCoerce $ m+  inverse' = withM33 Lin.inv33  instance Fractional r => Invertible 4 r where-  inverse' (Matrix m) = Matrix . unsafeCoerce . Lin.inv44 . unsafeCoerce $ m-+  inverse' = withM44 Lin.inv44 +-- | Class of matrices that have a determinant. class Arity d => HasDeterminant d where   det :: Num r => Matrix d d r -> r  instance HasDeterminant 1 where   det (Matrix (Vector1 (Vector1 x))) = x instance HasDeterminant 2 where-  det = Lin.det22 . unsafeCoerce+  det = Lin.det22 . coerce instance HasDeterminant 3 where-  det = Lin.det33 . unsafeCoerce+  det = Lin.det33 . coerce instance HasDeterminant 4 where-  det = Lin.det44 . unsafeCoerce+  det = Lin.det44 . coerce++--------------------------------------------------------------------------------+-- Boilerplate code for converting between Matrix and M22/M33/M44.++withM22 :: (M22 a -> M22 b) -> Matrix 2 2 a -> Matrix 2 2 b+withM22 f = coerce . f . coerce++withM33 :: (M33 a -> M33 b) -> Matrix 3 3 a -> Matrix 3 3 b+withM33 f = coerce . f . coerce++withM44 :: (M44 a -> M44 b) -> Matrix 4 4 a -> Matrix 4 4 b+withM44 f = coerce . f . coerce
src/Data/Geometry/PlanarSubdivision.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} --------------------------------------------------------------------------------@@ -76,7 +75,7 @@                                          -> f -- ^ data inside                                          -> f -- ^ data outside the polygon                                          -> PlanarSubdivision s p () f r-fromPolygon p pg@(SimplePolygon _) iD oD = fromSimplePolygon p pg iD oD+fromPolygon p pg@SimplePolygon{} iD oD   = fromSimplePolygon p pg iD oD fromPolygon p (MultiPolygon vs hs) iD oD = case NonEmpty.nonEmpty hs of     Nothing  -> outerPG     Just hs' -> let hs'' = (\pg -> fromSimplePolygon wp (toCounterClockWiseOrder pg) oD iD) <$> hs'@@ -84,7 +83,7 @@   where     wp = Proxy :: Proxy (Wrap s) -    outerPG = fromSimplePolygon p (SimplePolygon vs) iD oD+    outerPG = fromSimplePolygon p vs iD oD     i = V.last $ faces' outerPG  @@ -122,13 +121,13 @@  data HoleData f p = Outer !f | Hole !f !p deriving (Show,Eq) -holeData            :: HoleData f p -> f-holeData (Outer f)  = f-holeData (Hole f _) = f+_holeData            :: HoleData f p -> f+_holeData (Outer f)  = f+_holeData (Hole f _) = f -getP            :: HoleData f p -> Maybe p-getP (Outer _)  = Nothing-getP (Hole _ p) = Just p+_getP            :: HoleData f p -> Maybe p+_getP (Outer _)  = Nothing+_getP (Hole _ p) = Just p  --------------------------------------------------------------------------------
src/Data/Geometry/PlanarSubdivision/Basic.hs view
@@ -155,6 +155,7 @@                       => PlaneGraph s v e f r -> PlanarSubdivision s v e f r fromPlaneGraph g = fromPlaneGraph' g (PG.outerFaceDart g) +{- HLINT ignore fromPlaneGraph' -} -- | Given a (connected) PlaneGraph and a dart that has the outerface on its left -- | Constructs a planarsubdivision --@@ -280,7 +281,7 @@ numEdges :: PlanarSubdivision s v e f r  -> Int numEdges = (`div` 2) . V.length . _rawDartData --- | Get the number of faces+-- | \( O(1) \). Get the number of faces -- -- >>> numFaces myGraph -- 4@@ -327,11 +328,12 @@ edges    :: PlanarSubdivision s v e f r  -> V.Vector (Dart s, e) edges ps = (\e -> (e,ps^.dataOf e)) <$> edges' ps -+-- | \( O(n) \). Vector of all primal faces. faces'    :: PlanarSubdivision s v e f r -> V.Vector (FaceId' s) faces' ps = let n = numFaces ps             in V.fromList $ map (FaceId . VertexId) [0..n-1] +-- | \( O(n) \). Vector of all primal faces with associated data. faces    :: PlanarSubdivision s v e f r -> V.Vector (FaceId' s, FaceData (Dart s) f) faces ps = (\fi -> (fi,ps^.faceDataOf fi)) <$> faces' ps @@ -492,7 +494,7 @@ -- running time: \(O(k)\), where \(k\) is the output size. boundaryVertices      :: FaceId' s -> PlanarSubdivision s v e f r                       -> V.Vector (VertexId' s)-boundaryVertices f ps = (\d -> headOf d ps) <$> outerBoundaryDarts f ps+boundaryVertices f ps = (`headOf` ps) <$> outerBoundaryDarts f ps   -- | Lists the holes in this face, given as a list of darts to arbitrary darts@@ -640,7 +642,7 @@ -- -- \(O(k)\), where \(k\) is the complexity of the outer boundary of the face rawFaceBoundary      :: FaceId' s -> PlanarSubdivision s v e f r -> SimplePolygon v r :+ f-rawFaceBoundary i ps = fromPoints pts :+ (ps^.dataOf i)+rawFaceBoundary i ps = unsafeFromPoints pts :+ (ps^.dataOf i)   where     d   = V.head $ outerBoundaryDarts i ps     pts = (\d' -> PG.vtxDataToExt $ ps^.vertexDataOf (headOf d' ps))@@ -654,10 +656,10 @@                     -> SomePolygon v r :+ f rawFacePolygon i ps = case F.toList $ holesOf i ps of                         [] -> Left  res                               :+ x-                        hs -> Right (MultiPolygon vs $ map toHole hs) :+ x+                        hs -> Right (MultiPolygon res $ map toHole hs) :+ x   where-    res@(SimplePolygon vs) :+ x = rawFaceBoundary i ps-    toHole d = (rawFaceBoundary (leftFace d ps) ps)^.core+    res :+ x = rawFaceBoundary i ps+    toHole d = rawFaceBoundary (leftFace d ps) ps ^. core  -- | Lists all *internal* faces of the planar subdivision. rawFacePolygons    :: PlanarSubdivision s v e f r
src/Data/Geometry/PlanarSubdivision/Merge.hs view
@@ -23,9 +23,6 @@ import           Data.Geometry.Point import           Data.Geometry.Polygon import           Data.PlanarGraph.Dart-import           Data.PlaneGraph ( Dart, VertexId(..), FaceId(..)-                                , VertexId', FaceId'-                                ) import qualified Data.PlaneGraph as PG import           Data.Semigroup.Foldable import qualified Data.Vector as V@@ -215,34 +212,39 @@ --------------------------------------------------------------------------------  data Test = Test-data Id a = Id a+newtype Id a = Id a   triangle1 :: PlanarSubdivision Test () () Int Rational triangle1 = (\pg -> fromSimplePolygon (Id Test) pg 1 0)-          $ trianglePG1+          trianglePG1+trianglePG1 :: SimplePolygon () Rational trianglePG1 = fromPoints . map ext $ [origin, Point2 200 0, Point2 200 200]   triangle2 :: PlanarSubdivision Test () () Int Rational triangle2 = (\pg -> fromSimplePolygon (Id Test) pg 2 0)-          $ trianglePG2+          trianglePG2+trianglePG2 :: SimplePolygon () Rational trianglePG2 = fromPoints . map ext $ [Point2 0 30, Point2 10 30, Point2 10 40]    triangle4 :: PlanarSubdivision Test () () Int Rational triangle4 = (\pg -> fromSimplePolygon (Id Test) pg 1 0)-          $ trianglePG4+          trianglePG4+trianglePG4 :: SimplePolygon () Rational trianglePG4 = fromPoints . map ext $ [Point2 400 400, Point2 600 400, Point2 600 600]  triangle3 :: PlanarSubdivision Test () () Int Rational triangle3 = (\pg -> fromSimplePolygon (Id Test) pg 3 0)-          $ trianglePG3+          trianglePG3+trianglePG3 :: SimplePolygon () Rational trianglePG3 = fromPoints . map ext $ [Point2 401 530, Point2 410 530, Point2 410 540]  -myPS = embedAsHoleIn triangle2 const (mkFI 1) triangle1+_myPS :: PlanarSubdivision Test () () Int Rational+_myPS = embedAsHoleIn triangle2 const (mkFI 1) triangle1        `merge`        embedAsHoleIn triangle3 const (mkFI 1) triangle4
src/Data/Geometry/PlanarSubdivision/Raw.hs view
@@ -46,7 +46,7 @@ --------------------------------------------------------------------------------  -- | The Face data consists of the data itself and a list of holes-data FaceData h f = FaceData { _holes :: (Seq.Seq h)+data FaceData h f = FaceData { _holes :: Seq.Seq h                              , _fData :: !f                              } deriving (Show,Eq,Ord,Functor,Foldable,Traversable,Generic) makeLenses ''FaceData
src/Data/Geometry/Point.hs view
@@ -10,32 +10,32 @@ -- \(d\)-dimensional points. -- ---------------------------------------------------------------------------------module Data.Geometry.Point( Point(..)+module Data.Geometry.Point( Point(.., Point1, Point2, Point3)                           , origin, vector                           , pointFromList                           , projectPoint -                          , pattern Point1-                          , pattern Point2-                          , pattern Point3                           , xCoord, yCoord, zCoord                            , PointFunctor(..) -                          , CCW, ccw, ccw'+                          , CCW, ccw, ccw', isCoLinear                           , pattern CCW, pattern CW, pattern CoLinear -                          , ccwCmpAround, cwCmpAround, ccwCmpAroundWith, cwCmpAroundWith-                          , sortAround, insertIntoCyclicOrder+                          , ccwCmpAround, ccwCmpAround'+                          , cwCmpAround, cwCmpAround'+                          , ccwCmpAroundWith, ccwCmpAroundWith'+                          , cwCmpAroundWith, cwCmpAroundWith'+                          , sortAround, sortAround'+                          , insertIntoCyclicOrder                            , Quadrant(..), quadrantWith, quadrant, partitionIntoQuadrants -                          , cmpByDistanceTo+                          , cmpByDistanceTo, cmpByDistanceTo'                            , squaredEuclideanDist, euclideanDist --                          , AsAPoint(..), coord, unsafeCoord, vector'+                          , coord, unsafeCoord                           ) where  import Data.Geometry.Point.Class
src/Data/Geometry/Point/Class.hs view
@@ -9,7 +9,7 @@ --------------------------------------------------------------------------------  -- $setup--- >>> import Data.Geometry.Point.Internal (pattern Point2, pattern Point3)+-- >>> import Data.Geometry.Point.Internal (pattern Point2, pattern Point3, origin)  class ToAPoint point d r where   toPoint   :: Prism' (point d r) (Point d r)@@ -17,12 +17,32 @@ class AsAPoint p where   asAPoint :: Lens (p d r) (p d' r') (Point d r) (Point d' r') +-- | Lens to access the vector corresponding to this point.+--+-- >>> (Point3 1 2 3) ^. vector'+-- Vector3 1 2 3+-- >>> origin & vector' .~ Vector3 1 2 3+-- Point3 1 2 3 vector' :: AsAPoint p => Lens (p d r) (p d r') (Vector d r) (Vector d r') vector' = asAPoint . lens Internal.toVec (const Internal.Point) +-- | Get the coordinate in a given dimension+--+-- >>> Point3 1 2 3 ^. coord (C :: C 2)+-- 2+-- >>> Point3 1 2 3 & coord (C :: C 1) .~ 10+-- Point3 10 2 3+-- >>> Point3 1 2 3 & coord (C :: C 3) %~ (+1)+-- Point3 1 2 4 coord   :: (1 <= i, i <= d, KnownNat i, Arity d, AsAPoint p) => proxy i -> Lens' (p d r) r coord i = asAPoint.Internal.coord i +-- | Get the coordinate in a given dimension. This operation is unsafe in the+-- sense that no bounds are checked. Consider using `coord` instead.+--+--+-- >>> Point3 1 2 3 ^. unsafeCoord 2+-- 2 unsafeCoord   :: (Arity d, AsAPoint p) => Int -> Lens' (p d r) r unsafeCoord i = asAPoint.Internal.unsafeCoord i @@ -33,14 +53,12 @@   asAPoint = id  -- -- | Shorthand to access the first coordinate C 1 -- -- >>> Point3 1 2 3 ^. xCoord -- 1 -- >>> Point2 1 2 & xCoord .~ 10--- Point2 [10,2]+-- Point2 10 2 xCoord :: (1 <= d, Arity d, AsAPoint point) => Lens' (point d r) r xCoord = coord (C :: C 1) {-# INLINABLE xCoord #-}@@ -50,7 +68,7 @@ -- >>> Point2 1 2 ^. yCoord -- 2 -- >>> Point3 1 2 3 & yCoord %~ (+1)--- Point3 [1,3,3]+-- Point3 1 3 3 yCoord :: (2 <= d, Arity d, AsAPoint point) => Lens' (point d r) r yCoord = coord (C :: C 2) {-# INLINABLE yCoord #-}@@ -60,7 +78,7 @@ -- >>> Point3 1 2 3 ^. zCoord -- 3 -- >>> Point3 1 2 3 & zCoord %~ (+1)--- Point3 [1,2,4]-zCoord :: (3 <= d, Arity d,AsAPoint point) => Lens' (point d r) r+-- Point3 1 2 4+zCoord :: (3 <= d, Arity d, AsAPoint point) => Lens' (point d r) r zCoord = coord (C :: C 3) {-# INLINABLE zCoord #-}
src/Data/Geometry/Point/Internal.hs view
@@ -25,27 +25,29 @@   , PointFunctor(..)    , cmpByDistanceTo+  , cmpByDistanceTo'   , squaredEuclideanDist, euclideanDist   ) where  import           Control.DeepSeq import           Control.Lens+import           Control.Monad import           Data.Aeson import           Data.Ext-import qualified Data.Foldable as F+import qualified Data.Foldable                   as F+import           Data.Functor.Classes import           Data.Geometry.Properties import           Data.Geometry.Vector-import qualified Data.Geometry.Vector as Vec+import qualified Data.Geometry.Vector            as Vec import           Data.Hashable-import           Data.Ord (comparing)+import           Data.List                       (intersperse)+import           Data.Ord                        (comparing) import           Data.Proxy-import           GHC.Generics (Generic)+import           GHC.Generics                    (Generic) import           GHC.TypeLits-import           System.Random (Random(..))-import           Test.QuickCheck (Arbitrary)-import           Text.ParserCombinators.ReadP (ReadP, string,pfail)-import           Text.ParserCombinators.ReadPrec (lift)-import           Text.Read (Read(..),readListPrecDefault, readPrec_to_P,minPrec)+import           System.Random                   (Random (..))+import           Test.QuickCheck                 (Arbitrary, Arbitrary1)+import           Text.Read                       (Read (..), readListPrecDefault)   --------------------------------------------------------------------------------@@ -61,31 +63,65 @@ -- * A d-dimensional Point  -- | A d-dimensional point.+--+-- There are convenience pattern synonyms for 1, 2 and 3 dimensional points.+--+-- >>> let f (Point1 x) = x in f (Point1 1)+-- 1+-- >>> let f (Point2 x y) = x in f (Point2 1 2)+-- 1+-- >>> let f (Point3 x y z) = z in f (Point3 1 2 3)+-- 3+-- >>> let f (Point3 x y z) = z in f (Point $ Vector3 1 2 3)+-- 3 newtype Point d r = Point { toVec :: Vector d r } deriving (Generic)  instance (Show r, Arity d) => Show (Point d r) where-  show (Point v) = mconcat [ "Point", show $ F.length v , " "-                           , show $ F.toList v-                           ]+  showsPrec = liftShowsPrec showsPrec showList++instance (Arity d) => Show1 (Point d) where+  liftShowsPrec sp _ d (Point v) = showParen (d > 10) $+      showString constr . showChar ' ' .+      unwordsS (map (sp 11) (F.toList v))+    where+      constr = "Point" <> show (fromIntegral (natVal @d Proxy))+      unwordsS = foldr (.) id . intersperse (showChar ' ')+ instance (Read r, Arity d) => Read (Point d r) where-  readPrec     = lift readPt+  readPrec     = liftReadPrec readPrec readListPrec   readListPrec = readListPrecDefault -readPt :: forall d r. (Arity d, Read r) => ReadP (Point d r)-readPt = do let d = natVal (Proxy :: Proxy d)-            _  <- string $ "Point" <> show d <> " "-            rs <- readPrec_to_P readPrec minPrec-            case pointFromList rs of-              Just p -> pure p-              _      -> pfail+instance (Arity d) => Read1 (Point d) where+  liftReadPrec rp _rl = readData $+      readUnaryWith (replicateM d rp) constr $ \rs ->+        case pointFromList rs of+          Just p -> p+          _      -> error "internal error in Data.Geometry.Point read instance."+    where+      d = fromIntegral (natVal (Proxy :: Proxy d))+      constr = "Point" <> show d+  liftReadListPrec = liftReadListPrecDefault +-- readPt :: forall d r. (Arity d, Read r) => ReadP (Point d r)+-- readPt = do let d = natVal (Proxy :: Proxy d)+--             _  <- string $ "Point" <> show d+--             rs <- if d > 3+--               then readPrec_to_P readPrec minPrec+--               else replicateM (fromIntegral d) (readPrec_to_P readPrec minPrec)+--             case pointFromList rs of+--               Just p -> pure p+--               _      -> pfail+ deriving instance (Eq r, Arity d)        => Eq (Point d r)+deriving instance Arity d                => Eq1 (Point d) deriving instance (Ord r, Arity d)       => Ord (Point d r) deriving instance Arity d                => Functor (Point d)+deriving instance Arity d                => Applicative (Point d) deriving instance Arity d                => Foldable (Point d) deriving instance Arity d                => Traversable (Point d) deriving instance (Arity d, NFData r)    => NFData (Point d r) deriving instance (Arity d, Arbitrary r) => Arbitrary (Point d r)+deriving instance Arity d                => Arbitrary1 (Point d) deriving instance (Arity d, Hashable r)  => Hashable (Point d r) deriving instance (Arity d, Random r)    => Random (Point d r) @@ -109,7 +145,7 @@ -- | Point representing the origin in d dimensions -- -- >>> origin :: Point 4 Int--- Point4 [0,0,0,0]+-- Point4 0 0 0 0 origin :: (Arity d, Num r) => Point d r origin = Point $ pure 0 @@ -119,10 +155,10 @@ -- | Lens to access the vector corresponding to this point. -- -- >>> (Point3 1 2 3) ^. vector--- Vector3 [1,2,3]+-- Vector3 1 2 3 -- >>> origin & vector .~ Vector3 1 2 3--- Point3 [1,2,3]-vector :: Lens' (Point d r) (Vector d r)+-- Point3 1 2 3+vector :: Lens (Point d r) (Point d r') (Vector d r) (Vector d r') vector = lens toVec (const Point) {-# INLINABLE vector #-} @@ -142,9 +178,9 @@ -- >>> Point3 1 2 3 ^. coord (C :: C 2) -- 2 -- >>> Point3 1 2 3 & coord (C :: C 1) .~ 10--- Point3 [10,2,3]+-- Point3 10 2 3 -- >>> Point3 1 2 3 & coord (C :: C 3) %~ (+1)--- Point3 [1,2,4]+-- Point3 1 2 4 coord   :: forall proxy i d r. (1 <= i, i <= d, Arity d, KnownNat i)         => proxy i -> Lens' (Point d r) r coord _ = unsafeCoord $ fromIntegral (natVal $ C @i)@@ -160,7 +196,7 @@ -- list has to match the dimension exactly. -- -- >>> pointFromList [1,2,3] :: Maybe (Point 3 Int)--- Just Point3 [1,2,3]+-- Just (Point3 1 2 3) -- >>> pointFromList [1] :: Maybe (Point 3 Int) -- Nothing -- >>> pointFromList [1,2,3,4] :: Maybe (Point 3 Int)@@ -176,44 +212,18 @@ -------------------------------------------------------------------------------- -- * Convenience functions to construct 1, 2 and 3 dimensional points --- | We provide pattern synonyms for 1, 2 and 3 dimensional points. i.e.--- we can write:--------- >>> :{---   let---     f            :: Num r => Point 1 r -> r---     f (Point1 x) = x + 1---   in f (Point1 1)--- :}--- 2+-- | A bidirectional pattern synonym for 1 dimensional points. pattern Point1   :: r -> Point 1 r pattern Point1 x = Point (Vector1 x) {-# COMPLETE Point1 #-}  --- | Pattern synonym for 2 dimensional points------ >>> :{---   let---     f              :: Point 2 r -> r---     f (Point2 x y) = x---   in f (Point2 1 2)--- :}--- 1+-- | A bidirectional pattern synonym for 2 dimensional points. pattern Point2       :: r -> r -> Point 2 r pattern Point2 x y = Point (Vector2 x y) {-# COMPLETE Point2 #-} --- | Similarly, we can write:------ >>> :{---   let---     g                :: Point 3 r -> r---     g (Point3 x y z) = z---   in g myPoint--- :}--- 3+-- | A bidirectional pattern synonym for 3 dimensional points. pattern Point3       :: r -> r -> r -> Point 3 r pattern Point3 x y z = (Point (Vector3 x y z)) {-# COMPLETE Point3 #-}@@ -237,9 +247,13 @@  -- | Compare by distance to the first argument cmpByDistanceTo              :: (Ord r, Num r, Arity d)-                             => Point d r :+ c -> Point d r :+ p -> Point d r :+ q -> Ordering-cmpByDistanceTo (c :+ _) p q = comparing (squaredEuclideanDist c) (p^.core) (q^.core)+                             => Point d r -> Point d r -> Point d r -> Ordering+cmpByDistanceTo c p q = comparing (squaredEuclideanDist c) p q +-- | Compare by distance to the first argument+cmpByDistanceTo'  :: (Ord r, Num r, Arity d)+                  => Point d r :+ c -> Point d r :+ p -> Point d r :+ q -> Ordering+cmpByDistanceTo' c p q = cmpByDistanceTo (c^.core) (p^.core) (q^.core)
src/Data/Geometry/Point/Orientation/Degenerate.hs view
@@ -4,11 +4,15 @@    , ccw, ccw' -  , sortAround+  , isCoLinear -  , ccwCmpAroundWith, cwCmpAroundWith-  , ccwCmpAround, cwCmpAround+  , sortAround, sortAround' +  , ccwCmpAroundWith, ccwCmpAroundWith'+  , cwCmpAroundWith, cwCmpAroundWith'+  , ccwCmpAround, ccwCmpAround'+  , cwCmpAround, cwCmpAround'+   , insertIntoCyclicOrder   ) where @@ -22,16 +26,22 @@  -------------------------------------------------------------------------------- +-- $setup+-- >>> import Data.Double.Approximate+ -- | Data type for expressing the orientation of three points, with -- the option of allowing Colinearities. newtype CCW = CCWWrap Ordering deriving Eq +-- | CounterClockwise orientation. Also called a left-turn. pattern CCW      :: CCW pattern CCW      = CCWWrap GT +-- | Clockwise orientation. Also called a right-turn. pattern CW       :: CCW pattern CW       = CCWWrap LT +-- | CoLinear orientation. Also called a straight line. pattern CoLinear :: CCW pattern CoLinear = CCWWrap EQ {-# COMPLETE CCW, CW, CoLinear #-}@@ -44,8 +54,22 @@   -- | Given three points p q and r determine the orientation when going from p to r via q.+--+-- Be vary of numerical instability:+-- >>> ccw (Point2 0 0.3) (Point2 1 0.6) (Point2 2 (0.9::Double))+-- CCW+--+-- >>> ccw (Point2 0 0.3) (Point2 1 0.6) (Point2 2 (0.9::Rational))+-- CoLinear+--+-- If you can't use 'Rational', try 'SafeDouble' instead of 'Double':+-- >>> ccw (Point2 0 0.3) (Point2 1 0.6) (Point2 2 (0.9::SafeDouble))+-- CoLinear+-- ccw :: (Ord r, Num r) => Point 2 r -> Point 2 r -> Point 2 r -> CCW-ccw p q r = CCWWrap $ z `compare` 0+ccw p q r = CCWWrap $ (ux*vy) `compare` (uy*vx)+-- ccw p q r = CCWWrap $ z `compare` 0 -- Comparing against 0 is bad for numerical robustness.+                                       -- I've added a testcase that fails if comparing against 0.             -- case z `compare` 0 of             --   LT -> CW             --   GT -> CCW@@ -53,21 +77,38 @@      where        Vector2 ux uy = q .-. p        Vector2 vx vy = r .-. p-       z             = ux * vy - uy * vx+      --  _z             = ux * vy - uy * vx +-- | Given three points p q and r determine if the line from p to r via q is straight/colinear.+--+-- This is identical to `ccw p q r == CoLinear` but doesn't have the `Ord` constraint.+isCoLinear :: (Eq r, Num r) => Point 2 r -> Point 2 r -> Point 2 r -> Bool+isCoLinear p q r = (ux * vy) == (uy * vx)+     where+       Vector2 ux uy = q .-. p+       Vector2 vx vy = r .-. p+ -- | Given three points p q and r determine the orientation when going from p to r via q. ccw' :: (Ord r, Num r) => Point 2 r :+ a -> Point 2 r :+ b -> Point 2 r :+ c -> CCW ccw' p q r = ccw (p^.core) (q^.core) (r^.core) --- | Sort the points arround the given point p in counter clockwise order with+-- | \( O(n log n) \)+-- Sort the points arround the given point p in counter clockwise order with -- respect to the rightward horizontal ray starting from p.  If two points q -- and r are colinear with p, the closest one to p is reported first.--- running time: O(n log n) sortAround   :: (Ord r, Num r)-             => Point 2 r :+ q -> [Point 2 r :+ p] -> [Point 2 r :+ p]+             => Point 2 r -> [Point 2 r] -> [Point 2 r] sortAround c = L.sortBy (ccwCmpAround c <> cmpByDistanceTo c) +-- | \( O(n log n) \)+-- Sort the points arround the given point p in counter clockwise order with+-- respect to the rightward horizontal ray starting from p.  If two points q+-- and r are colinear with p, the closest one to p is reported first.+sortAround'   :: (Ord r, Num r)+             => Point 2 r :+ q -> [Point 2 r :+ p] -> [Point 2 r :+ p]+sortAround' c = L.sortBy (ccwCmpAround' c <> cmpByDistanceTo' c) + -- | Given a zero vector z, a center c, and two points p and q, -- compute the ccw ordering of p and q around c with this vector as zero -- direction.@@ -75,10 +116,10 @@ -- pre: the points p,q /= c ccwCmpAroundWith                              :: (Ord r, Num r)                                               => Vector 2 r-                                              -> Point 2 r :+ c-                                              -> Point 2 r :+ a -> Point 2 r :+ b+                                              -> Point 2 r+                                              -> Point 2 r -> Point 2 r                                               -> Ordering-ccwCmpAroundWith z@(Vector2 zx zy) (c :+ _) (q :+ _) (r :+ _) =+ccwCmpAroundWith z@(Vector2 zx zy) c q r =     case (ccw c a q, ccw c a r) of       (CCW,CCW)      -> cmp       (CCW,CW)       -> LT@@ -115,36 +156,71 @@             CoLinear -> EQ  -- | Given a zero vector z, a center c, and two points p and q,+-- compute the ccw ordering of p and q around c with this vector as zero+-- direction.+--+-- pre: the points p,q /= c+ccwCmpAroundWith'                              :: (Ord r, Num r)+                                               => Vector 2 r+                                               -> Point 2 r :+ c+                                               -> Point 2 r :+ a -> Point 2 r :+ b+                                               -> Ordering+ccwCmpAroundWith' z (c :+ _) (q :+ _) (r :+ _) = ccwCmpAroundWith z c q r++-- | Given a zero vector z, a center c, and two points p and q, -- compute the cw ordering of p and q around c with this vector as zero -- direction. -- -- pre: the points p,q /= c cwCmpAroundWith     :: (Ord r, Num r)                     => Vector 2 r+                    -> Point 2 r+                    -> Point 2 r -> Point 2 r+                    -> Ordering+cwCmpAroundWith z c = flip (ccwCmpAroundWith z c)+++-- | Given a zero vector z, a center c, and two points p and q,+-- compute the cw ordering of p and q around c with this vector as zero+-- direction.+--+-- pre: the points p,q /= c+cwCmpAroundWith'    :: (Ord r, Num r)+                    => Vector 2 r                     -> Point 2 r :+ a                     -> Point 2 r :+ b -> Point 2 r :+ c                     -> Ordering-cwCmpAroundWith z c = flip (ccwCmpAroundWith z c)+cwCmpAroundWith' z c = flip (ccwCmpAroundWith' z c)  -- | Counter clockwise ordering of the points around c. Points are ordered with -- respect to the positive x-axis. ccwCmpAround :: (Num r, Ord r)-             => Point 2 r :+ qc -> Point 2 r :+ p -> Point 2 r :+ q -> Ordering+             => Point 2 r -> Point 2 r -> Point 2 r -> Ordering ccwCmpAround = ccwCmpAroundWith (Vector2 1 0) +-- | Counter clockwise ordering of the points around c. Points are ordered with+-- respect to the positive x-axis.+ccwCmpAround' :: (Num r, Ord r)+             => Point 2 r :+ qc -> Point 2 r :+ p -> Point 2 r :+ q -> Ordering+ccwCmpAround' = ccwCmpAroundWith' (Vector2 1 0)+ -- | Clockwise ordering of the points around c. Points are ordered with -- respect to the positive x-axis. cwCmpAround :: (Num r, Ord r)-            => Point 2 r :+ qc -> Point 2 r :+ p -> Point 2 r :+ q -> Ordering+            => Point 2 r -> Point 2 r -> Point 2 r -> Ordering cwCmpAround = cwCmpAroundWith (Vector2 1 0) +-- | Clockwise ordering of the points around c. Points are ordered with+-- respect to the positive x-axis.+cwCmpAround' :: (Num r, Ord r)+            => Point 2 r :+ qc -> Point 2 r :+ p -> Point 2 r :+ q -> Ordering+cwCmpAround' a b c = cwCmpAround (a^.core) (b^.core) (c^.core) --- | Given a center c, a new point p, and a list of points ps, sorted in+-- | \( O(n) \)+-- Given a center c, a new point p, and a list of points ps, sorted in -- counter clockwise order around c. Insert p into the cyclic order. The focus -- of the returned cyclic list is the new point p.------ running time: O(n) insertIntoCyclicOrder   :: (Ord r, Num r)                         => Point 2 r :+ q -> Point 2 r :+ p                         -> C.CList (Point 2 r :+ p) -> C.CList (Point 2 r :+ p)-insertIntoCyclicOrder c = CU.insertOrdBy (ccwCmpAround c <> cmpByDistanceTo c)+insertIntoCyclicOrder c = CU.insertOrdBy (ccwCmpAround' c <> cmpByDistanceTo' c)
src/Data/Geometry/Point/Quadrants.hs view
@@ -1,26 +1,19 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.Point.Quadrants+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.Point.Quadrants where -import           Control.DeepSeq import           Control.Lens-import           Data.Aeson import           Data.Ext-import qualified Data.Foldable as F import           Data.Geometry.Point.Class import           Data.Geometry.Point.Internal-import           Data.Geometry.Properties import           Data.Geometry.Vector-import qualified Data.Geometry.Vector as Vec-import           Data.Hashable import qualified Data.List as L-import           Data.Ord (comparing)-import           Data.Proxy-import           GHC.Generics (Generic) import           GHC.TypeLits-import           System.Random (Random(..))-import           Test.QuickCheck (Arbitrary)-import           Text.ParserCombinators.ReadP (ReadP, string,pfail)-import           Text.ParserCombinators.ReadPrec (lift)-import           Text.Read (Read(..),readListPrecDefault, readPrec_to_P,minPrec)  --------------------------------------------------------------------------------
+ src/Data/Geometry/PointLocation.hs view
@@ -0,0 +1,12 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.PointLocation+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--------------------------------------------------------------------------------+module Data.Geometry.PointLocation+  ( module Data.Geometry.PointLocation.PersistentSweep+  ) where++import Data.Geometry.PointLocation.PersistentSweep
+ src/Data/Geometry/PointLocation/PersistentSweep.hs view
@@ -0,0 +1,177 @@+{-# Language TemplateHaskell #-}+{-# Language TypeApplications #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.PointLocation.PersistentSweep+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--------------------------------------------------------------------------------+module Data.Geometry.PointLocation.PersistentSweep+  ( PointLocationDS(PointLocationDS)+  , verticalRayShootingStructure, subdivision, outerFace++  -- * Building the Data Structure+  , pointLocationDS+  -- * Querying the Data Structure+  , dartAbove, dartAboveOrOn+  , faceContaining, faceIdContaining++  , InPolygonDS, inPolygonDS+  , InOut(..)++  , pointInPolygon+  , edgeOnOrAbove+  ) where++import qualified Data.Geometry.VerticalRayShooting.PersistentSweep as VRS+import           Control.Lens hiding (contains, below)+import           Data.Ext+import           Data.Geometry.LineSegment+import           Data.Geometry.PlanarSubdivision+import           Data.Geometry.Point+import           Data.Geometry.Polygon+import qualified Data.List.NonEmpty as NonEmpty+import           Data.Proxy+import           Data.Util (SP(..))+import qualified Data.Vector as V++--------------------------------------------------------------------------------++-- | Planar Point Location Data structure+data PointLocationDS s v e f r = PointLocationDS {+        _verticalRayShootingStructure :: VRS.VerticalRayShootingStructure v (Dart s) r+      , _subdivision                  :: PlanarSubdivision s v e f r+      , _outerFace                    :: FaceId' s+      } deriving (Show,Eq)++makeLensesWith (lensRules&generateUpdateableOptics .~ False) ''PointLocationDS++--------------------------------------------------------------------------------+-- * Buidlding the Point location Data structure++-- | Builds a pointlocation data structure on the planar subdivision with \(n\)+-- vertices.+--+-- running time: \(O(n\log n)\).+-- space: \(O(n\log n)\).+pointLocationDS    :: (Ord r, Fractional r)+                   => PlanarSubdivision s v e f r -> PointLocationDS s v e f r+pointLocationDS ps = PointLocationDS (VRS.verticalRayShootingStructure es) ps (outerFaceId ps)+  where+    es = NonEmpty.fromList . V.toList . fmap (\(d,s) -> s&extra .~ d) . edgeSegments $ ps+      -- the VRS structure will throw away vertical edges. So there is no need to+      -- explicitly filter them yet at this point++--------------------------------------------------------------------------------+-- * Querying the Structure++-- | 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)\)+dartAbove :: (Ord r, Fractional r)+          => Point 2 r -> PointLocationDS s v e f r -> Maybe (Dart s)+dartAbove = queryWith VRS.segmentAbove++dartAboveOrOn :: (Ord r, Fractional r)+              => Point 2 r -> PointLocationDS s v e f r -> Maybe (Dart s)+dartAboveOrOn = queryWith VRS.segmentAboveOrOn++type QueryAlgorithm v e r =+  Point 2 r -> VRS.VerticalRayShootingStructure v e r -> Maybe (LineSegment 2 v r :+ e)++queryWith         :: (Ord r, Fractional r)+                  => QueryAlgorithm v (Dart s) r+                  -> Point 2 r -> PointLocationDS s v e f r -> Maybe (Dart s)+queryWith query q = fmap (view extra) . query q . view verticalRayShootingStructure++-- | Locates the face containing the query point.+--+-- running time: \(O(\log n)\)+faceContaining      :: (Ord r, Fractional r)+                    => Point 2 r -> PointLocationDS s v e f r -> f+faceContaining q ds = ds^.subdivision.dataOf (faceIdContaining q ds)++-- | 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)\)+faceIdContaining      :: (Ord r, Fractional r)+                      => Point 2 r -> PointLocationDS s v e f r -> FaceId' s+faceIdContaining q ds = dartToFace ds $ dartAbove q ds++-- | Given the dart determine the faceId correspondig to it (depending+-- on the orientation of the dart that is returned.)+dartToFace    :: Ord r => PointLocationDS s v e f r -> Maybe (Dart s) -> FaceId' s+dartToFace ds = maybe (ds^.outerFace) getFace+  where+    ps = ds^.subdivision+    getFace d = let (u,v) = bimap (^.location) (^.location) $ endPointData d ps+                in if u <= v then rightFace d ps+                             else leftFace  d ps+++data OneOrTwo a = One !a | Two !a !a deriving (Show,Read,Eq,Ord,Functor,Foldable,Traversable)++-- | Locates the faceId of the face containing the query point. If the+-- query point lies on an edge, it returns both faces incident to the+-- edge; first the one below the edge then the one above the edge.+--+-- running time: \(O(\log n)\)+faceIdContaining'      :: (Ord r, Fractional r)+                      => Point 2 r -> PointLocationDS s v e f r -> OneOrTwo (FaceId' s)+faceIdContaining' q ds = maybe (One $ ds^.outerFace) getFace $ dartAboveOrOn q ds+  where+    ps = ds^.subdivision++    getFace = getFace' . orient++    orient d = let (u,v) = bimap (^.location) (^.location) $ endPointData d ps+               in if u <= v then (d,u,v) else (twin d, v, u)+++    getFace' (d,u,v) = case ccw u q v of+                         CoLinear -> Two (rightFace d ps) (leftFace d ps)+                         _        -> One (rightFace d ps)++--------------------------------------------------------------------------------++-- | Data structure for fast InPolygon Queries+-- newtype InPolygonDS v r = InPolygonDS (VRS.VerticalRayShootingStructure (Vertex v r) () r)+--   deriving (Show,Eq)++data InOut = In | Out deriving (Show,Eq)++data Dummy+type InPolygonDS v r = PointLocationDS Dummy (SP Int v) () InOut  r+++-- type Vertex v r = Int :+ (Point 2 r :+ v)++inPolygonDS    :: (Fractional r, Ord r) => SimplePolygon v r -> InPolygonDS v r+inPolygonDS pg = pointLocationDS $ fromSimplePolygon (Proxy @Dummy) (numberVertices pg) In Out++-- | Finds the edge on or above the query point, if it exists+--+--+edgeOnOrAbove      :: (Ord r, Fractional r)+                   => Point 2 r -> InPolygonDS v r -> Maybe (LineSegment 2 (SP Int v) r)+edgeOnOrAbove q ds = view core . flip edgeSegment (ds^.subdivision) <$> dartAboveOrOn q ds+++-- | Returns if a query point lies in (or on the boundary of) the polygon.+--+-- \(O(\log n)\)+pointInPolygon :: (Ord r, Fractional r) => Point 2 r -> InPolygonDS v r -> InOut+pointInPolygon q ds = case faceIdContaining' q ds of+                        One i   -> ds^.subdivision.dataOf i+                        Two _ _ -> In -- on an edge, so inside.++  -- FIXME: Make sure to also test the edge "below" q, i.e. if q is on+  -- some edge we should return that edge.++  -- FIXME: Figure out if this works ok for vertical edges as well
src/Data/Geometry/PolyLine.hs view
@@ -1,6 +1,11 @@-{-# LANGUAGE TemplateHaskell  #-}-{-# LANGUAGE DeriveFunctor  #-} {-# LANGUAGE UndecidableInstances  #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.PolyLine+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.PolyLine where  import           Control.Lens@@ -35,8 +40,11 @@  -- | A Poly line in R^d has at least 2 vertices newtype PolyLine d p r = PolyLine { _points :: LSeq 2 (Point d r :+ p) } deriving (Generic)-makeLenses ''PolyLine +-- | PolyLines are isomorphic to a sequence of points with at least 2 members.+points :: Iso (PolyLine d1 p1 r1) (PolyLine d2 p2 r2) (LSeq 2 (Point d1 r1 :+ p1)) (LSeq 2 (Point d2 r2 :+ p2))+points = iso (\(PolyLine s) -> s) PolyLine+ deriving instance (Show r, Show p, Arity d) => Show    (PolyLine d p r) deriving instance (Eq r, Eq p, Arity d)     => Eq      (PolyLine d p r) deriving instance (Ord r, Ord p, Arity d)   => Ord     (PolyLine d p r)@@ -70,6 +78,16 @@     toEncoding = genericToEncoding defaultOptions instance (FromJSON p, FromJSON r, Arity d, KnownNat d) => FromJSON (PolyLine d p r) +instance HasStart (PolyLine d p r) where+  type StartCore (PolyLine d p r)  = Point d r+  type StartExtra (PolyLine d p r) = p+  start = points.head1++instance HasEnd (PolyLine d p r) where+  type EndCore (PolyLine d p r)  = Point d r+  type EndExtra (PolyLine d p r) = p+  end = points.last1+ -- | Builds a Polyline from a list of points, if there are sufficiently many points fromPoints :: [Point d r :+ p] -> Maybe (PolyLine d p r) fromPoints = fmap PolyLine . LSeq.eval (C @ 2) . LSeq.fromList@@ -81,7 +99,7 @@ -- | pre: The input list contains at least two points. All extra vields are -- initialized with mempty. fromPointsUnsafe' :: (Monoid p) => [Point d r] -> PolyLine d p r-fromPointsUnsafe' = fromPointsUnsafe . map (\p -> p :+ mempty)+fromPointsUnsafe' = fromPointsUnsafe . map (:+ mempty)   -- | We consider the line-segment as closed.@@ -111,9 +129,9 @@ -- running time: \(O(\log n)\) -- -- >>> interpolatePoly 0.5 myPolyLine--- Point2 [5.0,5.0]+-- Point2 5.0 5.0 -- >>> interpolatePoly 1.5 myPolyLine--- Point2 [10.0,15.0]+-- Point2 10.0 15.0 interpolatePoly      :: (RealFrac r, Arity d) => r -> PolyLine d p r -> Point d r interpolatePoly t pl = let i = floor t in case edgeSegments pl^?ix i of                          Nothing -> pl^.points.to LSeq.last.core
src/Data/Geometry/Polygon.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- -- | -- Module      :  Data.Geometry.Polygon@@ -9,43 +8,76 @@ -- A Polygon data type and some basic functions to interact with them. -- ---------------------------------------------------------------------------------module Data.Geometry.Polygon( PolygonType(..)-                            , Polygon(..)-                            , _SimplePolygon, _MultiPolygon-                            , SimplePolygon, MultiPolygon, SomePolygon+module Data.Geometry.Polygon+  ( -- * Types+    PolygonType(..)+  , Polygon(..)+  , _SimplePolygon, _MultiPolygon+  , SimplePolygon, MultiPolygon, SomePolygon -                            , fromPoints+    -- * Conversion+  , fromPoints+  , fromCircularVector -                            , polygonVertices, listEdges+  , simpleFromPoints+  , simpleFromCircularVector -                            , outerBoundary, outerBoundaryEdges-                            , outerVertex, outerBoundaryEdge+  , unsafeFromPoints+  , unsafeFromCircularVector+  , unsafeFromVector+  , toVector+  , toPoints -                            , polygonHoles, polygonHoles'-                            , holeList+  , isSimple -                            , inPolygon, insidePolygon, onBoundary+    -- * Accessors -                            , area, signedArea+  , size+  , polygonVertices, listEdges -                            , centroid-                            , pickPoint+  , outerBoundary, outerBoundaryVector+  , unsafeOuterBoundaryVector+  , outerBoundaryEdges+  , outerVertex, outerBoundaryEdge -                            , isTriangle, isStarShaped+  , polygonHoles, polygonHoles'+  , holeList -                            , isCounterClockwise-                            , toCounterClockWiseOrder, toCounterClockWiseOrder'-                            , toClockwiseOrder, toClockwiseOrder'-                            , reverseOuterBoundary+    -- * Properties -                            , findDiagonal+  , area, signedArea+  , centroid -                            , withIncidentEdges, numberVertices+    -- * Queries+  , inPolygon, insidePolygon, onBoundary -                            , asSimplePolygon-                            , extremesLinear, cmpExtreme-                            ) where +  , isTriangle, isStarShaped++  , isCounterClockwise+  , toCounterClockWiseOrder, toCounterClockWiseOrder'+  , toClockwiseOrder, toClockwiseOrder'+  , reverseOuterBoundary++  , rotateLeft+  , rotateRight+  , maximumVertexBy+  , minimumVertexBy+++   -- * Misc+  , pickPoint+  , findDiagonal++  , withIncidentEdges, numberVertices++  , extremesLinear, cmpExtreme++  , findRotateTo++  ) where++import           Algorithms.Geometry.InPolygon import           Algorithms.Geometry.LinearProgramming.LP2DRIC import           Algorithms.Geometry.LinearProgramming.Types import           Control.Lens hiding (Simple)@@ -54,10 +86,13 @@ import qualified Data.Foldable as F import           Data.Geometry.HalfSpace (rightOf) import           Data.Geometry.Line+import           Data.Geometry.LineSegment import           Data.Geometry.Point+import           Data.Geometry.Boundary import           Data.Geometry.Polygon.Core import           Data.Geometry.Polygon.Extremes-+import           Data.Geometry.Properties+import qualified Data.Sequence as Seq  -------------------------------------------------------------------------------- -- * Polygons@@ -76,3 +111,30 @@     -- the first vertex is the intersection point of the two supporting lines     -- bounding it, so the first two edges bound the shape in this sirection     hs = fmap (rightOf . supportingLine) . outerBoundaryEdges $ pg+++--------------------------------------------------------------------------------+-- * Instances++type instance IntersectionOf (Line 2 r) (Boundary (Polygon t p r)) =+  '[Seq.Seq (Either (Point 2 r) (LineSegment 2 () r))]++type instance IntersectionOf (Point 2 r) (Polygon t p r) = [NoIntersection, Point 2 r]++instance (Fractional r, Ord r) => Point 2 r `IsIntersectableWith` Polygon t p r where+  nonEmptyIntersection = defaultNonEmptyIntersection+  q `intersects` pg = q `inPolygon` pg /= Outside+  q `intersect` pg | q `intersects` pg = coRec q+                   | otherwise         = coRec NoIntersection++-- instance IsIntersectableWith (Line 2 r) (Boundary (Polygon t p r)) where+--   nonEmptyIntersection _ _ (CoRec xs) = null xs+--   l `intersect` (Boundary (SimplePolygon vs)) =+--     undefined+  -- l `intersect` (Boundary (MultiPolygon vs hs)) = coRec .+  --    Seq.sortBy f . Seq.fromList+  --     . concatMap (unpack . (l `intersect`) . Boundary)+  --     $ SimplePolygon vs : hs+  --   where+  --     unpack (CoRec x) = x+  --     f = undefined
src/Data/Geometry/Polygon/Convex.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- -- | -- Module      :  Data.Geometry.Polygon.Convex@@ -10,54 +9,82 @@ -- Convex Polygons -- ---------------------------------------------------------------------------------module Data.Geometry.Polygon.Convex( ConvexPolygon(..), simplePolygon-                                   , merge-                                   , lowerTangent, lowerTangent'-                                   , upperTangent, upperTangent'+module Data.Geometry.Polygon.Convex+  ( ConvexPolygon(..), simplePolygon+  , convexPolygon+  , isConvex, verifyConvex+  , merge+  , lowerTangent, lowerTangent'+  , upperTangent, upperTangent' -                                   , extremes-                                   , maxInDirection+  , extremes+  , maxInDirection -                                   , leftTangent, rightTangent+  , leftTangent, rightTangent -                                   , minkowskiSum-                                   , bottomMost-                                   ) where+  , minkowskiSum+  , bottomMost+  , inConvex+  , randomConvex -import           Control.DeepSeq-import           Control.Lens hiding ((:<), (:>))-import           Data.CircularSeq (CSeq)-import qualified Data.CircularSeq as C+  , diameter+  , diametralPair+  , diametralIndexPair+  ) where+++import           Control.DeepSeq                (NFData)+import           Control.Lens                   (Iso, iso, over, view, (%~), (&), (^.))+import           Control.Monad.Random+import           Control.Monad.ST+import           Control.Monad.State+import           Data.Coerce import           Data.Ext-import qualified Data.Foldable as F-import           Data.Function (on)-import           Data.Geometry.Box (IsBoxable(..))+import qualified Data.Foldable                  as F+import           Data.Function                  (on)+import           Data.Geometry.Boundary+import           Data.Geometry.Box              (IsBoxable (..)) import           Data.Geometry.LineSegment import           Data.Geometry.Point-import           Data.Geometry.Polygon.Core (fromPoints, SimplePolygon, outerBoundary)-import           Data.Geometry.Polygon.Extremes(cmpExtreme)+import           Data.Geometry.Polygon.Core     (Polygon (..), SimplePolygon, centroid,+                                                 outerBoundaryVector, outerVertex, size,+                                                 unsafeFromPoints, unsafeFromVector,+                                                 unsafeOuterBoundaryVector)+import           Data.Geometry.Polygon.Extremes (cmpExtreme) import           Data.Geometry.Properties import           Data.Geometry.Transformation+import           Data.Geometry.Triangle import           Data.Geometry.Vector-import           Data.List.NonEmpty (NonEmpty(..))-import qualified Data.List.NonEmpty as NonEmpty-import           Data.Maybe (fromJust)-import           Data.Ord (comparing)-import           Data.Semigroup.Foldable (Foldable1(..))-import           Data.Sequence (viewl,viewr, ViewL(..), ViewR(..))-import qualified Data.Sequence as S+import qualified Data.IntSet                    as IS+import           Data.List.NonEmpty             (NonEmpty (..))+import qualified Data.List.NonEmpty             as NonEmpty+import           Data.Maybe                     (fromJust)+import           Data.Ord                       (comparing)+import           Data.Semigroup.Foldable        (Foldable1 (..)) import           Data.Util-+import qualified Data.Vector                    as V+import           Data.Vector.Circular           (CircularVector)+import qualified Data.Vector.Circular           as CV+import qualified Data.Vector.Circular.Util      as CV+import qualified Data.Vector.Mutable            as Mut+import qualified Data.Vector.NonEmpty           as NE+import qualified Data.Vector.Unboxed            as VU -- import           Data.Geometry.Ipe--- import           Debug.Trace+-- import Data.Ratio+-- import Data.RealNumber.Rational+-- import Debug.Trace  --------------------------------------------------------------------------------  -- | Data Type representing a convex polygon newtype ConvexPolygon p r = ConvexPolygon {_simplePolygon :: SimplePolygon p r }                           deriving (Show,Eq,NFData)-makeLenses ''ConvexPolygon +-- | ConvexPolygons are isomorphic to SimplePolygons with the added constraint that they have no+--   reflex vertices.+simplePolygon :: Iso (ConvexPolygon p1 r1) (ConvexPolygon p2 r2) (SimplePolygon p1 r1) (SimplePolygon p2 r2)+simplePolygon = iso _simplePolygon ConvexPolygon+ instance PointFunctor (ConvexPolygon p) where   pmap f (ConvexPolygon p) = ConvexPolygon $ pmap f p @@ -73,14 +100,110 @@   boundingBox = boundingBox . _simplePolygon  --- convexPolygon   :: SimplePolygon p r -> Maybe (ConvexPolygon p r)--- convexPolygon p = if isConvex p then Just p else Nothing --- isConvex   :: SimplePolygon p r -> Bool--- isConvex p = let ch = convexHull $ p^.vertices---              in p^.vertices.size == ch^.simplePolygon.vertices.size+--------------------------------------------------------------------------------+-- Convex hull of simple polygon. +type M s v a = StateT (Mut.MVector s v, Int) (ST s) a +runM :: Int -> M s v () -> ST s (Mut.MVector s v)+runM s action = do+  v <- Mut.new (2*s)+  (v', f) <- execStateT action (Mut.drop s v, 0)+  return $ Mut.tail $ Mut.take f v'++dequeRemove :: M s a ()+dequeRemove = do+  modify $ \(Mut.MVector offset len arr, f) -> (Mut.MVector (offset+1) (len-1) arr, f-1)++dequeInsert :: a -> M s a ()+dequeInsert a = do+  modify $ \(Mut.MVector offset len arr, f) -> (Mut.MVector (offset-1) (len+1) arr, f+1)+  (v,_) <- get+  Mut.write v 0 a++dequePush :: a -> M s a ()+dequePush a = do+  (v, f) <- get+  Mut.write v f a+  put (v,f+1)++dequePop :: M s a ()+dequePop = do+  modify $ \(v,f) -> (v,f-1)++dequeBottom :: Int -> M s a a+dequeBottom idx = do+  (v,_) <- get+  Mut.read v idx++dequeTop :: Int -> M s a a+dequeTop idx = do+  (v,f) <- get+  Mut.read v (f-idx-1)++-- Melkman's algorithm: http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.512.9681&rep=rep1&type=pdf++-- | \( O(n) \) Convex hull of a simple polygon.+--+--   For algorithmic details see: <https://en.wikipedia.org/wiki/Convex_hull_of_a_simple_polygon>+convexPolygon :: forall t p r. (Ord r, Num r, Show r, Show p) => Polygon t p r -> ConvexPolygon p r+convexPolygon p = ConvexPolygon $ unsafeFromVector $ V.create $ runM (size p) $+    findStartingPoint 2+  where+    -- Find the first spot where 0,n-1,n is not colinear.+    findStartingPoint :: Int -> M s (Point 2 r :+ p) ()+    findStartingPoint nth = do+      let vPrev = NE.unsafeIndex vs (nth-1)+          vNth = NE.unsafeIndex vs nth+      case ccw' v1 vPrev vNth of+        CoLinear -> findStartingPoint (nth+1)+        CCW -> do+          dequePush v1 >> dequePush vPrev+          dequePush vNth; dequeInsert vNth+          V.mapM_ build (NE.drop (nth+1) vs)+        CW -> do+          dequePush vPrev >> dequePush v1+          dequePush vNth; dequeInsert vNth+          V.mapM_ build (NE.drop (nth+1) vs)++    v1 = NE.unsafeIndex vs 0+    vs = CV.vector (p^.outerBoundaryVector)+    build v = do+      botTurn <- ccw' <$> pure v     <*> dequeBottom 0 <*> dequeBottom 1+      topTurn <- ccw' <$> dequeTop 1 <*> dequeTop 0    <*> pure v+      when (botTurn == CW || topTurn == CW) $ do+        backtrackTop v; dequePush v+        backtrackBot v; dequeInsert v+    backtrackTop v = do+      turn <- ccw' <$> dequeTop 1 <*> dequeTop 0 <*> pure v+      unless (turn == CCW) $ do+        dequePop+        backtrackTop v+    backtrackBot v = do+      turn <- ccw' <$> pure v <*> dequeBottom 0 <*> dequeBottom 1+      unless (turn == CCW) $ do+        dequeRemove+        backtrackBot v++++++++-- | \( O(n) \) Check if a polygon is strictly convex.+isConvex :: (Ord r, Num r) => SimplePolygon p r -> Bool+isConvex s =+    CV.and (CV.zipWith3 f (CV.rotateLeft 1 vs) vs (CV.rotateRight 1 vs))+  where+    f a b c = ccw' a b c == CCW+    vs = s ^. outerBoundaryVector++-- | \( O(n) \) Verify that a convex polygon is strictly convex.+verifyConvex :: (Ord r, Num r) => ConvexPolygon p r -> Bool+verifyConvex = isConvex . _simplePolygon+ -- mainWith inFile outFile = do --     ePage <- readSinglePageFile inFile --     case ePage of@@ -115,13 +238,40 @@ -- -- pre: The input polygon is strictly convex. ----- running time: \(O(\log^2 n)\)+-- running time: \(O(\log n)\) maxInDirection   :: (Num r, Ord r) => Vector 2 r -> ConvexPolygon p r -> Point 2 r :+ p maxInDirection u = findMaxWith (cmpExtreme u) +-- FIXME: c+1 is always less than n so we don't need to use `mod` or do bounds checking.+--        Use unsafe indexing.+-- \( O(\log n) \)+findMaxWith :: (Point 2 r :+ p -> Point 2 r :+ p -> Ordering)+             -> ConvexPolygon p r -> Point 2 r :+ p+findMaxWith cmp p = CV.index v (worker 0 (F.length v))+  where+    v = p ^. simplePolygon.outerBoundaryVector+    a `icmp` b = CV.index v a `cmp` CV.index v b+    worker a b+      | localMaximum c = c+      | a+1==b         = b+      | otherwise      =+        case  (isUpwards a, isUpwards c, c `icmp` a /= LT) of+          (True, False, _)      -> worker a c -- A is up, C is down, pick [a,c]+          (True, True, True)    -> worker c b -- A is up, C is up, C is GTE A, pick [c,b]+          (True, True, False)   -> worker a c -- A is up, C is LT A, pick [a,c]+          (False, True, _)      -> worker c b -- A is down, C is up, pick [c,b]+          (False, False, False) -> worker c b -- A is down, C is down, C is LT A, pick [c,b]+          (False, _, True)      -> worker a c -- A is down, C is GTE A, pick [a,c]+      where+        c = (a+b) `div` 2+        localMaximum idx = idx `icmp` (c-1) == GT && idx `icmp` (c+1) == GT+    isUpwards idx = idx `icmp` (idx+1) /= GT++{- Convex binary search using sequences in \( O(log^2 n) \)+ findMaxWith       :: (Point 2 r :+ p -> Point 2 r :+ p -> Ordering)                   -> ConvexPolygon p r -> Point 2 r :+ p-findMaxWith cmp p = findMaxStart . C.rightElements . getVertices $ p+findMaxWith cmp = findMaxStart . S.fromList . F.toList . getVertices   where     p' >=. q = (p' `cmp` q) /= LT @@ -140,7 +290,7 @@       | otherwise          = binSearch ac c cb      -- | Given the vertices [a..] c [..b] find the exteral vtx-    binSearch ac@(viewl -> a:<r) c cb = case (isUpwards a r, isUpwards c cb, a >=. c) of+    binSearch ac@(viewl -> a:<r) c cb = case (isUpwards a (r |> c), isUpwards c cb, a >=. c) of         (True,False,_)      -> findMax (ac |> c)         (True,True,True)    -> findMax (ac |> c)         (True,True,False)   -> findMax (c <| cb)@@ -157,7 +307,7 @@     -- the Edge from a to b is upwards w.r.t b if a is not larger than b     isUpwards a (viewl -> b :< _) = (a `cmp` b) /= GT     isUpwards _ _                 = error "isUpwards: no edge endpoint"-+-}  tangentCmp       :: (Num r, Ord r)                  => Point 2 r -> Point 2 r :+ p -> Point 2 r :+ q -> Ordering@@ -167,19 +317,19 @@                      CW       -> GT -- q is right of the line from o to p  ---  | Given a convex polygon poly, and a point outside the polygon, find the+-- | Given a convex polygon poly, and a point outside the polygon, find the --  left tangent of q and the polygon, i.e. the vertex v of the convex polygon --  s.t. the polygon lies completely to the right of the line from q to v. ----- running time: \(O(\log^2 n)\).+-- running time: \(O(\log n)\). leftTangent        :: (Ord r, Num r) => ConvexPolygon p r -> Point 2 r -> Point 2 r :+ p leftTangent poly q = findMaxWith (tangentCmp q) poly ---  | Given a convex polygon poly, and a point outside the polygon, find the+-- | Given a convex polygon poly, and a point outside the polygon, find the --  right tangent of q and the polygon, i.e. the vertex v of the convex polygon --  s.t. the polygon lies completely to the left of the line from q to v. ----- running time: \(O(\log^2 n)\).+-- running time: \(O(\log n)\). rightTangent        :: (Ord r, Num r) => ConvexPolygon p r -> Point 2 r -> Point 2 r :+ p rightTangent poly q = findMaxWith (flip $ tangentCmp q) poly @@ -209,21 +359,21 @@ -- Running time: O(n+m), where n and m are the sizes of the two polygons respectively merge       :: (Num r, Ord r) => ConvexPolygon p r  -> ConvexPolygon p r             -> (ConvexPolygon p r, LineSegment 2 p r, LineSegment 2 p r)-merge lp rp = (ConvexPolygon . fromPoints $ r' ++ l', lt, ut)+merge lp rp = (ConvexPolygon . unsafeFromPoints $ r' ++ l', lt, ut)   where     lt@(ClosedLineSegment a b) = lowerTangent lp rp     ut@(ClosedLineSegment c d) = upperTangent lp rp      takeUntil p xs = let (xs',x:_) = break p xs in xs' ++ [x]-    rightElems  = F.toList . C.rightElements+    rightElems  = F.toList . CV.rightElements     takeAndRotate x y = takeUntil (coreEq x) . rightElems . rotateTo' y . getVertices      r' = takeAndRotate b d rp     l' = takeAndRotate c a lp  -rotateTo'   :: Eq a => (a :+ b) -> CSeq (a :+ b) -> CSeq (a :+ b)-rotateTo' x = fromJust . C.findRotateTo (coreEq x)+rotateTo'   :: Eq a => (a :+ b) -> CircularVector (a :+ b) -> CircularVector (a :+ b)+rotateTo' x = fromJust . CV.findRotateTo (coreEq x)  coreEq :: Eq a => (a :+ b) -> (a :+ b) -> Bool coreEq = (==) `on` (^.core)@@ -246,9 +396,8 @@                    -> LineSegment 2 p r lowerTangent lp rp = ClosedLineSegment l r   where-    mkH f = NonEmpty.fromList . F.toList . f . getVertices-    lh = mkH (C.rightElements . rightMost) lp-    rh = mkH (C.leftElements  . leftMost)  rp+    lh = CV.rightElements . rightMost . getVertices $ lp+    rh = CV.leftElements  . leftMost  . getVertices $ rp     (Two (l :+ _) (r :+ _)) = lowerTangent' lh rh  -- | Compute the lower tangent of the two convex chains lp and rp@@ -286,16 +435,15 @@ --          the two polygons. --        - The vertices of the polygons are given in clockwise order ----- Running time: O(n+m), where n and m are the sizes of the two polygons respectively+-- Running time: \( O(n+m) \), where n and m are the sizes of the two polygons respectively upperTangent       :: (Num r, Ord r)                    => ConvexPolygon p r                    -> ConvexPolygon p r                    -> LineSegment 2 p r upperTangent lp rp = ClosedLineSegment l r   where-    mkH f = NonEmpty.fromList . F.toList . f . getVertices-    lh = mkH (C.leftElements  . rightMost) lp-    rh = mkH (C.rightElements . leftMost)  rp+    lh = CV.leftElements  . rightMost . getVertices $ lp+    rh = CV.rightElements . leftMost  . getVertices $ rp     (Two (l :+ _) (r :+ _)) = upperTangent' lh rh  -- | Compute the upper tangent of the two convex chains lp and rp@@ -335,14 +483,14 @@ -- running time: \(O(n+m)\). minkowskiSum     :: (Ord r, Num r)                  => ConvexPolygon p r -> ConvexPolygon q r -> ConvexPolygon (p,q) r-minkowskiSum p q = ConvexPolygon . fromPoints $ merge' (f p) (f q)+minkowskiSum p q = ConvexPolygon . unsafeFromPoints $ merge' (f p) (f q)   where-    f p' = let xs@(S.viewl -> (v :< _)) = C.asSeq . bottomMost . getVertices $ p'-           in F.toList $ xs |> v-    (v :+ ve) .+. (w :+ we) = v .+^ (toVec w) :+ (ve,we)+    f p' = let (v:xs) = F.toList . bottomMost . getVertices $ p'+           in v:xs++[v]+    (v :+ ve) .+. (w :+ we) = v .+^ toVec w :+ (ve,we)      cmpAngle v v' w w' =-      ccwCmpAround (ext $ origin) (ext . Point $ v' .-. v) (ext . Point $ w' .-. w)+      ccwCmpAround origin (Point $ v' .-. v) (Point $ w' .-. w)      merge' [_]       [_]       = []     merge' vs@[v]    (w:ws)    = v .+. w : merge' vs ws@@ -352,32 +500,117 @@         LT -> merge' (v':vs)   (w:w':ws)         GT -> merge' (v:v':vs) (w':ws)         EQ -> merge' (v':vs)   (w':ws)-    merge' _         _         = error $ "minkowskiSum: Should not happen"+    merge' _         _         = error "minkowskiSum: Should not happen"  +--------------------------------------------------------------------------------+-- inConvex +-- 1. Check if p is on left edge or right edge.+-- 2. Do binary search:+--       Find the largest n where p is on the right of 0 to n.+-- 3. Check if p is on segment n,n+1+-- 4. Check if p is in triangle 0,n,n+1 +-- | \( O(\log n) \)+--   Check if a point lies inside a convex polygon, on the boundary, or outside of the+--   convex polygon.+inConvex :: forall p r. (Fractional r, Ord r)+         => Point 2 r -> ConvexPolygon p r+         -> PointLocationResult+inConvex p (ConvexPolygon poly)+  | p `intersects` leftEdge  = OnBoundary+  | p `intersects` rightEdge = OnBoundary+  | otherwise                = worker 1 n+  where+    p'        = p :+ undefined+    n         = size poly - 1+    point0    = point 0+    leftEdge  = ClosedLineSegment point0 (point n)+    rightEdge = ClosedLineSegment point0 (point 1)+    worker a b+      | a+1 == b                        =+        if p `intersects` (ClosedLineSegment (point a) (point b))+          then OnBoundary+          else+            if inTriangle p (Triangle point0 (point a) (point b)) == Outside+              then Outside+              else Inside+      | ccw' point0 (point c) p' == CCW = worker c b+      | otherwise                       = worker a c+      where c = (a+b) `div` 2+    point x = poly ^. outerVertex x+ --------------------------------------------------------------------------------+-- Diameter +-- | \( O(n) \) Computes the Euclidean diameter by scanning antipodal pairs.+diameter :: (Ord r, Floating r) => ConvexPolygon p r -> r+diameter p = euclideanDist (a^.core) (b^.core)+  where+    (a,b) = diametralPair p++-- | \( O(n) \)+--   Computes the Euclidean diametral pair by scanning antipodal pairs.+diametralPair :: (Ord r, Num r) => ConvexPolygon p r -> (Point 2 r :+ p, Point 2 r :+ p)+diametralPair p = (p^.simplePolygon.outerVertex a, p^.simplePolygon.outerVertex b)+  where+    (a,b) = diametralIndexPair p++-- | \( O(n) \)+--   Computes the Euclidean diametral pair by scanning antipodal pairs.+diametralIndexPair :: (Ord r, Num r) => ConvexPolygon p r -> (Int, Int)+diametralIndexPair p = F.maximumBy fn $ antipodalPairs p+  where+    fn (a1,b1) (a2,b2) =+      squaredEuclideanDist (p^.simplePolygon.outerVertex a1.core) (p^.simplePolygon.outerVertex b1.core)+        `compare`+      squaredEuclideanDist (p^.simplePolygon.outerVertex a2.core) (p^.simplePolygon.outerVertex b2.core)++antipodalPairs :: forall p r. (Ord r, Num r) => ConvexPolygon p r -> [(Int, Int)]+antipodalPairs p = worker 0 (CV.index vectors 0) 1+  where+    n = size (p^.simplePolygon)+    vs = p^.simplePolygon.outerBoundaryVector++    worker a aElt b+      | a == n = []+      | otherwise =+        case ccw aElt (Point2 0 0) (CV.index vectors b) of+          CW -> worker a aElt (b+1)+          _  ->+            (a, b `mod` n) :+            worker (a+1) (CV.index vectors (a+1)) b++    vectors :: CircularVector (Point 2 r)+    vectors = CV.unsafeFromVector $ V.generate n $ \i ->+      let Point p1 = point i+          p2 = point (i+1)+      in p2 .-^ p1++    point x = CV.index vs x ^. core++--------------------------------------------------------------------------------+ -- | Rotate to the rightmost point (rightmost and topmost in case of ties)-rightMost    :: Ord r => CSeq (Point 2 r :+ p) -> CSeq (Point 2 r :+ p)-rightMost xs = let m = F.maximumBy (comparing (^.core)) xs in rotateTo' m xs+rightMost :: Ord r => CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)+rightMost = CV.rotateToMaximumBy (comparing (^.core))  -- | Rotate to the leftmost point (and bottommost in case of ties)-leftMost    :: Ord r => CSeq (Point 2 r :+ p) -> CSeq (Point 2 r :+ p)-leftMost xs = let m = F.minimumBy (comparing (^.core)) xs in rotateTo' m xs+leftMost :: Ord r => CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)+leftMost = CV.rotateToMinimumBy (comparing (^.core))  -- | Rotate to the bottommost point (and leftmost in case of ties)-bottomMost    :: Ord r => CSeq (Point 2 r :+ p) -> CSeq (Point 2 r :+ p)-bottomMost xs = let f p = (p^.core.yCoord,p^.core.xCoord)-                    m   = F.minimumBy (comparing f) xs-                in rotateTo' m xs+bottomMost :: Ord r => CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)+bottomMost = CV.rotateToMinimumBy (comparing f)+  where+    f p = (p^.core.yCoord,p^.core.xCoord)    -- | Helper to get the vertices of a convex polygon-getVertices :: ConvexPolygon p r -> CSeq (Point 2 r :+ p)-getVertices = view (simplePolygon.outerBoundary)+getVertices :: ConvexPolygon p r -> CircularVector (Point 2 r :+ p)+getVertices = view (simplePolygon.outerBoundaryVector)  -- -- | rotate right while p 'current' 'rightNeibhour' is true -- rotateRWhile      :: (a -> a -> Bool) -> C.CList a -> C.CList a@@ -401,3 +634,76 @@  -- testB :: Num r => ConvexPolygon () r -- testB = ConvexPolygon . fromPoints . map ext $ [origin, Point2 5 3, Point2 (-2) 2, Point2 (-2) 1]+++++--------------------------------------------------------------------------------+-- Random convex polygons++-- This is true for all convex polygons:+--   1. the sum of all edge vectors is (0,0). This is even true for all polygons.+--   2. edges are sorted by angle. Ie. all vertices are convex, not reflex.+--+-- So, if we can generate a set of vectors that sum to zero then we can sort them+-- and place them end-to-end and the result will be a convex polygon.+--+-- So, we need to generate N points that sum to 0. This can be done by generating+-- two sets of N points that sum to M, and the subtracting them from each other.+--+-- Generating N points that sum to M is done like this: Generate (N-1) unique points+-- between (but not including) 0 and M. Write down the distance between the points.+-- Imagine a scale from 0 to M:+--   0            M+--   |            |+-- Then we add two randomly selected points:+--   0            M+--   |  *      *  |+-- Then we look at the distance between 0 and point1, point1 and point2, and point2 to M:+--   0            M+--   |--*------*--|+--    2     6    2+-- 2+6+2 = 10 = M+--+-- Doing this again might yield [5,2,3]. Subtract them:+--     [2,   6,   2  ]+--   - [5,   2,   3  ]+--   = [2-5, 6-2, 2-3]+--   = [-3,  4,   -1 ]+-- And the sum of [-3, 4, -1] = -3+4-1 = 0.++-- O(n log n)+randomBetween :: RandomGen g => Int -> Int -> Rand g (VU.Vector Int)+randomBetween n vMax | vMax < n+1 = pure $ VU.replicate vMax 1+randomBetween n vMax = worker (n-1) IS.empty+  where+    gen from []     = [vMax-from]+    gen from (x:xs) = (x-from) : gen x xs+    worker 0 seen = pure (VU.fromList (gen 0 $ IS.elems seen))+    worker i seen = do+      v <- getRandomR (1, vMax-1)+      if IS.member v seen+        then worker i seen+        else worker (i-1) (IS.insert v seen)++randomBetweenZero :: RandomGen g => Int -> Int -> Rand g (VU.Vector Int)+randomBetweenZero n vMax = VU.zipWith (-) <$> randomBetween n vMax <*> randomBetween n vMax++randomEdges :: RandomGen g => Int -> Int -> Rand g [Vector 2 Int]+randomEdges n vMax = do+  zipWith Vector2+    <$> fmap VU.toList (randomBetweenZero n vMax)+    <*> fmap VU.toList (randomBetweenZero n vMax)++-- | \( O(n \log n) \)+--   Generate a uniformly random ConvexPolygon with @N@ vertices and a granularity of @vMax@.+randomConvex :: RandomGen g => Int -> Int -> Rand g (ConvexPolygon () Rational)+randomConvex n _vMax | n < 3 =+  error "Data.Geometry.Polygon.Convex.randomConvex: At least 3 edges are required."+randomConvex n vMax = do+  ~(v:vs) <- coerce . sortAround origin . coerce <$> randomEdges n vMax+  let vertices = fmap ((/ realToFrac vMax) . realToFrac) <$> scanl (.+^) (Point v) vs+      pRational = unsafeFromPoints $ map ext vertices+      Point c = centroid pRational+      pFinal = pRational & unsafeOuterBoundaryVector %~ CV.map (over core (.-^ c))+  pure $ ConvexPolygon pFinal
src/Data/Geometry/Polygon/Core.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------------------- -- | -- Module      :  Data.Geometry.Polygon.Core@@ -8,104 +9,167 @@ -- A Polygon data type and some basic functions to interact with them. -- ---------------------------------------------------------------------------------module Data.Geometry.Polygon.Core( PolygonType(..)-                                 , Polygon(..)-                                 , _SimplePolygon, _MultiPolygon-                                 , SimplePolygon, MultiPolygon, SomePolygon+module Data.Geometry.Polygon.Core+  ( PolygonType(..)+  , Polygon(..)+  , Vertices+  , _SimplePolygon, _MultiPolygon+  , SimplePolygon, MultiPolygon, SomePolygon +    -- * Construction+  , fromPoints+  , fromCircularVector -                                 , fromPoints+  , simpleFromPoints+  , simpleFromCircularVector -                                 , polygonVertices, listEdges+  , unsafeFromPoints+  , unsafeFromCircularVector+  , unsafeFromVector+  , toVector+  , toPoints -                                 , outerBoundary, outerBoundaryEdges-                                 , outerVertex, outerBoundaryEdge+  , isSimple -                                 , polygonHoles, polygonHoles'-                                 , holeList+  , size+  , polygonVertices, listEdges -                                 , inPolygon, insidePolygon, onBoundary+  , outerBoundary, outerBoundaryVector+  , unsafeOuterBoundaryVector+  , outerBoundaryEdges+  , outerVertex, unsafeOuterVertex+  , outerBoundaryEdge -                                 , area, signedArea+  , polygonHoles, polygonHoles'+  , holeList -                                 , centroid-                                 , pickPoint+  , area, signedArea -                                 , isTriangle+  , centroid+  , pickPoint -                                 , isCounterClockwise-                                 , toCounterClockWiseOrder, toCounterClockWiseOrder'-                                 , toClockwiseOrder, toClockwiseOrder'-                                 , reverseOuterBoundary+  , isTriangle -                                 , findDiagonal+  , isCounterClockwise+  , toCounterClockWiseOrder, toCounterClockWiseOrder'+  , toClockwiseOrder, toClockwiseOrder'+  , reverseOuterBoundary -                                 , withIncidentEdges, numberVertices+  , findDiagonal -                                 , asSimplePolygon-                                 ) where+  , withIncidentEdges, numberVertices +  -- * Testing for Reflex or Convex++  , isReflexVertex, isConvexVertex, isStrictlyConvexVertex+  , reflexVertices, convexVertices, strictlyConvexVertices++    -- * Specialized folds+  , maximumVertexBy+  , minimumVertexBy+  , findRotateTo+  , rotateLeft+  , rotateRight+  ) where++import qualified Algorithms.Geometry.LineSegmentIntersection.BentleyOttmann as BO import           Control.DeepSeq-import           Control.Lens hiding (Simple)+import           Control.Lens                                               (Getter, Lens', Prism',+                                                                             Traversal', lens, over,+                                                                             prism', to, toListOf,+                                                                             view, (%~), (&), (.~),+                                                                             (^.))+import           Data.Aeson import           Data.Bifoldable import           Data.Bifunctor import           Data.Bitraversable-import qualified Data.CircularSeq as C import           Data.Ext-import qualified Data.Foldable as F+import qualified Data.Foldable                                              as F import           Data.Geometry.Boundary-import           Data.Geometry.Box+import           Data.Geometry.Box                                          (IsBoxable (..),+                                                                             boundingBoxList') import           Data.Geometry.Line import           Data.Geometry.LineSegment import           Data.Geometry.Point import           Data.Geometry.Properties import           Data.Geometry.Transformation-import           Data.Geometry.Triangle (Triangle(..), inTriangle)-import           Data.Geometry.Vector-import qualified Data.List as List-import           Data.List.NonEmpty (NonEmpty(..))-import qualified Data.List.NonEmpty as NonEmpty-import           Data.Maybe (mapMaybe, catMaybes)-import           Data.Ord (comparing)-import           Data.Semigroup (sconcat)+import           Data.Geometry.Triangle                                     (Triangle (..),+                                                                             inTriangle)+import           Data.Geometry.Vector                                       (Additive (zero, (^+^)),+                                                                             Affine ((.+^), (.-.)),+                                                                             (*^), (^*), (^/))+import qualified Data.List                                                  as List+import qualified Data.List.NonEmpty                                         as NonEmpty+import           Data.Maybe                                                 (catMaybes)+import           Data.Ord                                                   (comparing)+import           Data.Semigroup                                             (sconcat) import           Data.Semigroup.Foldable-import qualified Data.Sequence as Seq import           Data.Util-import           Data.Vinyl.CoRec (asA)+import           Data.Vector                                                (Vector)+import qualified Data.Vector                                                as V+import           Data.Vector.Circular                                       (CircularVector)+import qualified Data.Vector.Circular                                       as CV+import qualified Data.Vector.Circular.Util                                  as CV + -- import Data.RealNumber.Rational  --------------------------------------------------------------------------------  {- $setup >>> import Data.RealNumber.Rational+>>> import Data.Foldable+>>> import Control.Lens.Extras >>> :{--- import qualified Data.CircularSeq as C+-- import qualified Data.Vector.Circular as CV let simplePoly :: SimplePolygon () (RealNumber 10)-    simplePoly = SimplePolygon . C.fromList . map ext $ [ Point2 0 0-                                                        , Point2 10 0-                                                        , Point2 10 10-                                                        , Point2 5 15-                                                        , Point2 1 11-                                                        ]+    simplePoly = fromPoints . map ext $+      [ Point2 0 0+      , Point2 10 0+      , Point2 10 10+      , Point2 5 15+      , Point2 1 11+      ]+    simpleTriangle :: SimplePolygon () (RealNumber 10)+    simpleTriangle = fromPoints  . map ext $+      [ Point2 0 0, Point2 2 0, Point2 1 1]+    multiPoly :: MultiPolygon () (RealNumber 10)+    multiPoly = MultiPolygon+      (fromPoints . map ext $ [Point2 (-1) (-1), Point2 3 (-1), Point2 2 2])+      [simpleTriangle] :} -} --- | We distinguish between simple polygons (without holes) and Polygons with holes.+-- | We distinguish between simple polygons (without holes) and polygons with holes. data PolygonType = Simple | Multi -+-- | 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. data Polygon (t :: PolygonType) p r where-  SimplePolygon :: C.CSeq (Point 2 r :+ p)                         -> Polygon Simple p r-  MultiPolygon  :: C.CSeq (Point 2 r :+ p) -> [Polygon Simple p r] -> Polygon Multi  p r+  SimplePolygon :: Vertices (Point 2 r :+ p)                -> SimplePolygon p r+  MultiPolygon  :: SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon  p r +newtype Vertices a = Vertices (CircularVector a)+  deriving (Functor, Foldable, Foldable1, Traversable, NFData, Eq, Ord)+ -- | Prism to 'test' if we are a simple polygon-_SimplePolygon :: Prism' (Polygon Simple p r) (C.CSeq (Point 2 r :+ p))+--+-- >>> is _SimplePolygon simplePoly+-- True+_SimplePolygon :: Prism' (Polygon Simple p r) (Vertices (Point 2 r :+ p)) _SimplePolygon = prism' SimplePolygon (\(SimplePolygon vs) -> Just vs)  -- | Prism to 'test' if we are a Multi polygon-_MultiPolygon :: Prism' (Polygon Multi p r) (C.CSeq (Point 2 r :+ p), [Polygon Simple p r])+--+-- >>> is _MultiPolygon multiPoly+-- True+_MultiPolygon :: Prism' (Polygon Multi p r) (Polygon Simple p r, [Polygon Simple p r]) _MultiPolygon = prism' (uncurry MultiPolygon) (\(MultiPolygon vs hs) -> Just (vs,hs)) +instance Functor (Polygon t p) where+  fmap = bimap id+ instance Bifunctor (Polygon t) where   bimap = bimapDefault @@ -115,7 +179,7 @@ instance Bitraversable (Polygon t) where   bitraverse f g p = case p of     SimplePolygon vs   -> SimplePolygon <$> bitraverseVertices f g vs-    MultiPolygon vs hs -> MultiPolygon  <$> bitraverseVertices f g vs+    MultiPolygon vs hs -> MultiPolygon  <$> bitraverse f g vs                                         <*> traverse (bitraverse f g) hs  instance (NFData p, NFData r) => NFData (Polygon t p r) where@@ -126,8 +190,10 @@                   -> t (Point 2 r :+ p) -> f (t (Point 2 s :+ q)) bitraverseVertices f g = traverse (bitraverse (traverse g) f) +-- | Polygon without holes. type SimplePolygon = Polygon Simple +-- | Polygon with zero or more holes. type MultiPolygon  = Polygon Multi  -- | Either a simple or multipolygon@@ -141,9 +207,23 @@ type instance NumType   (Polygon t p r) = r  instance (Show p, Show r) => Show (Polygon t p r) where-  show (SimplePolygon vs)   = "SimplePolygon (" <> show vs <> ")"+  show (SimplePolygon vs)   = "SimplePolygon " <> show (F.toList vs)   show (MultiPolygon vs hs) = "MultiPolygon (" <> show vs <> ") (" <> show hs <> ")" +instance (Read p, Read r) => Read (SimplePolygon p r) where+  readsPrec d = readParen (d > app_prec) $ \r ->+      [ (unsafeFromPoints vs, t)+      | ("SimplePolygon", s) <- lex r, (vs, t) <- reads s ]+    where app_prec = 10++instance (Read p, Read r) => Read (MultiPolygon p r) where+  readsPrec d = readParen (d > app_prec) $ \r ->+      [ (MultiPolygon vs hs, t')+      | ("MultiPolygon", s) <- lex r+      , (vs, t) <- reads s+      , (hs, t') <- reads t ]+    where app_prec = 10+ -- instance (Read p, Read r) => Show (Polygon t p r) where --   show (SimplePolygon vs)   = "SimplePolygon (" <> show vs <> ")" --   show (MultiPolygon vs hs) = "MultiPolygon (" <> show vs <> ") (" <> show hs <> ")"@@ -156,54 +236,94 @@  instance PointFunctor (Polygon t p) where   pmap f (SimplePolygon vs)   = SimplePolygon (fmap (first f) vs)-  pmap f (MultiPolygon vs hs) = MultiPolygon  (fmap (first f) vs) (map (pmap f) hs)+  pmap f (MultiPolygon vs hs) = MultiPolygon  (pmap f vs) (map (pmap f) hs)  instance Fractional r => IsTransformable (Polygon t p r) where   transformBy = transformPointFunctor  instance IsBoxable (Polygon t p r) where-  boundingBox = boundingBoxList' . toListOf (outerBoundary.traverse.core)+  boundingBox = boundingBoxList' . toListOf (outerBoundaryVector.traverse.core) -type instance IntersectionOf (Line 2 r) (Boundary (Polygon t p r)) =-  '[Seq.Seq (Either (Point 2 r) (LineSegment 2 () r))] -type instance IntersectionOf (Point 2 r) (Polygon t p r) = [NoIntersection, Point 2 r]--instance (Fractional r, Ord r) => (Point 2 r) `IsIntersectableWith` (Polygon t p r) where-  nonEmptyIntersection = defaultNonEmptyIntersection-  q `intersects` pg = q `inPolygon` pg /= Outside-  q `intersect` pg | q `intersects` pg = coRec q-                   | otherwise         = coRec NoIntersection+instance (ToJSON r, ToJSON p) => ToJSON (Polygon t p r) where+  toJSON     = \case+    (SimplePolygon vs)   -> object [ "tag"           .= ("SimplePolygon" :: String)+                                   , "vertices"      .= F.toList vs+                                   ]+    (MultiPolygon vs hs) -> object [ "tag"           .= ("MultiPolygon" :: String)+                                   , "outerBoundary" .= getVertices vs+                                   , "holes"         .= map getVertices hs+                                   ]+      where+        getVertices = view (outerBoundaryVector.to F.toList) --- instance IsIntersectableWith (Line 2 r) (Boundary (Polygon t p r)) where---   nonEmptyIntersection _ _ (CoRec xs) = null xs---   l `intersect` (Boundary (SimplePolygon vs)) =---     undefined-  -- l `intersect` (Boundary (MultiPolygon vs hs)) = coRec .-  --    Seq.sortBy f . Seq.fromList-  --     . concatMap (unpack . (l `intersect`) . Boundary)-  --     $ SimplePolygon vs : hs-  --   where-  --     unpack (CoRec x) = x-  --     f = undefined+instance (FromJSON r, Eq r, Num r, FromJSON p) => FromJSON (Polygon Simple p r) where+  parseJSON = withObject "Polygon" $ \o -> o .: "tag" >>= \case+                                             "SimplePolygon" -> pSimple o+                                             (_ :: String)   -> fail "Not a SimplePolygon"+    where+      pSimple o = fromPoints <$> o .: "vertices" +instance (FromJSON r, Eq r, Num r, FromJSON p) => FromJSON (Polygon Multi p r) where+  parseJSON = withObject "Polygon" $ \o -> o .: "tag" >>= \case+                                             "MultiPolygon"  -> pMulti o+                                             (_ :: String)   -> fail "Not a MultiPolygon"+    where+      pMulti  o = (\vs hs -> MultiPolygon (fromPoints vs) (map fromPoints hs))+               <$> o .: "outerBoundary" <*> o .: "holes"    -- * Functions on Polygons -outerBoundary :: forall t p r. Lens' (Polygon t p r) (C.CSeq (Point 2 r :+ p))+-- | Getter access to the outer boundary vector of a polygon.+--+-- >>> toList (simpleTriangle ^. outerBoundaryVector)+-- [Point2 0 0 :+ (),Point2 2 0 :+ (),Point2 1 1 :+ ()]+outerBoundaryVector :: forall t p r. Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))+outerBoundaryVector = to g+  where+    g                     :: Polygon t p r -> CircularVector (Point 2 r :+ p)+    g (SimplePolygon (Vertices vs))                  = vs+    g (MultiPolygon (SimplePolygon (Vertices vs)) _) = vs++-- | 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 :+ ()]+unsafeOuterBoundaryVector :: forall t p r. Lens' (Polygon t p r) (CircularVector (Point 2 r :+ p))+unsafeOuterBoundaryVector = lens g s+  where+    g                     :: Polygon t p r -> CircularVector (Point 2 r :+ p)+    g (SimplePolygon (Vertices vs))                  = vs+    g (MultiPolygon (SimplePolygon (Vertices vs)) _) = vs++    s                           :: Polygon t p r -> CircularVector (Point 2 r :+ p)+                                -> Polygon t p r+    s SimplePolygon{}     vs = SimplePolygon (Vertices vs)+    s (MultiPolygon _ hs) vs = MultiPolygon (SimplePolygon (Vertices vs)) hs+++-- | \( O(1) \) Lens access to the outer boundary of a polygon.+outerBoundary :: forall t p r. Lens' (Polygon t p r) (SimplePolygon p r) outerBoundary = lens g s   where-    g                     :: Polygon t p r -> C.CSeq (Point 2 r :+ p)-    g (SimplePolygon vs)  = vs-    g (MultiPolygon vs _) = vs+    g                     :: Polygon t p r -> SimplePolygon p r+    g poly@SimplePolygon{}    = poly+    g (MultiPolygon simple _) = simple -    s                           :: Polygon t p r -> C.CSeq (Point 2 r :+ p)+    s                           :: Polygon t p r -> SimplePolygon p r                                 -> Polygon t p r-    s (SimplePolygon _)      vs = SimplePolygon vs-    s (MultiPolygon  _   hs) vs = MultiPolygon vs hs+    s SimplePolygon{} simple     = simple+    s (MultiPolygon _ hs) simple = MultiPolygon simple hs +-- | Lens access for polygon holes.+--+-- >>> multiPoly ^. polygonHoles+-- [SimplePolygon [Point2 0 0 :+ (),Point2 2 0 :+ (),Point2 1 1 :+ ()]] polygonHoles :: forall p r. Lens' (Polygon Multi p r) [Polygon Simple p r] polygonHoles = lens g s   where@@ -213,16 +333,30 @@                           -> Polygon Multi p r     s (MultiPolygon vs _) = MultiPolygon vs +{- HLINT ignore polygonHoles' -}+-- | \( O(1) \). Traversal lens for polygon holes. Does nothing for simple polygons. polygonHoles' :: Traversal' (Polygon t p r) [Polygon Simple p r] polygonHoles' = \f -> \case-  p@(SimplePolygon _)  -> pure p-  (MultiPolygon vs hs) -> MultiPolygon vs <$> f hs+  p@SimplePolygon{}  -> pure p+  MultiPolygon vs hs -> MultiPolygon vs <$> f hs --- | Access the i^th vertex on the outer boundary-outerVertex   :: Int -> Lens' (Polygon t p r) (Point 2 r :+ p)-outerVertex i = outerBoundary.C.item i+-- | /O(1)/ Access the i^th vertex on the outer boundary. Indices are modulo \(n\).+--+-- >>> simplePoly ^. outerVertex 0+-- Point2 0 0 :+ ()+outerVertex   :: Int -> Getter (Polygon t p r) (Point 2 r :+ p)+outerVertex i = outerBoundaryVector . CV.item i --- running time: \(O(\log i)\)+-- | \( O(1) \) read and \( O(n) \) write. Access the i^th vertex on the outer boundary+--+-- >>> simplePoly ^. unsafeOuterVertex 0+-- Point2 0 0 :+ ()+-- >>> simplePoly & unsafeOuterVertex 0 .~ (Point2 10 10 :+ ())+-- SimplePolygon [Point2 10 10 :+ (),Point2 10 0 :+ (),Point2 10 10 :+ (),Point2 5 15 :+ (),Point2 1 11 :+ ()]+unsafeOuterVertex   :: Int -> Lens' (Polygon t p r) (Point 2 r :+ p)+unsafeOuterVertex i = unsafeOuterBoundaryVector . CV.item i++-- | \( O(1) \) Get the n^th edge along the outer boundary of the polygon. The edge is half open. outerBoundaryEdge     :: Int -> Polygon t p r -> LineSegment 2 p r outerBoundaryEdge i p = let u = p^.outerVertex i                             v = p^.outerVertex (i+1)@@ -231,36 +365,116 @@  -- | Get all holes in a polygon holeList                     :: Polygon t p r -> [Polygon Simple p r]-holeList (SimplePolygon _)   = []+holeList SimplePolygon{}     = [] holeList (MultiPolygon _ hs) = hs  --- | The vertices in the polygon. No guarantees are given on the order in which+-- | \( O(1) \) Vertex count. Includes the vertices of holes.+size :: Polygon t p r -> Int+size (SimplePolygon (Vertices cv)) = F.length cv+size (MultiPolygon b hs)           = sum (map size (b:hs))++-- | \( O(n) \) The vertices in the polygon. No guarantees are given on the order in which -- they appear! polygonVertices                      :: Polygon t p r                                      -> NonEmpty.NonEmpty (Point 2 r :+ p)-polygonVertices (SimplePolygon vs)   = toNonEmpty vs+polygonVertices p@SimplePolygon{}    = toNonEmpty $ p^.outerBoundaryVector polygonVertices (MultiPolygon vs hs) =-  sconcat $ toNonEmpty vs NonEmpty.:| map polygonVertices hs+  sconcat $ toNonEmpty (polygonVertices vs) NonEmpty.:| map polygonVertices hs +-- FIXME: Get rid of 'Fractional r' constraint.+-- | \( O(n \log n) \) Check if a polygon has any holes, duplicate points, or+--   self-intersections.+isSimple :: (Ord r, Fractional r) => Polygon p t r -> Bool+isSimple p@SimplePolygon{}   = null . BO.interiorIntersections $ listEdges p+isSimple (MultiPolygon b []) = isSimple b+isSimple MultiPolygon{}      = False --- | Creates a simple polygon from the given list of vertices.+requireThree :: String -> [a] -> [a]+requireThree _ lst@(_:_:_:_) = lst+requireThree label _ = error $+  "Data.Geometry.Polygon." ++ label ++ ": Polygons must have at least three points."++-- | \( 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.+--+fromPoints :: forall p r. (Eq r, Num r) => [Point 2 r :+ p] -> SimplePolygon p r+fromPoints = fromCircularVector . CV.unsafeFromList . requireThree "fromPoints"++-- | \( 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.+--+fromCircularVector :: forall p r. (Eq r, Num r) => CircularVector (Point 2 r :+ p) -> SimplePolygon p r+fromCircularVector = toCounterClockWiseOrder . unsafeFromCircularVector++-- | \( 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.+--+simpleFromPoints :: forall p r. (Ord r, Fractional r) => [Point 2 r :+ p] -> SimplePolygon p r+simpleFromPoints =+  simpleFromCircularVector . CV.unsafeFromList . requireThree "simpleFromPoints"++-- | \( 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.+--+simpleFromCircularVector :: forall p r. (Ord r, Fractional r)+  => CircularVector (Point 2 r :+ p) -> SimplePolygon p r+simpleFromCircularVector v =+  let p = fromCircularVector v+      hasInteriorIntersections = not . null . BO.interiorIntersections+  in if hasInteriorIntersections (listEdges p)+      then error "Data.Geometry.Polygon.simpleFromCircularVector: \+                 \Found self-intersections or repeated vertices."+      else p++-- | \( O(n) \) Creates a simple polygon from the given list of vertices.+-- -- pre: the input list constains no repeated vertices.-fromPoints :: [Point 2 r :+ p] -> SimplePolygon p r-fromPoints = SimplePolygon . C.fromList+unsafeFromPoints :: [Point 2 r :+ p] -> SimplePolygon p r+unsafeFromPoints = unsafeFromCircularVector . CV.unsafeFromList +-- | \( O(1) \) Creates a simple polygon from the given vector of vertices.+--+-- pre: the input list constains no repeated vertices.+unsafeFromCircularVector :: CircularVector (Point 2 r :+ p) -> SimplePolygon p r+unsafeFromCircularVector = SimplePolygon . Vertices --- | The edges along the outer boundary of the polygon. The edges are half open.+-- | \( O(1) \) Creates a simple polygon from the given vector of vertices. ----- running time: \(O(n)\)-outerBoundaryEdges :: Polygon t p r -> C.CSeq (LineSegment 2 p r)-outerBoundaryEdges = toEdges . (^.outerBoundary)+-- pre: the input list constains no repeated vertices.+unsafeFromVector :: Vector (Point 2 r :+ p) -> SimplePolygon p r+unsafeFromVector = unsafeFromCircularVector . CV.unsafeFromVector --- | Lists all edges. The edges on the outer boundary are given before the ones+-- -- | Polygon points, from left to right.+-- toList :: Polygon t p r -> [Point 2 r :+ p]+-- toList (SimplePolygon c)   = F.toList c+-- toList (MultiPolygon s hs) = toList s ++ concatMap toList hs++-- | \( O(n) \)+--   Polygon points, from left to right.+toVector :: Polygon t p r -> Vector (Point 2 r :+ p)+toVector p@SimplePolygon{}   = CV.toVector $ p^.outerBoundaryVector+toVector (MultiPolygon s hs) = foldr (<>) (toVector s) (map toVector hs)++-- | \( O(n) \)+--   Polygon points, from left to right.+toPoints :: Polygon t p r -> [Point 2 r :+ p]+toPoints = V.toList . toVector++-- | \( O(n) \) The edges along the outer boundary of the polygon. The edges are half open.+outerBoundaryEdges :: Polygon t p r -> CircularVector (LineSegment 2 p r)+outerBoundaryEdges = toEdges . (^.outerBoundaryVector)++-- | \( 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.------ running time: \(O(n)\) listEdges    :: Polygon t p r -> [LineSegment 2 p r] listEdges pg = let f = F.toList . outerBoundaryEdges                in  f pg <> concatMap f (holeList pg)@@ -271,20 +485,21 @@ -- -- -- >>> mapM_ print . polygonVertices $ withIncidentEdges simplePoly--- Point2 [0,0] :+ V2 LineSegment (Closed (Point2 [1,11] :+ ())) (Closed (Point2 [0,0] :+ ())) LineSegment (Closed (Point2 [0,0] :+ ())) (Closed (Point2 [10,0] :+ ()))--- Point2 [10,0] :+ V2 LineSegment (Closed (Point2 [0,0] :+ ())) (Closed (Point2 [10,0] :+ ())) LineSegment (Closed (Point2 [10,0] :+ ())) (Closed (Point2 [10,10] :+ ()))--- Point2 [10,10] :+ V2 LineSegment (Closed (Point2 [10,0] :+ ())) (Closed (Point2 [10,10] :+ ())) LineSegment (Closed (Point2 [10,10] :+ ())) (Closed (Point2 [5,15] :+ ()))--- Point2 [5,15] :+ V2 LineSegment (Closed (Point2 [10,10] :+ ())) (Closed (Point2 [5,15] :+ ())) LineSegment (Closed (Point2 [5,15] :+ ())) (Closed (Point2 [1,11] :+ ()))--- Point2 [1,11] :+ V2 LineSegment (Closed (Point2 [5,15] :+ ())) (Closed (Point2 [1,11] :+ ())) LineSegment (Closed (Point2 [1,11] :+ ())) (Closed (Point2 [0,0] :+ ()))+-- 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 :+ ())) withIncidentEdges                    :: Polygon t p r                                      -> Polygon t (Two (LineSegment 2 p r)) r-withIncidentEdges (SimplePolygon vs) =-      SimplePolygon $ C.zip3LWith f (C.rotateL vs) vs (C.rotateR vs)+withIncidentEdges poly@SimplePolygon{} =+      unsafeFromCircularVector $ CV.zipWith3 f (CV.rotateLeft 1 vs) vs (CV.rotateRight 1 vs)   where+    vs = poly ^. outerBoundaryVector     f p c n = c&extra .~ Two (ClosedLineSegment p c) (ClosedLineSegment c n) withIncidentEdges (MultiPolygon vs hs) = MultiPolygon vs' hs'   where-    (SimplePolygon vs') = withIncidentEdges $ SimplePolygon vs+    vs' = withIncidentEdges vs     hs' = map withIncidentEdges hs  -- -- | Gets the i^th edge on the outer boundary of the polygon, that is the edge@@ -292,143 +507,33 @@ -- -- modulo n. -- -- +-- FIXME: Test that \poly -> fromEdges (toEdges poly) == poly -- | Given the vertices of the polygon. Produce a list of edges. The edges are -- half-open.-toEdges    :: C.CSeq (Point 2 r :+ p) -> C.CSeq (LineSegment 2 p r)-toEdges vs = C.zipLWith (\p q -> LineSegment (Closed p) (Open q)) vs (C.rotateR vs)-  -- let vs' = F.toList vs in-  -- C.fromList $ zipWith (\p q -> LineSegment (Closed p) (Open q)) vs' (tail vs' ++ vs')----- | Test if q lies on the boundary of the polygon. Running time: O(n)------ >>> 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-onBoundary        :: (Fractional r, Ord r) => Point 2 r -> Polygon t p r -> Bool-q `onBoundary` pg = any (q `onSegment`) es-  where-    out = SimplePolygon $ pg^.outerBoundary-    es = concatMap (F.toList . outerBoundaryEdges) $ out : holeList pg---- | 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-inPolygon                                :: forall t p r. (Fractional r, Ord r)-                                         => Point 2 r -> Polygon t p r-                                         -> PointLocationResult-q `inPolygon` pg-    | q `onBoundary` pg                             = OnBoundary-    | odd kl && odd kr && not (any (q `inHole`) hs) = Inside-    | otherwise                                     = Outside-  where-    l = horizontalLine $ q^.yCoord--    -- Given a line segment, compute the intersection point (if a point) with the-    -- line l-    intersectionPoint = asA @(Point 2 r) . (`intersect` l)--    -- Count the number of intersections that the horizontal line through q-    -- maxes with the polygon, that are strictly to the left and strictly to-    -- the right of q. If these numbers are both odd the point lies within the polygon.-    ---    ---    -- note that: - by the asA (Point 2 r) we ignore horizontal segments (as desired)-    --            - by the filtering, we effectively limit l to an open-half line, starting-    --               at the (open) point q.-    --            - by using half-open segments as edges we avoid double counting-    --               intersections that coincide with vertices.-    --            - If the point is outside, and on the same height as the-    --              minimum or maximum coordinate of the polygon. The number of-    --              intersections to the left or right may be one. Thus-    --              incorrectly classifying the point as inside. To avoid this,-    --              we count both the points to the left *and* to the right of-    --              p. Only if both are odd the point is inside.  so that if-    --              the point is outside, and on the same y-coordinate as one-    --              of the extermal vertices (one ofth)-    ---    -- See http://geomalgorithms.com/a03-_inclusion.html for more information.-    SP kl kr = count (\p -> (p^.xCoord) `compare` (q^.xCoord))-             . mapMaybe intersectionPoint . F.toList . outerBoundaryEdges $ pg--    -- For multi polygons we have to test if we do not lie in a hole .-    inHole = insidePolygon-    hs     = holeList pg--    count   :: (a -> Ordering) -> [a] -> SP Int Int-    count f = foldr (\x (SP lts gts) -> case f x of-                             LT -> SP (lts + 1) gts-                             EQ -> SP lts       gts-                             GT -> SP lts       (gts + 1)) (SP 0 0)----- | Test if a point lies strictly inside the polgyon.-insidePolygon        :: (Fractional r, Ord r) => Point 2 r -> Polygon t p r -> Bool-q `insidePolygon` pg = q `inPolygon` pg == Inside----- testQ = map (`inPolygon` testPoly) [ Point2 1 1    -- Inside---                                    , Point2 0 0    -- OnBoundary---                                    , Point2 5 14   -- Inside---                                    , Point2 5 10   -- Inside---                                    , Point2 10 5   -- OnBoundary---                                    , Point2 20 5   -- Outside---                                    ]---- testPoly :: SimplePolygon () Rational--- testPoly = SimplePolygon . C.fromList . map ext $ [ Point2 0 0---                                                   , Point2 10 0---                                                   , Point2 10 10---                                                   , Point2 5 15---                                                   , Point2 1 11---                                                   ]+toEdges    :: CircularVector (Point 2 r :+ p) -> CircularVector (LineSegment 2 p r)+toEdges vs = CV.zipWith (\p q -> LineSegment (Closed p) (Open q)) vs (CV.rotateRight 1 vs)  -- | Compute the area of a polygon area                        :: Fractional r => Polygon t p r -> r-area poly@(SimplePolygon _) = abs $ signedArea poly-area (MultiPolygon vs hs)   = area (SimplePolygon vs) - sum [area h | h <- hs]+area poly@SimplePolygon{} = abs $ signedArea poly+area (MultiPolygon vs hs) = area vs - sum [area h | h <- hs]   -- | 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. signedArea      :: Fractional r => SimplePolygon p r -> r-signedArea poly = x / 2+signedArea poly = signedArea2X poly / 2++-- | Compute the signed area times 2 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.+signedArea2X      :: Num r => SimplePolygon p r -> r+signedArea2X poly = x   where     x = sum [ p^.core.xCoord * q^.core.yCoord - q^.core.xCoord * p^.core.yCoord             | LineSegment' p q <- F.toList $ outerBoundaryEdges poly  ] - -- | Compute the centroid of a simple polygon. centroid      :: Fractional r => SimplePolygon p r -> Point 2 r centroid poly = Point $ sum' xs ^/ (6 * signedArea poly)@@ -439,43 +544,33 @@     sum' = F.foldl' (^+^) zero  --- | Pick a  point that is inside the polygon.+-- | \( 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------ running time: \(O(n)\) pickPoint    :: (Ord r, Fractional r) => Polygon p t r -> Point 2 r-pickPoint pg | isTriangle pg = centroid . SimplePolygon $ pg^.outerBoundary+pickPoint pg | isTriangle pg = centroid $ pg^.outerBoundary              | otherwise     = let LineSegment' (p :+ _) (q :+ _) = findDiagonal pg                                in p .+^ (0.5 *^ (q .-. p)) --- | Test if the polygon is a triangle------ running time: \(O(1)\)+-- | \( O(1) \) Test if the polygon is a triangle isTriangle :: Polygon p t r -> Bool isTriangle = \case-    SimplePolygon vs   -> go vs-    MultiPolygon vs [] -> go vs+    p@SimplePolygon{}  -> F.length (p^.outerBoundaryVector) == 3+    MultiPolygon vs [] -> isTriangle vs     MultiPolygon _  _  -> False-  where-    go vs = case toNonEmpty vs of-              (_ :| [_,_]) -> True-              _            -> False --- | Find a diagonal of the polygon.+-- | \( O(n) \) Find a diagonal of the polygon. -- -- pre: the polygon is given in CCW order------ running time: \(O(n)\) findDiagonal    :: (Ord r, Fractional r) => Polygon t p r -> LineSegment 2 p r findDiagonal pg = List.head . catMaybes . F.toList $ diags      -- note that a diagonal is guaranteed to exist, so the usage of head is safe.   where-    vs      = pg^.outerBoundary-    diags   = C.zip3LWith f (C.rotateL vs) vs (C.rotateR vs)+    vs      = pg^.outerBoundaryVector+    diags   = CV.zipWith3 f (CV.rotateLeft 1 vs) vs (CV.rotateRight 1 vs)     f u v w = case ccw (u^.core) (v^.core) (w^.core) of                 CCW      -> Just $ findDiag u v w                             -- v is a convex vertex, so find a diagonal@@ -508,59 +603,48 @@   xs -> Just $ List.maximumBy (comparing f) xs  --- | Test if the outer boundary of the polygon is in clockwise or counter+-- | \( O(n) \) Test if the outer boundary of the polygon is in clockwise or counter -- clockwise order.------ running time: \(O(n)\)----isCounterClockwise :: (Eq r, Fractional r) => Polygon t p r -> Bool-isCounterClockwise = (\x -> x == abs x) . signedArea-                   . fromPoints . F.toList . (^.outerBoundary)+isCounterClockwise :: (Eq r, Num r) => Polygon t p r -> Bool+isCounterClockwise = (\x -> x == abs x) . signedArea2X . view outerBoundary  --- | Make sure that every edge has the polygon's interior on its+-- | \( 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.------ running time: \(O(n)\)--- | Orient the outer boundary of the polygon to clockwise order-toClockwiseOrder   :: (Eq r, Fractional r) => Polygon t p r -> Polygon t p r-toClockwiseOrder p = (toClockwiseOrder' p)&polygonHoles'.traverse %~ toCounterClockWiseOrder'+toClockwiseOrder   :: (Eq r, Num r) => Polygon t p r -> Polygon t p r+toClockwiseOrder p = toClockwiseOrder' p & polygonHoles'.traverse %~ toCounterClockWiseOrder' --- | Orient the outer boundary into clockwise order. Leaves any holes+-- | \( O(n) \) Orient the outer boundary into clockwise order. Leaves any holes -- as they are. ---toClockwiseOrder'   :: (Eq r, Fractional r) => Polygon t p r -> Polygon t p r+toClockwiseOrder'   :: (Eq r, Num r) => Polygon t p r -> Polygon t p r toClockwiseOrder' pg       | isCounterClockwise pg = reverseOuterBoundary pg       | otherwise             = pg --- | Make sure that every edge has the polygon's interior on its left,+-- | \( 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.------ running time: \(O(n)\)-toCounterClockWiseOrder   :: (Eq r, Fractional r) => Polygon t p r -> Polygon t p r+toCounterClockWiseOrder   :: (Eq r, Num r) => Polygon t p r -> Polygon t p r toCounterClockWiseOrder p =-  (toCounterClockWiseOrder' p)&polygonHoles'.traverse %~ toClockwiseOrder'+  toCounterClockWiseOrder' p & polygonHoles'.traverse %~ toClockwiseOrder' --- | Orient the outer boundary into counter-clockwise order. Leaves+-- | \( O(n) \) Orient the outer boundary into counter-clockwise order. Leaves -- any holes as they are.----toCounterClockWiseOrder'   :: (Eq r, Fractional r) => Polygon t p r -> Polygon t p r+toCounterClockWiseOrder'   :: (Eq r, Num r) => Polygon t p r -> Polygon t p r toCounterClockWiseOrder' p       | not $ isCounterClockwise p = reverseOuterBoundary p       | otherwise                  = p +-- FIXME: Delete this function.+-- | 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.+-- reverseOuterBoundary   :: Polygon t p r -> Polygon t p r-reverseOuterBoundary p = p&outerBoundary %~ C.reverseDirection----- | Convert a Polygon to a simple polygon by forgetting about any holes.-asSimplePolygon                        :: Polygon t p r -> SimplePolygon p r-asSimplePolygon poly@(SimplePolygon _) = poly-asSimplePolygon (MultiPolygon vs _)    = SimplePolygon vs+reverseOuterBoundary p = p&unsafeOuterBoundaryVector %~ CV.reverse   -- | assigns unique integer numbers to all vertices. Numbers start from 0, and@@ -568,7 +652,164 @@ -- will be numbered last, in the same order. -- -- >>> numberVertices simplePoly--- SimplePolygon (CSeq [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 ()])+-- 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 ()] numberVertices :: Polygon t p r -> Polygon t (SP Int p) r-numberVertices = snd . bimapAccumL (\a p -> (a+1,SP a p)) (\a r -> (a,r)) 0+numberVertices = snd . bimapAccumL (\a p -> (a+1,SP a p)) (,) 0   -- TODO: Make sure that this does not have the same issues as foldl vs foldl'++--------------------------------------------------------------------------------+-- Specialized folds++-- maximum and minimum probably aren't useful. Disabled for now. Lemmih, 2020-12-26.++-- | \( O(n) \) Yield the maximum point of the polygon. Points are compared first by x-coordinate+--   and then by y-coordinate. The maximum point will therefore be the right-most point in+--   the polygon (and top-most if multiple points share the largest x-coordinate).+--+--   Hole vertices are ignored since they cannot be the maximum.+_maximum :: Ord r => Polygon t p r -> Point 2 r :+ p+_maximum = F.maximumBy (comparing _core) . view outerBoundaryVector++-- | \( O(n) \) Yield the maximum point of a polygon according to the given comparison function.+maximumVertexBy :: (Point 2 r :+ p -> Point 2 r :+ p -> Ordering) -> Polygon t p r -> Point 2 r :+ p+maximumVertexBy fn (SimplePolygon vs)  = F.maximumBy fn vs+maximumVertexBy fn (MultiPolygon b hs) = F.maximumBy fn $ map (maximumVertexBy fn) (b:hs)++-- | \( O(n) \) Yield the maximum point of the polygon. Points are compared first by x-coordinate+--   and then by y-coordinate. The minimum point will therefore be the left-most point in+--   the polygon (and bottom-most if multiple points share the smallest x-coordinate).+--+--   Hole vertices are ignored since they cannot be the minimum.+_minimum :: Ord r => Polygon t p r -> Point 2 r :+ p+_minimum = F.minimumBy (comparing _core) . view outerBoundaryVector++-- | \( 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+minimumVertexBy fn (SimplePolygon vs)  = F.minimumBy fn vs+minimumVertexBy fn (MultiPolygon b hs) = F.minimumBy fn $ map (minimumVertexBy fn) (b:hs)++-- | 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+findRotateTo :: (Point 2 r :+ p -> Bool) -> SimplePolygon p r -> Maybe (SimplePolygon p r)+findRotateTo fn = fmap unsafeFromCircularVector . CV.findRotateTo fn . view outerBoundaryVector++--------------------------------------------------------------------------------+-- Rotation++-- | \( O(1) \) Rotate the polygon to the left by n number of points.+rotateLeft :: Int -> SimplePolygon p r -> SimplePolygon p r+rotateLeft n = over unsafeOuterBoundaryVector (CV.rotateLeft n)++-- | \( O(1) \) Rotate the polygon to the right by n number of points.+rotateRight :: Int -> SimplePolygon p r -> SimplePolygon p r+rotateRight n = over unsafeOuterBoundaryVector (CV.rotateRight n)++--------------------------------------------------------------------------------+-- Testing for reflex or convex++-- | Test if a given vertex is a reflex vertex.+--+-- \(O(1)\)+isReflexVertex      :: (Ord r, Num r) => Int -> Polygon Simple p r -> Bool+isReflexVertex i pg = ccw' u  v w == CW+  where+    u = pg^.outerVertex (i-1)+    v = pg^.outerVertex i+    w = pg^.outerVertex (i+1)++-- | Test if a given vertex is a convex vertex (i.e. not a reflex vertex).+--+-- \(O(1)\)+isConvexVertex   :: (Ord r, Num r) => Int -> Polygon Simple p r -> Bool+isConvexVertex i = not . isReflexVertex i++-- | Test if a given vertex is a strictly convex vertex.+--+-- \(O(1)\)+isStrictlyConvexVertex      :: (Ord r, Num r) => Int -> Polygon t p r -> Bool+isStrictlyConvexVertex i pg = ccw' u  v w == CCW+  where+    u = pg^.outerVertex (i-1)+    v = pg^.outerVertex i+    w = pg^.outerVertex (i+1)+++-- | Computes all reflex vertices of the polygon.+--+-- \(O(n)\)+reflexVertices  :: (Ord r, Num r) => Polygon t p r -> [Int :+ (Point 2 r :+ p)]+reflexVertices p@(SimplePolygon _)                    = reflexVertices' p+reflexVertices (numberVertices -> MultiPolygon vs hs) =+  map (\(_ :+ (p :+ SP i e)) -> i :+ (p :+ e)) $+    reflexVertices' vs <> concatMap strictlyConvexVertices' hs++-- | Computes all convex (i.e. non-reflex) vertices of the polygon.+--+-- \(O(n)\)+convexVertices :: (Ord r, Num r) => Polygon t p r -> [Int :+ (Point 2 r :+ p)]+convexVertices = \case+  p@(SimplePolygon _)                    -> convexVertices' p+  (numberVertices -> MultiPolygon vs hs) ->+    map (\(_ :+ (p :+ SP i e)) -> i :+ (p :+ e)) $+      convexVertices' vs <> concatMap reflexVertices' hs++-- | Computes all strictly convex vertices of the polygon.+--+-- \(O(n)\)+strictlyConvexVertices :: (Ord r, Num r) => Polygon t p r -> [Int :+ (Point 2 r :+ p)]+strictlyConvexVertices = \case+  p@(SimplePolygon _)                    -> convexVertices' p+  (numberVertices -> MultiPolygon vs hs) ->+    map (\(_ :+ (p :+ SP i e)) -> i :+ (p :+ e)) $+      strictlyConvexVertices' vs <> concatMap reflexVertices' hs++----------------------------------------++-- | Return (the indices of) all reflex vertices, in increasing order+-- along the boundary.+--+-- \(O(n)\)+reflexVertices' :: (Ord r, Num r) => SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]+reflexVertices' = filterReflexConvexWorker asReflex+  where+    asReflex u v w | ccw' (u^.extra) (v^.extra) (w^.extra) == CW = Just v+                   | otherwise                                   = Nothing++-- | Return (the indices of) all strictly convex vertices, in+-- increasing order along the boundary.+--+-- \(O(n)\)+strictlyConvexVertices' :: (Ord r, Num r) => SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]+strictlyConvexVertices' = filterReflexConvexWorker asStrictlyConvex+  where+    asStrictlyConvex u v w | ccw' (u^.extra) (v^.extra) (w^.extra) == CCW = Just v+                           | otherwise                                    = Nothing++-- | Return (the indices of) all convex (= non-reflex) vertices, in increasing order+-- along the boundary.+--+-- \(O(n)\)+convexVertices' :: (Ord r, Num r) => SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]+convexVertices' = filterReflexConvexWorker asConvex+  where+    asConvex u v w | ccw' (u^.extra) (v^.extra) (w^.extra) /= CW = Just v+                   | otherwise                                   = Nothing++-- | Helper function to implement convexVertices, reflexVertices, and+-- strictlyConvexVertices+filterReflexConvexWorker      :: (Ord r, Num r)+                              => (    Int :+ (Point 2 r :+ p)+                                   -> Int :+ (Point 2 r :+ p)+                                   -> Int :+ (Point 2 r :+ p)+                                   -> Maybe (Int :+ (Point 2 r :+ p))+                                 )+                              -> SimplePolygon p r -> [Int :+ (Point 2 r :+ p)]+filterReflexConvexWorker g pg =+    catMaybes $ zip3RWith g (CV.rotateLeft 1 vs) vs (CV.rotateRight 1 vs)+  where+    vs = CV.withIndicesRight $ pg^.outerBoundaryVector+    zip3RWith f us' vs' ws' = zipWith3 f (F.toList us') (F.toList vs') (F.toList ws')
src/Data/Geometry/Polygon/Extremes.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- -- | -- Module      :  Data.Geometry.Polygon.Extremes@@ -13,15 +12,15 @@                                      , extremesLinear                                      ) where -import           Control.Lens hiding (Simple)+import           Control.Lens hiding (Simple,simple) import           Data.Ext-import qualified Data.Foldable as F import           Data.Geometry.Point-import           Data.Geometry.Polygon.Core+import           Data.Geometry.Polygon.Core as P import           Data.Geometry.Vector  -------------------------------------------------------------------------------- +{- HLINT ignore cmpExtreme -} -- | Comparison that compares which point is 'larger' in the direction given by -- the vector u. cmpExtreme       :: (Num r, Ord r)@@ -34,6 +33,6 @@ -- running time: \(O(n)\) extremesLinear     :: (Ord r, Num r) => Vector 2 r -> Polygon t p r                    -> (Point 2 r :+ p, Point 2 r :+ p)-extremesLinear u p = let vs = p^.outerBoundary+extremesLinear u p = let simple = p^.outerBoundary                          f  = cmpExtreme u-                     in (F.minimumBy f vs, F.maximumBy f vs)+                     in (P.minimumVertexBy f simple, P.maximumVertexBy f simple)
+ src/Data/Geometry/Polygon/Inflate.hs view
@@ -0,0 +1,142 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.Polygon.Inflate+-- Copyright   :  (C) David Himmelstrup+-- License     :  see the LICENSE file+-- Maintainer  :  David Himmelstrup+--------------------------------------------------------------------------------+module Data.Geometry.Polygon.Inflate+  ( Arc(..)+  , inflate+  ) where++import           Algorithms.Geometry.SSSP   (SSSP, sssp, triangulate)+import           Control.Lens+import           Data.Ext+import           Data.Geometry.Line         (lineThrough)+import           Data.Geometry.LineSegment  (LineSegment (LineSegment, OpenLineSegment),+                                             interpolate, sqSegmentLength)+import           Data.Geometry.Point+import           Data.Geometry.Polygon.Core+import           Data.Intersection          (IsIntersectableWith (intersect),+                                             NoIntersection (NoIntersection))+import           Data.Maybe                 (catMaybes)+import qualified Data.Vector                as V+import qualified Data.Vector.Circular       as CV+import qualified Data.Vector.Unboxed        as VU+import           Data.Vinyl                 (Rec (RNil, (:&)))+import           Data.Vinyl.CoRec           (Handler (H), match)++----------------------------------------------------+-- Implementation++-- | Points annotated with an 'Arc' indicate that the edge from this point to+--   the next should not be a straight line but instead an arc with a given center+--   and a given border edge.+data Arc r = Arc+  { arcCenter :: Point 2 r+  , arcEdge   :: (Point 2 r, Point 2 r)+  } deriving (Show)++type Parent = Int++markParents :: SSSP -> SimplePolygon p r -> SimplePolygon Parent r+markParents t p = unsafeFromCircularVector $+  CV.imap (\i (pt :+ _) -> pt :+ t VU.! i) (p^.outerBoundaryVector)++addSteinerPoints :: (Ord r, Fractional r) => SimplePolygon Parent r -> SimplePolygon Parent r+addSteinerPoints p = fromPoints $ concatMap worker [0 .. size p - 1]+  where+    worker nth = do+        pointA : catMaybes [ (:+ parent nth)     <$> getIntersection edge lineA+                           , (:+ parent (nth+1)) <$> getIntersection edge lineB ]+      where+        fetch idx = p ^. outerVertex idx+        pointA = fetch nth+        pointB = fetch (nth+1)+        parent idx = p^.outerVertex idx.extra+        lineA = lineThrough+          (fetch (parent nth) ^. core)+          (fetch (parent (parent nth)) ^. core)+        lineB = lineThrough+          (fetch (parent (nth+1)) ^. core)+          (fetch (parent (parent (nth+1))) ^. core)+        edge = OpenLineSegment pointA pointB+        getIntersection segment line =+          match (segment `intersect` line) (+               H (\NoIntersection -> Nothing)+            :& H (\pt -> Just pt)+            :& H (\LineSegment{} -> Nothing)+            :& RNil+          )++annotate :: (Real r, Fractional r) =>+  Double -> SimplePolygon Parent r -> SimplePolygon Parent r -> SimplePolygon (Arc r) r+annotate t original p = unsafeFromCircularVector $+    CV.imap ann (p^.outerBoundaryVector)+    -- CV.generate (size p) ann -- Use this when circular-vector-0.1.2 is out.+  where+    nO = size original+    visibleDist = V.maximum distanceTreeSum * t+    parent idx = p^.outerVertex idx.extra+    parentO idx = original^.outerVertex idx.extra+    getLineO idx = OpenLineSegment (original ^. outerVertex (parentO idx)) (original ^. outerVertex idx)+    getLineP idx = OpenLineSegment (original ^. outerVertex (parent idx)) (p ^. outerVertex idx)++    ann i _ =+        ptLocation i :+ arc+      where+        start = p ^. outerVertex i . core+        end = p ^. outerVertex (i+1) . core+        arc = Arc+          { arcCenter =+              original ^. outerVertex (commonParent original (parent i) (parent (i+1))) . core+          , arcEdge   = (start, end) }++    -- Array of locations for points in the original polygon.+    ptLocationsO = V.generate nO ptLocationO+    ptLocationO 0 = (original ^. outerVertex 0 . core)+    ptLocationO i+      | frac <= 0 = ptLocationsO V.! (parentO i)+      | frac >= 1 = (original ^. outerVertex i . core)+      | otherwise = (interpolate frac (getLineO i))+      where+        dParent = distanceTreeSum V.! parentO i+        dSelf   = oDistance VU.! i+        frac    = realToFrac ((visibleDist - dParent) / dSelf)++    -- Locations for original points and steiner points.+    ptLocation 0 = (p ^. outerVertex 0 . core)+    ptLocation i+      | frac <= 0 = ptLocationsO V.! (parent i)+      | frac >= 1 = (p ^. outerVertex i . core)+      | otherwise = (interpolate frac (getLineP i))+      where+        dParent = distanceTreeSum V.! parent i+        dSelf   = sqrt $ realToFrac $ sqSegmentLength $ getLineP i+        frac    = realToFrac ((visibleDist - dParent) / dSelf)++    oDistance = VU.generate nO $ \i ->+      case i of+        0 -> 0+        _ -> sqrt $ realToFrac $ sqSegmentLength $ getLineO i+    distanceTreeSum = V.generate nO $ \i ->+      case i of+        0 -> 0+        _ -> distanceTreeSum V.! parentO i + oDistance VU.! i++commonParent :: SimplePolygon Parent r -> Int -> Int -> Int+commonParent p a b = worker 0 (parents a) (parents b)+  where+    worker _shared (x:xs) (y:ys)+      | x == y = worker x xs ys+    worker shared _ _ = shared+    parents 0 = [0]+    parents i = parents (p ^. outerVertex i . extra) ++ [i]++-- | \( O(n \log n) \)+inflate :: (Real r, Fractional r) => Double -> SimplePolygon () r -> SimplePolygon (Arc r) r+inflate t p = annotate t marked steiner+  where+    marked = markParents (sssp (triangulate p)) p+    steiner = addSteinerPoints marked
+ src/Data/Geometry/Polygon/Monotone.hs view
@@ -0,0 +1,118 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.Polygon.Monotone+-- Copyright   :  (C) 1ndy+-- License     :  see the LICENSE file+-- Maintainer  :  David Himmelstrup+--+-- A polygon is monotone in a certain direction if rays orthogonal to that+-- direction intersects the polygon at most twice. See+-- <https://en.wikipedia.org/wiki/Monotone_polygon>+--+--------------------------------------------------------------------------------+module Data.Geometry.Polygon.Monotone+  ( isMonotone+  , randomMonotone+  , randomMonotoneDirected+  , monotoneFrom+  , randomNonZeroVector+  ) where++import           Control.Monad.Random+import           Data.Ext+import qualified Data.Foldable                  as F+import           Data.Geometry.Line             (Line (..))+import           Data.Geometry.LineSegment+import           Data.Geometry.Point+import           Data.Geometry.Polygon.Core+import           Data.Geometry.Polygon.Extremes+import           Data.Geometry.Vector+import           Data.Intersection+import           Data.List+import           Data.Vinyl+import           Data.Vinyl.CoRec+import           Prelude                        hiding (max, min)++-- | \( O(n \log n) \)+--   A polygon is monotone if a straight line in a given direction+--   cannot have more than two intersections.+isMonotone :: (Fractional r, Ord r) => Vector 2 r -> SimplePolygon p r -> Bool+-- Check for each vertex that the number of intersections with the+-- line starting at the vertex and going out in the given direction+-- intersects with the edges of the polygon no more than 2 times.+isMonotone direction p = all isMonotoneAt (map _core $ toPoints p)+  where+    isMonotoneAt pt =+      sum (map (intersectionsThrough pt) (F.toList $ outerBoundaryEdges p)) <= 2+    intersectionsThrough pt edge =+      match (Data.Intersection.intersect edge line) $+           H (\NoIntersection -> 0)+        :& H (\Point{} -> 1)+        -- This happens when an edge is parallel with the given direction.+        -- I think it's correct to count it as a single intersection.+        :& H (\LineSegment{} -> 1)+        :& RNil+      where+        line = Line pt (rot90 direction)+        rot90 (Vector2 x y) = Vector2 (-y) x++{- Algorithm overview:++  1. Create N `Point 2 Rational` (N >= 3)+  2. Create a random `Vector 2 Rational`+  3. Find the extremes (min and max) of the points when sorted in the direction of the vector.+      We already have code for this. See `maximumBy (cmpExtreme vector)` and+      `minimumBy (cmpExtreme vector)`.+  4. Take out the two extremal points from the set.+  5. Partition the remaining points according to whether they're on the left side or right side+    of the imaginary line between the two extremal points.+  6. Sort the two partitioned sets, one in the direction of the vector and one in the opposite+    direction.+  7. Connect the points, starting from the minimal extreme point, going through the set of points+    that are increasing in the direction of the vector, then to the maximal point, and finally+    down through the points that are decreasing in the direction of the vector.+-}+-- | \( O(n \log n) \)+--   Generate a random N-sided polygon that is monotone in a random direction.+randomMonotone :: (RandomGen g, Random r, Ord r, Num r) => Int -> Rand g (SimplePolygon () r)+randomMonotone nVertices = randomMonotoneDirected nVertices =<< randomNonZeroVector++-- Pick a random vector and then call 'randomMonotone'.+-- | \( O(n \log n) \)+--   Generate a random N-sided polygon that is monotone in the given direction.+randomMonotoneDirected :: (RandomGen g, Random r, Ord r, Num r)+  => Int -> Vector 2 r -> Rand g (SimplePolygon () r)+randomMonotoneDirected nVertices direction = do+    points <- replicateM nVertices getRandom+    return (monotoneFrom direction points)++-- | \( O(n \log n) \)+--   Assemble a given set of points in a polygon that is monotone in the given direction.+monotoneFrom :: (Ord r, Num r) => Vector 2 r -> [Point 2 r] -> SimplePolygon () r+monotoneFrom direction vertices = fromPoints ([min] ++ rightHalf ++ [max] ++ leftHalf)+    where+        specialPoints = map (\x -> x :+ ()) vertices+        min = Data.List.minimumBy (cmpExtreme direction) specialPoints+        max = Data.List.maximumBy (cmpExtreme direction) specialPoints+        -- 4+        pointsWithoutExtremes = filter (\x -> x /= min && x /= max) specialPoints+        -- 5, 6+        (leftHalfUnsorted,rightHalfUnsorted) = Data.List.partition (toTheLeft min max) pointsWithoutExtremes+        leftHalf = sortBy (flip $ cmpExtreme direction) leftHalfUnsorted+        rightHalf = sortBy (cmpExtreme direction) rightHalfUnsorted++-------------------------------------------------------------------------------------------------+-- helper functions++-- for partitioning points+toTheLeft :: (Ord r, Num r) => Point 2 r :+ () -> Point 2 r :+ () -> Point 2 r :+ () -> Bool+toTheLeft min max x = ccw' min max x == CCW++-- | \( O(1) \)+--   Create a random 2D vector which has a non-zero magnitude.+randomNonZeroVector :: (RandomGen g, Random r, Eq r, Num r) => Rand g (Vector 2 r)+randomNonZeroVector = do+    v <- getRandom+    if (quadrance v==0)+      then randomNonZeroVector+      else pure v
src/Data/Geometry/PrioritySearchTree.hs view
@@ -41,7 +41,7 @@                              } deriving (Show,Eq)  instance Bifunctor NodeData where-  bimap f g (NodeData x m) = NodeData (g x) ((bimap (fmap g) f) <$> m)+  bimap f g (NodeData x m) = NodeData (g x) (bimap (fmap g) f <$> m)  maxVal :: Lens' (NodeData p r) (Maybe (Point 2 r :+ p)) maxVal = lens _maxVal (\(NodeData x _) m -> NodeData x m)@@ -97,7 +97,7 @@       -- TODO: In case we have multiple points with the same x-coord, these points       -- are not really in decreasing y-order.     Node l d r | py > d^?maxVal._Just.core.yCoord ->-                   node' l (d&maxVal .~ Just p) r (d^.maxVal)+                   node' l (d&maxVal ?~ p) r (d^.maxVal)                    -- push the existing point down                | otherwise                 ->                    node' l d                             r (Just p)
src/Data/Geometry/Properties.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE ImpredicativeTypes #-} {-# LANGUAGE UnicodeSyntax #-}-{-# LANGUAGE DefaultSignatures #-} -------------------------------------------------------------------------------- -- | -- Module      :  Data.Geometry.Properties
src/Data/Geometry/QuadTree.hs view
@@ -1,5 +1,12 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.QuadTree+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.QuadTree-- ( module Data.Geometry.QuadTree.Cell                              -- , module Data.Geometry.QuadTree.Quadrants                              -- , module Data.Geometry.QuadTree.Split@@ -78,6 +85,7 @@   where     c = fitsRectangle $ boundingBoxList (view core <$> pts) +{- HLINT ignore findLeaf -} -- | Locates the cell containing the given point, if it exists. -- -- running time: \(O(h)\), where \(h\) is the height of the quadTree@@ -147,7 +155,7 @@     GT -> Positive  fromSignum   :: (Num a, Eq a) => (b -> a) -> b -> Sign-fromSignum f = \x -> case signum (f x) of+fromSignum f x = case signum (f x) of                        -1 -> Negative                        0  -> Zero                        1  -> Positive
src/Data/Geometry/QuadTree/Cell.hs view
@@ -1,4 +1,11 @@ {-# LANGUAGE TemplateHaskell #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.QuadTree.Cell+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.QuadTree.Cell where  import Control.Lens (makeLenses, (^.),(&),(%~),ix, to)@@ -41,7 +48,7 @@  type instance IntersectionOf (Point 2 r) (Cell r) = '[ NoIntersection, Point 2 r] -instance (Ord r, Fractional r) => (Point 2 r) `IsIntersectableWith` (Cell r) where+instance (Ord r, Fractional r) => Point 2 r `IsIntersectableWith` Cell r where   nonEmptyIntersection = defaultNonEmptyIntersection   p `intersect` c = p `intersect` toBox c @@ -55,7 +62,7 @@ cellWidth (Cell w _) = pow w  toBox            :: Fractional r => Cell r -> Box 2 () r-toBox (Cell w p) = box (ext $ p) (ext $ p .+^ Vector2 (pow w) (pow w))+toBox (Cell w p) = box (ext p) (ext $ p .+^ Vector2 (pow w) (pow w))  inCell            :: (Fractional r, Ord r) => Point 2 r :+ p -> Cell r -> Bool inCell (p :+ _) c = p `inBox` toBox c
src/Data/Geometry/QuadTree/Quadrants.hs view
@@ -1,3 +1,10 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.QuadTree.Quadrants+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.QuadTree.Quadrants( pattern Quadrants                                        , Quadrants                                        , module Data.Geometry.Box.Corners
src/Data/Geometry/QuadTree/Split.hs view
@@ -1,4 +1,11 @@ {-# LANGUAGE TemplateHaskell #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.QuadTree.Split+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.QuadTree.Split where  import Control.Lens (makePrisms,(^.))@@ -22,10 +29,11 @@ -- | Split only when the Cell-width is at least wMin limitWidthTo        :: WidthIndex -- ^ smallest allowed width of a cell (i.e. width of a leaf)                     -> Limiter r i v p-limitWidthTo wMin f = \c pts -> case f c pts of-                                  No p                                -> No (Right p)-                                  Yes v qs | wMin < c^.cellWidthIndex -> Yes v qs-                                           | otherwise                -> No (Left pts)+limitWidthTo wMin f c pts =+    case f c pts of+      No p                                -> No (Right p)+      Yes v qs | wMin < c^.cellWidthIndex -> Yes v qs+               | otherwise                -> No (Left pts)   -- note that it is important that we still evaluate the function so   -- that we can distinguish at the last level i.e. between a regular   -- " we are done splitting (No (Right p))" and a "we are no longer
src/Data/Geometry/QuadTree/Tree.hs view
@@ -1,5 +1,12 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.QuadTree.Tree+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.QuadTree.Tree where
src/Data/Geometry/RangeTree.hs view
@@ -1,4 +1,11 @@ {-# LANGUAGE UndecidableInstances #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.RangeTree+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.RangeTree where  import           Control.Lens hiding (element)@@ -13,8 +20,6 @@ import           Data.Measured.Class import           Data.Proxy import           Data.Range-import           Data.Semigroup.Foldable-import           Data.Vector.Fixed.Cont (Peano, PeanoNum(..)) import           GHC.TypeLits import           Prelude hiding (last,init,head)
src/Data/Geometry/RangeTree/Generic.hs view
@@ -1,9 +1,15 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.RangeTree.Generic+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.RangeTree.Generic where  import           Control.Lens import           Data.BinaryTree import           Data.Ext-import           Data.Geometry.Point import           Data.Geometry.Properties import           Data.Geometry.RangeTree.Measure import           Data.List.NonEmpty (NonEmpty(..))@@ -13,7 +19,6 @@ import           Data.Measured.Size import           Data.Semigroup import           Data.Semigroup.Foldable-import qualified Data.Set as Set import           Data.Util  --------------------------------------------------------------------------------
src/Data/Geometry/RangeTree/Measure.hs view
@@ -1,3 +1,11 @@+{-# OPTIONS_GHC -Wno-orphans #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.RangeTree.Measure+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.RangeTree.Measure where  import Data.Measured.Class
src/Data/Geometry/SegmentTree.hs view
@@ -1,3 +1,10 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.SegmentTree+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.SegmentTree( module Data.Geometry.SegmentTree.Generic                                 ) where
src/Data/Geometry/SegmentTree/Generic.hs view
@@ -189,7 +189,7 @@ insert i (SegmentTree t) = SegmentTree $ insertRoot t   where     ri@(Range a b) = asRange i-    insertRoot t' = maybe t' (flip insert' t') $ getRange t'+    insertRoot t' = maybe t' (`insert'` t') $ getRange t'      insert' inR         lf@(Leaf nd@(LeafData rr _))       | coversAtomic ri inR rr = Leaf $ nd&leafAssoc %~ insertAssoc i
src/Data/Geometry/Slab.hs view
@@ -1,5 +1,12 @@ {-# Language ScopedTypeVariables #-} {-# Language TemplateHaskell #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.Slab+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.Slab where  import           Control.Lens (makeLenses, (^.),(%~),(.~),(&), both, from)@@ -56,15 +63,15 @@   '[Rectangle (a,a) r]  -instance Ord r => (Slab o a r) `IsIntersectableWith` (Slab o a r) where+instance Ord r => Slab o a r `IsIntersectableWith` Slab o a r where   nonEmptyIntersection = defaultNonEmptyIntersection    (Slab i) `intersect` (Slab i') = match (i `intersect` i') $-        (H $ \NoIntersection -> coRec NoIntersection)-     :& (H $ \i''            -> coRec (Slab i'' :: Slab o a r))+        H (\NoIntersection -> coRec NoIntersection)+     :& H (\i''            -> coRec (Slab i'' :: Slab o a r))      :& RNil -instance (Slab Horizontal a r) `IsIntersectableWith` (Slab Vertical a r) where+instance Slab Horizontal a r `IsIntersectableWith` Slab Vertical a r where   nonEmptyIntersection _ _ _ = True    (Slab h) `intersect` (Slab v) = coRec $ box low high@@ -98,18 +105,18 @@   [NoIntersection, Line 2 r, LineSegment 2 a r]  instance (Fractional r, Ord r, HasBoundingLines o) =>-         Line 2 r `IsIntersectableWith` (Slab o a r) where+         Line 2 r `IsIntersectableWith` Slab o a r where   nonEmptyIntersection = defaultNonEmptyIntersection    l@(Line p _) `intersect` s = match (l `intersect` a) $-         (H $ \NoIntersection -> if p `inSlab` s then coRec l else coRec NoIntersection)-      :& (H $ \pa             -> match (l `intersect` b) $-            (H $ \NoIntersection -> coRec NoIntersection)-         :& (H $ \pb             -> coRec $ lineSegment' pa pb)-         :& (H $ \_              -> coRec l)+         H (\NoIntersection -> if p `inSlab` s then coRec l else coRec NoIntersection)+      :& H (\pa             -> match (l `intersect` b) $+            H coRec -- NoIntersection+         :& H (coRec . lineSegment' pa)+         :& H (\_ -> coRec l)          :& RNil          )-      :& (H $ \_              -> coRec l)+      :& H (\_              -> coRec l)       :& RNil     where       (a :+ _,b :+ _) = boundingLines s@@ -125,17 +132,17 @@   [NoIntersection, SubLine 2 () s r]  instance (Fractional r, Ord r, HasBoundingLines o) =>-         SubLine 2 a r r `IsIntersectableWith` (Slab o a r) where+         SubLine 2 a r r `IsIntersectableWith` Slab o a r where    nonEmptyIntersection = defaultNonEmptyIntersection    sl@(SubLine l _) `intersect` s = match (l `intersect` s) $-       (H $ \NoIntersection -> coRec NoIntersection)-    :& (H $ \(Line _ _)     -> coRec $ dropExtra sl)-    :& (H $ \seg            -> match (sl `intersect` (seg^._SubLine)) $-                                    (H $ \NoIntersection -> coRec NoIntersection)-                                 :& (H $ \p@(Point2 _ _) -> coRec $ singleton p)-                                 :& (H $ \ss             -> coRec $ dropExtra ss)+       H (\NoIntersection -> coRec NoIntersection)+    :& H (\(Line _ _)     -> coRec $ dropExtra sl)+    :& H (\seg            -> match (sl `intersect` (seg^._SubLine)) $+                                    H (\NoIntersection -> coRec NoIntersection)+                                 :& H (\p@Point2{}     -> coRec $ singleton p)+                                 :& H (                   coRec . dropExtra)                                  :& RNil)     :& RNil     where@@ -146,12 +153,12 @@   [NoIntersection, LineSegment 2 () r]  instance (Fractional r, Ord r, HasBoundingLines o) =>-         LineSegment 2 a r `IsIntersectableWith` (Slab o a r) where+         LineSegment 2 a r `IsIntersectableWith` Slab o a r where   nonEmptyIntersection = defaultNonEmptyIntersection    seg `intersect` slab = match ((seg^._SubLine) `intersect` slab) $-       (H $ \NoIntersection -> coRec   NoIntersection)-    :& (H $ \sl             -> coRec $ sl^. from _SubLine)+       H (\NoIntersection -> coRec   NoIntersection)+    :& H (\sl             -> coRec $ sl^. from _SubLine)     :& RNil
src/Data/Geometry/SubLine.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE TemplateHaskell  #-} {-# LANGUAGE UndecidableInstances  #-} -------------------------------------------------------------------------------- -- |@@ -10,7 +9,22 @@ -- SubLine; a part of a line -- ---------------------------------------------------------------------------------module Data.Geometry.SubLine where+module Data.Geometry.SubLine+  ( SubLine(..)+  , line+  , subRange+  , fixEndPoints+  , dropExtra+  , _unBounded+  , toUnbounded+  , fromUnbounded+  , onSubLine+  , onSubLineUB+  , onSubLine2+  , onSubLine2UB+  , getEndPointsUnBounded+  , fromLine+  ) where  import           Control.Lens import           Data.Bifunctor@@ -27,8 +41,6 @@ import           Data.Vinyl.CoRec import           Test.QuickCheck(Arbitrary(..)) -import           Data.Ratio- --------------------------------------------------------------------------------  -- | Part of a line. The interval is ranged based on the vector of the@@ -36,8 +48,15 @@ data SubLine d p s r = SubLine { _line     :: Line d r                                , _subRange :: Interval p s                                }-makeLenses ''SubLine +-- | Line part of SubLine.+line :: Lens (SubLine d1 p s r1) (SubLine d2 p s r2) (Line d1 r1) (Line d2 r2)+line = lens _line (\sub l -> SubLine l (_subRange sub))++-- | Interval part of SubLine.+subRange :: Lens (SubLine d p1 s1 r) (SubLine d p2 s2 r) (Interval p1 s1) (Interval p2 s2)+subRange = lens _subRange (SubLine . _line)+ type instance Dimension (SubLine d p s r) = d  @@ -57,7 +76,7 @@ fixEndPoints sl = sl&subRange %~ f   where     ptAt              = flip pointAt (sl^.line)-    label (c :+ e)    = (c :+ (ptAt c :+ e))+    label (c :+ e)    = c :+ (ptAt c :+ e)     f ~(Interval l u) = Interval (l&unEndPoint %~ label)                                  (u&unEndPoint %~ label) @@ -65,6 +84,7 @@ dropExtra :: SubLine d p s r -> SubLine d () s r dropExtra = over subRange (first (const ())) +-- | Prism for downcasting an unbounded subline to a subline. _unBounded :: Prism' (SubLine d p (UnBounded r) r) (SubLine d p r r) _unBounded = prism' toUnbounded fromUnbounded @@ -88,10 +108,14 @@ -- lies on the subline, i.e. in the interval r onSubLineUB                   :: (Ord r, Fractional r)                               => Point 2 r -> SubLine 2 p (UnBounded r) r -> Bool-p `onSubLineUB` (SubLine l r) = case toOffset p l of-                                  Nothing -> False-                                  Just x  -> Val x `inInterval` r+p `onSubLineUB` (SubLine l r) =+  p `onLine2` l &&+  Val (toOffset' p l) `inInterval` r +inSubLineIntervalUB                   :: (Ord r, Fractional r)+                              => Point 2 r -> SubLine 2 p (UnBounded r) r -> Bool+p `inSubLineIntervalUB` (SubLine l r) = Val (toOffset' p l) `inInterval` r+ -- | given point p, and a Subline l r such that p lies on line l, test if it -- lies on the subline, i.e. in the interval r onSubLine2        :: (Ord r, Num r) => Point 2 r -> SubLine 2 p r r -> Bool@@ -118,19 +142,20 @@                                                                    , SubLine 2 p s r                                                                    ] +{- HLINT ignore "Redundant bracket" -} instance (Ord r, Fractional r) =>-         (SubLine 2 p r r) `IsIntersectableWith` (SubLine 2 p r r) where+         SubLine 2 p r r `IsIntersectableWith` SubLine 2 p r r where    nonEmptyIntersection = defaultNonEmptyIntersection    sl@(SubLine l r) `intersect` sm@(SubLine m _) = match (l `intersect` m) $-         (H $ \NoIntersection -> coRec NoIntersection)-      :& (H $ \p@(Point _)    -> if onSubLine2 p sl && onSubLine2 p sm+         H (\NoIntersection -> coRec NoIntersection)+      :& H (\p@(Point _)    -> if onSubLine2 p sl && onSubLine2 p sm                                  then coRec p                                  else coRec NoIntersection)-      :& (H $ \_             -> match (r `intersect` s'') $-                                      (H $ \NoIntersection -> coRec NoIntersection)-                                   :& (H $ \i              -> coRec $ SubLine l i)+      :& H (\_             -> match (r `intersect` s'') $+                                      H coRec -- NoIntersection+                                   :& H (coRec . SubLine l)                                    :& RNil            )       :& RNil@@ -141,17 +166,17 @@               &end.core   .~ toOffset' (s'^.end.extra.core)   l  instance (Ord r, Fractional r) =>-         (SubLine 2 p (UnBounded r) r) `IsIntersectableWith` (SubLine 2 p (UnBounded r) r) where+         SubLine 2 p (UnBounded r) r `IsIntersectableWith` SubLine 2 p (UnBounded r) r where   nonEmptyIntersection = defaultNonEmptyIntersection    sl@(SubLine l r) `intersect` sm@(SubLine m _) = match (l `intersect` m) $-         (H $ \NoIntersection -> coRec NoIntersection)-      :& (H $ \p@(Point _)    -> if onSubLine2UB p sl && onSubLine2UB p sm+         H (\NoIntersection -> coRec NoIntersection)+      :& H (\p@(Point _)    -> if inSubLineIntervalUB p sl && inSubLineIntervalUB p sm                                  then coRec p                                  else coRec NoIntersection)-      :& (H $ \_             -> match (r `intersect` s'') $-                                      (H $ \NoIntersection -> coRec NoIntersection)-                                   :& (H $ \i              -> coRec $ SubLine l i)+      :& H (\_              -> match (r `intersect` s'') $+                                      H coRec -- NoIntersection+                                   :& H (coRec . SubLine l)                                    :& RNil            )       :& RNil@@ -168,6 +193,7 @@   where     f = flip pointAt (sl^.line) +-- | Create a SubLine that covers the original line from -infinity to +infinity. fromLine   :: Arity d => Line d r -> SubLine d () (UnBounded r) r fromLine l = SubLine l (ClosedInterval (ext MinInfinity) (ext MaxInfinity)) @@ -185,6 +211,6 @@ -- testzz = let f  = bimap (fmap Val) (const ()) --          in -testz :: SubLine 2 () Rational Rational-testz = SubLine (Line (Point2 0 0) (Vector2 10 0))-                (Interval (Closed (0 % 1 :+ ())) (Closed (1 % 1 :+ ())))+-- testz :: SubLine 2 () Rational Rational+-- testz = SubLine (Line (Point2 0 0) (Vector2 10 0))+--                 (Interval (Closed (0 % 1 :+ ())) (Closed (1 % 1 :+ ())))
src/Data/Geometry/Transformation.hs view
@@ -1,5 +1,12 @@ {-# LANGUAGE Unsafe #-} {-# LANGUAGE UndecidableInstances #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.Transformation+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.Transformation where  import           Control.Lens (iso,set,Iso,imap)@@ -12,6 +19,10 @@ import           Data.Proxy import           GHC.TypeLits +{- $setup+>>> import Data.Geometry.LineSegment+>>> import Data.Ext+-}  -------------------------------------------------------------------------------- -- * Transformations@@ -19,6 +30,7 @@ -- | A type representing a Transformation for d dimensional objects newtype Transformation d r = Transformation { _transformationMatrix :: Matrix (d + 1) (d + 1) r } +-- | Transformations and Matrices are isomorphic. transformationMatrix :: Iso (Transformation d r)       (Transformation d       s)                             (Matrix (d + 1) (d + 1) r) (Matrix (d + 1) (d + 1) s) transformationMatrix = iso _transformationMatrix Transformation@@ -42,7 +54,7 @@ -- | Compute the inverse transformation -- -- >>> inverseOf $ translation (Vector2 (10.0) (5.0))--- Transformation {_transformationMatrix = Matrix Vector3 [Vector3 [1.0,0.0,-10.0],Vector3 [0.0,1.0,-5.0],Vector3 [0.0,0.0,1.0]]}+-- Transformation {_transformationMatrix = Matrix (Vector3 (Vector3 1.0 0.0 (-10.0)) (Vector3 0.0 1.0 (-5.0)) (Vector3 0.0 0.0 1.0))} inverseOf :: (Fractional r, Invertible (d + 1) r)           => Transformation d r -> Transformation d r inverseOf = Transformation . inverse' . _transformationMatrix@@ -54,11 +66,19 @@ class IsTransformable g where   transformBy :: Transformation (Dimension g) (NumType g) -> g -> g +-- | Apply a transformation to a collection of objects.+--+-- >>> transformAllBy (uniformScaling 2) [Point1 1, Point1 2, Point1 3]+-- [Point1 2.0,Point1 4.0,Point1 6.0] transformAllBy :: (Functor c, IsTransformable g)                => Transformation (Dimension g) (NumType g) -> c g -> c g transformAllBy t = fmap (transformBy t) -+-- | Apply transformation to a PointFunctor, ie something that contains+--   points. Polygons, triangles, line segments, etc, are all PointFunctors.+--+-- >>> transformPointFunctor (uniformScaling 2) $ OpenLineSegment (Point1 1 :+ ()) (Point1 2 :+ ())+-- OpenLineSegment (Point1 2.0 :+ ()) (Point1 4.0 :+ ()) transformPointFunctor   :: ( PointFunctor g, Fractional r, d ~ Dimension (g r)                            , Arity d, Arity (d + 1)                            ) => Transformation d r -> g r -> g r@@ -78,15 +98,31 @@ -------------------------------------------------------------------------------- -- * Common transformations +-- | Create translation transformation from a vector.+--+-- >>> transformBy (translation $ Vector2 1 2) $ Point2 2 3+-- Point2 3.0 5.0 translation   :: (Num r, Arity d, Arity (d + 1))               => Vector d r -> Transformation d r translation v = Transformation . Matrix $ imap transRow (snoc v 1) -+-- | Create scaling transformation from a vector.+--+-- >>> transformBy (scaling $ Vector2 2 (-1)) $ Point2 2 3+-- Point2 4.0 (-3.0) scaling   :: (Num r, Arity d, Arity (d + 1))           => Vector d r -> Transformation d r scaling v = Transformation . Matrix $ imap mkRow (snoc v 1) +-- | Create scaling transformation from a scalar that is applied+--   to all dimensions.+--+-- >>> transformBy (uniformScaling 5) $ Point2 2 3+-- Point2 10.0 15.0+-- >>> uniformScaling 5 == scaling (Vector2 5 5)+-- True+-- >>> uniformScaling 5 == scaling (Vector3 5 5 5)+-- True uniformScaling :: (Num r, Arity d, Arity (d + 1)) => r -> Transformation d r uniformScaling = scaling . pure @@ -94,17 +130,29 @@ -------------------------------------------------------------------------------- -- * Functions that execute transformations +-- | Translate a given point.+--+-- >>> translateBy (Vector2 1 2) $ Point2 2 3+-- Point2 3.0 5.0 translateBy :: ( IsTransformable g, Num (NumType g)                , Arity (Dimension g), Arity (Dimension g + 1)                ) => Vector (Dimension g) (NumType g) -> g -> g translateBy = transformBy . translation +-- | Scale a given point.+--+-- >>> scaleBy (Vector2 2 (-1)) $ Point2 2 3+-- Point2 4.0 (-3.0) scaleBy :: ( IsTransformable g, Num (NumType g)            , Arity (Dimension g), Arity (Dimension g + 1)            ) => Vector (Dimension g) (NumType g) -> g -> g scaleBy = transformBy . scaling  +-- | Scale a given point uniformly in all dimensions.+--+-- >>> scaleUniformlyBy 5 $ Point2 2 3+-- Point2 10.0 15.0 scaleUniformlyBy :: ( IsTransformable g, Num (NumType g)                     , Arity (Dimension g), Arity (Dimension g + 1)                     ) => NumType g -> g -> g
src/Data/Geometry/Triangle.hs view
@@ -1,36 +1,37 @@ {-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE UndecidableInstances #-}+-- | Triangles in \(d\)-dimensional space. module Data.Geometry.Triangle where -import           Control.DeepSeq+import           Control.DeepSeq              (NFData) import           Control.Lens-import           Data.Bifoldable-import           Data.Bifunctor+import           Data.Bifoldable              (Bifoldable (bifoldMap))+import           Data.Bifunctor               (Bifunctor (first)) import           Data.Bitraversable-import           Data.Either (partitionEithers)+import           Data.Either                  (partitionEithers) import           Data.Ext-import           Data.Geometry.Ball (Disk, disk)-import           Data.Geometry.Boundary+import           Data.Geometry.Ball           (Disk, disk)+import           Data.Geometry.Boundary       (PointLocationResult (..))+import           Data.Geometry.Box            (IsBoxable (..)) import           Data.Geometry.HyperPlane-import           Data.Geometry.Line+import           Data.Geometry.Line           (Line (Line)) import           Data.Geometry.LineSegment import           Data.Geometry.Point import           Data.Geometry.Properties import           Data.Geometry.Transformation import           Data.Geometry.Vector-import qualified Data.Geometry.Vector as V-import qualified Data.List as List-import           Data.Maybe (mapMaybe)-import           Data.Util-import           Data.Vinyl-import           Data.Vinyl.CoRec-import           GHC.Generics (Generic)-import           GHC.TypeLits+import qualified Data.Geometry.Vector         as V+import qualified Data.List                    as List+import           Data.Maybe                   (mapMaybe)+import           Data.Util                    (Three, pattern Three)+import           Data.Vinyl                   (Rec (RNil, (:&)))+import           Data.Vinyl.CoRec             (Handler (H), match)+import           GHC.Generics                 (Generic)+import           GHC.TypeLits                 (type (+))  -------------------------------------------------------------------------------- --- | Triangles in \(d\)-dimensional space.+-- | A triangle in \(d\)-dimensional space. data Triangle d p r = Triangle !(Point d r :+ p)                                !(Point d r :+ p)                                !(Point d r :+ p)@@ -62,6 +63,7 @@ type instance NumType   (Triangle d p r) = r type instance Dimension (Triangle d p r) = d +-- | A \(d\)-dimensional triangle is isomorphic to a triple of \(d\)-dimensional points. _TriangleThreePoints :: Iso' (Triangle d p r) (Three (Point d r :+ p)) _TriangleThreePoints = iso (\(Triangle p q r) -> Three p q r) (\(Three p q r) -> Triangle p q r) @@ -77,7 +79,7 @@   where     Triangle' p q r = Triangle (ext p) (ext q) (ext r) -+-- | Get the three line-segments that make up the sides of a triangle. sideSegments                  :: Triangle d p r -> [LineSegment d p r] sideSegments (Triangle p q r) =   [ClosedLineSegment p q, ClosedLineSegment q r, ClosedLineSegment r p]@@ -101,7 +103,7 @@ isDegenerateTriangle :: (Num r, Eq r) => Triangle 2 p r -> Bool isDegenerateTriangle = (== 0) . doubleArea --- | get the inscribed disk. Returns Nothing if the triangle is degenerate,+-- | Get the inscribed disk. Returns Nothing if the triangle is degenerate, -- i.e. if the points are colinear. inscribedDisk                  :: (Eq r, Fractional r)                                => Triangle 2 p r -> Maybe (Disk () r)@@ -144,18 +146,33 @@ inTriangle     :: (Ord r, Fractional r)                  => Point 2 r -> Triangle 2 p r -> PointLocationResult inTriangle q t-    | all (`inRange` (OpenRange   0 1)) [a,b,c] = Inside-    | all (`inRange` (ClosedRange 0 1)) [a,b,c] = OnBoundary+    | all (`inRange` OpenRange   0 1) [a,b,c] = Inside+    | all (`inRange` ClosedRange 0 1) [a,b,c] = OnBoundary     | otherwise                                 = Outside   where     Vector3 a b c = toBarricentric q t +inTriangleRelaxed     :: (Ord r, Num r)+                 => Point 2 r -> Triangle 2 p r -> PointLocationResult+inTriangleRelaxed q (Triangle a b c)+    | ab == CoLinear && bc == ca = OnBoundary+    | bc == CoLinear && ca == ab = OnBoundary+    | ca == CoLinear && bc == ab = OnBoundary+    | ab == bc && bc == ca       = Inside+    | otherwise                  = Outside+  where+    ab = ccw (a^.core) (b^.core) q+    bc = ccw (b^.core) (c^.core) q+    ca = ccw (c^.core) (a^.core) q+ -- | Test if a point lies inside or on the boundary of a triangle onTriangle       :: (Ord r, Fractional r)                  => Point 2 r -> Triangle 2 p r -> Bool q `onTriangle` t = let Vector3 a b c = toBarricentric q t-                   in all (`inRange` (ClosedRange 0 1)) [a,b,c]+                   in all (`inRange` ClosedRange 0 1) [a,b,c] +onTriangleRelaxed :: (Ord r, Num r) => Point 2 r -> Triangle 2 p r -> Bool+q `onTriangleRelaxed` t = inTriangleRelaxed q t /= Outside  -- myQ :: Point 2 Rational -- myQ = read "Point2 [(-5985) % 16,(-14625) % 1]"@@ -165,7 +182,7 @@ type instance IntersectionOf (Line 2 r) (Triangle 2 p r) =   [ NoIntersection, Point 2 r, LineSegment 2 () r ] -instance (Fractional r, Ord r) => (Line 2 r) `IsIntersectableWith` (Triangle 2 p r) where+instance (Fractional r, Ord r) => Line 2 r `IsIntersectableWith` Triangle 2 p r where    nonEmptyIntersection = defaultNonEmptyIntersection     l `intersect` (Triangle p q r) =@@ -180,9 +197,9 @@         collect   :: LineSegment 2 p r -> Maybe (Either (Point 2 r) (LineSegment 2 p r))        collect s = match (s `intersect` l) $-                        (H $ \NoIntersection           -> Nothing)-                     :& (H $ \(a :: Point 2 r)         -> Just $ Left a)-                     :& (H $ \(e :: LineSegment 2 p r) -> Just $ Right e)+                        H (\NoIntersection           -> Nothing)+                     :& H (\(a :: Point 2 r)         -> Just $ Left a)+                     :& H (\(e :: LineSegment 2 p r) -> Just $ Right e)                      :& RNil  @@ -190,14 +207,15 @@ type instance IntersectionOf (Line 3 r) (Triangle 3 p r) =   [ NoIntersection, Point 3 r, LineSegment 3 () r ] -instance (Fractional r, Ord r) => (Line 3 r) `IsIntersectableWith` (Triangle 3 p r) where+{- HLINT ignore "Use const" -}+instance (Fractional r, Ord r) => Line 3 r `IsIntersectableWith` Triangle 3 p r where    nonEmptyIntersection = defaultNonEmptyIntersection     l@(Line a v) `intersect` t@(Triangle (p :+ _) (q :+ _) (r :+ _)) =        match (l `intersect` h) $-            (H $ \NoIntersection   -> coRec NoIntersection)-         :& (H $ \i@(Point3 _ _ _) -> if onTriangle' i then coRec i else coRec NoIntersection)-         :& (H $ \_                -> intersect2d)+            H (\NoIntersection -> coRec NoIntersection)+         :& H (\i@Point3{}     -> if onTriangle' i then coRec i else coRec NoIntersection)+         :& H (\_              -> intersect2d)          :& RNil      where        h@(Plane _ n) = supportingPlane t@@ -210,13 +228,13 @@         -- test if the point in terms of its 2d coords lies in side the projected triangle        onTriangle'                :: Point 3 r -> Bool-       onTriangle' i = (project i) `onTriangle` t'+       onTriangle' i = project i `onTriangle` t'         -- FIXME! these vectors may not be unit vectors. How do we deal with        -- that? (and does that really matter here?)        transf :: Transformation 3 r        transf = let u = p .-. q-                in rotateTo (Vector3 u (n `cross` u) n) |.| translation ((-1) *^ (toVec q))+                in rotateTo (Vector3 u (n `cross` u) n) |.| translation ((-1) *^ toVec q)        -- inverse of the transformation above.        invTrans :: Transformation 3 r        invTrans = inverseOf transf@@ -233,8 +251,11 @@         intersect2d :: Intersection (Line 3 r) (Triangle 3 p r)        intersect2d = match (l' `intersect` t') $-            (H $ \NoIntersection    -> coRec NoIntersection)-         :& (H $ \i@(Point2 _ _)    -> coRec $ lift i)-         :& (H $ \(LineSegment s e) -> coRec $ LineSegment (s&unEndPoint.core %~ lift)-                                                           (e&unEndPoint.core %~ lift))+            H (\NoIntersection    -> coRec NoIntersection)+         :& H (\i@(Point2 _ _)    -> coRec $ lift i)+         :& H (\(LineSegment s e) -> coRec $ LineSegment (s&unEndPoint.core %~ lift)+                                                         (e&unEndPoint.core %~ lift))          :& RNil++instance (Arity d, Ord r) => IsBoxable (Triangle d p r) where+  boundingBox (Triangle a b c) = boundingBox a <> boundingBox b <> boundingBox c
src/Data/Geometry/Vector.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -------------------------------------------------------------------------------- -- |@@ -17,35 +17,42 @@                            , quadrance, qdA, distanceA                            , dot, norm, signorm                            , isScalarMultipleOf-                           , scalarMultiple+                           , scalarMultiple, sameDirection                            -- reexports                            , FV.replicate                            , xComponent, yComponent, zComponent                            ) where -import           Control.Applicative (liftA2)-import           Control.Lens (Lens')+import           Control.Applicative               (liftA2)+import           Control.Lens                      (Lens') import           Control.Monad.State-import qualified Data.Foldable as F+import qualified Data.Foldable                     as F import           Data.Geometry.Properties import           Data.Geometry.Vector.VectorFamily-import           Data.Geometry.Vector.VectorFixed (C(..))-import qualified Data.Vector.Fixed as FV+import           Data.Geometry.Vector.VectorFixed  (C (..))+import qualified Data.Vector.Fixed                 as FV import           GHC.TypeLits-import           Linear.Affine (Affine(..), qdA, distanceA)-import           Linear.Metric (dot,norm,signorm,quadrance)-import           Linear.Vector as LV hiding (E(..))-import           System.Random (Random(..))-import           Test.QuickCheck (Arbitrary(..),infiniteList)+import           Linear.Affine                     (Affine (..), distanceA, qdA)+import           Linear.Metric                     (dot, norm, quadrance, signorm)+import           Linear.Vector                     as LV hiding (E (..))+import           System.Random                     (Random (..))+import           Test.QuickCheck                   (Arbitrary (..), Arbitrary1 (..), infiniteList,+                                                    infiniteListOf)  -------------------------------------------------------------------------------- +-- $setup+-- >>> import Control.Lens+ type instance Dimension (Vector d r) = d type instance NumType   (Vector d r) = r  instance (Arbitrary r, Arity d) => Arbitrary (Vector d r) where   arbitrary = vectorFromListUnsafe <$> infiniteList +instance (Arity d) => Arbitrary1 (Vector d) where+  liftArbitrary gen = vectorFromListUnsafe <$> infiniteListOf gen+ instance (Random r, Arity d) => Random (Vector d r) where   randomR (lows,highs) g0 = flip runState g0 $                             FV.zipWithM (\l h -> state $ randomR (l,h)) lows highs@@ -79,7 +86,7 @@                          => Vector d r -> Vector d r -> Bool u `isScalarMultipleOf` v = let d = u `dot` v                                num = quadrance u * quadrance v-                           in num == 0 || 1 == d*d / num+                           in num == 0 || num == d*d -- u `isScalarMultipleOf` v = isJust $ scalarMultiple u v {-# SPECIALIZE     isScalarMultipleOf :: (Eq r, Fractional r) => Vector 2 r -> Vector 2 r -> Bool  #-}@@ -146,17 +153,46 @@     scalarMultiple' :: (Eq r, Fractional r) => Vector 2 r -> Vector 2 r -> Maybe r #-}  +-- | Given two colinar vectors, u and v, test if they point in the same direction, i.e.+-- iff scalarMultiple' u v == Just lambda, with lambda > 0+--+-- pre: u and v are colinear, u and v are non-zero+sameDirection     :: (Eq r, Num r, Arity d) => Vector d r -> Vector d r -> Bool+sameDirection u v = and $ FV.zipWith (\ux vx -> signum ux == signum vx) u v++-- sameDirectionProp      :: (Eq r, Fractional r, Arity d)+--                        => Vector d r -> Vector d r -> Bool+-- sameDirectionProp u v = sameDirection u v == maybe False ((/= (-1)) . signum) (scalarMultiple' u v)+ -------------------------------------------------------------------------------- -- * Helper functions specific to two and three dimensional vectors +-- | Shorthand to access the first component+--+-- >>> Vector3 1 2 3 ^. xComponent+-- 1+-- >>> Vector2 1 2 & xComponent .~ 10+-- Vector2 10 2 xComponent :: (1 <= d, Arity d) => Lens' (Vector d r) r xComponent = element (C :: C 0) {-# INLINABLE xComponent #-} +-- | Shorthand to access the second component+--+-- >>> Vector3 1 2 3 ^. yComponent+-- 2+-- >>> Vector2 1 2 & yComponent .~ 10+-- Vector2 1 10 yComponent :: (2 <= d, Arity d) => Lens' (Vector d r) r yComponent = element (C :: C 1) {-# INLINABLE yComponent #-} +-- | Shorthand to access the third component+--+-- >>> Vector3 1 2 3 ^. zComponent+-- 3+-- >>> Vector3 1 2 3 & zComponent .~ 10+-- Vector3 1 2 10 zComponent :: (3 <= d, Arity d) => Lens' (Vector d r) r zComponent = element (C :: C 2) {-# INLINABLE zComponent #-}
src/Data/Geometry/Vector/VectorFamily.hs view
@@ -15,31 +15,29 @@ module Data.Geometry.Vector.VectorFamily where  import           Control.DeepSeq-import           Control.Lens hiding (element)+import           Control.Lens                           hiding (element)+import           Control.Monad import           Data.Aeson--- import           Data.Aeson (ToJSON(..),FromJSON(..))-import qualified Data.Foldable as F-import qualified Data.List as L-import           Data.Geometry.Vector.VectorFixed (C(..))+import qualified Data.Foldable                          as F+import           Data.Functor.Classes+import           Data.Geometry.Vector.VectorFamilyPeano (ImplicitArity, VectorFamily (..),+                                                         VectorFamilyF) import qualified Data.Geometry.Vector.VectorFamilyPeano as Fam-import           Data.Geometry.Vector.VectorFamilyPeano ( VectorFamily(..)-                                                        , VectorFamilyF-                                                        , ImplicitArity-                                                        )-import qualified Data.Vector.Fixed as V-import           Data.Vector.Fixed.Cont (Peano)+import           Data.Geometry.Vector.VectorFixed       (C (..))+import           Data.Hashable+import           Data.List+import qualified Data.List                              as L+import           Data.Proxy+import qualified Data.Vector.Fixed                      as V+import           Data.Vector.Fixed.Cont                 (Peano) import           GHC.TypeLits-import           Linear.Affine (Affine(..))+import           Linear.Affine                          (Affine (..)) import           Linear.Metric-import qualified Linear.V2 as L2-import qualified Linear.V3 as L3-import qualified Linear.V4 as L4+import qualified Linear.V2                              as L2+import qualified Linear.V3                              as L3+import qualified Linear.V4                              as L4 import           Linear.Vector-import           Text.ParserCombinators.ReadP (ReadP, string,pfail)-import           Text.ParserCombinators.ReadPrec (lift)-import           Text.Read (Read(..),readListPrecDefault, readPrec_to_P,minPrec)-import           Data.Proxy-import           Data.Hashable+import           Text.Read                              (Read (..), readListPrecDefault)  -------------------------------------------------------------------------------- -- * d dimensional Vectors@@ -56,8 +54,9 @@ type instance Index   (Vector d r) = Int type instance IxValue (Vector d r) = r -unV :: Lens (Vector d r) (Vector d s) (VectorFamily (Peano d) r) (VectorFamily (Peano d) s)-unV = lens _unV (const MKVector)+-- | Vectors are isomorphic to a definition determined by 'VectorFamily'.+unV :: Iso (Vector d r) (Vector d s) (VectorFamily (Peano d) r) (VectorFamily (Peano d) s)+unV = iso _unV MKVector {-# INLINE unV #-}  -- type Arity d = (ImplicitArity (Peano d), KnownNat d)@@ -66,6 +65,7 @@   deriving instance (Eq r,  Arity d) => Eq  (Vector d r)+deriving instance Arity d          => Eq1 (Vector d) deriving instance (Ord r, Arity d) => Ord (Vector d r)  deriving instance Arity d => Functor     (Vector d)@@ -99,22 +99,50 @@   inspect    = V.inspect . _unV   basicIndex = V.basicIndex . _unV -instance (Arity d, Show r) => Show (Vector d r) where-  show v = mconcat [ "Vector", show $ F.length v , " "-                   , show $ F.toList v ]+-- instance (Arity d, Show r) => Show (Vector d r) where+--   show v = mconcat [ "Vector", show $ F.length v , " "+--                    , show $ F.toList v ] +-- instance (Read r, Arity d) => Read (Vector d r) where+--   readPrec     = lift readVec+--     where+--       readVec :: (Arity d, Read r) => ReadP (Vector d r)+--       readVec = do let d = natVal (Proxy :: Proxy d)+--                    _  <- string $ "Vector" <> show d <> " "+--                    rs <- readPrec_to_P readPrec minPrec+--                    case vectorFromList rs of+--                     Just v -> pure v+--                     _      -> pfail+--   readListPrec = readListPrecDefault++instance (Show r, Arity d) => Show (Vector d r) where+  showsPrec = liftShowsPrec showsPrec showList++instance (Arity d) => Show1 (Vector d) where+  liftShowsPrec sp _ d v = showParen (d > 10) $+      showString constr . showChar ' ' .+      unwordsS (map (sp 11) (F.toList v))+    where+      constr = "Vector" <> show (fromIntegral (natVal @d Proxy))+      unwordsS = foldr (.) id . intersperse (showChar ' ')+ instance (Read r, Arity d) => Read (Vector d r) where-  readPrec     = lift readVec+  readPrec     = liftReadPrec readPrec readListPrec   readListPrec = readListPrecDefault -readVec :: forall d r. (Arity d, Read r) => ReadP (Vector d r)-readVec = do let d = natVal (Proxy :: Proxy d)-             _  <- string $ "Vector" <> show d <> " "-             rs <- readPrec_to_P readPrec minPrec-             case vectorFromList rs of-               Just v -> pure v-               _      -> pfail+instance (Arity d) => Read1 (Vector d) where+  liftReadPrec rp _rl = readData $+      readUnaryWith (replicateM d rp) constr $ \rs ->+        case vectorFromList rs of+          Just p -> p+          _      -> error "internal error in Data.Geometry.Vector read instance."+    where+      d = fromIntegral (natVal (Proxy :: Proxy d))+      constr = "Vector" <> show d+  liftReadListPrec = liftReadListPrecDefault ++ deriving instance (FromJSON r, Arity d) => FromJSON (Vector d r) instance (ToJSON r, Arity d) => ToJSON (Vector d r) where   toJSON     = toJSON . _unV@@ -125,39 +153,48 @@ -------------------------------------------------------------------------------- -- * Convenience "constructors" +-- | Constant sized vector with d elements. pattern Vector   :: VectorFamilyF (Peano d) r -> Vector d r pattern Vector v = MKVector (VectorFamily v) {-# COMPLETE Vector #-} +-- | Constant sized vector with 1 element. pattern Vector1   :: r -> Vector 1 r pattern Vector1 x = (Vector (Identity x)) {-# COMPLETE Vector1 #-} +-- | Constant sized vector with 2 elements. pattern Vector2     :: r -> r -> Vector 2 r pattern Vector2 x y = (Vector (L2.V2 x y)) {-# COMPLETE Vector2 #-} +-- | Constant sized vector with 3 elements. pattern Vector3        :: r -> r -> r -> Vector 3 r pattern Vector3 x y z  = (Vector (L3.V3 x y z)) {-# COMPLETE Vector3 #-} +-- | Constant sized vector with 4 elements. pattern Vector4         :: r -> r -> r -> r -> Vector 4 r pattern Vector4 x y z w = (Vector (L4.V4 x y z w)) {-# COMPLETE Vector4 #-}  -------------------------------------------------------------------------------- +-- | \( O(n) \) Convert from a list to a non-empty vector. vectorFromList :: Arity d => [r] -> Maybe (Vector d r) vectorFromList = V.fromListM +-- | \( O(n) \) Convert from a list to a non-empty vector. vectorFromListUnsafe :: Arity d => [r] -> Vector d r vectorFromListUnsafe = V.fromList +-- | \( O(n) \) Pop the first element off a vector. destruct   :: (Arity d, Arity (d + 1))            => Vector (d + 1) r -> (r, Vector d r) destruct v = (L.head $ F.toList v, vectorFromListUnsafe . tail $ F.toList v)   -- FIXME: this implementaion of tail is not particularly nice +-- | \( O(1) \) First element. Since arity is at least 1, this function is total. head   :: (Arity d, 1 <= d) => Vector d r -> r head = view $ element (C :: C 0) @@ -174,15 +211,16 @@ -- | Similar to 'element' above. Except that we don't have a static guarantee -- that the index is in bounds. Hence, we can only return a Traversal element' :: forall d r. Arity d => Int -> Traversal' (Vector d r) r-element' i = unV.(e (C :: C d) i)+element' i = unV.e (C :: C d) i   where     e  :: Arity d => proxy d -> Int -> Traversal' (VectorFamily (Peano d) r) r-    e _ = Fam.element'+    e _ = ix {-# INLINE element' #-}  -------------------------------------------------------------------------------- -- * Snoccing and consindg +-- | \( O(n) \) Prepend an element. cons   :: (Arity d, Arity (d+1)) => r -> Vector d r -> Vector (d + 1) r cons x = vectorFromListUnsafe . (x:) . F.toList @@ -195,6 +233,7 @@ init :: (Arity d, Arity (d + 1)) => Vector (d + 1) r -> Vector d r init = vectorFromListUnsafe . L.init . F.toList +-- | \( O(1) \) Last element. Since the vector is non-empty, runtime bounds checks are bypassed. last :: forall d r. (KnownNat d, Arity (d + 1)) => Vector (d + 1) r -> r last = view $ element (C :: C d)
src/Data/Geometry/Vector/VectorFamilyPeano.hs view
@@ -1,6 +1,19 @@ {-# LANGUAGE ScopedTypeVariables  #-} {-# LANGUAGE UndecidableInstances #-}-module Data.Geometry.Vector.VectorFamilyPeano where+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.Vector.VectorFamilyPeano+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--------------------------------------------------------------------------------+module Data.Geometry.Vector.VectorFamilyPeano+  ( ImplicitArity+  , VectorFamily(VectorFamily)+  , VectorFamilyF+  , FromPeano+  , Two+  ) where  import           Control.Applicative (liftA2) import           Control.DeepSeq@@ -10,6 +23,7 @@ import qualified Data.Foldable as F import qualified Data.Geometry.Vector.VectorFixed as FV import           Data.Proxy+import           Data.Functor.Classes import qualified Data.Vector.Fixed as V import           Data.Vector.Fixed.Cont (PeanoNum(..), Fun(..)) import           GHC.TypeLits@@ -92,6 +106,15 @@         (SS (SS (SS (SS (SS _))))) -> u == v   {-# INLINE (==) #-} +instance (ImplicitArity d) => Eq1 (VectorFamily d) where+  liftEq eq (VectorFamily u) (VectorFamily v) = case (implicitPeano :: SingPeano d) of+        SZ                         -> liftEq eq u v+        (SS SZ)                    -> liftEq eq u v+        (SS (SS SZ))               -> liftEq eq u v+        (SS (SS (SS SZ)))          -> liftEq eq u v+        (SS (SS (SS (SS SZ))))     -> liftEq eq u v+        (SS (SS (SS (SS (SS _))))) -> liftEq eq u v+ instance (Ord r, ImplicitArity d) => Ord (VectorFamily d r) where   (VectorFamily u) `compare` (VectorFamily v) = case (implicitPeano :: SingPeano d) of         SZ                         -> u `compare` v@@ -216,13 +239,13 @@ {-# INLINE element' #-}  elem0   :: Int -> Traversal' (VectorFamily Z r) r-elem0 _ = \_ v -> pure v+elem0 _ _ = pure {-# INLINE elem0 #-} -- zero length vectors don't store any elements  elem1 :: Int -> Traversal' (VectorFamily One r) r elem1 = \case-           0 -> unVF.(lens runIdentity (\_ -> Identity))+           0 -> unVF.lens runIdentity (const Identity)            _ -> \_ v -> pure v {-# INLINE elem1 #-} @@ -287,14 +310,14 @@ vectorFromList :: ImplicitArity d => [r] -> Maybe (VectorFamily d r) vectorFromList = V.fromListM -vectorFromListUnsafe :: ImplicitArity d => [r] -> VectorFamily d r-vectorFromListUnsafe = V.fromList+-- vectorFromListUnsafe :: ImplicitArity d => [r] -> VectorFamily d r+-- vectorFromListUnsafe = V.fromList --- | Get the head and tail of a vector-destruct   :: (ImplicitArity d, ImplicitArity (S d))-           => VectorFamily (S d) r -> (r, VectorFamily d r)-destruct v = (head $ F.toList v, vectorFromListUnsafe . tail $ F.toList v)-  -- FIXME: this implementaion of tail is not particularly nice+-- -- | Get the head and tail of a vector+-- destruct   :: (ImplicitArity d, ImplicitArity (S d))+--            => VectorFamily (S d) r -> (r, VectorFamily d r)+-- destruct v = (head $ F.toList v, vectorFromListUnsafe . tail $ F.toList v)+--   -- FIXME: this implementaion of tail is not particularly nice  -- snoc     :: (ImplicitArity d, ImplicitArity (S d)) --          => VectorFamily d r -> r -> VectorFamily (S d) r
src/Data/Geometry/Vector/VectorFixed.hs view
@@ -1,5 +1,12 @@ {-# LANGUAGE ScopedTypeVariables  #-} {-# LANGUAGE UndecidableInstances #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.Vector.VectorFixed+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+-------------------------------------------------------------------------------- module Data.Geometry.Vector.VectorFixed where  import           Control.DeepSeq@@ -9,6 +16,7 @@ import           Data.Proxy import qualified Data.Vector.Fixed as V import           Data.Vector.Fixed (Arity)+import           Data.Functor.Classes import           Data.Vector.Fixed.Boxed import           GHC.Generics (Generic) import           GHC.TypeLits@@ -46,7 +54,7 @@ element'   :: forall d r. Arity d => Int -> Traversal' (Vector d r) r element' i f v   | 0 <= i && i < fromInteger (natVal (C :: C d)) = f (v V.! i)-                                                 <&> \a -> (v&V.element i .~ a)+                                                 <&> \a -> v&V.element i .~ a        -- Implementation based on that of Ixed Vector in Control.Lens.At   | otherwise                                     = pure v @@ -64,6 +72,11 @@                             ]  deriving instance (Eq r, Arity d)   => Eq (Vector d r)++-- FIXME: Upstream Eq1 instance to 'fixed-vector' package.+instance Arity d => Eq1 (Vector d) where+  liftEq eq (Vector lhs) (Vector rhs) = V.and $ V.zipWith eq lhs rhs+ deriving instance (Ord r, Arity d)  => Ord (Vector d r) -- deriving instance Arity d  => Functor (Vector d) @@ -125,7 +138,7 @@  -- | Cross product of two three-dimensional vectors cross       :: Num r => Vector 3 r -> Vector 3 r -> Vector 3 r-u `cross` v = fromV3 $ (toV3 u) `L3.cross` (toV3 v)+u `cross` v = fromV3 $ toV3 u `L3.cross` toV3 v   --------------------------------------------------------------------------------
+ src/Data/Geometry/VerticalRayShooting.hs view
@@ -0,0 +1,12 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.VerticalRayShooting+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--------------------------------------------------------------------------------+module Data.Geometry.VerticalRayShooting+  ( module Data.Geometry.VerticalRayShooting.PersistentSweep+  ) where++import Data.Geometry.VerticalRayShooting.PersistentSweep
+ src/Data/Geometry/VerticalRayShooting/PersistentSweep.hs view
@@ -0,0 +1,230 @@+{-# Language TemplateHaskell #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Geometry.VerticalRayShooting.PersistentSweep+-- Copyright   :  (C) Frank Staals+-- License     :  see the LICENSE file+-- Maintainer  :  Frank Staals+--------------------------------------------------------------------------------+module Data.Geometry.VerticalRayShooting.PersistentSweep+  ( VerticalRayShootingStructure(VerticalRayShootingStructure), StatusStructure+  , leftMost, sweepStruct++  -- * Building the Data Structure+  , verticalRayShootingStructure+  -- * Querying the Data Structure+  , segmentAbove, segmentAboveOrOn+  , findSlab+  , lookupAbove, lookupAboveOrOn, searchInSlab+  , ordAt, yCoordAt+  ) where++import           Algorithms.BinarySearch (binarySearchIn)+import           Control.Lens hiding (contains, below)+import           Data.Ext+import           Data.Foldable (toList)+import           Data.Geometry.Line+import           Data.Geometry.LineSegment+import           Data.Geometry.Point+import qualified Data.List as List+import           Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NonEmpty+import           Data.Maybe (mapMaybe)+import           Data.Ord (comparing)+import           Data.Semigroup.Foldable+import qualified Data.Set as SS -- status struct+import qualified Data.Set.Util as SS+import qualified Data.Vector as V+++import           Data.RealNumber.Rational++type R = RealNumber 5+--------------------------------------------------------------------------------++-- | The vertical ray shooting data structure+data VerticalRayShootingStructure p e r =+    VerticalRayShootingStructure { _leftMost    :: r+                                 , _sweepStruct :: V.Vector (r :+ StatusStructure p e r)+                                   -- ^ entry (r :+ s) means that "just" left of "r" the+                                   -- status structure is 's', i.e up to 'r'+                                 } deriving (Show,Eq)++type StatusStructure p e r = SS.Set (LineSegment 2 p r :+ e)++makeLensesWith (lensRules&generateUpdateableOptics .~ False) ''VerticalRayShootingStructure++--------------------------------------------------------------------------------+-- * Building the DS++-- | Given a set of \(n\) interiorly pairwise disjoint *closed* segments,+-- compute a vertical ray shooting data structure.  (i.e. the+-- endpoints of the segments may coincide).+--+-- pre: no vertical segments+--+-- running time: \(O(n\log n)\).+-- space: \(O(n\log n)\).+verticalRayShootingStructure   :: (Ord r, Fractional r, Foldable1 t)+                               => t (LineSegment 2 p r :+ e)+                               -> VerticalRayShootingStructure p e r+verticalRayShootingStructure ss = VerticalRayShootingStructure (eventX e) (sweep' events)+  where+    events@(e :| _) = fmap combine+                    . NonEmpty.groupAllWith1 eventX+                    . foldMap1 toEvents+                    . NonEmpty.fromList -- precondition guarantees that this is safe+                    . mapMaybe reOrient . toList+                    $ ss+    sweep' = V.fromList . toList . sweep++    reOrient s'@(s :+ z) = case (s^.start.core.xCoord) `compare` (s^.end.core.xCoord) of+                             LT -> Just s'+                             GT -> let s'' = s&start .~ (s^.end) -- flip the segment+                                              &end   .~ (s^.start)+                                   in Just $ s'' :+ z+                             EQ -> Nothing -- precondition says this won't happen, but kill+                                           -- them anyway++-- | Given a bunch of events happening at the same time, merge them into a single event+-- where we apply all actions.+combine                    :: NonEmpty (Event p e r) -> Event p e r+combine es@((x :+ _) :| _) = x :+ foldMap1 eventActions es++-- | Given a line segment construct the two events; i.e. when we+-- insert it and when we delete it.+toEvents                           :: Ord r => LineSegment 2 p r :+ e -> NonEmpty (Event p e r)+toEvents s@(LineSegment' p q :+ _) = NonEmpty.fromList [ (p^.core.xCoord) :+ Insert s :| []+                                                       , (q^.core.xCoord) :+ Delete s :| []+                                                       ]++----------------------------------------++data Action a = Insert a | Delete a  deriving (Show,Eq)++{- HLINT ignore "Avoid lambda using `infix`" -}+interpret :: Action a -> (a -> a -> Ordering) -> SS.Set a -> SS.Set a+interpret = \case+  Insert s -> \cmp -> SS.insertBy    cmp s+  Delete s -> \cmp -> SS.deleteAllBy cmp s+++type Event p e r = r :+ NonEmpty (Action (LineSegment 2 p r :+ e))++eventX :: Event p e r -> r+eventX = view core++eventActions :: Event p e r -> NonEmpty (Action (LineSegment 2 p r :+ e))+eventActions = view extra++----------------------------------------++-- | Runs the sweep building the data structure from left to right.+sweep    :: (Ord r, Fractional r)+         => NonEmpty (Event p e r) -> NonEmpty (r :+ StatusStructure p e r)+sweep es = NonEmpty.fromList+         . snd . List.mapAccumL h SS.empty+         $ zip (toList es) (NonEmpty.tail es)+  where+    h ss evts = let x :+ ss' = handle ss evts in (ss',x :+ ss')++-- | Given the current status structure (for left of the next event+-- 'l'), and the next two events (l,r); essentially defining the slab+-- between l and r, we construct the status structure for in the slab (l,r).+-- returns the right boundary and this status structure.+handle                :: (Ord r, Fractional r)+                      => StatusStructure p e r+                      -> (Event p e r, Event p e r)+                      -> r :+ StatusStructure p e r+handle ss ( l :+ acts+          , r :+ _)   = let mid               = (l+r)/2+                            runActionAt x act = interpret act (ordAt x)+                        in r :+ foldr (runActionAt mid) ss (orderActs acts)+                           -- run deletions first++-- | orders the actions to put insertions first and then all deletions+orderActs      :: NonEmpty (Action a) -> NonEmpty (Action a)+orderActs acts = let (dels,ins) = NonEmpty.partition (\case+                                                         Delete _ -> True+                                                         Insert _ -> False+                                                     ) acts+                 in NonEmpty.fromList $ ins <> dels+++--------------------------------------------------------------------------------+-- * Querying the DS++-- | Find the segment vertically strictly above query point q, if it+-- exists.+--+-- \(O(\log n)\)+segmentAbove      :: (Ord r, Num r) => Point 2 r -> VerticalRayShootingStructure p e r+                  -> Maybe (LineSegment 2 p r :+ e)+segmentAbove q ds = findSlab q ds >>= lookupAbove q++-- | Find the segment vertically query point q, if it exists.+--+-- \(O(\log n)\)+segmentAboveOrOn      :: (Ord r, Num r)+                      => Point 2 r -> VerticalRayShootingStructure p e r+                      -> Maybe (LineSegment 2 p r :+ e)+segmentAboveOrOn q ds = findSlab q ds >>= lookupAboveOrOn q++++-- | Given a query point, find the (data structure of the) slab containing the query point+--+-- \(O(\log n)\)+findSlab :: Ord r+         => Point 2 r -> VerticalRayShootingStructure p e r -> Maybe (StatusStructure p e r)+findSlab q ds | q^.xCoord < ds^.leftMost = Nothing+              | otherwise                = view extra+                                        <$> binarySearchIn (q `leftOf `) (ds^.sweepStruct)+  where+    q' `leftOf` (r :+ _) = q'^.xCoord <= r++--------------------------------------------------------------------------------+-- * Querying in a single slab++-- | Finds the segment containing or above the query point 'q'+--+-- \(O(\log n)\)+lookupAboveOrOn   :: (Ord r, Num r)+                  => Point 2 r -> StatusStructure p e r -> Maybe (LineSegment 2 p r :+ e)+lookupAboveOrOn q = searchInSlab (not . (q `liesAbove`))++-- | Finds the first segment strictly above q+--+-- \(O(\log n)\)+lookupAbove   :: (Ord r, Num r)+              => Point 2 r -> StatusStructure p e r -> Maybe (LineSegment 2 p r :+ e)+lookupAbove q = searchInSlab (q `liesBelow`)++-- | generic searching function+searchInSlab   :: Num r => (Line 2 r -> Bool)+               -> StatusStructure p e r -> Maybe (LineSegment 2 p r :+ e)+searchInSlab p = binarySearchIn (p . supportingLine . view core)+++----------------------------------------------------------------------------------++type Compare a = a -> a -> Ordering++-- | Compare based on the y-coordinate of the intersection with the horizontal+-- line through y+ordAt   :: (Fractional r, Ord r) => r -> Compare (LineSegment 2 p r :+ e)+ordAt x = comparing (yCoordAt x)+++-- | Given an x-coordinate and a line segment that intersects the vertical line+-- through x, compute the y-coordinate of this intersection point.+--+-- note that we will pretend that the line segment is closed, even if it is not+yCoordAt :: (Fractional r, Ord r) => r -> LineSegment 2 p r :+ e -> r+yCoordAt x (LineSegment' (Point2 px py :+ _) (Point2 qx qy :+ _) :+ _)+    | px == qx  = py `max` qy -- s is vertical, since by the precondition it+                              -- intersects we return the y-coord of the topmost+                              -- endpoint.+    | otherwise = py + alpha * (qy - py)+  where+    alpha = (x - px) / (qx - px)
src/Data/PlaneGraph.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------------------- -- | -- Module      :  Data.PlaneGraph
src/Data/PlaneGraph/Core.hs view
@@ -1,6 +1,6 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell     #-} -------------------------------------------------------------------------------- -- | -- Module      :  Data.PlaneGraph.Core@@ -58,33 +58,29 @@                            ) where  -import           Control.Lens hiding (holes, holesOf, (.=))+import           Control.Lens              hiding (holes, holesOf, (.=)) import           Data.Aeson-import qualified Data.CircularSeq as C import           Data.Ext-import qualified Data.Foldable as F-import           Data.Function (on)+import qualified Data.Foldable             as F+import           Data.Function             (on) import           Data.Geometry.Box import           Data.Geometry.Interval-import           Data.Geometry.Line (cmpSlope, supportingLine)+import           Data.Geometry.Line        (cmpSlope, supportingLine) import           Data.Geometry.LineSegment hiding (endPoints) import           Data.Geometry.Point import           Data.Geometry.Polygon import           Data.Geometry.Properties-import qualified Data.List.NonEmpty as NonEmpty-import qualified Data.Map as M-import           Data.Ord (comparing)-import qualified Data.PlanarGraph as PG-import           Data.PlanarGraph( PlanarGraph, planarGraph, dual-                                 , Dart(..), VertexId(..), FaceId(..), Arc(..)-                                 , Direction(..), twin-                                 , World(..)-                                 , FaceId', VertexId'-                                 , HasDataOf(..)-                                 )+import qualified Data.List.NonEmpty        as NonEmpty+import qualified Data.Map                  as M+import           Data.Ord                  (comparing)+import           Data.PlanarGraph          (Arc (..), Dart (..), Direction (..), FaceId (..),+                                            FaceId', HasDataOf (..), PlanarGraph, VertexId (..),+                                            VertexId', World (..), dual, planarGraph, twin)+import qualified Data.PlanarGraph          as PG import           Data.Util-import qualified Data.Vector as V-import           GHC.Generics (Generic)+import qualified Data.Vector               as V+import           Data.Vector.Circular      (CircularVector)+import           GHC.Generics              (Generic)  -------------------------------------------------------------------------------- @@ -182,15 +178,16 @@                                              -> f -- ^ data inside                                              -> f -- ^ data outside the polygon                                              -> PlaneGraph s p () f r-fromSimplePolygon p (SimplePolygon vs) iD oD = PlaneGraph g'+fromSimplePolygon p poly iD oD = PlaneGraph g'   where+    vs     = poly ^. outerBoundaryVector     g      = fromVertices p vs     fData' = V.fromList [iD, oD]     g'     = g & PG.faceData .~ fData'  -- | Constructs a planar from the given vertices fromVertices      :: proxy s-                  -> C.CSeq (Point 2 r :+ p)+                  -> CircularVector (Point 2 r :+ p)                   -> PlanarGraph s Primal (VertexData r p) () () fromVertices _ vs = g&PG.vertexData .~ vData'   where@@ -223,7 +220,7 @@      sing x = x NonEmpty.:| [] -    vts    = map (\(p,sp) -> (p,map (^.extra) . sortAround (ext p) <$> sp))+    vts    = map (\(p,sp) -> (p,map (^.extra) . sortAround' (ext p) <$> sp))            . M.assocs $ pts     -- vertex Data     vxData = V.fromList . map (\(p,sp) -> VertexData p (sp^._1)) $ vts@@ -272,10 +269,10 @@ -- | Enumerate all vertices, together with their vertex data -- -- >>> mapM_ print $ vertices smallG--- (VertexId 0,VertexData {_location = Point2 [0,0], _vData = 0})--- (VertexId 1,VertexData {_location = Point2 [2,2], _vData = 1})--- (VertexId 2,VertexData {_location = Point2 [2,0], _vData = 2})--- (VertexId 3,VertexData {_location = Point2 [-1,4], _vData = 3})+-- (VertexId 0,VertexData {_location = Point2 0 0, _vData = 0})+-- (VertexId 1,VertexData {_location = Point2 2 2, _vData = 1})+-- (VertexId 2,VertexData {_location = Point2 2 0, _vData = 2})+-- (VertexId 3,VertexData {_location = Point2 (-1) 4, _vData = 3}) vertices   :: PlaneGraph s v e f r  -> V.Vector (VertexId' s, VertexData r v) vertices = PG.vertices . _graph @@ -565,7 +562,7 @@                    => (VertexId' s -> v -> m v')                    -> PlaneGraph s v e f r                    -> m (PlaneGraph s v' e f r)-traverseVertices f = itraverseOf (vertexData.itraversed) (\i -> f (VertexId i))+traverseVertices f = itraverseOf (vertexData.itraversed) (f . VertexId)  -- | Traverses the darts --@@ -636,7 +633,7 @@            -- compare lexicographically; i.e. if same x-coord prefer the one with the            -- smallest y-coord     d :+ _ = V.maximumBy (cmpSlope `on` (^.extra))-           .  fmap (\d' -> d' :+ (edgeSegment d' ps)^.core.to supportingLine)+           .  fmap (\d' -> d' :+ edgeSegment d' ps ^. core.to supportingLine)            $ incidentEdges v ps     -- based on the approach sketched at https://cstheory.stackexchange.com/questions/27586/finding-outer-face-in-plane-graph-embedded-planar-graph     -- basically: find the leftmost vertex, find the incident edge with the largest slope@@ -650,11 +647,11 @@ -- | Reports all edges as line segments -- -- >>> mapM_ print $ edgeSegments smallG--- (Dart (Arc 0) +1,LineSegment (Closed (Point2 [0,0] :+ 0)) (Closed (Point2 [2,0] :+ 2)) :+ "0->2")--- (Dart (Arc 1) +1,LineSegment (Closed (Point2 [0,0] :+ 0)) (Closed (Point2 [2,2] :+ 1)) :+ "0->1")--- (Dart (Arc 2) +1,LineSegment (Closed (Point2 [0,0] :+ 0)) (Closed (Point2 [-1,4] :+ 3)) :+ "0->3")--- (Dart (Arc 4) +1,LineSegment (Closed (Point2 [2,2] :+ 1)) (Closed (Point2 [2,0] :+ 2)) :+ "1->2")--- (Dart (Arc 3) +1,LineSegment (Closed (Point2 [2,2] :+ 1)) (Closed (Point2 [-1,4] :+ 3)) :+ "1->3")+-- (Dart (Arc 0) +1,ClosedLineSegment (Point2 0 0 :+ 0) (Point2 2 0 :+ 2) :+ "0->2")+-- (Dart (Arc 1) +1,ClosedLineSegment (Point2 0 0 :+ 0) (Point2 2 2 :+ 1) :+ "0->1")+-- (Dart (Arc 2) +1,ClosedLineSegment (Point2 0 0 :+ 0) (Point2 (-1) 4 :+ 3) :+ "0->3")+-- (Dart (Arc 4) +1,ClosedLineSegment (Point2 2 2 :+ 1) (Point2 2 0 :+ 2) :+ "1->2")+-- (Dart (Arc 3) +1,ClosedLineSegment (Point2 2 2 :+ 1) (Point2 (-1) 4 :+ 3) :+ "1->3") edgeSegments    :: PlaneGraph s v e f r -> V.Vector (Dart s, LineSegment 2 v r :+ e) edgeSegments ps = fmap withSegment . edges $ ps   where@@ -683,7 +680,7 @@                     -> SimplePolygon v r :+ f rawFaceBoundary i ps = pg :+ (ps^.dataOf i)   where-    pg = fromPoints . F.toList . fmap (\j -> ps^.graph.dataOf j.to vtxDataToExt)+    pg = unsafeFromPoints . F.toList . fmap (\j -> ps^.graph.dataOf j.to vtxDataToExt)        . boundaryVertices i $ ps  -- | Alias for rawFace Boundary
src/Data/PlaneGraph/IO.hs view
@@ -16,7 +16,6 @@ import           Data.Aeson import           Data.Bifunctor import qualified Data.ByteString as B-import           Data.Ext import           Data.Geometry.Point import qualified Data.List as List import qualified Data.PlanarGraph.AdjRep as PGA@@ -123,11 +122,11 @@     location' = V.create $ do                    a <- MV.new (length vs)                    forM_ vs $ \(Vtx i p _ _) ->-                     MV.write a i $ ext p+                     MV.write a i p                    pure a     -- sort the adjacencies around every vertex v     sort' (Vtx v p ajs x) = Vtx v p (List.sortBy (around p) ajs) x-    around p (a,_) (b,_) = ccwCmpAround (ext p) (location' V.! a) (location' V.! b)+    around p (a,_) (b,_) = ccwCmpAround p (location' V.! a) (location' V.! b)                            -- note: since the graph is planar, there should not be                            -- any pairs of points for which ccwCmpAround returns EQ                            -- hence, no need to pick a secondary comparison
src/Graphics/Camera.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE TemplateHaskell  #-} -------------------------------------------------------------------------------- -- | -- Module      :  Graphics.Camera@@ -32,7 +31,7 @@ -- | A basic camera data type. The fields stored are: -- -- * the camera position,--- * the raw camera normal, i.e. a unit vecotr into the center of the screen,+-- * the raw camera normal, i.e. a unit vector into the center of the screen, -- * the raw view up vector indicating which side points "upwards" in the scene, -- * the viewplane depth (i.e. the distance from the camera position to the plane on which we project), -- * the near distance (everything closer than this is clipped),@@ -53,8 +52,38 @@ ---------------------------------------- -- * Field Accessor Lenses -makeLenses ''Camera+-- Lemmih: Writing out the lenses by hand so they can be documented.+-- makeLenses ''Camera +-- | Camera position.+cameraPosition :: Lens' (Camera r) (Point 3 r)+cameraPosition = lens _cameraPosition (\cam p -> cam{_cameraPosition=p})++-- | Raw camera normal, i.e. a unit vector into the center of the screen.+rawCameraNormal :: Lens' (Camera r) (Vector 3 r)+rawCameraNormal = lens _rawCameraNormal (\cam r -> cam{_rawCameraNormal=r})++-- | Raw view up vector indicating which side points "upwards" in the scene.+rawViewUp :: Lens' (Camera r) (Vector 3 r)+rawViewUp = lens _rawViewUp (\cam r -> cam{_rawViewUp=r})++-- | Viewplane depth (i.e. the distance from the camera position to the plane on which we project).+viewPlaneDepth :: Lens' (Camera r) r+viewPlaneDepth = lens _viewPlaneDepth (\cam v -> cam{_viewPlaneDepth=v})++-- | Near distance (everything closer than this is clipped).+nearDist :: Lens' (Camera r) r+nearDist = lens _nearDist (\cam n -> cam{_nearDist=n})++-- | Far distance (everything further away than this is clipped).+farDist :: Lens' (Camera r) r+farDist = lens _farDist (\cam f -> cam{_farDist=f})++-- | Screen dimensions.+screenDimensions :: Lens' (Camera r) (Vector 2 r)+screenDimensions = lens _screenDimensions (\cam d -> cam{_screenDimensions=d})++ -------------------------------------------------------------------------------- -- * Accessor Lenses @@ -82,8 +111,7 @@  -- | Translates world coordinates into view coordinates worldToView   :: Fractional r => Camera r -> Transformation 3 r-worldToView c =  rotateCoordSystem c-             |.| (translation $ (-1) *^ c^.cameraPosition.vector)+worldToView c = rotateCoordSystem c |.| translation ((-1) *^ c^.cameraPosition.vector)  -- | Transformation into viewport coordinates toViewPort   :: Fractional r => Camera r -> Transformation 3 r
− test/Algorithms/Geometry/LineSegmentIntersection/manual.ipe 
@@ -1,324 +0,0 @@-<?xml version="1.0"?>-<!DOCTYPE ipe SYSTEM "ipe.dtd">-<ipe version="70107" creator="Ipe 7.2.2">-<info created="D:20160903131616" modified="D:20161022125153"/>-<ipestyle name="basic">-<symbol name="arrow/arc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/farc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/ptarc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fptarc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="mark/circle(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</symbol>-<symbol name="mark/disk(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-</path>-</symbol>-<symbol name="mark/fdisk(sfx)" transformations="translations">-<group>-<path fill="sym-fill">-0.5 0 0 0.5 0 0 e-</path>-<path fill="sym-stroke" fillrule="eofill">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</group>-</symbol>-<symbol name="mark/box(sx)" transformations="translations">-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</symbol>-<symbol name="mark/square(sx)" transformations="translations">-<path fill="sym-stroke">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h-</path>-</symbol>-<symbol name="mark/fsquare(sfx)" transformations="translations">-<group>-<path fill="sym-fill">--0.5 -0.5 m-0.5 -0.5 l-0.5 0.5 l--0.5 0.5 l-h-</path>-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</group>-</symbol>-<symbol name="mark/cross(sx)" transformations="translations">-<group>-<path fill="sym-stroke">--0.43 -0.57 m-0.57 0.43 l-0.43 0.57 l--0.57 -0.43 l-h-</path>-<path fill="sym-stroke">--0.43 0.57 m-0.57 -0.43 l-0.43 -0.57 l--0.57 0.43 l-h-</path>-</group>-</symbol>-<symbol name="arrow/fnormal(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/pointed(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fpointed(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/linear(spx)">-<path stroke="sym-stroke" pen="sym-pen">--1 0.333 m-0 0 l--1 -0.333 l-</path>-</symbol>-<symbol name="arrow/fdouble(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/double(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<pen name="heavier" value="0.8"/>-<pen name="fat" value="1.2"/>-<pen name="ultrafat" value="2"/>-<symbolsize name="large" value="5"/>-<symbolsize name="small" value="2"/>-<symbolsize name="tiny" value="1.1"/>-<arrowsize name="large" value="10"/>-<arrowsize name="small" value="5"/>-<arrowsize name="tiny" value="3"/>-<color name="red" value="1 0 0"/>-<color name="green" value="0 1 0"/>-<color name="blue" value="0 0 1"/>-<color name="yellow" value="1 1 0"/>-<color name="orange" value="1 0.647 0"/>-<color name="gold" value="1 0.843 0"/>-<color name="purple" value="0.627 0.125 0.941"/>-<color name="gray" value="0.745"/>-<color name="brown" value="0.647 0.165 0.165"/>-<color name="navy" value="0 0 0.502"/>-<color name="pink" value="1 0.753 0.796"/>-<color name="seagreen" value="0.18 0.545 0.341"/>-<color name="turquoise" value="0.251 0.878 0.816"/>-<color name="violet" value="0.933 0.51 0.933"/>-<color name="darkblue" value="0 0 0.545"/>-<color name="darkcyan" value="0 0.545 0.545"/>-<color name="darkgray" value="0.663"/>-<color name="darkgreen" value="0 0.392 0"/>-<color name="darkmagenta" value="0.545 0 0.545"/>-<color name="darkorange" value="1 0.549 0"/>-<color name="darkred" value="0.545 0 0"/>-<color name="lightblue" value="0.678 0.847 0.902"/>-<color name="lightcyan" value="0.878 1 1"/>-<color name="lightgray" value="0.827"/>-<color name="lightgreen" value="0.565 0.933 0.565"/>-<color name="lightyellow" value="1 1 0.878"/>-<dashstyle name="dashed" value="[4] 0"/>-<dashstyle name="dotted" value="[1 3] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<textsize name="large" value="\large"/>-<textsize name="Large" value="\Large"/>-<textsize name="LARGE" value="\LARGE"/>-<textsize name="huge" value="\huge"/>-<textsize name="Huge" value="\Huge"/>-<textsize name="small" value="\small"/>-<textsize name="footnote" value="\footnotesize"/>-<textsize name="tiny" value="\tiny"/>-<textstyle name="center" begin="\begin{center}" end="\end{center}"/>-<textstyle name="itemize" begin="\begin{itemize}" end="\end{itemize}"/>-<textstyle name="item" begin="\begin{itemize}\item{}" end="\end{itemize}"/>-<gridsize name="4 pts" value="4"/>-<gridsize name="8 pts (~3 mm)" value="8"/>-<gridsize name="16 pts (~6 mm)" value="16"/>-<gridsize name="32 pts (~12 mm)" value="32"/>-<gridsize name="10 pts (~3.5 mm)" value="10"/>-<gridsize name="20 pts (~7 mm)" value="20"/>-<gridsize name="14 pts (~5 mm)" value="14"/>-<gridsize name="28 pts (~10 mm)" value="28"/>-<gridsize name="56 pts (~20 mm)" value="56"/>-<anglesize name="90 deg" value="90"/>-<anglesize name="60 deg" value="60"/>-<anglesize name="45 deg" value="45"/>-<anglesize name="30 deg" value="30"/>-<anglesize name="22.5 deg" value="22.5"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="75%" value="0.75"/>-<tiling name="falling" angle="-60" step="4" width="1"/>-<tiling name="rising" angle="30" step="4" width="1"/>-</ipestyle>-<ipestyle name="frank">-<arrowsize name="normal" value="5"/>-<arrowsize name="large" value="8"/>-<arrowsize name="huge" value="10"/>-<arrowsize name="small" value="3"/>-<arrowsize name="tiny" value="1"/>-<dashstyle name="dashed" value="[2 2] 0"/>-<dashstyle name="dotted" value="[0.5 1] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<gridsize name="1 pts" value="1"/>-<gridsize name="2 pts" value="2"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="20%" value="0.2"/>-<opacity name="40%" value="0.4"/>-<opacity name="60%" value="0.6"/>-<opacity name="70%" value="0.7"/>-<opacity name="80%" value="0.8"/>-<opacity name="90%" value="0.9"/>-</ipestyle>-<page>-<layer name="alpha"/>-<view layers="alpha" active="alpha"/>-<path layer="alpha" stroke="black">-16 16 m-144 80 l-</path>-<path stroke="black">-128 32 m-256 112 l-</path>-<path stroke="black">-144 80 m-225.708 52.1085 l-</path>-<path matrix="2.39165 0 0 2.39165 -206.711 -120.784" stroke="black">-144 80 m-148.537 86.7918 l-</path>-<path stroke="black">-144 80 m-140.284 85.5945 l-</path>-<path stroke="black">-137.686 70.5482 m-173.031 38.3458 l-</path>-<path stroke="black">-89.5694 78.2992 m-186.333 44.2802 l-</path>-<path stroke="black">-75.255 80.7127 m-75.255 24.0132 l-</path>-<path stroke="black">-35.9103 40.8867 m-180.812 40.8867 l-</path>-<path stroke="black">-82.6725 35.3346 m-57.1425 25.6907 l-</path>-<path stroke="black">-40.6648 34.541 m-144.411 12.4306 l-</path>-</page>-</ipe>
− test/Algorithms/Geometry/LineSegmentIntersection/selfIntersections.ipe 
@@ -1,313 +0,0 @@-<?xml version="1.0"?>-<!DOCTYPE ipe SYSTEM "ipe.dtd">-<ipe version="70107" creator="Ipe 7.2.2">-<info created="D:20170428203409" modified="D:20170428203521"/>-<ipestyle name="basic">-<symbol name="arrow/arc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/farc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/ptarc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fptarc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="mark/circle(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</symbol>-<symbol name="mark/disk(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-</path>-</symbol>-<symbol name="mark/fdisk(sfx)" transformations="translations">-<group>-<path fill="sym-fill">-0.5 0 0 0.5 0 0 e-</path>-<path fill="sym-stroke" fillrule="eofill">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</group>-</symbol>-<symbol name="mark/box(sx)" transformations="translations">-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</symbol>-<symbol name="mark/square(sx)" transformations="translations">-<path fill="sym-stroke">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h-</path>-</symbol>-<symbol name="mark/fsquare(sfx)" transformations="translations">-<group>-<path fill="sym-fill">--0.5 -0.5 m-0.5 -0.5 l-0.5 0.5 l--0.5 0.5 l-h-</path>-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</group>-</symbol>-<symbol name="mark/cross(sx)" transformations="translations">-<group>-<path fill="sym-stroke">--0.43 -0.57 m-0.57 0.43 l-0.43 0.57 l--0.57 -0.43 l-h-</path>-<path fill="sym-stroke">--0.43 0.57 m-0.57 -0.43 l-0.43 -0.57 l--0.57 0.43 l-h-</path>-</group>-</symbol>-<symbol name="arrow/fnormal(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/pointed(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fpointed(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/linear(spx)">-<path stroke="sym-stroke" pen="sym-pen">--1 0.333 m-0 0 l--1 -0.333 l-</path>-</symbol>-<symbol name="arrow/fdouble(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/double(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<pen name="heavier" value="0.8"/>-<pen name="fat" value="1.2"/>-<pen name="ultrafat" value="2"/>-<symbolsize name="large" value="5"/>-<symbolsize name="small" value="2"/>-<symbolsize name="tiny" value="1.1"/>-<arrowsize name="large" value="10"/>-<arrowsize name="small" value="5"/>-<arrowsize name="tiny" value="3"/>-<color name="red" value="1 0 0"/>-<color name="green" value="0 1 0"/>-<color name="blue" value="0 0 1"/>-<color name="yellow" value="1 1 0"/>-<color name="orange" value="1 0.647 0"/>-<color name="gold" value="1 0.843 0"/>-<color name="purple" value="0.627 0.125 0.941"/>-<color name="gray" value="0.745"/>-<color name="brown" value="0.647 0.165 0.165"/>-<color name="navy" value="0 0 0.502"/>-<color name="pink" value="1 0.753 0.796"/>-<color name="seagreen" value="0.18 0.545 0.341"/>-<color name="turquoise" value="0.251 0.878 0.816"/>-<color name="violet" value="0.933 0.51 0.933"/>-<color name="darkblue" value="0 0 0.545"/>-<color name="darkcyan" value="0 0.545 0.545"/>-<color name="darkgray" value="0.663"/>-<color name="darkgreen" value="0 0.392 0"/>-<color name="darkmagenta" value="0.545 0 0.545"/>-<color name="darkorange" value="1 0.549 0"/>-<color name="darkred" value="0.545 0 0"/>-<color name="lightblue" value="0.678 0.847 0.902"/>-<color name="lightcyan" value="0.878 1 1"/>-<color name="lightgray" value="0.827"/>-<color name="lightgreen" value="0.565 0.933 0.565"/>-<color name="lightyellow" value="1 1 0.878"/>-<dashstyle name="dashed" value="[4] 0"/>-<dashstyle name="dotted" value="[1 3] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<textsize name="large" value="\large"/>-<textsize name="Large" value="\Large"/>-<textsize name="LARGE" value="\LARGE"/>-<textsize name="huge" value="\huge"/>-<textsize name="Huge" value="\Huge"/>-<textsize name="small" value="\small"/>-<textsize name="footnote" value="\footnotesize"/>-<textsize name="tiny" value="\tiny"/>-<textstyle name="center" begin="\begin{center}" end="\end{center}"/>-<textstyle name="itemize" begin="\begin{itemize}" end="\end{itemize}"/>-<textstyle name="item" begin="\begin{itemize}\item{}" end="\end{itemize}"/>-<gridsize name="4 pts" value="4"/>-<gridsize name="8 pts (~3 mm)" value="8"/>-<gridsize name="16 pts (~6 mm)" value="16"/>-<gridsize name="32 pts (~12 mm)" value="32"/>-<gridsize name="10 pts (~3.5 mm)" value="10"/>-<gridsize name="20 pts (~7 mm)" value="20"/>-<gridsize name="14 pts (~5 mm)" value="14"/>-<gridsize name="28 pts (~10 mm)" value="28"/>-<gridsize name="56 pts (~20 mm)" value="56"/>-<anglesize name="90 deg" value="90"/>-<anglesize name="60 deg" value="60"/>-<anglesize name="45 deg" value="45"/>-<anglesize name="30 deg" value="30"/>-<anglesize name="22.5 deg" value="22.5"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="75%" value="0.75"/>-<tiling name="falling" angle="-60" step="4" width="1"/>-<tiling name="rising" angle="30" step="4" width="1"/>-</ipestyle>-<ipestyle name="frank">-<arrowsize name="normal" value="5"/>-<arrowsize name="large" value="8"/>-<arrowsize name="huge" value="10"/>-<arrowsize name="small" value="3"/>-<arrowsize name="tiny" value="1"/>-<dashstyle name="dashed" value="[2 2] 0"/>-<dashstyle name="dotted" value="[0.5 1] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<gridsize name="1 pts" value="1"/>-<gridsize name="2 pts" value="2"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="20%" value="0.2"/>-<opacity name="40%" value="0.4"/>-<opacity name="60%" value="0.6"/>-<opacity name="70%" value="0.7"/>-<opacity name="80%" value="0.8"/>-<opacity name="90%" value="0.9"/>-</ipestyle>-<page>-<layer name="alpha"/>-<view layers="alpha" active="alpha"/>-<path layer="alpha" stroke="red">-96 704 m-192 816 l-352 656 l-208 640 l-336 784 l-h-</path>-<path stroke="red">-144 592 m-336 624 l-320 544 l-240 624 l-h-</path>-<path stroke="blue">-80 624 m-32 576 l-128 576 l-h-</path>-<path stroke="blue">-64 784 m-32 752 l-32 688 l-64 672 l-144 672 l-96 688 l-80 768 l-128 768 l-112 800 l-h-</path>-</page>-</ipe>
− test/Algorithms/Geometry/LinearProgramming/manual.ipe 
@@ -1,370 +0,0 @@-<?xml version="1.0"?>-<!DOCTYPE ipe SYSTEM "ipe.dtd">-<ipe version="70206" creator="Ipe 7.2.7">-<info created="D:20190310094400" modified="D:20190310110316"/>-<ipestyle name="basic">-<symbol name="arrow/arc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/farc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/ptarc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fptarc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="mark/circle(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</symbol>-<symbol name="mark/disk(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-</path>-</symbol>-<symbol name="mark/fdisk(sfx)" transformations="translations">-<group>-<path fill="sym-fill">-0.5 0 0 0.5 0 0 e-</path>-<path fill="sym-stroke" fillrule="eofill">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</group>-</symbol>-<symbol name="mark/box(sx)" transformations="translations">-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</symbol>-<symbol name="mark/square(sx)" transformations="translations">-<path fill="sym-stroke">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h-</path>-</symbol>-<symbol name="mark/fsquare(sfx)" transformations="translations">-<group>-<path fill="sym-fill">--0.5 -0.5 m-0.5 -0.5 l-0.5 0.5 l--0.5 0.5 l-h-</path>-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</group>-</symbol>-<symbol name="mark/cross(sx)" transformations="translations">-<group>-<path fill="sym-stroke">--0.43 -0.57 m-0.57 0.43 l-0.43 0.57 l--0.57 -0.43 l-h-</path>-<path fill="sym-stroke">--0.43 0.57 m-0.57 -0.43 l-0.43 -0.57 l--0.57 0.43 l-h-</path>-</group>-</symbol>-<symbol name="arrow/fnormal(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/pointed(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fpointed(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/linear(spx)">-<path stroke="sym-stroke" pen="sym-pen">--1 0.333 m-0 0 l--1 -0.333 l-</path>-</symbol>-<symbol name="arrow/fdouble(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/double(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<pen name="heavier" value="0.8"/>-<pen name="fat" value="1.2"/>-<pen name="ultrafat" value="2"/>-<symbolsize name="large" value="5"/>-<symbolsize name="small" value="2"/>-<symbolsize name="tiny" value="1.1"/>-<arrowsize name="large" value="10"/>-<arrowsize name="small" value="5"/>-<arrowsize name="tiny" value="3"/>-<color name="red" value="1 0 0"/>-<color name="green" value="0 1 0"/>-<color name="blue" value="0 0 1"/>-<color name="yellow" value="1 1 0"/>-<color name="orange" value="1 0.647 0"/>-<color name="gold" value="1 0.843 0"/>-<color name="purple" value="0.627 0.125 0.941"/>-<color name="gray" value="0.745"/>-<color name="brown" value="0.647 0.165 0.165"/>-<color name="navy" value="0 0 0.502"/>-<color name="pink" value="1 0.753 0.796"/>-<color name="seagreen" value="0.18 0.545 0.341"/>-<color name="turquoise" value="0.251 0.878 0.816"/>-<color name="violet" value="0.933 0.51 0.933"/>-<color name="darkblue" value="0 0 0.545"/>-<color name="darkcyan" value="0 0.545 0.545"/>-<color name="darkgray" value="0.663"/>-<color name="darkgreen" value="0 0.392 0"/>-<color name="darkmagenta" value="0.545 0 0.545"/>-<color name="darkorange" value="1 0.549 0"/>-<color name="darkred" value="0.545 0 0"/>-<color name="lightblue" value="0.678 0.847 0.902"/>-<color name="lightcyan" value="0.878 1 1"/>-<color name="lightgray" value="0.827"/>-<color name="lightgreen" value="0.565 0.933 0.565"/>-<color name="lightyellow" value="1 1 0.878"/>-<dashstyle name="dashed" value="[4] 0"/>-<dashstyle name="dotted" value="[1 3] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<textsize name="large" value="\large"/>-<textsize name="Large" value="\Large"/>-<textsize name="LARGE" value="\LARGE"/>-<textsize name="huge" value="\huge"/>-<textsize name="Huge" value="\Huge"/>-<textsize name="small" value="\small"/>-<textsize name="footnote" value="\footnotesize"/>-<textsize name="tiny" value="\tiny"/>-<textstyle name="center" begin="\begin{center}" end="\end{center}"/>-<textstyle name="itemize" begin="\begin{itemize}" end="\end{itemize}"/>-<textstyle name="item" begin="\begin{itemize}\item{}" end="\end{itemize}"/>-<gridsize name="4 pts" value="4"/>-<gridsize name="8 pts (~3 mm)" value="8"/>-<gridsize name="16 pts (~6 mm)" value="16"/>-<gridsize name="32 pts (~12 mm)" value="32"/>-<gridsize name="10 pts (~3.5 mm)" value="10"/>-<gridsize name="20 pts (~7 mm)" value="20"/>-<gridsize name="14 pts (~5 mm)" value="14"/>-<gridsize name="28 pts (~10 mm)" value="28"/>-<gridsize name="56 pts (~20 mm)" value="56"/>-<anglesize name="90 deg" value="90"/>-<anglesize name="60 deg" value="60"/>-<anglesize name="45 deg" value="45"/>-<anglesize name="30 deg" value="30"/>-<anglesize name="22.5 deg" value="22.5"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="75%" value="0.75"/>-<tiling name="falling" angle="-60" step="4" width="1"/>-<tiling name="rising" angle="30" step="4" width="1"/>-</ipestyle>-<ipestyle name="frank">-<arrowsize name="normal" value="5"/>-<arrowsize name="large" value="8"/>-<arrowsize name="huge" value="10"/>-<arrowsize name="small" value="3"/>-<arrowsize name="tiny" value="1"/>-<dashstyle name="dashed" value="[2 2] 0"/>-<dashstyle name="dotted" value="[0.5 1] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<gridsize name="1 pts" value="1"/>-<gridsize name="2 pts" value="2"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="20%" value="0.2"/>-<opacity name="40%" value="0.4"/>-<opacity name="60%" value="0.6"/>-<opacity name="70%" value="0.7"/>-<opacity name="80%" value="0.8"/>-<opacity name="90%" value="0.9"/>-</ipestyle>-<page>-<layer name="alpha"/>-<view layers="alpha" active="alpha"/>-<path layer="alpha" stroke="blue">-80 512 m-496 688 l-</path>-<path stroke="blue">-32 656 m-400 496 l-</path>-<path stroke="blue">-192 512 m-512 592 l-</path>-<path stroke="blue">-80 544 m-448 512 l-</path>-<path stroke="red">-48 608 m-400 768 l-</path>-<path stroke="red">-64 784 m-512 672 l-</path>-<path stroke="red">-64 720 m-560 688 l-</path>-<use name="mark/disk(sx)" pos="223.532 572.725" size="normal" stroke="black"/>-</page>-<page>-<layer name="alpha"/>-<view layers="alpha" active="alpha"/>-<path layer="alpha" matrix="2.40555 0 0 2.40555 -64.8028 -863.829" stroke="red">-46.1048 614.582 m-429.2 688.899 l-</path>-<path matrix="2.32631 0 0 2.32631 -54.964 -984.057" stroke="blue">-41.4414 741.953 m-423.596 711.062 l-</path>-<path stroke="red">-121.985 842 m-859.993 369.865 l-</path>-</page>-<page>-<layer name="alpha"/>-<view layers="alpha" active="alpha"/>-<path layer="alpha" stroke="red">-22.6642 533.532 m-595 760.836 l-</path>-<path stroke="red">-0 803.856 m-595 555.084 l-</path>-<path stroke="red">--29.9681 598.468 m-794.006 675.181 l-</path>-<path stroke="red">-411.476 809.515 m-595 311.453 l-</path>-<path stroke="red">-0 382.909 m-437.853 1024.64 l-</path>-<path stroke="blue">--16.5606 862.606 m-411.101 433.915 l-</path>-<path stroke="blue">-95.0642 522.237 m-857.65 676.395 l-</path>-<path stroke="blue">-277.375 460.704 m-642.518 950.636 l-</path>-<path stroke="blue">-450.168 450.864 m-868.112 754.196 l-</path>-<path stroke="blue">-28.6395 500.773 m-594.217 555.411 l-</path>-<use name="mark/disk(sx)" pos="284.74 560.58" size="normal" stroke="blue"/>-</page>-</ipe>
− test/Algorithms/Geometry/LowerEnvelope/manual.ipe 
@@ -1,299 +0,0 @@-<?xml version="1.0"?>-<!DOCTYPE ipe SYSTEM "ipe.dtd">-<ipe version="70107" creator="Ipe 7.2.2">-<info created="D:20170715125328" modified="D:20170715125434"/>-<ipestyle name="basic">-<symbol name="arrow/arc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/farc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/ptarc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fptarc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="mark/circle(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</symbol>-<symbol name="mark/disk(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-</path>-</symbol>-<symbol name="mark/fdisk(sfx)" transformations="translations">-<group>-<path fill="sym-fill">-0.5 0 0 0.5 0 0 e-</path>-<path fill="sym-stroke" fillrule="eofill">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</group>-</symbol>-<symbol name="mark/box(sx)" transformations="translations">-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</symbol>-<symbol name="mark/square(sx)" transformations="translations">-<path fill="sym-stroke">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h-</path>-</symbol>-<symbol name="mark/fsquare(sfx)" transformations="translations">-<group>-<path fill="sym-fill">--0.5 -0.5 m-0.5 -0.5 l-0.5 0.5 l--0.5 0.5 l-h-</path>-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</group>-</symbol>-<symbol name="mark/cross(sx)" transformations="translations">-<group>-<path fill="sym-stroke">--0.43 -0.57 m-0.57 0.43 l-0.43 0.57 l--0.57 -0.43 l-h-</path>-<path fill="sym-stroke">--0.43 0.57 m-0.57 -0.43 l-0.43 -0.57 l--0.57 0.43 l-h-</path>-</group>-</symbol>-<symbol name="arrow/fnormal(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/pointed(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fpointed(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/linear(spx)">-<path stroke="sym-stroke" pen="sym-pen">--1 0.333 m-0 0 l--1 -0.333 l-</path>-</symbol>-<symbol name="arrow/fdouble(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/double(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<pen name="heavier" value="0.8"/>-<pen name="fat" value="1.2"/>-<pen name="ultrafat" value="2"/>-<symbolsize name="large" value="5"/>-<symbolsize name="small" value="2"/>-<symbolsize name="tiny" value="1.1"/>-<arrowsize name="large" value="10"/>-<arrowsize name="small" value="5"/>-<arrowsize name="tiny" value="3"/>-<color name="red" value="1 0 0"/>-<color name="green" value="0 1 0"/>-<color name="blue" value="0 0 1"/>-<color name="yellow" value="1 1 0"/>-<color name="orange" value="1 0.647 0"/>-<color name="gold" value="1 0.843 0"/>-<color name="purple" value="0.627 0.125 0.941"/>-<color name="gray" value="0.745"/>-<color name="brown" value="0.647 0.165 0.165"/>-<color name="navy" value="0 0 0.502"/>-<color name="pink" value="1 0.753 0.796"/>-<color name="seagreen" value="0.18 0.545 0.341"/>-<color name="turquoise" value="0.251 0.878 0.816"/>-<color name="violet" value="0.933 0.51 0.933"/>-<color name="darkblue" value="0 0 0.545"/>-<color name="darkcyan" value="0 0.545 0.545"/>-<color name="darkgray" value="0.663"/>-<color name="darkgreen" value="0 0.392 0"/>-<color name="darkmagenta" value="0.545 0 0.545"/>-<color name="darkorange" value="1 0.549 0"/>-<color name="darkred" value="0.545 0 0"/>-<color name="lightblue" value="0.678 0.847 0.902"/>-<color name="lightcyan" value="0.878 1 1"/>-<color name="lightgray" value="0.827"/>-<color name="lightgreen" value="0.565 0.933 0.565"/>-<color name="lightyellow" value="1 1 0.878"/>-<dashstyle name="dashed" value="[4] 0"/>-<dashstyle name="dotted" value="[1 3] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<textsize name="large" value="\large"/>-<textsize name="Large" value="\Large"/>-<textsize name="LARGE" value="\LARGE"/>-<textsize name="huge" value="\huge"/>-<textsize name="Huge" value="\Huge"/>-<textsize name="small" value="\small"/>-<textsize name="footnote" value="\footnotesize"/>-<textsize name="tiny" value="\tiny"/>-<textstyle name="center" begin="\begin{center}" end="\end{center}"/>-<textstyle name="itemize" begin="\begin{itemize}" end="\end{itemize}"/>-<textstyle name="item" begin="\begin{itemize}\item{}" end="\end{itemize}"/>-<gridsize name="4 pts" value="4"/>-<gridsize name="8 pts (~3 mm)" value="8"/>-<gridsize name="16 pts (~6 mm)" value="16"/>-<gridsize name="32 pts (~12 mm)" value="32"/>-<gridsize name="10 pts (~3.5 mm)" value="10"/>-<gridsize name="20 pts (~7 mm)" value="20"/>-<gridsize name="14 pts (~5 mm)" value="14"/>-<gridsize name="28 pts (~10 mm)" value="28"/>-<gridsize name="56 pts (~20 mm)" value="56"/>-<anglesize name="90 deg" value="90"/>-<anglesize name="60 deg" value="60"/>-<anglesize name="45 deg" value="45"/>-<anglesize name="30 deg" value="30"/>-<anglesize name="22.5 deg" value="22.5"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="75%" value="0.75"/>-<tiling name="falling" angle="-60" step="4" width="1"/>-<tiling name="rising" angle="30" step="4" width="1"/>-</ipestyle>-<ipestyle name="frank">-<arrowsize name="normal" value="5"/>-<arrowsize name="large" value="8"/>-<arrowsize name="huge" value="10"/>-<arrowsize name="small" value="3"/>-<arrowsize name="tiny" value="1"/>-<dashstyle name="dashed" value="[2 2] 0"/>-<dashstyle name="dotted" value="[0.5 1] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<gridsize name="1 pts" value="1"/>-<gridsize name="2 pts" value="2"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="20%" value="0.2"/>-<opacity name="40%" value="0.4"/>-<opacity name="60%" value="0.6"/>-<opacity name="70%" value="0.7"/>-<opacity name="80%" value="0.8"/>-<opacity name="90%" value="0.9"/>-</ipestyle>-<page>-<layer name="alpha"/>-<view layers="alpha" active="alpha"/>-<path layer="alpha" stroke="black">-80 496 m-304 624 l-</path>-<path stroke="black">-320 512 m-176 624 l-</path>-<path stroke="black">-80 560 m-368 560 l-</path>-<path stroke="black">-80 512 m-320 608 l-</path>-<use name="mark/disk(sx)" pos="173.333 549.333" size="normal" stroke="black"/>-<use name="mark/disk(sx)" pos="200 560" size="normal" stroke="black"/>-<use name="mark/disk(sx)" pos="258.286 560" size="normal" stroke="black"/>-</page>-</ipe>
− test/Algorithms/Geometry/PolygonTriangulation/monotone.ipe 
@@ -1,364 +0,0 @@-<?xml version="1.0"?>-<!DOCTYPE ipe SYSTEM "ipe.dtd">-<ipe version="70107" creator="Ipe 7.2.2">-<info created="D:20170207224641" modified="D:20180526104709"/>-<ipestyle name="basic">-<symbol name="arrow/arc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/farc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/ptarc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fptarc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="mark/circle(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</symbol>-<symbol name="mark/disk(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-</path>-</symbol>-<symbol name="mark/fdisk(sfx)" transformations="translations">-<group>-<path fill="sym-fill">-0.5 0 0 0.5 0 0 e-</path>-<path fill="sym-stroke" fillrule="eofill">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</group>-</symbol>-<symbol name="mark/box(sx)" transformations="translations">-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</symbol>-<symbol name="mark/square(sx)" transformations="translations">-<path fill="sym-stroke">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h-</path>-</symbol>-<symbol name="mark/fsquare(sfx)" transformations="translations">-<group>-<path fill="sym-fill">--0.5 -0.5 m-0.5 -0.5 l-0.5 0.5 l--0.5 0.5 l-h-</path>-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</group>-</symbol>-<symbol name="mark/cross(sx)" transformations="translations">-<group>-<path fill="sym-stroke">--0.43 -0.57 m-0.57 0.43 l-0.43 0.57 l--0.57 -0.43 l-h-</path>-<path fill="sym-stroke">--0.43 0.57 m-0.57 -0.43 l-0.43 -0.57 l--0.57 0.43 l-h-</path>-</group>-</symbol>-<symbol name="arrow/fnormal(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/pointed(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fpointed(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/linear(spx)">-<path stroke="sym-stroke" pen="sym-pen">--1 0.333 m-0 0 l--1 -0.333 l-</path>-</symbol>-<symbol name="arrow/fdouble(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/double(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<pen name="heavier" value="0.8"/>-<pen name="fat" value="1.2"/>-<pen name="ultrafat" value="2"/>-<symbolsize name="large" value="5"/>-<symbolsize name="small" value="2"/>-<symbolsize name="tiny" value="1.1"/>-<arrowsize name="large" value="10"/>-<arrowsize name="small" value="5"/>-<arrowsize name="tiny" value="3"/>-<color name="red" value="1 0 0"/>-<color name="green" value="0 1 0"/>-<color name="blue" value="0 0 1"/>-<color name="yellow" value="1 1 0"/>-<color name="orange" value="1 0.647 0"/>-<color name="gold" value="1 0.843 0"/>-<color name="purple" value="0.627 0.125 0.941"/>-<color name="gray" value="0.745"/>-<color name="brown" value="0.647 0.165 0.165"/>-<color name="navy" value="0 0 0.502"/>-<color name="pink" value="1 0.753 0.796"/>-<color name="seagreen" value="0.18 0.545 0.341"/>-<color name="turquoise" value="0.251 0.878 0.816"/>-<color name="violet" value="0.933 0.51 0.933"/>-<color name="darkblue" value="0 0 0.545"/>-<color name="darkcyan" value="0 0.545 0.545"/>-<color name="darkgray" value="0.663"/>-<color name="darkgreen" value="0 0.392 0"/>-<color name="darkmagenta" value="0.545 0 0.545"/>-<color name="darkorange" value="1 0.549 0"/>-<color name="darkred" value="0.545 0 0"/>-<color name="lightblue" value="0.678 0.847 0.902"/>-<color name="lightcyan" value="0.878 1 1"/>-<color name="lightgray" value="0.827"/>-<color name="lightgreen" value="0.565 0.933 0.565"/>-<color name="lightyellow" value="1 1 0.878"/>-<dashstyle name="dashed" value="[4] 0"/>-<dashstyle name="dotted" value="[1 3] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<textsize name="large" value="\large"/>-<textsize name="Large" value="\Large"/>-<textsize name="LARGE" value="\LARGE"/>-<textsize name="huge" value="\huge"/>-<textsize name="Huge" value="\Huge"/>-<textsize name="small" value="\small"/>-<textsize name="footnote" value="\footnotesize"/>-<textsize name="tiny" value="\tiny"/>-<textstyle name="center" begin="\begin{center}" end="\end{center}"/>-<textstyle name="itemize" begin="\begin{itemize}" end="\end{itemize}"/>-<textstyle name="item" begin="\begin{itemize}\item{}" end="\end{itemize}"/>-<gridsize name="4 pts" value="4"/>-<gridsize name="8 pts (~3 mm)" value="8"/>-<gridsize name="16 pts (~6 mm)" value="16"/>-<gridsize name="32 pts (~12 mm)" value="32"/>-<gridsize name="10 pts (~3.5 mm)" value="10"/>-<gridsize name="20 pts (~7 mm)" value="20"/>-<gridsize name="14 pts (~5 mm)" value="14"/>-<gridsize name="28 pts (~10 mm)" value="28"/>-<gridsize name="56 pts (~20 mm)" value="56"/>-<anglesize name="90 deg" value="90"/>-<anglesize name="60 deg" value="60"/>-<anglesize name="45 deg" value="45"/>-<anglesize name="30 deg" value="30"/>-<anglesize name="22.5 deg" value="22.5"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="75%" value="0.75"/>-<tiling name="falling" angle="-60" step="4" width="1"/>-<tiling name="rising" angle="30" step="4" width="1"/>-</ipestyle>-<ipestyle name="frank">-<arrowsize name="normal" value="5"/>-<arrowsize name="large" value="8"/>-<arrowsize name="huge" value="10"/>-<arrowsize name="small" value="3"/>-<arrowsize name="tiny" value="1"/>-<dashstyle name="dashed" value="[2 2] 0"/>-<dashstyle name="dotted" value="[0.5 1] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<gridsize name="1 pts" value="1"/>-<gridsize name="2 pts" value="2"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="20%" value="0.2"/>-<opacity name="40%" value="0.4"/>-<opacity name="60%" value="0.6"/>-<opacity name="70%" value="0.7"/>-<opacity name="80%" value="0.8"/>-<opacity name="90%" value="0.9"/>-</ipestyle>-<page>-<layer name="alpha"/>-<view layers="alpha" active="alpha"/>-<path layer="alpha" stroke="black">-176 736 m-240 688 l-240 608 l-128 576 l-64 640 l-80 720 l-128 752 l-h-</path>-<path stroke="black">-240 608 m-64 640 l-</path>-<path stroke="black">-64 640 m-240 688 l-</path>-<path stroke="black">-240 688 m-80 720 l-</path>-<path stroke="black">-80 720 m-176 736 l-</path>-<path matrix="1 0 0 1 32 96" stroke="red">-160 384 m-352 384 l-128 176 l-224 320 l-48 400 l-h-</path>-<path stroke="red">-384 480 m-256 416 l-</path>-<path stroke="red">-256 416 m-192 480 l-</path>-<path matrix="1 0 0 1 208 320" stroke="green">-320 320 m-256 320 l-224 320 l-128 240 l-64 224 l-256 192 l-h-</path>-<path matrix="1 0 0 1 208 320" stroke="green">-256 320 m-128 240 l-</path>-<path matrix="1 0 0 1 208 320" stroke="green">-128 240 m-320 320 l-</path>-<path matrix="1 0 0 1 208 320" stroke="green">-256 192 m-128 240 l-</path>-<path matrix="-1 0 -0 -1 592 400" stroke="violet">-320 320 m-256 320 l-224 320 l-128 240 l-64 224 l-256 192 l-h-</path>-<path stroke="violet">-464 160 m-336 208 l-</path>-<path stroke="violet">-336 80 m-336 208 l-</path>-<path stroke="violet">-368 80 m-336 208 l-</path>-</page>-</ipe>
− test/Algorithms/Geometry/PolygonTriangulation/simplepolygon6.ipe 
@@ -1,297 +0,0 @@-<?xml version="1.0"?>-<!DOCTYPE ipe SYSTEM "ipe.dtd">-<ipe version="70107" creator="Ipe 7.2.2">-<info created="D:20180524200410" modified="D:20180524221410"/>-<ipestyle name="basic">-<symbol name="arrow/arc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/farc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/ptarc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fptarc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="mark/circle(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</symbol>-<symbol name="mark/disk(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-</path>-</symbol>-<symbol name="mark/fdisk(sfx)" transformations="translations">-<group>-<path fill="sym-fill">-0.5 0 0 0.5 0 0 e-</path>-<path fill="sym-stroke" fillrule="eofill">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</group>-</symbol>-<symbol name="mark/box(sx)" transformations="translations">-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</symbol>-<symbol name="mark/square(sx)" transformations="translations">-<path fill="sym-stroke">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h-</path>-</symbol>-<symbol name="mark/fsquare(sfx)" transformations="translations">-<group>-<path fill="sym-fill">--0.5 -0.5 m-0.5 -0.5 l-0.5 0.5 l--0.5 0.5 l-h-</path>-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</group>-</symbol>-<symbol name="mark/cross(sx)" transformations="translations">-<group>-<path fill="sym-stroke">--0.43 -0.57 m-0.57 0.43 l-0.43 0.57 l--0.57 -0.43 l-h-</path>-<path fill="sym-stroke">--0.43 0.57 m-0.57 -0.43 l-0.43 -0.57 l--0.57 0.43 l-h-</path>-</group>-</symbol>-<symbol name="arrow/fnormal(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/pointed(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fpointed(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/linear(spx)">-<path stroke="sym-stroke" pen="sym-pen">--1 0.333 m-0 0 l--1 -0.333 l-</path>-</symbol>-<symbol name="arrow/fdouble(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/double(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<pen name="heavier" value="0.8"/>-<pen name="fat" value="1.2"/>-<pen name="ultrafat" value="2"/>-<symbolsize name="large" value="5"/>-<symbolsize name="small" value="2"/>-<symbolsize name="tiny" value="1.1"/>-<arrowsize name="large" value="10"/>-<arrowsize name="small" value="5"/>-<arrowsize name="tiny" value="3"/>-<color name="red" value="1 0 0"/>-<color name="green" value="0 1 0"/>-<color name="blue" value="0 0 1"/>-<color name="yellow" value="1 1 0"/>-<color name="orange" value="1 0.647 0"/>-<color name="gold" value="1 0.843 0"/>-<color name="purple" value="0.627 0.125 0.941"/>-<color name="gray" value="0.745"/>-<color name="brown" value="0.647 0.165 0.165"/>-<color name="navy" value="0 0 0.502"/>-<color name="pink" value="1 0.753 0.796"/>-<color name="seagreen" value="0.18 0.545 0.341"/>-<color name="turquoise" value="0.251 0.878 0.816"/>-<color name="violet" value="0.933 0.51 0.933"/>-<color name="darkblue" value="0 0 0.545"/>-<color name="darkcyan" value="0 0.545 0.545"/>-<color name="darkgray" value="0.663"/>-<color name="darkgreen" value="0 0.392 0"/>-<color name="darkmagenta" value="0.545 0 0.545"/>-<color name="darkorange" value="1 0.549 0"/>-<color name="darkred" value="0.545 0 0"/>-<color name="lightblue" value="0.678 0.847 0.902"/>-<color name="lightcyan" value="0.878 1 1"/>-<color name="lightgray" value="0.827"/>-<color name="lightgreen" value="0.565 0.933 0.565"/>-<color name="lightyellow" value="1 1 0.878"/>-<dashstyle name="dashed" value="[4] 0"/>-<dashstyle name="dotted" value="[1 3] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<textsize name="large" value="\large"/>-<textsize name="Large" value="\Large"/>-<textsize name="LARGE" value="\LARGE"/>-<textsize name="huge" value="\huge"/>-<textsize name="Huge" value="\Huge"/>-<textsize name="small" value="\small"/>-<textsize name="footnote" value="\footnotesize"/>-<textsize name="tiny" value="\tiny"/>-<textstyle name="center" begin="\begin{center}" end="\end{center}"/>-<textstyle name="itemize" begin="\begin{itemize}" end="\end{itemize}"/>-<textstyle name="item" begin="\begin{itemize}\item{}" end="\end{itemize}"/>-<gridsize name="4 pts" value="4"/>-<gridsize name="8 pts (~3 mm)" value="8"/>-<gridsize name="16 pts (~6 mm)" value="16"/>-<gridsize name="32 pts (~12 mm)" value="32"/>-<gridsize name="10 pts (~3.5 mm)" value="10"/>-<gridsize name="20 pts (~7 mm)" value="20"/>-<gridsize name="14 pts (~5 mm)" value="14"/>-<gridsize name="28 pts (~10 mm)" value="28"/>-<gridsize name="56 pts (~20 mm)" value="56"/>-<anglesize name="90 deg" value="90"/>-<anglesize name="60 deg" value="60"/>-<anglesize name="45 deg" value="45"/>-<anglesize name="30 deg" value="30"/>-<anglesize name="22.5 deg" value="22.5"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="75%" value="0.75"/>-<tiling name="falling" angle="-60" step="4" width="1"/>-<tiling name="rising" angle="30" step="4" width="1"/>-</ipestyle>-<ipestyle name="frank">-<arrowsize name="normal" value="5"/>-<arrowsize name="large" value="8"/>-<arrowsize name="huge" value="10"/>-<arrowsize name="small" value="3"/>-<arrowsize name="tiny" value="1"/>-<dashstyle name="dashed" value="[2 2] 0"/>-<dashstyle name="dotted" value="[0.5 1] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<gridsize name="1 pts" value="1"/>-<gridsize name="2 pts" value="2"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="20%" value="0.2"/>-<opacity name="40%" value="0.4"/>-<opacity name="60%" value="0.6"/>-<opacity name="70%" value="0.7"/>-<opacity name="80%" value="0.8"/>-<opacity name="90%" value="0.9"/>-</ipestyle>-<page>-<layer name="alpha"/>-<layer name="beta"/>-<view layers="alpha beta" active="beta"/>-<path layer="alpha" stroke="black">-80 544 m-320 527 l-208 496 l-48 432 l-16 560 l-h-</path>-<path stroke="black">-80 544 m-208 496 l-</path>-<path layer="beta" stroke="black">-208 496 m-16 560 l-</path>-</page>-</ipe>
− test/Algorithms/Geometry/RedBlueSeparator/manual.ipe 
@@ -1,355 +0,0 @@-<?xml version="1.0"?>-<!DOCTYPE ipe SYSTEM "ipe.dtd">-<ipe version="70206" creator="Ipe 7.2.7">-<info created="D:20190316210045" modified="D:20190316234250"/>-<ipestyle name="basic">-<symbol name="arrow/arc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/farc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/ptarc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fptarc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="mark/circle(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</symbol>-<symbol name="mark/disk(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-</path>-</symbol>-<symbol name="mark/fdisk(sfx)" transformations="translations">-<group>-<path fill="sym-fill">-0.5 0 0 0.5 0 0 e-</path>-<path fill="sym-stroke" fillrule="eofill">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</group>-</symbol>-<symbol name="mark/box(sx)" transformations="translations">-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</symbol>-<symbol name="mark/square(sx)" transformations="translations">-<path fill="sym-stroke">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h-</path>-</symbol>-<symbol name="mark/fsquare(sfx)" transformations="translations">-<group>-<path fill="sym-fill">--0.5 -0.5 m-0.5 -0.5 l-0.5 0.5 l--0.5 0.5 l-h-</path>-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</group>-</symbol>-<symbol name="mark/cross(sx)" transformations="translations">-<group>-<path fill="sym-stroke">--0.43 -0.57 m-0.57 0.43 l-0.43 0.57 l--0.57 -0.43 l-h-</path>-<path fill="sym-stroke">--0.43 0.57 m-0.57 -0.43 l-0.43 -0.57 l--0.57 0.43 l-h-</path>-</group>-</symbol>-<symbol name="arrow/fnormal(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/pointed(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fpointed(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/linear(spx)">-<path stroke="sym-stroke" pen="sym-pen">--1 0.333 m-0 0 l--1 -0.333 l-</path>-</symbol>-<symbol name="arrow/fdouble(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/double(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<pen name="heavier" value="0.8"/>-<pen name="fat" value="1.2"/>-<pen name="ultrafat" value="2"/>-<symbolsize name="large" value="5"/>-<symbolsize name="small" value="2"/>-<symbolsize name="tiny" value="1.1"/>-<arrowsize name="large" value="10"/>-<arrowsize name="small" value="5"/>-<arrowsize name="tiny" value="3"/>-<color name="red" value="1 0 0"/>-<color name="green" value="0 1 0"/>-<color name="blue" value="0 0 1"/>-<color name="yellow" value="1 1 0"/>-<color name="orange" value="1 0.647 0"/>-<color name="gold" value="1 0.843 0"/>-<color name="purple" value="0.627 0.125 0.941"/>-<color name="gray" value="0.745"/>-<color name="brown" value="0.647 0.165 0.165"/>-<color name="navy" value="0 0 0.502"/>-<color name="pink" value="1 0.753 0.796"/>-<color name="seagreen" value="0.18 0.545 0.341"/>-<color name="turquoise" value="0.251 0.878 0.816"/>-<color name="violet" value="0.933 0.51 0.933"/>-<color name="darkblue" value="0 0 0.545"/>-<color name="darkcyan" value="0 0.545 0.545"/>-<color name="darkgray" value="0.663"/>-<color name="darkgreen" value="0 0.392 0"/>-<color name="darkmagenta" value="0.545 0 0.545"/>-<color name="darkorange" value="1 0.549 0"/>-<color name="darkred" value="0.545 0 0"/>-<color name="lightblue" value="0.678 0.847 0.902"/>-<color name="lightcyan" value="0.878 1 1"/>-<color name="lightgray" value="0.827"/>-<color name="lightgreen" value="0.565 0.933 0.565"/>-<color name="lightyellow" value="1 1 0.878"/>-<dashstyle name="dashed" value="[4] 0"/>-<dashstyle name="dotted" value="[1 3] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<textsize name="large" value="\large"/>-<textsize name="Large" value="\Large"/>-<textsize name="LARGE" value="\LARGE"/>-<textsize name="huge" value="\huge"/>-<textsize name="Huge" value="\Huge"/>-<textsize name="small" value="\small"/>-<textsize name="footnote" value="\footnotesize"/>-<textsize name="tiny" value="\tiny"/>-<textstyle name="center" begin="\begin{center}" end="\end{center}"/>-<textstyle name="itemize" begin="\begin{itemize}" end="\end{itemize}"/>-<textstyle name="item" begin="\begin{itemize}\item{}" end="\end{itemize}"/>-<gridsize name="4 pts" value="4"/>-<gridsize name="8 pts (~3 mm)" value="8"/>-<gridsize name="16 pts (~6 mm)" value="16"/>-<gridsize name="32 pts (~12 mm)" value="32"/>-<gridsize name="10 pts (~3.5 mm)" value="10"/>-<gridsize name="20 pts (~7 mm)" value="20"/>-<gridsize name="14 pts (~5 mm)" value="14"/>-<gridsize name="28 pts (~10 mm)" value="28"/>-<gridsize name="56 pts (~20 mm)" value="56"/>-<anglesize name="90 deg" value="90"/>-<anglesize name="60 deg" value="60"/>-<anglesize name="45 deg" value="45"/>-<anglesize name="30 deg" value="30"/>-<anglesize name="22.5 deg" value="22.5"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="75%" value="0.75"/>-<tiling name="falling" angle="-60" step="4" width="1"/>-<tiling name="rising" angle="30" step="4" width="1"/>-</ipestyle>-<ipestyle name="frank">-<arrowsize name="normal" value="5"/>-<arrowsize name="large" value="8"/>-<arrowsize name="huge" value="10"/>-<arrowsize name="small" value="3"/>-<arrowsize name="tiny" value="1"/>-<dashstyle name="dashed" value="[2 2] 0"/>-<dashstyle name="dotted" value="[0.5 1] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<gridsize name="1 pts" value="1"/>-<gridsize name="2 pts" value="2"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="20%" value="0.2"/>-<opacity name="40%" value="0.4"/>-<opacity name="60%" value="0.6"/>-<opacity name="70%" value="0.7"/>-<opacity name="80%" value="0.8"/>-<opacity name="90%" value="0.9"/>-</ipestyle>-<page>-<layer name="alpha"/>-<view layers="alpha" active="alpha"/>-<use layer="alpha" name="mark/disk(sx)" pos="176 688" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="224 672" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="160 656" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="208 624" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="400 688" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="448 640" size="normal" stroke="red"/>-<use matrix="1 0 0 1 -43.6079 16.3284" name="mark/disk(sx)" pos="400 640" size="normal" stroke="red"/>-</page>-<page>-<layer name="alpha"/>-<view layers="alpha" active="alpha"/>-<use layer="alpha" name="mark/disk(sx)" pos="208 608" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="224 640" size="normal" stroke="red"/>-<use matrix="1 0 0 1 0 1.54293" name="mark/disk(sx)" pos="288 608" size="normal" stroke="red"/>-<use matrix="1 0 0 1 21.7014 -12.8726" name="mark/disk(sx)" pos="224 608" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="336 640" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="320 688" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="64 704" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="160 656" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="160 752" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="112 672" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="112 592" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="288 736" size="normal" stroke="blue"/>-</page>-<page>-<layer name="alpha"/>-<view layers="alpha" active="alpha"/>-<use layer="alpha" name="mark/cross(sx)" pos="137.831 733.813" size="normal" stroke="blue"/>-<use name="mark/cross(sx)" pos="230.904 721.563" size="normal" stroke="blue"/>-<use name="mark/cross(sx)" pos="150.255 624.633" size="normal" stroke="blue"/>-<use name="mark/cross(sx)" pos="85.1135 709.576" size="normal" stroke="blue"/>-<use name="mark/cross(sx)" pos="160.209 702.601" size="normal" stroke="blue"/>-<use name="mark/cross(sx)" pos="160.209 702.601" size="normal" stroke="blue"/>-<use name="mark/cross(sx)" pos="170.678 688.287" size="normal" stroke="blue"/>-<use name="mark/cross(sx)" pos="251.915 645.615" size="normal" stroke="blue"/>-<use name="mark/cross(sx)" pos="55.337 684.816" size="normal" stroke="blue"/>-<use name="mark/cross(sx)" pos="129.955 678.571" size="normal" stroke="blue"/>-<use name="mark/cross(sx)" pos="130.15 631.793" size="normal" stroke="blue"/>-<use name="mark/cross(sx)" pos="249.435 558.192" size="normal" stroke="blue"/>-<use name="mark/cross(sx)" pos="324.114 668.358" size="normal" stroke="blue"/>-<use name="mark/cross(sx)" pos="324.114 668.358" size="normal" stroke="blue"/>-<use name="mark/cross(sx)" pos="361.354 661.106" size="normal" stroke="blue"/>-<use name="mark/cross(sx)" pos="189.131 599.845" size="normal" stroke="blue"/>-<use name="mark/cross(sx)" pos="143.375 537.289" size="normal" stroke="blue"/>-<use name="mark/cross(sx)" pos="359.679 584.286" size="normal" stroke="red"/>-<use name="mark/cross(sx)" pos="396.828 627.4" size="normal" stroke="red"/>-<use name="mark/cross(sx)" pos="417.481 668.711" size="normal" stroke="red"/>-<use name="mark/cross(sx)" pos="467.45 598.096" size="normal" stroke="red"/>-<use matrix="1 0 0 1 -93.524 0.18083" name="mark/cross(sx)" pos="326.916 608.601" size="normal" stroke="red"/>-<use name="mark/cross(sx)" pos="338.842 545.777" size="normal" stroke="red"/>-<use name="mark/cross(sx)" pos="432.668 573.584" size="normal" stroke="red"/>-<use name="mark/cross(sx)" pos="357.521 629.624" size="normal" stroke="red"/>-<use name="mark/cross(sx)" pos="309.927 526.735" size="normal" stroke="red"/>-<use name="mark/cross(sx)" pos="417.855 527.98" size="normal" stroke="red"/>-<use name="mark/cross(sx)" pos="425.293 604.935" size="normal" stroke="red"/>-<use name="mark/cross(sx)" pos="482.54 641.657" size="normal" stroke="red"/>-</page>-<page>-<layer name="alpha"/>-<view layers="alpha" active="alpha"/>-<use layer="alpha" name="mark/disk(sx)" pos="71.295 646.994" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="124.003 669.524" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="158.117 593.965" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="106.985 602.699" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="130.801 646.957" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="183.976 638.614" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="268.842 528.238" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="303.35 581.718" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="353.58 636.762" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="288.989 633.613" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="325.76 613.53" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="337.81 597.8" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="245.135 580.319" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="168.779 515.317" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="116.706 526.039" size="normal" stroke="blue"/>-</page>-</ipe>
− test/Algorithms/Geometry/SmallestEnclosingDisk/manual.ipe 
@@ -1,369 +0,0 @@-<?xml version="1.0"?>-<!DOCTYPE ipe SYSTEM "ipe.dtd">-<ipe version="70107" creator="Ipe 7.1.7">-<info created="D:20151023214323" modified="D:20160123195914"/>-<ipestyle name="basic">-<symbol name="arrow/arc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/farc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/ptarc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fptarc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="mark/circle(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</symbol>-<symbol name="mark/disk(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-</path>-</symbol>-<symbol name="mark/fdisk(sfx)" transformations="translations">-<group>-<path fill="sym-fill">-0.5 0 0 0.5 0 0 e-</path>-<path fill="sym-stroke" fillrule="eofill">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</group>-</symbol>-<symbol name="mark/box(sx)" transformations="translations">-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</symbol>-<symbol name="mark/square(sx)" transformations="translations">-<path fill="sym-stroke">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h-</path>-</symbol>-<symbol name="mark/fsquare(sfx)" transformations="translations">-<group>-<path fill="sym-fill">--0.5 -0.5 m-0.5 -0.5 l-0.5 0.5 l--0.5 0.5 l-h-</path>-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</group>-</symbol>-<symbol name="mark/cross(sx)" transformations="translations">-<group>-<path fill="sym-stroke">--0.43 -0.57 m-0.57 0.43 l-0.43 0.57 l--0.57 -0.43 l-h-</path>-<path fill="sym-stroke">--0.43 0.57 m-0.57 -0.43 l-0.43 -0.57 l--0.57 0.43 l-h-</path>-</group>-</symbol>-<symbol name="arrow/fnormal(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/pointed(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fpointed(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/linear(spx)">-<path stroke="sym-stroke" pen="sym-pen">--1 0.333 m-0 0 l--1 -0.333 l-</path>-</symbol>-<symbol name="arrow/fdouble(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/double(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<pen name="heavier" value="0.8"/>-<pen name="fat" value="1.2"/>-<pen name="ultrafat" value="2"/>-<symbolsize name="large" value="5"/>-<symbolsize name="small" value="2"/>-<symbolsize name="tiny" value="1.1"/>-<arrowsize name="large" value="10"/>-<arrowsize name="small" value="5"/>-<arrowsize name="tiny" value="3"/>-<color name="red" value="1 0 0"/>-<color name="green" value="0 1 0"/>-<color name="blue" value="0 0 1"/>-<color name="yellow" value="1 1 0"/>-<color name="orange" value="1 0.647 0"/>-<color name="gold" value="1 0.843 0"/>-<color name="purple" value="0.627 0.125 0.941"/>-<color name="gray" value="0.745"/>-<color name="brown" value="0.647 0.165 0.165"/>-<color name="navy" value="0 0 0.502"/>-<color name="pink" value="1 0.753 0.796"/>-<color name="seagreen" value="0.18 0.545 0.341"/>-<color name="turquoise" value="0.251 0.878 0.816"/>-<color name="violet" value="0.933 0.51 0.933"/>-<color name="darkblue" value="0 0 0.545"/>-<color name="darkcyan" value="0 0.545 0.545"/>-<color name="darkgray" value="0.663"/>-<color name="darkgreen" value="0 0.392 0"/>-<color name="darkmagenta" value="0.545 0 0.545"/>-<color name="darkorange" value="1 0.549 0"/>-<color name="darkred" value="0.545 0 0"/>-<color name="lightblue" value="0.678 0.847 0.902"/>-<color name="lightcyan" value="0.878 1 1"/>-<color name="lightgray" value="0.827"/>-<color name="lightgreen" value="0.565 0.933 0.565"/>-<color name="lightyellow" value="1 1 0.878"/>-<dashstyle name="dashed" value="[4] 0"/>-<dashstyle name="dotted" value="[1 3] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<textsize name="large" value="\large"/>-<textsize name="small" value="\small"/>-<textsize name="tiny" value="\tiny"/>-<textsize name="Large" value="\Large"/>-<textsize name="LARGE" value="\LARGE"/>-<textsize name="huge" value="\huge"/>-<textsize name="Huge" value="\Huge"/>-<textsize name="footnote" value="\footnotesize"/>-<textstyle name="center" begin="\begin{center}" end="\end{center}"/>-<textstyle name="itemize" begin="\begin{itemize}" end="\end{itemize}"/>-<textstyle name="item" begin="\begin{itemize}\item{}" end="\end{itemize}"/>-<gridsize name="4 pts" value="4"/>-<gridsize name="8 pts (~3 mm)" value="8"/>-<gridsize name="16 pts (~6 mm)" value="16"/>-<gridsize name="32 pts (~12 mm)" value="32"/>-<gridsize name="10 pts (~3.5 mm)" value="10"/>-<gridsize name="20 pts (~7 mm)" value="20"/>-<gridsize name="14 pts (~5 mm)" value="14"/>-<gridsize name="28 pts (~10 mm)" value="28"/>-<gridsize name="56 pts (~20 mm)" value="56"/>-<anglesize name="90 deg" value="90"/>-<anglesize name="60 deg" value="60"/>-<anglesize name="45 deg" value="45"/>-<anglesize name="30 deg" value="30"/>-<anglesize name="22.5 deg" value="22.5"/>-<tiling name="falling" angle="-60" step="4" width="1"/>-<tiling name="rising" angle="30" step="4" width="1"/>-</ipestyle>-<ipestyle name="frank">-<arrowsize name="normal" value="5"/>-<arrowsize name="large" value="8"/>-<arrowsize name="small" value="3"/>-<arrowsize name="tiny" value="1"/>-<arrowsize name="huge" value="10"/>-<dashstyle name="dashed" value="[2 2] 0"/>-<dashstyle name="dotted" value="[0.5 1] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<gridsize name="1 pts" value="1"/>-<gridsize name="2 pts" value="2"/>-<opacity name="10%" value="0.1"/>-<opacity name="20%" value="0.2"/>-<opacity name="30%" value="0.3"/>-<opacity name="40%" value="0.4"/>-<opacity name="50%" value="0.5"/>-<opacity name="60%" value="0.6"/>-<opacity name="70%" value="0.7"/>-<opacity name="80%" value="0.8"/>-<opacity name="90%" value="0.9"/>-</ipestyle>-<page>-<layer name="alpha"/>-<layer name="beta"/>-<layer name="gamma"/>-<layer name="delta"/>-<view layers="alpha beta gamma delta" active="delta"/>-<use layer="alpha" name="mark/cross(sx)" pos="112 736" size="normal" stroke="black"/>-<use name="mark/cross(sx)" pos="336 640" size="normal" stroke="black"/>-<use name="mark/cross(sx)" pos="336 816" size="normal" stroke="black"/>-<use matrix="1 0 0 1 6.13784 -3.9059" name="mark/disk(sx)" pos="304 784" size="normal" stroke="black"/>-<use matrix="1 0 0 1 4.44908 -4.21815" name="mark/disk(sx)" pos="320 736" size="normal" stroke="black"/>-<use matrix="1 0 0 1 0.586099 6.64103" name="mark/disk(sx)" pos="352 736" size="normal" stroke="black"/>-<path stroke="black">-129.39 0 0 129.39 241.143 728 e-</path>-<use name="mark/disk(sx)" pos="264.671 689.288" size="normal" stroke="black"/>-<use name="mark/disk(sx)" pos="222.264 731.137" size="normal" stroke="black"/>-<use name="mark/disk(sx)" pos="289.78 722.767" size="normal" stroke="black"/>-<use name="mark/disk(sx)" pos="215.01 683.15" size="normal" stroke="black"/>-<use name="mark/disk(sx)" pos="197.154 741.181" size="normal" stroke="black"/>-<use name="mark/disk(sx)" pos="194.365 766.848" size="normal" stroke="black"/>-<use name="mark/disk(sx)" pos="230.076 767.406" size="normal" stroke="black"/>-<use name="mark/disk(sx)" pos="155.864 708.26" size="normal" stroke="black"/>-<use name="mark/disk(sx)" pos="238.445 743.413" size="normal" stroke="black"/>-<use name="mark/disk(sx)" pos="280.294 767.964" size="normal" stroke="black"/>-<use name="mark/disk(sx)" pos="274.715 659.157" size="normal" stroke="black"/>-<use name="mark/disk(sx)" pos="221.148 609.496" size="normal" stroke="black"/>-<use name="mark/disk(sx)" pos="310.984 638.512" size="normal" stroke="black"/>-<use name="mark/disk(sx)" pos="223.38 649.671" size="normal" stroke="black"/>-<use name="mark/disk(sx)" pos="169.813 689.846" size="normal" stroke="black"/>-<use name="mark/disk(sx)" pos="201.618 709.934" size="normal" stroke="black"/>-<use layer="beta" name="mark/disk(sx)" pos="368 608" size="normal" stroke="red"/>-<use matrix="1 0 0 1 2.78993 -9.48576" name="mark/disk(sx)" pos="336 608" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="352 592" size="normal" stroke="red"/>-<use matrix="1 0 0 1 10.0437 -7.8118" name="mark/disk(sx)" pos="368 576" size="normal" stroke="red"/>-<use matrix="1 0 0 1 2.78993 1.11597" name="mark/disk(sx)" pos="320 576" size="normal" stroke="red"/>-<use matrix="1 0 0 1 -8.36979 -11.1597" name="mark/disk(sx)" pos="352 576" size="normal" stroke="red"/>-<use matrix="1 0 0 1 30.6892 -15.0656" name="mark/disk(sx)" pos="400 608" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="400 576" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="304 560" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="368 544" size="normal" stroke="red"/>-<use name="mark/cross(sx)" pos="288.737 510.098" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="379.689 503.96" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="409.82 541.903" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="363.507 541.345" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="437.719 527.954" size="normal" stroke="red"/>-<use name="mark/cross(sx)" pos="476.778 591.564" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="403.682 564.223" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="409.82 562.549" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="414.284 563.107" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="462.271 545.809" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="450.553 567.013" size="normal" stroke="red"/>-<use name="mark/disk(sx)" pos="343.978 524.606" size="normal" stroke="red"/>-<path stroke="red">-102.465 0 0 102.465 382.758 550.831 e-</path>-<use layer="gamma" matrix="1 0 0 1 6.60054 4.12708" name="mark/disk(sx)" pos="368 608" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 9.39047 -5.35868" name="mark/disk(sx)" pos="336 608" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 6.60054 4.12708" name="mark/disk(sx)" pos="352 592" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 16.6443 -3.68472" name="mark/disk(sx)" pos="368 576" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 9.39047 5.24305" name="mark/disk(sx)" pos="320 576" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 -1.76925 -7.03264" name="mark/disk(sx)" pos="352 576" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 37.2898 -10.9385" name="mark/disk(sx)" pos="400 608" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 6.60054 4.12708" name="mark/disk(sx)" pos="400 576" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 6.60054 4.12708" name="mark/disk(sx)" pos="304 560" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 6.60054 4.12708" name="mark/disk(sx)" pos="368 544" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 6.60054 4.12708" name="mark/disk(sx)" pos="379.689 503.96" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 6.60054 4.12708" name="mark/disk(sx)" pos="409.82 541.903" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 6.60054 4.12708" name="mark/disk(sx)" pos="363.507 541.345" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 6.60054 4.12708" name="mark/disk(sx)" pos="437.719 527.954" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 6.60054 4.12708" name="mark/disk(sx)" pos="403.682 564.223" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 6.60054 4.12708" name="mark/disk(sx)" pos="409.82 562.549" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 6.60054 4.12708" name="mark/disk(sx)" pos="414.284 563.107" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 6.60054 4.12708" name="mark/disk(sx)" pos="462.271 545.809" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 6.60054 4.12708" name="mark/disk(sx)" pos="450.553 567.013" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 6.60054 4.12708" name="mark/disk(sx)" pos="343.978 524.606" size="normal" stroke="blue"/>-<use layer="delta" name="mark/disk(sx)" pos="71.4684 472.509" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="90.3283 458.001" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="75.0953 453.649" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="101.209 426.084" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="45.3547 421.732" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="76.5461 421.007" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="56.9608 430.437" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="85.2506 433.338" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="113.541 435.514" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="75.0953 453.649" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="46.8054 454.374" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 39.896 -3.62691" name="mark/disk(sx)" pos="75.0953 453.649" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="105.561 473.96" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="107.012 458.727" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="135.302 418.105" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 4.52803 -3.42357" name="mark/disk(sx)" pos="101.209 426.084" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="90.2821 422.711" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="118.434 461.101" size="normal" stroke="blue"/>-<use matrix="1 0 0 1 5.59154 0.698943" name="mark/disk(sx)" pos="57.5231 446.257" size="normal" stroke="blue"/>-<use name="mark/disk(sx)" pos="68.9116 432.574" size="normal" stroke="blue"/>-</page>-</ipe>
− test/Data/Geometry/Polygon/Convex/convexTests.ipe 
@@ -1,308 +0,0 @@-<?xml version="1.0"?>-<!DOCTYPE ipe SYSTEM "ipe.dtd">-<ipe version="70107" creator="Ipe 7.2.2">-<info created="D:20160608222645" modified="D:20160611094216"/>-<ipestyle name="basic">-<symbol name="arrow/arc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/farc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/ptarc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fptarc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="mark/circle(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</symbol>-<symbol name="mark/disk(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-</path>-</symbol>-<symbol name="mark/fdisk(sfx)" transformations="translations">-<group>-<path fill="sym-fill">-0.5 0 0 0.5 0 0 e-</path>-<path fill="sym-stroke" fillrule="eofill">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</group>-</symbol>-<symbol name="mark/box(sx)" transformations="translations">-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</symbol>-<symbol name="mark/square(sx)" transformations="translations">-<path fill="sym-stroke">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h-</path>-</symbol>-<symbol name="mark/fsquare(sfx)" transformations="translations">-<group>-<path fill="sym-fill">--0.5 -0.5 m-0.5 -0.5 l-0.5 0.5 l--0.5 0.5 l-h-</path>-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</group>-</symbol>-<symbol name="mark/cross(sx)" transformations="translations">-<group>-<path fill="sym-stroke">--0.43 -0.57 m-0.57 0.43 l-0.43 0.57 l--0.57 -0.43 l-h-</path>-<path fill="sym-stroke">--0.43 0.57 m-0.57 -0.43 l-0.43 -0.57 l--0.57 0.43 l-h-</path>-</group>-</symbol>-<symbol name="arrow/fnormal(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/pointed(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fpointed(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/linear(spx)">-<path stroke="sym-stroke" pen="sym-pen">--1 0.333 m-0 0 l--1 -0.333 l-</path>-</symbol>-<symbol name="arrow/fdouble(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/double(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<pen name="heavier" value="0.8"/>-<pen name="fat" value="1.2"/>-<pen name="ultrafat" value="2"/>-<symbolsize name="large" value="5"/>-<symbolsize name="small" value="2"/>-<symbolsize name="tiny" value="1.1"/>-<arrowsize name="large" value="10"/>-<arrowsize name="small" value="5"/>-<arrowsize name="tiny" value="3"/>-<color name="red" value="1 0 0"/>-<color name="green" value="0 1 0"/>-<color name="blue" value="0 0 1"/>-<color name="yellow" value="1 1 0"/>-<color name="orange" value="1 0.647 0"/>-<color name="gold" value="1 0.843 0"/>-<color name="purple" value="0.627 0.125 0.941"/>-<color name="gray" value="0.745"/>-<color name="brown" value="0.647 0.165 0.165"/>-<color name="navy" value="0 0 0.502"/>-<color name="pink" value="1 0.753 0.796"/>-<color name="seagreen" value="0.18 0.545 0.341"/>-<color name="turquoise" value="0.251 0.878 0.816"/>-<color name="violet" value="0.933 0.51 0.933"/>-<color name="darkblue" value="0 0 0.545"/>-<color name="darkcyan" value="0 0.545 0.545"/>-<color name="darkgray" value="0.663"/>-<color name="darkgreen" value="0 0.392 0"/>-<color name="darkmagenta" value="0.545 0 0.545"/>-<color name="darkorange" value="1 0.549 0"/>-<color name="darkred" value="0.545 0 0"/>-<color name="lightblue" value="0.678 0.847 0.902"/>-<color name="lightcyan" value="0.878 1 1"/>-<color name="lightgray" value="0.827"/>-<color name="lightgreen" value="0.565 0.933 0.565"/>-<color name="lightyellow" value="1 1 0.878"/>-<dashstyle name="dashed" value="[4] 0"/>-<dashstyle name="dotted" value="[1 3] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<textsize name="large" value="\large"/>-<textsize name="Large" value="\Large"/>-<textsize name="LARGE" value="\LARGE"/>-<textsize name="huge" value="\huge"/>-<textsize name="Huge" value="\Huge"/>-<textsize name="small" value="\small"/>-<textsize name="footnote" value="\footnotesize"/>-<textsize name="tiny" value="\tiny"/>-<textstyle name="center" begin="\begin{center}" end="\end{center}"/>-<textstyle name="itemize" begin="\begin{itemize}" end="\end{itemize}"/>-<textstyle name="item" begin="\begin{itemize}\item{}" end="\end{itemize}"/>-<gridsize name="4 pts" value="4"/>-<gridsize name="8 pts (~3 mm)" value="8"/>-<gridsize name="16 pts (~6 mm)" value="16"/>-<gridsize name="32 pts (~12 mm)" value="32"/>-<gridsize name="10 pts (~3.5 mm)" value="10"/>-<gridsize name="20 pts (~7 mm)" value="20"/>-<gridsize name="14 pts (~5 mm)" value="14"/>-<gridsize name="28 pts (~10 mm)" value="28"/>-<gridsize name="56 pts (~20 mm)" value="56"/>-<anglesize name="90 deg" value="90"/>-<anglesize name="60 deg" value="60"/>-<anglesize name="45 deg" value="45"/>-<anglesize name="30 deg" value="30"/>-<anglesize name="22.5 deg" value="22.5"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="75%" value="0.75"/>-<tiling name="falling" angle="-60" step="4" width="1"/>-<tiling name="rising" angle="30" step="4" width="1"/>-</ipestyle>-<ipestyle name="frank">-<arrowsize name="normal" value="5"/>-<arrowsize name="large" value="8"/>-<arrowsize name="huge" value="10"/>-<arrowsize name="small" value="3"/>-<arrowsize name="tiny" value="1"/>-<dashstyle name="dashed" value="[2 2] 0"/>-<dashstyle name="dotted" value="[0.5 1] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<gridsize name="1 pts" value="1"/>-<gridsize name="2 pts" value="2"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="20%" value="0.2"/>-<opacity name="40%" value="0.4"/>-<opacity name="60%" value="0.6"/>-<opacity name="70%" value="0.7"/>-<opacity name="80%" value="0.8"/>-<opacity name="90%" value="0.9"/>-</ipestyle>-<page>-<layer name="alpha"/>-<layer name="beta"/>-<view layers="alpha beta" active="beta"/>-<path layer="alpha" stroke="black">-144 720 m-224 768 l-368 672 l-320 592 l-240 544 l-112 528 l-96 640 l-h-</path>-<path stroke="black">-224 656 m-352 784 l-416 816 l-544 800 l-576 752 l-592 720 l-592 672 l-576 640 l-544 608 l-480 560 l-400 544 l-320 544 l-272 560 l-240 608 l-h-</path>-</page>-</ipe>
− test/Data/Geometry/Polygon/star_shaped.ipe 
@@ -1,339 +0,0 @@-<?xml version="1.0"?>-<!DOCTYPE ipe SYSTEM "ipe.dtd">-<ipe version="70206" creator="Ipe 7.2.7">-<info created="D:20190310121058" modified="D:20190310122053"/>-<ipestyle name="basic">-<symbol name="arrow/arc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/farc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/ptarc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fptarc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="mark/circle(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</symbol>-<symbol name="mark/disk(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-</path>-</symbol>-<symbol name="mark/fdisk(sfx)" transformations="translations">-<group>-<path fill="sym-fill">-0.5 0 0 0.5 0 0 e-</path>-<path fill="sym-stroke" fillrule="eofill">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</group>-</symbol>-<symbol name="mark/box(sx)" transformations="translations">-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</symbol>-<symbol name="mark/square(sx)" transformations="translations">-<path fill="sym-stroke">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h-</path>-</symbol>-<symbol name="mark/fsquare(sfx)" transformations="translations">-<group>-<path fill="sym-fill">--0.5 -0.5 m-0.5 -0.5 l-0.5 0.5 l--0.5 0.5 l-h-</path>-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</group>-</symbol>-<symbol name="mark/cross(sx)" transformations="translations">-<group>-<path fill="sym-stroke">--0.43 -0.57 m-0.57 0.43 l-0.43 0.57 l--0.57 -0.43 l-h-</path>-<path fill="sym-stroke">--0.43 0.57 m-0.57 -0.43 l-0.43 -0.57 l--0.57 0.43 l-h-</path>-</group>-</symbol>-<symbol name="arrow/fnormal(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/pointed(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fpointed(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/linear(spx)">-<path stroke="sym-stroke" pen="sym-pen">--1 0.333 m-0 0 l--1 -0.333 l-</path>-</symbol>-<symbol name="arrow/fdouble(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/double(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<pen name="heavier" value="0.8"/>-<pen name="fat" value="1.2"/>-<pen name="ultrafat" value="2"/>-<symbolsize name="large" value="5"/>-<symbolsize name="small" value="2"/>-<symbolsize name="tiny" value="1.1"/>-<arrowsize name="large" value="10"/>-<arrowsize name="small" value="5"/>-<arrowsize name="tiny" value="3"/>-<color name="red" value="1 0 0"/>-<color name="green" value="0 1 0"/>-<color name="blue" value="0 0 1"/>-<color name="yellow" value="1 1 0"/>-<color name="orange" value="1 0.647 0"/>-<color name="gold" value="1 0.843 0"/>-<color name="purple" value="0.627 0.125 0.941"/>-<color name="gray" value="0.745"/>-<color name="brown" value="0.647 0.165 0.165"/>-<color name="navy" value="0 0 0.502"/>-<color name="pink" value="1 0.753 0.796"/>-<color name="seagreen" value="0.18 0.545 0.341"/>-<color name="turquoise" value="0.251 0.878 0.816"/>-<color name="violet" value="0.933 0.51 0.933"/>-<color name="darkblue" value="0 0 0.545"/>-<color name="darkcyan" value="0 0.545 0.545"/>-<color name="darkgray" value="0.663"/>-<color name="darkgreen" value="0 0.392 0"/>-<color name="darkmagenta" value="0.545 0 0.545"/>-<color name="darkorange" value="1 0.549 0"/>-<color name="darkred" value="0.545 0 0"/>-<color name="lightblue" value="0.678 0.847 0.902"/>-<color name="lightcyan" value="0.878 1 1"/>-<color name="lightgray" value="0.827"/>-<color name="lightgreen" value="0.565 0.933 0.565"/>-<color name="lightyellow" value="1 1 0.878"/>-<dashstyle name="dashed" value="[4] 0"/>-<dashstyle name="dotted" value="[1 3] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<textsize name="large" value="\large"/>-<textsize name="Large" value="\Large"/>-<textsize name="LARGE" value="\LARGE"/>-<textsize name="huge" value="\huge"/>-<textsize name="Huge" value="\Huge"/>-<textsize name="small" value="\small"/>-<textsize name="footnote" value="\footnotesize"/>-<textsize name="tiny" value="\tiny"/>-<textstyle name="center" begin="\begin{center}" end="\end{center}"/>-<textstyle name="itemize" begin="\begin{itemize}" end="\end{itemize}"/>-<textstyle name="item" begin="\begin{itemize}\item{}" end="\end{itemize}"/>-<gridsize name="4 pts" value="4"/>-<gridsize name="8 pts (~3 mm)" value="8"/>-<gridsize name="16 pts (~6 mm)" value="16"/>-<gridsize name="32 pts (~12 mm)" value="32"/>-<gridsize name="10 pts (~3.5 mm)" value="10"/>-<gridsize name="20 pts (~7 mm)" value="20"/>-<gridsize name="14 pts (~5 mm)" value="14"/>-<gridsize name="28 pts (~10 mm)" value="28"/>-<gridsize name="56 pts (~20 mm)" value="56"/>-<anglesize name="90 deg" value="90"/>-<anglesize name="60 deg" value="60"/>-<anglesize name="45 deg" value="45"/>-<anglesize name="30 deg" value="30"/>-<anglesize name="22.5 deg" value="22.5"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="75%" value="0.75"/>-<tiling name="falling" angle="-60" step="4" width="1"/>-<tiling name="rising" angle="30" step="4" width="1"/>-</ipestyle>-<ipestyle name="frank">-<arrowsize name="normal" value="5"/>-<arrowsize name="large" value="8"/>-<arrowsize name="huge" value="10"/>-<arrowsize name="small" value="3"/>-<arrowsize name="tiny" value="1"/>-<dashstyle name="dashed" value="[2 2] 0"/>-<dashstyle name="dotted" value="[0.5 1] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<gridsize name="1 pts" value="1"/>-<gridsize name="2 pts" value="2"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="20%" value="0.2"/>-<opacity name="40%" value="0.4"/>-<opacity name="60%" value="0.6"/>-<opacity name="70%" value="0.7"/>-<opacity name="80%" value="0.8"/>-<opacity name="90%" value="0.9"/>-</ipestyle>-<page>-<layer name="alpha"/>-<view layers="alpha" active="alpha"/>-<path layer="alpha" stroke="blue">-176 752 m-208 688 l-160 624 l-288 672 l-304 752 l-256 736 l-h-</path>-<path stroke="red">-384 784 m-448 624 l-368 576 l-512 624 l-448 704 l-560 672 l-528 576 l-592 688 l-h-</path>-<path stroke="red">-240 544 m-80 416 l-224 336 l-320 336 l-208 416 l-352 416 l-320 320 l-480 400 l-448 496 l-320 496 l-256 464 l-h-</path>-<path stroke="blue">-176 272 m-144 80 l-400 176 l-h-</path>-<path stroke="blue">-432 272 m-480 144 l-528 192 l-496 192 l-512 240 l-480 224 l-h-</path>-<path stroke="blue">-64 656 m-32 592 l-80 640 l-144 640 l-80 656 l-96 704 l-80 672 l-h-</path>-</page>-</ipe>
− test/Data/Geometry/arrangement.ipe 
@@ -1,296 +0,0 @@-<?xml version="1.0"?>-<!DOCTYPE ipe SYSTEM "ipe.dtd">-<ipe version="70107" creator="Ipe 7.2.2">-<info created="D:20180731094955" modified="D:20180731094955"/>-<ipestyle name="basic">-<symbol name="arrow/arc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/farc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/ptarc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fptarc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="mark/circle(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</symbol>-<symbol name="mark/disk(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-</path>-</symbol>-<symbol name="mark/fdisk(sfx)" transformations="translations">-<group>-<path fill="sym-fill">-0.5 0 0 0.5 0 0 e-</path>-<path fill="sym-stroke" fillrule="eofill">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</group>-</symbol>-<symbol name="mark/box(sx)" transformations="translations">-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</symbol>-<symbol name="mark/square(sx)" transformations="translations">-<path fill="sym-stroke">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h-</path>-</symbol>-<symbol name="mark/fsquare(sfx)" transformations="translations">-<group>-<path fill="sym-fill">--0.5 -0.5 m-0.5 -0.5 l-0.5 0.5 l--0.5 0.5 l-h-</path>-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</group>-</symbol>-<symbol name="mark/cross(sx)" transformations="translations">-<group>-<path fill="sym-stroke">--0.43 -0.57 m-0.57 0.43 l-0.43 0.57 l--0.57 -0.43 l-h-</path>-<path fill="sym-stroke">--0.43 0.57 m-0.57 -0.43 l-0.43 -0.57 l--0.57 0.43 l-h-</path>-</group>-</symbol>-<symbol name="arrow/fnormal(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/pointed(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fpointed(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/linear(spx)">-<path stroke="sym-stroke" pen="sym-pen">--1 0.333 m-0 0 l--1 -0.333 l-</path>-</symbol>-<symbol name="arrow/fdouble(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/double(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<pen name="heavier" value="0.8"/>-<pen name="fat" value="1.2"/>-<pen name="ultrafat" value="2"/>-<symbolsize name="large" value="5"/>-<symbolsize name="small" value="2"/>-<symbolsize name="tiny" value="1.1"/>-<arrowsize name="large" value="10"/>-<arrowsize name="small" value="5"/>-<arrowsize name="tiny" value="3"/>-<color name="red" value="1 0 0"/>-<color name="green" value="0 1 0"/>-<color name="blue" value="0 0 1"/>-<color name="yellow" value="1 1 0"/>-<color name="orange" value="1 0.647 0"/>-<color name="gold" value="1 0.843 0"/>-<color name="purple" value="0.627 0.125 0.941"/>-<color name="gray" value="0.745"/>-<color name="brown" value="0.647 0.165 0.165"/>-<color name="navy" value="0 0 0.502"/>-<color name="pink" value="1 0.753 0.796"/>-<color name="seagreen" value="0.18 0.545 0.341"/>-<color name="turquoise" value="0.251 0.878 0.816"/>-<color name="violet" value="0.933 0.51 0.933"/>-<color name="darkblue" value="0 0 0.545"/>-<color name="darkcyan" value="0 0.545 0.545"/>-<color name="darkgray" value="0.663"/>-<color name="darkgreen" value="0 0.392 0"/>-<color name="darkmagenta" value="0.545 0 0.545"/>-<color name="darkorange" value="1 0.549 0"/>-<color name="darkred" value="0.545 0 0"/>-<color name="lightblue" value="0.678 0.847 0.902"/>-<color name="lightcyan" value="0.878 1 1"/>-<color name="lightgray" value="0.827"/>-<color name="lightgreen" value="0.565 0.933 0.565"/>-<color name="lightyellow" value="1 1 0.878"/>-<dashstyle name="dashed" value="[4] 0"/>-<dashstyle name="dotted" value="[1 3] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<textsize name="large" value="\large"/>-<textsize name="Large" value="\Large"/>-<textsize name="LARGE" value="\LARGE"/>-<textsize name="huge" value="\huge"/>-<textsize name="Huge" value="\Huge"/>-<textsize name="small" value="\small"/>-<textsize name="footnote" value="\footnotesize"/>-<textsize name="tiny" value="\tiny"/>-<textstyle name="center" begin="\begin{center}" end="\end{center}"/>-<textstyle name="itemize" begin="\begin{itemize}" end="\end{itemize}"/>-<textstyle name="item" begin="\begin{itemize}\item{}" end="\end{itemize}"/>-<gridsize name="4 pts" value="4"/>-<gridsize name="8 pts (~3 mm)" value="8"/>-<gridsize name="16 pts (~6 mm)" value="16"/>-<gridsize name="32 pts (~12 mm)" value="32"/>-<gridsize name="10 pts (~3.5 mm)" value="10"/>-<gridsize name="20 pts (~7 mm)" value="20"/>-<gridsize name="14 pts (~5 mm)" value="14"/>-<gridsize name="28 pts (~10 mm)" value="28"/>-<gridsize name="56 pts (~20 mm)" value="56"/>-<anglesize name="90 deg" value="90"/>-<anglesize name="60 deg" value="60"/>-<anglesize name="45 deg" value="45"/>-<anglesize name="30 deg" value="30"/>-<anglesize name="22.5 deg" value="22.5"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="75%" value="0.75"/>-<tiling name="falling" angle="-60" step="4" width="1"/>-<tiling name="rising" angle="30" step="4" width="1"/>-</ipestyle>-<ipestyle name="frank">-<arrowsize name="normal" value="5"/>-<arrowsize name="large" value="8"/>-<arrowsize name="huge" value="10"/>-<arrowsize name="small" value="3"/>-<arrowsize name="tiny" value="1"/>-<dashstyle name="dashed" value="[2 2] 0"/>-<dashstyle name="dotted" value="[0.5 1] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<gridsize name="1 pts" value="1"/>-<gridsize name="2 pts" value="2"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="20%" value="0.2"/>-<opacity name="40%" value="0.4"/>-<opacity name="60%" value="0.6"/>-<opacity name="70%" value="0.7"/>-<opacity name="80%" value="0.8"/>-<opacity name="90%" value="0.9"/>-</ipestyle>-<page>-<layer name="alpha"/>-<view layers="alpha" active="alpha"/>-<path layer="alpha" stroke="black">-80 560 m-368 800 l-</path>-<path stroke="black">-160 768 m-416 608 l-</path>-<path stroke="black">-80 624 m-400 672 l-</path>-<path matrix="0.857143 0 0 1.3 32 -172.8" stroke="black">-224 576 m-336 736 l-</path>-</page>-</ipe>
− test/Data/Geometry/arrangement.ipe.out.ipe 
@@ -1,247 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<ipe version="70005" creator="HGeometry"><ipestyle name="basic">-<color name="red" value="1 0 0"/>-<color name="green" value="0 1 0"/>-<color name="blue" value="0 0 1"/>-<color name="yellow" value="1 1 0"/>-<color name="orange" value="1 0.647 0"/>-<color name="gold" value="1 0.843 0"/>-<color name="purple" value="0.627 0.125 0.941"/>-<color name="gray" value="0.745 0.745 0.745"/>-<color name="brown" value="0.647 0.165 0.165"/>-<color name="navy" value="0 0 0.502"/>-<color name="pink" value="1 0.753 0.796"/>-<color name="seagreen" value="0.18 0.545 0.341"/>-<color name="turquoise" value="0.251 0.878 0.816"/>-<color name="violet" value="0.933 0.51 0.933"/>-<color name="darkblue" value="0 0 0.545"/>-<color name="darkcyan" value="0 0.545 0.545"/>-<color name="darkgray" value="0.663 0.663 0.663"/>-<color name="darkgreen" value="0 0.392 0"/>-<color name="darkmagenta" value="0.545 0 0.545"/>-<color name="darkorange" value="1 0.549 0"/>-<color name="darkred" value="0.545 0 0"/>-<color name="lightblue" value="0.678 0.847 0.902"/>-<color name="lightcyan" value="0.878 1 1"/>-<color name="lightgray" value="0.827 0.827 0.827"/>-<color name="lightgreen" value="0.565 0.933 0.565"/>-<color name="lightyellow" value="1 1 0.878"/>-<dashstyle name="dashed" value="[4] 0"/>-<dashstyle name="dotted" value="[1 3] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<pen name="heavier" value="0.8"/>-<pen name="fat" value="1.2"/>-<pen name="ultrafat" value="2"/>-<textsize name="large" value="\large"/>-<textsize name="Large" value="\Large"/>-<textsize name="LARGE" value="\LARGE"/>-<textsize name="huge" value="\huge"/>-<textsize name="Huge" value="\Huge"/>-<textsize name="small" value="\small"/>-<textsize name="footnote" value="\footnotesize"/>-<textsize name="tiny" value="\tiny"/>-<symbolsize name="small" value="2"/>-<symbolsize name="tiny" value="1.1"/>-<symbolsize name="large" value="5"/>-<arrowsize name="small" value="5"/>-<arrowsize name="tiny" value="3"/>-<arrowsize name="large" value="10"/>-<gridsize name="4 pts" value="4"/>-<gridsize name="8 pts (~3 mm)" value="8"/>-<gridsize name="16 pts (~6 mm)" value="16"/>-<gridsize name="32 pts (~12 mm)" value="32"/>-<gridsize name="10 pts (~3.5 mm)" value="10"/>-<gridsize name="20 pts (~7 mm)" value="20"/>-<gridsize name="14 pts (~5 mm)" value="14"/>-<gridsize name="28 pts (~10 mm)" value="28"/>-<gridsize name="56 pts (~20 mm)" value="56"/>-<anglesize name="90 deg" value="90"/>-<anglesize name="60 deg" value="60"/>-<anglesize name="45 deg" value="45"/>-<anglesize name="30 deg" value="30"/>-<anglesize name="22.5 deg" value="22.5"/>-<symbol name="mark/circle(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e 0.4 0 0 0.4 0 0 e-</path></symbol>-<symbol name="mark/disk(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-</path></symbol>-<symbol name="mark/fdisk(sfx)" transformations="translations">-<group><path fill="sym-fill">-0.5 0 0 0.5 0 0 e-</path><path fill="sym-stroke" fillrule="eofill">-0.6 0 0 0.6 0 0 e 0.4 0 0 0.4 0 0 e-</path></group></symbol>-<symbol name="mark/box(sx)" transformations="translations">-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m 0.6 -0.6 l 0.6 0.6 l -0.6 0.6 l h--0.4 -0.4 m 0.4 -0.4 l 0.4 0.4 l -0.4 0.4 l h</path></symbol>-<symbol name="mark/square(sx)" transformations="translations">-<path fill="sym-stroke">--0.6 -0.6 m 0.6 -0.6 l 0.6 0.6 l -0.6 0.6 l h</path></symbol>-<symbol name="mark/fsquare(sfx)" transformations="translations">-<group><path fill="sym-fill">--0.5 -0.5 m 0.5 -0.5 l 0.5 0.5 l -0.5 0.5 l h</path>-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m 0.6 -0.6 l 0.6 0.6 l -0.6 0.6 l h--0.4 -0.4 m 0.4 -0.4 l 0.4 0.4 l -0.4 0.4 l h</path></group></symbol>-<symbol name="mark/cross(sx)" transformations="translations">-<group><path fill="sym-stroke">--0.43 -0.57 m 0.57 0.43 l 0.43 0.57 l -0.57 -0.43 l h</path>-<path fill="sym-stroke">--0.43 0.57 m 0.57 -0.43 l 0.43 -0.57 l -0.57 0.43 l h</path>-</group></symbol>-<symbol name="arrow/arc(spx)">-<path pen="sym-pen" stroke="sym-stroke" fill="sym-stroke">-0 0 m -1.0 0.333 l -1.0 -0.333 l h</path></symbol>-<symbol name="arrow/farc(spx)">-<path pen="sym-pen" stroke="sym-stroke" fill="white">-0 0 m -1.0 0.333 l -1.0 -0.333 l h</path></symbol>-<symbol name="arrow/ptarc(spx)">-<path pen="sym-pen" stroke="sym-stroke" fill="sym-stroke">-0 0 m -1.0 0.333 l -0.8 0 l -1.0 -0.333 l h</path></symbol>-<symbol name="arrow/fptarc(spx)">-<path pen="sym-pen" stroke="sym-stroke" fill="white">-0 0 m -1.0 0.333 l -0.8 0 l -1.0 -0.333 l h</path></symbol>-<symbol name="arrow/fnormal(spx)">-<path pen="sym-pen" stroke="sym-stroke" fill="white">-0 0 m -1.0 0.333 l -1.0 -0.333 l h</path></symbol>-<symbol name="arrow/pointed(spx)">-<path pen="sym-pen" stroke="sym-stroke" fill="sym-stroke">-0 0 m -1.0 0.333 l -0.8 0 l -1.0 -0.333 l h</path></symbol>-<symbol name="arrow/fpointed(spx)">-<path pen="sym-pen" stroke="sym-stroke" fill="white">-0 0 m -1.0 0.333 l -0.8 0 l -1.0 -0.333 l h</path></symbol>-<symbol name="arrow/linear(spx)">-<path pen="sym-pen" stroke="sym-stroke">--1.0 0.333 m 0 0 l -1.0 -0.333 l</path></symbol>-<symbol name="arrow/fdouble(spx)">-<path pen="sym-pen" stroke="sym-stroke" fill="white">-0 0 m -1.0 0.333 l -1.0 -0.333 l h--1 0 m -2.0 0.333 l -2.0 -0.333 l h-</path></symbol>-<symbol name="arrow/double(spx)">-<path pen="sym-pen" stroke="sym-stroke" fill="sym-stroke">-0 0 m -1.0 0.333 l -1.0 -0.333 l h--1 0 m -2.0 0.333 l -2.0 -0.333 l h-</path></symbol>-<tiling name="falling" angle="-60" width="1" step="4"/>-<tiling name="rising" angle="30" width="1" step="4"/>-<textstyle name="center" begin="\begin{center}" end="\end{center}"/>-<textstyle name="itemize" begin="\begin{itemize}" end="\end{itemize}"/>-<textstyle name="item" begin="\begin{itemize}\item{}" end="\end{itemize}"/>-</ipestyle><page><layer name="alpha"/><view layers="alpha" active="alpha"/><group><use pos="172.658536585365 637.048780487804" name="mark/disk(sx)"/><use pos="172.658536585365 637.215447154471" name="mark/disk(sx)"/><use pos="172.658536585365 637.898780487804" name="mark/disk(sx)"/><use pos="172.658536585365 746.000060937506" name="mark/disk(sx)"/><use pos="173.658536585365 638.048780487804" name="mark/disk(sx)"/><use pos="195.199902499989 746.000060937506" name="mark/disk(sx)"/><use pos="252.176396921200 637.048780487804" name="mark/disk(sx)"/><use pos="256.914285714285 707.428571428571" name="mark/disk(sx)"/><use pos="258.512437254286 650.776865588142" name="mark/disk(sx)"/><use pos="278.447793072843 693.970129329472" name="mark/disk(sx)"/><use pos="302.000073125007 745.000060937506" name="mark/disk(sx)"/><use pos="302.461611663469 746.000060937506" name="mark/disk(sx)"/><use pos="303.200073125007 746.000060937506" name="mark/disk(sx)"/><use pos="330.322580645161 661.548387096774" name="mark/disk(sx)"/><use pos="331.322580645161 637.048780487804" name="mark/disk(sx)"/><use pos="331.322580645161 660.923387096774" name="mark/disk(sx)"/><use pos="331.322580645161 661.698387096774" name="mark/disk(sx)"/><use pos="331.322580645161 746.000060937506" name="mark/disk(sx)"/><path>172.658536585365 637.215447154471 m-173.658536585365 638.048780487804 l-</path><path>173.658536585365 638.048780487804 m-256.914285714285 707.428571428571 l-</path><path>256.914285714285 707.428571428571 m-302.000073125007 745.000060937506 l-</path><path>302.000073125007 745.000060937506 m-303.200073125007 746.000060937506 l-</path><path>195.199902499989 746.000060937506 m-256.914285714285 707.428571428571 l-</path><path>256.914285714285 707.428571428571 m-278.447793072843 693.970129329472 l-</path><path>278.447793072843 693.970129329472 m-330.322580645161 661.548387096774 l-</path><path>330.322580645161 661.548387096774 m-331.322580645161 660.923387096774 l-</path><path>172.658536585365 637.898780487804 m-173.658536585365 638.048780487804 l-</path><path>173.658536585365 638.048780487804 m-258.512437254286 650.776865588142 l-</path><path>258.512437254286 650.776865588142 m-330.322580645161 661.548387096774 l-</path><path>330.322580645161 661.548387096774 m-331.322580645161 661.698387096774 l-</path><path>252.176396921200 637.048780487804 m-258.512437254286 650.776865588142 l-</path><path>258.512437254286 650.776865588142 m-278.447793072843 693.970129329472 l-</path><path>278.447793072843 693.970129329472 m-302.000073125007 745.000060937506 l-</path><path>302.000073125007 745.000060937506 m-302.461611663469 746.000060937506 l-</path><path>172.658536585365 746.000060937506 m-195.199902499989 746.000060937506 l-</path><path>195.199902499989 746.000060937506 m-302.461611663469 746.000060937506 l-</path><path>302.461611663469 746.000060937506 m-303.200073125007 746.000060937506 l-</path><path>303.200073125007 746.000060937506 m-331.322580645161 746.000060937506 l-</path><path>331.322580645161 746.000060937506 m-331.322580645161 661.698387096774 l-</path><path>331.322580645161 661.698387096774 m-331.322580645161 660.923387096774 l-</path><path>331.322580645161 660.923387096774 m-331.322580645161 637.048780487804 l-</path><path>331.322580645161 637.048780487804 m-252.176396921200 637.048780487804 l-</path><path>252.176396921200 637.048780487804 m-172.658536585365 637.048780487804 l-</path><path>172.658536585365 637.048780487804 m-172.658536585365 637.215447154471 l-</path><path>172.658536585365 637.215447154471 m-172.658536585365 637.898780487804 l-</path><path>172.658536585365 637.898780487804 m-172.658536585365 746.000060937506 l-</path><path>172.658536585365 637.215447154471 m-173.658536585365 638.048780487804 l-258.512437254286 650.776865588142 l-252.176396921200 637.048780487804 l-172.658536585365 637.048780487804 l-h-</path><path>172.658536585365 637.898780487804 m-173.658536585365 638.048780487804 l-172.658536585365 637.215447154471 l-h-</path><path>172.658536585365 746.000060937506 m-195.199902499989 746.000060937506 l-256.914285714285 707.428571428571 l-173.658536585365 638.048780487804 l-172.658536585365 637.898780487804 l-h-</path><path>256.914285714285 707.428571428571 m-278.447793072843 693.970129329472 l-258.512437254286 650.776865588142 l-173.658536585365 638.048780487804 l-h-</path><path>302.461611663469 746.000060937506 m-302.000073125007 745.000060937506 l-256.914285714285 707.428571428571 l-195.199902499989 746.000060937506 l-h-</path><path>258.512437254286 650.776865588142 m-330.322580645161 661.548387096774 l-331.322580645161 660.923387096774 l-331.322580645161 637.048780487804 l-252.176396921200 637.048780487804 l-h-</path><path>302.000073125007 745.000060937506 m-278.447793072843 693.970129329472 l-256.914285714285 707.428571428571 l-h-</path><path>278.447793072843 693.970129329472 m-330.322580645161 661.548387096774 l-258.512437254286 650.776865588142 l-h-</path><path>302.000073125007 745.000060937506 m-303.200073125007 746.000060937506 l-331.322580645161 746.000060937506 l-331.322580645161 661.698387096774 l-330.322580645161 661.548387096774 l-278.447793072843 693.970129329472 l-h-</path><path>302.461611663469 746.000060937506 m-303.200073125007 746.000060937506 l-302.000073125007 745.000060937506 l-h-</path><path>331.322580645161 661.698387096774 m-331.322580645161 660.923387096774 l-330.322580645161 661.548387096774 l-h-</path></group></page></ipe>
− test/Data/Geometry/pointInPolygon.ipe 
@@ -1,311 +0,0 @@-<?xml version="1.0"?>-<!DOCTYPE ipe SYSTEM "ipe.dtd">-<ipe version="70107" creator="Ipe 7.1.7">-<info created="D:20150923215046" modified="D:20150924223742"/>-<ipestyle name="basic">-<symbol name="arrow/arc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/farc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/ptarc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fptarc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="mark/circle(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</symbol>-<symbol name="mark/disk(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-</path>-</symbol>-<symbol name="mark/fdisk(sfx)" transformations="translations">-<group>-<path fill="sym-fill">-0.5 0 0 0.5 0 0 e-</path>-<path fill="sym-stroke" fillrule="eofill">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</group>-</symbol>-<symbol name="mark/box(sx)" transformations="translations">-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</symbol>-<symbol name="mark/square(sx)" transformations="translations">-<path fill="sym-stroke">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h-</path>-</symbol>-<symbol name="mark/fsquare(sfx)" transformations="translations">-<group>-<path fill="sym-fill">--0.5 -0.5 m-0.5 -0.5 l-0.5 0.5 l--0.5 0.5 l-h-</path>-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</group>-</symbol>-<symbol name="mark/cross(sx)" transformations="translations">-<group>-<path fill="sym-stroke">--0.43 -0.57 m-0.57 0.43 l-0.43 0.57 l--0.57 -0.43 l-h-</path>-<path fill="sym-stroke">--0.43 0.57 m-0.57 -0.43 l-0.43 -0.57 l--0.57 0.43 l-h-</path>-</group>-</symbol>-<symbol name="arrow/fnormal(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/pointed(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fpointed(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/linear(spx)">-<path stroke="sym-stroke" pen="sym-pen">--1 0.333 m-0 0 l--1 -0.333 l-</path>-</symbol>-<symbol name="arrow/fdouble(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/double(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<pen name="heavier" value="0.8"/>-<pen name="fat" value="1.2"/>-<pen name="ultrafat" value="2"/>-<symbolsize name="large" value="5"/>-<symbolsize name="small" value="2"/>-<symbolsize name="tiny" value="1.1"/>-<arrowsize name="large" value="10"/>-<arrowsize name="small" value="5"/>-<arrowsize name="tiny" value="3"/>-<color name="red" value="1 0 0"/>-<color name="green" value="0 1 0"/>-<color name="blue" value="0 0 1"/>-<color name="yellow" value="1 1 0"/>-<color name="orange" value="1 0.647 0"/>-<color name="gold" value="1 0.843 0"/>-<color name="purple" value="0.627 0.125 0.941"/>-<color name="gray" value="0.745"/>-<color name="brown" value="0.647 0.165 0.165"/>-<color name="navy" value="0 0 0.502"/>-<color name="pink" value="1 0.753 0.796"/>-<color name="seagreen" value="0.18 0.545 0.341"/>-<color name="turquoise" value="0.251 0.878 0.816"/>-<color name="violet" value="0.933 0.51 0.933"/>-<color name="darkblue" value="0 0 0.545"/>-<color name="darkcyan" value="0 0.545 0.545"/>-<color name="darkgray" value="0.663"/>-<color name="darkgreen" value="0 0.392 0"/>-<color name="darkmagenta" value="0.545 0 0.545"/>-<color name="darkorange" value="1 0.549 0"/>-<color name="darkred" value="0.545 0 0"/>-<color name="lightblue" value="0.678 0.847 0.902"/>-<color name="lightcyan" value="0.878 1 1"/>-<color name="lightgray" value="0.827"/>-<color name="lightgreen" value="0.565 0.933 0.565"/>-<color name="lightyellow" value="1 1 0.878"/>-<dashstyle name="dashed" value="[4] 0"/>-<dashstyle name="dotted" value="[1 3] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<textsize name="large" value="\large"/>-<textsize name="Large" value="\Large"/>-<textsize name="LARGE" value="\LARGE"/>-<textsize name="huge" value="\huge"/>-<textsize name="Huge" value="\Huge"/>-<textsize name="small" value="\small"/>-<textsize name="footnote" value="\footnotesize"/>-<textsize name="tiny" value="\tiny"/>-<textstyle name="center" begin="\begin{center}" end="\end{center}"/>-<textstyle name="itemize" begin="\begin{itemize}" end="\end{itemize}"/>-<textstyle name="item" begin="\begin{itemize}\item{}" end="\end{itemize}"/>-<gridsize name="4 pts" value="4"/>-<gridsize name="8 pts (~3 mm)" value="8"/>-<gridsize name="16 pts (~6 mm)" value="16"/>-<gridsize name="32 pts (~12 mm)" value="32"/>-<gridsize name="10 pts (~3.5 mm)" value="10"/>-<gridsize name="20 pts (~7 mm)" value="20"/>-<gridsize name="14 pts (~5 mm)" value="14"/>-<gridsize name="28 pts (~10 mm)" value="28"/>-<gridsize name="56 pts (~20 mm)" value="56"/>-<anglesize name="90 deg" value="90"/>-<anglesize name="60 deg" value="60"/>-<anglesize name="45 deg" value="45"/>-<anglesize name="30 deg" value="30"/>-<anglesize name="22.5 deg" value="22.5"/>-<tiling name="falling" angle="-60" step="4" width="1"/>-<tiling name="rising" angle="30" step="4" width="1"/>-</ipestyle>-<ipestyle name="frank">-<arrowsize name="normal" value="5"/>-<arrowsize name="large" value="8"/>-<arrowsize name="huge" value="10"/>-<arrowsize name="small" value="3"/>-<arrowsize name="tiny" value="1"/>-<dashstyle name="dashed" value="[2 2] 0"/>-<dashstyle name="dotted" value="[0.5 1] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<gridsize name="1 pts" value="1"/>-<gridsize name="2 pts" value="2"/>-<opacity name="10%" value="0.1"/>-<opacity name="20%" value="0.2"/>-<opacity name="30%" value="0.3"/>-<opacity name="40%" value="0.4"/>-<opacity name="50%" value="0.5"/>-<opacity name="60%" value="0.6"/>-<opacity name="70%" value="0.7"/>-<opacity name="80%" value="0.8"/>-<opacity name="90%" value="0.9"/>-</ipestyle>-<page>-<layer name="alpha"/>-<view layers="alpha" active="alpha"/>-<path layer="alpha" stroke="darkblue">-208 752 m-304 688 l-224 592 l-48 736 l-h-</path>-<use name="mark/disk(sx)" pos="128 704" size="normal" stroke="darkblue"/>-<use name="mark/disk(sx)" pos="192 672" size="normal" stroke="darkblue"/>-<use name="mark/disk(sx)" pos="192 720" size="normal" stroke="darkblue"/>-<use name="mark/box(sx)" pos="304 688" size="normal" stroke="black"/>-<use name="mark/cross(sx)" pos="352 736" size="normal" stroke="darkblue"/>-<use name="mark/cross(sx)" pos="352 704" size="normal" stroke="darkblue"/>-<path stroke="orange">-496 736 m-432 624 l-512 608 l-h-</path>-<use name="mark/box(sx)" pos="432 624" size="normal" stroke="orange"/>-<use name="mark/box(sx)" pos="512 608" size="normal" stroke="orange"/>-<use name="mark/box(sx)" pos="496 736" size="normal" stroke="orange"/>-<use name="mark/disk(sx)" pos="496 656" size="normal" stroke="orange"/>-<use name="mark/disk(sx)" pos="480 640" size="normal" stroke="orange"/>-<use name="mark/disk(sx)" pos="464 656" size="normal" stroke="orange"/>-<use name="mark/cross(sx)" pos="368 608" size="normal" stroke="orange"/>-<use name="mark/cross(sx)" pos="384 592" size="normal" stroke="orange"/>-<use name="mark/cross(sx)" pos="336 576" size="normal" stroke="orange"/>-<use name="mark/disk(sx)" pos="496 624" size="normal" stroke="orange"/>-<use name="mark/cross(sx)" pos="528 624" size="normal" stroke="orange"/>-<use name="mark/cross(sx)" pos="384 624" size="normal" stroke="orange"/>-<use name="mark/cross(sx)" pos="368 640" size="normal" stroke="orange"/>-<use name="mark/cross(sx)" pos="336 688" size="normal" stroke="darkblue"/>-<use name="mark/disk(sx)" pos="256 688" size="normal" stroke="darkblue"/>-<use name="mark/disk(sx)" pos="224 688" size="normal" stroke="darkblue"/>-</page>-</ipe>
− test/Data/Geometry/pointInTriangle.ipe 
@@ -1,310 +0,0 @@-<?xml version="1.0"?>-<!DOCTYPE ipe SYSTEM "ipe.dtd">-<ipe version="70107" creator="Ipe 7.2.2">-<info created="D:20150923215046" modified="D:20180808120020"/>-<ipestyle name="basic">-<symbol name="arrow/arc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/farc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/ptarc(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fptarc(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="mark/circle(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</symbol>-<symbol name="mark/disk(sx)" transformations="translations">-<path fill="sym-stroke">-0.6 0 0 0.6 0 0 e-</path>-</symbol>-<symbol name="mark/fdisk(sfx)" transformations="translations">-<group>-<path fill="sym-fill">-0.5 0 0 0.5 0 0 e-</path>-<path fill="sym-stroke" fillrule="eofill">-0.6 0 0 0.6 0 0 e-0.4 0 0 0.4 0 0 e-</path>-</group>-</symbol>-<symbol name="mark/box(sx)" transformations="translations">-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</symbol>-<symbol name="mark/square(sx)" transformations="translations">-<path fill="sym-stroke">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h-</path>-</symbol>-<symbol name="mark/fsquare(sfx)" transformations="translations">-<group>-<path fill="sym-fill">--0.5 -0.5 m-0.5 -0.5 l-0.5 0.5 l--0.5 0.5 l-h-</path>-<path fill="sym-stroke" fillrule="eofill">--0.6 -0.6 m-0.6 -0.6 l-0.6 0.6 l--0.6 0.6 l-h--0.4 -0.4 m-0.4 -0.4 l-0.4 0.4 l--0.4 0.4 l-h-</path>-</group>-</symbol>-<symbol name="mark/cross(sx)" transformations="translations">-<group>-<path fill="sym-stroke">--0.43 -0.57 m-0.57 0.43 l-0.43 0.57 l--0.57 -0.43 l-h-</path>-<path fill="sym-stroke">--0.43 0.57 m-0.57 -0.43 l-0.43 -0.57 l--0.57 0.43 l-h-</path>-</group>-</symbol>-<symbol name="arrow/fnormal(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/pointed(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/fpointed(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--0.8 0 l--1 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/linear(spx)">-<path stroke="sym-stroke" pen="sym-pen">--1 0.333 m-0 0 l--1 -0.333 l-</path>-</symbol>-<symbol name="arrow/fdouble(spx)">-<path stroke="sym-stroke" fill="white" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<symbol name="arrow/double(spx)">-<path stroke="sym-stroke" fill="sym-stroke" pen="sym-pen">-0 0 m--1 0.333 l--1 -0.333 l-h--1 0 m--2 0.333 l--2 -0.333 l-h-</path>-</symbol>-<pen name="heavier" value="0.8"/>-<pen name="fat" value="1.2"/>-<pen name="ultrafat" value="2"/>-<symbolsize name="large" value="5"/>-<symbolsize name="small" value="2"/>-<symbolsize name="tiny" value="1.1"/>-<arrowsize name="large" value="10"/>-<arrowsize name="small" value="5"/>-<arrowsize name="tiny" value="3"/>-<color name="red" value="1 0 0"/>-<color name="green" value="0 1 0"/>-<color name="blue" value="0 0 1"/>-<color name="yellow" value="1 1 0"/>-<color name="orange" value="1 0.647 0"/>-<color name="gold" value="1 0.843 0"/>-<color name="purple" value="0.627 0.125 0.941"/>-<color name="gray" value="0.745"/>-<color name="brown" value="0.647 0.165 0.165"/>-<color name="navy" value="0 0 0.502"/>-<color name="pink" value="1 0.753 0.796"/>-<color name="seagreen" value="0.18 0.545 0.341"/>-<color name="turquoise" value="0.251 0.878 0.816"/>-<color name="violet" value="0.933 0.51 0.933"/>-<color name="darkblue" value="0 0 0.545"/>-<color name="darkcyan" value="0 0.545 0.545"/>-<color name="darkgray" value="0.663"/>-<color name="darkgreen" value="0 0.392 0"/>-<color name="darkmagenta" value="0.545 0 0.545"/>-<color name="darkorange" value="1 0.549 0"/>-<color name="darkred" value="0.545 0 0"/>-<color name="lightblue" value="0.678 0.847 0.902"/>-<color name="lightcyan" value="0.878 1 1"/>-<color name="lightgray" value="0.827"/>-<color name="lightgreen" value="0.565 0.933 0.565"/>-<color name="lightyellow" value="1 1 0.878"/>-<dashstyle name="dashed" value="[4] 0"/>-<dashstyle name="dotted" value="[1 3] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<textsize name="large" value="\large"/>-<textsize name="Large" value="\Large"/>-<textsize name="LARGE" value="\LARGE"/>-<textsize name="huge" value="\huge"/>-<textsize name="Huge" value="\Huge"/>-<textsize name="small" value="\small"/>-<textsize name="footnote" value="\footnotesize"/>-<textsize name="tiny" value="\tiny"/>-<textstyle name="center" begin="\begin{center}" end="\end{center}"/>-<textstyle name="itemize" begin="\begin{itemize}" end="\end{itemize}"/>-<textstyle name="item" begin="\begin{itemize}\item{}" end="\end{itemize}"/>-<gridsize name="4 pts" value="4"/>-<gridsize name="8 pts (~3 mm)" value="8"/>-<gridsize name="16 pts (~6 mm)" value="16"/>-<gridsize name="32 pts (~12 mm)" value="32"/>-<gridsize name="10 pts (~3.5 mm)" value="10"/>-<gridsize name="20 pts (~7 mm)" value="20"/>-<gridsize name="14 pts (~5 mm)" value="14"/>-<gridsize name="28 pts (~10 mm)" value="28"/>-<gridsize name="56 pts (~20 mm)" value="56"/>-<anglesize name="90 deg" value="90"/>-<anglesize name="60 deg" value="60"/>-<anglesize name="45 deg" value="45"/>-<anglesize name="30 deg" value="30"/>-<anglesize name="22.5 deg" value="22.5"/>-<tiling name="falling" angle="-60" step="4" width="1"/>-<tiling name="rising" angle="30" step="4" width="1"/>-</ipestyle>-<ipestyle name="frank">-<arrowsize name="normal" value="5"/>-<arrowsize name="large" value="8"/>-<arrowsize name="huge" value="10"/>-<arrowsize name="small" value="3"/>-<arrowsize name="tiny" value="1"/>-<dashstyle name="dashed" value="[2 2] 0"/>-<dashstyle name="dotted" value="[0.5 1] 0"/>-<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>-<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>-<gridsize name="1 pts" value="1"/>-<gridsize name="2 pts" value="2"/>-<opacity name="10%" value="0.1"/>-<opacity name="30%" value="0.3"/>-<opacity name="50%" value="0.5"/>-<opacity name="20%" value="0.2"/>-<opacity name="40%" value="0.4"/>-<opacity name="60%" value="0.6"/>-<opacity name="70%" value="0.7"/>-<opacity name="80%" value="0.8"/>-<opacity name="90%" value="0.9"/>-</ipestyle>-<page>-<layer name="alpha"/>-<view layers="alpha" active="alpha"/>-<path layer="alpha" stroke="darkblue">-304 720 m-224 592 l-48 736 l-h-</path>-<use name="mark/disk(sx)" pos="128 704" size="normal" stroke="darkblue"/>-<use name="mark/disk(sx)" pos="192 672" size="normal" stroke="darkblue"/>-<use name="mark/disk(sx)" pos="192 720" size="normal" stroke="darkblue"/>-<use name="mark/box(sx)" pos="304 688" size="normal" stroke="black"/>-<use name="mark/cross(sx)" pos="352 736" size="normal" stroke="darkblue"/>-<use name="mark/cross(sx)" pos="352 704" size="normal" stroke="darkblue"/>-<path stroke="orange">-496 736 m-432 624 l-512 608 l-h-</path>-<use name="mark/box(sx)" pos="432 624" size="normal" stroke="orange"/>-<use name="mark/box(sx)" pos="512 608" size="normal" stroke="orange"/>-<use name="mark/box(sx)" pos="496 736" size="normal" stroke="orange"/>-<use name="mark/disk(sx)" pos="496 656" size="normal" stroke="orange"/>-<use name="mark/disk(sx)" pos="480 640" size="normal" stroke="orange"/>-<use name="mark/disk(sx)" pos="464 656" size="normal" stroke="orange"/>-<use name="mark/cross(sx)" pos="368 608" size="normal" stroke="orange"/>-<use name="mark/cross(sx)" pos="384 592" size="normal" stroke="orange"/>-<use name="mark/cross(sx)" pos="336 576" size="normal" stroke="orange"/>-<use name="mark/disk(sx)" pos="496 624" size="normal" stroke="orange"/>-<use name="mark/cross(sx)" pos="528 624" size="normal" stroke="orange"/>-<use name="mark/cross(sx)" pos="384 624" size="normal" stroke="orange"/>-<use name="mark/cross(sx)" pos="368 640" size="normal" stroke="orange"/>-<use name="mark/cross(sx)" pos="336 688" size="normal" stroke="darkblue"/>-<use name="mark/disk(sx)" pos="256 688" size="normal" stroke="darkblue"/>-<use name="mark/disk(sx)" pos="224 688" size="normal" stroke="darkblue"/>-</page>-</ipe>
− test/Data/PlaneGraph/myPlaneGraph.yaml 
@@ -1,90 +0,0 @@-adjacencies:-- adj:-  - - 4-    - []-  - - 2-    - []-  - - 1-    - []-  - - 3-    - []-  id: 0-  loc:-  - 0-  - 0-  vData:-  - []-  - []-  - []-  - []-- adj:-  - - 2-    - []-  - - 3-    - []-  - - 0-    - []-  id: 1-  loc:-  - 10-  - 10-  vData:-  - []-  - []-  - []-- adj:-  - - 1-    - []-  - - 0-    - []-  - - 4-    - []-  id: 2-  loc:-  - 12-  - 10-  vData:-  - []-  - []-  - []-- adj:-  - - 0-    - []-  - - 1-    - []-  id: 3-  loc:-  - 13-  - 20-  vData:-  - []-  - []-- adj:-  - - 2-    - []-  - - 0-    - []-  id: 4-  loc:-  - 20-  - 5-  vData:-  - []-  - []-faces:-- fData: []-  incidentEdge:-  - 0-  - 4-- fData: []-  incidentEdge:-  - 0-  - 2-- fData: []-  incidentEdge:-  - 0-  - 1-- fData: []-  incidentEdge:-  - 0-  - 3
− test/Data/PlaneGraph/small.yaml 
@@ -1,58 +0,0 @@-ajacencies:-- adj:-  - - 2-    - 0->2-  - - 1-    - 0->1-  - - 3-    - 0->3-  id: 0-  loc:-  - 0-  - 0-  vData: 0-- adj:-  - - 0-    - 1->0-  - - 2-    - 1->2-  - - 3-    - 1->3-  id: 1-  loc:-  - 2-  - 2-  vData: 1-- adj:-  - - 0-    - 2->0-  - - 1-    - 2->1-  id: 2-  loc:-  - 2-  - 0-  vData: 2-- adj:-  - - 0-    - 3->0-  - - 1-    - 3->1-  id: 3-  loc:-  - -1-  - 4-  vData: 3-faces:-- fData: OuterFace-  incidentEdge:-  - 0-  - 2-- fData: A-  incidentEdge:-  - 0-  - 1-- fData: B-  incidentEdge:-  - 0-  - 3
− test/Data/PlaneGraph/testsegs.png

binary file changed (56081 → absent bytes)