{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Trustworthy #-}
module Physics.Learn.Mechanics
( TheTime
, TimeStep
, Velocity
, SimpleState
, SimpleAccelerationFunction
, simpleStateDeriv
, simpleRungeKuttaStep
, St(..)
, DSt(..)
, OneParticleSystemState
, OneParticleAccelerationFunction
, oneParticleStateDeriv
, oneParticleRungeKuttaStep
, oneParticleRungeKuttaSolution
, TwoParticleSystemState
, TwoParticleAccelerationFunction
, twoParticleStateDeriv
, twoParticleRungeKuttaStep
, ManyParticleSystemState
, ManyParticleAccelerationFunction
, manyParticleStateDeriv
, manyParticleRungeKuttaStep
)
where
import Data.VectorSpace
( AdditiveGroup(..)
, VectorSpace(..)
)
import Physics.Learn.StateSpace
( StateSpace(..)
, Diff
, DifferentialEquation
)
import Physics.Learn.RungeKutta
( rungeKutta4
, integrateSystem
)
import Physics.Learn.Position
( Position
)
import Physics.Learn.CarrotVec
( Vec
)
type TheTime = Double
type TimeStep = Double
type Velocity = Vec
type SimpleState = (TheTime,Position,Velocity)
type SimpleAccelerationFunction = SimpleState -> Vec
simpleStateDeriv :: SimpleAccelerationFunction
-> DifferentialEquation SimpleState
simpleStateDeriv a (t, r, v) = (1, v, a(t, r, v))
simpleRungeKuttaStep :: SimpleAccelerationFunction
-> TimeStep
-> SimpleState
-> SimpleState
simpleRungeKuttaStep = rungeKutta4 . simpleStateDeriv
data St = St { position :: Position
, velocity :: Velocity
}
deriving (Show)
data DSt = DSt Vec Vec
deriving (Show)
instance AdditiveGroup DSt where
zeroV = DSt zeroV zeroV
negateV (DSt dr dv) = DSt (negateV dr) (negateV dv)
DSt dr1 dv1 ^+^ DSt dr2 dv2 = DSt (dr1 ^+^ dr2) (dv1 ^+^ dv2)
instance VectorSpace DSt where
type Scalar DSt = Double
c *^ DSt dr dv = DSt (c*^dr) (c*^dv)
instance StateSpace St where
type Diff St = DSt
St r1 v1 .-. St r2 v2 = DSt (r1 .-. r2) (v1 .-. v2)
St r1 v1 .+^ DSt dr dv = St (r1 .+^ dr) (v1 .+^ dv)
type OneParticleSystemState = (TheTime,St)
type OneParticleAccelerationFunction = OneParticleSystemState -> Vec
oneParticleStateDeriv :: OneParticleAccelerationFunction
-> DifferentialEquation OneParticleSystemState
oneParticleStateDeriv a st@(_t, St _r v) = (1, DSt v (a st))
oneParticleRungeKuttaStep :: OneParticleAccelerationFunction
-> TimeStep
-> OneParticleSystemState
-> OneParticleSystemState
oneParticleRungeKuttaStep = rungeKutta4 . oneParticleStateDeriv
oneParticleRungeKuttaSolution :: OneParticleAccelerationFunction
-> TimeStep
-> OneParticleSystemState
-> [OneParticleSystemState]
oneParticleRungeKuttaSolution = integrateSystem . oneParticleStateDeriv
type TwoParticleSystemState = (TheTime,St,St)
type TwoParticleAccelerationFunction = TwoParticleSystemState -> (Vec,Vec)
twoParticleStateDeriv :: TwoParticleAccelerationFunction
-> DifferentialEquation TwoParticleSystemState
twoParticleStateDeriv af2 st2@(_t, St _r1 v1, St _r2 v2) = (1, DSt v1 a1, DSt v2 a2)
where
(a1,a2) = af2 st2
twoParticleRungeKuttaStep :: TwoParticleAccelerationFunction
-> TimeStep
-> TwoParticleSystemState
-> TwoParticleSystemState
twoParticleRungeKuttaStep = rungeKutta4 . twoParticleStateDeriv
type ManyParticleSystemState = (TheTime,[St])
type ManyParticleAccelerationFunction = ManyParticleSystemState -> [Vec]
manyParticleStateDeriv :: ManyParticleAccelerationFunction
-> DifferentialEquation ManyParticleSystemState
manyParticleStateDeriv af st@(_t, sts) = (1, [DSt v a | (v,a) <- zip vs as])
where
vs = map velocity sts
as = af st
manyParticleRungeKuttaStep :: ManyParticleAccelerationFunction
-> TimeStep
-> ManyParticleSystemState
-> ManyParticleSystemState
manyParticleRungeKuttaStep = rungeKutta4 . manyParticleStateDeriv