HASKELL SPACEFLIGHT WORKSHOP
18 |The current workshop notes and introductory slides:
19 | 24 |Source code is available in 25 | the GitHub repository.
27 |
14 | 
15 |
16 |
15 |
17 |
28 |
15 | The current workshop notes and introductory slides:
19 | 24 |Source code is available in 25 | the GitHub repository.
27 |
2 |
3 | # Haskell Spaceflight Workshop
4 |
5 | [](https://travis-ci.org/lancelet/space-workshop)
6 |
7 | The workshop contents are now complete. Final modifications and updates may still be made prior to LambdaJam 2019, but the current version is representative.
8 |
9 | The current notes for the workshop are available from
10 | [GitHub pages](https://lancelet.github.io/space-workshop), built using Travis CI.
11 |
12 | ## Instructions for Participants
13 |
14 | Please make sure that you download the required dependencies for the workshop and [the notes](https://lancelet.github.io/space-workshop) in advance. We support the [`stack`](https://www.haskellstack.org) and `cabal` build tools. Dependencies can be fetched by doing:
15 |
16 | ```
17 | $ stack --install-ghc test --only-dependencies
18 | ```
19 |
20 | or
21 |
22 | ```
23 | $ cabal new-build --only-dependencies test:tests
24 | ```
25 |
26 | in the checked-out repository.
27 |
28 | ## Docker Option
29 |
30 | If you are unable to obtain the required dependencies prior to the workshop, we will be distributing (on temporary loan only) USB flash drives containing a Docker image with the dependencies pre-installed. If you use this option, please copy everything off the USB drive before passing it on. Please then follow the instructions in the README from the flash drive.
31 |
32 | For reference, the Docker image itself was built using the [CI pipeline here](https://gitlab.com/jmerritt/haskell-space-workshop-docker-image), but the USB Flash drive also contains a snapshot of this GitHub repository and the notes.
33 |
34 | ## Solutions
35 |
36 | Solutions are provided in the `Solutions` sub-modules. To use them, either call them directly from the problem code, OR set the environment variable `IDDQD=1`, which will cause the `todo` function to use the fallback solutions:
37 |
38 | ```
39 | $ export IDDQD=1 # causes the `todo` function to use the provided solutions
40 | ```
41 |
42 | ## Developer Notes
43 |
44 | See the `.travis.yml` file for detailed CI build instructions.
45 |
46 | Building the manual requires:
47 | - TexLive (I use a full installation via nixpkgs)
48 | - pygments, for code formatting
49 |
50 | A manual build can be performed as follows:
51 |
52 | ```
53 | $ export IDDQD=1
54 | $ stack test
55 | $ stack exec tex-plots # generates PGF-format plots for the LaTeX notes
56 | $ cd notes
57 | $ make # generates the LaTeX notes.pdf
58 | ```
59 |
60 | Or with `cabal`:
61 |
62 | ```
63 | $ export IDDQD=1
64 | $ cabal new-test
65 | $ cabal new-run tex-plots # generates PGF-format plots for the LaTeX notes
66 | $ cd notes
67 | $ make # generates the LaTeX notes.pdf
68 | ```
69 |
70 | Be careful: the LaTeX file has `\nonstopmode` set so that it doesn't hang the CI build. It may be best to remove this when making local changes so that errors are more obvious.
71 |
72 | The Makefile for the notes supports a `watch` phony target to continuously watch the source files and re-run LaTeX as required:
73 |
74 | ```
75 | $ make watch
76 | ```
77 |
--------------------------------------------------------------------------------
/notes/beamer-trek/trek-shapes.sty:
--------------------------------------------------------------------------------
1 | \RequirePackage{tikz}
2 |
3 | \makeatletter
4 |
5 | % Trek cursor shape
6 | \pgfkeys{/tikz/trek/cursor/width/.initial = 20mm}
7 | \pgfkeys{/tikz/trek/cursor/height/.initial = 7.5mm}
8 | \pgfdeclareshape{trek cursor}
9 | {
10 | \saveddimen\width{\pgf@x = \pgfkeysvalueof{/tikz/trek/cursor/width}}
11 | \saveddimen\height{\pgf@x = \pgfkeysvalueof{/tikz/trek/cursor/height}}
12 | \savedanchor\centerpoint{
13 | \pgf@x = 0.5\wd\pgfnodeparttextbox
14 | \pgf@y = 0.5\ht\pgfnodeparttextbox
15 | }
16 | \anchor{center}{\centerpoint}
17 |
18 | \backgroundpath{
19 | \pgf@xc = \height
20 | \divide \pgf@xc by 2
21 | \pgf@xa = \width
22 | \advance \pgf@xa by -\pgf@xc
23 | \pgf@ya = \height
24 | \pgf@xb = \pgf@xa
25 | \pgf@yb = 0mm
26 | \pgfpathmoveto{\pgfpoint{0}{0}}
27 | \pgfpathlineto{\pgfpoint{0}{\height}}
28 | \pgfpathlineto{\pgfpoint{\pgf@xa}{\pgf@ya}}
29 | \pgfpatharcto{\height/2}{\height/2}{0}{0}{0}{\pgfpoint{\pgf@xb}{\pgf@yb}}
30 | \pgfpathclose
31 | \pgfusepath{fill,draw}
32 | }
33 | }
34 |
35 | % Trek circular bullet
36 | \pgfkeys{/tikz/trek/circular bullet/radius/.initial = 1.25mm}
37 | \pgfdeclareshape{trek circular bullet}
38 | {
39 | \saveddimen\width{\pgf@x = 2\pgfkeysvalueof{/tikz/trek/circular bullet/radius}}
40 | \saveddimen\height{\pgf@x = 2\pgfkeysvalueof{/tikz/trek/circular bullet/radius}}
41 | \savedanchor\centerpoint{
42 | \pgf@x = 0.5\wd\pgfnodeparttextbox
43 | \pgf@y = 0.5\ht\pgfnodeparttextbox
44 | }
45 | \anchor{center}{\centerpoint}
46 | \savedanchor\basepoint{
47 | \pgf@x = 0.5\wd\pgfnodeparttextbox
48 | \pgf@y = 0.0\wd\pgfnodeparttextbox
49 | }
50 | \anchor{base}{\basepoint}
51 |
52 | \foregroundpath{
53 | \pgfpathcircle{\pgfpoint{0}{0}}{\pgfkeysvalueof{/tikz/trek/circular bullet/radius}}
54 | \pgfpathclose
55 | \pgfusepath{fill}
56 | }
57 | }
58 | % Command to draw the circle inline in a document
59 | \newcommand{\trekcircle}{%
60 | \newdimen\@trek@lineheight%
61 | \setbox0=\hbox{I}%
62 | \@trek@lineheight=\ht0%
63 | \begin{tikzpicture}[baseline=-0.5\@trek@lineheight]
64 | \draw node (0,0) [trek circular bullet]{};
65 | \end{tikzpicture}%
66 | }
67 |
68 | % Trek elbow shape
69 | \pgfkeys{/tikz/trek/elbow/bar height/.initial = 7.5mm}
70 | \pgfkeys{/tikz/trek/elbow/outer radius/.initial = 3mm}
71 | \pgfkeys{/tikz/trek/elbow/inner radius/.initial = 1mm}
72 | \pgfkeys{/tikz/trek/elbow/sidebar width/.initial = 5mm}
73 | \pgfkeys{/tikz/trek/elbow/width/.initial = 30mm}
74 | \pgfkeys{/tikz/trek/elbow/height/.initial = 10mm}
75 | \pgfdeclareshape{trek elbow}
76 | {
77 | \saveddimen\barheight{\pgf@x = \pgfkeysvalueof{/tikz/trek/elbow/bar height}}
78 | \saveddimen\outerradius{\pgf@x = \pgfkeysvalueof{/tikz/trek/elbow/outer radius}}
79 | \saveddimen\innerradius{\pgf@x = \pgfkeysvalueof{/tikz/trek/elbow/inner radius}}
80 | \saveddimen\sidebarwidth{\pgf@x = \pgfkeysvalueof{/tikz/trek/elbow/sidebar width}}
81 | \saveddimen\width{\pgf@x = \pgfkeysvalueof{/tikz/trek/elbow/width}}
82 | \saveddimen\height{\pgf@x = \pgfkeysvalueof{/tikz/trek/elbow/height}}
83 | \savedanchor\centerpoint{
84 | \pgf@x = 0.5\wd\pgfnodeparttextbox
85 | \pgf@y = 0.5\ht\pgfnodeparttextbox
86 | }
87 | \anchor{center}{\centerpoint}
88 |
89 | \backgroundpath{
90 | \pgf@xa = -\width
91 | \advance \pgf@xa by \outerradius
92 | \pgf@ya = \barheight
93 | \advance \pgf@ya by -\outerradius
94 | \pgf@yb = -\height
95 | \advance \pgf@yb by \barheight
96 | \pgf@xb = -\width
97 | \advance \pgf@xb by \sidebarwidth
98 | \pgf@xc = \pgf@xb
99 | \advance \pgf@xc by \innerradius
100 | \pgfpathmoveto{\pgfpoint{0}{0}}
101 | \pgfpathlineto{\pgfpoint{0}{\barheight}}
102 | \pgfpathlineto{\pgfpoint{\pgf@xa}{\barheight}}
103 | \pgfpatharcto{\outerradius}{\outerradius}{0}{0}{1}{\pgfpoint{-\width}{\pgf@ya}}
104 | \pgfpathlineto{\pgfpoint{-\width}{\pgf@yb}}
105 | \pgfpathlineto{\pgfpoint{\pgf@xb}{\pgf@yb}}
106 | \pgfpathlineto{\pgfpoint{\pgf@xb}{-\innerradius}}
107 | \pgfpatharcto{\innerradius}{\innerradius}{0}{0}{0}{\pgfpoint{\pgf@xc}{0}}
108 | \pgfpathclose
109 | \pgfusepath{fill,draw}
110 | }
111 | }
112 |
113 | \makeatother
114 |
--------------------------------------------------------------------------------
/src/Solutions/Hohmann.hs:
--------------------------------------------------------------------------------
1 | {-|
2 | Module : Solutions.Hohmann
3 | Description : Solutions for the Hohmann module.
4 | -}
5 | {-# LANGUAGE NegativeLiterals #-}
6 | {-# LANGUAGE TypeOperators #-}
7 | module Solutions.Hohmann where
8 |
9 | import Control.Lens ((^.))
10 | import Data.LinearMap ((:-*), linear)
11 | import Data.List.NonEmpty (NonEmpty)
12 | import Linear (V2, norm, normalize, quadrance, (*^),
13 | (^+^), (^/), _x, _y)
14 |
15 | import qualified Hohmann.Types as T
16 | import qualified ODE as ODE
17 |
18 |
19 | -- | Standard earth gravity.
20 | g0 :: Double
21 | g0 = 9.80665 -- m/s^2
22 |
23 |
24 | -- | Find the craft angle (theta) from the state.
25 | --
26 | -- The angle should run from [0, 2*pi). Note that this range is different
27 | -- from the normal atan2 function.
28 | angle :: T.State -> Double
29 | angle state =
30 | let
31 | p = T.position state
32 | q = atan2 (p^._y) (p^._x)
33 | in
34 | if q > 0
35 | then q
36 | else (2*pi) + q
37 |
38 |
39 | -- | Find the gravitational force from the state.
40 | gravity :: T.Params -> T.State -> V2 Double
41 | gravity params state =
42 | let
43 | rMag2 = quadrance (T.position state)
44 | rHat = normalize (T.position state)
45 | in -(T.mu params) * (T.mass state) / rMag2 *^ rHat
46 |
47 |
48 | -- | Find the thrust force from the state.
49 | thrust :: T.Params -> T.State -> V2 Double
50 | thrust params state =
51 | let vHat = normalize (T.velocity state)
52 | in g0 * (T.isp params) * (T.mDot params) *^ vHat
53 |
54 |
55 | -- | Return @Nothing@ when @shouldTerminate == True@; @Just@ otherwise.
56 | terminateWhen
57 | :: Bool -- ^ when True, terminate
58 | -> a -- ^ value to wrap
59 | -> Maybe a
60 | terminateWhen shouldTerminate input
61 | = if shouldTerminate
62 | then Nothing
63 | else Just input
64 |
65 |
66 | -- | Compute a coasting trajectory.
67 | --
68 | -- The coasting trajectory is terminated once the craft reaches a given
69 | -- termination condition.
70 | coast
71 | :: T.Params -- ^ Simulation parameters.
72 | -> (T.State -> Bool) -- ^ Termination condition (True to terminate).
73 | -> (Double, T.State) -- ^ Initial time and state.
74 | -> NonEmpty (Double, T.State) -- ^ Simulation steps.
75 | coast params shouldTerminate s0 =
76 | let
77 | gradFn :: (Double, T.State) -> Maybe (Double :-* T.DState)
78 | gradFn (_, state)
79 | = terminateWhen (shouldTerminate state)
80 | $ linear
81 | $ \dt -> T.DState
82 | { T.dMass = 0
83 | , T.dDistance = dt * norm (T.velocity state)
84 | , T.dPosition = dt *^ T.velocity state
85 | , T.dVelocity = dt *^ gravity params state ^/ T.mass state
86 | }
87 |
88 | in ODE.integrateTerminating ODE.rk4StepTerminating
89 | (T.tEps params)
90 | (T.tStep params)
91 | s0
92 | gradFn
93 |
94 |
95 | -- | Compute a burn trajectory.
96 | --
97 | -- The burn trajectory is terminated once the craft reaches a given
98 | -- velocity magnitude.
99 | burn
100 | :: T.Params -- ^ Simulation parameters.
101 | -> Double -- ^ Termination velocity (m/s).
102 | -> (Double, T.State) -- ^ Initial time and state.
103 | -> NonEmpty (Double, T.State) -- ^ Simulation steps.
104 | burn params velF s0 =
105 | let
106 | gradFn :: (Double, T.State) -> Maybe (Double :-* T.DState)
107 | gradFn (_, state)
108 | = terminateWhen (norm (T.velocity state) >= velF)
109 | $ linear
110 | $ \dt -> T.DState
111 | { T.dMass = dt * -1 * T.mDot params
112 | , T.dDistance = dt * norm (T.velocity state)
113 | , T.dPosition = dt *^ T.velocity state
114 | , T.dVelocity = dt *^ (gravity params state ^+^ thrust params state) ^/ T.mass state
115 | }
116 |
117 | in ODE.integrateTerminating ODE.rk4StepTerminating
118 | (T.tEps params)
119 | (T.tStep params)
120 | s0
121 | gradFn
122 |
--------------------------------------------------------------------------------
/src/Staging.hs:
--------------------------------------------------------------------------------
1 | {-|
2 | Module : Staging
3 | Description : Simulating staging of rockets.
4 | -}
5 | {-# LANGUAGE OverloadedStrings #-}
6 | {-# LANGUAGE TypeOperators #-}
7 | {-# OPTIONS_GHC -Wno-unused-imports #-} -- re-enable after completing solutions
8 | module Staging where
9 |
10 | import Data.LinearMap ((:-*), linear)
11 | import Data.List.NonEmpty (NonEmpty)
12 | import qualified Data.List.NonEmpty as NonEmpty
13 | import Data.VectorSpace ((^*))
14 |
15 | import qualified ODE
16 | import qualified Plot
17 | import qualified Solutions.Staging
18 | import qualified Staging.Types as T
19 | import Todo (FallbackSolution (FallbackSolution), todo)
20 |
21 |
22 | -- | Equation of motion for a rocket stage.
23 | --
24 | -- The rocket engine is burning in a vacuum in the absence of gravity.
25 | equationOfMotion
26 | :: Double -- ^ Mass flow rate (kg / s).
27 | -> Double -- ^ Specific impulse (s).
28 | -> Double -- ^ Dry mass of this stage (kg).
29 | -> Double -- ^ Total mass of remaining stages (kg).
30 | -> (Double, T.State) -- ^ Current time and state (s, State).
31 | -> Double :-* T.DState -- ^ Linear map of derivatives.
32 | equationOfMotion {- mDot isp mDry mRemaining (_, state) -}
33 | = todo (FallbackSolution Solutions.Staging.equationOfMotion)
34 | {-
35 | = linear ((^*) grad)
36 | where
37 | -- grad is a DState for a unit time increment
38 | grad :: T.DState
39 | grad = T.DState
40 | { T.dPropellantMass = undefined
41 | , T.dPosition = undefined
42 | , T.dVelocity = undefined
43 | }
44 |
45 | g0 :: Double -- m/s^2
46 | g0 = 9.80665
47 | -}
48 |
49 |
50 | -- | Burn a stage of a rocket (can be the first or second stage).
51 | burnStage
52 | :: Double -- ^ Initial propellant mass (kg).
53 | -> Double -- ^ Dry mass of the current stage (kg).
54 | -> Double -- ^ Total mass of remaining mass of stages (kg).
55 | -> Int -- ^ Number of integration steps.
56 | -> Double -- ^ Initial time (s).
57 | -> T.State -- ^ Initial state.
58 | -> NonEmpty (Double, T.State) -- ^ List of time and state tuples.
59 | burnStage {- mp0 mDry mRemaining nSteps time0 state0 -}
60 | = todo (FallbackSolution Solutions.Staging.burnStage)
61 | {-
62 | where
63 | -- Duration of the burn (s).
64 | burnDuration :: Double
65 | burnDuration = undefined
66 |
67 | -- Evaluation times (s).
68 | times :: NonEmpty Double
69 | times = NonEmpty.fromList
70 | $ ODE.linspace nSteps time0 (time0 + burnDuration)
71 |
72 | -- Gradient function for ODE solver.
73 | gradFn :: (Double, T.State) -> Double :-* T.DState
74 | gradFn = undefined
75 |
76 | -- Mass flow rate (kg / s).
77 | mDot :: Double
78 | mDot = 290.0
79 |
80 | -- Specific impulse (s).
81 | isp :: Double
82 | isp = 300.0
83 | -}
84 |
85 |
86 | -- | Burn the single stage rocket only.
87 | burnSingleStage
88 | :: Int -- ^ Number of integration steps per stage.
89 | -> NonEmpty (Double, T.State) -- ^ Time and state list.
90 | burnSingleStage {- nSteps = burnStage mp0 mDry 0.0 nSteps state0 -}
91 | = todo (FallbackSolution Solutions.Staging.burnSingleStage)
92 |
93 |
94 | -- | Burn the two stage rocket only.
95 | burnTwoStage
96 | :: Int -- ^ Number of integration steps per stage.
97 | -> NonEmpty (Double, T.State) -- ^ Time and state list.
98 | burnTwoStage {- nSteps = stage1 <> stage2 -}
99 | = todo (FallbackSolution Solutions.Staging.burnTwoStage)
100 |
101 |
102 | -- | Plot the comparison of velocity history for the staging options.
103 | plotVelocityComparison :: Plot.Output -> IO ()
104 | plotVelocityComparison output =
105 | let
106 | nSteps :: Int
107 | nSteps = 100
108 |
109 | extractVel :: (Double, T.State) -> (Double, Double)
110 | extractVel (t, state) = (t, T.velocity state)
111 |
112 | v1Stage :: [(Double, Double)]
113 | v1Stage = NonEmpty.toList (extractVel <$> burnSingleStage nSteps)
114 |
115 | v2Stage :: [(Double, Double)]
116 | v2Stage = NonEmpty.toList (extractVel <$> burnTwoStage nSteps)
117 | in
118 | Plot.xyChart
119 | output
120 | "Single Stage vs Two Stage Velocity Comparison"
121 | "Time (s)"
122 | "Velocity (m/s)"
123 | []
124 | [ Plot.Line "Single Stage" v1Stage
125 | , Plot.Line "Two Stage" v2Stage ]
126 |
--------------------------------------------------------------------------------
/src/Solutions/Staging.hs:
--------------------------------------------------------------------------------
1 | {-|
2 | Module : Solutions.Staging
3 | Description : Solutions for the 'Staging' module.
4 | -}
5 | {-# LANGUAGE TypeOperators #-}
6 | module Solutions.Staging where
7 |
8 | import Data.LinearMap ((:-*), linear)
9 | import Data.List.NonEmpty (NonEmpty)
10 | import qualified Data.List.NonEmpty as NonEmpty
11 | import Data.VectorSpace ((^*))
12 |
13 | import qualified ODE
14 | import qualified Staging.Types as T
15 |
16 |
17 | -- | Equation of motion for a rocket stage.
18 | --
19 | -- The rocket engine is burning in a vacuum in the absence of gravity.
20 | equationOfMotion
21 | :: Double -- ^ Mass flow rate (kg / s).
22 | -> Double -- ^ Specific impulse (s).
23 | -> Double -- ^ Dry mass of this stage (kg).
24 | -> Double -- ^ Total mass of remaining stages (kg).
25 | -> (Double, T.State) -- ^ Current time and state (s, State).
26 | -> Double :-* T.DState -- ^ Linear map of derivatives.
27 | equationOfMotion mDot isp mDry mRemaining (_, state) = linear ((^*) grad)
28 | where
29 | -- grad is a DState for a unit time increment
30 | grad :: T.DState
31 | grad = T.DState
32 | { T.dPropellantMass = -mDot
33 | , T.dPosition = v
34 | , T.dVelocity = g0 * isp * mDot / (mp + mDry + mRemaining)
35 | }
36 |
37 | v = T.velocity state
38 | mp = T.propellantMass state
39 |
40 | g0 :: Double -- m/s^2
41 | g0 = 9.80665
42 |
43 |
44 | -- | Burn a stage of a rocket (can be the first or second stage).
45 | burnStage
46 | :: Double -- ^ Initial propellant mass (kg).
47 | -> Double -- ^ Dry mass of the current stage (kg).
48 | -> Double -- ^ Total mass of remaining mass of stages (kg).
49 | -> Int -- ^ Number of integration steps.
50 | -> Double -- ^ Initial time (s).
51 | -> T.State -- ^ Initial state.
52 | -> NonEmpty (Double, T.State) -- ^ List of time and state tuples.
53 | burnStage mp0 mDry mRemaining nSteps time0 state0
54 | = ODE.integrate ODE.rk4Step state0 times gradFn
55 | where
56 | -- Duration of the burn (s).
57 | burnDuration :: Double
58 | burnDuration = mp0 / mDot
59 |
60 | -- Evaluation times (s).
61 | times :: NonEmpty Double
62 | times = NonEmpty.fromList
63 | $ ODE.linspace nSteps time0 (time0 + burnDuration)
64 |
65 | -- Gradient function for ODE solver.
66 | gradFn :: (Double, T.State) -> Double :-* T.DState
67 | gradFn = equationOfMotion mDot isp mDry mRemaining
68 |
69 | -- Mass flow rate (kg / s).
70 | mDot :: Double
71 | mDot = 290.0
72 |
73 | -- Specific impulse (s).
74 | isp :: Double
75 | isp = 300.0
76 |
77 |
78 | -- | Burn the single stage rocket only.
79 | burnSingleStage
80 | :: Int -- ^ Number of integration steps per stage.
81 | -> NonEmpty (Double, T.State) -- ^ Time and state list.
82 | burnSingleStage nSteps = burnStage mp0 mDry 0.0 nSteps 0.0 state0
83 | where
84 | -- Initial state.
85 | state0 :: T.State
86 | state0 = T.State
87 | { T.propellantMass = mp0
88 | , T.position = 0.0
89 | , T.velocity = 0.0
90 | }
91 |
92 | -- Starting propellant mass (kg).
93 | mp0 :: Double
94 | mp0 = 500000.0
95 |
96 | -- Dry mass of the stage (kg).
97 | mDry :: Double
98 | mDry = 55556.0
99 |
100 |
101 | -- | Burn the two stage rocket only.
102 | burnTwoStage
103 | :: Int -- ^ Number of integration steps per stage.
104 | -> NonEmpty (Double, T.State) -- ^ Time and state list.
105 | burnTwoStage nSteps = stage1 <> stage2
106 | where
107 | -- Results from burning the first stage.
108 | stage1 :: NonEmpty (Double, T.State)
109 | stage1 = burnStage mp0 mDry (mp0 + mDry) nSteps 0.0 state01
110 |
111 | -- Results from burning the second stage.
112 | stage2 :: NonEmpty (Double, T.State)
113 | stage2 = burnStage mp0 mDry 0 nSteps time2 state02
114 |
115 | -- Initial state of the first stage.
116 | state01 :: T.State
117 | state01 = T.State
118 | { T.propellantMass = mp0
119 | , T.position = 0.0
120 | , T.velocity = 0.0
121 | }
122 |
123 | -- Initial state of the second stage.
124 | state02 :: T.State
125 | state02 = (snd (NonEmpty.last stage1)) { T.propellantMass = mp0 }
126 |
127 | -- Starting time of the second stage.
128 | time2 :: Double
129 | time2 = fst (NonEmpty.last stage1)
130 |
131 | -- Starting propellant mass for each stage.
132 | mp0 :: Double
133 | mp0 = 250000.0
134 |
135 | -- Dry mass for each stage.
136 | mDry :: Double
137 | mDry = 27778.0
138 |
--------------------------------------------------------------------------------
/logo.svg:
--------------------------------------------------------------------------------
1 |
2 |
3 |
22 |
--------------------------------------------------------------------------------
/src/Hohmann.hs:
--------------------------------------------------------------------------------
1 | {-|
2 | Module : Hohmann
3 | Description : Simulation of Hohmann transfer.
4 | -}
5 | {-# LANGUAGE NegativeLiterals #-}
6 | {-# LANGUAGE OverloadedStrings #-}
7 | {-# LANGUAGE TypeOperators #-}
8 | {-# OPTIONS_GHC -Wno-unused-imports #-} -- re-enable after completing solutions
9 | module Hohmann where
10 |
11 | import Control.Lens ((^.))
12 | import Data.LinearMap ((:-*), linear)
13 | import Data.List.NonEmpty (NonEmpty)
14 | import qualified Data.List.NonEmpty as NonEmpty
15 | import qualified Diagrams.Prelude as D
16 | import Linear (V2 (V2), norm, normalize, (*^), (^+^),
17 | (^/), _x, _y)
18 |
19 | import qualified Hohmann.Types as T
20 | import qualified ODE as ODE
21 | import qualified Plot as Plot
22 | import qualified Solutions.Hohmann
23 | import Todo (FallbackSolution (FallbackSolution), todo)
24 |
25 |
26 | -- | Standard earth gravity.
27 | g0 :: Double
28 | g0 = 9.80665 -- m/s^2
29 |
30 |
31 | -- | Find the craft angle (theta) from the state.
32 | angle :: T.State -> Double
33 | angle = todo (FallbackSolution Solutions.Hohmann.angle)
34 |
35 |
36 | -- | Find the gravitational force from the state.
37 | gravity :: T.Params -> T.State -> V2 Double
38 | gravity = todo (FallbackSolution Solutions.Hohmann.gravity)
39 |
40 |
41 | -- | Find the thrust force from the state.
42 | thrust :: T.Params -> T.State -> V2 Double
43 | thrust = todo (FallbackSolution Solutions.Hohmann.thrust)
44 |
45 |
46 | -- | Return @Nothing@ when @shouldTerminate == True@; @Just@ otherwise.
47 | terminateWhen
48 | :: Bool -- ^ when True, terminate
49 | -> a -- ^ value to wrap
50 | -> Maybe a
51 | terminateWhen {- shouldTerminate value -}
52 | = todo (FallbackSolution Solutions.Hohmann.terminateWhen)
53 |
54 |
55 | -- | Compute a coasting trajectory.
56 | --
57 | -- This will involve using ODE.integrateTerminating, with the ODE for coasting
58 | -- (see the notes).
59 | coast
60 | :: T.Params -- ^ Simulation parameters.
61 | -> (T.State -> Bool) -- ^ Termination condition (@True@ to terminate).
62 | -> (Double, T.State) -- ^ Initial time and state.
63 | -> NonEmpty (Double, T.State) -- ^ Simulation steps.
64 | coast = todo (FallbackSolution Solutions.Hohmann.coast)
65 |
66 |
67 | -- | Compute a burn trajectory.
68 | --
69 | -- The burn trajectory is terminated once the craft reaches a given
70 | -- velocity magnitude.
71 | --
72 | -- This will involve using ODE.integrateTerminating, with the ODE for a burn
73 | -- (see the notes).
74 | burn
75 | :: T.Params -- ^ Simulation parameters.
76 | -> Double -- ^ Termination velocity (m/s).
77 | -> (Double, T.State) -- ^ Initial time and state.
78 | -> NonEmpty (Double, T.State) -- ^ Simulation steps.
79 | burn = todo (FallbackSolution Solutions.Hohmann.burn)
80 |
81 |
82 | -- | Plots a simulation of the Hohmann transfer with a normal, high-impulse
83 | -- burn.
84 | plotHighImpulseBurn :: Plot.Output -> IO ()
85 | plotHighImpulseBurn output = plotBurn output 0.1 310 5.13
86 |
87 |
88 | -- | Plots a simulation of the Hohmann transfer with a low-impulse burn.
89 | plotLowImpulseBurn :: Plot.Output -> IO ()
90 | plotLowImpulseBurn output = plotBurn output 2 200 0.1
91 |
92 |
93 | -- | Plots a simulation of the Hohmann transfer with an ultra-low-impulse burn.
94 | plotUltraLowImpulseBurn :: Plot.Output -> IO ()
95 | plotUltraLowImpulseBurn output = plotBurn output 5 75 0.1
96 |
97 |
98 | -- | General Hohmann transfer simulation.
99 | plotBurn
100 | :: Plot.Output -- ^ Plotting device for output.
101 | -> Double -- ^ dt to use for the burn phase (s).
102 | -> Double -- ^ specific impulse (s)
103 | -> Double -- ^ mass flow rate (kg/s)
104 | -> IO ()
105 | plotBurn output burndt isp mDot = do
106 | let
107 | -- Convert simulation result to a trajectory using km units.
108 | kmTrajectory :: NonEmpty (Double, T.State) -> [(Double, Double)]
109 | kmTrajectory = fmap (\(_, state) ->
110 | let p = T.position state
111 | in (p^._x / 1000.0, p^._y / 1000.0))
112 | . NonEmpty.toList
113 |
114 | -- Simulation parameters.
115 | params :: T.Params
116 | params = T.Params
117 | { T.mu = 4.905e12 -- value for the moon (m^3/s^2)
118 | , T.mDot = mDot -- kg/s
119 | , T.isp = isp -- Specific impulse (s)
120 | , T.r1 = 1780e3 -- inner radius (m) ; ~20 nautical miles
121 | , T.r2 = 1860e3 -- outer radius (m) ; ~60 nautical miles
122 | , T.tStep = 10 -- time step (s)
123 | , T.tEps = 0.01 -- event accuracy (s)
124 | }
125 |
126 | -- Initial state at some radius.
127 | state0 :: Double -> T.State
128 | state0 radius = T.State
129 | { T.mass = 3000 -- kg
130 | , T.distance = 0 -- m
131 | , T.position = V2 radius 0
132 | , T.velocity = V2 0 (sqrt(T.mu params / radius))
133 | }
134 |
135 | -- Parameters for a burn.
136 | burnParams :: T.Params
137 | burnParams = params { T.tStep = burndt }
138 |
139 | -- Periapsis velocity of transfer trajectory. This is use as a terminal
140 | -- velocity for the first burn.
141 | vp = sqrt(T.mu burnParams * (2 / T.r1 burnParams - 2 / (T.r1 burnParams + T.r2 burnParams)))
142 |
143 | -- Velocity of final outer circular orbit. This is used as a terminal
144 | -- velocity for the second burn.
145 | vf = sqrt(T.mu params / T.r2 params)
146 |
147 | -- Trajectories.
148 | coastInner = coast params
149 | -- termination is complicated because angles are periodic
150 | (\state -> angle state >= 0
151 | && angle state < pi/2
152 | && T.distance state > 1e7)
153 | (0, state0 (T.r1 params))
154 | burn1 = burn burnParams vp (0, state0 (T.r1 params))
155 | transferCoast = coast params (\state -> angle state >= pi) (NonEmpty.last burn1)
156 | burn2 = burn burnParams vf (NonEmpty.last transferCoast)
157 | coastOuter = coast params
158 | -- termination is complicated because angles are periodic
159 | (\state -> angle state >= pi/2
160 | && angle state < 3*pi/2
161 | && T.distance state > 2e7)
162 | (NonEmpty.last burn2)
163 |
164 | Plot.plotOrbitSystem output
165 | 20.0
166 | (Plot.OrbitSystem
167 | { Plot.planet = (Plot.Planet "Moon" 1737.1 D.lightgray)
168 | , Plot.systemItems =
169 | [ Plot.Trajectory (kmTrajectory burn1) D.red
170 | , Plot.Trajectory (kmTrajectory transferCoast) D.black
171 | , Plot.Trajectory (kmTrajectory burn2) D.red
172 | , Plot.Trajectory (kmTrajectory coastInner) D.skyblue
173 | , Plot.Trajectory (kmTrajectory coastOuter) D.skyblue
174 | , Plot.AltitudeCircle 1780 "40 km" D.gray
175 | , Plot.AltitudeCircle 1820 "80 km" D.gray
176 | , Plot.AltitudeCircle 1860 "120 km" D.gray
177 | ]})
178 |
--------------------------------------------------------------------------------
/notes/references.bib:
--------------------------------------------------------------------------------
1 | @book{battin1999,
2 | author = "Richard H. Battin",
3 | title = "An introduction to the Mathematics and Methods of Astrodynamics, Revised Edition",
4 | publisher = "American Institute of Aeronautics and Astronautics",
5 | year = "1999"
6 | }
7 |
8 | @article{bennett1970,
9 | author = {F. V. Bennett},
10 | title = "{Apollo Lunar Descent and Ascent Trajectories. NASA TM X-58040}",
11 | year = 1970,
12 | journal = {AIAA 8th Aerospace Sciences Meeting, New York},
13 | url = {https://www.hq.nasa.gov/alsj/nasa58040.pdf}
14 | }
15 |
16 | @book{brauer1977,
17 | author = {G. L. Brauer and D. E. Cornick and R. Stevenson},
18 | title = {Capabilities and Applications of the Program to Optimize Simulated Trajectories (POST). Program Summary Document. NASA CR-2770},
19 | year = 1977,
20 | publisher = {NASA},
21 | url = {https://ntrs.nasa.gov/archive/nasa/casi.ntrs.nasa.gov/19770012832.pdf}
22 | }
23 |
24 | @article{davis2017,
25 | author = {Diane C. Davis and Sean M. Phillips and Kathleen C. Howell and Srianish Vutukuri and Brian P. McCarthy},
26 | title = "{Stationkeeping and Transfer Trajectory Design for Spacecraft in Cislunar Space}",
27 | year = 2017,
28 | journal = {AAS/AIAA Astrodynamics Specialist Conference, Columbia River Gorge, Stevenson, Washington},
29 | url = {https://engineering.purdue.edu/people/kathleen.howell.1/Publications/Conferences/2017_AAS_DavPhiHow.pdf}
30 | }
31 |
32 | @misc{dennis2018,
33 | author = {Michael Aaron Dennis},
34 | title = "{Encyclopaedia Britannica: Charles Stark Draper}",
35 | url = {https://www.britannica.com/biography/Charles-Stark-Draper}
36 | }
37 |
38 | @InProceedings{dileep2015,
39 | author = "M. V. Dileep and Surekha Kamath and Vishnu G. Nair",
40 | title = "Particle Swarm Optimization Applied to Ascent Phase Launch Vehicle Trajectory Optimization Problem",
41 | booktitle = "11th International Multi-Conference on Information Processing",
42 | year = 2015,
43 | doi = {10.1016/j.procs.2015.06.059},
44 | url = {https://core.ac.uk/download/pdf/82182140.pdf}
45 | }
46 |
47 | @article{dukeman2008,
48 | author = {Greg A. Dukeman and Ashley D. Hill},
49 | title = "{Rapid Trajectory Optimization for the ARES I Launch Vehicle}",
50 | year = 2008,
51 | journal = {AIAA Guidance, Navigation and Control Conference and Exhibit, Honolulu, Hawaii},
52 | url = {https://ntrs.nasa.gov/archive/nasa/casi.ntrs.nasa.gov/20080048217.pdf}
53 | }
54 |
55 | @InProceedings{elliott2009,
56 | author = "Conal Elliott",
57 | title = "Beautiful differentiation",
58 | booktitle = "International Conference on Functional Programming (ICFP)",
59 | year = 2009,
60 | url = {http://conal.net/papers/beautiful-differentiation},
61 | }
62 |
63 | @book{gantmacher1950,
64 | author = "F. R. Gantmacher and L. M. Levin",
65 | title = "Equations of Motion of a Rocket (Technical Memorandum 1255)",
66 | publisher = "National Advisory Committee for Aeronautics (NACA)",
67 | year = "1950",
68 | url = {https://apps.dtic.mil/dtic/tr/fulltext/u2/a801581.pdf}
69 | }
70 |
71 | @InProceedings{gerberich2013,
72 | author = "Matthew W. Gerberich and Steven R. Oleson",
73 | title = "{Estimation Model of Spacecraft Parameters and Cost Based on a Statistical Analysis of COMPASS Designs}",
74 | booktitle = "AIAA Space 2013 Conference and Exposition",
75 | year = 2013,
76 | url = {https://ntrs.nasa.gov/archive/nasa/casi.ntrs.nasa.gov/20140011472.pdf},
77 | doi = {10.2514/6.2013-5432}
78 | }
79 |
80 | @article{guelman1991,
81 | author = {M. Guelman},
82 | title = "{Guidance for asteroid rendezvous}",
83 | year = 1991,
84 | pages = {1080--1083},
85 | volume = 14,
86 | number = 5,
87 | journal = {Journal of Guidance, Control and Dynamics},
88 | doi = {10.2514/3.20759},
89 | url = {https://sci-hub.se/10.2514/3.20759}
90 | }
91 |
92 | @InProceedings{holt2009,
93 | author = "James B. Holt and Timothy S. Monk",
94 | title = "{Propellant Mass Fraction Calculation Methodology for Launch Vehicles and Application to Ares Vehicles}",
95 | booktitle = "AIAA Space 2009 Conference and Exposition. Session ST-2: Advanced Vehicle Systems II",
96 | year = 2009,
97 | url = {https://ntrs.nasa.gov/archive/nasa/casi.ntrs.nasa.gov/20090037584.pdf},
98 | doi = {10.2514/6.2009-6655}
99 | }
100 |
101 | @book{huzel1967,
102 | author = "Dieter K. Huzel and David H. Huang",
103 | title = "Design of Liquid Propellant Rocket Engines, 2nd Edition. NASA SP-125",
104 | publisher = "Office of Technology Utilization, NASA",
105 | year = "1967 (may be 1971 -- date uncertain)",
106 | url = {https://ntrs.nasa.gov/archive/nasa/casi.ntrs.nasa.gov/19710019929.pdf}
107 | }
108 |
109 | @article{kephart1971,
110 | author = "D. C. Kephart",
111 | title = "{BOOST: On-Line Computer Program for Estimating Powered-Rocket Performance. R-670-PR}",
112 | publisher = "United States Air Force Project Rand",
113 | year = 1971,
114 | url = {https://www.rand.org/content/dam/rand/pubs/reports/2006/R670.pdf}
115 | }
116 |
117 | @article{kibbey2015,
118 | author = "T. P. Kibbey",
119 | title = "Rho-{I}sp Revisited and Basic Stage Mass Estimating for Launch Vehicle Conceptual Sizing Studies",
120 | journal = "AIAA/SAE/ASEE Joint Propulsion Conference, AIAA Propulsion and Energy Forum",
121 | publisher = "American Institute of Aeronautics and Astronautics",
122 | year = "2015",
123 | doi = {10.2514/6.2015-3791},
124 | url = {https://ntrs.nasa.gov/archive/nasa/casi.ntrs.nasa.gov/20150016561.pdf}
125 | }
126 |
127 | @book{levine1971,
128 | editor = "G. M. Levine",
129 | title = "Apollo: Guidance, Navigation and Control",
130 | volume = "Section 5: Guidance Equations (Rev.~11)",
131 | publisher = "Charles Stark Draper Laboratory, MIT",
132 | year = "1971",
133 | url = {https://www.ibiblio.org/apollo/Documents/j2-80-R-567-SEC5-REV11_text.pdf}
134 | }
135 |
136 | @book{marble1964,
137 | editor = "F. E. Marble",
138 | title = "Spacecraft Propulsion",
139 | publisher = "Space Technology Summer Institute. California Institute of Technology",
140 | year = "1964",
141 | url = {https://authors.library.caltech.edu/62399/1/ST-3.pdf}
142 | }
143 |
144 | @book{maynard1966,
145 | author = "O. E. Maynard and J. R. Sevier",
146 | title = "Apollo Lunar Landing Mission Symposium",
147 | publisher = "NASA",
148 | year = "1966",
149 | volume = "1, General Mission Summary"
150 | }
151 |
152 | @book{press2007,
153 | author = {Press, William H. and Teukolsky, Saul A. and Vetterling, William T. and Flannery, Brian P.},
154 | title = {Numerical Recipes 3rd Edition: The Art of Scientific Computing},
155 | year = {2007},
156 | isbn = {0521880688, 9780521880688},
157 | edition = {3},
158 | publisher = {Cambridge University Press},
159 | address = {New York, NY, USA},
160 | }
161 |
162 | @article{prince2011,
163 | author = {Jill L. Prince and Prasun N. Desai and Eric M. Queen and Myron R. Grover},
164 | title = {Mars Phoenix Entry, Descent and Landing Simulation Design and Modelling Analysis},
165 | journal = {Journal of Spacecraft and Rockets},
166 | volume = 48,
167 | number = 5,
168 | pages = {754--764},
169 | year = 2011,
170 | doi = {10.2514/1.46561},
171 | url = {https://ntrs.nasa.gov/archive/nasa/casi.ntrs.nasa.gov/20080033126.pdf}
172 | }
173 |
174 | @article{rein2017,
175 | author = {Rein, Hanno and Tamayo, Daniel},
176 | title = "{JANUS: a bit-wise reversible integrator for N-body dynamics}",
177 | journal = {Monthly Notices of the Royal Astronomical Society},
178 | volume = {473},
179 | number = {3},
180 | pages = {3351--3357},
181 | year = {2017},
182 | month = {09},
183 | issn = {0035-8711},
184 | doi = {10.1093/mnras/stx2479},
185 | url = {https://arxiv.org/abs/1704.07715},
186 | }
187 |
188 | @article{springmann2004,
189 | author = "Philip N. Springmann and Olivier L. de Weck",
190 | title = "Parametric Scaling Model for Nongeosynchronous Communications Satellites",
191 | journal = "Journal of Spacecraft and Rockets",
192 | volume = {41},
193 | number = {3},
194 | pages = {472--477},
195 | year = {2004},
196 | month = {05},
197 | doi = {10.2514/1.6220},
198 | url = {http://web.mit.edu/deweck/www/PDF_archive/2%20Refereed%20Journal/2_3_JSR_parametric_NGSO.pdf}
199 | }
200 |
201 | @book{townsend1968,
202 | author = {G. E. Townsend and A. S. Abbott and R. R. Palmer},
203 | title = "{Guidance, Flight Mechanics and Trajectory Optimization. NASA CR-1007}",
204 | year = {1968},
205 | volume = "{VIII -- Boost Guidance Equations}",
206 | publisher = "{NASA}",
207 | url = {https://ntrs.nasa.gov/archive/nasa/casi.ntrs.nasa.gov/19680010980.pdf}
208 | }
209 |
210 | @book{widnall2008,
211 | author = {S. Widnall and J. Peraire},
212 | title = "{16.07 Dynamics, Lecture L17 -- Orbit Transfers and Interplanetary Trajectories. MIT Open Courseware}",
213 | year = {2008},
214 | publisher = "{MIT}",
215 | url = {https://ocw.mit.edu/courses/aeronautics-and-astronautics/16-07-dynamics-fall-2009/lecture-notes/MIT16_07F09_Lec17.pdf}
216 | }
--------------------------------------------------------------------------------
/src/LunarAscent/AGC.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE ExplicitNamespaces #-}
2 | {-# LANGUAGE FlexibleContexts #-}
3 | {-# LANGUAGE NegativeLiterals #-}
4 | {-# LANGUAGE QuasiQuotes #-}
5 | {-# LANGUAGE ScopedTypeVariables #-}
6 | {-# LANGUAGE TypeApplications #-}
7 | {-# LANGUAGE TypeFamilies #-}
8 | {-# LANGUAGE TypeOperators #-}
9 | module LunarAscent.AGC where
10 |
11 | import Control.Lens ((^.))
12 | import Data.Basis (Basis, HasBasis)
13 | import Data.VectorSpace (InnerSpace, Scalar, VectorSpace, zeroV)
14 |
15 | import LunarAscent.Types (AGCCommand (AGCCommand),
16 | AGCState (AGCState), AscentTarget,
17 | Constants, EngineShutoff (EngineShutoff),
18 | LVCS, MFCS, P2, Sim,
19 | ThrustAngle (ThrustAngle), V2, accel,
20 | agcState, apsExhaustVelocity,
21 | apsMassFlowRate, bThreshold, dynamics, mass,
22 | moonSGP, pos, prevThrustAngle, qcsAssignV2,
23 | qv2, rDotFLVPEnd, t2_HoldAll,
24 | t3_PositionControl, tEngineThreshold,
25 | targetRadius, targetVel, tgo, time, vel)
26 | import Units (type (@+), Qu, qMagnitude, qNegate,
27 | qNormalized, qSq, si, ( # ), (%), (%.),
28 | (*|), (|*^|), (|*|), (|+|), (|-|), (|.+^|),
29 | (|.-.|), (|.|), (|/), (|/|), (|^*|))
30 | import qualified Units as U
31 |
32 |
33 | -- | Ascent guidance program P12.
34 | p12
35 | :: forall a.
36 | ( InnerSpace a, a ~ Scalar a, Floating a, Ord a, Basis a ~ (), HasBasis a )
37 | => Constants a
38 | -> AscentTarget a
39 | -> Sim a
40 | -> (AGCCommand a, AGCState a)
41 | p12 constants target sim =
42 | let
43 | -- convert position and velocity from moon-fixed coordinates
44 | -- (MFCS) to local vertical coordinates (LVCS)
45 | p_l :: U.Length (P2 LVCS a)
46 | v_l :: U.Velocity (V2 LVCS a)
47 | a_l :: U.Acceleration (V2 LVCS a)
48 | (p_l, v_l, a_l) = mfcsToLocal (sim^.dynamics.pos)
49 | (sim^.dynamics.vel)
50 | (sim^.accel)
51 | p_lv :: U.Length (V2 LVCS a)
52 | p_lv = p_l |.-.| (zeroV %. [si| m |]) -- LVCS position as a vector
53 |
54 | -- unit vector in the radial direction of the local coordinate system
55 | u_R = qv2 @LVCS 1 0
56 |
57 | -- radial position and velocity
58 | r = qMagnitude p_lv
59 | rDot = v_l |.| u_R
60 |
61 | -- target radial position and velocity
62 | r_D = target^.targetRadius
63 | rDot_D = target^.targetVel |.| u_R
64 |
65 | -- v_G' - the velocity to be gained, which is the target velocity
66 | -- minus current LVCS velocity
67 | v_G' = target^.targetVel |-| v_l
68 |
69 | -- compensate v_G' for g_eff
70 | g_N = averageG (constants^.moonSGP) p_l v_l a_l (2 % [si| s |])
71 | g_eff = qSq (p_lv `qCross2D` v_l) |/| (r |*| r |*| r) |-| qMagnitude g_N
72 | v_G = v_G' |-| (0.5 *| sim^.agcState.tgo |*| g_eff |*^| u_R)
73 |
74 | -- update time-to-go estimate
75 | tau = sim^.dynamics.mass |/| constants^.apsMassFlowRate
76 | ve = constants^.apsExhaustVelocity
77 | v_G_mag = qMagnitude v_G
78 | tgo' = tau |*| v_G_mag |/| ve |*| (1 |-| 0.5 *| v_G_mag |/| ve) -- Apollo original
79 | -- tgo' = tau |*| (1 |-| exp (-1 *| v_G_mag |/| ve)) -- more accurate Tsiolkovsky solution
80 |
81 | -- compute control rate signals
82 | l = log (1 |-| tgo' |/| tau) -- ~= -1 *| v_G_mag |/| ve
83 | d12 = tau |+| tgo' |/| l
84 | d21 = tgo' |-| d12
85 | e = (tgo' |/ 2) |-| d21
86 | b' = (d21 |*| (rDot_D |-| rDot) |-| (r_D |-| r |-| rDot |^*| tgo'))
87 | |/| (tgo' |*| e)
88 | -- "B" control parameter
89 | b
90 | -- in "Injection Position Control" mode, the B parameter is set to zero
91 | | tgo' < constants^.t3_PositionControl = 0 % [si| m/s^2 |]
92 | -- B parameter must be negative; it's clamped at zero
93 | | b' > 0 % [si| m/s^2 |] = 0 % [si| m/s^2 |]
94 | -- the B parameter has a low threshold that it can't drop below
95 | | b' < constants^.bThreshold |*| tau = constants^.bThreshold |*| tau
96 | -- in between the lower and upper thresholds; use the computed value
97 | | otherwise = b'
98 | -- "A" control parameter.
99 | a = (-1) *| b |*| d12 |-| (rDot_D |-| rDot) |/| l
100 |
101 | -- compute thrust angle
102 | aTR = (a |+| (1 % [si| s |]) |*| b) |/| tau |-| g_eff -- desired rad accel
103 | -- In the real ACG, the maximum acceleration is computed from
104 | -- filtered measurements of thrust; that's not necessary
105 | -- here... just using the nominal value based on the exhaust
106 | -- velocity.
107 | aMax = constants^.apsExhaustVelocity |/| tau -- maximum acceleration
108 | angle = if aTR > aMax
109 | -- if we request more radial thrust than the maximum
110 | -- possible acceleration, then just command the thrust
111 | -- straight down
112 | then ThrustAngle 0
113 | -- otherwise, compute the thrust angle by comparing the
114 | -- required radial thrust to the total available thrust
115 | else ThrustAngle $ acos (aTR |/| aMax) # [si| |]
116 |
117 | -- near the end of the burn, we schedule the engine to cut-off;
118 | -- this is done once the time-to-go has passed a threshold point
119 | shutoff = if tgo' < constants^.tEngineThreshold
120 | then Just (EngineShutoff (sim^.time |+| tgo'))
121 | else Nothing
122 |
123 | -- compute the new commanded thrust angle
124 | thrustAngle
125 | -- during the vertical ascent we use a fixed zero thrust
126 | -- angle. vertical ascent is any time prior to achieving a
127 | -- vertical velocity of (nominally) 40feet-per-second
128 | | rDot < constants^.rDotFLVPEnd = ThrustAngle 0
129 | -- during the final control-hold stage (nominally 2 sec), we use
130 | -- the previously-commanded thrust angle
131 | | tgo' < constants^.t2_HoldAll = sim^.agcState.prevThrustAngle
132 | -- all other times; use the computed control thrust angle
133 | | otherwise = angle
134 | in
135 | (AGCCommand thrustAngle shutoff, AGCState tgo' thrustAngle)
136 |
137 |
138 | -- | Convert position and velocity in moon-fixed coordinates ('MFCS')
139 | -- to local vertical coordinates ('LVCS').
140 | mfcsToLocal
141 | :: forall a.
142 | ( InnerSpace a, Floating (Scalar a), Num a )
143 | => U.Length (P2 MFCS a) -- ^ Position in moon-fixed coords.
144 | -> U.Velocity (V2 MFCS a) -- ^ Velocity in moon-fixed coords.
145 | -> U.Acceleration (V2 MFCS a) -- ^ Acceleration in moon-fixed coords.
146 | -> ( U.Length (P2 LVCS a)
147 | , U.Velocity (V2 LVCS a)
148 | , U.Acceleration (V2 LVCS a) )
149 | mfcsToLocal p v a =
150 | let
151 | pv = qcsAssignV2 $ p |.-.| (zeroV %. [si| m |])
152 |
153 | u_R = qNormalized $ pv
154 | u_Z = qRotatedCW u_R
155 |
156 | r_LVCS = qv2 @LVCS 1 0
157 | z_LVCS = qv2 @LVCS 0 1
158 |
159 | p' = (zeroV %. [si| m |])
160 | |.+^| ((pv |.| u_R) |*^| r_LVCS)
161 | |.+^| ((pv |.| u_Z) |*^| z_LVCS)
162 | v' = ((v |.| u_R) |*^| r_LVCS)
163 | |+| ((v |.| u_Z) |*^| z_LVCS)
164 | a' = ((a |.| u_R) |*^| r_LVCS)
165 | |+| ((a |.| u_Z) |*^| z_LVCS)
166 | in
167 | (p', v', a')
168 |
169 |
170 | -- | Rotate vector 90 degrees clockwise.
171 | qRotatedCW
172 | :: forall d l c a.
173 | ( VectorSpace a, Num a, InnerSpace a
174 | , U.Normalize (U.Normalize d) ~ U.Normalize d )
175 | => U.Qu d l (V2 c a) -> U.Qu (U.Normalize d) l (V2 c a)
176 | qRotatedCW v =
177 | let
178 | i = qv2 1 0
179 | j = qv2 0 1
180 | x = v |.| i
181 | y = v |.| j
182 | x' = y
183 | y' = qNegate x
184 | in
185 | (x' |*^| i) |+| (y' |*^| j)
186 |
187 |
188 | -- | Instantaneous acceleration due to gravity.
189 | gravAccel
190 | :: forall a c.
191 | ( InnerSpace a, Floating a, a ~ Scalar a )
192 | => U.SGPUnit a
193 | -> U.Length (P2 c a)
194 | -> U.Acceleration (V2 c a)
195 | gravAccel mu r =
196 | let
197 | vr = r |.-.| (zeroV %. [si| m |])
198 | rhat = U.qNormalized vr
199 | r2 = U.qMagnitudeSq vr
200 | in
201 | -1 *| mu |/| r2 |*^| rhat
202 |
203 |
204 | -- | Average gravity during a time period.
205 | averageG
206 | :: ( InnerSpace a, a ~ Scalar a, Floating a )
207 | => U.SGPUnit a -- Specific gravitational parameter.
208 | -> U.Length (P2 LVCS a) -- Position of the vehicle.
209 | -> U.Velocity (V2 LVCS a) -- Velocity of the vehicle.
210 | -> U.Acceleration (V2 LVCS a) -- Acceleration of the vehicle.
211 | -> U.Time a -- Time increment.
212 | -> U.Acceleration (V2 LVCS a) -- Average velocity during the time increment.
213 | averageG mu r v a dt =
214 | let
215 | r' = r |.+^| ((1/8) *| a |^*| (dt |*| dt)) |.+^| ((1/2) *| v |^*| dt)
216 | in
217 | gravAccel mu r'
218 |
219 |
220 | -- | Magnitude of a cross-product between 2D vectors as though they were 3D.
221 | qCross2D
222 | :: ( Scalar a ~ a, InnerSpace a, Num a
223 | , U.Normalize (U.Normalize d1 @+ U.Normalize d2) ~ U.Normalize (d1 @+ d2) )
224 | => Qu d1 l (V2 c a)
225 | -> Qu d2 l (V2 c a)
226 | -> Qu (U.Normalize (d1 @+ d2)) l a
227 | qCross2D va vb =
228 | let
229 | i = qv2 1 0
230 | j = qv2 0 1
231 |
232 | vax = va |.| i
233 | vay = va |.| j
234 | vbx = vb |.| i
235 | vby = vb |.| j
236 | in
237 | (vax |*| vby) |-| (vay |*| vbx)
238 |
--------------------------------------------------------------------------------
/notes/beamer-trek/beamerinnerthemetrek.sty:
--------------------------------------------------------------------------------
1 | \makeatletter
2 |
3 | \def\largecircle{%
4 | \tikz[baseline]{
5 | \fill (0,0.75ex) circle (0.75ex);
6 | }%
7 | }
8 |
9 | \defbeamertemplate*{itemize item}{trek}{\largecircle}
10 |
11 | \defbeamertemplate*{itemize subitem}{trek}{\largecircle}
12 |
13 | \defbeamertemplate*{itemize subsubitem}{trek}{\largecircle}
14 |
15 | \defbeamertemplate*{itemize/enumerate body begin}{trek}{%
16 | \renewcommand{\theenumi}{\ifnum\value{enumi}<10 0\fi\arabic{enumi}}%
17 | \renewcommand{\theenumii}{\ifnum\value{enumii}<10 0\fi\arabic{enumii}}%
18 | \renewcommand{\theenumiii}{\ifnum\value{enumiii}<10 0\fi\arabic{enumiii}}%
19 | \setlength\labelsep{\the\trek@titlegap}%
20 | %\setlength\itemsep{0pt}% TODO: arrange item separation nicely
21 | }
22 |
23 | \defbeamertemplate*{enumerate item}{trek}{%
24 | % height of "cursor button"
25 | \newdimen\cursor@height%
26 | \setbox0=\hbox{\usebeamerfont{itemize/enumerate body}ML8}%
27 | \cursor@height=\ht0%
28 | \advance\cursor@height by 0.6ex%
29 | % draw the enumerate item
30 | \tikz[baseline]{
31 | \draw (0,-0.3ex) node [
32 | xscale=-1,
33 | trek cursor,
34 | trek/cursor/width=\the\trek@cursorwidth,
35 | trek/cursor/height=\the\cursor@height
36 | ] {};
37 | \draw (-0.3ex,0) node [anchor=south east,inner sep=0,line width=0] {%
38 | \color{black}\insertenumlabel%
39 | };
40 | \filldraw (\the\trek@buttongap,-0.3ex) rectangle ++(\the\trek@titlegap,\the\cursor@height);
41 | }%
42 | }
43 |
44 | \defbeamertemplate*{enumerate subitem}{trek}{%
45 | % height of "cursor button"
46 | \newdimen\cursor@height%
47 | \setbox0=\hbox{\usebeamerfont{itemize/enumerate subbody}ML8}%
48 | \cursor@height=\ht0%
49 | \advance\cursor@height by 0.6ex%
50 | % width of "00"
51 | \newdimen\prev@width%
52 | \setbox0=\hbox{00}%
53 | \prev@width=\wd0%
54 | % width of cursor
55 | \newdimen\cursor@width%
56 | \cursor@width=\the\trek@cursorwidth%
57 | \advance\cursor@width by \prev@width%
58 | % draw the enumerate subitem
59 | \tikz[baseline]{
60 | \draw (0,-0.3ex) node [
61 | xscale=-1,
62 | trek cursor,
63 | trek/cursor/width=\the\cursor@width,
64 | trek/cursor/height=\the\cursor@height
65 | ]{};
66 | \draw (-0.3ex,0) node [anchor=south east,inner sep=0,line width=0] {%
67 | \color{black}\insertenumlabel-\insertsubenumlabel%
68 | };
69 | \filldraw (\the\trek@buttongap,-0.3ex) rectangle ++(\the\trek@titlegap,\the\cursor@height);
70 | }%
71 | }
72 |
73 | \defbeamertemplate*{enumerate subsubitem}{trek}%
74 | {%
75 | % height of "cursor button"
76 | \newdimen\cursor@height%
77 | \setbox0=\hbox{\usebeamerfont{itemize/enumerate subsubbody}ML8}%
78 | \cursor@height=\ht0%
79 | \advance\cursor@height by 0.6ex%
80 | % width of "00"
81 | \newdimen\prev@width%
82 | \setbox0=\hbox{00}%
83 | \prev@width=\wd0%
84 | % width of cursor
85 | \newdimen\cursor@width%
86 | \cursor@width=\the\trek@cursorwidth%
87 | \advance\cursor@width by \prev@width%
88 | \advance\cursor@width by \prev@width%
89 | % draw the enumerate subsubitem
90 | \tikz[baseline]{
91 | \draw (0,-0.3ex) node [
92 | xscale=-1,
93 | trek cursor,
94 | trek/cursor/width=\the\cursor@width,
95 | trek/cursor/height=\the\cursor@height
96 | ]{};
97 | \draw (-0.3ex,0) node [anchor=south east,inner sep=0,line width=0] {%
98 | \color{black}\insertenumlabel-\insertsubenumlabel-\insertsubsubenumlabel%
99 | };
100 | \filldraw (\the\trek@buttongap,-0.3ex) rectangle ++(\the\trek@titlegap,\the\cursor@height);
101 | }%
102 | }
103 |
104 | \defbeamertemplate*{title page}{trek}{%
105 | % Measure size of subtitle, to go in the top right corner
106 | \newdimen\@subtitlewidth%
107 | \newdimen\@subtitleheight%
108 | \setbox0=\hbox{\usebeamerfont{subtitle}\insertsubtitle}%
109 | \@subtitlewidth=\wd0%
110 | \setbox1=\hbox{\usebeamerfont{subtitle}8ML}%
111 | \@subtitleheight=\ht1%
112 | % Compute height of frametitle region
113 | \newdimen\frametitle@height%
114 | \frametitle@height=\@subtitleheight%
115 | \advance \frametitle@height by \trek@margin%
116 | % Measure size of institute, to go in the bottom right corner
117 | \newdimen\@institutewidth%
118 | \newdimen\@instituteheight%
119 | \setbox0=\hbox{\usebeamerfont{institute}\insertinstitute}%
120 | \@institutewidth=\wd0%
121 | \setbox1=\hbox{\usebeamerfont{institute}8ML}%
122 | \@instituteheight=\ht1%
123 | % Origin of the NE "cursor" (right-most knobbly thing)
124 | \newdimen\cursorne@x%
125 | \newdimen\cursorne@y%
126 | \cursorne@x=\paperwidth%
127 | \advance \cursorne@x by -\the\trek@margin%
128 | \advance \cursorne@x by -\the\trek@cursorwidth%
129 | \cursorne@y=\paperheight%
130 | \advance \cursorne@y by -\the\trek@margin%
131 | \advance \cursorne@y by -\the\@subtitleheight%
132 | % Origin of NW "cursor"
133 | \newdimen\cursornw@x%
134 | \newdimen\cursornw@y%
135 | \cursornw@x=\trek@cursorwidth%
136 | \advance \cursornw@x by \trek@margin%
137 | \cursornw@y=\cursorne@y%
138 | % Origin of the title (center of baseline)
139 | \newdimen\subtitle@x%
140 | \newdimen\subtitle@y%
141 | \subtitle@x=-\the\@subtitlewidth%
142 | \divide \subtitle@x by 2%
143 | \advance \subtitle@x by \the\cursorne@x%
144 | \advance \subtitle@x by -\the\trek@titlegap%
145 | \subtitle@y=\the\cursorne@y%
146 | % Top bar
147 | \newdimen\topbar@x%
148 | \newdimen\topbar@y%
149 | \newdimen\topbar@width%
150 | \topbar@x=\the\cursornw@x%
151 | \advance \topbar@x by \the\trek@titlegap%
152 | \topbar@y=\the\cursornw@y%
153 | \topbar@width=\the\paperwidth%
154 | \advance \topbar@width by -\the\topbar@x%
155 | \advance \topbar@width by -\the\trek@margin%
156 | \advance \topbar@width by -\the\@subtitlewidth%
157 | \advance \topbar@width by -\the\trek@cursorwidth%
158 | \advance \topbar@width by -\the\trek@titlegap%
159 | \advance \topbar@width by -\the\trek@titlegap%
160 | % Origin of the SW "cursor" (left-most knobbly thing)
161 | \newdimen\cursorsw@x%
162 | \newdimen\cursorsw@y%
163 | \cursorsw@x=\the\trek@cursorwidth%
164 | \advance \cursorsw@x by \the\trek@margin%
165 | \cursorsw@y=\the\trek@margin%
166 | % Origin of the institute (center of baseline)
167 | \newdimen\institute@x%
168 | \newdimen\institute@y%
169 | \institute@x=\the\@institutewidth%
170 | \divide \institute@x by 2%
171 | \advance \institute@x by \the\cursorsw@x%
172 | \advance \institute@x by \the\trek@titlegap%
173 | \institute@y=\cursorsw@y%
174 | % Bottom bar
175 | \newdimen\bottombar@x%
176 | \newdimen\bottombar@y%
177 | \newdimen\bottombar@width%
178 | \bottombar@x=\the\cursorsw@x%
179 | \advance \bottombar@x by \the\@institutewidth%
180 | \advance \bottombar@x by \the\trek@titlegap%
181 | \advance \bottombar@x by \the\trek@titlegap%
182 | \bottombar@y=\the\cursorsw@y%
183 | \bottombar@width=\the\paperwidth%
184 | \advance \bottombar@width by -\the\bottombar@x%
185 | \advance \bottombar@width by -\the\trek@margin%
186 | \advance \bottombar@width by -\the\trek@cursorwidth%
187 | \advance \bottombar@width by -\the\trek@titlegap%
188 | % Origin of the SE "cursor"
189 | \newdimen\cursorse@x%
190 | \newdimen\cursorse@y%
191 | \cursorse@x=\paperwidth%
192 | \advance\cursorse@x by -\the\trek@margin%
193 | \advance\cursorse@x by -\the\trek@cursorwidth%
194 | \cursorse@y=\the\cursorsw@y%
195 | % Typeset the title
196 | \vspace{-1.2pt}%
197 | \leavevmode%
198 | \hskip-\the\trek@full@sidebar@width%
199 | \hbox{%
200 | \begin{beamercolorbox}[wd=\paperwidth,ht=\paperheight,left]{subtitle}%
201 | \begin{tikzpicture}
202 | \useasboundingbox (0,0) rectangle (\paperwidth,\paperheight);
203 | %\draw [draw=none,fill=red] (0,0) rectangle (\paperwidth,\paperheight);
204 | % NE cursor
205 | \draw (\the\cursorne@x,\the\cursorne@y) node [
206 | trek cursor,
207 | trek/cursor/width=\the\trek@cursorwidth,
208 | trek/cursor/height=\the\@subtitleheight
209 | ]{};
210 | % subtitle text
211 | \draw (\the\subtitle@x,\the\subtitle@y) node [anchor=base,inner sep=0]
212 | {\usebeamerfont{subtitle}\insertsubtitle};
213 | % top bar
214 | \filldraw (\the\topbar@x,\the\topbar@y) rectangle ++(\the\topbar@width,\the\@subtitleheight);
215 | % NW cursor
216 | \draw (\the\cursornw@x,\the\cursornw@y) node [
217 | trek cursor,
218 | xscale=-1,
219 | trek/cursor/width=\the\trek@cursorwidth,
220 | trek/cursor/height=\the\@subtitleheight
221 | ]{};
222 | % cursor at left
223 | \draw (\the\cursorsw@x,\the\cursorsw@y) node [
224 | trek cursor,
225 | xscale=-1,
226 | trek/cursor/width=\the\trek@cursorwidth,
227 | trek/cursor/height=\the\@instituteheight
228 | ]{};
229 | % institute text
230 | \draw (\the\institute@x,\the\institute@y) node [anchor=base,inner sep=0]
231 | {\usebeamerfont{institute}\insertinstitute};
232 | % bottom bar
233 | \filldraw (\the\bottombar@x,\the\bottombar@y) rectangle ++(\the\bottombar@width,\the\@subtitleheight);
234 | % SE cursor
235 | \draw (\the\cursorse@x,\the\cursorse@y) node [
236 | trek cursor,
237 | trek/cursor/width=\the\trek@cursorwidth,
238 | trek/cursor/height=\the\@instituteheight
239 | ]{};
240 | % logo and title
241 | \draw (\paperwidth/2,\paperheight/2) node [anchor=center] {
242 | \parbox{\paperwidth}{
243 | \begin{center}
244 | \inserttitlegraphic\par
245 | {\usebeamercolor[fg]{title}\usebeamerfont{title}\vspace{1ex}\inserttitle}\par
246 | {\usebeamercolor[fg]{author}\usebeamerfont{author}\insertauthor}\par
247 | {\usebeamercolor[fg]{date}\usebeamerfont{date}\insertdate}\par
248 | \end{center}
249 | }
250 | };
251 | \end{tikzpicture}%
252 | \end{beamercolorbox}%
253 | }%
254 | }%
255 |
256 | \makeatother
257 |
--------------------------------------------------------------------------------
/src/Solutions/ODE.hs:
--------------------------------------------------------------------------------
1 | {-|
2 | Module : Solutions.ODE
3 | Description : Solutions for the 'ODE' module.
4 | -}
5 | {-# LANGUAGE FlexibleContexts #-}
6 | {-# LANGUAGE ScopedTypeVariables #-}
7 | {-# LANGUAGE TypeFamilies #-}
8 | {-# LANGUAGE TypeOperators #-}
9 | module Solutions.ODE
10 | ( -- * Functions
11 | -- ** terminating versions
12 | integrateTerminating
13 | , rk4StepTerminating
14 | -- ** vector-space versions
15 | , integrate
16 | , integrateWithDiff
17 | , rk4Step
18 | , eulerStep
19 | -- ** Euler's method for Double only
20 | , integrateEulerDouble
21 | , eulerStepDouble
22 | ) where
23 |
24 | import Data.AffineSpace (AffineSpace, Diff, (.+^))
25 | import Data.Basis (Basis, HasBasis)
26 | import Data.LinearMap ((:-*), lapply)
27 | import qualified Data.List as List
28 | import Data.List.NonEmpty (NonEmpty ((:|)))
29 | import qualified Data.List.NonEmpty as NonEmpty
30 | import Data.MemoTrie (HasTrie)
31 | import Data.VectorSpace (Scalar, VectorSpace, (*^), (^+^), (^-^),
32 | (^/))
33 |
34 | -------------------------------------------------------------------------------
35 | -- Integration of ODEs with termination
36 | -------------------------------------------------------------------------------
37 |
38 | -- | Stepper function for ODE integration that can terminate.
39 | type TerminatingStepper time state
40 | = time
41 | -> ((time, state) -> Maybe (time :-* Diff state))
42 | -> (time, state)
43 | -> Maybe (time, state)
44 |
45 |
46 | -- | Driver for an ODE that terminates itself.
47 | --
48 | -- Bisection is used to find a terminal value for the ODE at a time whose error
49 | -- is less than @tEpsilon@.
50 | integrateTerminating
51 | :: forall state diff time s.
52 | ( diff ~ Diff state
53 | , HasBasis time
54 | , s ~ Scalar time, Ord time, Fractional s )
55 | => TerminatingStepper time state -- ^ Stepper to use.
56 | -> time -- ^ Allowable error in the final time.
57 | -> time -- ^ Step size @h@.
58 | -> (time, state) -- ^ Initial state.
59 | -> ((time, state) -> Maybe (time :-* diff)) -- ^ Gradient function.
60 | -> NonEmpty (time, state) -- ^ Computed states.
61 | integrateTerminating stepper tEpsilon h state0 f =
62 | let
63 |
64 | -- Use a list internally, to avoid duplicating starting elements
65 | -- if/when we halve the time step.
66 | listIntegrator
67 | :: time -- ^ dt
68 | -> (time, state) -- ^ initial state
69 | -> [(time, state)] -- ^ list of states produced
70 | listIntegrator dt' state0' =
71 | let
72 | stepFn :: (time, state) -> Maybe ((time, state), (time, state))
73 | stepFn timeState = stepper dt' f timeState >>= \r -> pure (r, r)
74 |
75 | unfold1 :: [(time, state)]
76 | unfold1 = List.unfoldr stepFn state0'
77 | in
78 | -- If our time step is less than the required error, then we
79 | -- know that our end point is definitely within tEpsilon and
80 | -- we can terminate. Otherwise we have to get closer to the end
81 | -- point, which we can do by halving the time step and acquiring
82 | -- new samples if necessary.
83 | if dt' < tEpsilon
84 | then unfold1
85 | else
86 | let
87 | -- We may not have generated any samples at all so far; so we
88 | -- need to handle that case by starting from the initial state.
89 | state0'' = case unfold1 of
90 | [] -> state0'
91 | _ -> last unfold1
92 | in
93 | unfold1 ++ listIntegrator (dt'^/2) state0''
94 |
95 | in state0 :| listIntegrator h state0
96 |
97 |
98 | -- | Single step of terminating 4th-order Runge-Kutta integration.
99 | --
100 | -- A result is only returned if all none of the function evaluations indicate
101 | -- termination.
102 | rk4StepTerminating
103 | :: ( AffineSpace state
104 | , diff ~ Diff state, VectorSpace diff
105 | , HasBasis time, HasTrie (Basis time)
106 | , s ~ Scalar time, s ~ Scalar diff, Fractional s )
107 | => time -- ^ Step size @h@
108 | -> ((time, state) -> Maybe (time :-* Diff state)) -- ^ Gradient function @f (x, t)@
109 | -> (time, state) -- ^ Before the step @(t, x)@
110 | -> Maybe (time, state) -- ^ Optional @(t, x)@ after the step
111 | rk4StepTerminating h f (t, x) =
112 | let
113 | o6 = 1/6
114 | o3 = 1/3
115 | tf = t ^+^ h
116 | midt = t ^+^ (h ^/ 2)
117 | ldx dxdt = lapply dxdt h
118 | in do
119 | k1 <- ldx <$> f(t, x )
120 | k2 <- ldx <$> f(midt, x .+^ k1^/2)
121 | k3 <- ldx <$> f(midt, x .+^ k2^/2)
122 | k4 <- ldx <$> f(tf, x .+^ k3 )
123 | let xf = x .+^ o6*^k1 .+^ o3*^k2 .+^ o3*^k3 .+^ o6*^k4
124 | pure (tf, xf)
125 |
126 |
127 | -------------------------------------------------------------------------------
128 | -- Integration of ODEs; generalized to work with vector-space classes
129 | -------------------------------------------------------------------------------
130 |
131 | -- | Integrate an ODE.
132 | integrate
133 | :: forall state diff time.
134 | ( diff ~ Diff state
135 | , HasBasis time )
136 | => Stepper time state -- ^ Stepper function
137 | -> state -- ^ Initial state
138 | -> NonEmpty time -- ^ Evaluation times
139 | -> ((time, state) -> time :-* diff) -- ^ Gradient function
140 | -> NonEmpty (time, state) -- ^ Computed states
141 | integrate stepper x0 (t0 :| ts) f =
142 | let
143 | stepFn :: (time, state) -> time -> (time, state)
144 | stepFn q@(ti, _) tf = stepper (tf ^-^ ti) f q
145 | in
146 | NonEmpty.scanl stepFn (t0, x0) ts
147 |
148 |
149 | -- | Integrate an ODE, recording the gradient.
150 | integrateWithDiff
151 | :: forall state diff time.
152 | ( diff ~ Diff state
153 | , HasBasis time )
154 | => Stepper time state -- ^ Stepper function
155 | -> state -- ^ Initial state
156 | -> NonEmpty time -- ^ Evaluation times
157 | -> ((time, state) -> time :-* diff) -- ^ Gradient function
158 | -> NonEmpty (time, state, time :-* diff) -- ^ Computed states
159 | integrateWithDiff stepper x0 (t0 :| ts) f =
160 | let
161 | stepFn
162 | :: (time, state, time :-* diff)
163 | -> time
164 | -> (time, state, time :-* diff)
165 | stepFn (ti, si, _) tf =
166 | let
167 | (t', state') = stepper (tf ^-^ ti) f (ti, si)
168 | in
169 | (t', state', f (ti, si))
170 | in
171 | NonEmpty.scanl stepFn (t0, x0, f (t0, x0)) ts
172 |
173 |
174 | -- | Stepper function used in ODE integration.
175 | type Stepper time state
176 | = time
177 | -> ((time, state) -> time :-* Diff state)
178 | -> (time, state)
179 | -> (time, state)
180 |
181 |
182 | -- | Single step of 4th-order Runge-Kutta integration.
183 | rk4Step
184 | :: ( AffineSpace state
185 | , diff ~ Diff state, VectorSpace diff
186 | , HasBasis time, HasTrie (Basis time)
187 | , s ~ Scalar diff, s ~ Scalar time, Fractional s )
188 | => time -- ^ Step size @h@
189 | -> ((time, state) -> time :-* diff) -- ^ Gradient function @f (x, t)@
190 | -> (time, state) -- ^ Before the step @(t, x)@
191 | -> (time, state) -- ^ After the step @(t, x)@
192 | rk4Step h f (t, x) =
193 | let
194 | o6 = 1/6
195 | o3 = 1/3
196 | tf = t ^+^ h
197 | midt = t ^+^ (h ^/ 2)
198 |
199 | k1 = lapply (f (t, x )) h
200 | k2 = lapply (f (midt, x .+^ k1^/2)) h
201 | k3 = lapply (f (midt, x .+^ k2^/2)) h
202 | k4 = lapply (f (tf, x .+^ k3 )) h
203 | xf = x .+^ o6*^k1 .+^ o3*^k2 .+^ o3*^k3 .+^ o6*^k4
204 | in
205 | (tf, xf)
206 |
207 |
208 | -- | Single step of Euler integration.
209 | eulerStep
210 | :: ( AffineSpace state
211 | , diff ~ Diff state, VectorSpace diff
212 | , HasBasis time, HasTrie (Basis time)
213 | , s ~ Scalar diff, s ~ Scalar time )
214 | => time -- ^ Step size @h@
215 | -> ((time, state) -> time :-* diff) -- ^ Gradient function @f (x, t)@
216 | -> (time, state) -- ^ Before the step @(t, x)@
217 | -> (time, state) -- ^ After the step @(t, x)@
218 | eulerStep h f q@(t, x) = (t ^+^ h, x .+^ lapply (f q) h)
219 |
220 |
221 | -------------------------------------------------------------------------------
222 | -- Euler's method specialized to Double only
223 | -------------------------------------------------------------------------------
224 |
225 | -- | Integrate an ODE using Euler's method (specialized to 'Double').
226 | integrateEulerDouble
227 | :: ((Double, Double) -> Double) -- ^ Gradient function @f (t, x)@
228 | -> Double -- ^ Initial state @x0@
229 | -> NonEmpty Double -- ^ NonEmpty of @t@ values
230 | -> NonEmpty (Double, Double) -- ^ NonEmpty of @(t, x)@ values
231 | integrateEulerDouble f x0 (t0 :| ts) =
232 | let
233 | stepFn :: (Double, Double) -> Double -> (Double, Double)
234 | stepFn q@(tStart, _) tEnd = eulerStepDouble (tEnd - tStart) f q
235 | in
236 | NonEmpty.scanl stepFn (t0, x0) ts
237 |
238 |
239 | -- | Single step of Euler integration (specialized to 'Double').
240 | eulerStepDouble
241 | :: Double -- ^ Step size
242 | -> ((Double, Double) -> Double) -- ^ Gradient function @f@
243 | -> (Double, Double) -- ^ State before the step @(x, y)@
244 | -> (Double, Double) -- ^ State after the step @(x, y)@
245 | eulerStepDouble h f q@(t, x) = (t + h, x + (h*f q))
246 |
--------------------------------------------------------------------------------
/src/ODE.hs:
--------------------------------------------------------------------------------
1 | {-|
2 | Module : ODE
3 | Description : Integration of Ordinary Differential Equations.
4 |
5 | Solutions for the problems in this module are contained in the
6 | 'Solutions.ODE' module.
7 | -}
8 | {-# LANGUAGE FlexibleContexts #-}
9 | {-# LANGUAGE NegativeLiterals #-}
10 | {-# LANGUAGE ScopedTypeVariables #-}
11 | {-# LANGUAGE TypeFamilies #-}
12 | {-# LANGUAGE TypeOperators #-}
13 | {-# OPTIONS_GHC -Wno-unused-imports #-} -- re-enable after completing solutions
14 | module ODE
15 | ( -- * Types
16 | Stepper
17 | -- * Functions
18 | -- ** Useful utilities
19 | , linspace
20 | -- ** vector-space versions
21 | , integrate
22 | , integrateWithDiff
23 | , rk4Step
24 | , eulerStep
25 | -- ** self-terminating versions
26 | , integrateTerminating
27 | , rk4StepTerminating
28 | -- ** Euler's method for Double only
29 | , integrateEulerDouble
30 | , eulerStepDouble
31 | ) where
32 |
33 | import Data.AffineSpace (AffineSpace, Diff, (.+^))
34 | import Data.Basis (Basis, HasBasis)
35 | import Data.LinearMap ((:-*), lapply)
36 | import qualified Data.List as List
37 | import Data.List.NonEmpty (NonEmpty ((:|)))
38 | import qualified Data.List.NonEmpty as NonEmpty
39 | import Data.MemoTrie (HasTrie)
40 | import Data.VectorSpace (Scalar, VectorSpace, (*^), (^+^), (^-^),
41 | (^/))
42 |
43 | import qualified Solutions.ODE
44 | import Todo (FallbackSolution (FallbackSolution), todo)
45 |
46 |
47 | -- | Single step of Euler integration (specialized to 'Double').
48 | --
49 | -- Euler's method specialized to Double. The relevant equations are:
50 | --
51 | -- tNext = t + h
52 | --
53 | -- xNext = x + h
54 | -- = x + (dx/dt)*h
55 | -- = x + h * f (t, x)
56 | --
57 | -- Example:
58 | --
59 | -- >>> f (_, x) = -0.2 * x -- this is an exponential decay equation
60 | -- >>> eulerStepDouble 1 f (2, 5)
61 | -- (3.0,4.0)
62 | --
63 | -- @
64 | -- ^ ^ ^ ^ ^
65 | -- | | | | |
66 | -- | | | | --- x = 5 before the time step
67 | -- | | | ------ t = 2 before the time step
68 | -- | | ----------- h = 1 is the time step
69 | -- | ---- x = 4 after the time step
70 | -- -------- t = 3 after the time step
71 | -- @
72 | --
73 | eulerStepDouble
74 | :: Double -- ^ Step size @h@
75 | -> ((Double, Double) -> Double) -- ^ Gradient function @f (t, x)@
76 | -> (Double, Double) -- ^ Time and state before the step @(t, x)@
77 | -> (Double, Double) -- ^ Time and state after the step @(t, x)@
78 | eulerStepDouble -- h f q@(t, x)
79 | = todo (FallbackSolution Solutions.ODE.eulerStepDouble)
80 |
81 |
82 | -- | Integrate an ODE using Euler's method (specialized to 'Double').
83 | --
84 | -- NOTE: The NonEmpty.scanl function is a convenient way to drive the
85 | -- computation.
86 | --
87 | -- Example:
88 | --
89 | -- >>> f (_, x) = -0.2 * x -- this is an exponential decay equation
90 | -- >>> times = NonEmpty.fromList [ 1, 2, 3 ]
91 | -- >>> x0 = 50.0
92 | -- >>> integrateEulerDouble f x0 times
93 | -- (1.0,50.0) :| [(2.0,40.0),(3.0,32.0)]
94 | integrateEulerDouble
95 | :: ((Double, Double) -> Double) -- ^ Gradient function @f (t, x)@
96 | -> Double -- ^ Initial state @x0@
97 | -> NonEmpty Double -- ^ NonEmpty of @t@ values
98 | -> NonEmpty (Double, Double) -- ^ NonEmpty of @(t, x)@ values
99 | integrateEulerDouble -- f x0 (t0 :| ts)
100 | = todo (FallbackSolution Solutions.ODE.integrateEulerDouble)
101 | {- Template:
102 | let
103 | stepFn :: (Double, Double) -> Double -> (Double, Double)
104 | stepFn q@(tStart, _) tEnd = -- TODO
105 | in
106 | NonEmpty.scanl stepFn (t0, x0) ts
107 | -}
108 |
109 |
110 | -- | Linearly-spaced samples.
111 | --
112 | -- Example:
113 | --
114 | -- >>> linspace 5 0.0 10.0 :: [Double]
115 | -- [0.0,2.0,4.0,6.0,8.0,10.0]
116 | linspace
117 | :: ( VectorSpace a, s ~ Scalar a, Fractional s )
118 | => Int -- ^ Number of divisions (1 less than the number of samples)
119 | -> a -- ^ Start of the sample range (== first sample)
120 | -> a -- ^ End of the sample range (== last sample for n > 2)
121 | -> [a] -- ^ Samples
122 | linspace n xStart xEnd =
123 | let
124 | n' = fromIntegral n
125 | range = xEnd ^-^ xStart
126 | f i = fromIntegral i *^ range ^/ n' ^+^ xStart
127 | in
128 | [ f i | i <- [0 .. n] ]
129 |
130 |
131 | -- | Single step of Euler integration.
132 | --
133 | -- Example:
134 | --
135 | -- >>> f (_, x) = linear $ \dt -> -0.2 * x * dt
136 | -- >>> eulerStep 1 f (2, 5)
137 | -- (3.0,4.0)
138 | eulerStep
139 | :: ( AffineSpace state
140 | , diff ~ Diff state, VectorSpace diff
141 | , HasBasis time, HasTrie (Basis time)
142 | , s ~ Scalar diff, s ~ Scalar time )
143 | => time -- ^ Step size @h@
144 | -> ((time, state) -> time :-* diff) -- ^ Gradient function @f (x, t)@
145 | -> (time, state) -- ^ Before the step @(t, x)@
146 | -> (time, state) -- ^ After the step @(t, x)@
147 | eulerStep -- h f (t, x)
148 | = todo (FallbackSolution Solutions.ODE.eulerStep)
149 |
150 |
151 | -- | Stepper function used in ODE integration.
152 | type Stepper time state
153 | = time
154 | -> ((time, state) -> time :-* Diff state)
155 | -> (time, state)
156 | -> (time, state)
157 |
158 |
159 | -- | Integrate an ODE.
160 | --
161 | -- Example:
162 | --
163 | -- >>> f (_, x) = linear $ \dt -> -0.2 * x * dt
164 | -- >>> times = NonEmpty.fromList [1, 2, 3]
165 | -- >>> x0 = 50.0
166 | -- >>> integrate eulerStep x0 times f
167 | -- (1.0,50.0) :| [(2.0,40.0),(3.0,32.0)]
168 | integrate
169 | :: ( diff ~ Diff state
170 | , HasBasis time )
171 | => Stepper time state -- ^ Stepper function
172 | -> state -- ^ Initial state
173 | -> NonEmpty time -- ^ Evaluation times
174 | -> ((time, state) -> time :-* diff) -- ^ Gradient function
175 | -> NonEmpty (time, state) -- ^ Computed states
176 | integrate -- stepper x0 (t0 :| ts) f
177 | = todo (FallbackSolution Solutions.ODE.integrate)
178 |
179 |
180 | -- | Integrate an ODE, recording the gradient.
181 | integrateWithDiff
182 | :: forall state diff time.
183 | ( diff ~ Diff state
184 | , HasBasis time )
185 | => Stepper time state -- ^ Stepper function
186 | -> state -- ^ Initial state
187 | -> NonEmpty time -- ^ Evaluation times
188 | -> ((time, state) -> time :-* diff) -- ^ Gradient function
189 | -> NonEmpty (time, state, time :-* diff) -- ^ Computed states
190 | integrateWithDiff -- stepper x0 (t0 :| ts) f =
191 | = todo (FallbackSolution Solutions.ODE.integrateWithDiff)
192 |
193 |
194 | -- | Single step of 4th-order Runge-Kutta integration.
195 | --
196 | --
197 | -- The equations for a single step of RK4 are as follows:
198 | --
199 | -- k1 = h * f (t, x)
200 | -- k2 = h * f (t + 0.5*h, x + 0.5*k1)
201 | -- k3 = h * f (t + 0.5*h, x + 0.5*k2)
202 | -- k4 = h * f (t + h, x + k3)
203 | --
204 | -- dx = (1/6)*k1 + (1/3)*k2 + (1/3)*k3 + (1/6)*k4
205 | --
206 | -- xNext = x + dx
207 | -- tNext = t + h
208 | rk4Step
209 | :: ( AffineSpace state
210 | , diff ~ Diff state, VectorSpace diff
211 | , HasBasis time, HasTrie (Basis time)
212 | , s ~ Scalar diff, s ~ Scalar time, Fractional s )
213 | => time -- ^ Step size @h@
214 | -> ((time, state) -> time :-* diff) -- ^ Gradient function @f (x, t)@
215 | -> (time, state) -- ^ Before the step @(t, x)@
216 | -> (time, state) -- ^ After the step @(t, x)@
217 | rk4Step -- h f q@(t, x)
218 | = todo (FallbackSolution Solutions.ODE.rk4Step)
219 |
220 |
221 | -- | Stepper function for ODE integration that can terminate.
222 | type TerminatingStepper time state
223 | = time
224 | -> ((time, state) -> Maybe (time :-* Diff state))
225 | -> (time, state)
226 | -> Maybe (time, state)
227 |
228 |
229 | -- | Driver for an ODE that terminates itself.
230 | --
231 | -- Bisection is used to find a terminal value for the ODE at a time whose error
232 | -- is less than @tEpsilon@.
233 | integrateTerminating
234 | :: forall state diff time s.
235 | ( diff ~ Diff state
236 | , HasBasis time
237 | , s ~ Scalar time, Ord time, Fractional s )
238 | => TerminatingStepper time state -- ^ Stepper to use.
239 | -> time -- ^ Allowable error in the final time.
240 | -> time -- ^ Step size @h@.
241 | -> (time, state) -- ^ Initial state.
242 | -> ((time, state) -> Maybe (time :-* diff)) -- ^ Gradient function.
243 | -> NonEmpty (time, state) -- ^ Computed states.
244 | integrateTerminating {- stepper tEpsilon h state0 f -}
245 | = todo (FallbackSolution Solutions.ODE.integrateTerminating)
246 |
247 |
248 | -- | Single step of terminating 4th-order Runge-Kutta integration.
249 | --
250 | -- A result is only returned if all none of the function evaluations indicate
251 | -- termination.
252 | rk4StepTerminating
253 | :: ( AffineSpace state
254 | , diff ~ Diff state, VectorSpace diff
255 | , HasBasis time, HasTrie (Basis time)
256 | , s ~ Scalar time, s ~ Scalar diff, Fractional s )
257 | => time -- ^ Step size @h@
258 | -> ((time, state) -> Maybe (time :-* Diff state)) -- ^ Gradient function @f (x, t)@
259 | -> (time, state) -- ^ Before the step @(t, x)@
260 | -> Maybe (time, state) -- ^ Optional @(t, x)@ after the step
261 | rk4StepTerminating {- h f (t, x) -}
262 | = todo (FallbackSolution Solutions.ODE.rk4StepTerminating)
263 |
264 |
265 | {- $setup
266 |
267 | >>> :set -XFlexibleContexts -XNegativeLiterals -XTypeFamilies
268 | >>> import Data.LinearMap (linear)
269 |
270 | -- >>> :set -XQuasiQuotes -XFlexibleContexts -XTypeFamilies
271 | -- >>> import Data.Metrology.Vector ((%), (|*|))
272 | -- >>> import Data.Units.SI.Parser (si)
273 |
274 | -}
275 |
--------------------------------------------------------------------------------
/notes/beamer-trek/beamerouterthemetrek.sty:
--------------------------------------------------------------------------------
1 | \RequirePackage{etex}
2 | \RequirePackage{tikz}
3 | \RequirePackage{trek-shapes}
4 |
5 | \mode