;    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-test "generics.ss"
  (require "test.ss" "vector-spaces.ss" "tuples.ss")
  
  (provide vector-spaces-test-suite)
  
  (define vector-spaces-test-suite
    (let ((R2 (make <vector-space> :dim 2)))
      (with-slots (slot-ref R2 'standard-basis) (vector->components components->vector)
        (let ((c1 (up (random) (random)))
              (c2 (up (random) (random))))
          (let ((v1 (components->vector c1))
                (v2 (components->vector c2)))
            (let ((swapped-basis (make <basis>
                                       :vector-space R2
                                       :vector->components (lambda (v)
                                                             (let ((c (vector->components v)))
                                                               (up (ref c 1) (ref c 0))))
                                       :components->vector (lambda (c)
                                                             (components->vector 
                                                              (up (ref c 1) (ref c 0)))))))
              (let ((inverse-swap (make <vector-space-linear-operator>
                                        :basis swapped-basis
                                        :components (down (up 0 1)
                                                          (up 1 0)))))
                (test-suite
                 "vector-spaces.ss test suite"
                 (test-case
                  "linearity of vectors"
                  (check-equals? (+ v1 v2)
                                 (components->vector (+ c1 c2)))
                  (check-equals? (+ (* 2 v1) (/ v2 3))
                                 (components->vector (+ (* 2 c1) (/ c2 3)))))
                 (test-case
                  "linear operators action and linearity"
                  (check-equals? (inverse-swap ((slot-ref swapped-basis 'components->vector) c1))
                                 v1)
                  (check-equals? ((+ inverse-swap inverse-swap)
                                  ((slot-ref swapped-basis 'components->vector) c1))
                                 (* v1 2))))))))))))