;    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 lie-groups-test "generics.ss"
  (require "test.ss" "lie-groups.ss" "tuples.ss" "manifolds.ss")
  
  (provide lie-groups-test-suite)
   
  (define-values (R6-chart R6)
    (recursive-make (R6-chart <chart> 
                              :dim 6 
                              :chi (lambda (m) (slot-ref m 'point)) 
                              :chiinv (lambda (x) 
                                        (make <lie-group-element> 
                                              :point x
                                              :group R6)))
                    (R6 <lie-group>
                        :standard-chart R6-chart
                        :identity ((slot-ref R6-chart 'chiinv) (up 0 0 0 0 0 0))
                        :multiplication (let ((chi (slot-ref R6-chart 'chi))
                                              (chiinv (slot-ref R6-chart 'chiinv)))
                                          (lambda (g1 g2)
                                            (chiinv (+ (chi g1) (chi g2)))))
                        :inverse (let ((chi (slot-ref R6-chart 'chi))
                                       (chiinv (slot-ref R6-chart 'chiinv)))
                                   (lambda (g)
                                     (chiinv (- (chi g))))))))
  
  (define R6-chi (slot-ref R6-chart 'chi))
  (define R6-chiinv (slot-ref R6-chart 'chiinv))

  (define-named-coordinates (x y z u v w) R6-chart)
  
  (define lie-groups-test-suite
    (test-suite
     "lie-groups.ss test suite"
     (test-case 
      "(* g g^-1) ?=? identity"
      (let ((g (R6-chiinv (up 1 2 3 4 5 6))))
        (check-equals? (R6-chi (* g (/ g)))
                       (R6-chi (slot-ref R6 'identity)))))
     (test-case
      "Extend d/dx equals d/dx"
      (let ((ext (natural-extension R6)))
        (let ((ed/dx (ext d/dx))
              (e (slot-ref R6 'identity)))
          (let ((d/dxc ((vector-field->component-field d/dx R6-chart) e))
                (ed/dxc ((vector-field->component-field ed/dx R6-chart) e)))
            (check-equals? d/dxc ed/dxc))
          (let ((m (R6-chiinv (up 23 578 82 02 5234 876))))
            (let ((d/dxc ((vector-field->component-field d/dx R6-chart) m))
                  (ed/dxc ((vector-field->component-field ed/dx R6-chart) m)))
              (check-equals? d/dxc ed/dxc))))))
     (test-case
      "Is R6 abelian?"
      (let ((f (structure-constants R6 R6-chart)))
        (check-equals? f
                       (* f 0)))))))