{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE Safe #-}

{- | 
Module      :  Physics.Learn.Curve
Copyright   :  (c) Scott N. Walck 2012-2018
License     :  BSD3 (see LICENSE)
Maintainer  :  Scott N. Walck <walck@lvc.edu>
Stability   :  experimental

This module contains functions for working with 'Curve's
and line integrals along 'Curve's.
-}

module Physics.Learn.Curve
    (
    -- * Curves
      Curve(..)
    , normalizeCurve
    , concatCurves
    , concatenateCurves
    , reverseCurve
    , evalCurve
    , shiftCurve
    , straightLine
    -- * Line Integrals
    , simpleLineIntegral
    , dottedLineIntegral
    , crossedLineIntegral
    , compositeTrapezoidDottedLineIntegral
    , compositeTrapezoidCrossedLineIntegral
    , compositeSimpsonDottedLineIntegral
    , compositeSimpsonCrossedLineIntegral
    )
    where

import Data.VectorSpace
    ( VectorSpace
    , InnerSpace
    , Scalar
    )
import Physics.Learn.CarrotVec
    ( Vec
    , (><)
    , (<.>)
    , sumV
    , (^*)
    , (^/)
    , (^+^)
    , (^-^)
    , (*^)
    , magnitude
    , zeroV
    , negateV
    )
import Physics.Learn.Position
    ( Position
    , Displacement
    , displacement
    , Field
    , VectorField
    , shiftPosition
    )

-- | 'Curve' is a parametrized function into three-space, an initial limit, and a final limit.
data Curve = Curve { Curve -> R -> Position
curveFunc          :: Double -> Position  -- ^ function from one parameter into space
                   , Curve -> R
startingCurveParam :: Double              -- ^ starting value of the parameter
                   , Curve -> R
endingCurveParam   :: Double              -- ^ ending value of the parameter
                   }

-- | A dotted line integral.
--   Convenience function for 'compositeSimpsonDottedLineIntegral'.
dottedLineIntegral
    :: Int          -- ^ number of half-intervals
                    --   (one less than the number of function evaluations)
    -> VectorField  -- ^ vector field
    -> Curve        -- ^ curve to integrate over
    -> Double       -- ^ scalar result
dottedLineIntegral :: Int -> VectorField -> Curve -> R
dottedLineIntegral = Int -> VectorField -> Curve -> R
compositeSimpsonDottedLineIntegral

-- | Calculates integral vf x dl over curve.
--   Convenience function for 'compositeSimpsonCrossedLineIntegral'.
crossedLineIntegral
    :: Int          -- ^ number of half-intervals
                    --   (one less than the number of function evaluations)
    -> VectorField  -- ^ vector field
    -> Curve        -- ^ curve to integrate over
    -> Vec          -- ^ vector result
crossedLineIntegral :: Int -> VectorField -> Curve -> Vec
crossedLineIntegral = Int -> VectorField -> Curve -> Vec
compositeSimpsonCrossedLineIntegral

-- | A dotted line integral, performed in an unsophisticated way.
compositeTrapezoidDottedLineIntegral
    :: Int          -- ^ number of intervals
    -> VectorField  -- ^ vector field
    -> Curve        -- ^ curve to integrate over
    -> Double       -- ^ scalar result
compositeTrapezoidDottedLineIntegral :: Int -> VectorField -> Curve -> R
compositeTrapezoidDottedLineIntegral Int
n VectorField
vf (Curve R -> Position
f R
a R
b)
    = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall v. InnerSpace v => v -> v -> Scalar v
(<.>) [Vec]
aveVecs [Vec]
dls
      where
        dt :: R
dt = (R
b forall a. Num a => a -> a -> a
- R
a) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        pts :: [Position]
pts = [R -> Position
f R
t | R
t <- [R
a,R
aforall a. Num a => a -> a -> a
+R
dt..R
b]]
        vecs :: [Vec]
vecs = [VectorField
vf Position
pt | Position
pt <- [Position]
pts]
        aveVecs :: [Vec]
aveVecs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall v. (VectorSpace v, Scalar v ~ R) => v -> v -> v
average [Vec]
vecs (forall a. [a] -> [a]
tail [Vec]
vecs)
        dls :: [Vec]
dls = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Position -> VectorField
displacement [Position]
pts (forall a. [a] -> [a]
tail [Position]
pts)

-- | Calculates integral vf x dl over curve in an unsophisticated way.
compositeTrapezoidCrossedLineIntegral
    :: Int          -- ^ number of intervals
    -> VectorField  -- ^ vector field
    -> Curve        -- ^ curve to integrate over
    -> Vec          -- ^ vector result
compositeTrapezoidCrossedLineIntegral :: Int -> VectorField -> Curve -> Vec
compositeTrapezoidCrossedLineIntegral Int
n VectorField
vf (Curve R -> Position
f R
a R
b)
    = forall (f :: * -> *) v. (Foldable f, AdditiveGroup v) => f v -> v
sumV forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Vec -> Vec -> Vec
(><) [Vec]
aveVecs [Vec]
dls
      where
        dt :: R
dt = (R
b forall a. Num a => a -> a -> a
- R
a) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        pts :: [Position]
pts = [R -> Position
f R
t | R
t <- [R
a,R
aforall a. Num a => a -> a -> a
+R
dt..R
b]]
        vecs :: [Vec]
vecs = [VectorField
vf Position
pt | Position
pt <- [Position]
pts]
        aveVecs :: [Vec]
aveVecs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall v. (VectorSpace v, Scalar v ~ R) => v -> v -> v
average [Vec]
vecs (forall a. [a] -> [a]
tail [Vec]
vecs)
        dls :: [Vec]
dls = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Position -> VectorField
displacement [Position]
pts (forall a. [a] -> [a]
tail [Position]
pts)

-- | Calculates integral f dl over curve, where dl is a scalar line element.
simpleLineIntegral
    :: (InnerSpace v, Scalar v ~ Double)
       => Int      -- ^ number of intervals
    -> Field v     -- ^ scalar or vector field
    -> Curve       -- ^ curve to integrate over
    -> v           -- ^ scalar or vector result
simpleLineIntegral :: forall v.
(InnerSpace v, Scalar v ~ R) =>
Int -> Field v -> Curve -> v
simpleLineIntegral Int
n Field v
vf (Curve R -> Position
f R
a R
b)
    = forall (f :: * -> *) v. (Foldable f, AdditiveGroup v) => f v -> v
sumV forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
(^*) [v]
aveVecs (forall a b. (a -> b) -> [a] -> [b]
map forall v s. (InnerSpace v, s ~ Scalar v, Floating s) => v -> s
magnitude [Vec]
dls)
      where
        dt :: R
dt = (R
b forall a. Num a => a -> a -> a
- R
a) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        pts :: [Position]
pts = [R -> Position
f R
t | R
t <- [R
a,R
aforall a. Num a => a -> a -> a
+R
dt..R
b]]
        vecs :: [v]
vecs = [Field v
vf Position
pt | Position
pt <- [Position]
pts]
        aveVecs :: [v]
aveVecs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall v. (VectorSpace v, Scalar v ~ R) => v -> v -> v
average [v]
vecs (forall a. [a] -> [a]
tail [v]
vecs)
        dls :: [Vec]
dls = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Position -> VectorField
displacement [Position]
pts (forall a. [a] -> [a]
tail [Position]
pts)

-- | Reparametrize a curve from 0 to 1.
normalizeCurve :: Curve -> Curve
normalizeCurve :: Curve -> Curve
normalizeCurve (Curve R -> Position
f R
a R
b)
    = (R -> Position) -> R -> R -> Curve
Curve (R -> Position
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. R -> R
scl) R
0 R
1
      where
        scl :: R -> R
scl R
t = R
a forall a. Num a => a -> a -> a
+ (R
b forall a. Num a => a -> a -> a
- R
a) forall a. Num a => a -> a -> a
* R
t

-- | Concatenate two curves.
concatCurves :: Curve  -- ^ go first along this curve
             -> Curve  -- ^ then along this curve
             -> Curve  -- ^ to produce this new curve
concatCurves :: Curve -> Curve -> Curve
concatCurves Curve
c1 Curve
c2
    = Curve -> Curve
normalizeCurve forall a b. (a -> b) -> a -> b
$ (R -> Position) -> R -> R -> Curve
Curve R -> Position
f R
0 R
2
      where
        (Curve R -> Position
f1 R
_ R
_) = Curve -> Curve
normalizeCurve Curve
c1
        (Curve R -> Position
f2 R
_ R
_) = Curve -> Curve
normalizeCurve Curve
c2
        f :: R -> Position
f R
t | R
t forall a. Ord a => a -> a -> Bool
<= R
1     = R -> Position
f1 R
t
            | Bool
otherwise  = R -> Position
f2 (R
tforall a. Num a => a -> a -> a
-R
1)

-- | Concatenate a list of curves.
--   Parametrizes curves equally.
concatenateCurves :: [Curve] -> Curve
concatenateCurves :: [Curve] -> Curve
concatenateCurves []     = forall a. HasCallStack => [Char] -> a
error [Char]
"concatenateCurves:  cannot concatenate empty list"
concatenateCurves [Curve]
cs = Curve -> Curve
normalizeCurve forall a b. (a -> b) -> a -> b
$ (R -> Position) -> R -> R -> Curve
Curve R -> Position
f R
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
    where
      n :: Int
n   = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Curve]
cs
      ncs :: [Curve]
