From 4494e74864554ef72c4e61b5bca7d826145492a0 Mon Sep 17 00:00:00 2001 From: bnewbold Date: Thu, 5 Feb 2009 23:08:17 -0500 Subject: day's work --- journal/04feb2009.html | 3 +- journal/05feb2009.html | 47 +++++++++++ work/funcdiff_play.scm | 215 +++++++++++++++++++++++++++++++++++++++++++++++-- 3 files changed, 256 insertions(+), 9 deletions(-) create mode 100644 journal/05feb2009.html diff --git a/journal/04feb2009.html b/journal/04feb2009.html index d3d1cb1..8e6d45e 100644 --- a/journal/04feb2009.html +++ b/journal/04feb2009.html @@ -32,7 +32,8 @@ time to keep reading but I haven't been playing/exploring on my own as much. Hopefully I'll get the chance to calculate some geodesics and come up with an outline on Friday.

-(previous entry) +(previous entry) - +(next entry) diff --git a/journal/05feb2009.html b/journal/05feb2009.html new file mode 100644 index 0000000..64be27f --- /dev/null +++ b/journal/05feb2009.html @@ -0,0 +1,47 @@ + + +bnewbold thesis + +

+Journal: Feb 05, 2009

+Bryan Newbold, bnewbold@mit.edu
+ +http://web.mit.edu/bnewbold/thesis/ +

+ + + +Today i'm skimming through sections on pullbacks and pushforwards without much +understanding; I think i've gone pretty far down the math path for now and need +to push through to some physical problems. I can return later if I need to? +It looks like ultimately it will be a good example of the functional approach, +but stumbles before strides. + +

+To define: Cartan, Christoffel, + +

+I like the list of thing which are important enough to be refered to with a +"the-" prefix in scheme: +

+the-cons-table    the-empty-stream  the-environment   the-environment?
+the-ether         the-null-symbol   the-real-line   
+

+What components of the entire operating system are unique/important enough to +be refered to this way? The only "a-" is a-reduce, which while technically +"a" thing, doesn't refer to just any old reduce. This makes sense. + +

+Whew, finally got through the end of the differential geometry memo, at least +skimming through it. Looks like there's plenty of work still to be done! Of +course i'm sure a lot of it is in will's calculus additions, i'll have to +look through that next. +

