{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE Safe #-}
module Physics.Learn.Surface
(
Surface(..)
, unitSphere
, centeredSphere
, sphere
, northernHemisphere
, disk
, shiftSurface
, surfaceIntegral
, dottedSurfaceIntegral
)
where
import Data.VectorSpace
( VectorSpace
, InnerSpace
, Scalar
)
import Physics.Learn.CarrotVec
( vec
, (^+^)
, (^-^)
, (^*)
, (^/)
, (<.>)
, (><)
, magnitude
, sumV
)
import Physics.Learn.Position
( Position
, Displacement
, VectorField
, Field
, cart
, cyl
, shiftPosition
, displacement
)
data Surface = Surface { Surface -> (Double, Double) -> Position
surfaceFunc :: (Double,Double) -> Position
, Surface -> Double
lowerLimit :: Double
, Surface -> Double
upperLimit :: Double
, Surface -> Double -> Double
lowerCurve :: Double -> Double
, Surface -> Double -> Double
upperCurve :: Double -> Double
}
unitSphere :: Surface
unitSphere :: Surface
unitSphere = ((Double, Double) -> Position)
-> Double
-> Double
-> (Double -> Double)
-> (Double -> Double)
-> Surface
Surface (\(Double
th,Double
phi) -> Double -> Double -> Double -> Position
cart (forall a. Floating a => a -> a
sin Double
th forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos Double
phi) (forall a. Floating a => a -> a
sin Double
th forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin Double
phi) (forall a. Floating a => a -> a
cos Double
th))
Double
0 forall a. Floating a => a
pi (forall a b. a -> b -> a
const Double
0) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Double
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi)
centeredSphere :: Double -> Surface
centeredSphere :: Double -> Surface
centeredSphere Double
r = ((Double, Double) -> Position)
-> Double
-> Double
-> (Double -> Double)
-> (Double -> Double)
-> Surface
Surface (\(Double
th,Double
phi) -> Double -> Double -> Double -> Position
cart (Double
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin Double
th forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos Double
phi) (Double
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin Double
th forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin Double
phi) (Double
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos Double
th))
Double
0 forall a. Floating a => a
pi (forall a b. a -> b -> a
const Double
0) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Double
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi)
sphere :: Double -> Position -> Surface
sphere :: Double -> Position -> Surface
sphere Double
r Position
c = ((Double, Double) -> Position)
-> Double
-> Double
-> (Double -> Double)
-> (Double -> Double)
-> Surface
Surface (\(Double
th,Double
phi) -> Vec -> Position -> Position
shiftPosition (Double -> Double -> Double -> Vec
vec (Double
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin Double
th forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos Double
phi) (Double
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin Double
th forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin Double
phi) (Double
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos Double
th)) Position
c)
Double
0 forall a. Floating a => a
pi (forall a b. a -> b -> a
const Double
0) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Double
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi)
northernHemisphere :: Surface
northernHemisphere :: Surface
northernHemisphere = ((Double, Double) -> Position)
-> Double
-> Double
-> (Double -> Double)
-> (Double -> Double)
-> Surface
Surface (\(Double
th,Double
phi) -> Double -> Double -> Double -> Position
cart (forall a. Floating a => a -> a
sin Double
th forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos Double
phi) (forall a. Floating a => a -> a
sin Double
th forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin Double
phi) (forall a. Floating a => a -> a
cos Double
th))
Double
0 (forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/Double
2) (forall a b. a -> b -> a
const Double
0) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Double
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi)
disk :: Double -> Surface
disk :: Double -> Surface
disk Double
radius = ((Double, Double) -> Position)
-> Double
-> Double
-> (Double -> Double)
-> (Double -> Double)
-> Surface
Surface (\(Double
s,Double
phi) -> Double -> Double -> Double -> Position
cyl Double
s Double
phi Double
0) Double
0 Double
radius (forall a b. a -> b -> a
const Double
0) (forall a b. a -> b -> a
const (Double
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi))
surfaceIntegral :: (VectorSpace v, Scalar v ~ Double) =>
Int
-> Int
-> Field v
-> Surface
-> v
surfaceIntegral :: forall v.
(VectorSpace v, Scalar v ~ Double) =>
Int -> Int -> Field v -> Surface -> v
surfaceIntegral Int
n1 Int
n2 Field v
field (Surface (Double, Double) -> Position
f Double
s_l Double
s_u Double -> Double
t_l Double -> Double
t_u)
= forall (f :: * -> *) v. (Foldable f, AdditiveGroup v) => f v -> v
sumV forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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 a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
(^*)) [[v]]
aveVals (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall v s. (InnerSpace v, s ~ Scalar v, Floating s) => v -> s
magnitude) [[Vec]]
areas)
where
pts :: [[Position]]
pts = [[(Double, Double) -> Position
f (Double
s,Double
t) | Double
t <- Int -> Double -> Double -> [Double]
linSpaced Int
n2 (Double -> Double
t_l Double
s) (Double -> Double
t_u Double
s)] | Double
s <- Int -> Double -> Double -> [Double]
linSpaced Int
n1 Double
s_l Double
s_u]
areas :: [[Vec]]
areas = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Vec -> Vec -> Vec
(><)) [[Vec]]
dus [[Vec]]
dvs
dus :: [[Vec]]
dus = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Position -> Position -> Vec
displacement) [[Position]]
pts (forall a. [a] -> [a]
tail [[Position]]
pts)
dvs :: [[Vec]]
dvs = forall a b. (a -> b) -> [a] -> [b]
map (\[Position]
row -> forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Position -> Position -> Vec
displacement [Position]
row (forall a. [a] -> [a]
tail [Position]
row)) [[Position]]
pts
vals :: [[v]]
vals = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map Field v
field) [[Position]]
pts
halfAveVals :: [[v]]
halfAveVals = forall a b. (a -> b) -> [a] -> [b]
map (\[v]
row -> forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall v. (VectorSpace v, Scalar v ~ Double) => v -> v -> v
ave (forall a. [a] -> [a]
tail [v]
row) [v]
row) [[v]]
vals
aveVals :: [[v]]
aveVals = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall v. (VectorSpace v, Scalar v ~ Double) => v -> v -> v
ave) (forall a. [a] -> [a]
tail [[v]]
halfAveVals) [[v]]
halfAveVals
dottedSurfaceIntegral :: Int
-> Int
-> VectorField
-> Surface
-> Double
dottedSurfaceIntegral :: Int -> Int -> (Position -> Vec) -> Surface -> Double
dottedSurfaceIntegral Int
n1 Int
n2 Position -> Vec
vf (Surface (Double, Double) -> Position
f Double
s_l Double
s_u Double -> Double
t_l Double -> Double
t_u)
= forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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 a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall v. InnerSpace v => v -> v -> Scalar v
(<.>)) [[Vec]]
aveVals [[Vec]]
areas
where
pts :: [[Position]]
pts = [[(Double, Double) -> Position
f (Double
s,Double
t) | Double
t <- Int -> Double -> Double -> [Double]
linSpaced Int
n2 (Double -> Double
t_l Double
s) (Double -> Double
t_u Double
s)] | Double
s <- Int -> Double -> Double -> [Double]
linSpaced Int
n1 Double
s_l Double
s_u]
areas :: [[Vec]]
areas = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Vec -> Vec -> Vec
(><)) [[Vec]]
dus [[Vec]]
dvs
dus :: [[Vec]]
dus = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Position -> Position -> Vec
displacement) [[Position]]
pts (forall a. [a] -> [a]
tail [[Position]]
pts)
dvs :: [[Vec]]
dvs = forall a b. (a -> b) -> [a] -> [b]
map (\[Position]
row -> forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Position -> Position -> Vec
displacement [Position]
row (forall a. [a] -> [a]
tail [Position]
row)) [[Position]]
pts
vals :: [[Vec]]
vals = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map Position -> Vec
vf) [[Position]]
pts
halfAveVals :: [[Vec]]
halfAveVals = forall a b. (a -> b) -> [a] -> [b]
map (\[Vec]
row -> forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall v. (VectorSpace v, Scalar v ~ Double) => v -> v -> v
ave (forall a. [a] -> [a]
tail [Vec]
row) [Vec]
row) [[Vec]]
vals
aveVals :: [[Vec]]
aveVals = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall v. (VectorSpace v, Scalar v ~ Double) => v -> v -> v
ave) (forall a. [a] -> [a]
tail [[Vec]]
halfAveVals) [[Vec]]
halfAveVals
linSpaced :: Int -> Double -> Double -> [Double]
linSpaced :: Int -> Double -> Double -> [Double]
linSpaced Int
n Double
a Double
b
| Double
a forall a. Ord a => a -> a -> Bool
< Double
b = let dx :: Double
dx = (Double
b forall a. Num a => a -> a -> a
- Double
a) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
in [Double
a,Double
aforall a. Num a => a -> a -> a
+Double
dx..Double
b]
| Double
a forall v. (InnerSpace v, Scalar v ~ Double) => v -> v -> Bool
~~ Double
b = [forall v. (VectorSpace v, Scalar v ~ Double) => v -> v -> v
ave Double
a Double
b]
| Bool
otherwise = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"linSpaced: lower limit greater than upper limit: (n,a,b) = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Int
n,Double
a,Double
b)
(~~) :: (InnerSpace v, Scalar v ~ Double) => v -> v -> Bool
v
a ~~ :: forall v. (InnerSpace v, Scalar v ~ Double) => v -> v -> Bool
~~ v
b = forall v s. (InnerSpace v, s ~ Scalar v, Floating s) => v -> s
magnitude (v
a forall v. AdditiveGroup v => v -> v -> v
^-^ v
b) forall a. Ord a => a -> a -> Bool
< Double
tolerance
tolerance :: Double
tolerance :: Double
tolerance = Double
1e-10
ave :: (VectorSpace v, Scalar v ~ Double) => v -> v -> v
ave :: forall v. (VectorSpace v, Scalar v ~ Double) => v -> v -> v
ave 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
^/ Double
2
shiftSurface :: Displacement -> Surface -> Surface
shiftSurface :: Vec -> Surface -> Surface
shiftSurface Vec
d (Surface (Double, Double) -> Position
f Double
sl Double
su Double -> Double
tl Double -> Double
tu)
= ((Double, Double) -> Position)
-> Double
-> Double
-> (Double -> Double)
-> (Double -> Double)
-> Surface
Surface (Vec -> Position -> Position
shiftPosition Vec
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> Position
f) Double
sl Double
su Double -> Double
tl Double -> Double
tu