ncs = forall a b. (a -> b) -> [a] -> [b]
map Curve -> Curve
normalizeCurve [Curve]
cs
      f :: R -> Position
f R
t = Curve -> R -> Position
evalCurve ([Curve]
ncs forall a. [a] -> Int -> a
!! Int
m) (R
t forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)
          where m :: Int
m = forall a. Ord a => a -> a -> a
min (Int
nforall a. Num a => a -> a -> a
-Int
1) (forall a b. (RealFrac a, Integral b) => a -> b
floor R
t)

-- | Reverse a curve.
reverseCurve :: Curve -> Curve
reverseCurve :: Curve -> Curve
reverseCurve (Curve R -> Position
f R
a R
b)
    = (R -> Position) -> R -> R -> Curve
Curve (R -> Position
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. R -> R
rev) R
a R
b
      where
        rev :: R -> R
rev R
t = R
a forall a. Num a => a -> a -> a
+ R
b forall a. Num a => a -> a -> a
- R
t

-- | Evaluate the position of a curve at a parameter.
evalCurve :: Curve     -- ^ the curve
          -> Double    -- ^ the parameter
          -> Position  -- ^ position of the point on the curve at that parameter
evalCurve :: Curve -> R -> Position
evalCurve (Curve R -> Position
f R
_ R
_) R
t = R -> Position
f R
t

