|
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