1 files changed, 104 insertions, 0 deletions
diff --git a/chapters/6-Over-a-Map.scm b/chapters/6-Over-a-Map.scm
new file mode 100644
index 0000000..748316b
--- /dev/null
+++ b/chapters/6-Over-a-Map.scm
@@ -0,0 +1,104 @@
+
+(define ((vector-field->vector-field-over-map mu:N->M) v-on-M)
+  (procedure->vector-field
+    (lambda (f-on-M)
+      (compose (v-on-M f-on-M) mu:N->M))))
+
+(define (((differential mu) v) f)
+  (v (compose f mu)))
+
+(define ((form-field->form-field-over-map mu:N->M) w-on-M)
+  (define (make-fake-vector-field V-over-mu n)
+    (define ((u f) m)
+      ((V-over-mu f) n))
+    (procedure->vector-field u))
+  (procedure->nform-field
+    (lambda vectors-over-map
+      (lambda (n)
+        ((apply w-on-M
+                (map (lambda (V-over-mu)
+                       (make-fake-vector-field V-over-mu n))
+                     vectors-over-map))
+         (mu:N->M n))))
+    (get-rank w-on-M)))
+
+(define S2 (make-manifold S^2 2 3))
+(define S2-spherical
+  (coordinate-system-at 'spherical 'north-pole S2))
+(define-coordinates (up theta phi) S2-spherical)
+(define S2-basis (coordinate-system->basis S2-spherical))
+
+(define-coordinates t R1-rect)
+
+(define mu
+  (compose (point S2-spherical)
+           (up (literal-function 'theta)
+               (literal-function 'phi))
+           (chart R1-rect)))
+
+(define S2-basis-over-mu
+  (basis->basis-over-map mu S2-basis))
+
+(define h
+  (literal-manifold-function 'h-spherical S2-spherical))
+
+(((basis->vector-basis S2-basis-over-mu) h)
+ ((point R1-rect) 't0))
+; (down (((partial 0) h-spherical) (up (theta t0) (phi t0)))
+;       (((partial 1) h-spherical) (up (theta t0) (phi t0))))
+
+
+(((basis->1form-basis S2-basis-over-mu)
+  (basis->vector-basis S2-basis-over-mu))
+ ((point R1-rect) 't0))
+; (up (down 1 0) (down 0 1))
+
+(((basis->1form-basis S2-basis-over-mu)
+  ((differential mu) d/dt))
+ ((point R1-rect) 't0))
+; (up ((D theta) t0) ((D phi) t0))
+
+(define ((pullback-function mu:N->M) f-on-M)
+  (compose f-on-M mu:N->M))
+
+(define ((pushforward-vector mu:N->M mu^-1:M->N) v-on-N)
+  (procedure->vector-field
+    (lambda (f)
+      (compose (v-on-N (compose f mu:N->M)) mu^-1:M->N))))
+
+(define (pullback-vector-field mu:N->M mu^-1:M->N)
+  (pushforward-vector mu^-1:M->N mu:N->M))
+
+(define ((pullback-form mu:N->M) omega-on-M)
+  (let ((k (get-rank omega-on-M)))
+    (if (= k 0)
+        ((pullback-function mu:N->M) omega-on-M)
+        (procedure->nform-field
+          (lambda vectors-on-N
+            (apply ((form-field->form-field-over-map mu:N->M)
+                    omega-on-M)
+                   (map (differential mu:N_>M) vectors-on-N)))
+          k))))
+
+(define mu (literal-manifold-map 'MU R2-rect R3-rect))
+
+(define f (literal-manifold-function 'f-rect R3-rect))
+(define X (literal-vector-field 'X-rect R2-rect))
+
+(((- ((pullback mu) (d f)) (d ((pullback mu) f))) X)
+ ((point R2-rect) (up 'x0 'y0)))
+; 0
+
+(define theta (literal-1form-field 'THETA R3-rect))
+(define Y (literal-vector-field 'Y-rect R2-rect))
+
+(((- ((pullback mu) (d theta)) (d ((pullback mu) theta))) X Y)
+ ((point R2-rect) (up 'x0 'y0)))
+; 0
+
+
+;;; Exersize 6.1: Velocities on a Globe
+
+; a)
+
+; b)