1 files changed, 92 insertions, 1 deletions

diff --git a/work/funcdiff_play.scm b/work/funcdiff_play.scm
index 482f0f3..f447253 100644
--- a/work/funcdiff_play.scm
+++ b/work/funcdiff_play.scm
@@ -300,4 +300,95 @@
 ; 0
 ; so [Jx,Jy] = -Jz, nice
 
-; @ p21?
\ No newline at end of file
+;;; Feb 4
+
+(define setup-R2
+  (lambda ()
+    (let ()
+      (define R2 (rectangular 2))
+      (instantiate-coordinates R2 '(x y))
+      (define R2-point ((R2 '->point) (up 'x0 'y0))))))
+
+(define setup-R3
+  (lambda ()
+    (let ()
+      (define R3 (rectangular 3))
+      (instantiate-coordinates R3 '(x y z))
+      (define R3-point ((R3 '->point) (up 'x0 'y0 'z0))))))
+
+(setup-R2)
+
+(define v (+ (* 'a d/dx) (* 'b d/dy)))
+(define w (+ (* 'c d/dx) (* 'd d/dy)))
+
+;(pe (((wedge dx dy) v w) R2-point))
+
+(setup-R3)
+
+(define u (+ (* 'a d/dx) (* 'b d/dy) (* 'c d/dz)))
+(define v (+ (* 'd d/dx) (* 'e d/dy) (* 'f d/dz)))
+(define w (+ (* 'g d/dx) (* 'h d/dy) (* 'i d/dz)))
+
+;(pe (((wedge dx dy dz) u v w) R3-point))
+; determinant
+
+(define a (l-m-f 'alpha R3))
+(define b (l-m-f 'beta R3))
+(define c (l-m-f 'gamma R3))
+
+(define theta (+ (* a dx) (* b dy) (* c dz)))
+
+(define X (literal-vector-field 'X R3))
+(define Y (literal-vector-field 'Y R3))
+
+#|
+(pe (((- (d theta)
+	 (+ (wedge (d a) dx)
+	    (wedge (d b) dy)
+	    (wedge (d c) dz)))
+      X Y)
+     R3-point))
+;0
+
+|#
+
+(define ((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 (vector-field-over-map->vector-field V-over-mu n)
+  (procedure->vector-field
+   (lambda (f)
+     (lambda (m) ((V-over-mu f) n)))))
+
+(define ((form-field-over-map mu:N->M) w-on-M)
+  (let ((k (get-rank w-on-M)))
+    (procedure->nform-field
+     (lambda vecotrs-over-map
+       (lambda (n)
+	 ((apply w-on-M
+		 (map (lambda (V-over-mu)
+			(vector-field-over-map->vector-field
+			 V-over-mu n))
+		      vectors-over-map))
+	  (mu:N->M n))))
+     'athing
+     k)))
+
+(pp procedure->nform-field)
+
+(define sphere (S2 1))
+(instantiate-coordinates sphere '(theta phi))
+(define sphere-basis (coordinate-system->basis sphere))
+(instantiate-coordinates the-real-line 't)
+
+(define mu
+  (compose (sphere '->point)
+	   (up (literal-function 'alpha)
+	       (literal-function 'beta))
+	   (the-real-line '->coords)))
+
+(define sphere-basis-over-mu
+  (basis->basis-over-map mu sphere-basis))
+