#+begin_src clojure :exports none
(ns fdg.ch1
  (:refer-clojure :exclude [+ - * / = compare zero? ref partial
                            numerator denominator])
  (:require [sicmutils.env :as e :refer :all :exclude [F->C]]))
#+end_src

* Description

This chapter shows examples of the SICMechanics book [1].

A description of how to begin without any knowledge is in [2].

This first page shows an example of calculating cartesian coordinates out of polar coordinates.

The code of all examples can also be viewed, modified and run within a simple html page [3].

More information on this visual programming project is available on github [4].

[1] https://mitp-content-server.mit.edu/books/content/sectbyfn/books_pres_0/9579/sicm_edition_2.zip/chapter001.html

[2] https://kloimhardt.github.io/blog/literatur/2023/03/16/competence-comprehesion-2.html

[3] https://kloimhardt.github.io/blog/html/sicmutils-as-js-book-part1.html

[4] https://github.com/kloimhardt/clj-tiles

 #+begin_src clojure
(->tex-equation
  (up (* 'R (cos 'phi))
      (* 'R (sin 'phi))))
#+end_src

* Description
This page shows an example of calculating cartesian coordinates out of polar coordinates
in three dimensions. Press "Run" to look at some nice rendering of the result.

 $up$ : (x, y, z) $\rightarrow$ vector ; gives a three dimensional vector; the vector is just data. Having now data, we come to functions.

** ---
This text will never appear because it lacks a linebreak. Also the next code is not displayed for some reason, but that is good.

