(define ((vector-field->vector-field-over-map mu:N->M) v-on-M)
  (procedure->vector-field
    (lambda (f-on-M)
      (compose (v-on-M f-on-M) mu:N->M))))

(define (((differential mu) v) f)
  (v (compose f mu)))

(define ((form-field->form-field-over-map mu:N->M) w-on-M)
  (define (make-fake-vector-field V-over-mu n)
    (define ((u f) m)
      ((V-over-mu f) n))
    (procedure->vector-field u))
  (procedure->nform-field
    (lambda vectors-over-map
      (lambda (n)
        ((apply w-on-M
                (map (lambda (V-over-mu)
                       (make-fake-vector-field V-over-mu n))
                     vectors-over-map))
         (mu:N->M n))))
    (get-rank w-on-M)))

(define S2 (make-manifold S^2 2 3))
(define S2-spherical
  (coordinate-system-at 'spherical 'north-pole S2))
(define-coordinates (up theta phi) S2-spherical)
(define S2-basis (coordinate-system->basis S2-spherical))

(define-coordinates t R1-rect)

(define mu
  (compose (point S2-spherical)
           (up (literal-function 'theta)
               (literal-function 'phi))
           (chart R1-rect)))

(define S2-basis-over-mu
  (basis->basis-over-map mu S2-basis))

(define h
  (literal-manifold-function 'h-spherical S2-spherical))

(((basis->vector-basis S2-basis-over-mu) h)
 ((point R1-rect) 't0))
; (down (((partial 0) h-spherical) (up (theta t0) (phi t0)))
;       (((partial 1) h-spherical) (up (theta t0) (phi t0))))


(((basis->1form-basis S2-basis-over-mu)
  (basis->vector-basis S2-basis-over-mu))
 ((point R1-rect) 't0))
; (up (down 1 0) (down 0 1))

(((basis->1form-basis S2-basis-over-mu)
  ((differential mu) d/dt))
 ((point R1-rect) 't0))
; (up ((D theta) t0) ((D phi) t0))

(define ((pullback-function mu:N->M) f-on-M)
  (compose f-on-M mu:N->M))

(define ((pushforward-vector mu:N->M mu^-1:M->N) v-on-N)
  (procedure->vector-field
    (lambda (f)
      (compose (v-on-N (compose f mu:N->M)) mu^-1:M->N))))

(define (pullback-vector-field mu:N->M mu^-1:M->N)
  (pushforward-vector mu^-1:M->N mu:N->M))

(define ((pullback-form mu:N->M) omega-on-M)
  (let ((k (get-rank omega-on-M)))
    (if (= k 0)
        ((pullback-function mu:N->M) omega-on-M)
        (procedure->nform-field
          (lambda vectors-on-N
            (apply ((form-field->form-field-over-map mu:N->M)
                    omega-on-M)
                   (map (differential mu:N_>M) vectors-on-N)))
          k))))

(define mu (literal-manifold-map 'MU R2-rect R3-rect))

(define f (literal-manifold-function 'f-rect R3-rect))
(define X (literal-vector-field 'X-rect R2-rect))

(((- ((pullback mu) (d f)) (d ((pullback mu) f))) X)
 ((point R2-rect) (up 'x0 'y0)))
; 0

(define theta (literal-1form-field 'THETA R3-rect))
(define Y (literal-vector-field 'Y-rect R2-rect))

(((- ((pullback mu) (d theta)) (d ((pullback mu) theta))) X Y)
 ((point R2-rect) (up 'x0 'y0)))
; 0


;;; Exersize 6.1: Velocities on a Globe

; a)

; b)