{-# OPTIONS -Wall #-}

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

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

module LPFPCore.Charge where

import LPFPCore.SimpleVec ( R, Vec, vec, sumV, (*^), (^/), (<.>), magnitude, negateV )
import LPFPCore.Electricity ( elementaryCharge )
import LPFPCore.CoordinateSystems ( Position, ScalarField, origin, cart, sph
                         , rVF, displacement, shiftPosition )
import LPFPCore.Geometry ( Curve(..), Surface(..), Volume(..)
                , straightLine, shiftSurface, disk )
import LPFPCore.Integrals
    ( scalarLineIntegral, scalarSurfaceIntegral, scalarVolumeIntegral
    , vectorLineIntegral, vectorSurfaceIntegral, vectorVolumeIntegral
    , curveSample, surfaceSample, volumeSample )

type Charge = R

data ChargeDistribution
    = PointCharge   Charge      Position
    | LineCharge    ScalarField Curve
    | SurfaceCharge ScalarField Surface
    | VolumeCharge  ScalarField Volume
    | MultipleCharges [ChargeDistribution]

protonOrigin :: ChargeDistribution
protonOrigin :: ChargeDistribution
protonOrigin = Charge -> Position -> ChargeDistribution
PointCharge Charge
elementaryCharge Position
origin

chargedLine :: Charge -> R -> ChargeDistribution
chargedLine :: Charge -> Charge -> ChargeDistribution
chargedLine Charge
q Charge
len
    = ScalarField -> Curve -> ChargeDistribution
LineCharge (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Charge
q forall a. Fractional a => a -> a -> a
/ Charge
len) forall a b. (a -> b) -> a -> b
$
      (Charge -> Position) -> Charge -> Charge -> Curve
Curve (\Charge
z -> Charge -> Charge -> Charge -> Position
cart Charge
0 Charge
0 Charge
z) (-Charge
lenforall a. Fractional a => a -> a -> a
/Charge
2) (Charge
lenforall a. Fractional a => a -> a -> a
/Charge
2)

chargedBall :: Charge -> R -> ChargeDistribution
chargedBall :: Charge -> Charge -> ChargeDistribution
chargedBall Charge
q Charge
radius
    = ScalarField -> Volume -> ChargeDistribution
VolumeCharge (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Charge
q forall a. Fractional a => a -> a -> a
/ (Charge
4forall a. Fractional a => a -> a -> a
/Charge
3forall a. Num a => a -> a -> a
*forall a. Floating a => a
piforall a. Num a => a -> a -> a
*Charge
radiusforall a. Floating a => a -> a -> a
**Charge
3)) forall a b. (a -> b) -> a -> b
$
      ((Charge, Charge, Charge) -> Position)
-> Charge
-> Charge
-> (Charge -> Charge)
-> (Charge -> Charge)
-> (Charge -> Charge -> Charge)
-> (Charge -> Charge -> Charge)
-> Volume
Volume (\(Charge
r,Charge
theta,Charge
phi) -> Charge -> Charge -> Charge -> Position
sph Charge
r Charge
theta Charge
phi)
                 Charge
0 Charge
radius (forall a b. a -> b -> a
const Charge
0) (forall a b. a -> b -> a
const forall a. Floating a => a
pi) (\Charge
_ Charge
_ -> Charge
0) (\Charge
_ Charge
_ -> Charge
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi)

diskCap :: R -> R -> R -> ChargeDistribution
diskCap :: Charge -> Charge -> Charge -> ChargeDistribution
diskCap Charge
radius Charge
plateSep Charge
sigma
    = [ChargeDistribution] -> ChargeDistribution
MultipleCharges
      [ScalarField -> Surface -> ChargeDistribution
SurfaceCharge (forall a b. a -> b -> a
const Charge
sigma) forall a b. (a -> b) -> a -> b
$
       Vec -> Surface -> Surface
shiftSurface (Charge -> Charge -> Charge -> Vec
vec Charge
0 Charge
0 (Charge
plateSepforall a. Fractional a => a -> a -> a
/Charge
2)) (Charge -> Surface
disk Charge
radius)
      ,ScalarField -> Surface -> ChargeDistribution
SurfaceCharge (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ -Charge
sigma) forall a b. (a -> b) -> a -> b
$
       Vec -> Surface -> Surface
shiftSurface (Charge -> Charge -> Charge -> Vec
vec Charge
0 Charge
0 (-Charge
plateSepforall a. Fractional a => a -> a -> a
/Charge
2)) (Charge -> Surface
disk Charge
radius)
      ]

totalCharge :: ChargeDistribution -> Charge
totalCharge :: ChargeDistribution -> Charge
totalCharge (PointCharge   Charge
q      Position
_)
    = Charge
q
totalCharge (LineCharge    ScalarField
lambda Curve
c)
    = CurveApprox -> ScalarField -> Curve -> Charge
scalarLineIntegral    (Int -> CurveApprox
curveSample  Int
1000) ScalarField
lambda Curve
c
totalCharge (SurfaceCharge ScalarField
sigma  Surface
s)
    = SurfaceApprox -> ScalarField -> Surface -> Charge
scalarSurfaceIntegral (Int -> SurfaceApprox
surfaceSample Int
200) ScalarField
sigma Surface
s
totalCharge (VolumeCharge  ScalarField
rho    Volume
v)
    = VolumeApprox -> ScalarField -> Volume -> Charge
scalarVolumeIntegral  (Int -> VolumeApprox
volumeSample   Int
50) ScalarField
rho Volume
v
totalCharge (MultipleCharges [ChargeDistribution]
ds    )
    = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ChargeDistribution -> Charge
totalCharge ChargeDistribution
d | ChargeDistribution
d <- [ChargeDistribution]
ds]

