|  | 
| 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