;    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 "generics.ss"
  (require "tuples.ss"
           "manifolds.ss"
           "maps.ss"
           "memoization.ss")
  
  (provide <lie-group> lie-group? <lie-group-element> lie-group-element?
           natural-extension lie-algebra-bracket structure-constants
           phi psi)
  
  (defclass <lie-group> (<manifold>)
    multiplication identity inverse
    :auto #t :print #t)
  
  (defclass <lie-group-element> ()
    point group
    :auto #t :print #t)
  
  (defmethod (times (g <lie-group-element>)) g)
  (defmethod (mul (g1 <lie-group-element>) (g2 <lie-group-element>))
    (with-slots g1 ((G1 'group))
      (with-slots g2 ((G2 'group))
        (if (not (eq? G1 G2))
            (raise-type-error '* "trying to multiply elements of different lie groups" (list g1 g2))
            ((slot-ref G1 'multiplication) g1 g2)))))
  
  (defmethod (invert (g <lie-group-element>))
    (with-slots g (group)
      (with-slots group (inverse)
        (inverse g))))
  
  (define ((natural-extension G) v)
    (define ((proc f) g)
      ((v (compose f (phi g))) (slot-ref G 'identity)))
    (procedure->vector-field proc))
  
  (define (lie-algebra-bracket G)
    (let ((ext (natural-extension G)))
      (lambda (v1 v2)
        (lie-bracket (ext v1) (ext v2)))))

  (define (phi g)
    (lambda (g2) (* g g2)))
  
  (define (psi g)
    (lambda (g2) (* g2 g)))
  
  (define (structure-constants G chart)
    (let ((coord-vecs (chart->coordinate-vector-fields chart))
          (brk (lie-algebra-bracket G))
          (ext (natural-extension G)))
      (tuple-map 
       (lambda (b tb)
         (tuple-map 
          (lambda (c tc)
            ((vector-field->component-field 
              (brk tb tc) 
              chart) 
             (slot-ref G 'identity)))
          coord-vecs))
       coord-vecs))))