From d33e373b84fdd82507dd40c6a0a937a91ef88b05 Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Fri, 23 Sep 2022 10:51:24 -0700 Subject: commit work from yesterday (thursday) --- chapters/4-Basis-Fields.scm | 150 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 150 insertions(+) create mode 100644 chapters/4-Basis-Fields.scm (limited to 'chapters/4-Basis-Fields.scm') diff --git a/chapters/4-Basis-Fields.scm b/chapters/4-Basis-Fields.scm new file mode 100644 index 0000000..577bd58 --- /dev/null +++ b/chapters/4-Basis-Fields.scm @@ -0,0 +1,150 @@ + +; 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-polar-chi (chart R2-polar)) +(define R2-polar-chi-inverse (point R2-polar)) +(define R2-rect-point (R2-rect-chi-inverse (up 'x0 'y0))) +(define R2-polar-point (R2-polar-chi-inverse (up 'r0 'theta0))) + +(define-coordinates (up x y) R2-rect) +(define-coordinates (up r theta) R2-polar) + +(define e0 + (+ (* (literal-manifold-function 'e0x R2-rect) d/dx) + (* (literal-manifold-function 'e0y R2-rect) d/dy))) + +(define e1 + (+ (* (literal-manifold-function 'e1x R2-rect) d/dx) + (* (literal-manifold-function 'e1y R2-rect) d/dy))) + +(define e-vector-basis (down e0 e1)) +(define e-dual-basis + (vector-basis->dual e-vector-basis R2-polar)) + +((e-dual-basis e-vector-basis) R2-rect-point) +; (up (down 1 0) (down 0 1)) + +((e-dual-basis e-vector-basis) R2-polar-point) +; (up (down 1 0) (down 0 1)) + +; remember, e-vector-basis is "down" +(define v + (* (up (literal-manifold-function 'b^0 R2-rect) + (literal-manifold-function 'b^1 R2-rect)) + e-vector-basis)) + +((e-dual-basis v) R2-rect-point) +; (up (b^0 (up x0 y0)) (b^1 (up x0 y0))) + +(define (Jacobian to-basis from-basis) + (s:map/r (basis->1form-basis to-basis) + (basis->vector-basis from-basis))) + +(define b-rect + ((coordinate-system->1form-basis R2-rect) + (literal-vector-field 'b R2-rect))) + +(define b-polar + (* (Jacobian (coordinate-system->basis R2-polar) + (coordinate-system->basis R2-rect)) + b-rect)) + +(b-rect ((point R2-rect) (up 'x0 'y0))) +; (up (b^0 (up x0 y0)) (b^1 (up x0 y0))) + +(b-polar ((point R2-rect) (up 'x0 'y0))) +; (up (/ (+ (* x0 (b^0 (up x0 y0))) (* y0 (b^1 (up x0 y0)))) +; (sqrt (+ (expt x0 2) (expt y0 2)))) +; (/ (+ (* x0 (b^1 (up x0 y0))) (* -1 y0 (b^0 (up x0 y0)))) +; (+ (expt x0 2) (expt y0 2)))) +; same as... +; (x0 b0(m) + y0 b1(m)) / r +; (x0 b1(m) - y0 b0(m)) / r^2 + +; Commutators + +(let* ((polar-basis (coordinate-system->basis R2-polar)) + (polar-vector-basis (basis->vector-basis polar-basis)) + (polar-dual-basis (basis->1form-basis polar-basis)) + (f (literal-manifold-function 'f-rect R2-rect))) + ((- ((commutator e0 e1) f) + (* (- (e0 (polar-dual-basis e1)) + (e1 (polar-dual-basis e0))) + (polar-vector-basis f))) + R2-rect-point)) +; 0 + +(define-coordinates (up x y z) R3-rect) + +(define R3->R (-> (UP Real Real Real) Real)) +(define R3-rect-chi (chart R3-rect)) +(define R3-rect-chi-inverse (point R3-rect)) +(define R3-rect-point (R3-rect-chi-inverse (up 'x0 'y0 'z0))) + +(define Jz (- (* x d/dy) (* y d/dx))) +(define Jx (- (* y d/dz) (* z d/dy))) +(define Jy (- (* z d/dx) (* x d/dz))) + +; huh, 'g' here was not defined. is it supposed to be a metric? probably not. a function? +;(((+ (commutator Jx Jy) Jz) g) R3-rect-point) +(define g (compose (literal-function 'g-rect R3->R) R3-rect-chi)) + +; oh, I see, there was a footnote. I defined things a little differently, could have been: + +; (define R3-rect (coordinate-system-at 'rectangular 'origin R3)) +; (define-coordinates (up x y z) R3-rect) +; (define R3-rect-point ((point R3-rect) (up 'x0 'y0 'z0))) +; (define g (literal-manifold-function 'g-rect R3-rect)) + + +(((+ (commutator Jx Jy) Jz) g) R3-rect-point) +; 0 +(((+ (commutator Jy Jz) Jx) g) R3-rect-point) +; 0 +(((+ (commutator Jz Jx) Jy) g) R3-rect-point) +; 0 + +(define Euler-angles (coordinate-system-at 'Euler 'Euler-patch SO3)) +(define Euler-angles-chi-inverse (point Euler-angles)) +(define-coordinates (up theta phi psi) Euler-angles) +(define SO3-point ((point Euler-angles) (up 'theta 'phi' psi))) +(define f (literal-manifold-function 'f-Euler Euler-angles)) + +; from p48 +(define e_x (+ (* (cos phi) d/dtheta) + (* -1 (sin phi) (/ (cos theta) (sin theta)) d/dphi) + (* (/ (sin phi) (sin theta)) d/dpsi))) +(define e_y (+ (* (cos phi) (/ (cos theta) (sin theta)) d/dphi) + (* (sin phi) d/dtheta) + (* -1 (/ (cos phi) (sin theta)) d/dpsi))) +(define e_z d/dphi) + +(((+ (commutator e_x e_y) e_z) f) SO3-point) +; 0 + +(((+ (commutator e_y e_z) e_x) f) SO3-point) +; 0 + +(((+ (commutator e_z e_x) e_y) f) SO3-point) +; 0 + +; that is a fair amount of computer algebra! verified by fiddling with the +; definition of e_x, and the subtraction no longer comes out to zero + +;;; Exercise 4.1 Alternate Angles + +; 4.1a + + +;;; Exersize 4.2 General Commutators + +; verify equation (4.38) (not done) + +;;; Exersize 4.3 SO(3) Basis and Angular Momentum Basis + + +((Jx g) R3-rect-point) + +((e_x f) SO3-point) -- cgit v1.2.3