Exercise 1.20: Sliding pendulum

(require '[sicmutils.env :refer :all])

Consider a pendulum of length inline_formula not implemented attached to a support that is free to move horizontally, as shown in figure 1.4. Let the mass of the support be inline_formula not implemented and the mass of the pendulum bob be inline_formula not implemented. Formulate a Lagrangian and derive Lagrange's equations for this system.

This is interesting, and totally not-obvious how to represent with Newtonian mechanics. Here it is pretty simple. The setup:

We can use 2 coordinates:

  1. the horizontal position of the cart

  2. the angle inline_formula not implemented of the bob.

Here's the conversion to rectangular:

formula not implemented

Draw these on the picture to make it clearer.

Write the coordinate transformation in scheme.

(defn sliding-pend->rect [l]
  (fn [[_ [x1 theta]]]
    (up x1
        l
        (+ x1 (* l (sin theta)))
        (* l (- 1 (cos theta))))))

Next, the Lagrangian given rectangular coordinates, assuming no constraints:

(defn L-sliding-pend-rect [m1 m2 U]
  (fn [[_ q [vx1 vy1 vx2 vy2]]]
    (- (+ (* m1 (+ (square vx1)
                   (square vy1)))
          (* m2 (+ (square vx2)
                   (square vy2))))
       (U q))))

And the composition:

(defn L-sliding-pend [l m1 m2 U]
  (compose (L-sliding-pend-rect m1 m2 U)
           (F->C (sliding-pend->rect l))))

Gravitational potential. I could include the cart here, but since we know it's fixed gravitationally it wouldn't change the equations of motion.

(defn U-gravity [g m2]
  (fn [q]
    (let [y2 (ref q 3)]
      (* m2 g y2))))
(let [local (up 't
                (up 'x_1 'theta)
                (up 'xdot_1 'thetadot))
      U (U-gravity 'g 'm_2)]
  ((L-sliding-pend 'l 'm_1 'm_2 U) local))

Lagrange equations of motion:

(let [U (U-gravity 'g 'm_2)
      L (L-sliding-pend 'l 'm_1 'm_2 U)
      x1 (literal-function 'x_1)
      theta (literal-function 'theta)]
  (((Lagrange-equations L) (up x1 theta))
   't))

Cleaner:

(let [U (U-gravity 'g 'm_2)
      L (L-sliding-pend 'l 'm_1 'm_2 U)
      x1 (literal-function 'x_1)
      theta (literal-function 'theta)
      eqs (((Lagrange-equations L) (up x1 theta))
           't)]
  (up (ref eqs 0)
      (/ (ref eqs 1) 'l 'm_2)))
Runtimes (1)