[lisplab-cvs] r204 - in trunk: . src/list src/vector2

[jivestgarden at common-lisp.net]

Author: jivestgarden
Date: Sun Oct  9 06:50:13 2011
New Revision: 204

Log:
Restructured

Added:
   trunk/src/list/level2-list.lisp
      - copied unchanged from r200, trunk/src/vector2/level2-list.lisp
Deleted:
   trunk/src/vector2/level2-list.lisp
   trunk/src/vector2/level2-vector.lisp
Modified:
   trunk/lisplab.asd
   trunk/src/vector2/vector2-generic.lisp

Modified: trunk/lisplab.asd
==============================================================================
--- trunk/lisplab.asd	Sun Oct  9 06:45:43 2011	(r203)
+++ trunk/lisplab.asd	Sun Oct  9 06:50:13 2011	(r204)
@@ -114,11 +114,15 @@
      ;; Level2, spezialized
      (:file "vector2-dge")
      (:file "vector2-zge")
-
-     (:file "level2-list")
-     (:file "level2-vector")
      ))
 
+
+   (:module :src/list
+    :depends-on (:src/core)
+    :serial t
+    :components ((:file "level2-list")))
+
+
    (:module :src/matrix2
     :depends-on (:src/core :src/vector1 :src/matrix1 :src/util)
     :serial t

Copied: trunk/src/list/level2-list.lisp (from r200, trunk/src/vector2/level2-list.lisp)
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/src/list/level2-list.lisp	Sun Oct  9 06:50:13 2011	(r204, copy of r200, trunk/src/vector2/level2-list.lisp)
@@ -0,0 +1,74 @@
+;;; Lisplab, level2-list.lisp
+;;; Basic algebra stuff for lists
+
+;;; Copyright (C) 2009 Joern Inge Vestgaarden
+;;;
+;;; 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.
+
+;;; Should it be somewhere else. It has nothing to do with matrices, really. 
+
+(in-package :lisplab)
+
+(defmethod convert ((x cons) type)
+  (let* ((cols (length (car x)))
+	 (rows (length x))
+	 (m (make-matrix-instance type (list rows cols) 0)))
+    (fill-matrix-with-list m x)
+    m))
+
+(defmethod .mul ((x cons) (y cons))
+  (mapcar #'.mul x y))
+
+(defmethod .mul ((x cons) (y number))
+  (mapcar (lambda (x) (.mul x y)) x))
+
+(defmethod .mul ((x number) (y cons))
+  (mapcar (lambda (y) (.mul x y)) y))
+
+(defmethod .add ((x cons) (y cons))
+  (mapcar #'.add x y))
+
+(defmethod .add ((x cons) (y number))
+  (mapcar (lambda (x) (.add x y)) x))
+
+(defmethod .add ((x number) (y cons))
+  (mapcar (lambda (y) (.add x y)) y))
+
+(defmethod .sub ((x cons) (y cons))
+  (mapcar #'.sub x y))
+
+(defmethod .sub ((x cons) (y number))
+  (mapcar (lambda (x) (.sub x y)) x))
+
+(defmethod .sub ((x number) (y cons))
+  (mapcar (lambda (y) (.sub x y)) y))
+
+(defmethod .div ((x cons) (y cons))
+  (mapcar #'.div x y))
+
+(defmethod .div ((x cons) (y number))
+  (mapcar (lambda (x) (.div x y)) x))
+
+(defmethod .div ((x number) (y cons))
+  (mapcar (lambda (y) (.div x y)) y))
+
+(defmethod .expt ((x cons) (y cons))
+  (mapcar #'.expt x y))
+
+(defmethod .expt ((x cons) (y number))
+  (mapcar (lambda (x) (.expt x y)) x))
+
+(defmethod .expt ((x number) (y cons))
+  (mapcar (lambda (y) (.expt x y)) y))

Modified: trunk/src/vector2/vector2-generic.lisp
==============================================================================
--- trunk/src/vector2/vector2-generic.lisp	Sun Oct  9 06:45:43 2011	(r203)
+++ trunk/src/vector2/vector2-generic.lisp	Sun Oct  9 06:50:13 2011	(r204)
@@ -30,6 +30,27 @@
 
 (in-package :lisplab)
 
+;;; For general vector
+
+(defmethod vdot ((a vector-base) (b vector-base))
+  (msum (.* a b)))
+
+(defmethod vcross :before ((a vector-base) (b vector-base))
+  (assert (= (size a) (size b) 3)))
+
+(defmethod vcross ((a vector-base) (b vector-base))
+  (let ((out (mcreate a)))
+    (setf (vref out 0) (.- (.* (vref a 1) (vref b 2))
+			   (.* (vref a 2) (vref b 1)))
+	  (vref out 1) (.- (.* (vref a 2) (vref b 0))
+			   (.* (vref a 0) (vref b 2)))
+	  (vref out 2) (.- (.* (vref a 0) (vref b 1))
+			   (.* (vref a 1) (vref b 0))))
+    out))
+
+(defmethod vnorm ((a vector-base))
+  (.sqrt (vdot (.conj a) a)))
+
 ;;; Vector operations (ignore structure)
 
 (defmethod copy ((a vector-base))