{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
module Diagrams.TwoD.Curvature
(
curvature
, radiusOfCurvature
, squaredCurvature
, squaredRadiusOfCurvature
) where
import Control.Lens (over)
import Control.Monad
import Data.Monoid.Inf
import Diagrams.Segment
import Diagrams.Tangent
import Diagrams.TwoD.Types
import Linear.Vector
curvature :: RealFloat n
=> Segment Closed V2 n
-> n
-> PosInf n
curvature :: Segment Closed V2 n -> n -> PosInf n
curvature s :: Segment Closed V2 n
s = V2 n -> PosInf n
forall a. RealFloat a => V2 a -> PosInf a
toPosInf (V2 n -> PosInf n) -> (n -> V2 n) -> n -> PosInf n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter (V2 n) (V2 n) n n -> (n -> n) -> V2 n -> V2 n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (V2 n) (V2 n) n n
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y n -> n
forall a. Floating a => a -> a
sqrt (V2 n -> V2 n) -> (n -> V2 n) -> n -> V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Segment Closed V2 n -> n -> V2 n
forall n. Num n => Segment Closed V2 n -> n -> V2 n
curvaturePair Segment Closed V2 n
s
squaredCurvature :: RealFloat n => Segment Closed V2 n -> n -> PosInf n
squaredCurvature :: Segment Closed V2 n -> n -> PosInf n
squaredCurvature s :: Segment Closed V2 n
s = V2 n -> PosInf n
forall a. RealFloat a => V2 a -> PosInf a
toPosInf (V2 n -> PosInf n) -> (n -> V2 n) -> n -> PosInf n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter (V2 n) (V2 n) n n -> (n -> n) -> V2 n -> V2 n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (V2 n) (V2 n) n n
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x ((n -> n -> n) -> n -> n
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join n -> n -> n
forall a. Num a => a -> a -> a
(*)) (V2 n -> V2 n) -> (n -> V2 n) -> n -> V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Segment Closed V2 n -> n -> V2 n
forall n. Num n => Segment Closed V2 n -> n -> V2 n
curvaturePair Segment Closed V2 n
s
radiusOfCurvature :: RealFloat n
=> Segment Closed V2 n
-> n
-> PosInf n
radiusOfCurvature :: Segment Closed V2 n -> n -> PosInf n
radiusOfCurvature s :: Segment Closed V2 n
s = V2 n -> PosInf n
forall a. RealFloat a => V2 a -> PosInf a
toPosInf (V2 n -> PosInf n) -> (n -> V2 n) -> n -> PosInf n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(V2 p :: n
p q :: n
q) -> n -> n -> V2 n
forall a. a -> a -> V2 a
V2 (n -> n
forall a. Floating a => a -> a
sqrt n
q) n
p) (V2 n -> V2 n) -> (n -> V2 n) -> n -> V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Segment Closed V2 n -> n -> V2 n
forall n. Num n => Segment Closed V2 n -> n -> V2 n
curvaturePair Segment Closed V2 n
s
squaredRadiusOfCurvature :: RealFloat n => Segment Closed V2 n -> n -> PosInf n
squaredRadiusOfCurvature :: Segment Closed V2 n -> n -> PosInf n
squaredRadiusOfCurvature s :: Segment Closed V2 n
s = V2 n -> PosInf n
forall a. RealFloat a => V2 a -> PosInf a
toPosInf (V2 n -> PosInf n) -> (n -> V2 n) -> n -> PosInf n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(V2 p :: n
p q :: n
q) -> (n -> n -> V2 n
forall a. a -> a -> V2 a
V2 n
q (n
p n -> n -> n
forall a. Num a => a -> a -> a
* n
p))) (V2 n -> V2 n) -> (n -> V2 n) -> n -> V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Segment Closed V2 n -> n -> V2 n
forall n. Num n => Segment Closed V2 n -> n -> V2 n
curvaturePair Segment Closed V2 n
s
toPosInf :: RealFloat a => V2 a -> PosInf a
toPosInf :: V2 a -> PosInf a
toPosInf (V2 _ 0) = PosInf a
forall p a. Inf p a
Infinity
toPosInf (V2 p :: a
p q :: a
q)
| a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
r Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
r = PosInf a
forall p a. Inf p a
Infinity
| Bool
otherwise = a -> PosInf a
forall p a. a -> Inf p a
Finite a
r
where r :: a
r = a
p a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
q
curvaturePair :: Num n
=> Segment Closed V2 n -> n -> V2 n
curvaturePair :: Segment Closed V2 n -> n -> V2 n
curvaturePair (Linear _) _ = n -> n -> V2 n
forall a. a -> a -> V2 a
V2 0 1
curvaturePair seg :: Segment Closed V2 n
seg@(Cubic b :: V2 n
b c :: V2 n
c (OffsetClosed d :: V2 n
d)) t :: n
t
= n -> n -> V2 n
forall a. a -> a -> V2 a
V2 (n
x'n -> n -> n
forall a. Num a => a -> a -> a
*n
y'' n -> n -> n
forall a. Num a => a -> a -> a
- n
y'n -> n -> n
forall a. Num a => a -> a -> a
*n
x'') ((n
x'n -> n -> n
forall a. Num a => a -> a -> a
*n
x' n -> n -> n
forall a. Num a => a -> a -> a
+ n
y'n -> n -> n
forall a. Num a => a -> a -> a
*n
y')n -> Int -> n
forall a b. (Num a, Integral b) => a -> b -> a
^(3 :: Int))
where
(V2 x' :: n
x' y' :: n
y' ) = Segment Closed V2 n
seg Segment Closed V2 n
-> N (Segment Closed V2 n) -> Vn (Segment Closed V2 n)
forall t. Parametric (Tangent t) => t -> N t -> Vn t
`tangentAtParam` n
N (Segment Closed V2 n)
t
(V2 x'' :: n
x'' y'' :: n
y'') = V2 n
secondDerivative
secondDerivative :: V2 n
secondDerivative = (6n -> n -> n
forall a. Num a => a -> a -> a
*(3n -> n -> n
forall a. Num a => a -> a -> a
*n
tn -> n -> n
forall a. Num a => a -> a -> a
-2))n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^V2 n
b V2 n -> V2 n -> V2 n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (6n -> n -> n
forall a. Num a => a -> a -> a
-18n -> n -> n
forall a. Num a => a -> a -> a
*n
t)n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^V2 n
c V2 n -> V2 n -> V2 n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (6n -> n -> n
forall a. Num a => a -> a -> a
*n
t)n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^V2 n
d