{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE Safe #-}
module Physics.Learn.Curve
(
Curve(..)
, normalizeCurve
, concatCurves
, concatenateCurves
, reverseCurve
, evalCurve
, shiftCurve
, straightLine
, 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
)
data Curve = Curve { Curve -> R -> Position
curveFunc :: Double -> Position
, Curve -> R
startingCurveParam :: Double
, Curve -> R
endingCurveParam :: Double
}
dottedLineIntegral
:: Int
-> VectorField
-> Curve
-> Double
dottedLineIntegral :: Int -> VectorField -> Curve -> R
dottedLineIntegral = Int -> VectorField -> Curve -> R
compositeSimpsonDottedLineIntegral
crossedLineIntegral
:: Int
-> VectorField
-> Curve
-> Vec
crossedLineIntegral :: Int -> VectorField -> Curve -> Vec
crossedLineIntegral = Int -> VectorField -> Curve -> Vec
compositeSimpsonCrossedLineIntegral
compositeTrapezoidDottedLineIntegral
:: Int
-> VectorField
-> Curve
-> Double
compositeTrapezoidDottedLineIntegral :: Int -> VectorField -> Curve -> R
compositeTrapezoidDottedLineIntegral Int
n VectorField
vf (Curve R -> Position
f R
a R
b)
= [R] -> R
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([R] -> R) -> [R] -> R
forall a b. (a -> b) -> a -> b
$ (Vec -> Vec -> R) -> [Vec] -> [Vec] -> [R]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Vec -> Vec -> R
Vec -> Vec -> Scalar Vec
forall v. InnerSpace v => v -> v -> Scalar v
(<.>) [Vec]
aveVecs [Vec]
dls
where
dt :: R
dt = (R
b R -> R -> R
forall a. Num a => a -> a -> a
- R
a) R -> R -> R
forall a. Fractional a => a -> a -> a
/ Int -> R
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
aR -> R -> R
forall a. Num a => a -> a -> a
+R
dt..R
b]]
vecs :: [Vec]
vecs = [VectorField
vf Position
pt | Position
pt <- [Position]
pts]
aveVecs :: [Vec]
aveVecs = (Vec -> Vec -> Vec) -> [Vec] -> [Vec] -> [Vec]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Vec -> Vec -> Vec
forall v. (VectorSpace v, Scalar v ~ R) => v -> v -> v
average [Vec]
vecs ([Vec] -> [Vec]
forall a. HasCallStack => [a] -> [a]
tail [Vec]
vecs)
dls :: [Vec]
dls = (Position -> VectorField) -> [Position] -> [Position] -> [Vec]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Position -> VectorField
displacement [Position]
pts ([Position] -> [Position]
forall a. HasCallStack => [a] -> [a]
tail [Position]
pts)
compositeTrapezoidCrossedLineIntegral
:: Int
-> VectorField
-> Curve
-> Vec
compositeTrapezoidCrossedLineIntegral :: Int -> VectorField -> Curve -> Vec
compositeTrapezoidCrossedLineIntegral Int
n VectorField
vf (Curve R -> Position
f R
a R
b)
= [Vec] -> Vec
forall (f :: * -> *) v. (Foldable f, AdditiveGroup v) => f v -> v
sumV ([Vec] -> Vec) -> [Vec] -> Vec
forall a b. (a -> b) -> a -> b
$ (Vec -> Vec -> Vec) -> [Vec] -> [Vec] -> [Vec]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Vec -> Vec -> Vec
(><) [Vec]
aveVecs [Vec]
dls
where
dt :: R
dt = (R
b R -> R -> R
forall a. Num a => a -> a -> a
- R
a) R -> R -> R
forall a. Fractional a => a -> a -> a
/ Int -> R
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
aR -> R -> R
forall a. Num a => a -> a -> a
+R
dt..R
b]]
vecs :: [Vec]
vecs = [VectorField
vf Position
pt | Position
pt <- [Position]
pts]
aveVecs :: [Vec]
aveVecs = (Vec -> Vec -> Vec) -> [Vec] -> [Vec] -> [Vec]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Vec -> Vec -> Vec
forall v. (VectorSpace v, Scalar v ~ R) => v -> v -> v
average [Vec]
vecs ([Vec] -> [Vec]
forall a. HasCallStack => [a] -> [a]
tail [Vec]
vecs)
dls :: [Vec]
dls = (Position -> VectorField) -> [Position] -> [Position] -> [Vec]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Position -> VectorField
displacement [Position]
pts ([Position] -> [Position]
forall a. HasCallStack => [a] -> [a]
tail [Position]
pts)
simpleLineIntegral
:: (InnerSpace v, Scalar v ~ Double)
=> Int
-> Field v
-> Curve
-> v
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)
= [v] -> v
forall (f :: * -> *) v. (Foldable f, AdditiveGroup v) => f v -> v
sumV ([v] -> v) -> [v] -> v
forall a b. (a -> b) -> a -> b
$ (v -> R -> v) -> [v] -> [R] -> [v]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith v -> R -> v
forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
(^*) [v]
aveVecs ((Vec -> R) -> [Vec] -> [R]
forall a b. (a -> b) -> [a] -> [b]
map Vec -> R
forall v s. (InnerSpace v, s ~ Scalar v, Floating s) => v -> s
magnitude [Vec]
dls)
where
dt :: R
dt = (R
b R -> R -> R
forall a. Num a => a -> a -> a
- R
a) R -> R -> R
forall a. Fractional a => a -> a -> a
/ Int -> R
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
aR -> R -> R
forall 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 = (v -> v -> v) -> [v] -> [v] -> [v]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith v -> v -> v
forall v. (VectorSpace v, Scalar v ~ R) => v -> v -> v
average [v]
vecs ([v] -> [v]
forall a. HasCallStack => [a] -> [a]
tail [v]
vecs)
dls :: [Vec]
dls = (Position -> VectorField) -> [Position] -> [Position] -> [Vec]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Position -> VectorField
displacement [Position]
pts ([Position] -> [Position]
forall a. HasCallStack => [a] -> [a]
tail [Position]
pts)
normalizeCurve :: Curve -> Curve
normalizeCurve :: Curve -> Curve
normalizeCurve (Curve R -> Position
f R
a R
b)
= (R -> Position) -> R -> R -> Curve
Curve (R -> Position
f (R -> Position) -> (R -> R) -> R -> Position
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 R -> R -> R
forall a. Num a => a -> a -> a
+ (R
b R -> R -> R
forall a. Num a => a -> a -> a
- R
a) R -> R -> R
forall a. Num a => a -> a -> a
* R
t
concatCurves :: Curve
-> Curve
-> Curve
concatCurves :: Curve -> Curve -> Curve
concatCurves Curve
c1 Curve
c2
= Curve -> Curve
normalizeCurve (Curve -> Curve) -> Curve -> Curve
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 R -> R -> Bool
forall a. Ord a => a -> a -> Bool
<= R
1 = R -> Position
f1 R
t
| Bool
otherwise = R -> Position
f2 (R
tR -> R -> R
forall a. Num a => a -> a -> a
-R
1)
concatenateCurves :: [Curve] -> Curve
concatenateCurves :: [Curve] -> Curve
concatenateCurves [] = [Char] -> Curve
forall a. HasCallStack => [Char] -> a
error [Char]
"concatenateCurves: cannot concatenate empty list"
concatenateCurves [Curve]
cs = Curve -> Curve
normalizeCurve (Curve -> Curve) -> Curve -> Curve
forall a b. (a -> b) -> a -> b
$ (R -> Position) -> R -> R -> Curve
Curve R -> Position
f R
0 (Int -> R
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
where
n :: Int
n = [Curve] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Curve]
cs
ncs :: [Curve]
ncs = (Curve -> Curve) -> [Curve] -> [Curve]
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 [Curve] -> Int -> Curve
forall a. HasCallStack => [a] -> Int -> a
!! Int
m) (R
t R -> R -> R
forall a. Num a => a -> a -> a
- Int -> R
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)
where m :: Int
m = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (R -> Int
forall b. Integral b => R -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor R
t)
reverseCurve :: Curve -> Curve
reverseCurve :: Curve -> Curve
reverseCurve (Curve R -> Position
f R
a R
b)
= (R -> Position) -> R -> R -> Curve
Curve (R -> Position
f (R -> Position) -> (R -> R) -> R -> Position
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 R -> R -> R
forall a. Num a => a -> a -> a
+ R
b R -> R -> R
forall a. Num a => a -> a -> a
- R
t
evalCurve :: Curve
-> Double
-> Position
evalCurve :: Curve -> R -> Position
evalCurve (Curve R -> Position
f R
_ R
_) R
t = R -> Position
f R
t
shiftCurve :: Displacement
-> Curve
-> 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 (Position -> Position) -> (R -> Position) -> R -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R -> Position
f) R
sl R
su
straightLine :: Position
-> Position
-> 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
Scalar Vec
t Scalar Vec -> Vec -> Vec
forall v. VectorSpace v => Scalar v -> v -> v
*^ Vec
d) Position
r1
d :: Vec
d = Position -> VectorField
displacement Position
r1 Position
r2
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 v -> v -> v
forall v. AdditiveGroup v => v -> v -> v
^+^ v
v2) v -> R -> v
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ R
2
dottedSimp :: (InnerSpace v, Fractional (Scalar v)) =>
v
-> v
-> v
-> v
-> v
-> Scalar v
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 v -> v -> v
forall v. AdditiveGroup v => v -> v -> v
^+^ v
g10) v -> Scalar v -> v
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ Scalar v
6) v -> v -> Scalar v
forall v. InnerSpace v => v -> v -> Scalar v
<.> (v
f0 v -> v -> v
forall v. AdditiveGroup v => v -> v -> v
^+^ Scalar v
4 Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
*^ v
f1 v -> v -> v
forall v. AdditiveGroup v => v -> v -> v
^+^ v
f2)
Scalar v -> Scalar v -> Scalar v
forall a. Num a => a -> a -> a
+ ((v
g21 v -> v -> v
forall v. AdditiveGroup v => v -> v -> v
^-^ v
g10) v -> Scalar v -> v
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ Scalar v
3) v -> v -> Scalar v
forall v. InnerSpace v => v -> v -> Scalar v
<.> (v
f2 v -> v -> v
forall v. AdditiveGroup v => v -> v -> v
^-^ v
f0)
compositeSimpsonDottedLineIntegral
:: Int
-> VectorField
-> Curve
-> Double
compositeSimpsonDottedLineIntegral :: Int -> VectorField -> Curve -> R
compositeSimpsonDottedLineIntegral Int
n VectorField
vf (Curve R -> Position
c R
a R
b)
= let nEven :: Int
nEven = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
n Int
2
dt :: R
dt = (R
b R -> R -> R
forall a. Num a => a -> a -> a
- R
a) R -> R -> R
forall a. Fractional a => a -> a -> a
/ Int -> R
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nEven
ts :: [R]
ts = [R
a R -> R -> R
forall a. Num a => a -> a -> a
+ Int -> R
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m R -> R -> R
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 [] = [Char] -> R
forall a. HasCallStack => [Char] -> a
error [Char]
"compositeSimpson: odd number of half-intervals"
combine [(Position, Vec)
_] = R
forall v. AdditiveGroup v => v
zeroV
combine ((Position, Vec)
_:(Position, Vec)
_:[]) = [Char] -> R
forall a. HasCallStack => [Char] -> a
error [Char]
"compositeSimpson: odd number of half-intervals"
combine ((Position
c0,Vec
f0):(Position
c1,Vec
f1):(Position
c2,Vec
f2):[(Position, Vec)]
ps)
= Vec -> Vec -> Vec -> Vec -> Vec -> Scalar Vec
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)
R -> R -> R
forall v. AdditiveGroup v => v -> v -> v
^+^ [(Position, Vec)] -> R
combine ((Position
c2,Vec
f2)(Position, Vec) -> [(Position, Vec)] -> [(Position, Vec)]
forall a. a -> [a] -> [a]
:[(Position, Vec)]
ps)
in [(Position, Vec)] -> R
combine [(Position, Vec)]
pairs
crossedSimp :: Vec
-> Vec
-> Vec
-> Vec
-> Vec
-> Vec
crossedSimp :: Vec -> Vec -> Vec -> Vec -> Vec -> Vec
crossedSimp Vec
f0 Vec
f1 Vec
f2 Vec
g10 Vec
g21
= Vec -> Vec
forall v. AdditiveGroup v => v -> v
negateV (Vec -> Vec) -> Vec -> Vec
forall a b. (a -> b) -> a -> b
$
((Vec
g21 Vec -> Vec -> Vec
forall v. AdditiveGroup v => v -> v -> v
^+^ Vec
g10) Vec -> R -> Vec
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ R
6) Vec -> Vec -> Vec
>< (Vec
f0 Vec -> Vec -> Vec
forall v. AdditiveGroup v => v -> v -> v
^+^ R
Scalar Vec
4 Scalar Vec -> Vec -> Vec
forall v. VectorSpace v => Scalar v -> v -> v
*^ Vec
f1 Vec -> Vec -> Vec
forall v. AdditiveGroup v => v -> v -> v
^+^ Vec
f2)
Vec -> Vec -> Vec
forall v. AdditiveGroup v => v -> v -> v
^+^ ((Vec
g21 Vec -> Vec -> Vec
forall v. AdditiveGroup v => v -> v -> v
^-^ Vec
g10) Vec -> R -> Vec
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ R
3) Vec -> Vec -> Vec
>< (Vec
f2 Vec -> Vec -> Vec
forall v. AdditiveGroup v => v -> v -> v
^-^ Vec
f0)
compositeSimpsonCrossedLineIntegral
:: Int
-> VectorField
-> Curve
-> Vec
compositeSimpsonCrossedLineIntegral :: Int -> VectorField -> Curve -> Vec
compositeSimpsonCrossedLineIntegral Int
n VectorField
vf (Curve R -> Position
c R
a R
b)
= let nEven :: Int
nEven = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
n Int
2
dt :: R
dt = (R
b R -> R -> R
forall a. Num a => a -> a -> a
- R
a) R -> R -> R
forall a. Fractional a => a -> a -> a
/ Int -> R
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nEven
ts :: [R]
ts = [R
a R -> R -> R
forall a. Num a => a -> a -> a
+ Int -> R
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m R -> R -> R
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 [] = [Char] -> Vec
forall a. HasCallStack => [Char] -> a
error [Char]
"compositeSimpson: odd number of half-intervals"
combine [(Position, Vec)
_] = Vec
forall v. AdditiveGroup v => v
zeroV
combine ((Position, Vec)
_:(Position, Vec)
_:[]) = [Char] -> Vec
forall a. HasCallStack => [Char] -> a
error [Char]
"compositeSimpson: odd number of half-intervals"
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)
Vec -> Vec -> Vec
forall v. AdditiveGroup v => v -> v -> v
^+^ [(Position, Vec)] -> Vec
combine ((Position
c2,Vec
f2)(Position, Vec) -> [(Position, Vec)] -> [(Position, Vec)]
forall a. a -> [a] -> [a]
:[(Position, Vec)]
ps)
in [(Position, Vec)] -> Vec
combine [(Position, Vec)]
pairs