--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Ball.Diametral
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- A ball represented by its two diametral points
--
--------------------------------------------------------------------------------
{-# LANGUAGE UndecidableInstances #-}
module HGeometry.Ball.Diametral
  ( DiametralBall(MkDiametralBall,DiametralPoints)
  ) where

import Control.Lens
import Data.Foldable1
import HGeometry.Ball.Class
import HGeometry.Boundary
import HGeometry.Point
import HGeometry.Properties
import HGeometry.Vector
import HGeometry.Intersection

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

-- | A ball defined by its two diametral points
newtype DiametralBall point = MkDiametralBall (Vector 2 point)
                            deriving stock (Int -> DiametralBall point -> ShowS
[DiametralBall point] -> ShowS
DiametralBall point -> String
(Int -> DiametralBall point -> ShowS)
-> (DiametralBall point -> String)
-> ([DiametralBall point] -> ShowS)
-> Show (DiametralBall point)
forall point. Show point => Int -> DiametralBall point -> ShowS
forall point. Show point => [DiametralBall point] -> ShowS
forall point. Show point => DiametralBall point -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall point. Show point => Int -> DiametralBall point -> ShowS
showsPrec :: Int -> DiametralBall point -> ShowS
$cshow :: forall point. Show point => DiametralBall point -> String
show :: DiametralBall point -> String
$cshowList :: forall point. Show point => [DiametralBall point] -> ShowS
showList :: [DiametralBall point] -> ShowS
Show,DiametralBall point -> DiametralBall point -> Bool
(DiametralBall point -> DiametralBall point -> Bool)
-> (DiametralBall point -> DiametralBall point -> Bool)
-> Eq (DiametralBall point)
forall point.
Eq point =>
DiametralBall point -> DiametralBall point -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall point.
Eq point =>
DiametralBall point -> DiametralBall point -> Bool
== :: DiametralBall point -> DiametralBall point -> Bool
$c/= :: forall point.
Eq point =>
DiametralBall point -> DiametralBall point -> Bool
/= :: DiametralBall point -> DiametralBall point -> Bool
Eq,(forall a b. (a -> b) -> DiametralBall a -> DiametralBall b)
-> (forall a b. a -> DiametralBall b -> DiametralBall a)
-> Functor DiametralBall
forall a b. a -> DiametralBall b -> DiametralBall a
forall a b. (a -> b) -> DiametralBall a -> DiametralBall b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> DiametralBall a -> DiametralBall b
fmap :: forall a b. (a -> b) -> DiametralBall a -> DiametralBall b
$c<$ :: forall a b. a -> DiametralBall b -> DiametralBall a
<$ :: forall a b. a -> DiametralBall b -> DiametralBall a
Functor,(forall m. Monoid m => DiametralBall m -> m)
-> (forall m a. Monoid m => (a -> m) -> DiametralBall a -> m)
-> (forall m a. Monoid m => (a -> m) -> DiametralBall a -> m)
-> (forall a b. (a -> b -> b) -> b -> DiametralBall a -> b)
-> (forall a b. (a -> b -> b) -> b -> DiametralBall a -> b)
-> (forall b a. (b -> a -> b) -> b -> DiametralBall a -> b)
-> (forall b a. (b -> a -> b) -> b -> DiametralBall a -> b)
-> (forall a. (a -> a -> a) -> DiametralBall a -> a)
-> (forall a. (a -> a -> a) -> DiametralBall a -> a)
-> (forall a. DiametralBall a -> [a])
-> (forall a. DiametralBall a -> Bool)
-> (forall a. DiametralBall a -> Int)
-> (forall a. Eq a => a -> DiametralBall a -> Bool)
-> (forall a. Ord a => DiametralBall a -> a)
-> (forall a. Ord a => DiametralBall a -> a)
-> (forall a. Num a => DiametralBall a -> a)
-> (forall a. Num a => DiametralBall a -> a)
-> Foldable DiametralBall
forall a. Eq a => a -> DiametralBall a -> Bool
forall a. Num a => DiametralBall a -> a
forall a. Ord a => DiametralBall a -> a
forall m. Monoid m => DiametralBall m -> m
forall a. DiametralBall a -> Bool
forall a. DiametralBall a -> Int
forall a. DiametralBall a -> [a]
forall a. (a -> a -> a) -> DiametralBall a -> a
forall m a. Monoid m => (a -> m) -> DiametralBall a -> m
forall b a. (b -> a -> b) -> b -> DiametralBall a -> b
forall a b. (a -> b -> b) -> b -> DiametralBall a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => DiametralBall m -> m
fold :: forall m. Monoid m => DiametralBall m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> DiametralBall a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> DiametralBall a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> DiametralBall a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> DiametralBall a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> DiametralBall a -> b
foldr :: forall a b. (a -> b -> b) -> b -> DiametralBall a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> DiametralBall a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> DiametralBall a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> DiametralBall a -> b
foldl :: forall b a. (b -> a -> b) -> b -> DiametralBall a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> DiametralBall a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> DiametralBall a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> DiametralBall a -> a
foldr1 :: forall a. (a -> a -> a) -> DiametralBall a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> DiametralBall a -> a
foldl1 :: forall a. (a -> a -> a) -> DiametralBall a -> a
$ctoList :: forall a. DiametralBall a -> [a]
toList :: forall a. DiametralBall a -> [a]
$cnull :: forall a. DiametralBall a -> Bool
null :: forall a. DiametralBall a -> Bool
$clength :: forall a. DiametralBall a -> Int
length :: forall a. DiametralBall a -> Int
$celem :: forall a. Eq a => a -> DiametralBall a -> Bool
elem :: forall a. Eq a => a -> DiametralBall a -> Bool
$cmaximum :: forall a. Ord a => DiametralBall a -> a
maximum :: forall a. Ord a => DiametralBall a -> a
$cminimum :: forall a. Ord a => DiametralBall a -> a
minimum :: forall a. Ord a => DiametralBall a -> a
$csum :: forall a. Num a => DiametralBall a -> a
sum :: forall a. Num a => DiametralBall a -> a
$cproduct :: forall a. Num a => DiametralBall a -> a
product :: forall a. Num a => DiametralBall a -> a
Foldable,Functor DiametralBall
Foldable DiametralBall
(Functor DiametralBall, Foldable DiametralBall) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> DiametralBall a -> f (DiametralBall b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    DiametralBall (f a) -> f (DiametralBall a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> DiametralBall a -> m (DiametralBall b))
-> (forall (m :: * -> *) a.
    Monad m =>
    DiametralBall (m a) -> m (DiametralBall a))
-> Traversable DiametralBall
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
DiametralBall (m a) -> m (DiametralBall a)
forall (f :: * -> *) a.
Applicative f =>
DiametralBall (f a) -> f (DiametralBall a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DiametralBall a -> m (DiametralBall b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DiametralBall a -> f (DiametralBall b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DiametralBall a -> f (DiametralBall b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DiametralBall a -> f (DiametralBall b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
DiametralBall (f a) -> f (DiametralBall a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
DiametralBall (f a) -> f (DiametralBall a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DiametralBall a -> m (DiametralBall b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DiametralBall a -> m (DiametralBall b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
DiametralBall (m a) -> m (DiametralBall a)
sequence :: forall (m :: * -> *) a.
Monad m =>
DiametralBall (m a) -> m (DiametralBall a)
Traversable)
                            deriving newtype (Foldable DiametralBall
Foldable DiametralBall =>
(forall m. Semigroup m => DiametralBall m -> m)
-> (forall m a. Semigroup m => (a -> m) -> DiametralBall a -> m)
-> (forall m a. Semigroup m => (a -> m) -> DiametralBall a -> m)
-> (forall a. DiametralBall a -> NonEmpty a)
-> (forall a. Ord a => DiametralBall a -> a)
-> (forall a. Ord a => DiametralBall a -> a)
-> (forall a. DiametralBall a -> a)
-> (forall a. DiametralBall a -> a)
-> (forall a b. (a -> b) -> (a -> b -> b) -> DiametralBall a -> b)
-> (forall a b. (a -> b) -> (b -> a -> b) -> DiametralBall a -> b)
-> (forall a b. (a -> b) -> (b -> a -> b) -> DiametralBall a -> b)
-> (forall a b. (a -> b) -> (a -> b -> b) -> DiametralBall a -> b)
-> Foldable1 DiametralBall
forall a. Ord a => DiametralBall a -> a
forall m. Semigroup m => DiametralBall m -> m
forall a. DiametralBall a -> a
forall a. DiametralBall a -> NonEmpty a
forall m a. Semigroup m => (a -> m) -> DiametralBall a -> m
forall a b. (a -> b) -> (a -> b -> b) -> DiametralBall a -> b
forall a b. (a -> b) -> (b -> a -> b) -> DiametralBall a -> b
forall (t :: * -> *).
Foldable t =>
(forall m. Semigroup m => t m -> m)
-> (forall m a. Semigroup m => (a -> m) -> t a -> m)
-> (forall m a. Semigroup m => (a -> m) -> t a -> m)
-> (forall a. t a -> NonEmpty a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. t a -> a)
-> (forall a. t a -> a)
-> (forall a b. (a -> b) -> (a -> b -> b) -> t a -> b)
-> (forall a b. (a -> b) -> (b -> a -> b) -> t a -> b)
-> (forall a b. (a -> b) -> (b -> a -> b) -> t a -> b)
-> (forall a b. (a -> b) -> (a -> b -> b) -> t a -> b)
-> Foldable1 t
$cfold1 :: forall m. Semigroup m => DiametralBall m -> m
fold1 :: forall m. Semigroup m => DiametralBall m -> m
$cfoldMap1 :: forall m a. Semigroup m => (a -> m) -> DiametralBall a -> m
foldMap1 :: forall m a. Semigroup m => (a -> m) -> DiametralBall a -> m
$cfoldMap1' :: forall m a. Semigroup m => (a -> m) -> DiametralBall a -> m
foldMap1' :: forall m a. Semigroup m => (a -> m) -> DiametralBall a -> m
$ctoNonEmpty :: forall a. DiametralBall a -> NonEmpty a
toNonEmpty :: forall a. DiametralBall a -> NonEmpty a
$cmaximum :: forall a. Ord a => DiametralBall a -> a
maximum :: forall a. Ord a => DiametralBall a -> a
$cminimum :: forall a. Ord a => DiametralBall a -> a
minimum :: forall a. Ord a => DiametralBall a -> a
$chead :: forall a. DiametralBall a -> a
head :: forall a. DiametralBall a -> a
$clast :: forall a. DiametralBall a -> a
last :: forall a. DiametralBall a -> a
$cfoldrMap1 :: forall a b. (a -> b) -> (a -> b -> b) -> DiametralBall a -> b
foldrMap1 :: forall a b. (a -> b) -> (a -> b -> b) -> DiametralBall a -> b
$cfoldlMap1' :: forall a b. (a -> b) -> (b -> a -> b) -> DiametralBall a -> b
foldlMap1' :: forall a b. (a -> b) -> (b -> a -> b) -> DiametralBall a -> b
$cfoldlMap1 :: forall a b. (a -> b) -> (b -> a -> b) -> DiametralBall a -> b
foldlMap1 :: forall a b. (a -> b) -> (b -> a -> b) -> DiametralBall a -> b
$cfoldrMap1' :: forall a b. (a -> b) -> (a -> b -> b) -> DiametralBall a -> b
foldrMap1' :: forall a b. (a -> b) -> (a -> b -> b) -> DiametralBall a -> b
Foldable1)

pattern DiametralPoints     :: point -> point -> DiametralBall point
pattern $mDiametralPoints :: forall {r} {point}.
DiametralBall point -> (point -> point -> r) -> ((# #) -> r) -> r
$bDiametralPoints :: forall point. point -> point -> DiametralBall point
DiametralPoints p q = MkDiametralBall (Vector2 p q)
{-# COMPLETE DiametralPoints #-}

type instance Dimension (DiametralBall point) = Dimension point
type instance NumType   (DiametralBall point) = NumType   point

instance Traversable1 DiametralBall where
  traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> DiametralBall a -> f (DiametralBall b)
traverse1 a -> f b
f (MkDiametralBall Vector 2 a
v) = Vector 2 b -> DiametralBall b
forall point. Vector 2 point -> DiametralBall point
MkDiametralBall (Vector 2 b -> DiametralBall b)
-> f (Vector 2 b) -> f (DiametralBall b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Vector 2 a -> f (Vector 2 b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> Vector 2 a -> f (Vector 2 b)
traverse1 a -> f b
f Vector 2 a
v

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

instance (Point_ point d r, Fractional r, Has_ Metric_ d r
         ) => Ball_ (DiametralBall point) (Point d r) where
  squaredRadius :: Getter (DiametralBall point) (NumType (DiametralBall point))
squaredRadius = (DiametralBall point -> NumType (DiametralBall point))
-> (NumType (DiametralBall point)
    -> f (NumType (DiametralBall point)))
-> DiametralBall point
-> f (DiametralBall point)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((DiametralBall point -> NumType (DiametralBall point))
 -> (NumType (DiametralBall point)
     -> f (NumType (DiametralBall point)))
 -> DiametralBall point
 -> f (DiametralBall point))
-> (DiametralBall point -> NumType (DiametralBall point))
-> (NumType (DiametralBall point)
    -> f (NumType (DiametralBall point)))
-> DiametralBall point
-> f (DiametralBall point)
forall a b. (a -> b) -> a -> b
$ \(DiametralPoints point
p point
q) -> Vector d r -> NumType (DiametralBall point)
forall vector (d :: Nat) r.
(Metric_ vector d r, Num r) =>
vector -> r
quadrance (Vector d r -> NumType (DiametralBall point))
-> Vector d r -> NumType (DiametralBall point)
forall a b. (a -> b) -> a -> b
$ (point
p point -> point -> Vector d r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
.-. point
q) Vector d r -> r -> Vector d r
forall vector (d :: Nat) r.
(Vector_ vector d r, Fractional r) =>
vector -> r -> vector
^/ r
2

--------------------------------------------------------------------------------
-- * Point in ball

instance (Point_ point d r, Has_ Metric_ d r) => HasInBall (DiametralBall point) where
  inBall :: forall point (d :: Nat) r.
(Point_ point d r, Ord r, Num r, NumType (DiametralBall point) ~ r,
 Dimension (DiametralBall point) ~ d) =>
point -> DiametralBall point -> PointLocationResult
inBall point
q (DiametralPoints point
a point
b) = let a' :: Vector d r
a' = point
apoint -> Getting (Vector d r) point (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) point (Vector d r)
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point point (Vector d r) (Vector d r)
vector
                                       b' :: Vector d r
b' = point
bpoint -> Getting (Vector d r) point (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) point (Vector d r)
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point point (Vector d r) (Vector d r)
vector
                                       v :: Vector d r
v = r
2 r -> Vector d r -> Vector d r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
r -> vector -> vector
*^ (point
qpoint -> Getting (Vector d r) point (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) point (Vector d r)
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point point (Vector d r) (Vector d r)
vector) Vector d r -> Vector d r -> Vector d r
forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
^-^ (Vector d r
a' Vector d r -> Vector d r -> Vector d r
forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
^+^ Vector d r
b')
                                       w :: Vector d r
w = Vector d r
a' Vector d r -> Vector d r -> Vector d r
forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
^-^ Vector d r
b'
                                   in case (Vector d r
v Vector d r -> Vector d r -> r
forall vector (d :: Nat) r.
(Metric_ vector d r, Num r) =>
vector -> vector -> r
`dot` Vector d r
v) r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Vector d r
w Vector d r -> Vector d r -> r
forall vector (d :: Nat) r.
(Metric_ vector d r, Num r) =>
vector -> vector -> r
`dot` Vector d r
w) of
                                        Ordering
LT -> PointLocationResult
Inside
                                        Ordering
EQ -> PointLocationResult
OnBoundary
                                        Ordering
GT -> PointLocationResult
Outside
    -- main idea: solve: ||q-c||^2 <= r^2
    -- since we have c = (a+b)/2, and r=|a-b|/2
    -- we essentially avoid the division by using (2^2)*r^2 = (2r)^2 = (a-b)^2
    -- simialrly on the left side.

type instance Intersection (Point d r) (DiametralBall point) = Maybe (Point d r)

instance ( Point_ point d r, Ord r, Num r, Has_ Metric_ d r
         ) => (Point d r) `HasIntersectionWith` (DiametralBall point) where
  intersects :: Point d r -> DiametralBall point -> Bool
intersects Point d r
q DiametralBall point
b = Point d r
q Point d r -> DiametralBall point -> PointLocationResult
forall ball point (d :: Nat) r.
(HasInBall ball, Point_ point d r, Ord r, Num r, NumType ball ~ r,
 Dimension ball ~ d) =>
point -> ball -> PointLocationResult
forall point (d :: Nat) r.
(Point_ point d r, Ord r, Num r, NumType (DiametralBall point) ~ r,
 Dimension (DiametralBall point) ~ d) =>
point -> DiametralBall point -> PointLocationResult
`inBall` DiametralBall point
b PointLocationResult -> PointLocationResult -> Bool
forall a. Eq a => a -> a -> Bool
/= PointLocationResult
Outside

instance ( Point_ point d r
         , Ord r, Num r
         , Has_ Metric_ d r
         ) => (Point d r) `IsIntersectableWith` (DiametralBall point) where
  intersect :: Point d r
-> DiametralBall point
-> Intersection (Point d r) (DiametralBall point)
intersect Point d r
q DiametralBall point
b | Point d r
q Point d r -> DiametralBall point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` DiametralBall point
b = Point d r -> Maybe (Point d r)
forall a. a -> Maybe a
Just Point d r
q
                | Bool
otherwise        = Maybe (Point d r)
Intersection (Point d r) (DiametralBall point)
forall a. Maybe a
Nothing


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

instance (Point_ point d r, Fractional r) => HasCenter  (DiametralBall point) (Point d r) where
  center :: Lens' (DiametralBall point) (Point d r)
center = (DiametralBall point -> Point d r)
-> (DiametralBall point -> Point d r -> DiametralBall point)
-> Lens' (DiametralBall point) (Point d r)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DiametralBall point -> Point d r
forall point (d :: Nat) r.
(Point_ point d r, Fractional r) =>
DiametralBall point -> Point d r
computeCenter (\DiametralBall point
ball Point d r
c' -> let c :: Point d r
c = DiametralBall point -> Point d r
forall point (d :: Nat) r.
(Point_ point d r, Fractional r) =>
DiametralBall point -> Point d r
computeCenter DiametralBall point
ball
                                               v :: Vector d r
v = Point d r
c' Point d r -> Point d r -> Vector d r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
.-. Point d r
c
                                           in (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 -> point) -> DiametralBall point -> DiametralBall point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DiametralBall point
ball
                              ) -- shifts the center to the new position

-- | Computes the center of the ball
computeCenter :: (Point_ point d r, Fractional r) => DiametralBall point -> Point d r
computeCenter :: forall point (d :: Nat) r.
(Point_ point d r, Fractional r) =>
DiametralBall point -> Point d r
computeCenter (DiametralPoints point
a point
b) = Vector d r -> PointF (Vector d r)
forall v. v -> PointF v
Point (Vector d r -> PointF (Vector d r))
-> Vector d r -> PointF (Vector d r)
forall a b. (a -> b) -> a -> b
$ (point
apoint -> Getting (Vector d r) point (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) point (Vector d r)
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point point (Vector d r) (Vector d r)
vector Vector d r -> Vector d r -> Vector d r
forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
^+^ point
bpoint -> Getting (Vector d r) point (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) point (Vector d r)
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point point (Vector d r) (Vector d r)
vector) Vector d r -> r -> Vector d r
forall vector (d :: Nat) r.
(Vector_ vector d r, Fractional r) =>
vector -> r -> vector
^/ r
2