#+begin_src clojure :exports none
  (defn walk [inner outer form]
    (cond
      (list? form) (outer (apply list (map inner form)))
      (seq? form)  (outer (doall (map inner form)))
      (coll? form) (outer (into (empty form) (map inner form)))
      :else        (outer form)))
  (defn postwalk [f form]
    (walk (partial postwalk f) f form))
  (defn postwalk-replace [smap form]
    (postwalk (fn [x] (if (contains? smap x) (smap x) x)) form))
  (defmacro let-scheme [b & e]
    (concat (list 'let (into [] (apply concat b))) e))
  (defmacro define-1 [h & b]
    (let [body (postwalk-replace {'let 'let-scheme} b)]
      (if (coll? h)
        (if (coll? (first h))
          (list 'defn (ffirst h) (into [] (rest (first h)))
                (concat (list 'fn (into [] (rest h))) body))
          (concat (list 'defn (first h) (into [] (rest h)))
                  body))
        (concat (list 'def h) body))))
  (defmacro define [h & b]
    (if (and (coll? h) (= (first h) 'tex-inspect))
      (list 'do
            (concat ['define-1 (second h)] b)
            h)
      (concat ['define-1 h] b)))
  (defmacro lambda [h b]
    (list 'fn (into [] h) b))
  (def show-expression simplify)
  (def velocities velocity)
  (def coordinates coordinate)
  (def vector-length count)
  (defn time [state] (first state))
#+end_src

** Code

#+begin_src clojure
(->tex-equation
  (up (* 'R (sin 'theta) (cos 'phi))
          (* 'R (sin 'theta) (sin 'phi))
          (* 'R (cos 'theta))))
#+end_src

Here we show how to differentiate a simple function.

 $expt$ : (fn, number) $\rightarrow$ fn . So expt returns a function, not a number.

 $D$ :  $(fn) \rightarrow$ $fn$ ; a procedure that takes a function of one number and returns a function which is the derivative.

(( $D$ (* 3 (expt sin 2))) 'x))) : the expression 6 sin(x) cos(x) ; an expression is just data. Note that with D, the derivative is taken from a function and not perhaps from some expression.

#+begin_src clojure
(define t0 0)
(define t1 10)
(definite-integral (expt sin 2) t0 t1)
#+end_src

#+begin_src clojure
(define t 't_i)
(define mass 'm_0)
(->infix
  (simplify
    ((D (* mass (expt sin 2))) t)))
#+end_src

* Description

 $literal-function$ : (symbol) $\rightarrow$ fn ; returns a generic function of one argument

 $x$ : the path function; it is a generic function which here represents a point at position x at time t; can be viewed as $x(t)$, a function of $t$.

 $Gamma$ : (path-fn) $\rightarrow$ fn ; a procedure that takes a path function and returns a somewhat augmentd path-function

 $gamma-of-x$ : a function; $(t) \rightarrow$ local-tuple  ; generated by the Gamma procedure

 $local$ : the local tuple (t, x(t), v(t))

** ---
Scheme replacement: replace () in all let expressions with []
in principle, a :tiles/vert would alaways be in order (only done in a view examples)
(let ((x a)) (f x)) -> (let (:tiles/vert [(:tiles/vert (x a))]) (f x))

** Code

#+begin_src clojure
(define x (literal-function 'x))
(define gamma-of-x (Gamma x))
(define local (gamma-of-x t))
(->tex-equation local)
#+end_src

* 1 Lagrangian Mechanics

** 1.4 Computing Actions

 $L-free-particle$ : $(mass) \rightarrow$ $fn$ ; procedure that takes a mass and returns a function

( $L-free-particle$ 'm) : $(local) \rightarrow$ mv^2/2

#+begin_src clojure
(define ((L-free-particle mass) local)
    (let [(:tiles/vert (v (velocity local)))]
      (* 1/2 mass (dot-product v v))))
#+end_src

#+begin_src clojure
(define q
 (up (literal-function 'x)
 (literal-function 'y)
 (literal-function 'z)))
((Gamma q) 't)
#+end_src

 $compose$ : (fn, fn) $\rightarrow$ fn ; makes a new function out of two functions

#+begin_src clojure
((compose (L-free-particle 'm) (Gamma q)) 't) 
#+end_src

#+begin_src clojure
(define (test-path t)
  (up (+ (* 4 t) 7)
      (+ (* 3 t) 5)
      (+ (* 2 t) 1)))
#+end_src

 $Lagrangian-action$ : (Lagrange-Function, path, t0, t1) $\rightarrow$ number ; a numerical calculation of the action of a given path.

#+begin_src clojure
(define (Lagrangian-action L q t0 t1)
  (definite-integral (compose L (Gamma q)) t0 t1))
(define Lagrangian (L-free-particle 3.0))
(Lagrangian-action Lagrangian test-path 0.0 10.0)
#+end_src

Note that by construction, make-eta is zero if t is either 0 or 10.

#+begin_src clojure
(define nu (up sin cos square))
(define ((make-eta nu t0 t1) t)
(* (- t t0) (- t t1) (nu t)))
#+end_src

#+begin_src clojure
(define ((varied-free-particle-action mass q nu t0 t1) eps)
  (let [(:tiles/vert (eta (make-eta nu t0 t1)))]
    (Lagrangian-action (L-free-particle mass)
                       (+ q (* eps eta))
                       t0
                       t1)))

((varied-free-particle-action 3.0 test-path nu 0.0 10.0) 0.001)
 #+end_src

#+begin_src clojure
((varied-free-particle-action 3.0 test-path
                              (up sin cos square)
                              0.0 10.0)
 0.001) 
#+end_src

#+begin_src clojure
(minimize 
  (varied-free-particle-action 3.0 test-path
   (up sin cos square)
    0.0 10.0)
  -2.0 1.0)
#+end_src

 $make-path$ : (t0, q0, t1, q1, positions) $\rightarrow$ fn(t) ; construct a path by linear inperpolation between the positions. Unlike test-path, the path is not three dimensional but rather one-dimensional.

#+begin_src clojure
(define q0 0)
(define q1 5)
(define qs (up -1 2 -3 4))
((make-path t0 q0 t1 q1 qs) 6.1)
#+end_src

#+begin_src clojure
  (define ((parametric-path-action Lagrangian t0 q0 t1 q1) qs)
    (let (:tiles/vert [(path (make-path t0 q0 t1 q1 qs))])
      (Lagrangian-action Lagrangian path t0 t1))) 
#+end_src

#+begin_src clojure
  (define (find-path Lagrangian t0 q0 t1 q1 n)
    (let [(:tiles/vert (initial-qs (linear-interpolants q0 q1 n)))
          (:tiles/vert (minimizing-qs
                         (multidimensional-minimize
                           (parametric-path-action Lagrangian
                                                   t0 q0 t1 q1)
                           initial-qs)))]
      (make-path t0 q0 t1 q1 minimizing-qs))) 
#+end_src

#+begin_src clojure
  (define ((L-harmonic m k) local)
    (let [(:tiles/vert (q (coordinate local)))
          (:tiles/vert (v (velocity local)))]
      (- (* 1/2 m (square v)) (* 1/2 k (square q))))) 
#+end_src

#+begin_src clojure
(define q-harmonic 
  (find-path (L-harmonic 1.0 1.0) 0.0 1.0 (* 1/2 pi) 0.0 3))
(- (cos 0.8) (q-harmonic 0.8))
#+end_src

* 1.5   The Euler–Lagrange Equations

**        1.5.2 Computing Lagrange's Equations

#+begin_src clojure
(define ((Lagrange-equations Lagrangian) q)
  (- (D (compose ((partial 2) Lagrangian) (Gamma q)))
     (compose ((partial 1) Lagrangian) (Gamma q)))) 
#+end_src

#+begin_src clojure
(define (general-test-path t)
  (up (+ (* 'a t) 'a0)
      (+ (* 'b t) 'b0)
      (+ (* 'c t) 'c0))) 
#+end_src

#+begin_src clojure
(((Lagrange-equations (L-free-particle 'm))
  general-test-path)
 't) 
#+end_src

#+begin_src clojure
(show-expression
  (((Lagrange-equations (L-free-particle 'm))
    (literal-function 'x))
   't)) 
#+end_src

#+begin_src clojure
(define (proposed-solution t)
  (* 'A (cos (+ (* 'omega t) 'phi)))) 
#+end_src

#+begin_src clojure
(show-expression
  (((Lagrange-equations (L-harmonic 'm 'k))
    proposed-solution)
   't)) 
#+end_src

** Exercise 1.11: Kepler's third law

Show that a planet in circular orbit satisfies Kepler's third law $n^2a^3=G(M_1 + m_2)$ , where n is the angular frequency of the orbit and a is the distance between sun and planet. (Hint: use the reduced mass to construct the Lagrangian)

#+begin_src clojure
(define ((L-Kepler-central-polar m V) local)
  (let [(:tiles/vert (q (coordinate local)))
          (:tiles/vert (qdot (velocity local)))]
    (let [(:tiles/vert (r (ref q 0)))
            (:tiles/vert (phi (ref q 1)))
            (:tiles/vert (rdot (ref qdot 0)))
            (:tiles/vert (phidot (ref qdot 1)))]
        (- (* 1/2 m
              (+ (square rdot) (square (* r phidot))) )
           (V r)))))
#+end_src

#+begin_src clojure
(define ((gravitational-energy G m1 m2) r)
  (- (/ (* G m1 m2) r))) 
#+end_src

#+begin_src clojure
(define (circle t)
  (up 'a (* 'n t))) 
#+end_src

#+begin_src clojure
(define lagrangian-reduced
(L-Kepler-central-polar (/ (* 'M_1 'm_2) (+ 'M_1 'm_2))
(gravitational-energy 'G 'M_1 'm_2))) 
#+end_src

#+begin_src clojure
(((Lagrange-equations lagrangian-reduced) circle) 't) 
#+end_src

** 1.6 How to find Lagrangians

#+begin_src clojure
  (define ((L-uniform-acceleration m g) local)
    (let [(:tiles/vert (q (coordinate local)))
          (:tiles/vert (v (velocity local)))]
      (let [(:tiles/vert (y (ref q 1)))]
        (- (* 1/2 m (square v)) (* m g y))))) 
#+end_src

#+begin_src clojure
(show-expression
  (((Lagrange-equations
      (L-uniform-acceleration 'm 'g))
    (up (literal-function 'x)
        (literal-function 'y)))
   't)) 
#+end_src

#+begin_src clojure
  (define ((L-central-rectangular m U) local)
    (let [(:tiles/vert (q (coordinate local)))
          (:tiles/vert (v (velocity local)))]
      (- (* 1/2 m (square v))
         (U (sqrt (square q))))))
#+end_src

#+begin_src clojure
  (((Lagrange-equations
      (L-central-rectangular 'm (literal-function 'U)))
    (up (literal-function 'x)
        (literal-function 'y)))
   't) 
#+end_src

#+begin_src clojure
(show-expression
  (((Lagrange-equations
      (L-Kepler-central-polar 'm (literal-function 'U)))
    (up (literal-function 'r)
        (literal-function 'phi)))
   't)) 
#+end_src

** 1.6.1 Coordinate Transformations

#+begin_src clojure
(define ((F->C F) local)
  (up (time local)
      (F local)
      (+ (((partial 0) F) local)
         (* (((partial 1) F) local)
            (velocity local))))) 
#+end_src

#+begin_src clojure
  (define (p->r local)
    (let [(:tiles/vert (polar-tuple (coordinate local)))]
      (let [(:tiles/vert (r (ref polar-tuple 0)))
            (:tiles/vert (phi (ref polar-tuple 1)))]
        (let [(:tiles/vert (x (* r (cos phi))))
              (:tiles/vert (y (* r (sin phi))))]
          (up x y))))) 
#+end_src

#+begin_src clojure
(show-expression
  (velocity
    ((F->C p->r)
     (up 't (up 'r 'phi) (up 'rdot 'phidot))))) 
#+end_src

#+begin_src clojure
(define (L-central-polar m U)
  (compose (L-central-rectangular m U) (F->C p->r))) 
#+end_src

#+begin_src clojure
(show-expression
  ((L-central-polar 'm (literal-function 'U))
   (up 't (up 'r 'phi) (up 'rdot 'phidot)))) 
#+end_src

Coriolis and centrifugal forces

#+begin_src clojure
  (define ((L-free-rectangular m) local)
    (let [(:tiles/vert (vx (ref (velocities local) 0)))
          (:tiles/vert (vy (ref (velocities local) 1)))]
      (* 1/2 m (+ (square vx) (square vy))))) 
#+end_src

#+begin_src clojure
(define (L-free-polar m)
  (compose (L-free-rectangular m) (F->C p->r))) 
#+end_src

#+begin_src clojure
  (define ((F Omega) local)
    (let [(:tiles/vert (t (time local)))
          (:tiles/vert (r (ref (coordinates local) 0)))
          (:tiles/vert (theta (ref (coordinates local) 1)))]
      (up r (+ theta (* Omega t))))) 
#+end_src

#+begin_src clojure
(define (L-rotating-polar m Omega)
  (compose (L-free-polar m) (F->C (F Omega)))) 
#+end_src

#+begin_src clojure
(define (L-rotating-rectangular m Omega)
  (compose (L-rotating-polar m Omega) (F->C r->p))) 
#+end_src

    <p><code>r->p</code> added</p>

#+begin_src clojure
  (define (r->p local)
    (let [(rect-tuple (coordinate local))]
      (let [(x (ref rect-tuple 0))
            (y (ref rect-tuple 1))]
        (let [(r (sqrt (square rect-tuple)))
              (phi (atan (/ y x)))]
          (up r phi))))) 
#+end_src

#+begin_src clojure
((L-rotating-rectangular 'm 'Omega)
(up 't (up 'x_r 'y_r) (up 'xdot_r 'ydot_r))) 
#+end_src

#+begin_src clojure
(+ (* 1/2 (expt 'Omega 2) 'm (expt 'x_r 2))
(* 1/2 (expt 'Omega 2) 'm (expt 'y_r 2))
(* -1 'Omega 'm 'xdot_r 'y_r)
(* 'Omega 'm 'ydot_r 'x_r)
(* 1/2 'm (expt 'xdot_r 2))
(* 1/2 'm (expt 'ydot_r 2))) 
#+end_src

    <p><code>x_r, y_r</code>: underscore added. Calculation takes a few seconds,
    add a blank at the and to start</p>

#+begin_src clojure
(((Lagrange-equations (L-rotating-rectangular 'm 'Omega))
  (up (literal-function 'x_r) (literal-function 'y_r)))
 't)
#+end_src

    <p>definitions x_r y_r added</p>

#+begin_src clojure
(define x_r (literal-function 'x_r)) 
#+end_src

#+begin_src clojure
(define y_r (literal-function 'y_r)) 
#+end_src

#+begin_src clojure
(down
(+ (* -1 (expt 'Omega 2) 'm (x_r 't))
(* -2 'Omega 'm ((D y_r) 't))
(* 'm (((expt D 2) x_r) 't)))
(+ (* -1 (expt 'Omega 2) 'm (y_r 't))
(* 2 'Omega 'm ((D x_r) 't))
(* 'm (((expt D 2) y_r) 't)))) 
#+end_src

    <h3>1.6.2 Systems with Rigid Constraints</h3>
    <h4>A pendulum driven at the pivot</h4>

    <p>See <a href="https://kloimhardt.github.io/cljtiles.html?page=116">here</a> for a presentation of the Driven Pendulum using visual programming</p>

#+begin_src clojure
  (define ((T-pend m l g ys) local)
    (let [(t (time local))
          (theta (coordinate local))
          (thetadot (velocity local))]
      (let [(vys (D ys))]
        (* 1/2 m
           (+ (square (* l thetadot))
              (square (vys t))
              (* 2 l (vys t) thetadot (sin theta))))))) 
#+end_src

#+begin_src clojure
  (define ((V-pend m l g ys) local)
    (let [(t (time local))
          (theta (coordinate local))]
      (* m g (- (ys t) (* l (cos theta)))))) 
#+end_src

    <p> Because used later, rename <code>L-pend</code> to <code>L-pendulum</code>
#+begin_src clojure
(define L-pendulum (- T-pend V-pend)) 
#+end_src

#+begin_src clojure
(show-expression
(((Lagrange-equations
(L-pendulum 'm 'l 'g (literal-function 'y_s)))
(literal-function 'theta))
't)) 
#+end_src

    <h3>
        1.6.3 Constraints as Coordinate Transformations
    </h3>

#+begin_src clojure
  (define ((dp-coordinates l y_s) local)
    (let [(t (time local))
          (theta (coordinate local))]
      (let [(x (* l (sin theta)))
            (y (- (y_s t) (* l (cos theta))))]
        (up x y)))) 
#+end_src

#+begin_src clojure
(define (L-pend m l g y_s)
(compose (L-uniform-acceleration m g)
(F->C (dp-coordinates l y_s)))) 
#+end_src

#+begin_src clojure
(show-expression
((L-pend 'm 'l 'g (literal-function 'y_s))
(up 't 'theta 'thetadot))) 
#+end_src

    <h3>1.7   Evolution of Dynamical State</h3>

#+begin_src clojure
  (define (Lagrangian->acceleration L)
    (let [(P ((partial 2) L)) (F ((partial 1) L))]
      (solve-linear-left
        ((partial 2) P)
        (- F
           (+ ((partial 0) P)
              (* ((partial 1) P) velocity)))))) 
#+end_src


Scheme replacement: replace () in all lambda expressions with []

#+begin_src clojure
  (define (Lagrangian->state-derivative L)
    (let [(acceleration (Lagrangian->acceleration L))]
      (lambda [state]
              (up 1
                  (velocity state)
                  (acceleration state))))) 
#+end_src

#+begin_src clojure
(define (harmonic-state-derivative m k)
(Lagrangian->state-derivative (L-harmonic m k))) 
#+end_src

#+begin_src clojure
((harmonic-state-derivative 'm 'k)
(up 't (up 'x 'y) (up 'v_x 'v_y))) 
#+end_src

#+begin_src clojure
(up 1 (up 'v_x 'v_y) (up (/ (* -1 'k 'x) 'm) (/ (* -1 'k 'y) 'm))) 
#+end_src

#+begin_src clojure
  (define ((Lagrange-equations-first-order L) q v)
    (let [(state-path (qv->state-path q v))]
      (- (D state-path)
         (compose (Lagrangian->state-derivative L)
                  state-path)))) 
#+end_src

#+begin_src clojure
(define ((qv->state-path q v) t)
  (up t (q t) (v t))) 
#+end_src

#+begin_src clojure
(show-expression
 (((Lagrange-equations-first-order (L-harmonic 'm 'k))
   (up (literal-function 'x)
       (literal-function 'y))
   (up (literal-function 'v_x)
       (literal-function 'v_y)))
  't)) 
#+end_src

    <h4>Numerical integration</h4>

Scheme replacement: replace (state-advancer ...) with state-advancer-fn

#+begin_src clojure
(define state-advancer-fn (state-advancer harmonic-state-derivative 2.0 1.0))
#+end_src


#+begin_src clojure
(state-advancer-fn (up 1.0 (up 1.0 2.0) (up 3.0 4.0))
10.0
1.0e-12)
#+end_src

#+begin_src clojure
(up 11.0
    (up 3.7127916645844437 5.420620823651583)
    (up 1.6148030925459782 1.8189103724750855)) 
#+end_src

#+begin_src clojure
(define ((periodic-drive amplitude frequency phase) t)
(* amplitude (cos (+ (* frequency t) phase)))) 
#+end_src

#+begin_src clojure
  (define (L-periodically-driven-pendulum m l g A omega)
    (let [(ys (periodic-drive A omega 0))]
      (L-pend m l g ys))) 
#+end_src

#+begin_src clojure
(show-expression
(((Lagrange-equations
(L-periodically-driven-pendulum 'm 'l 'g 'A 'omega))
(literal-function 'theta))
't)) 
#+end_src

#+begin_src clojure
(define (pend-state-derivative m l g A omega)
(Lagrangian->state-derivative
(L-periodically-driven-pendulum m l g A omega))) 
#+end_src

#+begin_src clojure
(show-expression
((pend-state-derivative 'm 'l 'g 'A 'omega)
(up 't 'theta 'thetadot))) 
#+end_src

    <h2>1.8 Conserved Quantities</h2>
    <h3>1.8.2 Energy Conservation</h3>

#+begin_src clojure
  (define (Lagrangian->energy L)
    (let [(P ((partial 2) L))]
      (- (* P velocity) L))) 
#+end_src

    <h3>1.8.3 Central Forces in Three Dimensions</h3>

#+begin_src clojure
  (define ((T3-spherical m) state)
    (let [(q (coordinate state))
          (qdot (velocity state))]
      (let [(r (ref q 0))
            (theta (ref q 1))
            (rdot (ref qdot 0))
            (thetadot (ref qdot 1))
            (phidot (ref qdot 2))]
        (* 1/2 m
           (+ (square rdot)
              (square (* r thetadot))
              (square (* r (sin theta) phidot))))))) 
#+end_src

    <p>Change the second define into a let</p>

#+begin_src clojure
  (define (L3-central m Vr)
    (let (:tiles/vert [(:tiles/vert (Vs (lambda [state]
                                                (let (:tiles/vert [(:tiles/vert (r (ref (coordinate state) 0)))])
                                                  (Vr r)))))])
      (- (T3-spherical m) Vs))) 
#+end_src

#+begin_src clojure
(show-expression
(((partial 1) (L3-central 'm (literal-function 'V)))
(up 't
(up 'r 'theta 'phi)
(up 'rdot 'thetadot 'phidot)))) 
#+end_src

#+begin_src clojure
(show-expression
(((partial 2) (L3-central 'm (literal-function 'V)))
(up 't
(up 'r 'theta 'phi)
(up 'rdot 'thetadot 'phidot)))) 
#+end_src

#+begin_src clojure
  (define ((ang-mom-z m) rectangular-state)
    (let [(xyz (coordinate rectangular-state))
          (v (velocity rectangular-state))]
      (ref (cross-product xyz (* m v)) 2))) 
#+end_src

#+begin_src clojure
  (define (s->r spherical-state)
    (let [(q (coordinate spherical-state))]
      (let [(r (ref q 0))
            (theta (ref q 1))
            (phi (ref q 2))]
        (let [(x (* r (sin theta) (cos phi)))
              (y (* r (sin theta) (sin phi)))
              (z (* r (cos theta)))]
          (up x y z))))) 
#+end_src

#+begin_src clojure
(show-expression
((compose (ang-mom-z 'm) (F->C s->r))
(up 't
(up 'r 'theta 'phi)
(up 'rdot 'thetadot 'phidot)))) 
#+end_src

#+begin_src clojure
(show-expression
((Lagrangian->energy (L3-central 'm (literal-function 'V)))
(up 't
(up 'r 'theta 'phi)
(up 'rdot 'thetadot 'phidot)))) 
#+end_src

    <h3>1.8.4 The Restricted Three-Body Problem</h3>

#+begin_src clojure
  (define ((L0 m V) local)
    (let [(t (time local))
          (q (coordinates local))
          (v (velocities local))]
      (- (* 1/2 m (square v)) (V t q)))) 
#+end_src

#+begin_src clojure
  (define ((V a GM0 GM1 m) t xy)
    (let [(Omega (sqrt (/ (+ GM0 GM1) (expt a 3))))
          (a0 (* (/ GM1 (+ GM0 GM1)) a))
          (a1 (* (/ GM0 (+ GM0 GM1)) a))]
      (let [(x (ref xy 0))
            (y (ref xy 1))
            (x0 (* -1 a0 (cos (* Omega t))))
            (y0 (* -1 a0 (sin (* Omega t))))
            (x1 (* +1 a1 (cos (* Omega t))))
            (y1 (* +1 a1 (sin (* Omega t))))]
        (let [(r0
                (sqrt (+ (square (- x x0)) (square (- y y0)))))
              (r1
                (sqrt (+ (square (- x x1)) (square (- y y1)))))]
          (- (+ (/ (* GM0 m) r0) (/ (* GM1 m) r1))))))) 
#+end_src

#+begin_src clojure
  (define ((LR3B m a GM0 GM1) local)
    (let [(q (coordinates local))
          (qdot (velocities local))
          (Omega (sqrt (/ (+ GM0 GM1) (expt a 3))))
          (a0 (* (/ GM1 (+ GM0 GM1)) a))
          (a1 (* (/ GM0 (+ GM0 GM1)) a))]
      (let [(x (ref q 0))     (y (ref q 1))
            (xdot (ref qdot 0)) (ydot (ref qdot 1))]
        (let [(r0 (sqrt (+ (square (+ x a0)) (square y))))
              (r1 (sqrt (+ (square (- x a1)) (square y))))]
          (+ (* 1/2 m (square qdot))
             (* 1/2 m (square Omega) (square q))
             (* m Omega (- (* x ydot) (* xdot y)))
             (/ (* GM0 m) r0) (/ (* GM1 m) r1)))))) 
#+end_src

#+begin_src clojure
  (define ((LR3B1 m a0 a1 Omega GM0 GM1) local)
    (let [(q (coordinates local))
          (qdot (velocities local))]
      (let [(x (ref q 0))     (y (ref q 1))
            (xdot (ref qdot 0)) (ydot (ref qdot 1))]
        (let [(r0 (sqrt (+ (square (+ x a0)) (square y))))
              (r1 (sqrt (+ (square (- x a1)) (square y))))]
          (+ (* 1/2 m (square qdot))
             (* 1/2 m (square Omega) (square q))
             (* m Omega (- (* x ydot) (* xdot y)))
             (/ (* GM0 m) r0) (/ (* GM1 m) r1)))))) 
#+end_src

Scheme replacement: replace ^ with _ in next two

#+begin_src clojure
((Lagrangian->energy (LR3B1 'm 'a_0 'a_1 'Omega 'GM_0 'GM_1))
(up 't (up 'x_r 'y_r) (up 'v_r_x 'v_r_y)))
#+end_src

#+begin_src clojure
(+ (* 1/2 'm (expt 'v_r_x 2))
(* 1/2 'm (expt 'v_r_y 2))
(/ (* -1 'GM_0 'm)
(sqrt (+ (expt (+ 'x_r 'a_0) 2) (expt 'y_r 2))))
(/ (* -1 'GM_1 'm)
(sqrt (+ (expt (- 'x_r 'a_1) 2) (expt 'y_r 2))))
(* -1/2 'm (expt 'Omega 2) (expt 'x_r 2))
(* -1/2 'm (expt 'Omega 2) (expt 'y_r 2)))
#+end_src

    <h3>1.8.5 Noether’s Theorem</h3>

#+begin_src clojure
(define (F-tilde angle-x angle-y angle-z)
(compose (Rx angle-x) (Ry angle-y) (Rz angle-z) coordinate)) 
#+end_src

    <p>
        A <code>let</code> within a variable definition is not allowed
        in our little Scheme compiler,
        ... so we split in two expressions.
        Also we define D-F-tilde as (D F-tilde)
    </p>


#+begin_src clojure
(define let-L (L-central-rectangular 'm (literal-function 'U))) 
#+end_src

#+begin_src clojure
(define D-F-tilde (D F-tilde)) 
#+end_src

#+begin_src clojure
(define the-Noether-integral
  (* ((partial 2) let-L) (D-F-tilde 0 0 0))) 
#+end_src

#+begin_src clojure
(the-Noether-integral
(up 't
(up 'x 'y 'z)
(up 'vx 'vy 'vz))) 
#+end_src

#+begin_src clojure
(down (+ (* 'm 'vy 'z) (* -1 'm 'vz 'y))
(+ (* 'm 'vz 'x) (* -1 'm 'vx 'z))
(+ (* 'm 'vx 'y) (* -1 'm 'vy 'x))) 
#+end_src

    <h2>1.9   Abstraction of Path Functions</h2>

#+begin_src clojure
(define ((Gamma-bar f-bar) local)
((f-bar (osculating-path local)) (time local))) 
#+end_src

#+begin_src clojure
  (define (F->C1 F)
    (let (:tiles/vert [(:tiles/vert (C (lambda [local]
                                               (let (:tiles/vert [(:tiles/vert (n (vector-length local)))
                                                                  (:tiles/vert (f-bar (lambda [q-prime]
                                                                                              (let [(q (compose F (Gamma q-prime)))]
                                                                                                (Gamma q n)))))])
                                                 ((Gamma-bar f-bar) local)))))])
      C)) 
#+end_src

#+begin_src clojure
(show-expression
((F->C1 p->r)
(up 't (up 'r 'theta) (up 'rdot 'thetadot)))) 
#+end_src

#+begin_src clojure
  (define (Dt F)
    (let (:tiles/vert [(:tiles/vert (DtF (lambda [state]
                                                 (let (:tiles/vert [(:tiles/vert (n (vector-length state)))
                                                                    (:tiles/vert (DF-on-path (lambda [q]
                                                                                                     (D (compose F (Gamma q (- n 1)))))))])
                                                   ((Gamma-bar DF-on-path) state)))))])
      DtF)) 
#+end_src

#+begin_src clojure
(define (Euler-Lagrange-operator L)
(- (Dt ((partial 2) L)) ((partial 1) L))) 
#+end_src

#+begin_src clojure
((Euler-Lagrange-operator
   (L-harmonic 'm 'k))
     (up 't 'x 'v 'a)) 
#+end_src

#+begin_src clojure
(+ (* 'a 'm) (* 'k 'x)) 
#+end_src

#+begin_src clojure
((compose
(Euler-Lagrange-operator (L-harmonic 'm 'k))
(Gamma (literal-function 'x) 4))
't) 
#+end_src

#+begin_src clojure
(+ (* 'k ((literal-function 'x) 't))
   (* 'm (((expt D 2) (literal-function 'x)) 't))) 
#+end_src