;    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 "generics.ss"
  (require "vector-spaces.ss" "lie-groups.ss" "generics.ss"
           "manifolds.ss" "maps.ss")
  
  (provide <representation> <representation-object> gauge-transform
           gauge-generator-transform component-field->mu
           component-field->mu-tilde ->representation-object!
           adjoint-representation)
  
  (defclass <representation> ()
    mu mu-tilde
    :auto #t :print #t)
  
  ;; Representation objects are really a mixin.  To enhance some object to be a rep, 
  ;; simply declare a new class which has as supers (<old-object-class> <representation-object>).
  ;; The order is *vitally* important here.  It means that your object is primarily of <old-object-class>
  ;; so that all the generic functions still operate correctly on it.  The aroundmethods below wrap the 
  ;; generic math functions so that operations on an object in a rep will preserve the rep.
  (defclass <representation-object> ()
    representation
    :auto #t :print #t)
  
  (defclass <adjoint-representation-object> (<vector-field> <representation-object>)
    :auto #t :print #t)
  
  (defclass <vector-space-representation-object> (<vector-space-vector> <representation-object>)
    :auto #t :print #t)
  
  (defgeneric (->representation-object! v rep))
  (defmethod (->representation-object! (v <vector-space-vector>) rep)
    (change-class! v <vector-space-representation-object> :representation rep)
    v)
  (defmethod (->representation-object! (v <vector-field>) rep)
    (change-class! v <adjoint-representation-object> :representation rep)
    v)
  
  (defaroundmethod (transform-vector/components comp basis (ro <representation-object>))
    (->representation-object! (call-next-method) (slot-ref ro 'representation)))
  
  (defaroundmethod (add (ro1 <representation-object>)
                        (ro2 <representation-object>))
    (with-slots ro1 ((rep1 'representation))
      (with-slots ro2 ((rep2 'representation))
        (if (not (eq? rep1 rep2))
            (error '+ "objects in different representations: ~a ~a" ro1 ro2)
            (->representation-object! (call-next-method) (slot-ref ro1 'representation))))))
  (defaroundmethod (minus (ro <representation-object>))
    (->representation-object! (call-next-method) (slot-ref ro 'representation)))
  (defaroundmethod (sub (ro1 <representation-object>)
                        (ro2 <representation-object>))
    (with-slots ro1 ((rep1 'representation))
      (with-slots ro2 ((rep2 'representation))
        (if (not (eq? rep1 rep2))
            (error '- "objects in different representations: ~a ~a" ro1 ro2)
            (->representation-object! (call-next-method) (slot-ref ro1 'representation))))))
  (defaroundmethod (mul (ro <representation-object>)
                        (x <number>))
    (->representation-object! (call-next-method) (slot-ref ro 'representation)))
  (defaroundmethod (mul (x <number>)
                        (ro <representation-object>))
    (->representation-object! (call-next-method) (slot-ref ro 'representation)))
  (defaroundmethod (div (ro <representation-object>)
                        (x <number>))
    (->representation-object! (call-next-method) (slot-ref ro 'representation)))
  
  (define ((gauge-transform g) ro)
    (with-slots ro (representation)
      (with-slots representation (mu)
        ((mu g) ro))))
  
  (define ((gauge-generator-transform t) ro)
    (with-slots ro (representation)
      (with-slots representation (mu-tilde)
        ((mu-tilde t) ro))))
  
  (define (component-field->mu G comp-field basis)
    (lambda (g) 
      (make <vector-space-linear-operator>
            :basis basis
            :components (comp-field g))))
  
  (define (component-field->mu-tilde G comp-field basis)
    (lambda (t)
      (make <vector-space-linear-operator>
            :basis basis
            :components ((((natural-extension G) t) 
                          comp-field) 
                         (slot-ref G 'identity)))))
  
  (define (adjoint-representation G)
    (letrec ((rep (make <representation>
                        :mu (lambda (g)
                              (lambda (t)
                                (->representation-object! 
                                 ((pushforward (psi (/ g)) (psi g)) t)
                                 rep)))
                        :mu-tilde (lambda (t1)
                                    (lambda (t2)
                                      (->representation-object!
                                       ((lie-algebra-bracket G) t1 t2)
                                       rep))))))
      rep)))