{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Safe #-}
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 :: SimpleAccelerationFunction -> DifferentialEquation SimpleState
simpleStateDeriv SimpleAccelerationFunction
a (Double
t, Position
r, Vec
v) = (Double
1, Vec
v, SimpleAccelerationFunction
a(Double
t, Position
r, Vec
v))
simpleRungeKuttaStep :: SimpleAccelerationFunction
-> TimeStep
-> SimpleState
-> SimpleState
simpleRungeKuttaStep :: SimpleAccelerationFunction -> Double -> SimpleState -> SimpleState
simpleRungeKuttaStep = forall p. StateSpace p => (p -> Diff p) -> Time p -> p -> p
rungeKutta4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleAccelerationFunction -> DifferentialEquation SimpleState
simpleStateDeriv
data St = St { St -> Position
position :: Position
, St -> Vec
velocity :: Velocity
}
deriving (Int -> St -> ShowS
[St] -> ShowS
St -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [St] -> ShowS
$cshowList :: [St] -> ShowS
show :: St -> String
$cshow :: St -> String
showsPrec :: Int -> St -> ShowS
$cshowsPrec :: Int -> St -> ShowS
Show)
data DSt = DSt Vec Vec
deriving (Int -> DSt -> ShowS
[DSt] -> ShowS
DSt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DSt] -> ShowS
$cshowList :: [DSt] -> ShowS
show :: DSt -> String
$cshow :: DSt -> String
showsPrec :: Int -> DSt -> ShowS
$cshowsPrec :: Int -> DSt -> ShowS
Show)
instance AdditiveGroup DSt where
zeroV :: DSt
zeroV = Vec -> Vec -> DSt
DSt forall v. AdditiveGroup v => v
zeroV forall v. AdditiveGroup v => v
zeroV
negateV :: DSt -> DSt
negateV (DSt Vec
dr Vec
dv) = Vec -> Vec -> DSt
DSt (forall v. AdditiveGroup v => v -> v
negateV Vec
dr) (forall v. AdditiveGroup v => v -> v
negateV Vec
dv)
DSt Vec
dr1 Vec
dv1 ^+^ :: DSt -> DSt -> DSt
^+^ DSt Vec
dr2 Vec
dv2 = Vec -> Vec -> DSt
DSt (Vec
dr1 forall v. AdditiveGroup v => v -> v -> v
^+^ Vec
dr2) (Vec
dv1 forall v. AdditiveGroup v => v -> v -> v
^+^ Vec
dv2)
instance VectorSpace DSt where
type Scalar DSt = Double
Scalar DSt
c *^ :: Scalar DSt -> DSt -> DSt
*^ DSt Vec
dr Vec
dv = Vec -> Vec -> DSt
DSt (Scalar DSt
cforall v. VectorSpace v => Scalar v -> v -> v
*^Vec
dr) (Scalar DSt
cforall v. VectorSpace v => Scalar v -> v -> v
*^Vec
dv)
instance StateSpace St where
type Diff St = DSt
St Position
r1 Vec
v1 .-. :: St -> St -> Diff St
.-. St Position
r2 Vec
v2 = Vec -> Vec -> DSt
DSt (Position
r1 forall p. StateSpace p => p -> p -> Diff p
.-. Position
r2) (Vec
v1 forall p. StateSpace p => p -> p -> Diff p
.-. Vec
v2)
St Position
r1 Vec
v1 .+^ :: St -> Diff St -> St
.+^ DSt Vec
dr Vec
dv = Position -> Vec -> St
St (Position
r1 forall p. StateSpace p => p -> Diff p -> p
.+^ Vec
dr) (Vec
v1 forall p. StateSpace p => p -> Diff p -> p
.+^ Vec
dv)
type OneParticleSystemState = (TheTime,St)
type OneParticleAccelerationFunction = OneParticleSystemState -> Vec
oneParticleStateDeriv :: OneParticleAccelerationFunction
-> DifferentialEquation OneParticleSystemState
oneParticleStateDeriv :: OneParticleAccelerationFunction
-> DifferentialEquation OneParticleSystemState
oneParticleStateDeriv OneParticleAccelerationFunction
a st :: OneParticleSystemState
st@(Double
_t, St Position
_r Vec
v) = (Double
1, Vec -> Vec -> DSt
DSt Vec
v (OneParticleAccelerationFunction
a OneParticleSystemState
st))
oneParticleRungeKuttaStep :: OneParticleAccelerationFunction
-> TimeStep
-> OneParticleSystemState
-> OneParticleSystemState
oneParticleRungeKuttaStep :: OneParticleAccelerationFunction
-> Double -> OneParticleSystemState -> OneParticleSystemState
oneParticleRungeKuttaStep = forall p. StateSpace p => (p -> Diff p) -> Time p -> p -> p
rungeKutta4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneParticleAccelerationFunction
-> DifferentialEquation OneParticleSystemState
oneParticleStateDeriv
oneParticleRungeKuttaSolution :: OneParticleAccelerationFunction
-> TimeStep
-> OneParticleSystemState
-> [OneParticleSystemState]
oneParticleRungeKuttaSolution :: OneParticleAccelerationFunction
-> Double -> OneParticleSystemState -> [OneParticleSystemState]
oneParticleRungeKuttaSolution = forall p. StateSpace p => (p -> Diff p) -> Time p -> p -> [p]
integrateSystem forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneParticleAccelerationFunction
-> DifferentialEquation OneParticleSystemState
oneParticleStateDeriv
type TwoParticleSystemState = (TheTime,St,St)
type TwoParticleAccelerationFunction = TwoParticleSystemState -> (Vec,Vec)
twoParticleStateDeriv :: TwoParticleAccelerationFunction
-> DifferentialEquation TwoParticleSystemState
twoParticleStateDeriv :: TwoParticleAccelerationFunction
-> DifferentialEquation TwoParticleSystemState
twoParticleStateDeriv TwoParticleAccelerationFunction
af2 st2 :: TwoParticleSystemState
st2@(Double
_t, St Position
_r1 Vec
v1, St Position
_r2 Vec
v2) = (Double
1, Vec -> Vec -> DSt
DSt Vec
v1 Vec
a1, Vec -> Vec -> DSt
DSt Vec
v2 Vec
a2)
where
(Vec
a1,Vec
a2) = TwoParticleAccelerationFunction
af2 TwoParticleSystemState
st2
twoParticleRungeKuttaStep :: TwoParticleAccelerationFunction
-> TimeStep
-> TwoParticleSystemState
-> TwoParticleSystemState
twoParticleRungeKuttaStep :: TwoParticleAccelerationFunction
-> Double -> TwoParticleSystemState -> TwoParticleSystemState
twoParticleRungeKuttaStep = forall p. StateSpace p => (p -> Diff p) -> Time p -> p -> p
rungeKutta4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. TwoParticleAccelerationFunction
-> DifferentialEquation TwoParticleSystemState
twoParticleStateDeriv
type ManyParticleSystemState = (TheTime,[St])
type ManyParticleAccelerationFunction = ManyParticleSystemState -> [Vec]
manyParticleStateDeriv :: ManyParticleAccelerationFunction
-> DifferentialEquation ManyParticleSystemState
manyParticleStateDeriv :: ManyParticleAccelerationFunction
-> DifferentialEquation ManyParticleSystemState
manyParticleStateDeriv ManyParticleAccelerationFunction
af st :: ManyParticleSystemState
st@(Double
_t, [St]
sts) = (Double
1, [Vec -> Vec -> DSt
DSt Vec
v Vec
a | (Vec
v,Vec
a) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Vec]
vs [Vec]
as])
where
vs :: [Vec]
vs = forall a b. (a -> b) -> [a] -> [b]
map St -> Vec
velocity [St]
sts
as :: [Vec]
as = ManyParticleAccelerationFunction
af ManyParticleSystemState
st
manyParticleRungeKuttaStep :: ManyParticleAccelerationFunction
-> TimeStep
-> ManyParticleSystemState
-> ManyParticleSystemState
manyParticleRungeKuttaStep :: ManyParticleAccelerationFunction
-> Double -> ManyParticleSystemState -> ManyParticleSystemState
manyParticleRungeKuttaStep = forall p. StateSpace p => (p -> Diff p) -> Time p -> p -> p
rungeKutta4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ManyParticleAccelerationFunction
-> DifferentialEquation ManyParticleSystemState
manyParticleStateDeriv