;    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-group-representations-test "generics.ss"
  (require "test.ss" "tuples.ss" "lie-group-SO3.ss" 
           "lie-group-representations.ss" "vector-spaces.ss" 
           "quaternions.ss" "lie-groups.ss" "manifolds.ss")
  (provide lie-group-representations-test-suite)
  
  ;; This code works better close to the identity, so we only produce 
  ;; small random numbers.
  (define (my-random)
    (/ (random)
       10))
  
  (define lie-group-representations-test-suite
    (let ((R3 (make <vector-space> :dim 3)))
      (with-slots R3 ((basis 'standard-basis))
        (with-slots basis ((v->c 'vector->components) (c->v 'components->vector))
          (with-slots SO3-rectangular-angles-chart (chi chiinv)
            (let ((R-comp-field
                   (lambda (g)
                     (let ((x-y-z (chi g)))
                       (let ((x (ref x-y-z 0))
                             (y (ref x-y-z 1))
                             (z (ref x-y-z 2)))
                         (let ((cx (cos x))
                               (cy (cos y))
                               (cz (cos z))
                               (sx (sin x))
                               (sy (sin y))
                               (sz (sin z)))
                           (let ((result 
                                  (down 
                                   (up (* cy cz) (* cy sz) (- sy))
                                   (up (- (* cz sx sy) (* cx sz)) 
                                       (+ (* cx cz) (* sx sy sz))
                                       (* cy sx))
                                   (up (+ (* cx cz sy) (* sx sz))
                                       (- (* cx sy sz) (* cz sx))
                                       (* cx cy)))))
                             result)))))))
              (let ((3v-rep 
                     (make <representation> 
                           :mu (component-field->mu SO3 R-comp-field basis)
                           :mu-tilde (component-field->mu-tilde SO3 R-comp-field basis)))
                    (ad-rep (adjoint-representation SO3)))
                (define-named-coordinates (x y z) SO3-rectangular-angles-chart)
                (let ((g1 (chiinv (up (my-random) (my-random) (my-random))))
                      (g2 (chiinv (up (my-random) (my-random) (my-random))))
                      (t1 (+ (* (my-random) d/dx)
                             (* (my-random) d/dy)
                             (* (my-random) d/dz)))
                      (t2 (+ (* (my-random) d/dx)
                             (* (my-random) d/dy)
                             (* (my-random) d/dz)))
                      (v (->representation-object! 
                          (c->v (up (my-random) (my-random) (my-random)))
                          3v-rep))
                      (ad-v (->representation-object! 
                             ((natural-extension SO3)
                              (+ (* (my-random) d/dx)
                                 (* (my-random) d/dy)
                                 (* (my-random) d/dz)))
                             ad-rep)))
                  (test-suite
                   "lie-group-representations.ss test suite"
                   (test-case
                    "operator composition <=> group multiplication"
                    (check-tuple-close?
                     1e-6
                     (v->c ((compose (gauge-transform g1) 
                                     (gauge-transform g2)) 
                            v))
                     (v->c ((gauge-transform (* g1 g2)) v))))
                   (test-case
                    "generator matrix commutator <=> generator lie-bracket"
                    (check-tuple-close?
                     1e-6
                     (v->c (- ((compose 
                                (gauge-generator-transform t1) 
                                (gauge-generator-transform t2)) 
                               v)
                              ((compose 
                                (gauge-generator-transform t2) 
                                (gauge-generator-transform t1)) 
                               v)))
                     (v->c ((gauge-generator-transform 
                             ((lie-algebra-bracket SO3) t1 t2)) 
                            v))))
                   (test-case 
                    "adjoint rep composition <=> group multiplication"
                    (check-tuple-close?
                     1e-6
                     (up 0 0 0)
                     ((vector-field->component-field
                       (- ((compose (gauge-transform g2) (gauge-transform g1))
                           ad-v)
                          ((gauge-transform (* g2 g1)) ad-v))
                       SO3-rectangular-angles-chart)
                      (slot-ref SO3 'identity))))
                   (test-case
                    "adjoint rep generator transform respects commutator"
                    (check-tuple-close? 
                     1e-6
                     (up 0 0 0)
                     ((vector-field->component-field
                       (- (- ((compose (gauge-generator-transform t1) 
                                       (gauge-generator-transform t2)) 
                              ad-v)
                             ((compose (gauge-generator-transform t2) 
                                       (gauge-generator-transform t1)) 
                              ad-v))
                          ((gauge-generator-transform
                            ((lie-algebra-bracket SO3) t1 t2)) 
                           ad-v))
                       SO3-rectangular-angles-chart)
                      (slot-ref SO3 'identity))))))))))))))