{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Kernel.Instances
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Arbitrary instances for the types in hgeometry-kernel
--
--------------------------------------------------------------------------------
module HGeometry.Kernel.Instances where

import Control.Lens hiding (cons)
import Data.Maybe (catMaybes)
import Data.Semialign
import GHC.TypeLits
import HGeometry.Ball
import HGeometry.Disk
import HGeometry.Box
import HGeometry.Combinatorial.Instances ()
import HGeometry.HalfSpace
import HGeometry.HyperPlane (HyperPlane(..))
import HGeometry.HyperPlane.NonVertical (NonVerticalHyperPlane(..))
import HGeometry.Interval
import HGeometry.Interval.EndPoint ()
import HGeometry.Line.General
import HGeometry.HalfLine
import HGeometry.Line.LineEQ
import HGeometry.Line.PointAndVector
import HGeometry.LineSegment
import HGeometry.Matrix
import HGeometry.Point
import HGeometry.Point.Instances ()
import HGeometry.Properties
import HGeometry.Triangle
import HGeometry.Vector
import HGeometry.Vector.Instances ()
import Test.QuickCheck

--------------------------------------------------------------------------------

-- instance Arbitrary v => Arbitrary (PointF v) where
--   arbitrary = Point <$> arbitrary

instance Arbitrary r => Arbitrary (EndPoint ep r) where
  arbitrary :: Gen (EndPoint ep r)
arbitrary = r -> EndPoint ep r
forall (et :: EndPointType) r. r -> EndPoint et r
EndPoint (r -> EndPoint ep r) -> Gen r -> Gen (EndPoint ep r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen r
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: EndPoint ep r -> [EndPoint ep r]
shrink (EndPoint r
p) = r -> EndPoint ep r
forall (et :: EndPointType) r. r -> EndPoint et r
EndPoint (r -> EndPoint ep r) -> [r] -> [EndPoint ep r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> [r]
forall a. Arbitrary a => a -> [a]
shrink r
p

instance Arbitrary EndPointType where
  arbitrary :: Gen EndPointType
arbitrary = (\Bool
b -> if Bool
b then EndPointType
Open else EndPointType
Closed) (Bool -> EndPointType) -> Gen Bool -> Gen EndPointType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: EndPointType -> [EndPointType]
shrink = \case
    EndPointType
Open   -> [EndPointType
Closed]
    EndPointType
Closed -> []

instance Arbitrary r => Arbitrary (AnEndPoint r) where
  arbitrary :: Gen (AnEndPoint r)
arbitrary = EndPointType -> r -> AnEndPoint r
forall r. EndPointType -> r -> AnEndPoint r
AnEndPoint (EndPointType -> r -> AnEndPoint r)
-> Gen EndPointType -> Gen (r -> AnEndPoint r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen EndPointType
forall a. Arbitrary a => Gen a
arbitrary Gen (r -> AnEndPoint r) -> Gen r -> Gen (AnEndPoint r)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen r
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: AnEndPoint r -> [AnEndPoint r]
shrink = AnEndPoint r -> [AnEndPoint r]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance ( Arbitrary (endPoint r)
         , Eq (endPoint r), Ord r, IxValue (endPoint r) ~ r, EndPoint_ (endPoint r)
         ) => Arbitrary (Interval endPoint r) where
  arbitrary :: Gen (Interval endPoint r)
arbitrary = do p <- Gen (endPoint r)
forall a. Arbitrary a => Gen a
arbitrary
                 q <- arbitrary `suchThat` (isValidInterval p)
                 pure $ buildInterval p q
  shrink :: Interval endPoint r -> [Interval endPoint r]
shrink Interval endPoint r
i = [ StartPointOf (Interval endPoint r)
-> EndPointOf (Interval endPoint r) -> Interval endPoint r
forall interval point.
(ConstructableInterval_ interval point, Ord point,
 StartPointOf interval ~ EndPointOf interval) =>
StartPointOf interval -> EndPointOf interval -> interval
buildInterval endPoint r
StartPointOf (Interval endPoint r)
p endPoint r
EndPointOf (Interval endPoint r)
q
             | endPoint r
p <- endPoint r -> [endPoint r]
forall a. Arbitrary a => a -> [a]
shrink (endPoint r -> [endPoint r]) -> endPoint r -> [endPoint r]
forall a b. (a -> b) -> a -> b
$ Interval endPoint r
iInterval endPoint r
-> Getting (endPoint r) (Interval endPoint r) (endPoint r)
-> endPoint r
forall s a. s -> Getting a s a -> a
^.Getting (endPoint r) (Interval endPoint r) (endPoint r)
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
startPoint
             , endPoint r
q <- endPoint r -> [endPoint r]
forall a. Arbitrary a => a -> [a]
shrink (endPoint r -> [endPoint r]) -> endPoint r -> [endPoint r]
forall a b. (a -> b) -> a -> b
$ Interval endPoint r
iInterval endPoint r
-> Getting (endPoint r) (Interval endPoint r) (endPoint r)
-> endPoint r
forall s a. s -> Getting a s a -> a
^.Getting (endPoint r) (Interval endPoint r) (endPoint r)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
endPoint
             , endPoint r -> endPoint r -> Bool
forall (endPoint :: * -> *) r.
(Eq (endPoint r), Ord r, IxValue (endPoint r) ~ r,
 EndPoint_ (endPoint r)) =>
endPoint r -> endPoint r -> Bool
isValidInterval endPoint r
p endPoint r
q
             ]

isValidInterval     :: (Eq (endPoint r), Ord r, IxValue (endPoint r) ~ r, EndPoint_ (endPoint r))
                    => endPoint r -> endPoint r -> Bool
isValidInterval :: forall (endPoint :: * -> *) r.
(Eq (endPoint r), Ord r, IxValue (endPoint r) ~ r,
 EndPoint_ (endPoint r)) =>
endPoint r -> endPoint r -> Bool
isValidInterval endPoint r
p endPoint r
q = endPoint r
p endPoint r -> endPoint r -> Bool
forall a. Eq a => a -> a -> Bool
/= endPoint r
q Bool -> Bool -> Bool
&& ((endPoint r
pendPoint r -> Getting r (endPoint r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (endPoint r) r
(IxValue (endPoint r) -> Const r (IxValue (endPoint r)))
-> endPoint r -> Const r (endPoint r)
forall endPoint endPoint'.
IsEndPoint endPoint endPoint' =>
Lens endPoint endPoint' (IxValue endPoint) (IxValue endPoint')
Lens
  (endPoint r)
  (endPoint r)
  (IxValue (endPoint r))
  (IxValue (endPoint r))
_endPoint r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== endPoint r
qendPoint r -> Getting r (endPoint r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (endPoint r) r
(IxValue (endPoint r) -> Const r (IxValue (endPoint r)))
-> endPoint r -> Const r (endPoint r)
forall endPoint endPoint'.
IsEndPoint endPoint endPoint' =>
Lens endPoint endPoint' (IxValue endPoint) (IxValue endPoint')
Lens
  (endPoint r)
  (endPoint r)
  (IxValue (endPoint r))
  (IxValue (endPoint r))
_endPoint) Bool -> Bool -> Bool
`implies` endPoint r -> endPoint r -> Bool
forall {k} (endPoint :: k -> *) (r :: k).
EndPoint_ (endPoint r) =>
endPoint r -> endPoint r -> Bool
bothClosed endPoint r
p endPoint r
q)

bothClosed     :: EndPoint_ (endPoint r) => endPoint r -> endPoint r -> Bool
bothClosed :: forall {k} (endPoint :: k -> *) (r :: k).
EndPoint_ (endPoint r) =>
endPoint r -> endPoint r -> Bool
bothClosed endPoint r
p endPoint r
q = endPoint r -> EndPointType
forall endPoint. EndPoint_ endPoint => endPoint -> EndPointType
endPointType endPoint r
p EndPointType -> EndPointType -> Bool
forall a. Eq a => a -> a -> Bool
== EndPointType
Closed Bool -> Bool -> Bool
&& endPoint r -> EndPointType
forall endPoint. EndPoint_ endPoint => endPoint -> EndPointType
endPointType endPoint r
q EndPointType -> EndPointType -> Bool
forall a. Eq a => a -> a -> Bool
== EndPointType
Closed

implies :: Bool -> Bool -> Bool
implies :: Bool -> Bool -> Bool
implies Bool
p Bool
q = Bool -> Bool
not Bool
p Bool -> Bool -> Bool
|| Bool
q


instance ( Arbitrary point, Arbitrary (Vector (Dimension point) (NumType point))
         , Num (NumType point), Eq (Vector (Dimension point) (NumType point))
         , Has_ Additive_ (Dimension point) (NumType point)
         ) => Arbitrary (HalfLine point) where
  arbitrary :: Gen (HalfLine point)
arbitrary = point -> Vector (Dimension point) (NumType point) -> HalfLine point
forall point.
point -> Vector (Dimension point) (NumType point) -> HalfLine point
HalfLine (point
 -> Vector (Dimension point) (NumType point) -> HalfLine point)
-> Gen point
-> Gen (Vector (Dimension point) (NumType point) -> HalfLine point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen point
forall a. Arbitrary a => Gen a
arbitrary Gen (Vector (Dimension point) (NumType point) -> HalfLine point)
-> Gen (Vector (Dimension point) (NumType point))
-> Gen (HalfLine point)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Gen (Vector (Dimension point) (NumType point))
forall a. Arbitrary a => Gen a
arbitrary Gen (Vector (Dimension point) (NumType point))
-> (Vector (Dimension point) (NumType point) -> Bool)
-> Gen (Vector (Dimension point) (NumType point))
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Vector (Dimension point) (NumType point)
-> Vector (Dimension point) (NumType point) -> Bool
forall a. Eq a => a -> a -> Bool
/= Vector (Dimension point) (NumType point)
forall r vector (d :: Nat). (Num r, Additive_ vector d r) => vector
zero))

instance ( Arbitrary (endPoint point)
         , IsEndPoint (endPoint point) (endPoint point)
         , IxValue (endPoint point) ~ point
         , Eq point
         ) => Arbitrary (LineSegment endPoint point) where
  arbitrary :: Gen (LineSegment endPoint point)
arbitrary = do p <- Gen (endPoint point)
forall a. Arbitrary a => Gen a
arbitrary
                 q <- arbitrary `suchThat` (\endPoint point
q' -> endPoint point
q'endPoint point -> Getting point (endPoint point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (endPoint point) point
(IxValue (endPoint point)
 -> Const point (IxValue (endPoint point)))
-> endPoint point -> Const point (endPoint point)
forall endPoint endPoint'.
IsEndPoint endPoint endPoint' =>
Lens endPoint endPoint' (IxValue endPoint) (IxValue endPoint')
Lens
  (endPoint point)
  (endPoint point)
  (IxValue (endPoint point))
  (IxValue (endPoint point))
_endPoint point -> point -> Bool
forall a. Eq a => a -> a -> Bool
/= endPoint point
pendPoint point -> Getting point (endPoint point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (endPoint point) point
(IxValue (endPoint point)
 -> Const point (IxValue (endPoint point)))
-> endPoint point -> Const point (endPoint point)
forall endPoint endPoint'.
IsEndPoint endPoint endPoint' =>
Lens endPoint endPoint' (IxValue endPoint) (IxValue endPoint')
Lens
  (endPoint point)
  (endPoint point)
  (IxValue (endPoint point))
  (IxValue (endPoint point))
_endPoint)
                 pure $ LineSegment p q
  shrink :: LineSegment endPoint point -> [LineSegment endPoint point]
shrink LineSegment endPoint point
s = [ endPoint point -> endPoint point -> LineSegment endPoint point
forall (endPoint :: * -> *) point.
endPoint point -> endPoint point -> LineSegment endPoint point
LineSegment endPoint point
p endPoint point
q
             | endPoint point
p <- endPoint point -> [endPoint point]
forall a. Arbitrary a => a -> [a]
shrink (endPoint point -> [endPoint point])
-> endPoint point -> [endPoint point]
forall a b. (a -> b) -> a -> b
$ LineSegment endPoint point
sLineSegment endPoint point
-> Getting
     (endPoint point) (LineSegment endPoint point) (endPoint point)
-> endPoint point
forall s a. s -> Getting a s a -> a
^.Getting
  (endPoint point) (LineSegment endPoint point) (endPoint point)
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' (LineSegment endPoint point) (endPoint point)
startPoint
             , endPoint point
q <- endPoint point -> [endPoint point]
forall a. Arbitrary a => a -> [a]
shrink (endPoint point -> [endPoint point])
-> endPoint point -> [endPoint point]
forall a b. (a -> b) -> a -> b
$ LineSegment endPoint point
sLineSegment endPoint point
-> Getting
     (endPoint point) (LineSegment endPoint point) (endPoint point)
-> endPoint point
forall s a. s -> Getting a s a -> a
^.Getting
  (endPoint point) (LineSegment endPoint point) (endPoint point)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' (LineSegment endPoint point) (endPoint point)
endPoint
             , endPoint point
qendPoint point -> Getting point (endPoint point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (endPoint point) point
(IxValue (endPoint point)
 -> Const point (IxValue (endPoint point)))
-> endPoint point -> Const point (endPoint point)
forall endPoint endPoint'.
IsEndPoint endPoint endPoint' =>
Lens endPoint endPoint' (IxValue endPoint) (IxValue endPoint')
Lens
  (endPoint point)
  (endPoint point)
  (IxValue (endPoint point))
  (IxValue (endPoint point))
_endPoint point -> point -> Bool
forall a. Eq a => a -> a -> Bool
/= endPoint point
pendPoint point -> Getting point (endPoint point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (endPoint point) point
(IxValue (endPoint point)
 -> Const point (IxValue (endPoint point)))
-> endPoint point -> Const point (endPoint point)
forall endPoint endPoint'.
IsEndPoint endPoint endPoint' =>
Lens endPoint endPoint' (IxValue endPoint) (IxValue endPoint')
Lens
  (endPoint point)
  (endPoint point)
  (IxValue (endPoint point))
  (IxValue (endPoint point))
_endPoint
             ]

instance ( Arbitrary point
         , Arbitrary (NumType point)
         , Ord (NumType point)
         , Num (NumType point)
         ) => Arbitrary (Ball point) where
  arbitrary :: Gen (Ball point)
arbitrary = point -> NumType point -> Ball point
forall point. point -> NumType point -> Ball point
Ball (point -> NumType point -> Ball point)
-> Gen point -> Gen (NumType point -> Ball point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen point
forall a. Arbitrary a => Gen a
arbitrary
                   Gen (NumType point -> Ball point)
-> Gen (NumType point) -> Gen (Ball point)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Gen (NumType point)
forall a. Arbitrary a => Gen a
arbitrary Gen (NumType point)
-> (NumType point -> Bool) -> Gen (NumType point)
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (NumType point -> NumType point -> Bool
forall a. Ord a => a -> a -> Bool
> NumType point
0))
  shrink :: Ball point -> [Ball point]
shrink (Ball point
c NumType point
r) = [ point -> NumType point -> Ball point
forall point. point -> NumType point -> Ball point
Ball point
c' NumType point
r'
                      | point
c' <- point -> [point]
forall a. Arbitrary a => a -> [a]
shrink point
c
                      , NumType point
r' <- NumType point
1 NumType point -> [NumType point] -> [NumType point]
forall a. a -> [a] -> [a]
: NumType point -> [NumType point]
forall a. Arbitrary a => a -> [a]
shrink NumType point
r
                      , NumType point
r' NumType point -> NumType point -> Bool
forall a. Ord a => a -> a -> Bool
> NumType point
0
                      ]

instance (Arbitrary point, Eq point, ConstructablePoint_ point d r, Num r
         ) => Arbitrary (DiametralBall point) where
  arbitrary :: Gen (DiametralBall point)
arbitrary = do p <- Gen point
forall a. Arbitrary a => Gen a
arbitrary
                 q <- arbitrary `suchThat` (/= p)
                 pure $ DiametralPoints p q
  shrink :: DiametralBall point -> [DiametralBall point]
shrink (DiametralPoints point
p point
q) = [ point -> point -> DiametralBall point
forall point. point -> point -> DiametralBall point
DiametralPoints point
p' point
q'
                                 | point
p' <- point
forall point (d :: Nat) r.
(Num r, ConstructablePoint_ point d r) =>
point
origin point -> [point] -> [point]
forall a. a -> [a] -> [a]
: point -> [point]
forall a. Arbitrary a => a -> [a]
shrink point
p
                                 , point
q' <- point -> [point]
forall a. Arbitrary a => a -> [a]
shrink point
q
                                 , point
p' point -> point -> Bool
forall a. Eq a => a -> a -> Bool
/= point
q'
                                 ]

instance (Arbitrary point, Point_ point 2 r, Ord r, Num r
         ) => Arbitrary (BallByPoints' 3 point) where
  arbitrary :: Gen (BallByPoints' 3 point)
arbitrary = do mDisk <- point -> point -> point -> Maybe (BallByPoints' 3 point)
point -> point -> point -> Maybe (BallByPoints point)
forall point r.
(Point_ point 2 r, Ord r, Num r) =>
point -> point -> point -> Maybe (BallByPoints point)
diskFromPoints (point -> point -> point -> Maybe (BallByPoints' 3 point))
-> Gen point
-> Gen (point -> point -> Maybe (BallByPoints' 3 point))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen point
forall a. Arbitrary a => Gen a
arbitrary Gen (point -> point -> Maybe (BallByPoints' 3 point))
-> Gen point -> Gen (point -> Maybe (BallByPoints' 3 point))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen point
forall a. Arbitrary a => Gen a
arbitrary Gen (point -> Maybe (BallByPoints' 3 point))
-> Gen point -> Gen (Maybe (BallByPoints' 3 point))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen point
forall a. Arbitrary a => Gen a
arbitrary
                 case mDisk of
                   Just BallByPoints' 3 point
disk -> BallByPoints' 3 point -> Gen (BallByPoints' 3 point)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BallByPoints' 3 point
disk
                   Maybe (BallByPoints' 3 point)
Nothing   -> Gen (BallByPoints' 3 point)
forall a. Arbitrary a => Gen a
arbitrary

  shrink :: BallByPoints' 3 point -> [BallByPoints' 3 point]
shrink (BoundaryPoints (Vector3 point
a point
b point
c)) =
    [Maybe (BallByPoints' 3 point)] -> [BallByPoints' 3 point]
forall a. [Maybe a] -> [a]
catMaybes [ point -> point -> point -> Maybe (BallByPoints point)
forall point r.
(Point_ point 2 r, Ord r, Num r) =>
point -> point -> point -> Maybe (BallByPoints point)
diskFromPoints point
a' point
b' point
c'
              | point
a' <- point -> [point]
forall a. Arbitrary a => a -> [a]
shrink point
a, point
b' <- point -> [point]
forall a. Arbitrary a => a -> [a]
shrink point
b, point
c' <- point -> [point]
forall a. Arbitrary a => a -> [a]
shrink point
c
              ]

instance (Arbitrary point, ConstructablePoint_ point 2 r, Ord r, Num r, Eq point
         ) => Arbitrary (DiskByPoints point) where
  arbitrary :: Gen (DiskByPoints point)
arbitrary = [Gen (DiskByPoints point)] -> Gen (DiskByPoints point)
forall a. HasCallStack => [Gen a] -> Gen a
oneof [DiametralBall point -> DiskByPoints point
forall point. DiametralBall point -> DiskByPoints point
DiametralDisk (DiametralBall point -> DiskByPoints point)
-> Gen (DiametralBall point) -> Gen (DiskByPoints point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (DiametralBall point)
forall a. Arbitrary a => Gen a
arbitrary, BallByPoints' 3 point -> DiskByPoints point
forall point. BallByPoints' 3 point -> DiskByPoints point
DiskByPoints (BallByPoints' 3 point -> DiskByPoints point)
-> Gen (BallByPoints' 3 point) -> Gen (DiskByPoints point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (BallByPoints' 3 point)
forall a. Arbitrary a => Gen a
arbitrary]

instance ( Arbitrary point
         , Point_ point 2 r, Num r, Ord r
         , Eq point
         ) => Arbitrary (Triangle point) where
  arbitrary :: Gen (Triangle point)
arbitrary = do a <- Gen point
forall a. Arbitrary a => Gen a
arbitrary
                 b <- arbitrary `suchThat` (/= a)
                 c <- arbitrary `suchThat` (\point
c' -> point
c' point -> point -> Bool
forall a. Eq a => a -> a -> Bool
/= point
a Bool -> Bool -> Bool
&& point
c' point -> point -> Bool
forall a. Eq a => a -> a -> Bool
/= point
b Bool -> Bool -> Bool
&& point -> point -> point -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw point
a point
b point
c' CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
/= CCW
CoLinear)
                 pure $ Triangle a b c
  shrink :: Triangle point -> [Triangle point]
shrink (Triangle point
a point
b point
c) = [ point -> point -> point -> Triangle point
forall point. point -> point -> point -> Triangle point
Triangle point
a' point
b' point
c'
                            | point
a' <- point -> [point]
forall a. Arbitrary a => a -> [a]
shrink point
a
                            , point
b' <- point -> [point]
forall a. Arbitrary a => a -> [a]
shrink point
b
                            , point
c' <- point -> [point]
forall a. Arbitrary a => a -> [a]
shrink point
c
                            , point
b' point -> point -> Bool
forall a. Eq a => a -> a -> Bool
/= point
a', point
c' point -> point -> Bool
forall a. Eq a => a -> a -> Bool
/= point
a', point
c' point -> point -> Bool
forall a. Eq a => a -> a -> Bool
/= point
b', point -> point -> point -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw point
a' point
b' point
c' CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
/= CCW
CoLinear
                            ]

instance Arbitrary r => Arbitrary (LineEQ r) where
  arbitrary :: Gen (LineEQ r)
arbitrary = r -> r -> LineEQ r
forall r. r -> r -> LineEQ r
LineEQ (r -> r -> LineEQ r) -> Gen r -> Gen (r -> LineEQ r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen r
forall a. Arbitrary a => Gen a
arbitrary Gen (r -> LineEQ r) -> Gen r -> Gen (LineEQ r)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen r
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary r => Arbitrary (VerticalOrLineEQ r) where
  arbitrary :: Gen (VerticalOrLineEQ r)
arbitrary = [(Int, Gen (VerticalOrLineEQ r))] -> Gen (VerticalOrLineEQ r)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [ (Int
5,  r -> VerticalOrLineEQ r
forall r. r -> VerticalOrLineEQ r
VerticalLineThrough (r -> VerticalOrLineEQ r) -> Gen r -> Gen (VerticalOrLineEQ r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen r
forall a. Arbitrary a => Gen a
arbitrary)
                        , (Int
95, LineEQ r -> VerticalOrLineEQ r
forall r. LineEQ r -> VerticalOrLineEQ r
NonVertical (LineEQ r -> VerticalOrLineEQ r)
-> Gen (LineEQ r) -> Gen (VerticalOrLineEQ r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (LineEQ r)
forall a. Arbitrary a => Gen a
arbitrary)
                        ]


instance ( Arbitrary r
         , Has_ Additive_ d r
         , Eq (Vector d r), Num r
         , KnownNat d
         ) => Arbitrary (LinePV d r) where
  arbitrary :: Gen (LinePV d r)
arbitrary = Point d r -> Vector d r -> LinePV d r
forall (d :: Nat) r. Point d r -> Vector d r -> LinePV d r
LinePV (Point d r -> Vector d r -> LinePV d r)
-> Gen (Point d r) -> Gen (Vector d r -> LinePV d r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Point d r)
forall a. Arbitrary a => Gen a
arbitrary
                     Gen (Vector d r -> LinePV d r)
-> Gen (Vector d r) -> Gen (LinePV d r)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Gen (Vector d r)
forall a. Arbitrary a => Gen a
arbitrary Gen (Vector d r) -> (Vector d r -> Bool) -> Gen (Vector d r)
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Vector d r -> Vector d r -> Bool
forall a. Eq a => a -> a -> Bool
/= Vector d r
forall r vector (d :: Nat). (Num r, Additive_ vector d r) => vector
zero))


instance ( Arbitrary point
         , Arbitrary r
         , Point_ point d r
         , Num r
         , Ord r
         , Zip (Vector d)
         ) => Arbitrary (Box point) where
  arbitrary :: Gen (Box point)
arbitrary = (\point
p Vector d r
v -> point -> point -> Box point
forall point. point -> point -> Box point
Box point
p (point
p point -> Vector d r -> point
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ Vector d r
v)) (point -> Vector d r -> Box point)
-> Gen point -> Gen (Vector d r -> Box point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen point
forall a. Arbitrary a => Gen a
arbitrary
                                        Gen (Vector d r -> Box point)
-> Gen (Vector d r) -> Gen (Box point)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Vector d r)
forall a. Arbitrary a => Gen a
arbitrary Gen (Vector d r) -> (Vector d r -> Bool) -> Gen (Vector d r)
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Getting All (Vector d r) r -> (r -> Bool) -> Vector d r -> Bool
forall s a. Getting All s a -> (a -> Bool) -> s -> Bool
allOf Getting All (Vector d r) r
(IxValue (Vector d r) -> Const All (IxValue (Vector d r)))
-> Vector d r -> Const All (Vector d r)
forall vector vector'.
HasComponents vector vector' =>
IndexedTraversal1
  Int vector vector' (IxValue vector) (IxValue vector')
IndexedTraversal1
  Int
  (Vector d r)
  (Vector d r)
  (IxValue (Vector d r))
  (IxValue (Vector d r))
components (r -> r -> Bool
forall a. Ord a => a -> a -> Bool
> r
0))
  shrink :: Box point -> [Box point]
shrink Box point
b = [ point -> point -> Box point
forall point. point -> point -> Box point
Box point
p (point
p point -> Vector d r -> point
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ Vector d r
v)
             | point
p <- point -> [point]
forall a. Arbitrary a => a -> [a]
shrink (point -> [point]) -> point -> [point]
forall a b. (a -> b) -> a -> b
$ Box point
bBox point -> Getting point (Box point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (Box point) point
forall box point. HasMinPoint box point => Lens' box point
Lens' (Box point) point
minPoint
             , Vector d r
v <- Vector d r -> [Vector d r]
forall a. Arbitrary a => a -> [a]
shrink (Vector d r -> [Vector d r]) -> Vector d r -> [Vector d r]
forall a b. (a -> b) -> a -> b
$ Box point -> Vector d r
forall box (d :: Nat) point r.
(Box_ box point, Point_ point d r, Num r, Functor (Vector d)) =>
box -> Vector d r
size Box point
b
             , Getting All (Vector d r) r -> (r -> Bool) -> Vector d r -> Bool
forall s a. Getting All s a -> (a -> Bool) -> s -> Bool
allOf Getting All (Vector d r) r
(IxValue (Vector d r) -> Const All (IxValue (Vector d r)))
-> Vector d r -> Const All (Vector d r)
forall vector vector'.
HasComponents vector vector' =>
IndexedTraversal1
  Int vector vector' (IxValue vector) (IxValue vector')
IndexedTraversal1
  Int
  (Vector d r)
  (Vector d r)
  (IxValue (Vector d r))
  (IxValue (Vector d r))
components (r -> r -> Bool
forall a. Ord a => a -> a -> Bool
> r
0) Vector d r
v
             ]

instance ( Has_ Additive_ m r
         , Has_ Vector_ n (Vector m r)
         , Ixed (Vector n (Vector m r))
         , Ixed (Vector m r)
         , Arbitrary r
         ) =>
  Arbitrary (Matrix n m r) where
  arbitrary :: Gen (Matrix n m r)
arbitrary = (Vector n (Vector m r) -> Matrix n m r
forall rowVector.
Vector_ rowVector n (Vector m r) =>
rowVector -> Matrix n m r
forall matrix (n :: Nat) (m :: Nat) r rowVector.
(Matrix_ matrix n m r, Vector_ rowVector n (Vector m r)) =>
rowVector -> matrix
matrixFromRows :: Vector n (Vector m r) -> Matrix n m r)
           (Vector n (Vector m r) -> Matrix n m r)
-> Gen (Vector n (Vector m r)) -> Gen (Matrix n m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Vector n (Vector m r))
forall a. Arbitrary a => Gen a
arbitrary

instance ( Arbitrary r, Has_ Vector_ (d+1) r, Has_ Additive_ d r, d <= d+1
         , Num r, Eq (Vector d r)) => Arbitrary (HyperPlane d r) where
  arbitrary :: Gen (HyperPlane d r)
arbitrary = do a0                <- Gen r
forall a. Arbitrary a => Gen a
arbitrary
                 (a :: Vector d r) <- arbitrary `suchThat` (/= zero)
                 pure $ HyperPlane $ cons a0 a
  shrink :: HyperPlane d r -> [HyperPlane d r]
shrink (HyperPlane Vector (d + 1) r
u) = [ Vector (d + 1) r -> HyperPlane d r
forall (d :: Nat) r. Vector (d + 1) r -> HyperPlane d r
HyperPlane Vector (d + 1) r
u
                          | Vector (d + 1) r
v <- Vector (d + 1) r -> [Vector (d + 1) r]
forall a. Arbitrary a => a -> [a]
shrink Vector (d + 1) r
u, forall (i :: Nat) (d :: Nat) vector vector' r.
(i <= d, Vector_ vector d r, Vector_ vector' i r) =>
vector -> vector'
prefix @d @(d+1) @_ @(Vector d r) Vector (d + 1) r
v Vector d r -> Vector d r -> Bool
forall a. Eq a => a -> a -> Bool
/= Vector d r
forall r vector (d :: Nat). (Num r, Additive_ vector d r) => vector
zero
                          ]


instance (Arbitrary r, Has_ Additive_ d r
         , Num r, Eq (Vector d r)) => Arbitrary (NonVerticalHyperPlane d r) where
  arbitrary :: Gen (NonVerticalHyperPlane d r)
arbitrary = Vector d r -> NonVerticalHyperPlane d r
forall (d :: Nat) r. Vector d r -> NonVerticalHyperPlane d r
NonVerticalHyperPlane (Vector d r -> NonVerticalHyperPlane d r)
-> Gen (Vector d r) -> Gen (NonVerticalHyperPlane d r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Vector d r)
forall a. Arbitrary a => Gen a
arbitrary Gen (Vector d r) -> (Vector d r -> Bool) -> Gen (Vector d r)
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Vector d r -> Vector d r -> Bool
forall a. Eq a => a -> a -> Bool
/= Vector d r
forall r vector (d :: Nat). (Num r, Additive_ vector d r) => vector
zero)
  shrink :: NonVerticalHyperPlane d r -> [NonVerticalHyperPlane d r]
shrink (NonVerticalHyperPlane Vector d r
u) = [ Vector d r -> NonVerticalHyperPlane d r
forall (d :: Nat) r. Vector d r -> NonVerticalHyperPlane d r
NonVerticalHyperPlane Vector d r
u
                                     | Vector d r
v <- Vector d r -> [Vector d r]
forall a. Arbitrary a => a -> [a]
shrink Vector d r
u, Vector d r
v Vector d r -> Vector d r -> Bool
forall a. Eq a => a -> a -> Bool
/= Vector d r
forall r vector (d :: Nat). (Num r, Additive_ vector d r) => vector
zero
                                     ]

instance Arbitrary boundingHyperPlane => Arbitrary (HalfSpaceF boundingHyperPlane) where
  arbitrary :: Gen (HalfSpaceF boundingHyperPlane)
arbitrary = Sign -> boundingHyperPlane -> HalfSpaceF boundingHyperPlane
forall boundingHyperPlane.
Sign -> boundingHyperPlane -> HalfSpaceF boundingHyperPlane
HalfSpace (Sign -> boundingHyperPlane -> HalfSpaceF boundingHyperPlane)
-> Gen Sign
-> Gen (boundingHyperPlane -> HalfSpaceF boundingHyperPlane)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Sign
forall a. Arbitrary a => Gen a
arbitrary Gen (boundingHyperPlane -> HalfSpaceF boundingHyperPlane)
-> Gen boundingHyperPlane -> Gen (HalfSpaceF boundingHyperPlane)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen boundingHyperPlane
forall a. Arbitrary a => Gen a
arbitrary