diff --git a/examples/src/BCircularLoop.hs b/examples/src/BCircularLoop.hs deleted file mode 100644 --- a/examples/src/BCircularLoop.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# 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] - -myOptions :: Options -myOptions = defaultOpts {optWindowName = "Magnetic Field from a Current Loop"} - -main :: IO () -main = display myOptions drawFun diff --git a/examples/src/LorentzForceSimulation.hs b/examples/src/LorentzForceSimulation.hs deleted file mode 100644 --- a/examples/src/LorentzForceSimulation.hs +++ /dev/null @@ -1,64 +0,0 @@ -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 (v3FromPos 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) - -myOptions :: Options -myOptions = defaultOpts {optWindowName = "Particle Experiencing Electromagnetic Force"} - -main :: IO () -main = simulate - myOptions - 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 diff --git a/examples/src/NMR.hs b/examples/src/NMR.hs deleted file mode 100644 --- a/examples/src/NMR.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} - --- ^ Nuclear Magnetic Resonance on the Bloch Sphere - -module Main where - -import Physics.Learn.QuantumMat - ( zm - ) -import Physics.Learn.BlochSphere - ( hamRabi - , evolutionBlochSphere - ) - -main :: IO () -main = evolutionBlochSphere zm (hamRabi 10 1 10) diff --git a/examples/src/PlaneWave.hs b/examples/src/PlaneWave.hs deleted file mode 100644 --- a/examples/src/PlaneWave.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} - -module Main where - -import Vis - ( animate - , VisObject(..) - , red - , blue - , Options(..) - , defaultOpts - ) -import Physics.Learn.CarrotVec - ( vec - ) -import Physics.Learn - ( Position - , VectorField - , displayVectorField - , cart - , cartesianCoordinates - ) - -samplePoints :: [Position] -samplePoints = [cart x y z | x <- [-2,0,2], y <- [-2,0,2], z <- [-4,-3.6..4]] - -drawFun :: Float -> VisObject Double -drawFun time = VisObjects [displayVectorField blue 1 samplePoints (eField t) - ,displayVectorField red 1 samplePoints (bField t) - ] - where - t = realToFrac time - -eField :: Double -> VectorField -eField t r = vec (cos (z - t)) 0 0 - where - (_,_,z) = cartesianCoordinates r - -bField :: Double -> VectorField -bField t r = vec 0 (cos (z - t)) 0 - where - (_,_,z) = cartesianCoordinates r - -myOptions :: Options -myOptions = defaultOpts {optWindowName = "Plane Wave"} - -main :: IO () -main = animate myOptions drawFun diff --git a/examples/src/eFieldLine3D.hs b/examples/src/eFieldLine3D.hs deleted file mode 100644 --- a/examples/src/eFieldLine3D.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} - -module Main where - -import Vis - ( display - , VisObject(..) - , red - , blue - , Options(..) - , defaultOpts - ) -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] - -myOptions :: Options -myOptions = defaultOpts {optWindowName = "Electric Field from a Line Charge"} - -main :: IO () -main = display myOptions drawFun diff --git a/learn-physics.cabal b/learn-physics.cabal --- a/learn-physics.cabal +++ b/learn-physics.cabal @@ -1,5 +1,5 @@ Name: learn-physics -Version: 0.6.0.2 +Version: 0.6.2 Synopsis: Haskell code for learning physics Description: A library of functions for vector calculus, calculation of electric field, electric flux, @@ -12,7 +12,6 @@ Category: Physics Build-type: Simple Cabal-version: >=1.8 -Tested-with: GHC >= 7.10.2 && <= 7.10.3 Library Exposed-modules: Physics.Learn.Charge Physics.Learn.Current @@ -30,72 +29,71 @@ Physics.Learn.CompositeQuadrature Physics.Learn.RootFinding Physics.Learn.Mechanics + Physics.Learn.Visual.PlotTools + Physics.Learn.Visual.GlossTools + Physics.Learn Physics.Learn.QuantumMat Physics.Learn.Ket - Physics.Learn.BlochSphere Physics.Learn.BeamStack - Physics.Learn - Physics.Learn.Visual.PlotTools - Physics.Learn.Visual.VisTools - Physics.Learn.Visual.GlossTools - Build-depends: base >= 4.7 && < 4.10, - vector-space >= 0.8.4 && < 0.11, - not-gloss >= 0.5.0.4 && < 0.8, - spatial-math >= 0.1.7 && < 0.4, - gloss >= 1.8 && < 1.11, - gnuplot >= 0.5 && < 0.6, - linear >= 1.20 && < 1.21, - hmatrix >= 0.17 && < 1.18 +-- Physics.Learn.BlochSphere +-- Physics.Learn.Visual.VisTools + Build-depends: base >= 4.7 && < 4.12, + vector-space >= 0.8.4, + hmatrix >= 0.17, + gloss >= 1.8, + gnuplot >= 0.5 && < 0.6 +-- not-gloss >= 0.5.0.4, +-- spatial-math >= 0.2, Hs-source-dirs: src Source-repository head type: git location: https://github.com/walck/learn-physics -Executable learn-physics-PlaneWave - Main-is: examples/src/PlaneWave.hs - Build-depends: not-gloss >= 0.7.4 && < 0.8, - base >= 4.5 && < 4.10, - learn-physics +-- Executable learn-physics-PlaneWave +-- Main-is: examples/src/PlaneWave.hs +-- Build-depends: not-gloss >= 0.7.4, +-- base >= 4.5 && < 4.12, +-- learn-physics -Executable learn-physics-eFieldLine3D - Main-is: examples/src/eFieldLine3D.hs - Build-depends: not-gloss >= 0.7.4 && < 0.8, - base >= 4.5 && < 4.10, - learn-physics +-- Executable learn-physics-eFieldLine3D +-- Main-is: examples/src/eFieldLine3D.hs +-- Build-depends: not-gloss >= 0.7.4, +-- base >= 4.5 && < 4.12, +-- learn-physics -Executable learn-physics-LorentzForceSimulation - Main-is: examples/src/LorentzForceSimulation.hs - Build-depends: not-gloss >= 0.7.4 && < 0.8, - spatial-math >= 0.2 && < 0.3, - base >= 4.5 && < 4.10, - learn-physics +-- Executable learn-physics-LorentzForceSimulation +-- Main-is: examples/src/LorentzForceSimulation.hs +-- Build-depends: not-gloss >= 0.7.4, +-- spatial-math >= 0.2, +-- base >= 4.5 && < 4.12, +-- learn-physics -Executable learn-physics-BCircularLoop - Main-is: examples/src/BCircularLoop.hs - Build-depends: not-gloss >= 0.7.4 && < 0.8, - base >= 4.5 && < 4.10, - learn-physics +-- Executable learn-physics-BCircularLoop +-- Main-is: examples/src/BCircularLoop.hs +-- Build-depends: not-gloss >= 0.7.4, +-- base >= 4.5 && < 4.12, +-- learn-physics Executable learn-physics-sunEarth Main-is: examples/src/sunEarthRK4.hs Build-depends: gloss >= 1.8, - base >= 4.5 && < 4.10, + base >= 4.5 && < 4.12, learn-physics Executable learn-physics-eFieldLine2D Main-is: examples/src/eFieldLine2D.hs Build-depends: gloss >= 1.8, - base >= 4.5 && < 4.10, + base >= 4.5 && < 4.12, learn-physics Executable learn-physics-Projectile Main-is: examples/src/Projectile.hs - Build-depends: gnuplot >= 0.5 && < 0.6, - base >= 4.5 && < 4.10, + Build-depends: gnuplot >= 0.5, + base >= 4.5 && < 4.12, learn-physics -Executable learn-physics-NMR - Main-is: examples/src/NMR.hs - Build-depends: base >= 4.5, - learn-physics +-- Executable learn-physics-NMR +-- Main-is: examples/src/NMR.hs +-- Build-depends: base >= 4.5, +-- learn-physics diff --git a/src/Physics/Learn.hs b/src/Physics/Learn.hs --- a/src/Physics/Learn.hs +++ b/src/Physics/Learn.hs @@ -3,7 +3,7 @@ {- | Module : Physics.Learn -Copyright : (c) Scott N. Walck 2014 +Copyright : (c) Scott N. Walck 2014-2018 License : BSD3 (see LICENSE) Maintainer : Scott N. Walck Stability : experimental @@ -166,12 +166,12 @@ , arrow , thickArrow -- ** Vis library - , v3FromVec - , v3FromPos - , visVec - , oneVector - , displayVectorField - , curveObject + -- , v3FromVec + -- , v3FromPos + -- , visVec + -- , oneVector + -- , displayVectorField + -- , curveObject ) where @@ -275,14 +275,14 @@ , shiftVolume , volumeIntegral ) -import Physics.Learn.Visual.VisTools - ( v3FromVec - , v3FromPos - , visVec - , oneVector - , displayVectorField - , curveObject - ) +-- import Physics.Learn.Visual.VisTools +-- ( v3FromVec +-- , v3FromPos +-- , visVec +-- , oneVector +-- , displayVectorField +-- , curveObject +-- ) import Physics.Learn.StateSpace ( StateSpace(..) , (.-^) diff --git a/src/Physics/Learn/BeamStack.hs b/src/Physics/Learn/BeamStack.hs --- a/src/Physics/Learn/BeamStack.hs +++ b/src/Physics/Learn/BeamStack.hs @@ -1,9 +1,10 @@ {-# OPTIONS_GHC -Wall #-} {-# LANGUAGE Trustworthy #-} +{-# LANGUAGE CPP #-} {- | Module : Physics.Learn.BeamStack -Copyright : (c) Scott N. Walck 2016 +Copyright : (c) Scott N. Walck 2016-2018 License : BSD3 (see LICENSE) Maintainer : Scott N. Walck Stability : experimental @@ -78,6 +79,9 @@ import Data.List ( intercalate ) +#if MIN_VERSION_base(4,11,0) +import Prelude hiding ((<>)) +#endif data BeamStack = BeamStack (Matrix C) diff --git a/src/Physics/Learn/BlochSphere.hs b/src/Physics/Learn/BlochSphere.hs deleted file mode 100644 --- a/src/Physics/Learn/BlochSphere.hs +++ /dev/null @@ -1,222 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} - -{- | -Module : Physics.Learn.BlochSphere -Copyright : (c) Scott N. Walck 2016 -License : BSD3 (see LICENSE) -Maintainer : Scott N. Walck -Stability : experimental - -This module contains functions for displaying the -state of a spin-1/2 particle or other quantum two-level -system as a point on the Bloch Sphere. --} - -module Physics.Learn.BlochSphere - ( VisObj - , toPos - , ketToPos - , staticBlochSphere - , displayStaticState - , animatedBlochSphere - , simulateBlochSphere - , simulateBlochSphereK - , stateProp - , statePropK - , evolutionBlochSphere - , evolutionBlochSphereK - , hamRabi - ) - where - -import qualified Physics.Learn.QuantumMat as M -import qualified Physics.Learn.Ket as K -import Physics.Learn.Ket - ( Ket - , Operator - , (<>) - , dagger - ) -import Numeric.LinearAlgebra - ( Vector - , Matrix - , C - , iC --- , (<>) -- matrix multiplication --- , (|>) -- vector definition - , (!) -- vector element access - , (><) -- matrix definition - , scale - , size - ) -import Data.Complex - ( Complex(..) - , conjugate - , realPart - , imagPart - ) -import Physics.Learn - ( Position - , v3FromPos - , cart - ) -import SpatialMath - ( Euler(..) - ) -import Vis - ( VisObject(..) - , Flavour(..) - , Options(..) - , Camera0(..) - , defaultOpts - , display - , simulate - , blue - , red - ) - -{- -3 ways to specify the state of a spin-1/2 particle: -Vector C -Ket -Position (Bloch vector) - -2 ways to specify a Hamiltonian: -Matrix C -Operator - -3 choices for Vis' world: -(Float, Vector C) -(Float, Ket) -(Float, Position) --} - --- | A Vis object. -type VisObj = VisObject Double - --- | Convert a 2x1 complex state vector for a qubit --- into Bloch (x,y,z) coordinates. -toPos :: Vector C -> Position -toPos v - = if size v /= 2 - then error "toPos only for size 2 vectors" - else let z1 = v ! 0 - z2 = v ! 1 - in cart (2 * realPart (conjugate z1 * z2)) - (2 * imagPart (conjugate z1 * z2)) - (realPart (conjugate z1 * z1 - conjugate z2 * z2)) - --- | Convert a qubit ket --- into Bloch (x,y,z) coordinates. -ketToPos :: Ket -> Position -ketToPos psi - = if K.dim psi /= 2 - then error "ketToPos only for qubit kets" - else let z1 = dagger K.zp <> psi - z2 = dagger K.zm <> psi - in cart (2 * realPart (conjugate z1 * z2)) - (2 * imagPart (conjugate z1 * z2)) - (realPart (conjugate z1 * z1 - conjugate z2 * z2)) - --- | A static 'VisObj' for the state of a qubit. -staticBlochSphere :: Position -> VisObj -staticBlochSphere r - = RotEulerDeg (Euler 270 0 0) $ RotEulerDeg (Euler 0 180 0) $ - VisObjects [ Sphere 1 Wireframe blue - , Trans (v3FromPos r) (Sphere 0.05 Solid red) - ] - -displayStaticBlochSphere :: Position -> IO () -displayStaticBlochSphere r - = display myOptions (staticBlochSphere r) - --- | Display a qubit state vector as a point on the Bloch Sphere. -displayStaticState :: Vector C -> IO () -displayStaticState = displayStaticBlochSphere . toPos - --- | Given a Bloch vector as a function of time, --- return a 'VisObj' as a function of time. -animatedBlochSphere :: (Double -> Position) -> (Float -> VisObj) -animatedBlochSphere f - = staticBlochSphere . f . realToFrac - --- | Given a sample rate, initial qubit state vector, and --- state propagation function, produce a simulation. --- The 'Float' in the state propagation function is the time --- since the beginning of the simulation. -simulateBlochSphere :: Double -> Vector C -> (Float -> (Float,Vector C) -> (Float,Vector C)) -> IO () -simulateBlochSphere sampleRate initial statePropFunc - = simulate myOptions sampleRate (0,initial) (staticBlochSphere . toPos . snd) statePropFunc - --- | Given a sample rate, initial qubit state ket, and --- state propagation function, produce a simulation. --- The 'Float' in the state propagation function is the time --- since the beginning of the simulation. -simulateBlochSphereK :: Double -> Ket -> (Float -> (Float,Ket) -> (Float,Ket)) -> IO () -simulateBlochSphereK sampleRate initial statePropFuncK - = simulate myOptions sampleRate (0,initial) (staticBlochSphere . ketToPos . snd) statePropFuncK - -{- --- | Given a sample rate, initial qubit state vector, and --- state propagation function, produce a simulation. --- The 'Float' in the state propagation function is the time --- since the beginning of the simulation. -playBlochSphere :: Double -> Vector C -> (Float -> (Float,Vector C) -> (Float,Vector C)) -> IO () -playBlochSphere sampleRate initial statePropFunc - = play myOptions sampleRate (0,initial) (staticBlochSphere . toPos . snd) statePropFunc --} - --- | Produce a state propagation function from a time-dependent Hamiltonian. -stateProp :: (Double -> Matrix C) -> Float -> (Float,Vector C) -> (Float,Vector C) -stateProp ham tNew (tOld,v) - = (tNew, M.timeEv (realToFrac dt) (ham tMid) v) - where - dt = tNew - tOld - tMid = realToFrac $ (tNew + tOld) / 2 - --- | Produce a state propagation function from a time-dependent Hamiltonian. -statePropK :: (Double -> Operator) -> Float -> (Float,Ket) -> (Float,Ket) -statePropK ham tNew (tOld,psi) - = (tNew, K.timeEv (realToFrac dt) (ham tMid) psi) - where - dt = tNew - tOld - tMid = realToFrac $ (tNew + tOld) / 2 - --- | Given an initial qubit state and a time-dependent Hamiltonian, --- produce a visualization. -evolutionBlochSphere :: Vector C -> (Double -> Matrix C) -> IO () -evolutionBlochSphere psi0 ham - = simulateBlochSphere 0.01 psi0 (stateProp ham) - --- | Given an initial qubit ket and a time-dependent Hamiltonian, --- produce a visualization. -evolutionBlochSphereK :: Ket -> (Double -> Operator) -> IO () -evolutionBlochSphereK psi0 ham - = simulateBlochSphereK 0.01 psi0 (statePropK ham) - -myOptions :: Options -myOptions = defaultOpts {optWindowName = "Bloch Sphere" - ,optInitialCamera = Just (Camera0 75 20 4)} - -{- -staticBz1 :: IO () -staticBz1 = evolutionBlochSphere M.xp (const (scale 0.9 M.sz)) - -staticBz2 :: IO () -staticBz2 = evolutionBlochSphere ((2|>) [(cos (pi / 8)), (sin (pi / 8))]) (const M.sz) - -staticBy1 :: IO () -staticBy1 = evolutionBlochSphere M.xp (const M.sy) --} - --- | Hamiltonian for nuclear magnetic resonance. --- Explain omega0, omegaR, omega. -hamRabi :: Double -> Double -> Double -> Double -> Matrix C -hamRabi omega0 omegaR omega t - = let h11 = omega0 :+ 0 - h12 = (omegaR :+ 0) * exp (-iC * ((omega * t) :+ 0)) - in scale (1/2) $ (2><2) [h11, h12, (conjugate h12), (-h11)] - --- need to scale time - --- a pi pulse diff --git a/src/Physics/Learn/CarrotVec.hs b/src/Physics/Learn/CarrotVec.hs --- a/src/Physics/Learn/CarrotVec.hs +++ b/src/Physics/Learn/CarrotVec.hs @@ -1,10 +1,10 @@ {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} {- | Module : Physics.Learn.CarrotVec -Copyright : (c) Scott N. Walck 2011-2014 +Copyright : (c) Scott N. Walck 2011-2018 License : BSD3 (see LICENSE) Maintainer : Scott N. Walck Stability : experimental diff --git a/src/Physics/Learn/CompositeQuadrature.hs b/src/Physics/Learn/CompositeQuadrature.hs --- a/src/Physics/Learn/CompositeQuadrature.hs +++ b/src/Physics/Learn/CompositeQuadrature.hs @@ -1,10 +1,10 @@ {-# OPTIONS_GHC -Wall #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} {- | Module : Physics.Learn.CompositeQuadrature -Copyright : (c) Scott N. Walck 2012-2014 +Copyright : (c) Scott N. Walck 2012-2018 License : BSD3 (see LICENSE) Maintainer : Scott N. Walck Stability : experimental diff --git a/src/Physics/Learn/CoordinateFields.hs b/src/Physics/Learn/CoordinateFields.hs --- a/src/Physics/Learn/CoordinateFields.hs +++ b/src/Physics/Learn/CoordinateFields.hs @@ -1,9 +1,9 @@ {-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} {- | Module : Physics.Learn.CoordinateFields -Copyright : (c) Scott N. Walck 2012-2014 +Copyright : (c) Scott N. Walck 2012-2018 License : BSD3 (see LICENSE) Maintainer : Scott N. Walck Stability : experimental diff --git a/src/Physics/Learn/CoordinateSystem.hs b/src/Physics/Learn/CoordinateSystem.hs --- a/src/Physics/Learn/CoordinateSystem.hs +++ b/src/Physics/Learn/CoordinateSystem.hs @@ -1,9 +1,9 @@ {-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} {- | Module : Physics.Learn.CoordinateSystem -Copyright : (c) Scott N. Walck 2012-2014 +Copyright : (c) Scott N. Walck 2012-2018 License : BSD3 (see LICENSE) Maintainer : Scott N. Walck Stability : experimental diff --git a/src/Physics/Learn/Curve.hs b/src/Physics/Learn/Curve.hs --- a/src/Physics/Learn/Curve.hs +++ b/src/Physics/Learn/Curve.hs @@ -1,10 +1,10 @@ {-# LANGUAGE TypeFamilies, FlexibleContexts #-} {-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} {- | Module : Physics.Learn.Curve -Copyright : (c) Scott N. Walck 2012-2014 +Copyright : (c) Scott N. Walck 2012-2018 License : BSD3 (see LICENSE) Maintainer : Scott N. Walck Stability : experimental diff --git a/src/Physics/Learn/Ket.hs b/src/Physics/Learn/Ket.hs --- a/src/Physics/Learn/Ket.hs +++ b/src/Physics/Learn/Ket.hs @@ -2,10 +2,11 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-# LANGUAGE CPP #-} {- | Module : Physics.Learn.Ket -Copyright : (c) Scott N. Walck 2016 +Copyright : (c) Scott N. Walck 2016-2018 License : BSD3 (see LICENSE) Maintainer : Scott N. Walck Stability : experimental @@ -106,6 +107,9 @@ , toList , fromLists ) +#if MIN_VERSION_base(4,11,0) +import Prelude hiding ((<>)) +#endif infixl 7 <> diff --git a/src/Physics/Learn/Position.hs b/src/Physics/Learn/Position.hs --- a/src/Physics/Learn/Position.hs +++ b/src/Physics/Learn/Position.hs @@ -1,10 +1,10 @@ {-# OPTIONS_GHC -Wall #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} {- | Module : Physics.Learn.Position -Copyright : (c) Scott N. Walck 2012-2014 +Copyright : (c) Scott N. Walck 2012-2018 License : BSD3 (see LICENSE) Maintainer : Scott N. Walck Stability : experimental diff --git a/src/Physics/Learn/QuantumMat.hs b/src/Physics/Learn/QuantumMat.hs --- a/src/Physics/Learn/QuantumMat.hs +++ b/src/Physics/Learn/QuantumMat.hs @@ -1,9 +1,10 @@ {-# OPTIONS_GHC -Wall #-} {-# LANGUAGE Trustworthy #-} +{-# LANGUAGE CPP #-} {- | Module : Physics.Learn.QuantumMat -Copyright : (c) Scott N. Walck 2016 +Copyright : (c) Scott N. Walck 2016-2018 License : BSD3 (see LICENSE) Maintainer : Scott N. Walck Stability : experimental @@ -104,6 +105,9 @@ , magnitude , realPart ) +#if MIN_VERSION_base(4,11,0) +import Prelude hiding ((<>)) +#endif -- | The state resulting from a measurement of -- spin angular momentum in the x direction diff --git a/src/Physics/Learn/RootFinding.hs b/src/Physics/Learn/RootFinding.hs --- a/src/Physics/Learn/RootFinding.hs +++ b/src/Physics/Learn/RootFinding.hs @@ -3,7 +3,7 @@ {- | Module : Physics.Learn.RootFinding -Copyright : (c) Scott N. Walck 2012-2014 +Copyright : (c) Scott N. Walck 2012-2017 License : BSD3 (see LICENSE) Maintainer : Scott N. Walck Stability : experimental @@ -26,7 +26,7 @@ -- | Given an initial bracketing of a root -- (an interval (a,b) for which f(a) f(b) <= 0), --- produce a bracket of arbitrary smallness. +-- produce a bracket (c,d) for which |c-d| < desired accuracy. bracketRoot :: (Ord a, Fractional a) => a -- ^ desired accuracy -> (a -> a) -- ^ function diff --git a/src/Physics/Learn/Visual/VisTools.hs b/src/Physics/Learn/Visual/VisTools.hs deleted file mode 100644 --- a/src/Physics/Learn/Visual/VisTools.hs +++ /dev/null @@ -1,126 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} - --- | Some tools related to the not-gloss 3D graphics and animation library. - -module Physics.Learn.Visual.VisTools - ( v3FromVec - , v3FromPos - , visVec - , oneVector - , displayVectorField - , curveObject - ) - where - -import SpatialMath - ( V3(..) - , Euler(..) - ) -import Vis - ( VisObject(..) - , Color - ) -import Physics.Learn.CarrotVec - ( Vec - , xComp - , yComp - , zComp --- , magnitude - , (^/) - ) -import Physics.Learn.Position - ( Position - , cartesianCoordinates - , VectorField - ) -import Physics.Learn.Curve - ( Curve(..) - ) - --- | Make a 'V3' object from a 'Vec'. -v3FromVec :: Vec -> V3 Double -v3FromVec v = V3 x y z - where - x = xComp v - y = yComp v - z = zComp v - --- | Make a 'V3' object from a 'Position'. -v3FromPos :: Position -> V3 Double -v3FromPos r = V3 x y z - where - (x,y,z) = cartesianCoordinates r - --- | Display a vector field. -displayVectorField :: Color -- ^ color for the vector field - -> Double -- ^ scale factor - -> [Position] -- ^ list of positions to show the field - -> VectorField -- ^ vector field to display - -> VisObject Double -- ^ the displayable object -displayVectorField col unitsPerMeter samplePts field - = VisObjects [Trans (v3FromPos r) $ visVec col (e ^/ unitsPerMeter) | r <- samplePts, let e = field r] - --- | A displayable VisObject for a curve. -curveObject :: Color -> Curve -> VisObject Double -curveObject color (Curve f a b) - = Line' Nothing [(v3FromPos (f t), color) | t <- [a,a+(b-a)/1000..b]] - --- | Place a vector at a particular position. -oneVector :: Color -> Position -> Vec -> VisObject Double -oneVector c r v = Trans (v3FromPos r) $ visVec c v - -data Cart = Cart Double Double Double - deriving (Show) - -data Sph = Sph Double Double Double - deriving (Show) - -sphericalCoords :: Cart -> Sph -sphericalCoords (Cart x y z) = Sph r theta phi - where - r = sqrt (x*x + y*y + z*z) - s = sqrt (x*x + y*y) - theta = atan2 s z - phi = atan2 y x - --- | A VisObject arrow from a vector -visVec :: Color -> Vec -> VisObject Double -visVec c v = rotZ phi $ rotY theta $ Arrow (r,20*r) (V3 0 0 1) c - where - x = xComp v - y = yComp v - z = zComp v - Sph r theta phi = sphericalCoords (Cart x y z) - -{- -rotX :: Double -- ^ in radians - -> VisObject Double - -> VisObject Double -rotX alpha = RotEulerRad (Euler 0 0 alpha) --} - -rotY :: Double -- ^ in radians - -> VisObject Double - -> VisObject Double -rotY alpha = RotEulerRad (Euler 0 alpha 0) - -rotZ :: Double -- ^ in radians - -> VisObject Double - -> VisObject Double -rotZ alpha = RotEulerRad (Euler alpha 0 0) - - -{- -adjacentDistance :: [Position] -> Double -adjacentDistance [] = 0 -adjacentDistance rs'@(_:rs) = minimum (map magnitude $ zipWith displacement rs' rs) - -visVectorField :: Color -> [Position] -> VectorField -> VisObject Double -visVectorField c rs vf = let prs = [(r,vf r) | r <- rs] - bigV = maximum [magnitude (snd pr) | pr <- prs] - disp = adjacentDistance rs - scaleFactor = disp / bigV - newPrs = [(r, scaleFactor *^ v) | (r,v) <- prs] - vecs = [oneVector c r v' | (r,v') <- newPrs] - in VisObjects vecs --}