learn-physics-examples (empty) → 0.3
raw patch · 10 files changed
+488/−0 lines, 10 filesdep +basedep +glossdep +gnuplot
Dependencies added: base, gloss, gnuplot, learn-physics, not-gloss, spatial-math
Files
- LICENSE +29/−0
- learn-physics-examples.cabal +66/−0
- src/BCircularLoop.hs +27/−0
- src/DampedOscillator.hs +27/−0
- src/ElectricFluxPlot.hs +23/−0
- src/LorentzForceSimulation.hs +62/−0
- src/eFieldLine2D.hs +45/−0
- src/eFieldLine3D.hs +43/−0
- src/learn-physics-PlaneWave.hs +80/−0
- src/sunEarthRK4.hs +86/−0
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2011-2014 Scott N. Walck <walck@lvc.edu>.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Scott N. Walck nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ learn-physics-examples.cabal view
@@ -0,0 +1,66 @@+Name: learn-physics-examples+Version: 0.3+Stability: Experimental+Synopsis: examples for learn-physics+Description: Executables that use the learn-physics library.+License: BSD3+License-file: LICENSE+Author: Scott N. Walck+Maintainer: Scott N. Walck <walck@lvc.edu>+Category: Physics+Build-type: Simple+Cabal-version: >=1.6+Tested-with: GHC == 7.6.3++Executable learn-physics-PlaneWave+ Main-is: src/learn-physics-PlaneWave.hs+ Build-depends: not-gloss >= 0.5.0 && < 0.6,+ spatial-math >= 0.1.4 && < 0.2,+ base >= 4.5 && < 4.8,+ learn-physics >= 0.4.2++Executable learn-physics-eFieldLine3D+ Main-is: src/eFieldLine3D.hs+ Build-depends: not-gloss >= 0.5.0 && < 0.6,+ spatial-math >= 0.1.4 && < 0.2,+ base >= 4.5 && < 4.8,+ learn-physics >= 0.4.2++Executable learn-physics-LorentzForceSimulation+ Main-is: src/LorentzForceSimulation.hs+ Build-depends: not-gloss >= 0.5.0 && < 0.6,+ spatial-math >= 0.1.4 && < 0.2,+ base >= 4.5 && < 4.8,+ learn-physics >= 0.4.2++Executable learn-physics-BCircularLoop+ Main-is: src/BCircularLoop.hs+ Build-depends: not-gloss >= 0.5.0 && < 0.6,+ spatial-math >= 0.1.4 && < 0.2,+ base >= 4.5 && < 4.8,+ learn-physics >= 0.4.2++Executable learn-physics-sunEarth+ Main-is: src/sunEarthRK4.hs+ Build-depends: gloss >= 1.8 && < 1.9,+ base >= 4.5 && < 4.8,+ learn-physics >= 0.4.2++Executable learn-physics-eFieldLine2D+ Main-is: src/eFieldLine2D.hs+ Build-depends: gloss >= 1.8 && < 1.9,+ base >= 4.5 && < 4.8,+ learn-physics >= 0.4.2++Executable learn-physics-ElectricFluxPlot+ Main-is: src/ElectricFluxPlot.hs+ Build-depends: gnuplot >= 0.5 && < 0.6,+ base >= 4.5 && < 4.8,+ learn-physics >= 0.4.2++Executable learn-physics-DampedOscillator+ Main-is: src/DampedOscillator.hs+ Build-depends: gnuplot >= 0.5 && < 0.6,+ base >= 4.5 && < 4.8,+ learn-physics >= 0.4.2+
+ src/BCircularLoop.hs view
@@ -0,0 +1,27 @@+{-# OPTIONS_GHC -Wall #-}++module Main where++import Physics.Learn+import Vis++loopCurve :: Curve+loopCurve = Curve (\phi -> cyl 1 phi 0) 0 (2*pi)++loop :: CurrentDistribution+loop = LineCurrent 20 loopCurve++samplePoints :: [Position]+samplePoints = [cyl s phi z |+ s <- [0.25,0.75..1.75]+ , phi <- [pi/6,pi/2..2*pi]+ , z <- [-1.5,-1..1.5]]++arrows :: VisObject Double+arrows = displayVectorField blue 5e-5 samplePoints (bField loop)++drawFun :: VisObject Double+drawFun = VisObjects [curveObject red loopCurve, arrows]++main :: IO ()+main = display Nothing "Magnetic Field from a Current Loop" drawFun
+ src/DampedOscillator.hs view
@@ -0,0 +1,27 @@+{-# OPTIONS_GHC -Wall #-}++-- | Damped harmonic oscillator++module Main where++import Physics.Learn.RungeKutta+ ( integrateSystem+ )+import Graphics.Gnuplot.Simple++dampedOscillator :: Double -> Double -> Double+ -> (Double,Double,Double) -> (Double,Double,Double)+dampedOscillator r l c (_t,vc,il)+ = (1,-vc / r / c - il / c, vc / l)++theStates :: [(Double,Double,Double)]+theStates = integrateSystem (dampedOscillator 10000 200 0.001) 0.01 (0,1,0)++plot2 :: IO ()+plot2 = plotList [Title "Damped Harmonic Oscillator"+ ,XLabel "Time (s)"+ ,YLabel "Voltage (V)"+ ] (map (\(t,x,_) -> (t,x)) $ take 1000 theStates)++main :: IO ()+main = plot2
+ src/ElectricFluxPlot.hs view
@@ -0,0 +1,23 @@+{-# OPTIONS_GHC -Wall #-}++-- | Electric flux plot++module Main where++import Physics.Learn.Charge+import Physics.Learn.Surface+import Physics.Learn.Position+import Graphics.Gnuplot.Simple++-- | A plot of electric flux produced by a 1-nC point charge at (x,y,z) = (x,0,0)+-- through a sphere of radius 2 m centered at the origin+-- as a function of x.+plot1 :: IO ()+plot1 = plotFunc [Title "Electric flux produced by a 1-nC point charge through a sphere with radius 2m"+ ,YLabel "Electric flux (V m)"+ ,XLabel "Displacement of point charge from center of sphere (m)"]+ [-3.05,-2.95..3] (\x -> electricFlux (sphere 2 (cart 0 0 0)) (PointCharge 1e-9 (cart x 0 0)))++-- | Electric flux plot+main :: IO ()+main = plot1
+ src/LorentzForceSimulation.hs view
@@ -0,0 +1,62 @@+module Main where++import Physics.Learn+import Vis+import SpatialMath+ ( Euler(..)+ )++drawFunction :: SimpleState -> VisObject Double+drawFunction (_t,r,_v)+ = RotEulerDeg (Euler 270 0 0) $ RotEulerDeg (Euler 0 180 0) $+ VisObjects [ Axes (0.5, 15)+ , Trans (xyzFromPos r) (Sphere 0.1 Solid red)+ ]++statePropagationFunction :: Float -> SimpleState -> SimpleState+statePropagationFunction t' (t,r,v) = rungeKutta4 newton2 (realToFrac t' - t) (t,r,v)++-- Newton's Second Law+newton2 :: SimpleState -> Diff SimpleState+newton2 (t,r,v) = (1,v,force (t,r,v) ^/ m)++-- Lorentz Force Law+force :: SimpleState -> Vec+force (_t,r,v) = q *^ (electricField r ^+^ v >< magneticField r)++main :: IO ()+main = simulate+ Nothing+ "Particle Experiencing Electromagnetic Force"+ 0.01+ (0,initialPosition,initialVelocity)+ drawFunction+ statePropagationFunction++-- particle mass+m :: Double+m = 1++-- particle charge+q :: Double+q = 1++-- Electric Field+electricField :: VectorField+electricField r = vec 0 2 0+ where+ (x,y,z) = cartesianCoordinates r++-- Magnetic Field+magneticField :: VectorField+magneticField r = vec 0 0 4+ where+ (x,y,z) = cartesianCoordinates r++-- Initial displacement+initialPosition :: Position+initialPosition = cart 0 0 0++-- Initial velocity+initialVelocity :: Vec+initialVelocity = vec 0 0 0
+ src/eFieldLine2D.hs view
@@ -0,0 +1,45 @@+{-# OPTIONS_GHC -Wall #-}++module Main where++import Graphics.Gloss+import Physics.Learn.CarrotVec+import Physics.Learn.Position+import Physics.Learn.Curve+import Physics.Learn.Charge+import Physics.Learn.Visual.GlossTools++pixelsPerMeter :: Float+pixelsPerMeter = 40++pixelsPerVPM :: Float+pixelsPerVPM = 5.6++scalePoint :: Float -> Point -> Point+scalePoint m (x,y) = (m*x,m*y)++twoD :: Vec -> Point+twoD r = (realToFrac $ xComp r,realToFrac $ yComp r)++twoDp :: Position -> Point+twoDp r = (realToFrac x, realToFrac y)+ where+ (x,y,_) = cartesianCoordinates r++samplePoints :: [Position]+samplePoints = [cart x y 0 | x <- [-8,-6..8], y <- [-6,-4..6], abs y > 0.5 || abs x > 4.5]++curve1 :: Curve+curve1 = Curve (\t -> cart t 0 0) (-4) 4++eFields :: [(Position,Vec)]+eFields = [(r,eFieldFromLineCharge (const 1e-9) curve1 r) | r <- samplePoints]++arrows :: [Picture]+arrows = [thickArrow 5 (scalePoint pixelsPerMeter $ twoDp r)+ (scalePoint pixelsPerVPM $ twoD e) | (r,e) <- eFields]++main :: IO ()+main = display (InWindow "Electric Field from a Line Charge" (680,520) (10,10)) white $+ Pictures [(Color blue (Pictures arrows))+ ,Color orange $ Line [(-4*pixelsPerMeter,0),(4*pixelsPerMeter,0)]]
+ src/eFieldLine3D.hs view
@@ -0,0 +1,43 @@+{-# OPTIONS_GHC -Wall #-}++module Main where++import Vis+ ( display+ , VisObject(..)+ , red+ , blue+ )+import Physics.Learn.Visual.VisTools+ ( curveObject+ , displayVectorField+ )+import Physics.Learn.Position+ ( Position+ , cart+ )+import Physics.Learn.Curve+ ( Curve(..)+ )+import Physics.Learn.Charge+ ( ChargeDistribution(..)+ , eField+ )++curve1 :: Curve+curve1 = Curve (\t -> cart t 0 0) (-4) 4++lineCharge :: ChargeDistribution+lineCharge = LineCharge (const 1e-9) curve1++samplePoints :: [Position]+samplePoints = [cart x y z | x <- [-8,-6..8], y <- [-4,-2..4], z <- [-4,-2..4], abs y + abs z > 0.5 || abs x > 4.5]++arrows :: VisObject Double+arrows = displayVectorField blue 10 samplePoints (eField lineCharge)++drawFun :: VisObject Double+drawFun = VisObjects [curveObject red curve1, arrows]++main :: IO ()+main = display Nothing "Electric Field from a Line Charge" drawFun
+ src/learn-physics-PlaneWave.hs view
@@ -0,0 +1,80 @@+{-# OPTIONS_GHC -Wall #-}++module Main where++import SpatialMath+ ( Xyz(..)+ )+import Vis+ ( animate+ , VisObject(..)+ , Color+ , red+ , blue+ )+import Physics.Learn.CarrotVec+ ( Vec+ , xComp+ , yComp+ , zComp+ , vec+ , magnitude+ , (<.>)+ )++pointList :: [Double]+pointList = [-2,0,2]++-- samplePoints :: [Vec]+-- samplePoints = [vec x y z | x <- [0], y <- [0], z <- [-4,-3.6..4]]++samplePoints :: [Vec]+samplePoints = [vec x y z | x <- [-2,0,2], y <- [-2,0,2], z <- [-4,-3.6..4]]++xyzFromVec :: Vec -> Xyz Double+xyzFromVec v = Xyz x y z+ where+ x = xComp v+ y = yComp v+ z = zComp v++thinArrow :: Double -> (Xyz Double) -> Color -> VisObject Double+thinArrow l = Arrow (l,10*l)++metersPerVPM :: Double+metersPerVPM = 1++eArrows :: Double -> [VisObject Double]+eArrows t = [Trans (xyzFromVec r) $ thinArrow (metersPerVPM * magnitude e) (xyzFromVec e) blue | (r,e) <- eFields t]++eFields :: Double -> [(Vec,Vec)]+eFields t = [(r,eField r t) | r <- samplePoints]++bArrows :: Double -> [VisObject Double]+bArrows t = [Trans (xyzFromVec r) $ thinArrow (metersPerVPM * magnitude b) (xyzFromVec b) red | (r,b) <- bFields t]++bFields :: Double -> [(Vec,Vec)]+bFields t = [(r,bField r t) | r <- samplePoints]++drawFun :: Float -> VisObject Double+drawFun time = VisObjects $ eArrows t ++ bArrows t+ where+ t = realToFrac time++c :: Double+c = 1++k :: Vec+k = vec 0 0 1++e0 :: Double+e0 = 1++eField :: Vec -> Double -> Vec+eField r t = vec (e0 * cos (k <.> r - c * magnitude k * t)) 0 0++bField :: Vec -> Double -> Vec+bField r t = vec 0 (e0 / c * cos (k <.> r - c * magnitude k * t)) 0++main :: IO ()+main = animate Nothing "Plane Wave" drawFun
+ src/sunEarthRK4.hs view
@@ -0,0 +1,86 @@+{-# OPTIONS_GHC -Wall #-}++-- Animation of Earth orbiting around a fixed Sun+-- Using SI units++module Main where++import Physics.Learn+import Graphics.Gloss+import Graphics.Gloss.Data.ViewPort++type Acceleration = Vec++gGrav :: Double+gGrav = 6.67e-11++massSun :: Double+massSun = 1.99e30++-- This is enlarged so we can see it.+radiusSun :: Double+radiusSun = 0.1 * earthSunDistance++-- This is enlarged so we can see it.+radiusEarth :: Double+radiusEarth = 0.05 * earthSunDistance++earthSunDistance :: Double+earthSunDistance = 1.496e11++year :: Double+year = 365.25*24*60*60++-- Derived constants++initialEarthSpeed :: Double+initialEarthSpeed = 2*pi*earthSunDistance/year++initialState :: SimpleState+initialState = (0+ ,cart earthSunDistance 0 0+ ,vec 0 initialEarthSpeed 0)++rS :: Position+rS = cart 0 0 0++earthGravity :: SimpleAccelerationFunction+earthGravity (_,rE,_)+ = ((-gGrav) * massSun) *^ disp ^/ magnitude disp ** 3+ where+ disp = displacement rS rE++diskPic :: Double -> Picture+diskPic r = ThickCircle (radius/2) radius+ where radius = realToFrac r++-- A yellow disk will represent the Sun+yellowDisk :: Picture+yellowDisk = Color yellow (diskPic radiusSun)++-- A blue disk will represent the Earth+blueDisk :: Picture+blueDisk = Color blue (diskPic radiusEarth)++worldToPicture :: SimpleState -> Picture+worldToPicture (_,rE,_)+ = scale scl scl $ pictures [yellowDisk+ ,translate xE yE blueDisk+ ]+ where+ xE = realToFrac x+ yE = realToFrac y+ scl = 200 / realToFrac (earthSunDistance)+ (x,y,_) = cartesianCoordinates rE++timeScale :: Double+timeScale = 0.25 * year++simStep :: ViewPort -> Float -> SimpleState -> SimpleState+simStep _ dt = simpleRungeKuttaStep earthGravity dtScaled+ where+ dtScaled = timeScale * realToFrac dt++main :: IO ()+main = simulate (InWindow "Sun-Earth Animation" (1024, 768) (0, 0))+ black 50 initialState worldToPicture simStep