{-# OPTIONS -Wall #-}

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

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

module LPFPCore.MagneticField where

import LPFPCore.SimpleVec ( Vec(..), R
                 , (^-^), (*^), (^/), (<.>), (><)
                 , magnitude )
import LPFPCore.CoordinateSystems
    ( VectorField
    , rVF, displacement, addVectorFields )
import LPFPCore.Geometry ( Curve(..), Surface(..), Volume(..) )
import LPFPCore.ElectricField
    ( curveSample, surfaceSample, volumeSample
    , vectorSurfaceIntegral, vectorVolumeIntegral, mu0 )
import LPFPCore.Current
    ( Current, CurrentDistribution(..)
    , wireToroid, crossedLineIntegral, circularCurrentLoop )

bFieldFromLineCurrent
    :: Current      -- current (in Amps)
    -> Curve
    -> VectorField  -- magnetic field (in Tesla)
bFieldFromLineCurrent :: R -> Curve -> VectorField
bFieldFromLineCurrent R
i Curve
c Position
r
    = let coeff :: R
coeff = -R
mu0 R -> R -> R
forall a. Num a => a -> a -> a
* R
i R -> R -> R
forall a. Fractional a => a -> a -> a
/ (R
4 R -> R -> R
forall a. Num a => a -> a -> a
* R
forall a. Floating a => a
pi)  -- SI units
          integrand :: VectorField
integrand Position
r' = Displacement
d Displacement -> R -> Displacement
^/ Displacement -> R
magnitude Displacement
d R -> R -> R
forall a. Floating a => a -> a -> a
** R
3
              where d :: Displacement
d = Position -> VectorField
displacement Position
r' Position
r
      in R
coeff R -> Displacement -> Displacement
*^ CurveApprox -> VectorField -> Curve -> Displacement
crossedLineIntegral (Int -> CurveApprox
curveSample Int
1000) VectorField
integrand Curve
c

bField :: CurrentDistribution -> VectorField
bField :: CurrentDistribution -> VectorField
bField (LineCurrent    R
i  Curve
c) = R -> Curve -> VectorField
bFieldFromLineCurrent    R
i  Curve
c
bField (SurfaceCurrent VectorField
kC Surface
s) = VectorField -> Surface -> VectorField
bFieldFromSurfaceCurrent VectorField
kC Surface
s
bField (VolumeCurrent  VectorField
j  Volume
v) = VectorField -> Volume -> VectorField
bFieldFromVolumeCurrent  VectorField
j  Volume
v
bField (MultipleCurrents [CurrentDistribution]
cds) = [VectorField] -> VectorField
addVectorFields ([VectorField] -> VectorField) -> [VectorField] -> VectorField
forall a b. (a -> b) -> a -> b
$ (CurrentDistribution -> VectorField)
-> [CurrentDistribution] -> [VectorField]
forall a b. (a -> b) -> [a] -> [b]
map CurrentDistribution -> VectorField
bField [CurrentDistribution]
cds

circleB :: VectorField  -- magnetic field
circleB :: VectorField
circleB = CurrentDistribution -> VectorField
bField (CurrentDistribution -> VectorField)
-> CurrentDistribution -> VectorField
forall a b. (a -> b) -> a -> b
$ R -> R -> CurrentDistribution
circularCurrentLoop R
0.25 R
10

bFieldIdealDipole :: Vec          -- magnetic dipole moment
                  -> VectorField  -- magnetic field
bFieldIdealDipole :: Displacement -> VectorField
bFieldIdealDipole Displacement
m Position
r
    = let coeff :: R
coeff = R
mu0 R -> R -> R
forall a. Fractional a => a -> a -> a
/ (R
4 R -> R -> R
forall a. Num a => a -> a -> a
* R
forall a. Floating a => a
pi)    -- SI units
          rMag :: R
rMag = Displacement -> R
magnitude (VectorField
rVF Position
r)
          rUnit :: Displacement
rUnit = VectorField
rVF Position
r Displacement -> R -> Displacement
^/ R
rMag
      in R
coeff R -> Displacement -> Displacement
*^ (R
1 R -> R -> R
forall a. Fractional a => a -> a -> a
/ R
rMagR -> R -> R
forall a. Floating a => a -> a -> a
**R
3) R -> Displacement -> Displacement
*^ (R
3 R -> Displacement -> Displacement
*^ (Displacement
m Displacement -> Displacement -> R
<.> Displacement
rUnit) R -> Displacement -> Displacement
*^ Displacement
rUnit Displacement -> Displacement -> Displacement
^-^ Displacement
m)

bFieldWireToroid :: VectorField
bFieldWireToroid :: VectorField
bFieldWireToroid = CurrentDistribution -> VectorField
bField (R -> R -> R -> R -> CurrentDistribution
wireToroid R
0.3 R
1 R
50 R
10)

bFieldFromSurfaceCurrent
    :: VectorField  -- surface current density
    -> Surface      -- surface across which current flows
    -> VectorField  -- magnetic field (in T)
bFieldFromSurfaceCurrent :: VectorField -> Surface -> VectorField
bFieldFromSurfaceCurrent VectorField
kCurrent Surface
s Position
r
    = let coeff :: R
coeff = R
mu0 R -> R -> R
forall a. Fractional a => a -> a -> a
/ (R
4 R -> R -> R
forall a. Num a => a -> a -> a
* R
forall a. Floating a => a
pi)  -- SI units
          integrand :: VectorField
integrand Position
r' = (VectorField
kCurrent Position
r' Displacement -> Displacement -> Displacement
>< Displacement
d) Displacement -> R -> Displacement
^/ Displacement -> R
magnitude Displacement
d R -> R -> R
forall a. Floating a => a -> a -> a
** R
3
              where d :: Displacement