+(previous entry) + + + + + diff --git a/work/funcdiff_play.scm b/work/funcdiff_play.scm index f447253..18c72e5 100644 --- a/work/funcdiff_play.scm +++ b/work/funcdiff_play.scm @@ -85,6 +85,7 @@ ;;; Feb 2 +#| (define (vector-field-procedure components coordinate-system) (define (the-procedure f) (compose (* (D (compose f (coordinate-system '->point))) @@ -92,9 +93,10 @@ (coordinate-system '->coords))) the-procedure) -(define (components->vecotr-field components coordinate-system) +(define (components->vector-field components coordinate-system) (procedure->vector-field - (vector-field-procedure components coordinate-system))) + (vector-field-procedure components coordinate-system) + 'foo)) (define v (components->vector-field @@ -113,6 +115,7 @@ (coordsys '->point)))) (* ((D f) x) (b x)))) (make-operator v)) +|# #| (pe (((coordinatize v R2) @@ -355,17 +358,19 @@ (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)))) + (compose (v-on-M f-on-M) mu:N->M)) + 'foo)) (define (vector-field-over-map->vector-field V-over-mu n) (procedure->vector-field (lambda (f) - (lambda (m) ((V-over-mu f) n))))) + (lambda (m) ((V-over-mu f) n))) + 'foo)) (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 vectors-over-map (lambda (n) ((apply w-on-M (map (lambda (V-over-mu) @@ -389,6 +394,200 @@ (literal-function 'beta)) (the-real-line '->coords))) -(define sphere-basis-over-mu - (basis->basis-over-map mu sphere-basis)) - +(define (((differential mu) v) f) + (v (compose f mu))) + +;;; Feb 5 +;;; skipped a bit here... + +(define setup-P2 + (lambda () + (define P2 (polar/cylindrical 2)) + (define P2-chi (P2 '->coords)) + (define P2-chi-inverse (P2 '->point)) + (define polar-basis (coordinate-system->basis P2)) + (instantiate-coordinates P2 '(r theta)))) + +(setup-R2) +(define rectangular-basis (coordinate-system->basis R2)) +(setup-P2) +(define polar-basis (coordinate-system->basis P2)) + +(define rectangular-Christoffel + (make-Christoffel + (let ((zero (lambda (m) 0))) + (down (down (up zero zero) + (up zero zero)) + (down (up zero zero) + (up zero zero)))) + rectangular-basis)) + +(define polar-Christoffel + (make-Christoffel + (let ((zero (lambda (m) 0))) + (down (down (up zero zero) + (up zero (/ 1 r))) + (down (up zero (/ 1 r)) + (up (* -1 r) zero)))) + polar-basis)) + +(define rectangular-Cartan + (Christoffel->Cartan rectangular-Christoffel)) + +(define polar-Cartan + (Christoffel->Cartan polar-Christoffel)) + +(define f + (compose (literal-function 'f-rect R2->R) R2-chi)) + +#| +(pe (((((covariant-derivative rectangular-Cartan) d/dx) + J) + f) + R2-point)) + +(pe ((d/dy f) R2-point)) +|# + +(instantiate-coordinates the-real-line 't) +(define M (rectangular 2)) +(instantiate-coordinates M '(theta phi)) +(define M-basis (coordinate-system->basis M)) + +(define G-S2-1 + (make-Christoffel + (let ((zero (lambda (point) 0))) + (down (down (up zero zero) + (up zero (/ 1 (tan theta)))) + (down (up zero (/ 1 (tan theta))) + (up (- (+ (sin theta) (cos theta))) zero)))) + M-basis)) + +(define gamma:N->M + (compose (M '->point) + (up (literal-function 'alpha) + (literal-function 'beta)) + (the-real-line '->coords))) + +(define basis-over-gamma + (basis->basis-over-map gamma:N->M M-basis)) +; this gave me an error; i tried from a blank run and didn't get the error so +; I must have clobbered something in this file + +; ah, it was easy, i /was/ passing the wrong arguments to +; procedure->vector-field + +(define w + (basis-components->vector-field + (up (compose (literal-function 'w0) + (the-real-line '->coords)) + (compose (literal-function 'w1) + (the-real-line '->coords))) + (basis->vector-basis basis-over-gamma))) + +(define sphere-Cartan-over-gamma + (Christoffel->Cartan-over-map G-S2-1 gamma:N->M)) + +#| +(pe + (s:map/r + (lambda (omega) + ((omega + (((covariant-derivative sphere-Cartan-over-gamma) + d/dt) + w)) + ((the-real-line '->point) 'tau))) + (basis->1form-basis basis-over-gamma))) + +|# + +(define gamma:N->M + (compose (M '->point) + (up (literal-function 'alpha) + (literal-function 'beta)) + (the-real-line '->coords))) + +#| +(se + (((((covariant-derivative sphere-Cartan-over-gamma) d/dt) + ((differential gamma:N->M) d/dt)) + (M '->coords)) + ((the-real-line '->point) 't))) +|# + +(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))) + +#| +(pe (((Lagrange-equations Lsphere) + (up (literal-function 'alpha) + (literal-function 'beta))) + 't)) +|# + +(define ((Riemann-curvature Cartan) u v) + (let ((nabla (covariant-derivative Cartan))) + (- (commutator (nabla u) (nabla v)) + (nabla (commutator u v))))) + +(define sphere-Cartan (Christoffel->Cartan G-S2-1)) + +(pe (((Riemann sphere-Cartan) dphi d/dtheta d/dphi d/dtheta) + ((M '->point) (up 'theta0 'phi0)))) +;1 + +(define SR (rectangular 4)) +(instantiate-coordinates SR '(t x y z)) +(define an-event ((SR '->point) (up 't0 'x0 'y0 'z0))) +(define c 'c) + +(define (g-Lorentz u v) + (+ (* (dx u) (dx v)) + (* (dy u) (dy v)) + (* (dz u) (dz v)) + (* -1 (square c) (dt u) (dt v)))) + +(define SR-vector-basis + (down (* (/ 1 c) d/dt) + d/dx + d/dy + d/dz)) + +(define SR-1form-basis + (up (* c dt) dx dy dz)) + +(define SR-basis + (make-basis SR-vector-basis SR-1form-basis)) + +(define (Faraday Ex Ey Ez Bx By Bz) + (+ (* Ex c (wedge dx dt)) + (* Ey c (wedge dy dt)) + (* Ez c (wedge dz dt)) + (* Bx (wedge dy dz)) + (* By (wedge dz dx)) + (* Bz (wedge dx dy)))) + +(define (Maxwell Ex Ey Ez Bx By Bz) + (+ (* -1 Bx c (wedge dx dt)) + (* -1 By c (wedge dy dt)) + (* -1 Bz c (wedge dz dt)) + (* Ex (wedge dy dz)) + (* Ey (wedge dz dx)) + (* Ez (wedge dx dy)))) + +; blah doesn't interpret + +(define SR-star + (Hodge-star g-Lorentz SR-basis)) + +(SR-star (Faraday 'Ex 'Ey 'Ez 'Bx 'By 'Bz)) -- cgit v1.2.3