-- | Shift a curve by a displacement.
shiftCurve :: Displacement  -- ^ amount to shift
           -> Curve         -- ^ original curve
           -> Curve         -- ^ shifted curve
shiftCurve :: Vec -> Curve -> Curve
shiftCurve Vec
d (Curve R -> Position
f R
sl R
su)
    = (R -> Position) -> R -> R -> Curve
Curve (Vec -> Position -> Position
shiftPosition Vec
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. R -> Position
f) R
sl R
su

-- | The straight-line curve from one position to another.
straightLine :: Position  -- ^ starting position
             -> Position  -- ^ ending position
             -> Curve     -- ^ straight-line curve
straightLine :: Position -> Position -> Curve
straightLine Position
r1 Position
r2 = (R -> Position) -> R -> R -> Curve
Curve R -> Position
f R
0 R
1
    where
      f :: R -> Position
f R
t = Vec -> Position -> Position
shiftPosition (R
t forall v. VectorSpace v => Scalar v -> v -> v
*^ Vec
d) Position
r1
      d :: Vec
d = Position -> VectorField
displacement Position
r1 Position
r2

-------------
-- Helpers --
-------------

average :: (VectorSpace v, Scalar v ~ Double) => v -> v -> v
average :: forall v. (VectorSpace v, Scalar v ~ R) => v -> v -> v
average v
v1 v
v2 = (v
v1 forall v. AdditiveGroup v => v -> v -> v
^+^ v
v2) forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ R
2

