progress today (tuesday)

1 files changed, 223 insertions, 0 deletions

diff --git a/chapters/3-Vector-Fields.scm b/chapters/3-Vector-Fields.scm
new file mode 100644
index 0000000..2e15c18
--- /dev/null
+++ b/chapters/3-Vector-Fields.scm
@@ -0,0 +1,223 @@
+
+; pre-reqs
+(define R2->R (-> (UP Real Real) Real))
+(define R2-rect-chi (chart R2-rect))
+(define R2-rect-chi-inverse (point R2-rect))
+(define R2-rect-point (R2-rect-chi-inverse (up 'x0 'y0)))
+
+
+(define (components->vector-field components coordsys)
+  (define (v f)
+    (compose (* (D (compose f (point coordsys)))
+                components)
+             (chart coordsys)))
+  (procedure->vector-field v))
+
+(define v
+  (components->vector-field
+    (up (literal-function 'b^0 R2->R)
+        (literal-function 'b^1 R2->R))
+    R2-rect))
+
+((v (literal-manifold-function 'f-rect R2-rect)) R2-rect-point)
+; (+ (* (b^0 (up x0 y0))
+;       (((partial 0) f-rect) (up x0 y0)))
+;    (* (b^1 (up x0 y0))
+;       (((partial 1) f-rect) (up x0 y0))))
+
+((v (chart R2-rect)) R2-rect-point)
+; (up (b^0 (up x0 y0)) (b^1 (up x0 y0)))
+
+(define (coordinatize v coordsys)
+  (define ((coordinatized-v f) x)
+    (let ((b (compose (v (chart coordsys))
+                      (point coordsys))))
+      (* ((D f) x) (b x))))
+  (make-operator coordinatized-v))
+
+(((coordinatize v R2-rect) (literal-function 'f-rect R2->R))
+ (up 'x0 'y0))
+; (+ (* (b^0 (up x0 y0))
+;       (((partial 0) f-rect) (up x0 y0)))
+;    (* (b^1 (up x0 y0))
+;       (((partial 1) f-rect) (up x0 y0))))
+
+(define-coordinates (up x y) R2-rect)
+(define-coordinates (up r theta) R2-polar)
+
+((d/dx (square r)) R2-rect-point)
+; (* 2 x0)
+
+(((+ d/dx (* 2 d/dy)) (+ (square r) (* 3 x))) R2-rect-point)
+; (+ 3 (* 2 x0) (* 4 y0))
+
+(define circular (- (* x d/dy) (* y d/dx)))
+
+(series:for-each print-expression
+                 (((exp (* 't circular)) (chart R2-rect))
+                  ((point R2-rect) (up 1 0)))
+                 6)
+; (up 0 t)
+; (up (* -1/2 (expt t 2)) 0)
+; (up 0 (* -1/6 (expt t 3)))
+; (up (* 1/24 (expt t 4)) 0)
+; (up 0 (* 1/120 (expt t 5)))
+
+(define ((((evolution order) delta-t v) f) m)
+  (series:sum
+    (((exp (* delta-t v)) f) m)
+    order))
+
+((((evolution 6) 'delta-t circular) (chart R2-rect))
+ ((point R2-rect) (up 1 0)))
+; (up (+ 1
+;        (* -1/720 (expt delta-t 6))
+;        (* 1/24 (expt delta-t 4))
+;        (* -1/2 (expt delta-t 2)))
+;     (+ (* 1/120 (expt delta-t 5))
+;        (* -1/6 (expt delta-t 3))
+;        delta-t))
+
+; "note: these are jus tthe series expansion for cos(delta-t) and sin(delta-t)"
+
+;;; Exercise 3.1
+
+(print-expression "==== Exercise 3.1")
+(define R5 (make-manifold R^n 5))
+(define R5-rect (coordinate-system-at 'rectangular 'origin R5))
+(define R5->R (-> (UP Real Real Real Real Real) Real))
+
+(define-coordinates (up pt px py pvx pvy) R5-rect)
+
+; this isn't really true... it is more of a function of two coordinates. but
+; could consider it a manifold function ignoring most? hrm.
+(define Ax (literal-manifold-function 'Ax R5-rect))
+(define Ay (literal-manifold-function 'Ay R5-rect))
+
+;(define v-newton-planar
+;  (components->vector-field
+;    (up 1
+;        pvx
+;        pvy
+;        Ax
+;        Ay)
+;    R5-rect))
+
+(define v-newton-planar
+  (+ (* 1 d/dpt)
+     (* pvx d/dpx)
+     (* pvy d/dpy)
+     (* Ax d/dpvx)
+     (* Ay d/dpvy)))
+  
+(series:for-each print-expression
+                 (((exp (* 't v-newton-planar)) (chart R5-rect))
+                  ((point R5-rect) (up 't0 'px0 'py0 'pvx0 'pvy0)))
+                 3)
+;(up t0 px0 py0 pvx0 pvy0)
+;(up t (* pvx0 t) (* pvy0 t) (* t (Ax (up t0 px0 py0 pvx0 pvy0))) (* t (Ay (up t0 px0 py0 pvx0 pvy0))))
+;(up
+; 0
+; (* 1/2 (expt t 2) (Ax (up t0 px0 py0 pvx0 pvy0)))
+; (* 1/2 (expt t 2) (Ay (up t0 px0 py0 pvx0 pvy0)))
+; (+ (* 1/2 pvx0 (expt t 2) (((partial 1) Ax) (up t0 px0 py0 pvx0 pvy0)))
+;    (* 1/2 pvy0 (expt t 2) (((partial 2) Ax) (up t0 px0 py0 pvx0 pvy0)))
+;    (* 1/2 (expt t 2) (Ay (up t0 px0 py0 pvx0 pvy0)) (((partial 4) Ax) (up t0 px0 py0 pvx0 pvy0)))
+;    (* 1/2 (expt t 2) (Ax (up t0 px0 py0 pvx0 pvy0)) (((partial 3) Ax) (up t0 px0 py0 pvx0 pvy0)))
+;    (* 1/2 (expt t 2) (((partial 0) Ax) (up t0 px0 py0 pvx0 pvy0))))
+; (+ (* 1/2 pvx0 (expt t 2) (((partial 1) Ay) (up t0 px0 py0 pvx0 pvy0)))
+;    (* 1/2 pvy0 (expt t 2) (((partial 2) Ay) (up t0 px0 py0 pvx0 pvy0)))
+;    (* 1/2 (expt t 2) (Ay (up t0 px0 py0 pvx0 pvy0)) (((partial 4) Ay) (up t0 px0 py0 pvx0 pvy0)))
+;    (* 1/2 (expt t 2) (Ax (up t0 px0 py0 pvx0 pvy0)) (((partial 3) Ay) (up t0 px0 py0 pvx0 pvy0)))
+;    (* 1/2 (expt t 2) (((partial 0) Ay) (up t0 px0 py0 pvx0 pvy0)))))
+
+; this isn't really complete/correct, though it is sort of close. hrm.
+
+;;; One-form Fields
+
+(define omega
+  (components->1form-field
+    (down (literal-function 'a_0 R2->R)
+          (literal-function 'a_1 R2->R))
+    R2-rect))
+
+((omega (down d/dx d/dy)) R2-rect-point)
+; (down (a_0 (up x0 y0)) (a_1 (up x0 y0)))
+
+(define omega (literal-1form-field 'a R2-rect))
+
+(((d (literal-manifold-function 'f-rect R2-rect))
+  (coordinate-system->vector-basis R2-rect))
+ R2-rect-point)
+
+; (down (((partial 0) f-rect) (up x0 y0))
+;       (((partial 1) f-rect) (up x0 y0)))
+
+(((d (literal-manifold-function 'f-rect R2-polar))
+  (coordinate-system->vector-basis R2-rect))
+ ((point R2-polar) (up 'r 'theta)))
+; (down (/ (+ (* r (cos theta) (((partial 0) f-rect) (up r theta))) (* -1 (sin theta) (((partial 1) f-rect) (up r theta)))) r)
+;       (/ (+ (* r (sin theta) (((partial 0) f-rect) (up r theta))) (* (cos theta) (((partial 1) f-rect) (up r theta)))) r))
+
+(define-coordinates (up x y) R2-rect)
+
+((dx d/dy) R2-rect-point)
+; 0
+
+((dx d/dx) R2-rect-point)
+; 1
+
+((dx circular) R2-rect-point)
+; (* -1 y0)
+
+
+((dy circular) R2-rect-point)
+; x0
+
+((dr circular) R2-rect-point)
+; 0
+
+((dtheta circular) R2-rect-point)
+; 1
+
+(define f (literal-manifold-function 'f-rect R2-rect))
+
+(((- circular d/dtheta) f) R2-rect-point)
+; 0
+
+(define omega (literal-1form-field 'a R2-rect))
+
+(define v (literal-vector-field 'b R2-rect))
+
+((omega v) R2-rect-point)
+; (+ (* (b^0 (up x0 y0))
+;       (a_0 (up x0 y0)))
+;    (* (b^1 (up x0 y0))
+;       (a_1 (up x0 y0))))
+
+;;; Exercise 3.2
+
+; not done
+
+;;; Exersize 3.3 Hill Climbing
+
+(print-expression "==== Exercise 3.3")
+
+(define S2-spherical-point ((point S2-spherical) (up 'theta0 'phi0)))
+
+(define h (literal-manifold-function 'h-spherical S2-spherical))
+(define v-walk (literal-vector-field 'v-walk S2-spherical))
+
+(define (power mass)
+  (* mass (v-walk h)))
+
+((power 'mass0) S2-spherical-point)
+; (+ (* mass0
+;       (v-walk^0 (up theta0 phi0))
+;       (((partial 0) h-spherical) (up theta0 phi0)))
+;    (* mass0
+;       (v-walk^1 (up theta0 phi0))
+;       (((partial 1) h-spherical) (up theta0 phi0))))
+
+; I think I got this correct?
+