simpleDipole :: Vec  -- electric dipole moment
             -> R    -- charge separation
             -> ChargeDistribution
simpleDipole :: Vec -> Charge -> ChargeDistribution
simpleDipole Vec
p Charge
sep
    = let q :: Charge
q    = Vec -> Charge
magnitude Vec
p forall a. Fractional a => a -> a -> a
/ Charge
sep
          disp :: Vec
disp = (Charge
sepforall a. Fractional a => a -> a -> a
/Charge
2) Charge -> Vec -> Vec
*^ (Vec
p Vec -> Charge -> Vec
^/ Vec -> Charge
magnitude Vec
p)
      in [ChargeDistribution] -> ChargeDistribution
MultipleCharges
             [Charge -> Position -> ChargeDistribution
PointCharge   Charge
q  (Vec -> Position -> Position
shiftPosition          Vec
disp  Position
origin)
             ,Charge -> Position -> ChargeDistribution
PointCharge (-Charge
q) (Vec -> Position -> Position
shiftPosition (Vec -> Vec
negateV Vec
disp) Position
origin)
             ]

electricDipoleMoment :: ChargeDistribution -> Vec
electricDipoleMoment :: ChargeDistribution -> Vec
electricDipoleMoment (PointCharge   Charge
q      Position
r)
    = Charge
q Charge -> Vec -> Vec
*^ Position -> Position -> Vec
displacement Position
origin Position
r
electricDipoleMoment (LineCharge    ScalarField
lambda Curve
c)
    = CurveApprox -> (Position -> Vec) -> Curve -> Vec
vectorLineIntegral    (Int -> CurveApprox
curveSample  Int
1000) (\Position
r -> ScalarField
lambda Position
r Charge -> Vec -> Vec
*^ Position -> Vec
rVF Position
r) Curve
c
electricDipoleMoment (SurfaceCharge ScalarField
sigma  Surface
s)
    = SurfaceApprox -> (Position -> Vec) -> Surface -> Vec
