Handling degenerate lower envelopes and Vornoi Diagrams (#247)

* deaeling with degeneracies + switching to the new lower enve implementation * it compiles again * tests now also compile again * cleaning up * updating tests * drawing ipelines * the degenerate parallel strips business of lower envelopes * making the testcases pass :) * making sure the examples compile again * cleaning up a bit + hoping to fix the 9.8 compile error * one more attempt at making things compile :)
noinia · Sep 15, 2024 · 80f1f79 · 80f1f79
1 parent 8089184
commit 80f1f79
Show file tree

Hide file tree

Showing 42 changed files with 1,113 additions and 1,801 deletions.
diff --git a/hgeometry-combinatorial/src/HGeometry/Sequence/Alternating.hs b/hgeometry-combinatorial/src/HGeometry/Sequence/Alternating.hs
@@ -13,6 +13,7 @@ module HGeometry.Sequence.Alternating
   ( Alternating(..)
   , fromNonEmptyWith
   , mapF
+  , firstWithNeighbors
   , withNeighbours
   , mergeAlternating
   , insertBreakPoints
@@ -21,6 +22,7 @@ module HGeometry.Sequence.Alternating
   , consElemWith
   , unconsAlt
   , snocElemWith
+  , separators
   ) where
 
 import           Control.DeepSeq