----------------------------------------
-- Quadratic (Simpson) Approximations --
----------------------------------------

dottedSimp :: (InnerSpace v, Fractional (Scalar v)) =>
              v  -- ^ vector field low
           -> v  -- ^ vector field mid
           -> v  -- ^ vector field high
           -> v  -- ^ dl low to mid
           -> v  -- ^ dl mid to high
           -> Scalar v  -- ^ quadratic approximation
dottedSimp :: forall v.
(InnerSpace v, Fractional (Scalar v)) =>
v -> v -> v -> v -> v -> Scalar v
dottedSimp v
f0 v
f1 v
f2 v
g10 v
g21
    = ((v
g21 forall v. AdditiveGroup v => v -> v -> v
^+^ v
g10) forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ Scalar v
6) forall v. InnerSpace v => v -> v -> Scalar v
<.> (v
f0 forall v. AdditiveGroup v => v -> v -> v
^+^ Scalar v
4 forall v. VectorSpace v => Scalar v -> v -> v
*^ v
f1 forall v. AdditiveGroup v => v -> v -> v
^+^ v
f2)
      forall a. Num a => a -> a -> a
+ ((v
g21 forall v. AdditiveGroup v => v -> v -> v
^-^ v
g10) forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ Scalar v
3) forall v. InnerSpace v => v -> v -> Scalar v
<.> (v
f2 forall v. AdditiveGroup v => v -> v -> v
^-^ v
f0)

-- | Quadratic approximation to vector field.
--   Quadratic approximation to curve.
--   Composite strategy.
--   Dotted line integral.
compositeSimpsonDottedLineIntegral
    :: Int          -- ^ number of half-intervals
                    --   (one less than the number of function evaluations)
    -> VectorField  -- ^ vector field
    -> Curve        -- ^ curve to integrate over
    -> Double       -- ^ scalar result
compositeSimpsonDottedLineIntegral :: Int -> VectorField -> Curve -> R
compositeSimpsonDottedLineIntegral Int
n VectorField
vf (Curve R -> Position
c R
a R
b)
    = let nEven :: Int
nEven = Int
2 forall a. Num a => a -> a -> a
* forall a. Integral a => a -> a -> a
div Int
n Int
2
          dt :: R
dt = (R
b forall a. Num a => a -> a -> a
- R
a) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nEven
          ts :: [R]
ts = [R
a forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m forall a. Num a => a -> a -> a
* R
dt | Int
m <- [Int
0..Int
nEven]]
          pairs :: [(Position, Vec)]
pairs = [(Position
ct,VectorField
vf Position
ct) | R
t <- [R]
ts, let ct :: Position
ct = R -> Position
c R
t]
          combine :: [(Position, Vec)] -> R
combine [] = forall a. HasCallStack => [Char] -> a
error [Char]
"compositeSimpson: odd number of half-intervals" -- this should never happen
          combine [(Position, Vec)
_] = forall v. AdditiveGroup v => v
zeroV
          combine ((Position, Vec)
_:(Position, Vec)
_:[]) = forall a. HasCallStack => [Char] -> a
error [Char]
"compositeSimpson: odd number of half-intervals" -- this should never happen
          combine ((Position
c0,Vec
f0):(Position
c1,Vec
f1):(Position
c2,Vec
f2):[(Position, Vec)]
ps)
              = forall v.
(InnerSpace v, Fractional (Scalar v)) =>
v -> v -> v -> v -> v -> Scalar v
dottedSimp Vec
f0 Vec
f1 Vec
f2 (Position -> VectorField
displacement Position
c0 Position
c1) (Position -> VectorField
displacement Position
c1 Position
c2)
                forall v. AdditiveGroup v => v -> v -> v
