;    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 vector-spaces "generics.ss"
  ;; We don't use any of the exports of tuples.ss, but we want the 
  ;; generic functions from tuples to be initialized before anyone uses this 
  ;; module.
  (require "operators.ss" "tuples.ss") 
  (provide <vector-space> <basis> <vector-space-vector> <vector-space-linear-operator>
           transform-vector/components)
  
  (defclass <vector-space> ()
    dim standard-basis                             
    :auto #t :print #t)
  
  (defclass <basis> ()
    vector-space vector->components components->vector
    :auto #t :print #t)
  
  (defclass <vector-space-vector> ()
    components vector-space
    :auto #t :print #t)
  
  (defentityclass <vector-space-linear-operator> (<linear-operator>)
    basis components
    :auto #t :print #t)    
            
  (defmethod (initialize (vs <vector-space>) args)
    (call-next-method)
    (if (not (getarg args :standard-basis #f))
        (slot-set! vs
                   'standard-basis
                   (make <basis>
                         :vector-space vs
                         :vector->components (lambda (v) (slot-ref v 'components))
                         :components->vector (lambda (c) (make <vector-space-vector>
                                                               :vector-space vs
                                                               :components c))))))
  
  (defmethod (initialize (op <vector-space-linear-operator>) args)
    (call-next-method)
    (with-slots op ((op-b 'basis) (op-c 'components))
      (set-instance-proc!
       op
       (lambda (v)
         (with-slots v ((v-vs 'vector-space))
           (if (not (eq? v-vs (slot-ref op-b 'vector-space)))
               (error 'apply-vector-space-linear-operator
                      "cannot apply linear operator on vector space ~a to vector in vector space ~a"
                      (slot-ref op-b 'vector-space)
                      v-vs)
               (transform-vector/components op-c op-b v)))))))
  
  (defgeneric (transform-vector/components comp basis v))
  (defmethod (transform-vector/components comp basis (v <vector-space-vector>))
    (with-slots basis ((v->c 'vector->components) (c->v 'components->vector))
      (let ((vc (v->c v)))
        (c->v (* comp vc)))))
  
  (defmethod (plus (v <vector-space-vector>)) v)
  (defmethod (add (v1 <vector-space-vector>)
                  (v2 <vector-space-vector>))
    (with-slots v1 ((comp1 'components) (vs1 'vector-space))
      (with-slots v2 ((comp2 'components) (vs2 'vector-space))
        (if (not (eq? vs1 vs2))
            (error '+ "cannot add vector in space ~a to vector in space ~a" vs1 vs2)
            (make <vector-space-vector>
                  :components (+ comp1 comp2)
                  :vector-space vs1)))))
  (defmethod (minus (v <vector-space-vector>)) 
    (make <vector-space-vector>
          :components (- (slot-ref v 'components))
          :vector-space (slot-ref v 'vector-space)))
  (defmethod (sub (v1 <vector-space-vector>)
                  (v2 <vector-space-vector>))
    (with-slots v1 ((comp1 'components) (vs1 'vector-space))
      (with-slots v2 ((comp2 'components) (vs2 'vector-space))
        (if (not (eq? vs1 vs2))
            (error '- "cannot subtract vector in space ~a from vector in space ~a" vs1 vs2)
            (make <vector-space-vector>
                  :components (- comp1 comp2)
                  :vector-space vs1)))))
  (defmethod (times (v <vector-space-vector>)) v)
  (defmethod (mul (v <vector-space-vector>) (x <number>))
    (make <vector-space-vector>
          :components (* x (slot-ref v 'components))
          :vector-space (slot-ref v 'vector-space)))
  (defmethod (mul (x <number>) (v <vector-space-vector>))
    (mul v x))
  (defmethod (div (v <vector-space-vector>) (x <number>))
    (make <vector-space-vector>
          :components (/ (slot-ref v 'components) x)
          :vector-space (slot-ref v 'vector-space)))
  
  (add-equals?-method <vector-space-vector> class+slots-equals?))