{-# OPTIONS -Wall #-}

{- | 
Module      :  LPFPCore.CoordinateSystems
Copyright   :  (c) Scott N. Walck 2023
License     :  BSD3 (see LICENSE)
Maintainer  :  Scott N. Walck <walck@lvc.edu>
Stability   :  stable

Code from chapter 22 of the book Learn Physics with Functional Programming
-}

module LPFPCore.CoordinateSystems where

import LPFPCore.SimpleVec
    ( R, Vec, (^/), vec, xComp, yComp, zComp, iHat, jHat, kHat
    , magnitude, sumV, zeroV )
import LPFPCore.MOExamples ( Table(..), Justification(..) )

data Position = Cart R R R
                deriving (Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> String
$cshow :: Position -> String
showsPrec :: Int -> Position -> ShowS
$cshowsPrec :: Int -> Position -> ShowS
Show)

type CoordinateSystem = (R,R,R) -> Position

cartesian   :: CoordinateSystem
cartesian :: CoordinateSystem
cartesian (R
x,R
y,R
z)
    = R -> R -> R -> Position
Cart R
x R
y R
z

cylindrical :: CoordinateSystem
cylindrical :: CoordinateSystem
cylindrical (R
s,R
phi,R
z)
    = R -> R -> R -> Position
Cart (R
s forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos R
phi) (R
s forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin R
phi) R
z

spherical   :: CoordinateSystem
spherical :: CoordinateSystem
spherical (R
r,R
theta,R
phi)
    = R -> R -> R -> Position
Cart (R
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin R
theta forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos R
phi)
           (R
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin R
theta forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin R
phi)
           (R
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos R
theta)

cart :: R  -- x coordinate
     -> R  -- y coordinate
     -> R  -- z coordinate
     -> Position
cart :: R -> R -> R -> Position
cart = R -> R -> R -> Position
Cart

cyl  :: R  -- s   coordinate
     -> R  -- phi coordinate
     -> R  -- z   coordinate
     -> Position
cyl :: R -> R -> R -> Position
cyl R
s R
phi R
z = CoordinateSystem
cylindrical (R
s,R
phi,R
z)

sph  :: R  -- r     coordinate
     -> R  -- theta coordinate
     -> R  -- phi   coordinate
     -> Position
sph :: R -> R -> R -> Position
sph R
r R
theta R
phi = CoordinateSystem
spherical (R
r,R
theta,R
phi)

origin :: Position
origin :: Position
origin = R -> R -> R -> Position
cart R
0 R
0 R
0

cartesianCoordinates   :: Position -> (R,R,R)
cartesianCoordinates :: Position -> (R, R, R)
cartesianCoordinates   (Cart R
x R
y R
z) = (R
x,R
y,R
z)

cylindricalCoordinates :: Position -> (R,R,R)
cylindricalCoordinates :: Position -> (R, R, R)
cylindricalCoordinates (Cart R
x R
y R
z) = (R
s,R
phi,R
z)
    where
      s :: R
s = forall a. Floating a => a -> a
sqrt(R
xforall a. Floating a => a -> a -> a
**R
2 forall a. Num a => a -> a -> a
+ R
yforall a. Floating a => a -> a -> a
**R
2)
      phi :: R
phi = forall a. RealFloat a => a -> a -> a
atan2 R
y R
x

sphericalCoordinates   :: Position -> (R,R,R)
sphericalCoordinates :: Position -> (R, R, R)
sphericalCoordinates   (Cart R
x R
y R
z) = (R
r,R
theta,R
phi)
    where
      r :: R
r = forall a. Floating a => a -> a
sqrt(R
xforall a. Floating a => a -> a -> a
**R
2 forall a. Num a => a -> a -> a
+ R
yforall a. Floating a => a -> a -> a
**R
2 forall a. Num a => a -> a -> a
+ R
zforall a. Floating a => a -> a -> a
**R
2)
      theta :: R
theta = forall a. RealFloat a => a -> a -> a
atan2 R
s R
z
      s :: R
s = forall a. Floating a => a -> a
sqrt(R
xforall a. Floating a => a -> a -> a
**R
2 forall a. Num a => a -> a -> a
+ R
yforall a. Floating a => a -> a -> a
**R
2)
      phi :: R
phi = forall a. RealFloat a => a -> a -> a
atan2 R
y R
x

type Displacement = Vec

displacement :: Position  -- source position
             -> Position  -- target position
             -> Displacement
displacement :: Position -> Position -> Displacement
displacement (Cart R
x' R
y' R
z') (Cart R
x R
y R
z)
    = R -> R -> R -> Displacement
vec (R
xforall a. Num a => a -> a -> a
-R
x') (R
yforall a. Num a => a -> a -> a
-R
y') (R
zforall a. Num a => a -> a -> a
-R
z')

shiftPosition :: Displacement -> Position -> Position
shiftPosition :: Displacement -> Position -> Position
shiftPosition Displacement
v (Cart R
x R
y R
z)
  = R -> R -> R -> Position
Cart (R
x forall a. Num a => a -> a -> a
+ Displacement -> R
xComp Displacement
v) (R
y forall a. Num a => a -> a -> a
+ Displacement -> R
yComp Displacement
v) (R
z forall a. Num a => a -> a -> a
+ Displacement -> R
zComp Displacement
v)

type ScalarField = Position -> R

xSF :: ScalarField
xSF :: ScalarField
xSF Position
p = R
x
    where
      (R
x,R
_,R
_) = Position -> (R, R, R)
cartesianCoordinates Position
p

rSF :: ScalarField
rSF :: ScalarField
rSF Position
p = R
r
    where
      (R
r,R
_,R
_) = Position -> (R, R, R)
sphericalCoordinates Position
p

fst3 :: (a,b,c) -> a
fst3 :: forall a b c. (a, b, c) -> a
fst3 (a
u,b
_,c
_) = a
u

snd3 :: (a,b,c) -> b
snd3 :: forall a b c. (a, b, c) -> b
snd3 (a
_,b
u,c
_) = b
u

thd3 :: (a,b,c) -> c
thd3 :: forall a b c. (a, b, c) -> c
thd3 (a
_,b
_,c
u) = c
u

ySF :: ScalarField
ySF :: ScalarField
ySF = forall a b c. (a, b, c) -> b
snd3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> (R, R, R)
cartesianCoordinates

type VectorField = Position -> Vec

sHat   :: VectorField
sHat :: Position -> Displacement
sHat   Position
r = R -> R -> R -> Displacement
vec ( forall a. Floating a => a -> a
cos R
phi) (forall a. Floating a => a -> a
sin R
phi) R
0
    where
      (R
_,R
phi,R
_) = Position -> (R, R, R)
cylindricalCoordinates Position
r

phiHat :: VectorField
phiHat :: Position -> Displacement
phiHat Position
r = R -> R -> R -> Displacement
vec (-forall a. Floating a => a -> a
sin R
phi) (forall a. Floating a => a -> a
cos R
phi) R
0
    where
      (R
_,R
phi,R
_) = Position -> (R, R, R)
cylindricalCoordinates Position
r

rHat :: VectorField
rHat :: Position -> Displacement
rHat Position
rv = let d :: Displacement
d = Position -> Position -> Displacement
displacement Position
origin Position
rv
          in if Displacement
d forall a. Eq a => a -> a -> Bool
== Displacement
zeroV
             then Displacement
zeroV
             else Displacement
d Displacement -> R -> Displacement
^/ Displacement -> R
magnitude Displacement
d

thetaHat :: VectorField
thetaHat :: Position -> Displacement
thetaHat Position
r = R -> R -> R -> Displacement
vec ( forall a. Floating a => a -> a
cos R
theta forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos R
phi)
                 ( forall a. Floating a => a -> a
cos R
theta forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin R
phi)
                 (-forall a. Floating a => a -> a
sin R
theta          )
    where
      (R
_,R
theta,R
phi) = Position -> (R, R, R)
sphericalCoordinates Position
r

xHat :: VectorField
xHat :: Position -> Displacement
xHat = forall a b. a -> b -> a
const Displacement
iHat

yHat :: VectorField
yHat :: Position -> Displacement
yHat = forall a b. a -> b -> a
const Displacement
jHat

zHat :: VectorField
zHat :: Position -> Displacement
zHat = forall a b. a -> b -> a
const Displacement
kHat

rVF :: VectorField
rVF :: Position -> Displacement
rVF = Position -> Position -> Displacement
displacement Position
origin

addScalarFields :: [ScalarField] -> ScalarField
addScalarFields :: [ScalarField] -> ScalarField
addScalarFields [ScalarField]
flds Position
r = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum  [ScalarField
fld Position
r | ScalarField
fld <- [ScalarField]
flds]

addVectorFields :: [VectorField] -> VectorField
addVectorFields :: [Position -> Displacement] -> Position -> Displacement
addVectorFields [Position -> Displacement]
flds Position
r = [Displacement] -> Displacement
sumV [Position -> Displacement
fld Position
r | Position -> Displacement
fld <- [Position -> Displacement]
flds]

sfTable :: ((R,R) -> Position)
        -> [R]  -- horizontal
        -> [R]  -- vertical
        -> ScalarField
        -> Table Int
sfTable :: ((R, R) -> Position) -> [R] -> [R] -> ScalarField -> Table Int
sfTable (R, R) -> Position
toPos [R]
ss [R]
ts ScalarField
sf
    = forall a. Justification -> [[a]] -> Table a
Table Justification
RJ [[forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ ScalarField
sf forall a b. (a -> b) -> a -> b
$ (R, R) -> Position
toPos (R
s,R
t) | R
s <- [R]
ss] | R
t <- forall a. [a] -> [a]
reverse [R]
ts]

magRad :: (R,R) -> (R,R)
magRad :: (R, R) -> (R, R)
magRad (R
x,R
y) = (forall a. Floating a => a -> a
sqrt (R
xforall a. Num a => a -> a -> a
*R
x forall a. Num a => a -> a -> a
+ R
yforall a. Num a => a -> a -> a
*R
y), forall a. RealFloat a => a -> a -> a
atan2 R
y R
x)

thetaSF :: ScalarField
thetaSF :: ScalarField
thetaSF = forall a. HasCallStack => a
undefined

thetaHat3D :: IO ()
thetaHat3D :: IO ()
thetaHat3D = forall a. HasCallStack => a
undefined

phiHatGrad :: IO ()
phiHatGrad :: IO ()
phiHatGrad = forall a. HasCallStack => a
undefined