|
4 | 4 | ;; 1.44](https://tgvaughan.github.io/sicm/chapter001.html#Exe_1-44) from Sussman |
5 | 5 | ;; and Wisdom's [Structure and Interpretation of Classical |
6 | 6 | ;; Mechanics](https://tgvaughan.github.io/sicm/), using |
7 | | -;; the [SICMUtils](https://github.com/sicmutils/sicmutils) Clojure library and |
| 7 | +;; the [Emmy](https://github.com/mentat-collective/emmy) Clojure library and |
8 | 8 | ;; the Clerk rendering environment. |
9 | 9 |
|
10 | 10 | #_{:clj-kondo/ignore [:refer-all]} |
11 | | -(ns sicmutils |
| 11 | +(ns emmy |
12 | 12 | (:refer-clojure |
13 | | - :exclude [+ - * / partial ref zero? numerator denominator compare = run!]) |
| 13 | + :exclude [+ - * / partial ref zero? numerator denominator compare = run! |
| 14 | + abs infinite?]) |
14 | 15 | (:require [nextjournal.clerk :as clerk] |
15 | | - [sicmutils.env :as e :refer :all] |
16 | | - [sicmutils.expression.render :as xr])) |
| 16 | + [emmy.env :as e :refer :all] |
| 17 | + [emmy.expression.compile :as xc] |
| 18 | + [emmy.expression.render :as xr])) |
17 | 19 |
|
18 | 20 | ;; ## Lagrangian |
19 | 21 | ;; |
|
39 | 41 | (* 1/2 m2 (+ (square xdot2) |
40 | 42 | (square ydot2)))))) |
41 | 43 |
|
42 | | - |
43 | 44 | ;; `V` describes a uniform gravitational potential with coefficient `g`, acting |
44 | 45 | ;; on two particles with masses of, respectively, `m1` and `m2`. Again, this is |
45 | 46 | ;; written in rectangular coordinates. |
|
86 | 87 |
|
87 | 88 | ;; And here are the equations of motion for the system: |
88 | 89 |
|
| 90 | +;; TODO this currently causes a notebook failure. |
| 91 | +#_ |
89 | 92 | (let [L (L-double-pendulum 'm_1 'm_2 'l_1 'l_2 'g)] |
90 | 93 | (binding [xr/*TeX-vertical-down-tuples* true] |
91 | 94 | (render-eq |
|
172 | 175 | ;; state. Chaotic first: |
173 | 176 |
|
174 | 177 | (def raw-chaotic-data |
175 | | - (run! step horizon chaotic-initial-q)) |
| 178 | + (time |
| 179 | + (run! step horizon chaotic-initial-q))) |
176 | 180 |
|
177 | 181 | ;; Looks good: |
178 | 182 |
|
|
181 | 185 | ;; Next, the regular initial condition: |
182 | 186 |
|
183 | 187 | (def raw-regular-data |
184 | | - (run! step horizon regular-initial-q)) |
| 188 | + (time |
| 189 | + (run! step horizon regular-initial-q))) |
185 | 190 |
|
186 | 191 | ;; Peek at the final state: |
187 | 192 |
|
188 | 193 | (peek raw-regular-data) |
189 | 194 |
|
| 195 | + |
190 | 196 | ;; ## Measurements, Data Transformation |
191 | 197 |
|
192 | 198 | ;; Next we'll chart the measurements trapped in those sequences of state tuples. |
|
225 | 231 | #_{:clj-kondo/ignore [:unresolved-symbol]} |
226 | 232 | (defn transform-data [xs] |
227 | 233 | (let [energy-fn (L-energy m1 m2 l1 l2 g) |
228 | | - monitor (energy-monitor energy-fn (first xs)) |
229 | | - xform (angles->rect l1 l2) |
| 234 | + monitor (xc/compile-state-fn |
| 235 | + (energy-monitor energy-fn (first xs)) |
| 236 | + false |
| 237 | + (first xs) |
| 238 | + {:calling-convention :structure}) |
| 239 | + xform (xc/compile-state-fn |
| 240 | + (angles->rect l1 l2) |
| 241 | + false |
| 242 | + (first xs) |
| 243 | + {:calling-convention :structure}) |
230 | 244 | pv (principal-value Math/PI)] |
231 | 245 | (map (fn [[t [theta1 theta2] [thetadot1 thetadot2] :as state]] |
232 | 246 | (let [[x1 y1 x2 y2] (xform state)] |
|
245 | 259 | ;; The following forms transform the raw data for each initial condition and |
246 | 260 | ;; bind the results to `chaotic-data` and `regular-data` for exploration. |
247 | 261 |
|
248 | | -(def chaotic-data |
| 262 | +(defonce chaotic-data |
249 | 263 | (doall |
250 | 264 | (transform-data raw-chaotic-data))) |
251 | 265 |
|
252 | | -(def regular-data |
| 266 | +(defonce regular-data |
253 | 267 | (doall |
254 | 268 | (transform-data raw-regular-data))) |
255 | 269 |
|
|
307 | 321 | ;; a helper function that should be in clojure.core |
308 | 322 | (defn deep-merge [v & vs] |
309 | 323 | (letfn [(rec-merge [v1 v2] |
310 | | - (if (and (map? v1) (map? v2)) |
311 | | - (merge-with deep-merge v1 v2) |
312 | | - v2))] |
| 324 | + (if (and (map? v1) (map? v2)) |
| 325 | + (merge-with deep-merge v1 v2) |
| 326 | + v2))] |
313 | 327 | (when (some identity vs) |
314 | 328 | (reduce #(rec-merge %1 %2) v vs)))) |
315 | 329 |
|
|
439 | 453 | (defn L-double-double-pendulum [m1 m2 l1 l2 g] |
440 | 454 | (fn [[t [thetas1 thetas2] [qdots1 qdots2]]] |
441 | 455 | (let [s1 (up t thetas1 qdots1) |
442 | | - s2 (up t thetas2 qdots2)] |
443 | | - (+ ((L-double-pendulum m1 m2 l1 l2 g) s1) |
444 | | - ((L-double-pendulum m1 m2 l1 l2 g) s2))))) |
| 456 | + s2 (up t thetas2 qdots2)] |
| 457 | + (+ ((L-double-pendulum m1 m2 l1 l2 g) s1) |
| 458 | + ((L-double-pendulum m1 m2 l1 l2 g) s2))))) |
445 | 459 |
|
446 | 460 | (def dd-state-derivative |
447 | 461 | (compose |
|
0 commit comments