more tests / fixes in generalEq :)

hgeometry-combinatorial/src/HGeometry/Sequence/Alternating.hs

@@ -11,6 +11,7 @@
 --------------------------------------------------------------------------------
 module HGeometry.Sequence.Alternating
   ( Alternating(..)
+  , fromNonEmptyWith
   , mapF
   , withNeighbours
   , mergeAlternating
@@ -32,6 +33,7 @@ import           Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NonEmpty
 import           Data.Semigroup.Traversable
 import           GHC.Generics (Generic)
+import           HGeometry.Foldable.Util
 import           Prelude hiding (reverse)
 
 --------------------------------------------------------------------------------
@@ -71,6 +73,13 @@ instance Foldable f => Bifoldable (Alternating f) where
 instance Traversable f => Bitraversable (Alternating f) where
   bitraverse f g (Alternating x xs) = Alternating <$> g x <*> traverse (bitraverse f g) xs
 
+
+-- | Given a separator, and some foldable structure, constructs an Alternating.
+fromNonEmptyWith        :: (HasFromFoldable g, Foldable1 f) => sep -> f a -> Alternating g sep a
+fromNonEmptyWith sep xs = let (x0 :| xs') = toNonEmpty xs
+                          in Alternating x0 $ fromList (map (sep,) xs')
+
+
 -- | map some function changing the f into a g.
 mapF                      :: (f (sep, a) -> g (sep', a))
                           -> Alternating f sep a -> Alternating g sep' a
@@ -139,6 +148,11 @@ reverse p@(Alternating s xs) = case NonEmpty.nonEmpty xs of
 -- | Given a function f that takes the (current) last element x, and the new element y,
 -- and computes the new separating element s, snocs the separator and y onto the
 -- alternating list.
+--
+-- >>> snocElemWith (\_ _ -> ".") (fromNonEmptyWith @[] "," (NonEmpty.fromList [1..5])) 6
+-- Alternating 1 [(",",2),(",",3),(",",4),(",",5),(".",6)]
+-- >>> snocElemWith (\_ _ -> ".") (fromNonEmptyWith @[] "," (NonEmpty.fromList [1])) 6
+-- Alternating 1 [(".",6)]
 snocElemWith                         :: Snoc (f (sep,a)) (f (sep,a)) (sep,a) (sep,a)
                                      => (a -> a -> sep)
                                      -> Alternating f sep a -> a -> Alternating f sep a

hgeometry/hgeometry.cabal

@@ -599,6 +599,7 @@ test-suite kernel-hspec
       Spec
       Point2Spec
       HGeometry.Line.PointAndVectorSpec
+      HGeometry.Line.GeneralSpec
       HGeometry.LineSegmentSpec
       HGeometry.BallSpec
       HGeometry.BoxSpec

hgeometry/kernel/src/HGeometry/Line/General.hs

@@ -60,8 +60,8 @@ instance HyperPlane_ (VerticalOrLineEQ r) 2 r where
 
 instance (Fractional r, Eq r) => ConstructableHyperPlane_ (VerticalOrLineEQ r) 2 r where
   type HyperPlaneFromEquationConstraint (VerticalOrLineEQ r) 2 r = ()
-  hyperPlaneFromEquation v@(Vector3 c _ b)
-    | b == 0    = VerticalLineThrough (-c)
+  hyperPlaneFromEquation v@(Vector3 a b c)
+    | b == 0    = VerticalLineThrough ((-c)/a)
     | otherwise = NonVertical $ hyperPlaneFromEquation v
 
 

hgeometry/kernel/test/HGeometry/Line/GeneralSpec.hs

@@ -0,0 +1,28 @@
+module HGeometry.Line.GeneralSpec
+  (spec
+  ) where
+
+import HGeometry.HyperPlane.Class
+import HGeometry.Kernel.Instances ()
+import HGeometry.Line.General
+import HGeometry.Number.Real.Rational (RealNumber)
+import HGeometry.Vector
+import Test.Hspec
+
+--------------------------------------------------------------------------------
+
+type R = RealNumber 5
+
+spec :: Spec
+spec = do
+  describe "Line General Form" $ do
+    it "should be vertical" $ do
+      let l = VerticalLineThrough 5
+      asGeneralLine l `shouldBe` l
+    it "hyperPlaneEq vertical line" $
+      hyperPlaneEquation (VerticalLineThrough 5) `shouldBe` (Vector3 1 0 (-5))
+
+
+asGeneralLine :: HyperPlane_ hyperPlane 2 R
+              => hyperPlane -> VerticalOrLineEQ R
+asGeneralLine = hyperPlaneFromEquation . hyperPlaneEquation

hgeometry/src/HGeometry/HalfPlane/CommonIntersection.hs

@@ -28,6 +28,7 @@ import           HGeometry.Polygon.Convex
 import           HGeometry.Sequence.Alternating
 import           HGeometry.Vector
 
+import Debug.Trace
 --------------------------------------------------------------------------------
 
 -- | Common intersection of a bunch of halfplanes
@@ -73,6 +74,7 @@ commonIntersection     :: ( Foldable1 f, Functor f
                           , Fractional r, Ord r
 
                           , Default (LineEQ r :+ halfPlane), Default halfPlane -- FIXME
+                          , Show halfPlane, Show r
                           )
                        => f halfPlane -> CommonIntersection halfPlane r
 commonIntersection hs0 = case partitionEithersNE . fmap classifyHalfPlane $ toNonEmpty hs0 of
@@ -132,9 +134,12 @@ lowerBoundary = undefined
 upperBoundary     :: ( HalfPlane_ halfPlane r
                      , Foldable1 f, Fractional r, Ord r
                      , Default (LineEQ r :+ halfPlane), Default halfPlane -- FIXME
+
+                     , Show halfPlane, Show r
                      )
                   => f halfPlane -> Chain Seq halfPlane r
-upperBoundary hs0 = Chain $ case partitionEithersNE . fmap classifyHalfPlane $ toNonEmpty hs0 of
+upperBoundary hs0 = Chain $ case traceShowWith ("partitioning",) $
+  partitionEithersNE . fmap classifyHalfPlane $ toNonEmpty hs0 of
     This onlyVerticals           -> let (_ :+ h) = leftMostPlane onlyVerticals
                                     in Alternating h mempty
     That onlyNonVerticals        -> let env = view extra <$> lowerEnvelope' onlyNonVerticals
@@ -143,15 +148,18 @@ upperBoundary hs0 = Chain $ case partitionEithersNE . fmap classifyHalfPlane $ t
                                         env         = clipRight maxX $ lowerEnvelope' nonVerticals
                                         -- we clip the env at the leftmost vertical plane, throwing
                                         -- away any vertices whose x-coord is at most maxX
-                                        alt         = snocElemWith (intersectVertical maxX)
+                                        alt         = traceShowWith ("alt",env,) $
+                                                      snocElemWith (intersectVertical maxX)
                                                                    (env^._Alternating)
-                                                                   (undefined :+ h)
+                                                                   (dummy :+ h)
                                         -- we snoc the new element onto the alternating list.
-                                        -- we use undefined to create a dummy non-vertical
+                                        -- we create a dummy non-vertical
                                         -- line (that we will next immediately) throw away
                                         -- anyway
                                     in view extra <$> alt
   where
+    dummy = LineEQ 0 0
+
     classifyHalfPlane h = case h^.boundingHyperPlane.to asGeneralLine of
       VerticalLineThrough x -> Left  (x :+ h)
       NonVertical l         -> Right (l :+ h)

hgeometry/test-with-ipe/test/HalfPlane/CommonIntersectionSpec.hs

@@ -44,12 +44,14 @@ myHalfPlanes :: NonEmpty (HalfPlane R)
 myHalfPlanes = NonEmpty.fromList
                [ below $ LineEQ 1    1
                , below $ LineEQ (-1) 2
+               , leftOf $ 10
                ]
 
 theAnswer :: CommonIntersection (HalfPlane R) R
 theAnswer = Unbounded . Chain
           $ Alternating (myHalfPlanes NonEmpty.!! 0)
                         (Seq.fromList $ [ (Point2 (1/2) (3/2), myHalfPlanes NonEmpty.!! 1)
+                                        , (Point2 10    (-8),  myHalfPlanes NonEmpty.!! 2)
                                         ]
                         )