# Ex 1.22 Driven pendulum, 3.1

Ex 1.24 Constraint forces, 1.1

Structure and Interpretation of Classical Mechanics

.

~~~

[guess] \displaystyle{ \begin{aligned} m \ddot{y} &= F \cos \theta - mg \\ m \ddot{x} &= - F \sin \theta \\ \end{aligned}}  \displaystyle{ \begin{aligned} m \ddot{y} &= F \frac{y_s - y}{l} - mg \\ m \ddot{x} &= - F \frac{x - x_s}{l} \\ \sqrt{(x_s - x)^2 + (y_s - y)^2} &= l \\ \end{aligned}}

. \displaystyle{ \begin{aligned} y_s &= l \\ x_s &= 0 \\ \end{aligned}} \displaystyle{ \begin{aligned} m \ddot{y} &= F \frac{l - y}{l} - mg \\ m \ddot{x} &= - F \frac{x}{l} \\ \sqrt{x^2 + (l - y)^2} &= l \\ \end{aligned}}

.


(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] }$


(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}}


(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}}

[guess]

— Me@2022-03-24 04:38:10 PM

.

.