FDG | Physics Town

Chapter 1: Introduction

(define ((Gamma w) t)
  (up t (w t) ((D w) t)))

(define q-rect
  (up (literal-function 'x_0)
      (literal-function 'y_0)
      (literal-function 'x_1)
      (literal-function 'y_1)
      (literal-function 'F)))

(show-expression (q-rect 't))

(show-expression ((Gamma q-rect) 't))





(define ((Lfree mass) state)
  (* 1/2 mass (square (velocity state))))

(define ((sphere->R3 R) state)
  (let ((q (coordinate state)))
    (let ((theta (ref q 0)) (phi (ref q 1)))
      (up (* R (sin theta) (cos phi))
          (* R (sin theta) (sin phi))
          (* R (cos theta))))))

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

(define (Lsphere m R)
  (compose (Lfree m) (F->C (sphere->R3 R))))

((Lsphere 'm 'R)
 (up 't
     (up 'theta 'phi)
     (up 'thetadot 'phidot)))

(show-expression
 ((Lsphere 'm 'R)
  (up 't
      (up 'theta 'phi)
      (up 'thetadot 'phidot))))



(define ((L2 mass metric) place velocity)
  (* 1/2
     mass
     ((metric velocity velocity) place)))

(define ((Lc mass metric coordsys) state)
  (let ((x (coordinates state))
        (v (velocities state))
        (e (coordinate-system->vector-basis
            coordsys)))
    ((L2 mass metric)
     ((point coordsys) x) (* e v))))

(define the-metric
  (literal-metric 'g R2-rect))

(define L
  (Lc 'm the-metric R2-rect))

(L (up 't (up 'x 'y) (up 'vx 'vy)))

(show-expression
 (L (up 't (up 'x 'y) (up 'v_x 'v_y))))



(define gamma
  (literal-manifold-map 'q R1-rect R2-rect))

((chart R2-rect)
 (gamma ((point R1-rect) 't)))

(show-expression
 ((chart R2-rect)
  (gamma ((point R1-rect) 't))))



(define coordinate-path
  (compose
   (chart R2-rect) gamma (point R1-rect)))

(coordinate-path 't)

(define Lagrange-residuals
  (((Lagrange-equations L)
    coordinate-path) 't))

(show-expression
 Lagrange-residuals)





(define-coordinates t R1-rect)

(define Cartan
  (Christoffel->Cartan
   (metric->Christoffel-2
    the-metric
    (coordinate-system->basis R2-rect))))

(define geodesic-equation-residuals
  (((((covariant-derivative Cartan gamma) d/dt)
     ((differential gamma) d/dt))
    (chart R2-rect))
   ((point R1-rect) 't)))

(define metric-components
  (metric->components
   the-metric
   (coordinate-system->basis R2-rect)))

(- Lagrange-residuals
   (* (* 'm (metric-components
             (gamma ((point R1-rect) 't))))
      geodesic-equation-residuals))

(show-expression
 (- Lagrange-residuals
    (* (* 'm (metric-components
              (gamma ((point R1-rect) 't))))
       geodesic-equation-residuals)))