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

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

--------------------------------------------------------------------------------
-- | Disks are either diametral, or specified by three points
data DiskByPoints point = DiametralDisk !(DiametralBall point)
                        | DiskByPoints  !(BallByPoints' 3 point)
                        deriving stock (Int -> DiskByPoints point -> ShowS
[DiskByPoints point] -> ShowS
DiskByPoints point -> String
(Int -> DiskByPoints point -> ShowS)
-> (DiskByPoints point -> String)
-> ([DiskByPoints point] -> ShowS)
-> Show (DiskByPoints point)
forall point. Show point => Int -> DiskByPoints point -> ShowS
forall point. Show point => [DiskByPoints point] -> ShowS
forall point. Show point => DiskByPoints point -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall point. Show point => Int -> DiskByPoints point -> ShowS
showsPrec :: Int -> DiskByPoints point -> ShowS
$cshow :: forall point. Show point => DiskByPoints point -> String
show :: DiskByPoints point -> String
$cshowList :: forall point. Show point => [DiskByPoints point] -> ShowS
showList :: [DiskByPoints point] -> ShowS
Show,DiskByPoints point -> DiskByPoints point -> Bool
(DiskByPoints point -> DiskByPoints point -> Bool)
-> (DiskByPoints point -> DiskByPoints point -> Bool)
-> Eq (DiskByPoints point)
forall point.
Eq point =>
DiskByPoints point -> DiskByPoints point -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall point.
Eq point =>
DiskByPoints point -> DiskByPoints point -> Bool
== :: DiskByPoints point -> DiskByPoints point -> Bool
$c/= :: forall point.
Eq point =>
DiskByPoints point -> DiskByPoints point -> Bool
/= :: DiskByPoints point -> DiskByPoints point -> Bool
Eq,(forall m. Monoid m => DiskByPoints m -> m)
-> (forall m a. Monoid m => (a -> m) -> DiskByPoints a -> m)
-> (forall m a. Monoid m => (a -> m) -> DiskByPoints a -> m)
-> (forall a b. (a -> b -> b) -> b -> DiskByPoints a -> b)
-> (forall a b. (a -> b -> b) -> b -> DiskByPoints a -> b)
-> (forall b a. (b -> a -> b) -> b -> DiskByPoints a -> b)
-> (forall b a. (b -> a -> b) -> b -> DiskByPoints a -> b)
-> (forall a. (a -> a -> a) -> DiskByPoints a -> a)
-> (forall a. (a -> a -> a) -> DiskByPoints a -> a)
-> (forall a. DiskByPoints a -> [a])
-> (forall a. DiskByPoints a -> Bool)
-> (forall a. DiskByPoints a -> Int)
-> (forall a. Eq a => a -> DiskByPoints a -> Bool)
-> (forall a. Ord a => DiskByPoints a -> a)
-> (forall a. Ord a => DiskByPoints a -> a)
-> (forall a. Num a => DiskByPoints a -> a)
-> (forall a. Num a => DiskByPoints a -> a)
-> Foldable DiskByPoints
forall a. Eq a => a -> DiskByPoints a -> Bool
forall a. Num a => DiskByPoints a -> a
forall a. Ord a => DiskByPoints a -> a
forall m. Monoid m => DiskByPoints m -> m
forall a. DiskByPoints a -> Bool
forall a. DiskByPoints a -> Int
forall a. DiskByPoints a -> [a]
forall a. (a -> a -> a) -> DiskByPoints a -> a
forall m a. Monoid m => (a -> m) -> DiskByPoints a -> m
forall b a. (b -> a -> b) -> b -> DiskByPoints a -> b
forall a b. (a -> b -> b) -> b -> DiskByPoints 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 => DiskByPoints m -> m
fold :: forall m. Monoid m => DiskByPoints m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> DiskByPoints a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> DiskByPoints a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> DiskByPoints a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> DiskByPoints a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> DiskByPoints a -> b
foldr :: forall a b. (a -> b -> b) -> b -> DiskByPoints a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> DiskByPoints a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> DiskByPoints a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> DiskByPoints a -> b
foldl :: forall b a. (b -> a -> b) -> b -> DiskByPoints a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> DiskByPoints a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> DiskByPoints a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> DiskByPoints a -> a
foldr1 :: forall a. (a -> a -> a) -> DiskByPoints a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> DiskByPoints a -> a
foldl1 :: forall a. (a -> a -> a) -> DiskByPoints a -> a
$ctoList :: forall a. DiskByPoints a -> [a]
toList :: forall a. DiskByPoints a -> [a]
$cnull :: forall a. DiskByPoints a -> Bool
null :: forall a. DiskByPoints a -> Bool
$clength :: forall a. DiskByPoints a -> Int
length :: forall a. DiskByPoints a -> Int
$celem :: forall a. Eq a => a -> DiskByPoints a -> Bool
elem :: forall a. Eq a => a -> DiskByPoints a -> Bool
$cmaximum :: forall a. Ord a => DiskByPoints a -> a
maximum :: forall a. Ord a => DiskByPoints a -> a
$cminimum :: forall a. Ord a => DiskByPoints a -> a
minimum :: forall a. Ord a => DiskByPoints a -> a
$csum :: forall a. Num a => DiskByPoints a -> a
sum :: forall a. Num a => DiskByPoints a -> a
$cproduct :: forall a. Num a => DiskByPoints a -> a
product :: forall a. Num a => DiskByPoints a -> a
Foldable,(forall a b. (a -> b) -> DiskByPoints a -> DiskByPoints b)
-> (forall a b. a -> DiskByPoints b -> DiskByPoints a)
-> Functor DiskByPoints
forall a b. a -> DiskByPoints b -> DiskByPoints a
forall a b. (a -> b) -> DiskByPoints a -> DiskByPoints 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) -> DiskByPoints a -> DiskByPoints b
fmap :: forall a b. (a -> b) -> DiskByPoints a -> DiskByPoints b
$c<$ :: forall a b. a -> DiskByPoints b -> DiskByPoints a
<$ :: forall a b. a -> DiskByPoints b -> DiskByPoints a
Functor)

