6.946 pset1

pset1.scm

(define ((parametric-path-action Lagrangian t0 q0 t1 q1) qs)
  (let ((path (make-path t0 q0 t1 q1 qs)))
    (Lagrangian-action Lagrangian path t0 t1)))

; canned multi-dimensional minimization
; used to find approximate solution path
(define (find-path Lagrangian t0 q0 t1 q1 n)
  (let ((initial-qs (linear-interpolants q0 q1 n)))
    (let ((minimizing-qs
	   (multidimensional-minimize
	    (parametric-path-action Lagrangian t0 q0 t1 q1)
	    initial-qs)))
      (make-path t0 q0 t1 q1 minimizing-qs))))

;; equally spaced points on a straight line = initial guess.

(define ((L-harmonic m k) local)
  (let ((q (coordinate local))
	(v (velocity local)))
    (- (* 1/2 m (square v)) (* 1/2 k (square q)))))

(se (- (* 1/2 'm (square 'v)) (* 1/2 'k (square 'q))))

;; approximate path of harmonic oscillator
(define q (find-path (L-harmonic 1.0 8.0) 0. 1. :pi/2 0. 2))
#| q |#

(q (* .25 :pi))
#| .7070947672458608 |#
;; wow, that's a good approximation of cos(x)


(define win2 (frame 0. :pi/2 0. 1.2))

(define ((parametric-path-action Lagrangian t0 q0 t1 q1)
	 intermediate-qs)
  (let ((path (make-path t0 q0 t1 q1 intermediate-qs)))
    (graphics-clear win2)
    (plot-function win2 path t0 t1 (/ (- t1 t0) 100))
    (Lagrangian-action Lagrangian path t0 t1)))



;; Problem 1.11
(define lf literal-function)

;; A
(define ((L-particle m) local)
  (let ((q (coordinate local))
	(v (velocity local)))
    (let ((x (ref q 0))
	  (y (ref q 1)))
      (- (* 1/2 m (square v)) 
	 (/ (square q) 2) 
	 (* (square x) y) 
	 (* -1 (/ (cube y) 3))))))

(define qa (up (lf 'x) (lf 'y)))

(define L-comp-ga (compose (L-particle 'm) (Gamma qa)))

(se (L-comp-ga 't))
#|
(+ (/ (* m (expt ((D y) t) 2)) 2)
   (/ (* m (expt ((D x) t) 2)) 2)
   (/ (expt (y t) 3) 3)
   (* -1 (y t) (expt (x t) 2))
   (/ (* -1 (expt (y t) 2)) 2)
   (/ (* -1 (expt (x t) 2)) 2))
|#

(se ((Gamma qa) 't))

;; a function that returns the right-hand side of the 
;; Lagrange equation (d1L*Gamma)
(define (Leq-right L-fn gamma)
  (((partial 1) L-fn) (gamma 't)))

(define (Leq-left L-fn gamma)
  ((D ((partial 2) L-fn)) (gamma 't)))

;; the following:
(Leq-right (L-particle 'm) (Gamma qa))
;; is equivalent to to:
(((partial 1) (L-particle 'm)) ((Gamma qa) 't))
#|
(down (+ (* -2 (y t) (x t)) (* -1 (x t)))
      (+ (expt (y t) 2) (* -1 (expt (x t) 2)) (* -1 (y t))))
|#

(Leq-left (L-particle 'm) (Gamma qa))
#|
Help! Why isn't the velocity being derived properly?
(down (down 0 0) (down (down 0 0) (down 0 0)) (down (down m 0) (down 0 m)))
|#

;; And now the solution
(se (((Lagrange-equations (L-particle 'm)) qa) 't))
#|
(down (+ (* m (((expt D 2) x) t)) (* 2 (y t) (x t)) (x t))
      (+ (* m (((expt D 2) y) t)) (* -1 (expt (y t) 2)) (expt (x t) 2) (y t)))
|#


;; B
(define ((L-pendulum m l g) local)
  (let ((theta (coordinate local))
	(thetadot (velocity local)))
    (+ (* 1/2 m (square l) (square thetadot)) (* m g l (cos theta)))))

(define qb (lf 'theta))

(define L-pen-sym (L-pendulum 'm 'l 'g))

(Leq-right L-pen-sym (Gamma qb))
#|
(* -1 g l m (sin (theta t)))
|#

(Leq-left L-pen-sym (Gamma qb))
#|
;; Again, the differentiation operator is treating [thetadot] like a constant...
(down 0 0 (* m (expt l 2)))
|#


(pe (((Lagrange-equations (L-pendulum 'm 'l 'g)) qb) 't))
#|
(+ (* g l m (sin (theta t))) (* (expt l 2) m (((expt D 2) theta) t)))
|#


;; C

(define ((L-sphere-particle m R) local)
  (let ((pos (coordinate local))
	(vel (velocity local)))
    (let ((theta (ref pos 0))
	  (phi   (ref pos 1))
	  (alpha (ref vel 0))
	  (beta  (ref vel 1)))
      (* 1/2 m (square R) (+ (square alpha)
			     (square (* beta (sin theta))))))))


(define qc (up (lf 'theta) (lf 'phi)))
(se ((Gamma qc) 't))

(se (((Lagrange-equations (L-sphere-particle 'm 'R)) qc) 't))
#|
(down
 (+ (* -1 (expt R 2) m (cos (theta t)) (sin (theta t)) (expt ((D phi) t) 2))
    (* (expt R 2) m (((expt D 2) theta) t)))
 (+
  (* 2 (expt R 2) m (sin (theta t)) ((D theta) t) (cos (theta t)) ((D phi) t))
  (* (expt R 2) m (expt (sin (theta t)) 2) (((expt D 2) phi) t))))
|#