more fiddling

.github/workflows/gh-pages.yml

@@ -175,6 +175,8 @@ jobs:
           # $CABAL haddock-project
         env:
           HCVER: ${{ matrix.compilerVersion }}
+        with:
+          path: ~/.ghcup/bin
       - name: haddock-badge
         run: |
           grep ") in " haddock.raw.txt | sort -hr > haddock.txt

hgeometry-combinatorial/hgeometry-combinatorial.cabal

@@ -54,6 +54,7 @@ common setup
       , file-io                  >= 0.1         && < 1
       , text                     >= 2           &&  < 3
       , bytestring               >= 0.10        &&  < 1
+      , indexed-traversable      >= 0.1.3       && < 1
 
       -- , witherable              >= 0.4
       -- , linear                  >= 1.21

hgeometry-combinatorial/src/HGeometry/Vector/NonEmpty/Util.hs

@@ -18,8 +18,11 @@ module HGeometry.Vector.NonEmpty.Util
 
 import           Control.Lens
 import qualified Data.Foldable as F
+import           Data.Foldable1
+import           Data.Foldable1.WithIndex
 import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Vector as Vector
+import qualified Data.Vector.NonEmpty as NonEmptyV
 import           Data.Vector.NonEmpty.Internal (NonEmptyVector(..))
 
 --------------------------------------------------------------------------------
