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