;    Copyright (C) 2006  Will M. Farr <farr@mit.edu>
;
;    This program is free software; you can redistribute it and/or modify
;    it under the terms of the GNU General Public License as published by
;    the Free Software Foundation; either version 2 of the License, or
;    (at your option) any later version.
;
;    This program is distributed in the hope that it will be useful,
;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;    GNU General Public License for more details.
;
;    You should have received a copy of the GNU General Public License along
;    with this program; if not, write to the Free Software Foundation, Inc.,
;    51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.


(module manifolds-test "generics.ss"
  (require "manifolds.ss")
  (require "tuples.ss")
  (require "test.ss")
  
  (provide manifolds-test-suite)
;  (provide (all-defined))
  
  (define rectangular 
    (make <chart>
          :dim 3
          :chi (lambda (m) m)                 
          :chiinv (lambda (m) m)))
  
  (define R3 (make <manifold> :standard-chart rectangular
                   :dim 3))
  
  (define-named-coordinates (x y z) (slot-ref R3 'standard-chart))
  (define R3-chi (slot-ref (slot-ref R3 'standard-chart) 'chi))
  (define R3-chiinv (slot-ref (slot-ref R3 'standard-chart) 'chiinv))
  
  (define cylindrical (make <chart> 
                            :chi (lambda (m)
                                   (let ((x (R3-chi m)))
                                     (let ((r (sqrt (+ (square (ref x 0))
                                                       (square (ref x 1)))))
                                           (theta (atan2 (ref x 1) (ref x 0)))
                                           (z (ref x 2)))
                                       (up r theta z))))
                            :chiinv (lambda (x)
                                      (let ((r (ref x 0))
                                            (theta (ref x 1))
                                            (z (ref x 2)))
                                        (R3-chiinv (up (* r (cos theta))
                                                       (* r (sin theta))
                                                       z))))
                            :dim 3))
  (define-named-coordinates (R Theta Z) cylindrical)
  
  (define spherical (make <chart> 
                          :chi (lambda (m)
                                 (let ((x (R3-chi m)))
                                   (let ((r (sqrt (* x (flip x))))
                                         (theta (atan2 (ref x 1) (ref x 0)))
                                         (phi (atan2 (ref x 2) (sqrt (+ (square (ref x 0))
                                                                        (square (ref x 1)))))))
                                     (up r theta phi))))
                          :chiinv (lambda (x)
                                    (let ((r (ref x 0))
                                          (theta (ref x 1))
                                          (phi (ref x 2)))
                                      (R3-chiinv (up (* r (cos theta) (sin phi))
                                                     (* r (sin theta) (sin phi))
                                                     (* r (cos phi))))))
                          :dim 3))
  (define-named-coordinates (r theta phi) spherical)
  
  (define manifolds-test-suite
    (test-suite 
     "manifolds.ss test suite"
     (test-case
      "R3 forms on vectors"
      (check = ((dx d/dx) (R3-chiinv (up 1 2 3))) 1)
      (check = ((dz d/dy) (R3-chiinv (up 2 3 4))) 0)
      (check (close? 1e-6) ((dR d/dR) (R3-chiinv (up 2 3 4))) 1))
     (test-case
      "R3 vectors on coordinate functions"
      (check (close? 1e-6) ((d/dR x) ((slot-ref cylindrical 'chiinv) (up 1.234 4.8234 1.24))) (cos 4.8234)))
     (test-case
      "Coordinate components of vectors"
      (check-equals? ((vector-field->component-field d/dx rectangular) (R3-chiinv (up 0 0 0)))
                     (up 1 0 0)))
     (test-case 
      "Coordinate components of vectors"
      (check (close? 1e-6)
             (ref ((vector-field->component-field d/dr spherical) (R3-chiinv (up 5 4 3))) 0)
             1))
     (test-case
      "Jacobi identity."
      (let ((a-comp (up (random) (random) (random)))
            (b-comp (up (random) (random) (random)))
            (c-comp (up (random) (random) (random))))
        (let ((a (component-field->vector-field 
                  (lambda (m) (* (R m) a-comp))
                  rectangular))
              (b (component-field->vector-field
                  (lambda (m) (* (r m) b-comp))
                  rectangular))
              (c (component-field->vector-field
                  (lambda (m) (* (theta m) c-comp))
                  rectangular)))
          (check (tuple-close? 1e-6)
                 ((vector-field->component-field
                   (+ (lie-bracket a (lie-bracket b c))
                      (lie-bracket b (lie-bracket c a))
                      (lie-bracket c (lie-bracket a b)))
                   rectangular)
                  (up (random) (random) (random)))
                 (up 0.0 0.0 0.0))))))))