@@ -194,3 +196,19 @@ snocElemWith f (Alternating x0 xs) y = Alternating x0 $ view (re _Snoc) (xs, (s,
     s = case xs^?_last of
           Nothing    -> f x0 y
           Just (_,x) -> f x  y
+
+
+--------------------------------------------------------------------------------
+
+-- | Map over the separators of the alterating together with the neighbours
+firstWithNeighbors                       :: Traversable f
+                                         => (a -> sep -> a -> sep')
+                                         -> Alternating f sep a -> Alternating f sep' a
+firstWithNeighbors f (Alternating x0 xs) = Alternating x0 xs'
+  where
+    (_, xs') = List.mapAccumL (\x (sep,y) -> (y, (f x sep y, y))) x0 xs
+
+
+-- | Get the separators out of the alternating
+separators                    :: Functor f => Alternating f sep a -> f sep
+separators (Alternating _ xs) = fmap fst xs
diff --git a/hgeometry-examples/skia/Model.hs b/hgeometry-examples/skia/Model.hs
@@ -28,6 +28,7 @@ import           Color
 import           Control.Lens hiding (view, element)
 import           Data.Default.Class
 import qualified Data.IntMap as IntMap
+import qualified Data.Set as Set
 import           Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NonEmpty
 import           Data.Maybe (fromJust)
@@ -94,7 +95,7 @@ data Model = Model { _canvas       :: SkiaCanvas.Canvas R
 
                    , _planeGraphs  :: IntMap.IntMap (PlaneGraph' R)
 
-                   , _diagram      :: Maybe [Point 2 R]
+                   , _diagram      :: Maybe (Set.Set (Point 2 R))
                    , __layers      :: Layers
                    , _stroke       :: !StrokeFill
                    , _fill         :: !StrokeFill

diff --git a/hgeometry-examples/voronoiDiagram/Main.hs b/hgeometry-examples/voronoiDiagram/Main.hs
@@ -3,18 +3,20 @@
 module Main(main) where
 
 import           Control.Lens hiding (view, element)
+import           Data.Foldable (toList)
 import qualified Data.IntMap as IntMap
 import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Map as Map
+import qualified Data.Set as Set
 import           GHC.TypeNats
-import           HGeometry.VoronoiDiagram
 import           HGeometry.Ext
 import           HGeometry.Miso.OrphanInstances ()
 import           HGeometry.Miso.Svg
 import           HGeometry.Miso.Svg.Canvas (Canvas, blankCanvas, mouseCoordinates)
 import qualified HGeometry.Miso.Svg.Canvas as Canvas
 import           HGeometry.Number.Real.Rational
 import           HGeometry.Point
+import           HGeometry.VoronoiDiagram
 import qualified Language.Javascript.JSaddle.Warp as JSaddle
 import           Miso
 import           Miso.String (MisoString,ToMisoString(..), ms)
@@ -26,7 +28,7 @@ type R = RealNumber 5
 
 data Model = Model { _canvas   :: Canvas R
                    , _points   :: IntMap.IntMap (Point 2 R)
-                   , _diagram  :: Maybe [Point 2 R]
+                   , _diagram  :: Maybe (Set.Set (Point 2 R))
                    } deriving (Eq)
 makeLenses ''Model
 
@@ -96,7 +98,7 @@ viewModel m = div_ [ ]
     canvasBody = [ g_ [] [ draw v [ fill_ "red"
                                   ]
                          ]
-                 | v <- m^..diagram.traverse.traverse ]
+                 | v <- m^..diagram.traverse.to toList.traverse ]
               <> [ g_ [] [ draw p [ fill_ "black"
                                   ]
                          , textAt p [] (ms i)

diff --git a/hgeometry/data/test-with-ipe/Plane/LowerEnvelope/degenerate1_out.ipe b/hgeometry/data/test-with-ipe/Plane/LowerEnvelope/degenerate1_out.ipe
@@ -143,20 +143,20 @@
 <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 layer="alpha" stroke="black" size="normal" pos="64.000000000000 96.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="96.000000000000 128.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="128.000000000000 96.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="96.000000000000 64.000000000000" name="mark/disk(sx)"/></group><group><group><use stroke="green" pos="128.000000000000 96.000000000000" name="mark/disk(sx)"/><path fill="green" opacity="10%">1096.000000000000 -904.000000000000 m
-1096.000000000000 1096.000000000000 l
+</ipestyle><page><layer name="alpha"/><view layers="alpha" active="alpha"/><group><use layer="alpha" stroke="black" size="normal" pos="64.000000000000 96.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="96.000000000000 128.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="128.000000000000 96.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="96.000000000000 64.000000000000" name="mark/disk(sx)"/></group><group><group><use stroke="green" pos="64.000000000000 96.000000000000" name="mark/disk(sx)"/><path fill="green" opacity="10%">-904.000000000000 1096.000000000000 m
+-904.000000000000 -904.000000000000 l
 96.000000000000 96.000000000000 l
 h
-</path></group><group><use stroke="blue" pos="96.000000000000 128.000000000000" name="mark/disk(sx)"/><path fill="blue" opacity="10%">1096.000000000000 1096.000000000000 m
--904.000000000000 1096.000000000000 l
+</path></group><group><use stroke="blue" pos="96.000000000000 64.000000000000" name="mark/disk(sx)"/><path fill="blue" opacity="10%">-904.000000000000 -904.000000000000 m
+1096.000000000000 -904.000000000000 l
 96.000000000000 96.000000000000 l
 h
-</path></group><group><use stroke="yellow" pos="96.000000000000 64.000000000000" name="mark/disk(sx)"/><path fill="yellow" opacity="10%">-904.000000000000 -904.000000000000 m
-1096.000000000000 -904.000000000000 l
+</path></group><group><use stroke="yellow" pos="96.000000000000 128.000000000000" name="mark/disk(sx)"/><path fill="yellow" opacity="10%">1096.000000000000 1096.000000000000 m
+-904.000000000000 1096.000000000000 l
 96.000000000000 96.000000000000 l
 h
-</path></group><group><use stroke="orange" pos="64.000000000000 96.000000000000" name="mark/disk(sx)"/><path fill="orange" opacity="10%">-904.000000000000 1096.000000000000 m
--904.000000000000 -904.000000000000 l
+</path></group><group><use stroke="orange" pos="128.000000000000 96.000000000000" name="mark/disk(sx)"/><path fill="orange" opacity="10%">1096.000000000000 -904.000000000000 m
+1096.000000000000 1096.000000000000 l
 96.000000000000 96.000000000000 l
 h
 </path></group></group><use stroke="red" pos="96.000000000000 96.000000000000" name="mark/disk(sx)"/></page></ipe>
diff --git a/hgeometry/data/test-with-ipe/Plane/LowerEnvelope/degenerate2_out.ipe b/hgeometry/data/test-with-ipe/Plane/LowerEnvelope/degenerate2_out.ipe
@@ -143,46 +143,46 @@
 <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 stroke="black" size="normal" pos="82.745200000000 173.255000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="128.000000000000 192.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="173.255000000000 173.255000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="192.000000000000 128.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="173.255000000000 82.745200000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="128.000000000000 64.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="82.745200000000 82.745200000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="64.000000000000 128.000000000000" name="mark/disk(sx)"/></group><group><group><use stroke="green" pos="192.000000000000 128.000000000000" name="mark/disk(sx)"/><path fill="green" opacity="10%">1128.000225351379 -286.210430677666 m
-1128.000566767257 542.208941532476 l
-128.000566767257 128.000566767257 l
-128.000019914361 128.000019914361 l
+</ipestyle><page><layer name="alpha"/><view layers="alpha" active="alpha"/><group><use stroke="black" size="normal" pos="82.745200000000 173.255000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="128.000000000000 192.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="173.255000000000 173.255000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="192.000000000000 128.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="173.255000000000 82.745200000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="128.000000000000 64.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="82.745200000000 82.745200000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="64.000000000000 128.000000000000" name="mark/disk(sx)"/></group><group><group><use stroke="green" pos="64.000000000000 128.000000000000" name="mark/disk(sx)"/><path fill="green" opacity="10%">-872.000225351380 542.213019517769 m
+-872.000048077500 -286.214576669489 l
+127.999951922500 128.000048077500 l
+127.999774648620 128.000225351379 l
+h
+</path></group><group><use stroke="blue" pos="82.745200000000 82.745200000000" name="mark/disk(sx)"/><path fill="blue" opacity="10%">-872.000048077500 -286.214576669489 m
+-871.999951922500 -2286.207418497661 l
 128.000048077500 127.999951922500 l
-128.000225351379 127.999774648620 l
+128.000019914361 128.000019914361 l
+127.999951922500 128.000048077500 l
 h
-</path></group><group><use stroke="blue" pos="173.255000000000 173.255000000000" name="mark/disk(sx)"/><path fill="blue" opacity="10%">1128.000566767257 542.208941532476 m
-1128.000566767257 2542.244365113483 l
-128.000566767257 128.000566767257 l
+</path></group><group><use stroke="yellow" pos="82.745200000000 173.255000000000" name="mark/disk(sx)"/><path fill="yellow" opacity="10%">-872.000225351380 2542.233354185735 m
+-872.000225351380 542.213019517769 l
+127.999774648620 128.000225351379 l
 h
-</path></group><group><use stroke="yellow" pos="173.255000000000 82.745200000000" name="mark/disk(sx)"/><path fill="yellow" opacity="10%">1128.000225351379 -2286.218265169573 m
-1128.000225351379 -286.210430677666 l
+</path></group><group><use stroke="orange" pos="128.000000000000 64.000000000000" name="mark/disk(sx)"/><path fill="orange" opacity="10%">-871.999951922500 -2286.207418497661 m
+1128.000225351379 -2286.218265169573 l
 128.000225351379 127.999774648620 l
+128.000048077500 127.999951922500 l
 h
-</path></group><group><use stroke="orange" pos="128.000000000000 192.000000000000" name="mark/disk(sx)"/><path fill="orange" opacity="10%">1128.000566767257 2542.244365113483 m
+</path></group><group><use stroke="gold" pos="128.000000000000 192.000000000000" name="mark/disk(sx)"/><path fill="gold" opacity="10%">1128.000566767257 2542.244365113483 m
 -872.000225351380 2542.233354185735 l
 127.999774648620 128.000225351379 l
 127.999951922500 128.000048077500 l
 128.000019914361 128.000019914361 l
 128.000566767257 128.000566767257 l
 h
-</path></group><group><use stroke="gold" pos="128.000000000000 64.000000000000" name="mark/disk(sx)"/><path fill="gold" opacity="10%">-871.999951922500 -2286.207418497661 m
-1128.000225351379 -2286.218265169573 l
+</path></group><group><use stroke="purple" pos="173.255000000000 82.745200000000" name="mark/disk(sx)"/><path fill="purple" opacity="10%">1128.000225351379 -2286.218265169573 m
+1128.000225351379 -286.210430677666 l
 128.000225351379 127.999774648620 l
-128.000048077500 127.999951922500 l
 h
-</path></group><group><use stroke="purple" pos="82.745200000000 173.255000000000" name="mark/disk(sx)"/><path fill="purple" opacity="10%">-872.000225351380 2542.233354185735 m
--872.000225351380 542.213019517769 l
-127.999774648620 128.000225351379 l
+</path></group><group><use stroke="gray" pos="173.255000000000 173.255000000000" name="mark/disk(sx)"/><path fill="gray" opacity="10%">1128.000566767257 542.208941532476 m
+1128.000566767257 2542.244365113483 l
+128.000566767257 128.000566767257 l
 h
-</path></group><group><use stroke="gray" pos="82.745200000000 82.745200000000" name="mark/disk(sx)"/><path fill="gray" opacity="10%">-872.000048077500 -286.214576669489 m
--871.999951922500 -2286.207418497661 l
-128.000048077500 127.999951922500 l
+</path></group><group><use stroke="brown" pos="192.000000000000 128.000000000000" name="mark/disk(sx)"/><path fill="brown" opacity="10%">1128.000225351379 -286.210430677666 m
+1128.000566767257 542.208941532476 l
+128.000566767257 128.000566767257 l
 128.000019914361 128.000019914361 l
-127.999951922500 128.000048077500 l
-h
-</path></group><group><use stroke="brown" pos="64.000000000000 128.000000000000" name="mark/disk(sx)"/><path fill="brown" opacity="10%">-872.000225351380 542.213019517769 m
--872.000048077500 -286.214576669489 l
-127.999951922500 128.000048077500 l
-127.999774648620 128.000225351379 l
+128.000048077500 127.999951922500 l
+128.000225351379 127.999774648620 l
 h
 </path></group></group><use stroke="red" pos="127.999774648620 128.000225351379" name="mark/disk(sx)"/><use stroke="red" pos="127.999951922500 128.000048077500" name="mark/disk(sx)"/><use stroke="red" pos="128.000019914361 128.000019914361" name="mark/disk(sx)"/><use stroke="red" pos="128.000048077500 127.999951922500" name="mark/disk(sx)"/><use stroke="red" pos="128.000225351379 127.999774648620" name="mark/disk(sx)"/><use stroke="red" pos="128.000566767257 128.000566767257" name="mark/disk(sx)"/></page></ipe>
diff --git a/hgeometry/data/test-with-ipe/Plane/LowerEnvelope/degenerate_out.ipe b/hgeometry/data/test-with-ipe/Plane/LowerEnvelope/degenerate_out.ipe
@@ -143,20 +143,20 @@
 <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 layer="alpha" stroke="black" size="normal" pos="64.000000000000 128.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="128.000000000000 128.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="128.000000000000 64.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="64.000000000000 64.000000000000" name="mark/disk(sx)"/></group><group><group><use stroke="green" pos="128.000000000000 128.000000000000" name="mark/disk(sx)"/><path fill="green" opacity="10%">1096.000000000000 96.000000000000 m
-96.000000000000 1096.000000000000 l
+</ipestyle><page><layer name="alpha"/><view layers="alpha" active="alpha"/><group><use layer="alpha" stroke="black" size="normal" pos="64.000000000000 128.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="128.000000000000 128.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="128.000000000000 64.000000000000" name="mark/disk(sx)"/><use stroke="black" size="normal" pos="64.000000000000 64.000000000000" name="mark/disk(sx)"/></group><group><group><use stroke="green" pos="64.000000000000 64.000000000000" name="mark/disk(sx)"/><path fill="green" opacity="10%">-904.000000000000 96.000000000000 m
+96.000000000000 -904.000000000000 l
 96.000000000000 96.000000000000 l
 h
-</path></group><group><use stroke="blue" pos="128.000000000000 64.000000000000" name="mark/disk(sx)"/><path fill="blue" opacity="10%">96.000000000000 -904.000000000000 m
-1096.000000000000 96.000000000000 l
+</path></group><group><use stroke="blue" pos="64.000000000000 128.000000000000" name="mark/disk(sx)"/><path fill="blue" opacity="10%">96.000000000000 1096.000000000000 m
+-904.000000000000 96.000000000000 l
 96.000000000000 96.000000000000 l
 h
-</path></group><group><use stroke="yellow" pos="64.000000000000 128.000000000000" name="mark/disk(sx)"/><path fill="yellow" opacity="10%">96.000000000000 1096.000000000000 m
--904.000000000000 96.000000000000 l
+</path></group><group><use stroke="yellow" pos="128.000000000000 64.000000000000" name="mark/disk(sx)"/><path fill="yellow" opacity="10%">96.000000000000 -904.000000000000 m
+1096.000000000000 96.000000000000 l
 96.000000000000 96.000000000000 l
 h
-</path></group><group><use stroke="orange" pos="64.000000000000 64.000000000000" name="mark/disk(sx)"/><path fill="orange" opacity="10%">-904.000000000000 96.000000000000 m
-96.000000000000 -904.000000000000 l
+</path></group><group><use stroke="orange" pos="128.000000000000 128.000000000000" name="mark/disk(sx)"/><path fill="orange" opacity="10%">1096.000000000000 96.000000000000 m
+96.000000000000 1096.000000000000 l
 96.000000000000 96.000000000000 l
 h
 </path></group></group><use stroke="red" pos="96.000000000000 96.000000000000" name="mark/disk(sx)"/></page></ipe>