^+^ [(Position, Vec)] -> R
combine ((Position
c2,Vec
f2)forall a. a -> [a] -> [a]
:[(Position, Vec)]
ps)
      in [(Position, Vec)] -> R
combine [(Position, Vec)]
pairs

crossedSimp :: Vec  -- ^ vector field low
            -> Vec  -- ^ vector field mid
            -> Vec  -- ^ vector field high
            -> Vec  -- ^ dl low to mid
            -> Vec  -- ^ dl mid to high
            -> Vec  -- ^ quadratic approximation
crossedSimp :: Vec -> Vec -> Vec -> Vec -> Vec -> Vec
crossedSimp Vec
f0 Vec
f1 Vec
f2 Vec
g10 Vec
g21
    = forall v. AdditiveGroup v => v -> v
negateV forall a b. (a -> b) -> a -> b
$
      ((Vec
g21 forall v. AdditiveGroup v => v -> v -> v
^+^ Vec
g10) forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ R
6) Vec -> Vec -> Vec
>< (Vec
f0 forall v. AdditiveGroup v => v -> v -> v
^+^ R
4 forall v. VectorSpace v => Scalar v -> v -> v
*^ Vec
f1 forall v. AdditiveGroup v => v -> v -> v
^+^ Vec
f2)
      forall v. AdditiveGroup v => v -> v -> v
^+^ ((Vec
g21 forall v. AdditiveGroup v => v -> v -> v
^-^ Vec
g10) forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ R
3) Vec -> Vec -> Vec
>< (Vec
f2 forall v. AdditiveGroup v => v -> v -> v
^-^ Vec
f0)

-- | Quadratic approximation to vector field.
--   Quadratic approximation to curve.
--   Composite strategy.
--   Crossed line integral.
compositeSimpsonCrossedLineIntegral
    :: Int          -- ^ number of half-intervals
                    --   (one less than the number of function evaluations)
    -> VectorField  -- ^ vector field
    -> Curve        -- ^ curve to integrate over
    -> Vec          -- ^ vector result
compositeSimpsonCrossedLineIntegral :: Int -> VectorField -> Curve -> Vec
compositeSimpsonCrossedLineIntegral Int
n VectorField
vf (Curve R -> Position
c R
a R
b)
    = let nEven :: Int
nEven = Int
2 forall a. Num a => a -> a -> a
* forall a. Integral a => a -> a -> a
div Int
n Int
2
          dt :: R
dt = (R
b forall a. Num a => a -> a -> a
- R
a) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nEven
          ts :: [R]
ts = [R
a forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m forall a. Num a => a -> a -> a
* R
dt | Int
m <- [Int
0..Int
nEven]]
          pairs :: [(Position, Vec)]
pairs = [(Position
ct,VectorField
vf Position
ct) | R
t <- [R]
ts, let ct :: Position
ct = R -> Position
c R
t]
          combine :: [(Position, Vec)] -> Vec
combine [] = forall a. HasCallStack => [Char] -> a
error [Char]
"compositeSimpson: odd number of half-intervals" -- this should never happen
          combine [(Position, Vec)
_] = forall v. AdditiveGroup v => v
zeroV
          combine ((Position, Vec)
_:(Position, Vec)
_:[]) = forall a. HasCallStack => [Char] -> a
error [Char]
"compositeSimpson: odd number of half-intervals" -- this should never happen
          combine ((Position
c0,Vec
f0):(Position
c1,Vec
f1):(Position
c2,Vec
f2):[(Position, Vec)]
ps)
              = Vec -> Vec -> Vec -> Vec -> Vec -> Vec
crossedSimp Vec
f0 Vec
f1 Vec
f2 (Position -> VectorField
displacement Position
c0 Position
c1) (Position -> VectorField
displacement Position
c1 Position
c2)
                forall v. AdditiveGroup v => v -> v -> v
^+^ [(Position, Vec)] -> Vec
combine ((Position
c2,Vec
f2)forall a. a -> [a] -> [a]
:[(Position, Vec)]
ps)
      in [(Position, Vec)] -> Vec
combine [(Position, Vec)]
pairs