vectorSurfaceIntegral (Int -> SurfaceApprox
surfaceSample Int
200) (\Position
r -> ScalarField
sigma  Position
r Charge -> Vec -> Vec
*^ Position -> Vec
rVF Position
r) Surface
s
electricDipoleMoment (VolumeCharge  ScalarField
rho    Volume
v)
    = VolumeApprox -> (Position -> Vec) -> Volume -> Vec
vectorVolumeIntegral  (Int -> VolumeApprox
volumeSample   Int
50) (\Position
r -> ScalarField
rho    Position
r Charge -> Vec -> Vec
*^ Position -> Vec
rVF Position
r) Volume
v
electricDipoleMoment (MultipleCharges [ChargeDistribution]
ds    )
    = [Vec] -> Vec
sumV [ChargeDistribution -> Vec
electricDipoleMoment ChargeDistribution
d | ChargeDistribution
d <- [ChargeDistribution]
ds]

lineDipole :: Vec  -- dipole moment
           -> R    -- charge separation
           -> ChargeDistribution
lineDipole :: Vec -> Charge -> ChargeDistribution
lineDipole Vec
p Charge
sep
    = let disp :: Vec
disp = (Charge
sepforall a. Fractional a => a -> a -> a
/Charge
2) Charge -> Vec -> Vec
*^ (Vec
p Vec -> Charge -> Vec
^/ Vec -> Charge
magnitude Vec
p)
          curve :: Curve
curve = Position -> Position -> Curve
straightLine (Vec -> Position -> Position
shiftPosition (Vec -> Vec
negateV Vec
disp) Position
origin)
                               (Vec -> Position -> Position
shiftPosition          Vec
disp  Position
origin)
          coeff :: Charge
coeff = Charge
12 forall a. Fractional a => a -> a -> a
/ Charge
sepforall a. Floating a => a -> a -> a
**Charge
3
          lambda :: ScalarField
lambda Position
r = Charge
coeff forall a. Num a => a -> a -> a
* (Position -> Position -> Vec
displacement Position
origin Position
r Vec -> Vec -> Charge
<.> Vec
p)
      in ScalarField -> Curve -> ChargeDistribution
LineCharge ScalarField
lambda Curve
curve

chargedDisk :: Charge -> R -> ChargeDistribution
chargedDisk :: Charge -> Charge -> ChargeDistribution
chargedDisk Charge
q Charge
radius = forall a. HasCallStack => a
undefined Charge
q Charge
radius

circularLineCharge :: Charge -> R -> ChargeDistribution
circularLineCharge :: Charge -> Charge -> ChargeDistribution
circularLineCharge Charge
q Charge
radius = forall a. HasCallStack => a
undefined Charge
q Charge
radius

chargedSquarePlate :: Charge -> R -> ChargeDistribution
chargedSquarePlate :: Charge -> Charge -> ChargeDistribution
chargedSquarePlate Charge
q Charge
side = forall a. HasCallStack => a
undefined Charge
q Charge
side

chargedSphericalShell :: Charge -> R -> ChargeDistribution
chargedSphericalShell :: Charge -> Charge -> ChargeDistribution
chargedSphericalShell Charge
q Charge
radius = forall a. HasCallStack => a
undefined Charge
q Charge
radius

chargedCube :: Charge -> R -> ChargeDistribution
chargedCube :: Charge -> Charge -> ChargeDistribution
chargedCube Charge
q Charge
side = forall a. HasCallStack => a
undefined Charge
q Charge
side

squareCap :: R -> R -> R -> ChargeDistribution
squareCap :: Charge -> Charge -> Charge -> ChargeDistribution
squareCap Charge
side Charge
plateSep Charge
sigma = forall a. HasCallStack => a
undefined Charge
side Charge
plateSep Charge
sigma

hydrogen :: ChargeDistribution
hydrogen :: ChargeDistribution
hydrogen = forall a. HasCallStack => a
undefined