Ex 1.24 Constraint forces, 1.1
Structure and Interpretation of Classical Mechanics
.
~~~
[guess]
.
.
(define (KE-particle m v) (* 1/2 m (square v))) (define ((extract-particle pieces) local i) (let* ((indices (apply up (iota pieces (* i pieces)))) (extract (lambda (tuple) (vector-map (lambda (i) (ref tuple i)) indices)))) (up (time local) (extract (coordinate local)) (extract (velocity local))))) (define (U-constraint q0 q1 F l) (* (/ F (* 2 l)) (- (square (- q1 q0)) (square l)))) (define ((U-gravity g m) q) (let* ((y (ref q 1))) (* m g y))) (define ((L-driven-free m l x_s y_s U) local) (let* ((extract (extract-particle 2)) (p (extract local 0)) (q (coordinate p)) (qdot (velocity p)) (F (ref (coordinate local) 2))) (- (KE-particle m qdot) (U q) (U-constraint (up (x_s (time local)) (y_s (time local))) q F l)))) (let* ((U (U-gravity 'g 'm)) (x_s (literal-function 'x_s)) (y_s (literal-function 'y_s)) (L (L-driven-free 'm 'l x_s y_s U)) (q-rect (up (literal-function 'x) (literal-function 'y) (literal-function 'F)))) (show-expression ((compose L (Gamma q-rect)) 't)))
(let* ((U (U-gravity 'g 'm)) (x_s (literal-function 'x_s)) (y_s (literal-function 'y_s)) (L (L-driven-free 'm 'l x_s y_s U)) (q-rect (up (literal-function 'x) (literal-function 'y) (literal-function 'F)))) (show-expression (((Lagrange-equations L) q-rect) 't)))
(define ((F->C F) local) (->local (time local) (F local) (+ (((partial 0) F) local) (* (((partial 1) F) local) (velocity local))))) (define ((q->r x_s y_s l) local) (let* ((q (coordinate local)) (t (time local)) (theta (ref q 0)) (F (ref q 1))) (up (+ (x_s t) (* l (sin theta))) (- (y_s t) (* l (cos theta))) F))) (let ((q (up (literal-function 'theta) (literal-function 'F)))) (show-expression (q 't)))
(let* ((x_s (literal-function 'x_s)) (y_s (literal-function 'y_s)) (q (up (literal-function 'theta) (literal-function 'F)))) (show-expression ((Gamma q) 't)))
(let* ((xs (literal-function 'x_s)) (ys (literal-function 'y_s)) (q (up (literal-function 'theta) (literal-function 'F)))) (show-expression ((compose (q->r xs ys 'l) (Gamma q)) 't)))
(let* ((xs (literal-function 'x_s)) (ys (literal-function 'y_s)) (q (up (literal-function 'theta) (literal-function 'F)))) (show-expression ((F->C (q->r xs ys 'l)) ((Gamma q) 't))))
(define (L-theta m l x_s y_s U) (compose (L-driven-free m l x_s y_s U) (F->C (q->r x_s y_s l)))) (let* ((U (U-gravity 'g 'm)) (xs (literal-function 'x_s)) (ys (literal-function 'y_s)) (q (up (literal-function 'theta) (literal-function 'F)))) (show-expression ((Gamma (compose (q->r xs ys 'l) (Gamma q))) 't)))
(let* ((U (U-gravity 'g 'm)) (xs (literal-function 'x_s)) (ys (literal-function 'y_s)) (q (up (literal-function 'theta) (literal-function 'F)))) (show-expression (U ((compose (q->r xs ys 'l) (Gamma q)) 't))))
(let* ((U (U-gravity 'g 'm)) (xs (literal-function 'x_s)) (ys (literal-function 'y_s)) (q (up (literal-function 'theta) (literal-function 'F)))) (show-expression ((L-driven-free 'm 'l xs ys U) ((Gamma (compose (q->r xs ys 'l) (Gamma q))) 't))))
(let* ((U (U-gravity 'g 'm)) (xs (literal-function 'x_s)) (ys (literal-function 'y_s)) (q (up (literal-function 'theta) (literal-function 'F)))) (show-expression ((L-theta 'm 'l xs ys U) ((Gamma q) 't))))
[guess]
— Me@2022-03-24 04:38:10 PM
.
.
2022.03.26 Saturday (c) All rights reserved by ACHK
You must be logged in to post a comment.