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

* Tutorial Page 1/2

(0) https://kloimhardt.github.io/markus.html#a for general information

(1) The most important thing is the left arrow "<" button. It brings you back to this tutorial.

(2) Go to the next page with ">". (back with "<")

(3) Scroll down. Do not miss some tutorial step at the bottom left or top right!

(4) Execute this workspace with "Run". (back with "<")

(5) You just saw some formula for polar coordinates. Have you memorized it? Let's find out!

(6) Press "Get the Puzzle". (back with "<")

(7) "Get the Puzzle" but come back via "Run" + "Clear output".

(8) In the workspace above, you should see several blocks containing white slots.

(9) Press "Run" and hold the "Color" button. (back via "Clear output")

(10) On the top of the workspace, put "phi" into the slot of "sin".

(11) Repeat step (9), the "(sin 'phi)" line should turn green.

(12) Make the lines more and more green by solving the workspace puzzle (keep pressing "Color"!). The code below might help.  When upon completion the ">" button turns green, press it immediately.

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

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

* Tutorial Page 2/2

(1) Notice that the drop down list above shows a second chapter named "Lyrics".

(2) Press ">" a few times and note the generic text. Read it. (back to this page with "<")

(3) From this page, after having pressed "Get the Puzzle" + "Color", again press ">".

(4) Via the drop down, go to the chaper "Lyrics", press "<"+ "Color" + ">".

#+begin_src clojure
"Tutorial Page 2/2"
#+end_src

* 1 Lagrangian Mechanics

** 1.4 Computing Actions

#+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 (test-path t)
  (up (+ (* 4 t) 7)
      (+ (* 3 t) 5)
      (+ (* 2 t) 1)))
#+end_src

#+begin_src clojure
(define (Lagrangian-action L q t0 t1)
  (definite-integral (compose L (Gamma q)) t0 t1))
#+end_src

#+begin_src clojure
(Lagrangian-action (L-free-particle 3.0) test-path 0.0 10.0)
#+end_src

#+begin_src clojure
(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)))
 #+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

#+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 harmonic-path
  (find-path (L-harmonic 1.0 1.0) 0.0 1.0 (* 1/2 pi) 0.0 3))
(:tiles/keep (- (cos 0.8) (harmonic-path 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