@@ -32,6 +35,15 @@ instance Ixed (NonEmptyVector a) where
   ix i f (NonEmptyVector v) = NonEmptyVector <$> ix i f v
   {-# INLINE ix #-}
 
+
+instance Foldable1WithIndex Int NonEmptyVector where
+  ifoldMap1 f = fold1 . NonEmptyV.imap f
+  {-# INLINE ifoldMap1 #-}
+-- -- | ifoldMap1. This will appear in indexedtraversal as of next release
+-- ifoldMap1   :: Semigroup m => (Int -> a -> m) -> NonEmptyV.NonEmptyVector a -> m
+
+
+
 -- instance Foldable1 NonEmptyVector where
 --   foldMap1 f v = let (v',x) = NV.unsnoc v
 --                  in Vector.foldr (\x' a -> f x' <> a) (f x) v'

hgeometry/hgeometry.cabal

@@ -67,6 +67,7 @@ common all-setup
       , reflection                >= 2.1.7         && < 3
       , filepath                  >= 1.4.100       && < 2
       , file-io                   >= 0.1           && < 1
+      , indexed-traversable       >= 0.1.3         && < 1
 
       , ghc-typelits-natnormalise >= 0.7.7         && < 1
       , ghc-typelits-knownnat     >= 0.7.6         && < 1

hgeometry/kernel/src/HGeometry/Box.hs

@@ -20,7 +20,11 @@ module HGeometry.Box
   ) where
 
 import Control.Lens
+import Data.Coerce
+import Data.Foldable1
+import Data.List.NonEmpty (NonEmpty(..))
 import Data.Maybe (isJust)
+import HGeometry.Boundary
 import HGeometry.Box.Boxable
 import HGeometry.Box.Class
 import HGeometry.Box.Corners
@@ -164,3 +168,50 @@ type instance Intersection (Box point) (Box point) =
 --         ClosedInterval_x_ClosedInterval_Point x     -> ClosedInterval x x
 --         ClosedInterval_x_ClosedInterval_Contained i -> i
 --         ClosedInterval_x_ClosedInterval_Partial i   -> i
+
+
+
+--------------------------------------------------------------------------------
+-- * Intersection with a line
+
+
+-- instance (Ord r, Num r, Point_ point 2 r
+--          ) => LinePV 2 p `HasIntersectionWith` Rectangle point where
+--   l `intersects` r = notAllTheSame (onSide l) $ corners r
+--   {-# INLINE intersects #-}
+
+-- instance (Ord r, Num r, Point_ point 2 r
+--          ) => LineEQ r `HasIntersectionWith` Rectangle point where
+--   l `intersects` r = notAllTheSame (onSide l) $ corners r
+--   {-# INLINE intersects #-}
+
+-- instance (Ord r, Num r, Point_ point 2 r
+--          ) => LinePV 2 p `HasIntersectionWith` Boundary (Rectangle point) where
+--   l `intersects` br = l `intersects` (coerce br :: Rectangle point)
+--   {-# INLINE intersects #-}
+
+-- instance (Ord r, Num r, Point_ point 2 r
+--          ) => LineEQ r `HasIntersectionWith` Boundary (Rectangle point) where
+--   l `intersects` br = l `intersects` (coerce br :: Rectangle point)
+--   {-# INLINE intersects #-}
+
+
+
+-- type instance Intersection (LinePV 2 r) (Rectangle point) =
+--   Maybe (ClosedLineSegment (Point 2 r))
+
+-- type instance Intersection (LineEQ r) (Rectangle point) =
+--   Maybe (ClosedLineSegment (Point 2 r))
+
+
+-- instance (Ord r, Fractional r, Point_ point 2 r) => LinePV 2 p `IsIntersectableWith` Rectangle point where
+--   l `intersect` r = undefined
+
+-- instance (Ord r, Fractional r, Point_ point 2 r) => LineEQ r `IsIntersectableWith` Rectangle point where
+--   l `intersect` r = undefined
+
+-- -- | Verify that not all entries are the same.
+-- notAllTheSame      :: (Foldable1 f, Eq b) => (a -> b) -> f b -> Bool
+-- notAllTheSame f xs = let y :| ys = toNonEmpty xs
+--                          z       = f x
+--                      in any (\y' -> f y' /= z) xs

hgeometry/src/HGeometry/LowerEnvelope/AdjListForm.hs

@@ -34,6 +34,7 @@ import           Control.Applicative
 import           Control.Lens
 import qualified Data.Foldable as F
 import           Data.Foldable1
+import           Data.Foldable1.WithIndex
 import           Data.Function (on)
 import qualified Data.List as List
 import           Data.List.NonEmpty (NonEmpty(..))
@@ -641,12 +642,3 @@ maxBy         :: (t -> t -> Ordering) -> t -> t -> t
 maxBy cmp a b = case cmp a b of
                   LT -> b
                   _  -> a
-
-
---------------------------------------------------------------------------------
-
--- | ifoldMap1. This will appear in indexedtraversal as of next release
-ifoldMap1   :: Semigroup m => (Int -> a -> m) -> NonEmptyV.NonEmptyVector a -> m
-ifoldMap1 f = fold1 . NonEmptyV.imap f
-
---------------------------------------------------------------------------------

hgeometry/src/HGeometry/VoronoiDiagram.hs

@@ -9,7 +9,9 @@
 --
 --------------------------------------------------------------------------------
 module HGeometry.VoronoiDiagram
-  ( voronoiVertices
+  ( VoronoiDiagram(..)
+  , voronoiDiagram
+  , voronoiVertices
   ) where
 
 import HGeometry.VoronoiDiagram.ViaLowerEnvelope

hgeometry/src/HGeometry/VoronoiDiagram/ViaLowerEnvelope.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE UndecidableInstances #-}
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  HGeometry.VoronoiDiagram.ViaLowerEnvelope
@@ -10,7 +11,9 @@
 --
 --------------------------------------------------------------------------------
 module HGeometry.VoronoiDiagram.ViaLowerEnvelope
-  ( voronoiVertices
+  ( VoronoiDiagram(..)
+  , voronoiDiagram
+  , voronoiVertices
   ) where
 
 import           Control.Lens
@@ -30,9 +33,25 @@ import           Hiraffe.Graph
 
 --------------------------------------------------------------------------------
 
-type VoronoiDiagram point = LowerEnvelope (Plane (NumType point) :+ point)
+newtype VoronoiDiagram point =
+  VoronoiDiagram (LowerEnvelope (Plane (NumType point) :+ point))
 
+deriving instance (Show point, Show (NumType point)) => Show (VoronoiDiagram point)
+deriving instance (Eq point, Eq (NumType point))     => Eq   (VoronoiDiagram point)
 
+--------------------------------------------------------------------------------
+
+-- | Computes the Voronoi Diagram, by lifting the points to planes, and computing
+-- the lower envelope of these planes.
+--
+-- \(O(n\log n)\)
+voronoiDiagram :: ( Point_ point 2 r, Functor f, Default point, Ord point
+                   , Ord r, Fractional r, Foldable f
+                   ) => f point -> VoronoiDiagram point
+voronoiDiagram = VoronoiDiagram
+               . fromVertexForm
+               . upperEnvelopeVertexForm
+               . fmap (\p -> liftPointToPlane p :+ p)
 
 -- | Computes all voronoi vertices
 voronoiVertices :: ( Point_ point 2 r, Functor f, Default point, Ord point