d = Position -> VectorField
displacement Position
r' Position
r
      in R
coeff R -> Displacement -> Displacement
*^ SurfaceApprox -> VectorField -> Surface -> Displacement
vectorSurfaceIntegral (Int -> SurfaceApprox
surfaceSample Int
200) VectorField
integrand Surface
s

bFieldFromVolumeCurrent
    :: VectorField  -- volume current density
    -> Volume       -- volume throughout which current flows
    -> VectorField  -- magnetic field (in T)
bFieldFromVolumeCurrent :: VectorField -> Volume -> VectorField
bFieldFromVolumeCurrent VectorField
j Volume
vol Position
r
    = let coeff :: R
coeff = R
mu0 R -> R -> R
forall a. Fractional a => a -> a -> a
/ (R
4 R -> R -> R
forall a. Num a => a -> a -> a
* R
forall a. Floating a => a
pi)  -- SI units
          integrand :: VectorField
integrand Position
r' = (VectorField
j Position
r' Displacement -> Displacement -> Displacement
>< Displacement
d) Displacement -> R -> Displacement
^/ Displacement -> R
magnitude Displacement
d R -> R -> R
forall a. Floating a => a -> a -> a
** R
3
              where d :: Displacement
d = Position -> VectorField
displacement Position
r' Position
r
      in R
coeff R -> Displacement -> Displacement
*^ VolumeApprox -> VectorField -> Volume -> Displacement
vectorVolumeIntegral (Int -> VolumeApprox
volumeSample Int
50) VectorField
integrand Volume
vol

magneticFluxFromField :: VectorField -> Surface -> R
magneticFluxFromField :: VectorField -> Surface -> R
magneticFluxFromField = VectorField -> Surface -> R
forall a. HasCallStack => a
undefined

magneticFluxFromCurrent :: CurrentDistribution -> Surface -> R
magneticFluxFromCurrent :: CurrentDistribution -> Surface -> R
magneticFluxFromCurrent = CurrentDistribution -> Surface -> R
forall a. HasCallStack => a
undefined

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