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)))
![\displaystyle{ L = \frac{1}{2} m \left[(Dx)^2 + (Dy)^2 \right] - mgy - \frac{F}{2l} \left[ (x-x_s)^2 + (y-y_s)^2 - l^2 \right] }](https://s0.wp.com/latex.php?latex=%5Cdisplaystyle%7B+L+%3D+%5Cfrac%7B1%7D%7B2%7D+m+%5Cleft%5B%28Dx%29%5E2+%2B+%28Dy%29%5E2+%5Cright%5D+-+mgy+-+%5Cfrac%7BF%7D%7B2l%7D+%5Cleft%5B+%28x-x_s%29%5E2+%2B+%28y-y_s%29%5E2+-+l%5E2+%5Cright%5D+%7D&bg=ffffff&fg=333333&s=0&c=20201002)
(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)))

![\displaystyle{ \begin{aligned} mD^2x(t) + \frac{F(t)}{l} \left[x(t) - x_s(t)\right] &= 0 \\ mg + m D^2y(t) + \frac{F(t)}{l} [y(t) - y_s(t)] &= 0 \\ -l^2 + [y(t)-y_s(t)]^2 + [x(t)-x_s(t)]^2 &= 0 \\ \end{aligned}}](https://s0.wp.com/latex.php?latex=%5Cdisplaystyle%7B+%5Cbegin%7Baligned%7D+mD%5E2x%28t%29+%2B+%5Cfrac%7BF%28t%29%7D%7Bl%7D+%5Cleft%5Bx%28t%29+-+x_s%28t%29%5Cright%5D+%26%3D+0+%5C%5C+mg+%2B+m+D%5E2y%28t%29+%2B+%5Cfrac%7BF%28t%29%7D%7Bl%7D+%5By%28t%29+-+y_s%28t%29%5D+%26%3D+0+%5C%5C+-l%5E2+%2B+%5By%28t%29-y_s%28t%29%5D%5E2+%2B+%5Bx%28t%29-x_s%28t%29%5D%5E2+%26%3D+0+%5C%5C+%5Cend%7Baligned%7D%7D&bg=ffffff&fg=333333&s=0&c=20201002)
(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))))
![\displaystyle{ \begin{aligned} L_\theta &= \frac{1}{2} m (D x_s(t))^2 + \frac{1}{2} m (D y_s(t))^2 - m g \left[ y_s(t) - l \cos \theta(t) \right] \\ &+ \frac{1}{2} m l^2 (D \theta(t))^2 + lm D \theta(t) \left[ D x_s(t) \cos \theta(t) + \sin \theta(t) D y_s(t) \right] \\ \end{aligned}}](https://s0.wp.com/latex.php?latex=%5Cdisplaystyle%7B+%5Cbegin%7Baligned%7D+++L_%5Ctheta+++++%26%3D+++%5Cfrac%7B1%7D%7B2%7D+m+%28D+x_s%28t%29%29%5E2++%2B+%5Cfrac%7B1%7D%7B2%7D+m+%28D+y_s%28t%29%29%5E2++-++m+g+%5Cleft%5B+y_s%28t%29+-+l+%5Ccos+%5Ctheta%28t%29++%5Cright%5D+%5C%5C++%26%2B+%5Cfrac%7B1%7D%7B2%7D+m+l%5E2+%28D+%5Ctheta%28t%29%29%5E2+++%2B+lm+D+%5Ctheta%28t%29+%5Cleft%5B+++++D+x_s%28t%29+%5Ccos+%5Ctheta%28t%29+%2B+%5Csin+%5Ctheta%28t%29+D+y_s%28t%29++%5Cright%5D++++%5C%5C+++%5Cend%7Baligned%7D%7D&bg=ffffff&fg=333333&s=0&c=20201002)
[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.