From jivestgarden at common-lisp.net Wed Sep 1 18:51:00 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Wed, 01 Sep 2010 14:51:00 -0400 Subject: [lisplab-cvs] r178 - in trunk/src: linalg matrix Message-ID: Author: jivestgarden Date: Wed Sep 1 14:50:59 2010 New Revision: 178 Log: Applied patches from Jan Moringen Modified: trunk/src/linalg/level3-linalg-dge.lisp trunk/src/linalg/level3-linalg-generic.lisp trunk/src/linalg/level3-linalg-interface.lisp trunk/src/matrix/level1-funmat.lisp trunk/src/matrix/level2-generic.lisp trunk/src/matrix/level2-interface.lisp trunk/src/matrix/level2-matrix-dge.lisp trunk/src/matrix/level2-operator.lisp trunk/src/matrix/level2-view.lisp Modified: trunk/src/linalg/level3-linalg-dge.lisp ============================================================================== --- trunk/src/linalg/level3-linalg-dge.lisp (original) +++ trunk/src/linalg/level3-linalg-dge.lisp Wed Sep 1 14:50:59 2010 @@ -1,4 +1,4 @@ -;;; Lisplab, level3-generic.lisp +;;; Lisplab, level3-linalg-dge.lisp ;;; Non-spcialized matrix methods. ;;; Copyright (C) 2009 Joern Inge Vestgaarden @@ -150,22 +150,21 @@ (LU-solve!-blas-real LU b2 0)))) (defun minv!-blas-real (A) - (let ((LU (copy A)) - (N (rows A))) - (destructuring-bind (LU p det) - (LU-factor! LU (make-permutation-vector N)) - (mfill A 0) - (dotimes (i N) - (setf (mref A i (vref p i)) 1) - (LU-solve!-blas-real LU A (vref p i))))) + (let ((N (rows A))) + (if (= N 1) + (setf (mref A 0 0) (/ 1 (mref A 0 0))) + (let ((LU (copy A))) + (destructuring-bind (LU p det) + (LU-factor! LU (make-permutation-vector N)) + (declare (ignore det)) + (mfill A 0) + (dotimes (i N) + (setf (mref A i (vref p i)) 1) + (LU-solve!-blas-real LU A (vref p i))))))) A) - + (defmethod minv! ((A matrix-base-dge)) (minv!-blas-real A)) (defmethod minv ((A matrix-base-dge)) (minv! (copy A))) - - - - \ No newline at end of file Modified: trunk/src/linalg/level3-linalg-generic.lisp ============================================================================== --- trunk/src/linalg/level3-linalg-generic.lisp (original) +++ trunk/src/linalg/level3-linalg-generic.lisp Wed Sep 1 14:50:59 2010 @@ -1,4 +1,4 @@ -;;; Lisplab, level3-generic.lisp +;;; Lisplab, level3-linalg-generic.lisp ;;; Non-spcialized matrix methods. ;;; Copyright (C) 2009 Joern Inge Vestgaarden Modified: trunk/src/linalg/level3-linalg-interface.lisp ============================================================================== --- trunk/src/linalg/level3-linalg-interface.lisp (original) +++ trunk/src/linalg/level3-linalg-interface.lisp Wed Sep 1 14:50:59 2010 @@ -1,4 +1,4 @@ -;;; Lisplab, level2-description.lisp +;;; Lisplab, level3-linalg-interface.lisp ;;; Matrix generic functions. ;;; Copyright (C) 2009 Joern Inge Vestgaarden Modified: trunk/src/matrix/level1-funmat.lisp ============================================================================== --- trunk/src/matrix/level1-funmat.lisp (original) +++ trunk/src/matrix/level1-funmat.lisp Wed Sep 1 14:50:59 2010 @@ -62,3 +62,17 @@ (defmethod (setf vref) (value (f function-matrix) idx) (funcall (function-matrix-set-vref f) value f idx)) + + +;;; constructor +;; + +(defmethod mcreate ((a function-matrix) + &optional (value 0) (dim (dim a))) + "DOC" + (make-matrix-instance + (list (element-type-spec a) + (structure-spec a) + :any) + dim + value)) Modified: trunk/src/matrix/level2-generic.lisp ============================================================================== --- trunk/src/matrix/level2-generic.lisp (original) +++ trunk/src/matrix/level2-generic.lisp Wed Sep 1 14:50:59 2010 @@ -18,17 +18,17 @@ ;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -;;; Implementation principles: -;;; - all operators in this film should spezialie for matrix-base and only -;;; assume level0 and level1 generic function (mref, vref, size, dim, etc.) -;;; - The methods in this file should not assume anything about implementation of -;;; the matrices. -;;; - The methds in this file should be as short and clean as possible. +;;; Implementation principles: +;;; - all operators in this film should specialize for matrix-base and only +;;; assume level0 and level1 generic function (mref, vref, size, dim, etc.) +;;; - The methods in this file should not assume anything about implementation of +;;; the matrices. +;;; - The methods in this file should be as short and clean as possible. ;;; - Avoid optimizations (Exept: call other level2 functions, such as mmap, as much as possible.) -;;; +;;; -(in-package :lisplab) +(in-package :lisplab) ;;; This is OK, but could be optimzied! (defmacro w/mat (a args &body body) Modified: trunk/src/matrix/level2-interface.lisp ============================================================================== --- trunk/src/matrix/level2-interface.lisp (original) +++ trunk/src/matrix/level2-interface.lisp Wed Sep 1 14:50:59 2010 @@ -133,22 +133,22 @@ (:documentation "Sums all matrix elements.")) (defgeneric mmin (m) - (:documentation "Retuns the smalles matrix element and its vector index.")) + (:documentation "Returns the smallest matrix element and its vector index.")) (defgeneric mmax (m) - (:documentation "Retuns the largest matrix element and its vector index.")) + (:documentation "Returns the largest matrix element and its vector index.")) (defgeneric mabsmin (m) - (:documentation "Retuns the matrix element closest to zero and its vector index.")) + (:documentation "Returns the matrix element closest to zero and its vector index.")) (defgeneric mabsmax (m) - (:documentation "Retuns the matrix element with largest absolute value and its vector index.")) + (:documentation "Returns the matrix element with largest absolute value and its vector index.")) (defgeneric mminmax (m) - (:documentation "Retuns a list with (minumum maximum)")) + (:documentation "Returns a list with (minimum maximum)")) (defgeneric circ-shift (m shifts) - (:documentation "Shifts the matrix with periodic indecices")) + (:documentation "Shifts the matrix with periodic indices")) (defgeneric pad-shift (m shifts &optional value) (:documentation "Shifts the matrix and pads results")) @@ -156,10 +156,10 @@ (defgeneric mreverse (m) (:documentation "Reverts elements of matrix or vector. Similar to cl:reverse")) -;; Some vector functions +;; Some vector functions (defgeneric vcross (a b) - (:documentation "Cross product. Must be a vecotors of length 3")) + (:documentation "Cross product. Must be a vectors of length 3")) (defgeneric vdot (a b) (:documentation "Dot product of vectors")) Modified: trunk/src/matrix/level2-matrix-dge.lisp ============================================================================== --- trunk/src/matrix/level2-matrix-dge.lisp (original) +++ trunk/src/matrix/level2-matrix-dge.lisp Wed Sep 1 14:50:59 2010 @@ -244,7 +244,7 @@ (unless (zerop mod) (return-from all-integer-elements-p nil)))) t) - + (defmethod .expt ((a matrix-base-dge) (b matrix-base-dge)) (cond ((>= (mmin a) 0d0) (let ((c (mcreate a))) @@ -269,8 +269,8 @@ (defmethod .expt ((a matrix-base-dge) (b real)) "There is a lot of fuzz going on in here. The reason is because -the important special cases of exponents -3,-2,-1,0,1,2,3 are a factor 10 faster -than the general case on SBCL. Furthermor, output can be complex for non-integer exponent." +the important special cases of exponents -3,-2,-1,0,1,2,3 are a factor 10 faster +than the general case on SBCL. Furthermore, output can be complex for non-integer exponent." (multiple-value-bind (div mod) (truncate b) (if (= 0 mod) (let ((c (mcreate a))) Modified: trunk/src/matrix/level2-operator.lisp ============================================================================== --- trunk/src/matrix/level2-operator.lisp (original) +++ trunk/src/matrix/level2-operator.lisp Wed Sep 1 14:50:59 2010 @@ -85,15 +85,9 @@ (defmacro defmethod-operator-matrix-matrix (name) (let ((a (gensym)) - (b (gensym)) - (out (gensym)) - (type-a (gensym))) + (b (gensym))) `(defmethod ,name ((,a matrix-base) (,b matrix-base)) - (let* ((,type-a (class-of ,a)) - ;; Let the default be the type of the first matrix. Not sure about this. - ;; Maybe I should flag an error - (,out (make-matrix-instance ,type-a (dim ,a) 0))) - (mmap-operator #',name ,a ,b ,out))))) + (mmap-operator #',name ,a ,b (mcreate ,a))))) (defmacro defmethod-operator-matrix-any (name) (let ((a (gensym)) Modified: trunk/src/matrix/level2-view.lisp ============================================================================== --- trunk/src/matrix/level2-view.lisp (original) +++ trunk/src/matrix/level2-view.lisp Wed Sep 1 14:50:59 2010 @@ -49,11 +49,11 @@ :mref #'(lambda (x i j) (declare (ignore x i)) (mref matrix row j)) - :set-mref #'(lambda (value x i j) - (declare (ignore x j)) - (setf (mref matrix row i) value)) - :vref #'(lambda (x i) - (declare (ignore x)) + :set-mref #'(lambda (value x i j) + (declare (ignore x i)) + (setf (mref matrix row j) value)) + :vref #'(lambda (x i) + (declare (ignore x)) (mref matrix row i)) :set-vref #'(lambda (value x i) (declare (ignore x)) @@ -82,9 +82,7 @@ (make-instance 'function-matrix :rows (cols matrix) :cols (rows matrix) - :size (size matrix) - :element-type (element-type matrix) - :mref #'(lambda (x i j) + :mref #'(lambda (x i j) (declare (ignore x)) (mref matrix j i)) :set-mref #'(lambda (value x i j) From jivestgarden at common-lisp.net Mon Sep 13 18:04:06 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Mon, 13 Sep 2010 14:04:06 -0400 Subject: [lisplab-cvs] r180 - in trunk/src: matrix1 matrix2 vector1 vector2 Message-ID: Author: jivestgarden Date: Mon Sep 13 14:04:06 2010 New Revision: 180 Log: New directories for separation of level 1 and 2 Added: trunk/src/matrix1/ trunk/src/matrix2/ trunk/src/vector1/ trunk/src/vector2/ From jivestgarden at common-lisp.net Mon Sep 13 18:26:47 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Mon, 13 Sep 2010 14:26:47 -0400 Subject: [lisplab-cvs] r181 - in trunk: . src/extra src/matrix src/matrix1 src/vector1 src/vector2 Message-ID: Author: jivestgarden Date: Mon Sep 13 14:26:47 2010 New Revision: 181 Log: Separates vectors and matrices on build. Not finished Added: trunk/src/extra/ trunk/src/matrix1/level1-array.lisp - copied unchanged from r179, /trunk/src/matrix/level1-array.lisp trunk/src/matrix1/level1-classes.lisp - copied unchanged from r179, /trunk/src/matrix/level1-classes.lisp trunk/src/matrix1/level1-constructors.lisp - copied unchanged from r179, /trunk/src/matrix/level1-constructors.lisp trunk/src/matrix1/level1-container.lisp - copied unchanged from r179, /trunk/src/matrix/level1-container.lisp trunk/src/matrix1/level1-ddiag.lisp - copied unchanged from r179, /trunk/src/matrix/level1-ddiag.lisp trunk/src/matrix1/level1-dge.lisp - copied unchanged from r179, /trunk/src/matrix/level1-dge.lisp trunk/src/matrix1/level1-dgt.lisp - copied unchanged from r179, /trunk/src/matrix/level1-dgt.lisp trunk/src/matrix1/level1-funmat.lisp - copied unchanged from r179, /trunk/src/matrix/level1-funmat.lisp trunk/src/matrix1/level1-ge.lisp - copied unchanged from r179, /trunk/src/matrix/level1-ge.lisp trunk/src/matrix1/level1-matrix.lisp - copied unchanged from r179, /trunk/src/matrix/level1-matrix.lisp trunk/src/matrix1/level1-sparse.lisp - copied unchanged from r179, /trunk/src/matrix/level1-sparse.lisp trunk/src/matrix1/level1-zge.lisp - copied unchanged from r179, /trunk/src/matrix/level1-zge.lisp trunk/src/vector1/level1-interface.lisp - copied unchanged from r179, /trunk/src/matrix/level1-interface.lisp trunk/src/vector1/level1-util.lisp - copied unchanged from r179, /trunk/src/matrix/level1-util.lisp trunk/src/vector1/level1-vector.lisp - copied unchanged from r179, /trunk/src/matrix/level1-vector.lisp trunk/src/vector2/level2-constructors.lisp - copied unchanged from r179, /trunk/src/matrix/level2-constructors.lisp trunk/src/vector2/level2-function.lisp - copied unchanged from r179, /trunk/src/matrix/level2-function.lisp trunk/src/vector2/level2-generic.lisp - copied unchanged from r179, /trunk/src/matrix/level2-generic.lisp trunk/src/vector2/level2-interface.lisp - copied unchanged from r179, /trunk/src/matrix/level2-interface.lisp trunk/src/vector2/level2-list.lisp - copied unchanged from r179, /trunk/src/matrix/level2-list.lisp trunk/src/vector2/level2-matrix-dge.lisp - copied unchanged from r179, /trunk/src/matrix/level2-matrix-dge.lisp trunk/src/vector2/level2-matrix-zge.lisp - copied unchanged from r179, /trunk/src/matrix/level2-matrix-zge.lisp trunk/src/vector2/level2-operator.lisp - copied unchanged from r179, /trunk/src/matrix/level2-operator.lisp trunk/src/vector2/level2-vector.lisp - copied unchanged from r179, /trunk/src/matrix/level2-vector.lisp trunk/src/vector2/level2-view.lisp - copied unchanged from r179, /trunk/src/matrix/level2-view.lisp trunk/src/vector2/permutation.lisp - copied unchanged from r179, /trunk/src/matrix/permutation.lisp trunk/src/vector2/store-operators.lisp - copied unchanged from r179, /trunk/src/matrix/store-operators.lisp trunk/src/vector2/store-ordinary-functions.lisp - copied unchanged from r179, /trunk/src/matrix/store-ordinary-functions.lisp Removed: trunk/src/matrix/level1-array.lisp trunk/src/matrix/level1-classes.lisp trunk/src/matrix/level1-constructors.lisp trunk/src/matrix/level1-container.lisp trunk/src/matrix/level1-ddiag.lisp trunk/src/matrix/level1-dge.lisp trunk/src/matrix/level1-dgt.lisp trunk/src/matrix/level1-funmat.lisp trunk/src/matrix/level1-ge.lisp trunk/src/matrix/level1-generic.lisp trunk/src/matrix/level1-interface.lisp trunk/src/matrix/level1-matrix.lisp trunk/src/matrix/level1-sparse.lisp trunk/src/matrix/level1-util.lisp trunk/src/matrix/level1-vector.lisp trunk/src/matrix/level1-zge.lisp trunk/src/matrix/level2-constructors.lisp trunk/src/matrix/level2-function.lisp trunk/src/matrix/level2-generic.lisp trunk/src/matrix/level2-interface.lisp trunk/src/matrix/level2-list.lisp trunk/src/matrix/level2-matrix-dge.lisp trunk/src/matrix/level2-matrix-zge.lisp trunk/src/matrix/level2-operator.lisp trunk/src/matrix/level2-vector.lisp trunk/src/matrix/level2-view.lisp trunk/src/matrix/permutation.lisp trunk/src/matrix/store-operators.lisp trunk/src/matrix/store-ordinary-functions.lisp Modified: trunk/lisplab.asd Modified: trunk/lisplab.asd ============================================================================== --- trunk/lisplab.asd (original) +++ trunk/lisplab.asd Mon Sep 13 14:26:47 2010 @@ -62,26 +62,24 @@ (:file "level0-thread") (:file "level0-infpre"))) - ;; - ;; All core matrix stuff (level 1 and 2) - ;; - (:module :src/matrix + (:module :src/vector1 :depends-on (:src/core) :serial t :components ( - (:file "level1-interface") + (:file "level1-interface") + (:file "level1-util") + (:file "level1-vector") + )) - ;; The three double-float store utility files should - ;; depend on the CL package only - (:file "level1-util") - (:file "store-operators") - (:file "store-ordinary-functions") - (:file "permutation") - - (:file "level1-classes") + (:module :src/matrix1 + :depends-on (:src/core :src/vector1) + :serial t + :components + ( + (:file "level1-classes") (:file "level1-constructors") - (:file "level1-vector") + (:file "level1-matrix") (:file "level1-ge") @@ -93,7 +91,19 @@ (:file "level1-sparse") (:file "level1-array") - ;; Level2, non-spezialized + )) + + (:module :src/vector2 + :depends-on (:src/core :src/vector1) + :serial t + :components + ( ;; Level2, non-spezialized + + (:file "store-operators") + (:file "store-ordinary-functions") + (:file "permutation") + + (:file "level2-interface") (:file "level2-constructors") (:file "level2-generic") @@ -108,11 +118,18 @@ (:file "level2-vector") )) + (:module :src/matrix2 + :depends-on (:src/core :src/vector1 :src/matrix1) + :serial t + :components + ()) + + ;; ;; IO (level 3) ;; (:module :src/io - :depends-on (:src/matrix) + :depends-on (:src/matrix2) :components ((:file "level3-io-interface") (:file "level3-io"))) @@ -121,7 +138,7 @@ ;; Linear algebra lisp implementation (Level 3) ;; (:module :src/linalg - :depends-on (:src/matrix) + :depends-on (:src/matrix2) :serial t :components ((:file "level3-linalg-interface") @@ -132,7 +149,7 @@ ;; Fast Fourier transform (Level 3) ;; (:module :src/fft - :depends-on (:src/matrix) + :depends-on (:src/matrix2) :serial t :components ( @@ -144,7 +161,7 @@ ;; Euler and Runge-Kutt solvers (Level 3) ;; (:module :src/util - :depends-on (:src/matrix) + :depends-on (:src/matrix2) :serial t :components ( From jivestgarden at common-lisp.net Tue Sep 14 19:00:17 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Tue, 14 Sep 2010 15:00:17 -0400 Subject: [lisplab-cvs] r182 - in trunk: . src/core src/extra src/io src/matrix2 src/test src/util src/vector1 src/vector2 Message-ID: Author: jivestgarden Date: Tue Sep 14 15:00:17 2010 New Revision: 182 Log: finished separation of vectors and matrices Added: trunk/src/extra/extra.lisp trunk/src/extra/infpre.lisp - copied unchanged from r179, /trunk/src/core/level0-infpre.lisp trunk/src/extra/level3-euler.lisp - copied unchanged from r179, /trunk/src/util/level3-euler.lisp trunk/src/extra/level3-rk4.lisp - copied unchanged from r179, /trunk/src/util/level3-rk4.lisp trunk/src/matrix2/level2-constructors.lisp - copied unchanged from r181, /trunk/src/vector2/level2-constructors.lisp trunk/src/matrix2/level2-view.lisp - copied unchanged from r181, /trunk/src/vector2/level2-view.lisp trunk/src/matrix2/matrix2-generic.lisp trunk/src/util/level1-util.lisp - copied unchanged from r181, /trunk/src/vector1/level1-util.lisp trunk/src/util/permutation.lisp - copied unchanged from r181, /trunk/src/vector2/permutation.lisp trunk/src/util/store-operators.lisp - copied unchanged from r181, /trunk/src/vector2/store-operators.lisp trunk/src/util/store-ordinary-functions.lisp - copied unchanged from r181, /trunk/src/vector2/store-ordinary-functions.lisp Removed: trunk/src/core/level0-infpre.lisp trunk/src/util/level3-euler.lisp trunk/src/util/level3-rk4.lisp trunk/src/vector1/level1-util.lisp trunk/src/vector2/level2-constructors.lisp trunk/src/vector2/level2-view.lisp trunk/src/vector2/permutation.lisp trunk/src/vector2/store-operators.lisp trunk/src/vector2/store-ordinary-functions.lisp Modified: trunk/lisplab.asd trunk/src/io/level3-io.lisp trunk/src/test/test-methods.lisp trunk/src/vector2/level2-generic.lisp trunk/src/vector2/level2-list.lisp Modified: trunk/lisplab.asd ============================================================================== --- trunk/lisplab.asd (original) +++ trunk/lisplab.asd Tue Sep 14 15:00:17 2010 @@ -60,15 +60,23 @@ ;; (:file "level0-default") (:file "level0-functions") (:file "level0-thread") - (:file "level0-infpre"))) + )) + + (:module :src/util + :depends-on () + :serial t + :components + ((:file "level1-util") + (:file "store-operators") + (:file "store-ordinary-functions") + (:file "permutation") + )) (:module :src/vector1 - :depends-on (:src/core) + :depends-on (:src/core :src/util) :serial t :components - ( - (:file "level1-interface") - (:file "level1-util") + ((:file "level1-interface") (:file "level1-vector") )) @@ -76,55 +84,47 @@ :depends-on (:src/core :src/vector1) :serial t :components - ( - (:file "level1-classes") - (:file "level1-constructors") - - (:file "level1-matrix") - - (:file "level1-ge") - (:file "level1-dge") - (:file "level1-zge") - (:file "level1-ddiag") - (:file "level1-dgt") - (:file "level1-funmat") - (:file "level1-sparse") - (:file "level1-array") + ((:file "level1-classes") + (:file "level1-constructors") + + (:file "level1-matrix") + (:file "level1-ge") + (:file "level1-dge") + (:file "level1-zge") + (:file "level1-ddiag") + (:file "level1-dgt") + (:file "level1-funmat") + (:file "level1-sparse") + (:file "level1-array") )) (:module :src/vector2 :depends-on (:src/core :src/vector1) :serial t :components - ( ;; Level2, non-spezialized - - (:file "store-operators") - (:file "store-ordinary-functions") - (:file "permutation") - + ((:file "level2-interface") + (:file "level2-generic") + (:file "level2-operator") + (:file "level2-function") + + ;; Level2, spezialized + (:file "level2-matrix-dge") + (:file "level2-matrix-zge") - (:file "level2-interface") - (:file "level2-constructors") - (:file "level2-generic") - (:file "level2-operator") - (:file "level2-function") - - ;; Level2, spezialized - (:file "level2-matrix-dge") - (:file "level2-matrix-zge") - (:file "level2-view") - (:file "level2-list") - (:file "level2-vector") - )) + (:file "level2-list") + (:file "level2-vector") + )) (:module :src/matrix2 :depends-on (:src/core :src/vector1 :src/matrix1) :serial t :components - ()) + ((:file "level2-constructors") + (:file "matrix2-generic") + (:file "level2-view") + )) - ;; ;; IO (level 3) ;; @@ -160,14 +160,16 @@ ;; ;; Euler and Runge-Kutt solvers (Level 3) ;; -(:module :src/util + (:module :src/extra :depends-on (:src/matrix2) :serial t :components ( (:file "level3-rk4") - (:file "level3-euler"))) - + (:file "level3-euler") + (:file "extra") + (:file "infpre") + )) )) (defsystem :lisplab-matlisp Added: trunk/src/extra/extra.lisp ============================================================================== --- (empty file) +++ trunk/src/extra/extra.lisp Tue Sep 14 15:00:17 2010 @@ -0,0 +1,41 @@ +;;; Lisplab, extra.lisp +;;; Some string and file utilities + +;;; 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. + +(in-package :lisplab) + +(defun strcat (&rest args) + "Concatenates the strings." + (apply #'concatenate (append (list 'string) args))) + +(defmacro in-dir (dir &body body) + "Temperarily binds *default-pathname-defaults* to dir. When directory +does not exists, it is created." + (let ((path (gensym)) + (dir2 (gensym))) + `(let* ((,dir2 ,dir) + (,path (merge-pathnames (if (pathnamep ,dir2) + ,dir2 + (pathname (strcat ,dir2 "/"))) + *default-pathname-defaults*))) + (ensure-directories-exist ,path) + (unless (probe-file ,path) + (error "<~S> is no directory" ,path )) + (let ((*default-pathname-defaults* ,path)) + , at body)))) + Modified: trunk/src/io/level3-io.lisp ============================================================================== --- trunk/src/io/level3-io.lisp (original) +++ trunk/src/io/level3-io.lisp Tue Sep 14 15:00:17 2010 @@ -25,26 +25,6 @@ (in-package :lisplab) -(defun strcat (&rest args) - "Concatenates the strings." - (apply #'concatenate (append (list 'string) args))) - -(defmacro in-dir (dir &body body) - "Temperarily binds *default-pathname-defaults* to dir. When directory -does not exists, it is created." - (let ((path (gensym)) - (dir2 (gensym))) - `(let* ((,dir2 ,dir) - (,path (merge-pathnames (if (pathnamep ,dir2) - ,dir2 - (pathname (strcat ,dir2 "/"))) - *default-pathname-defaults*))) - (ensure-directories-exist ,path) - (unless (probe-file ,path) - (error "<~S> is no directory" ,path )) - (let ((*default-pathname-defaults* ,path)) - , at body)))) - (defmethod dlmwrite (out (x number) &key (printer #'prin1) dlm) (declare (ignore dlm)) (dlmwrite (dcol x) out :printer printer)) Added: trunk/src/matrix2/matrix2-generic.lisp ============================================================================== --- (empty file) +++ trunk/src/matrix2/matrix2-generic.lisp Tue Sep 14 15:00:17 2010 @@ -0,0 +1,151 @@ +;;; Lisplab, matrix2-generic.lisp +;;; Level2, non-specialized matrix methods. + +;;; 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. + + +;;; Implementation principles: +;;; - all operators in this film should specialize for matrix-base and only +;;; assume level0 and level1 generic function (mref, vref, size, dim, etc.) +;;; - The methods in this file should not assume anything about implementation of +;;; the matrices. +;;; - The methods in this file should be as short and clean as possible. +;;; - Avoid optimizations (Exept: call other level2 functions, such as mmap, as much as possible.) +;;; + + +(in-package :lisplab) + +;;; This is OK, but could be optimzied! +(defmacro w/mat (a args &body body) + (let ((a2 (gensym)) + (x (first args)) + (i (second args)) + (j (third args))) + `(let ((,a2 ,a)) + (dotimes (,i (rows ,a2)) + (dotimes (,j (cols ,a2)) + (let ((,x (mref ,a2 ,i ,j))) + (setf (mref ,a2 ,i ,j) + , at body)))) + ,a2))) + +(defmethod copy-contents ((a matrix-base) (b matrix-base) + &optional (converter #'identity)) + (dotimes (i (rows a)) + (dotimes (j (cols a)) + (setf (mref b i j) (funcall converter (mref a i j)))) + b)) + +(defmethod sub-matrix (m rr cc) + (unless (cddr rr) + (setf rr (cons (car rr) (cons 1 (cdr rr))))) + (unless (cddr cc) + (setf cc (cons (car cc) (cons 1 (cdr cc))))) + (destructuring-bind (r0 r-step r1) rr + (destructuring-bind (c0 c-step c1) cc + (when (>= r1 (rows m)) + (setf r1 (1- (rows m)))) + (when (>= c1 (cols m)) + (setf c1 (1- (cols m)))) + (let* ((rows (1+ (floor (- r1 r0) r-step))) + (cols (1+ (floor (- c1 c0) c-step))) + (m1 (mcreate m 0 (list rows cols)))) + (dotimes (i rows) + (dotimes (j cols) + (setf (mref m1 i j) + (mref m (+ r0 (* r-step i)) (+ c0 (* c-step j)))))) + m1)))) + +(defmethod circ-shift ((A matrix-base) shift) + ;; TODO move to level3 + (let ((B (mcreate A)) + (rows (rows A)) + (cols (cols A)) + (dr (first shift)) + (dc (second shift))) + (dotimes (i rows) + (dotimes (j cols) + (setf (mref B (mod (+ i dr) rows) (mod (+ j dc) cols)) + (mref A i j)))) + B)) + +(defmethod pad-shift ((A matrix-base) shift &optional (value 0)) + ;; TODO move to level3 + (let ((B (mcreate A value)) + (rows (rows A)) + (cols (cols A)) + (dr (first shift)) + (dc (second shift))) + (loop for i from (max 0 dr) below (min rows (+ rows dr)) do + (loop for j from (max 0 dc) below (min cols (+ cols dc)) do + (setf (mref B i j) + (mref A (- i dr) (- j dc))))) + B)) + +(defmethod mreverse ((A matrix-base)) + (let ((B (mcreate A)) + (len (size A))) + (dotimes (i len) + (setf (vref B (- len i 1)) + (vref A i))) + B)) + +(defmethod export-list ((m matrix-base)) + (let ((res nil)) + (dotimes (i (size m)) + (push (vref m i) res)) + (nreverse res))) + +(defmethod import-list ((m matrix-base) list) + (let ((tmp list)) + (dotimes (i (size m)) + (unless tmp + (return-from import-list m)) + (setf (vref m i) (car tmp) + tmp (cdr tmp))) + m)) + +(defmethod reshape ((a matrix-base) shape) + (let ((B (mcreate a 0 shape))) + (dotimes (i (size B)) + (setf (vref B i) (vref A i))) + B)) + +(defmethod to-vector ((a matrix-base)) + (reshape a (list (size a) 1))) + +(defmethod to-matrix ((a matrix-base) rows) + (reshape a (list rows (/ (size a) rows) 1))) + + +(defmethod row-swap! (A i j) + (dotimes (c (cols A)) + (psetf (mref A i c) (mref A j c) + (mref A j c) (mref A i c))) + A) + +(defmethod row-mul! (A i num) + (dotimes (c (cols A)) + (setf (mref A i c) (.* num (mref A i c)))) + A) + +(defmethod row-add! (A i j num) + (dotimes (c (cols A)) + (setf (mref A i c) (.+ (mref A i c) (.* num (mref A j c))))) + A) + Modified: trunk/src/test/test-methods.lisp ============================================================================== --- trunk/src/test/test-methods.lisp (original) +++ trunk/src/test/test-methods.lisp Tue Sep 14 15:00:17 2010 @@ -22,9 +22,9 @@ (let* ((a 1) (b 1d0) (c %i) - (x #md((1 2) (3 4))) - (y #md((1 2) (3 4))) - (w #mm((1 2) (3 4))) + (x #md((1 2 ) (3 4))) + (y #md((1 2 3) (3 4 3))) + (w #mm((1 2 2) (3 4 3) (1 100000 1000000)) (args (list a b c x y w))) (mapc (lambda (fun) (mapc (lambda (x) Modified: trunk/src/vector2/level2-generic.lisp ============================================================================== --- trunk/src/vector2/level2-generic.lisp (original) +++ trunk/src/vector2/level2-generic.lisp Tue Sep 14 15:00:17 2010 @@ -132,125 +132,3 @@ val) -;;; Matrix operations (depend on structure) - - -;;; This is OK, but could be optimzied! -(defmacro w/mat (a args &body body) - (let ((a2 (gensym)) - (x (first args)) - (i (second args)) - (j (third args))) - `(let ((,a2 ,a)) - (dotimes (,i (rows ,a2)) - (dotimes (,j (cols ,a2)) - (let ((,x (mref ,a2 ,i ,j))) - (setf (mref ,a2 ,i ,j) - , at body)))) - ,a2))) - -(defmethod copy-contents ((a matrix-base) (b matrix-base) - &optional (converter #'identity)) - (dotimes (i (rows a)) - (dotimes (j (cols a)) - (setf (mref b i j) (funcall converter (mref a i j)))) - b)) - -(defmethod sub-matrix (m rr cc) - (unless (cddr rr) - (setf rr (cons (car rr) (cons 1 (cdr rr))))) - (unless (cddr cc) - (setf cc (cons (car cc) (cons 1 (cdr cc))))) - (destructuring-bind (r0 r-step r1) rr - (destructuring-bind (c0 c-step c1) cc - (when (>= r1 (rows m)) - (setf r1 (1- (rows m)))) - (when (>= c1 (cols m)) - (setf c1 (1- (cols m)))) - (let* ((rows (1+ (floor (- r1 r0) r-step))) - (cols (1+ (floor (- c1 c0) c-step))) - (m1 (mcreate m 0 (list rows cols)))) - (dotimes (i rows) - (dotimes (j cols) - (setf (mref m1 i j) - (mref m (+ r0 (* r-step i)) (+ c0 (* c-step j)))))) - m1)))) - -(defmethod circ-shift ((A matrix-base) shift) - ;; TODO move to level3 - (let ((B (mcreate A)) - (rows (rows A)) - (cols (cols A)) - (dr (first shift)) - (dc (second shift))) - (dotimes (i rows) - (dotimes (j cols) - (setf (mref B (mod (+ i dr) rows) (mod (+ j dc) cols)) - (mref A i j)))) - B)) - -(defmethod pad-shift ((A matrix-base) shift &optional (value 0)) - ;; TODO move to level3 - (let ((B (mcreate A value)) - (rows (rows A)) - (cols (cols A)) - (dr (first shift)) - (dc (second shift))) - (loop for i from (max 0 dr) below (min rows (+ rows dr)) do - (loop for j from (max 0 dc) below (min cols (+ cols dc)) do - (setf (mref B i j) - (mref A (- i dr) (- j dc))))) - B)) - -(defmethod mreverse ((A matrix-base)) - (let ((B (mcreate A)) - (len (size A))) - (dotimes (i len) - (setf (vref B (- len i 1)) - (vref A i))) - B)) - -(defmethod export-list ((m matrix-base)) - (let ((res nil)) - (dotimes (i (size m)) - (push (vref m i) res)) - (nreverse res))) - -(defmethod import-list ((m matrix-base) list) - (let ((tmp list)) - (dotimes (i (size m)) - (unless tmp - (return-from import-list m)) - (setf (vref m i) (car tmp) - tmp (cdr tmp))) - m)) - -(defmethod reshape ((a matrix-base) shape) - (let ((B (mcreate a 0 shape))) - (dotimes (i (size B)) - (setf (vref B i) (vref A i))) - B)) - -(defmethod to-vector ((a matrix-base)) - (reshape a (list (size a) 1))) - -(defmethod to-matrix ((a matrix-base) rows) - (reshape a (list rows (/ (size a) rows) 1))) - - -(defmethod row-swap! (A i j) - (dotimes (c (cols A)) - (psetf (mref A i c) (mref A j c) - (mref A j c) (mref A i c))) - A) - -(defmethod row-mul! (A i num) - (dotimes (c (cols A)) - (setf (mref A i c) (.* num (mref A i c)))) - A) - -(defmethod row-add! (A i j num) - (dotimes (c (cols A)) - (setf (mref A i c) (.+ (mref A i c) (.* num (mref A j c))))) - A) - Modified: trunk/src/vector2/level2-list.lisp ============================================================================== --- trunk/src/vector2/level2-list.lisp (original) +++ trunk/src/vector2/level2-list.lisp Tue Sep 14 15:00:17 2010 @@ -17,7 +17,7 @@ ;;; 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. +;;; Should it be somewhere else. It has nothing to do with matrices, really. (in-package :lisplab) From jivestgarden at common-lisp.net Tue Sep 14 19:01:37 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Tue, 14 Sep 2010 15:01:37 -0400 Subject: [lisplab-cvs] r183 - trunk/src/matrix Message-ID: Author: jivestgarden Date: Tue Sep 14 15:01:37 2010 New Revision: 183 Log: Removed empty dir Removed: trunk/src/matrix/ From jivestgarden at common-lisp.net Wed Sep 29 18:34:16 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Wed, 29 Sep 2010 14:34:16 -0400 Subject: [lisplab-cvs] r184 - trunk/src/util Message-ID: Author: jivestgarden Date: Wed Sep 29 14:34:16 2010 New Revision: 184 Log: untested new double float array utility Added: trunk/src/util/ext-store-operators.lisp Added: trunk/src/util/ext-store-operators.lisp ============================================================================== --- (empty file) +++ trunk/src/util/ext-store-operators.lisp Wed Sep 29 14:34:16 2010 @@ -0,0 +1,162 @@ +;;; Lisplab, ext-store-operators.lisp +;;; Double float and complex double float operators (such as +,-,*, etc) on +;;; simple arrays. +;;; Extended parameters list with offset and step. +;;; Used by the matrix implementations. + +;;; 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. + +;;; This file contains manipulations of simple double-float arrays +;;; and should be called by the spesialized matrix methods. +;;; The purpose of this layer is that it can be used by +;;; many classes such as matrix-base-dge and matrix-base-ddi, etc. +;;; +;;; The content of this file must be highly optimized +;;; and should not depend anything exept Common Lisp itself. + +(in-package :lisplab) + +;;; TODO: there must be some easier way to generate the code in this file, +;;; but I have not the energy to do it. I do, however, think that +;;; the basic idea of having a layer of ordinary functions is a good one. + +;;; The reason for generating ordinary functions and not using methods, +;;; is that the real and complex stores have the same type. The fortran-compatible +;;; complex arrays are just subsequent real and complex double-floats. + +;;; The reason for having both real and complex in the same file is that +;;; not all operators function on both real and complex arguments. Care must +;;; be taken. This is also the reason why it's hard to generate more code +;;; automatically. + +;;; The below code generates ordinary lisp functions +;;; for elementwise operations on simple double-float arrays. +;;; They use a naming conventions, which should be pretty easy to +;;; guess, such as df = double float and cdfa = complex double float array. +;;; +;;; (The convention for complex should for consistnt naming be changed to zdfa, +;;; but its not really important) +;;; +;;; I use map-into when its performance is equal or better to the iterations. +;;; The iterative version for all operations are still in the file, since other lisps +;;; than sbcl might have a slower map-into, so that they can be needed later. +;;; For real numbers, map-into can be used for all operations, while for complex +;;; number only + and - (*, / and expt mix the real and complex parts) + + +(declaim (inline double-float-simple-array-ref-ext)) +(declaim (ftype (function + (type-blas-store + type-blas-idx + type-blas-idx + type-blas-idx) + double-float) + double-float-simple-array-ref-ext)) +(defun double-float-simple-array-ref-ext (a i off step) + (declare (type type-blas-idx i off step) + (type type-blas-store a)) + (aref a (truly-the type-blas-idx + (+ off + (truly-the type-blas-idx + (* i step)))))) + +(declaim (inline (setf double-float-simple-array-ref-ext))) +(declaim (ftype (function + (double-float + type-blas-store + type-blas-idx + type-blas-idx + type-blas-idx) + double-float) + (setf double-float-simple-array-ref-ext))) +(defun (setf double-float-simple-array-ref-ext) (value a i off step) + (declare (type type-blas-idx i off step) + (type double-float value) + (type type-blas-store a)) + (setf (aref a (truly-the type-blas-idx + (+ off + (truly-the type-blas-idx + (* i step))))) + value) + value) + +;;; Array and number + +(defmacro defun-ext-dfa-df (name op) + `(defun ,name (len a aoff astep b c coff cstep) + (declare (type type-blas-store a c) + (type double-float b)) + (dotimes (i len) + (setf (double-float-simple-array-ref-ext c i coff cstep) + (,op (double-float-simple-array-ref-ext a i aoff astep) + b))) + c)) + +(defun-ext-dfa-df +_ext-dfa-df +) +(defun-ext-dfa-df -_ext-dfa-df -) +(defun-ext-dfa-df *_ext-dfa-df *) +(defun-ext-dfa-df /_ext-dfa-df /) +(defun-ext-dfa-df ^_ext-dfa-df expt) +(defun-ext-dfa-df max_ext-dfa-df max) +(defun-ext-dfa-df min_ext-dfa-df min) +(defun-ext-dfa-df log_ext-dfa-df log) + +;;; Number and array + +(defmacro defun-ext-df-dfa (name op) + `(defun ,name (len a b boff bstep c coff cstep) + (declare (type type-blas-store b c) + (type double-float a)) + (dotimes (i len) + (setf (double-float-simple-array-ref-ext c i coff cstep) + (,op a + (double-float-simple-array-ref-ext b i boff bstep)))) + c)) + +(defun-ext-df-dfa +_ext-df-dfa +) +(defun-ext-df-dfa -_ext-df-dfa -) +(defun-ext-df-dfa *_ext-df-dfa *) +(defun-ext-df-dfa /_ext-df-dfa /) +(defun-ext-df-dfa ^_ext-df-dfa expt) +(defun-ext-df-dfa max_ext-df-dfa max) +(defun-ext-df-dfa min_ext-df-dfa min) +(defun-ext-df-dfa log_ext-df-dfa log) + +;;; Array and array + +(defmacro defun-ext-dfa-dfa (name op) + `(defun ,name (len a aoff astep b boff bstep c coff cstep) + (declare (type type-blas-store b a c)) + (dotimes (i len) + (setf (double-float-simple-array-ref-ext c i coff cstep) + (,op (double-float-simple-array-ref-ext a i aoff astep) + (double-float-simple-array-ref-ext b i boff bstep)))) + c)) + +(defun-ext-dfa-dfa +_ext-dfa-dfa +) +(defun-ext-dfa-dfa -_ext-dfa-dfa -) +(defun-ext-dfa-dfa *_ext-dfa-dfa *) +(defun-ext-dfa-dfa /_ext-dfa-dfa /) +(defun-ext-dfa-dfa ^_ext-dfa-dfa expt) +(defun-ext-dfa-dfa max_ext-dfa-dfa max) +(defun-ext-dfa-dfa min_ext-dfa-dfa min) +(defun-ext-dfa-dfa log_ext-dfa-dfa log) + + + + +