Emmy, the Algebra System: Differential Geometry Chapter Seven

Functional Differential Geometry: Chapter 7
Author
Affiliation

Markus Agwin Kloimwieder

Scicloj

Published

February 20, 2026

7 Directional Derivatives

The vector field was a generalization of the directional derivative to functions on a manifold.

(define ((F->directional-derivative F) v)
  (lambda (u)
          (lambda (f)
                  (lambda (m)
                          (define (g delta)
                            (- ((u f) m) (((((F v) delta) u) f) m)))
                          ((D g) 0)))))

7.1 Lie Derivative

Vector Fields

the implementation of scheme/define does not support (((define x) y) z)

(define ((F-Lie phi) v)
  (lambda (delta)
          (pushforward-vector ((phi v) delta) ((phi v) (- delta)))))
(define ((phi coordsys order) v)
  (lambda (delta)
          (lambda (m)
                  ((point coordsys)
                   (series:sum (((exp (* delta v)) (chart coordsys)) m) order)))))
(define (Lie-directional coordsys order)
  (let ((Phi (phi coordsys order)))
    (F->directional-derivative (F-Lie Phi))))
(print-expression
  (let-scheme ((v (literal-vector-field 'v-rect R3-rect))
               (w (literal-vector-field 'w-rect R3-rect))
               (f (literal-manifold-function 'f-rect R3-rect)))
    ((- ((((Lie-directional R3-rect 2) v) w) f)
        ((commutator v w) f))
     ((point R3-rect) (up 'x0 'y0 'z0)))))
0
(define ((Lie-derivative-vector V) Y) (commutator V Y))

Properties of the Lie Derivative

(define a (literal-manifold-function 'alpha R3-rect))
(define b (literal-manifold-function 'beta R3-rect))
(define c (literal-manifold-function 'gamma R3-rect))
(define-coordinates (up x y z) R3-rect)
NoteERR 
WARNING: R3-rect already refers to: #'emmy.env/R3-rect in namespace: mentat-collective.emmy.fdg-ch07, being replaced by: #'mentat-collective.emmy.fdg-ch07/R3-rect

(define theta (+ (* a dx) (* b dy) (* c dz)))
(define omega
  (+ (* a (wedge dy dz))
     (* b (wedge dz dx))
     (* c (wedge dx dy))))
(define X (literal-vector-field 'X-rect R3-rect))
(define Y (literal-vector-field 'Y-rect R3-rect))
(define Z (literal-vector-field 'Z-rect R3-rect))
(define V (literal-vector-field 'V-rect R3-rect))
(define R3-rect-point
  ((point R3-rect) (up 'x0 'y0 'z0)))
(print-expression
  (((- ((Lie-derivative V) (d theta)) (d ((Lie-derivative V) theta)))
    X Y)
   R3-rect-point))
0
(print-expression
  (((- ((Lie-derivative V) (d omega)) (d ((Lie-derivative V) omega)))
    X Y Z)
   R3-rect-point))
0
(print-expression
  ((((- (commutator (Lie-derivative X) (Lie-derivative Y)) (Lie-derivative (commutator X Y)))
     theta) Z)
   R3-rect-point))
0
(print-expression
  ((((- (commutator (Lie-derivative X) (Lie-derivative Y)) (Lie-derivative (commutator X Y)))
     omega) Z V)
   R3-rect-point))
0
(define Jz (- (* x d:dy) (* y d:dx)))
(print-expression
  (vec (take 5
             ((((exp (* 'a (Lie-derivative Jz))) d:dy)
               (literal-manifold-function 'f-rect R3-rect))
              ((point R3-rect) (up 1 0 0))))))
[(((partial 1) f-rect) (up 1 0 0))
 (* a (((partial 0) f-rect) (up 1 0 0)))
 (* -1/2 (expt a 2) (((partial 1) f-rect) (up 1 0 0)))
 (* -1/6 (expt a 3) (((partial 0) f-rect) (up 1 0 0)))
 (* 1/24 (expt a 4) (((partial 1) f-rect) (up 1 0 0)))]
(define ((L1 X) omega)
  (+ ((interior-product X) (d omega))
     (d ((interior-product X) omega))))
(print-expression
  ((- (((Lie-derivative X) omega) Y Z) (((L1 X) omega) Y Z))
   ((point R3-rect) (up 'x0 'y0 'z0))))
0
(define ((F-parallel omega phi coordsys) v)
  (lambda (delta)
          (lambda (u)
                  (lambda ( f)
                          (lambda (m)
                                  (let ((basis (coordinate-system->basis coordsys)))
                                    (let ((etilde (basis->oneform-basis basis))
                                          (e (basis->vector-basis basis)))
                                      (let ((m0 (((phi v) (- delta)) m)))
                                        (let ((Aij (+ (identity-like ((omega v) m0))
                                                      (* delta (- ((omega v) m0)))))
                                              (ui ((etilde u) m0)))
                                          (* ((e f) m) (* Aij ui)))))))))))
(define (covariant-derivative-vector omega coordsys order)
  (let ((Phi (phi coordsys order)))
    (F->directional-derivative
      (F-parallel omega Phi coordsys))))
(define ((covariant-derivative-vector Cartan) V)
  (lambda (U)
          (lambda (f)
                  (let ((basis (Cartan->basis Cartan))
                        (Cartan-forms (Cartan->forms Cartan)))
                    (let ((vector-basis (basis->vector-basis basis))
                          (oneform-basis (basis->oneform-basis basis)))
                      (let ((u-components (oneform-basis U)))
                        (* (vector-basis f)
                           (+ (V u-components)
                              (* (Cartan-forms V) u-components)))))))))
(define ((covariant-derivative-oneform Cartan) V)
  (lambda (tau)
          (lambda (U)
                  (let ((nabla-V ((covariant-derivative-vector Cartan) V)))
                    (- (V (tau U)) (tau (nabla-V U)))))))

the definition of get-rank, sigma and list-with-substituted-coord does work differtly in clj

(comment
  (define ((((covariant-derivative-form Cartan) V) tau) vs)
    (let ((k (get-rank tau))
          (nabla V ((covariant-derivative-vector Cartan) V)))
      (- (V (apply tau vs))
         (sigma (lambda (i) (apply tau
                                   (list-with-substituted-coord vs i (nabla V (list-ref vs i)))))
                0 (- k 1)))))
  :end-comment)

doesn not work in cljs ff/procedure->oneform-field

(comment
  (define (Cartan-transform Cartan basis-prime)
    (let ((basis (Cartan->basis Cartan))
          (forms (Cartan->forms Cartan))
          (prime-dual-basis (basis->oneform-basis basis-prime))
          (prime-vector-basis (basis->vector-basis basis-prime)))
      (let ((vector-basis (basis->vector-basis basis))
            (oneform-basis (basis->oneform-basis basis)))
        (let ((J-inv (s/mapr oneform-basis prime-vector-basis))
              (J (s/mapr prime-dual-basis vector-basis)))
          (let ((omega-prime-forms
                  (ff/procedure->oneform-field
                    (lambda (v)
                            (+ (* J (v J-inv))
                               (* J (* (forms v) J-inv))))
                    'omega-prime-forms)))
            (make-Cartan omega-prime-forms basis-prime))))))

  :end-comment)
(define R2-rect-basis (coordinate-system->basis R2-rect))
(define R2-polar-basis (coordinate-system->basis R2-polar))
(define-coordinates (up x y) R2-rect)
NoteERR 
WARNING: R2-rect already refers to: #'emmy.env/R2-rect in namespace: mentat-collective.emmy.fdg-ch07, being replaced by: #'mentat-collective.emmy.fdg-ch07/R2-rect

(define-coordinates (up r theta) R2-polar)
NoteERR 
WARNING: R2-polar already refers to: #'emmy.env/R2-polar in namespace: mentat-collective.emmy.fdg-ch07, being replaced by: #'mentat-collective.emmy.fdg-ch07/R2-polar

(define R2-rect-Christoffel
  (make-Christoffel
    (let ((zero (lambda (m) 0)))
      (down (down (up zero zero)
                  (up zero zero))
            (down (up zero zero)
                  (up zero zero))))
    R2-rect-basis))
(define R2-rect-Cartan
  (Christoffel->Cartan R2-rect-Christoffel))
(define R2-polar-Cartan
  (Cartan-transform R2-rect-Cartan R2-polar-basis))
(define circular (- (* x d:dy) (* y d:dx)))
(define f (literal-manifold-function 'f-rect R2-rect))
(define R2-rect-point ((point R2-rect) (up 'x0 'y0)))
(print-expression
  (((((covariant-derivative R2-rect-Cartan) d:dx)
     circular)
    f)
   R2-rect-point))
(((partial 1) f-rect) (up x0 y0))
(print-expression
  ((d:dy f) R2-rect-point))
(((partial 1) f-rect) (up x0 y0))
(print-expression
  (((((covariant-derivative R2-polar-Cartan) d:dx) circular) f)
   R2-rect-point))
(((partial 1) f-rect) (up x0 y0))
(define V (literal-vector-field 'V-rect R2-rect))
(define W (literal-vector-field 'W-rect R2-rect))
(print-expression
  (((((- (covariant-derivative R2-rect-Cartan)
         (covariant-derivative R2-polar-Cartan))
      V)
     W)
    f)
   R2-rect-point))
0

7.3 Parallel Transport

S2-spherical is in the environment

(comment
  (define sphere (make-manifold S2-type 2 3))

  (define S2-spherical
    (coordinate-system-at sphere :spherical :north-pole))

  :end-comment)
(define-coordinates t R1-rect)
NoteERR 
WARNING: R1-rect already refers to: #'emmy.env/R1-rect in namespace: mentat-collective.emmy.fdg-ch07, being replaced by: #'mentat-collective.emmy.fdg-ch07/R1-rect

(define-coordinates (up theta phi) S2-spherical)
NoteERR 
WARNING: S2-spherical already refers to: #'emmy.env/S2-spherical in namespace: mentat-collective.emmy.fdg-ch07, being replaced by: #'mentat-collective.emmy.fdg-ch07/S2-spherical

(define S2-basis
  (coordinate-system->basis S2-spherical))
(define gamma
  (compose (point S2-spherical)
           (up (literal-function 'alpha)
               (literal-function 'beta))
           (chart R1-rect)))
(define basis-over-gamma
  (basis->basis-over-map gamma S2-basis))
(define u_gamma
  (* (up (compose (literal-function 'u↑0)
                  (chart R1-rect))
         (compose (literal-function 'u↑1 )
                  (chart R1-rect)))
     (basis->vector-basis basis-over-gamma)))
(define (S2-Christoffel basis theta)
  (let ((zero zero-manifold-function))
    (make-Christoffel
      (down (down
              (up zero zero)
              (up zero (/ 1 (tan theta))))
            (down
              (up zero (/ 1 (tan theta)))
              (up (- (* (sin theta)
                        (cos theta)))
                  zero)))
      basis)))
(define sphere-Cartan (Christoffel->Cartan (S2-Christoffel S2-basis theta)))
(print-expression
  (mapr
    (lambda (omega)
            ((omega
               (((covariant-derivative sphere-Cartan gamma)
                 d:dt)
                u_gamma))
             ((point R1-rect) 'tau)))
    (basis->oneform-basis basis-over-gamma)))
(up (+ (* -1 (sin (alpha tau)) (cos (alpha tau)) ((D beta) tau) (u↑1 tau)) ((D u↑0) tau)) (/ (+ (* (cos (alpha tau)) ((D beta) tau) (u↑0 tau)) (* (cos (alpha tau)) (u↑1 tau) ((D alpha) tau)) (* (sin (alpha tau)) ((D u↑1) tau))) (sin (alpha tau))))

On a great circle

(define (g gamma Cartan)
  (let ((omega
          ((Cartan->forms
             (Cartan->Cartan-over-map Cartan gamma))
           ((differential gamma) d:dt))))
    (define (the-state-derivative)
      (lambda (state)
              (let ((t ((point R1-rect) (ref state 0)))
                    (u (ref state 1)))
                (up 1 (* -1 (omega t) u)))))
    the-state-derivative))

the implementation of scheme/define does not support ((define x) y) within let

(define ((transform tilt) coords)
  (let ((colat (ref coords 0))
        (long (ref coords 1)))
    (let ((x (* (sin colat) (cos long)))
          (y (* (sin colat) (sin long)))
          (z (cos colat)))
      (let ((vp ((rotate-x tilt) (up x y z))))
        (let ((colatp (acos (ref vp 2)))
              (longp (atan (ref vp 1) (ref vp 0))))
          (up colatp longp))))))
(define (tilted-path tilt)
  (define (coords t)
    ((transform tilt) (up (/ pi 2) t)))
  (compose (point S2-spherical)
           coords
           (chart R1-rect)))
(define pi-half (/ pi 2))
(print-expression
  ((state-advancer (g (tilted-path 1) sphere-Cartan))
   (up 0 (* ((D (transform 1)) (up pi-half 0)) (up 1 0)))
   pi-half))
NoteOUT 
2026-03-04T00:27:43.159Z runnervmnay03 INFO [emmy.expression.compile:661] - compiled function in 104.256125 ms

(up 1.5707963267948972 (up 1.000000002621498 -5.095750372011154E-8))
(print-expression
  ((state-advancer (g (tilted-path 1) sphere-Cartan))
   (up 0 (* ((D (transform 1)) (up pi-half 0)) (up 1 0)))
   1))
NoteOUT 
2026-03-04T00:27:43.195Z runnervmnay03 INFO [emmy.expression.compile:661] - compiled function in 13.00629 ms

(up 1.0000000000000002 (up 0.7651502645088568 0.9117920271835236))
(print-expression
  (* ((D (transform 1)) (up pi-half 1)) (up 1 0)))
(up 0.7651502649370375 0.9117920272004736)

7.4 Geodesic Motion

(show-expression
  (simplify
    (((((covariant-derivative sphere-Cartan gamma)
        d:dt)
       ((differential gamma) d:dt))
      (chart S2-spherical)) ((point R1-rect) 't0))))

\[\boxed{\begin{pmatrix}\displaystyle{- \sin\left(\alpha\left(\mathsf{t0}\right)\right)\,\cos\left(\alpha\left(\mathsf{t0}\right)\right)\,{\left(D\beta\left(\mathsf{t0}\right)\right)}^{2} + {D}^{2}\alpha\left(\mathsf{t0}\right)} \cr \cr \displaystyle{\frac{2\,\cos\left(\alpha\left(\mathsf{t0}\right)\right)\,D\beta\left(\mathsf{t0}\right)\,D\alpha\left(\mathsf{t0}\right) + \sin\left(\alpha\left(\mathsf{t0}\right)\right)\,{D}^{2}\beta\left(\mathsf{t0}\right)}{\sin\left(\alpha\left(\mathsf{t0}\right)\right)}}\end{pmatrix}}\]

(define (Lfree s)
  (* 1/2 (square (velocity s))))
(define (sphere->R3 s)
  (let ((q (coordinate s)))
    (let ((theta (ref q 0))
          (phi (ref q 1)))
      (up (* (sin theta) (cos phi))
          (* (sin theta) (sin phi))
          (cos theta)))))
(define Lsphere
  (compose Lfree (F->C sphere->R3)))
(show-expression
  (simplify
    (((Lagrange-equations Lsphere)
      (up (literal-function 'alpha)
          (literal-function 'beta)))
     't)))

\[\boxed{\begin{bmatrix}\displaystyle{- \cos\left(\alpha\left(t\right)\right)\,\sin\left(\alpha\left(t\right)\right)\,{\left(D\beta\left(t\right)\right)}^{2} + {D}^{2}\alpha\left(t\right)}&\displaystyle{2\,\cos\left(\alpha\left(t\right)\right)\,D\alpha\left(t\right)\,\sin\left(\alpha\left(t\right)\right)\,D\beta\left(t\right) + {\sin}^{2}\left(\alpha\left(t\right)\right)\,{D}^{2}\beta\left(t\right)}\end{bmatrix}}\]

Exercise 7.1: Hamiltonian Evolution

(define Hsphere (Lagrangian->Hamiltonian Lsphere))
(print-expression
  ((phase-space-derivative Hsphere)
   (up 't (up 'theta 'phi) (down 'p_theta 'p_phi))))
(up 1 (up p_theta (/ p_phi (expt (sin theta) 2))) (down (/ (* (expt p_phi 2) (cos theta)) (expt (sin theta) 3)) 0))
(define state-space (make-manifold Rn 5))
(define states
  (coordinate-system-at state-space :rectangular :origin))
(define-coordinates
  (up t (up theta phi) (down p_theta p_phi)) states)
(repl/scittle-sidebar)
source: src/mentat_collective/emmy/fdg_ch07.clj