cleaning up things

hgeometry/hgeometry.cabal

@@ -29,8 +29,7 @@ data-files:
     test-with-ipe/**/*.ipe
 
 tested-with:
-    GHC == 9.6.5
-  , GHC == 9.8.2
+    GHC == 9.8.2
   , GHC == 9.10.1
 
 source-repository head

hgeometry/src/HGeometry/Plane/LowerEnvelope/BatchedPointLoc.hs

@@ -1,16 +1,17 @@
 module HGeometry.LowerEnvelope.BatchedPointLoc
-  ( batchedPointLocation
+  ( -- batchedPointLocation
   ) where
 
 import           Control.Lens
 import qualified Data.Vector as Boxed
 import           HGeometry.Interval
 import           HGeometry.Line
 import           HGeometry.Line.LineEQ
-import           HGeometry.LowerEnvelope.Type
+-- import           HGeometry.LowerEnvelope.Type
 import           HGeometry.Point
 
 --------------------------------------------------------------------------------
+{-
 
 -- | Given a set of n query points and a set of r planes, computes
 -- an output array A of the planes, and for each query point q an interval [i,j] so that
@@ -38,3 +39,4 @@ batchedPointLocation2 :: f (Point 2 r) -> g (LineEQ r) -> ( Boxed.Vector (LineEQ
                                                         )
 batchedPointLocation2 = undefined
 -- use some sweepline here. so maybe don't report them as a vector
+-}

hgeometry/src/HGeometry/Plane/LowerEnvelope/Connected/Regions.hs

@@ -28,6 +28,8 @@ module HGeometry.Plane.LowerEnvelope.Connected.Regions
   , intersectionPoint
   , intersectionLine
 
+
+  , toPlaneGraph
   ) where
 
 import           Control.Lens
@@ -38,6 +40,7 @@ import qualified Data.List.NonEmpty as NonEmpty
 import           Data.Map (Map)
 import qualified Data.Map as Map
 import           Data.Maybe (fromMaybe, listToMaybe)
+import           Data.Semigroup (First(..))
 -- import           Data.Sequence (Seq)
 -- import qualified Data.Sequence as Seq
 import           Data.Set (Set)
@@ -460,7 +463,7 @@ unionsWithKey   :: (Foldable f, Ord k) => (k -> a-> a ->a) -> f (Map k a) -> Map
 unionsWithKey f = F.foldl' (Map.unionWithKey f) Map.empty
 
 -- | Merge the maps. When they share a key, combine their values using a semigroup.
-mapWithKeyMerge   :: (Ord k, Ord k', Semigroup v')
+mapWithKeyMerge   :: (Ord k', Semigroup v')
                   => (k -> v -> Map k' v') -> Map k v -> Map k' v'
 mapWithKeyMerge f = getMap . Map.foldMapWithKey (\k v -> MonoidalMap $ f k v)
 
@@ -474,3 +477,59 @@ instance (Ord k, Semigroup v) => Semigroup (MonoidalMap k v) where
 
 instance (Ord k, Semigroup v) => Monoid (MonoidalMap k v) where
   mempty = MonoidalMap mempty
+
+
+--------------------------------------------------------------------------------
+
+-- -- | Triangulate the regions. Note that unbounded regions are somewhat weird now
+-- triangulate        :: Region r plane -> [Region r plane]
+-- triangulate region = case region of
+--   Bounded vertices       -> case vertices of
+--     (v0:v1:vs) -> zipWith (\u v -> Bounded [v0,u,v]) (v1:vs) vs
+--     _          -> error "triangulate: absurd, <2 vertices"
+--   Unbounded v vertices w -> case vertices of
+--     [_]        -> [region]
+--     [_,_]      -> [region]
+--     (v0:v1:vs) -> let w = List.last vs
+--                   in Unbounded v [v0,w] vs : zipWith (\u v -> Bounded [v0,u,v]) (v1:vs) vs
+
+
+-- | A Plane graph storing vertices of type v that are identified by keys of type k, and
+-- some ordered sequence of edges (which are ordered using e).
+type PlaneGraph k v e = Map k (Map e k, v)
+
+newtype E r = E (Vector 2 r)
+  deriving newtype (Show)
+
+instance (Ord r, Num r) => Eq (E r) where
+  a == b = a `compare` b == EQ
+instance (Ord r, Num r) => Ord (E r) where
+  (E v) `compare` (E u) = ccwCmpAroundWith (Vector2 0 1) origin (Point v) (Point u)
+
+-- | Produce a triangulated plane graph on the bounded vertices.  every vertex is
+-- represented by its point, it stores a list of its outgoing edges, and some data.
+toPlaneGraph :: (Plane_ plane r, Num r, Ord r)
+             => MinimizationDiagram r plane -> PlaneGraph (Point 2 r) (First r) (E r)
+toPlaneGraph = mapWithKeyMerge toTriangulatedGr
+
+toTriangulatedGr   :: (Plane_ plane r, Num r, Ord r)
+                   => plane -> Region r (Point 2 r)
+                   -> PlaneGraph (Point 2 r) (First r) (E r)
+toTriangulatedGr h = Map.mapWithKey (\v adjs -> (adjs, First $ evalAt v h)) . \case
+  Bounded vertices       -> case vertices of
+    (v0:v1:vs) -> triangulate v0 v1 vs
+    _          -> error "triangulate: absurd, <2 vertices"
+  Unbounded _ vertices _ -> case vertices of
+    _  :| []     -> Map.empty
+    u  :| [v]    -> Map.fromList [ (u, (uncurry Map.singleton $ edge u v))
+                                 , (v, (uncurry Map.singleton $ edge v u))
+                                 ]
+    v0 :|(v1:vs) -> triangulate v0 v1 vs
+  where
+    triangulate v0 v1 vs = Map.unionsWith (<>) $ zipWith (triangle v0) (v1:vs) vs
+
+    triangle u v w = Map.fromList [ (u, Map.fromList [ edge u v, edge u w])
+                                  , (v, Map.fromList [ edge v u, edge v w])
+                                  , (w, Map.fromList [ edge w u, edge w v])
+                                  ]
+    edge u v = ((E $ v .-. u), v)