learn-physics-0.5: src/Tests.hs

{-# OPTIONS_GHC -Wall #-}

module Main where

import Physics.Learn
import Test.QuickCheck

propGaussLaw1 :: (Double,Double,Double) -> Bool
propGaussLaw1 (x,y,z) = abs (eFlux - q/epsilon0) < 0.01
    where
      eFlux = fluxThroughLargeCenteredSphere (x,y,z) q
      epsilon0 = 1 / (4 * pi * 9e9)
      q = epsilon0

fluxThroughLargeCenteredSphere :: (Double,Double,Double) -> Double -> Double
fluxThroughLargeCenteredSphere (x,y,z) q
    = electricFlux (centeredSphere radius) (PointCharge q (cart x y z))
      where
        radius = 2 * sqrt(x*x + y*y + z*z) + 1

currentLoop :: Double -> Current -> CurrentDistribution
currentLoop radius i
    = LineCurrent i (Curve (\phi -> cyl radius phi 0) 0 (2*pi))

amperianLoop :: Double -> Curve
amperianLoop radius
    = Curve (\t -> cart (radius + radius * sin t) 0 (radius * cos t)) 0 (2*pi)

magCirculation :: Double -> Current -> Double
magCirculation radius i
    = dottedLineIntegral 20
      (bFieldFromCurrentLoop i (Curve (\phi -> cyl radius phi 0) 0 (2*pi)))
      (amperianLoop radius)

bFieldFromCurrentLoop :: Current -> Curve -> VectorField
bFieldFromCurrentLoop i c r
    = k *^ crossedLineIntegral 20 integrand c
      where
        k = 1e-7  -- mu0 / (4 * pi)
        integrand r' = (-i) *^ d ^/ magnitude d ** 3
            where
              d = displacement r' r

propAmpere1 :: Double -> Property
propAmpere1 radius
    = radius > 0 ==> abs (magCirculation radius i - 4*pi*1e-7 * i) < 0.01
      where
        i = 1 / (4*pi*1e-7)

main :: IO ()
main = putStrLn "Gauss's law test:" >>
       quickCheck propGaussLaw1 >>
       putStrLn "Ampere's law test:" >>
       quickCheck propAmpere1