type instance Dimension (DiskByPoints point) = Dimension point -- this better be 2
type instance NumType   (DiskByPoints point) = NumType point

makePrisms ''DiskByPoints


instance Foldable1 DiskByPoints where
  foldMap1 :: forall m a. Semigroup m => (a -> m) -> DiskByPoints a -> m
foldMap1 a -> m
f = \case
    DiametralDisk DiametralBall a
d -> (a -> m) -> DiametralBall a -> m
forall m a. Semigroup m => (a -> m) -> DiametralBall a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f DiametralBall a
d
    DiskByPoints BallByPoints' 3 a
d  -> (a -> m) -> BallByPoints' 3 a -> m
forall m a. Semigroup m => (a -> m) -> BallByPoints' 3 a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f BallByPoints' 3 a
d

instance Traversable DiskByPoints where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DiskByPoints a -> f (DiskByPoints b)
traverse a -> f b
f = \case
    DiametralDisk DiametralBall a
d -> DiametralBall b -> DiskByPoints b
forall point. DiametralBall point -> DiskByPoints point
DiametralDisk (DiametralBall b -> DiskByPoints b)
-> f (DiametralBall b) -> f (DiskByPoints b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> DiametralBall a -> f (DiametralBall b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DiametralBall a -> f (DiametralBall b)
traverse a -> f b
f DiametralBall a
d
    DiskByPoints BallByPoints' 3 a
d  -> BallByPoints' 3 b -> DiskByPoints b
forall point. BallByPoints' 3 point -> DiskByPoints point
DiskByPoints  (BallByPoints' 3 b -> DiskByPoints b)
-> f (BallByPoints' 3 b) -> f (DiskByPoints b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> BallByPoints' 3 a -> f (BallByPoints' 3 b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BallByPoints' 3 a -> f (BallByPoints' 3 b)
traverse a -> f b
f BallByPoints' 3 a
d

instance Traversable1 DiskByPoints where
  traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> DiskByPoints a -> f (DiskByPoints b)
traverse1 a -> f b
f = \case
    DiametralDisk DiametralBall a
d -> DiametralBall b -> DiskByPoints b
forall point. DiametralBall point -> DiskByPoints point
DiametralDisk (DiametralBall b -> DiskByPoints b)
-> f (DiametralBall b) -> f (DiskByPoints b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> DiametralBall a -> f (DiametralBall 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) -> DiametralBall a -> f (DiametralBall b)
traverse1 a -> f b
f DiametralBall a
d
    DiskByPoints BallByPoints' 3 a
d  -> BallByPoints' 3 b -> DiskByPoints b
forall point. BallByPoints' 3 point -> DiskByPoints point
DiskByPoints  (BallByPoints' 3 b -> DiskByPoints b)
-> f (BallByPoints' 3 b) -> f (DiskByPoints b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> BallByPoints' 3 a -> f (BallByPoints' 3 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) -> BallByPoints' 3 a -> f (BallByPoints' 3 b)
traverse1 a -> f b
f BallByPoints' 3 a
d


instance (Point_ point 2 r, Fractional r) => Ball_ (DiskByPoints point) (Point 2 r) where
  squaredRadius :: Getter (DiskByPoints point) (NumType (DiskByPoints point))
squaredRadius = (DiskByPoints point -> NumType (DiskByPoints point))
-> (NumType (DiskByPoints point)
    -> f (NumType (DiskByPoints point)))
-> DiskByPoints point
-> f (DiskByPoints point)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((DiskByPoints point -> NumType (DiskByPoints point))
 -> (NumType (DiskByPoints point)
     -> f (NumType (DiskByPoints point)))
 -> DiskByPoints point
 -> f (DiskByPoints point))
-> (DiskByPoints point -> NumType (DiskByPoints point))
-> (NumType (DiskByPoints point)
    -> f (NumType (DiskByPoints point)))
-> DiskByPoints point
-> f (DiskByPoints point)
forall a b. (a -> b) -> a -> b
$ \case
    DiametralDisk DiametralBall point
d -> DiametralBall point
dDiametralBall point -> Getting r (DiametralBall point) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (DiametralBall point) r
(NumType (DiametralBall point)
 -> Const r (NumType (DiametralBall point)))
-> DiametralBall point -> Const r (DiametralBall point)
forall ball point. Ball_ ball point => Getter ball (NumType ball)
Getter (DiametralBall point) (NumType (DiametralBall point))
squaredRadius
    DiskByPoints BallByPoints' 3 point
d  -> BallByPoints' 3 point
dBallByPoints' 3 point -> Getting r (BallByPoints' 3 point) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (BallByPoints' 3 point) r
(NumType (BallByPoints' 3 point)
 -> Const r (NumType (BallByPoints' 3 point)))
-> BallByPoints' 3 point -> Const r (BallByPoints' 3 point)
forall ball point. Ball_ ball point => Getter ball (NumType ball)
Getter (BallByPoints' 3 point) (NumType (BallByPoints' 3 point))
squaredRadius

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

instance Point_ point 2 r => HasInBall (DiskByPoints point) where
  inBall :: forall point (d :: Nat) r.
(Point_ point d r, Ord r, Num r, NumType (DiskByPoints point) ~ r,
 Dimension (DiskByPoints point) ~ d) =>
point -> DiskByPoints point -> PointLocationResult
inBall point
q = \case
    DiametralDisk DiametralBall point
d -> point -> 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 point
q DiametralBall point
d
    DiskByPoints BallByPoints' 3 point
d  -> point -> BallByPoints' 3 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 (BallByPoints' 3 point) ~ r,
 Dimension (BallByPoints' 3 point) ~ d) =>
point -> BallByPoints' 3 point -> PointLocationResult
inBall point
q BallByPoints' 3 point
d

type instance Intersection (Point 2 r) (DiskByPoints point) = Maybe (Point 2 r)

instance ( Point_ point 2 r, Ord r, Num r
         ) => (Point 2 r) `HasIntersectionWith` (DiskByPoints  point) where
  intersects :: Point 2 r -> DiskByPoints point -> Bool
intersects Point 2 r
q DiskByPoints point
b = Point 2 r
q Point 2 r -> DiskByPoints 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 (DiskByPoints point) ~ r,
 Dimension (DiskByPoints point) ~ d) =>
point -> DiskByPoints point -> PointLocationResult
`inBall` DiskByPoints point
b PointLocationResult -> PointLocationResult -> Bool
forall a. Eq a => a -> a -> Bool
/= PointLocationResult
Outside

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

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


instance (Point_ point 2 r, Fractional r) => HasCenter  (DiskByPoints point) (Point 2 r) where
  center :: Lens' (DiskByPoints point) (Point 2 r)
center = (DiskByPoints point -> Point 2 r)
-> (DiskByPoints point -> Point 2 r -> DiskByPoints point)
-> Lens' (DiskByPoints point) (Point 2 r)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\case
                    DiametralDisk DiametralBall point
d -> DiametralBall point
dDiametralBall point
-> Getting (Point 2 r) (DiametralBall point) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (DiametralBall point) (Point 2 r)
forall geom point. HasCenter geom point => Lens' geom point
Lens' (DiametralBall point) (Point 2 r)
center
                    DiskByPoints BallByPoints' 3 point
d  -> BallByPoints' 3 point
dBallByPoints' 3 point
-> Getting (Point 2 r) (BallByPoints' 3 point) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (BallByPoints' 3 point) (Point 2 r)
forall geom point. HasCenter geom point => Lens' geom point
Lens' (BallByPoints' 3 point) (Point 2 r)
center
                )
                (\case
                    DiametralDisk DiametralBall point
d -> DiametralBall point -> DiskByPoints point
forall point. DiametralBall point -> DiskByPoints point
DiametralDisk (DiametralBall point -> DiskByPoints point)
-> (Point 2 r -> DiametralBall point)
-> Point 2 r
-> DiskByPoints point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point 2 r -> DiametralBall point -> DiametralBall point)
-> DiametralBall point -> Point 2 r -> DiametralBall point
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ASetter
  (DiametralBall point) (DiametralBall point) (Point 2 r) (Point 2 r)
-> Point 2 r -> DiametralBall point -> DiametralBall point
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (DiametralBall point) (DiametralBall point) (Point 2 r) (Point 2 r)
forall geom point. HasCenter geom point => Lens' geom point
Lens' (DiametralBall point) (Point 2 r)
center) DiametralBall point
d
                    DiskByPoints BallByPoints' 3 point
d  -> BallByPoints' 3 point -> DiskByPoints point
forall point. BallByPoints' 3 point -> DiskByPoints point
DiskByPoints  (BallByPoints' 3 point -> DiskByPoints point)
-> (Point 2 r -> BallByPoints' 3 point)
-> Point 2 r
-> DiskByPoints point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point 2 r -> BallByPoints' 3 point -> BallByPoints' 3 point)
-> BallByPoints' 3 point -> Point 2 r -> BallByPoints' 3 point
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ASetter
  (BallByPoints' 3 point)
  (BallByPoints' 3 point)
  (Point 2 r)
  (Point 2 r)
-> Point 2 r -> BallByPoints' 3 point -> BallByPoints' 3 point
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (BallByPoints' 3 point)
  (BallByPoints' 3 point)
  (Point 2 r)
  (Point 2 r)
forall geom point. HasCenter geom point => Lens' geom point
Lens' (BallByPoints' 3 point) (Point 2 r)
center) BallByPoints' 3 point
d
                )