From jivestgarden at common-lisp.net Tue Nov 16 20:07:54 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Tue, 16 Nov 2010 15:07:54 -0500 Subject: [lisplab-cvs] r193 - in trunk/src: matrix2 vector2 Message-ID: Author: jivestgarden Date: Tue Nov 16 15:07:54 2010 New Revision: 193 Log: Change implmentation of matrix creation. Modified: trunk/src/matrix2/level2-constructors.lisp trunk/src/vector2/level2-list.lisp Modified: trunk/src/matrix2/level2-constructors.lisp ============================================================================== --- trunk/src/matrix2/level2-constructors.lisp (original) +++ trunk/src/matrix2/level2-constructors.lisp Tue Nov 16 15:07:54 2010 @@ -24,7 +24,6 @@ (in-package :lisplab) - ;;; Creates matrices with general structure, e.g., #md((1 2) (3 4)) ;;; TODO: error check is important here! @@ -104,16 +103,8 @@ value)) (defun mmat (type x) - "Creates a matrix from the list of lists. -For a macro use #mm((..) (..) ..) instead." - (unless (consp (car x)) - ;; It is a list. Create a column vector. - (setf x (mapcar #'list x))) - (let* ((cols (length (car x))) - (rows (length x)) - (m (make-matrix-instance type (list rows cols) 0))) - (fill-matrix-with-list m x) - m)) + "Creates a matrix from the supplied contents." + (convert x type)) (defun mcol (type &rest args) "Creates a column matrix." @@ -130,9 +121,8 @@ (mmap t #'random (dnew 1d0 rows cols))) (defun dmat (args) - "Creates a matrix-dge from the list of lists. -For macro: use #md((..) (..) ..) instead." - (mmat 'matrix-dge args)) + "Creates a matrix-dge from supplied contents." + (convert args 'matrix-dge)) (defun dcol (&rest args) "Creates a matrix-dge column matrix." @@ -192,9 +182,8 @@ ;;; Constructors for matrix-zge (defun zmat (args) - "Creates a matrix-zge from the list of lists. -For macro: use #mz((..) (..) ..) instead." - (mmat 'matrix-zge args)) + "Creates a matrix-zge from the supplied contents." + (convert args 'matrix-zge)) (defun zcol (&rest args) "Creates a matrix-zge column matrix." Modified: trunk/src/vector2/level2-list.lisp ============================================================================== --- trunk/src/vector2/level2-list.lisp (original) +++ trunk/src/vector2/level2-list.lisp Tue Nov 16 15:07:54 2010 @@ -22,7 +22,11 @@ (in-package :lisplab) (defmethod convert ((x cons) type) - (mmat type x)) + (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)) From jivestgarden at common-lisp.net Tue Nov 16 20:52:33 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Tue, 16 Nov 2010 15:52:33 -0500 Subject: [lisplab-cvs] r194 - trunk/src/matrix2 Message-ID: Author: jivestgarden Date: Tue Nov 16 15:52:32 2010 New Revision: 194 Log: Implmented generic get-row and get-col Modified: trunk/src/matrix2/matrix2-generic.lisp Modified: trunk/src/matrix2/matrix2-generic.lisp ============================================================================== --- trunk/src/matrix2/matrix2-generic.lisp (original) +++ trunk/src/matrix2/matrix2-generic.lisp Tue Nov 16 15:52:32 2010 @@ -51,7 +51,7 @@ (setf (mref b i j) (funcall converter (mref a i j)))) b)) -(defmethod sub-matrix (m rr cc) +(defmethod sub-matrix ((m matrix-base) rr cc) (unless (cddr rr) (setf rr (cons (car rr) (cons 1 (cdr rr))))) (unless (cddr cc) @@ -68,9 +68,17 @@ (dotimes (i rows) (dotimes (j cols) (setf (mref m1 i j) - (mref m (+ r0 (* r-step i)) (+ c0 (* c-step j)))))) + (mref m + (+ r0 (* r-step i)) + (+ c0 (* c-step j)))))) m1)))) +(defmethod get-row ((m matrix-base) row) + (sub-matrix m (list row row) (list 0 (1- (cols m))))) + +(defmethod get-col ((m matrix-base) col) + (sub-matrix m (list 0 (1- (rows m))) (list col col))) + (defmethod circ-shift ((A matrix-base) shift) ;; TODO move to level3 (let ((B (mcreate A)) From jivestgarden at common-lisp.net Sun Nov 21 13:46:08 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sun, 21 Nov 2010 08:46:08 -0500 Subject: [lisplab-cvs] r195 - in trunk/src: matrix1 matrix2 vector2 Message-ID: Author: jivestgarden Date: Sun Nov 21 08:46:08 2010 New Revision: 195 Log: copy is now a pure vector operation Modified: trunk/src/matrix1/level1-dge.lisp trunk/src/matrix2/level2-constructors.lisp trunk/src/vector2/level2-generic.lisp trunk/src/vector2/level2-matrix-dge.lisp Modified: trunk/src/matrix1/level1-dge.lisp ============================================================================== --- trunk/src/matrix1/level1-dge.lisp (original) +++ trunk/src/matrix1/level1-dge.lisp Sun Nov 21 08:46:08 2010 @@ -22,7 +22,7 @@ ;;; Double float general classes (defclass matrix-base-dge - (structure-general + (structure-general vector-d implementation-base) ()) Modified: trunk/src/matrix2/level2-constructors.lisp ============================================================================== --- trunk/src/matrix2/level2-constructors.lisp (original) +++ trunk/src/matrix2/level2-constructors.lisp Sun Nov 21 08:46:08 2010 @@ -70,13 +70,6 @@ (unless implementation (setf implementation (implementation-spec a))) (make-matrix-instance (list element-type structure implementation) dim value)) - -(defmethod copy ((a matrix-base)) - (let ((x (make-matrix-instance (class-of a) (dim a) 0))) - (dotimes (i (size x)) - (setf (vref x i) (vref a i))) - x)) - (defmethod convert ((x matrix-base) type) (let ((y (make-matrix-instance type (dim x) 0))) (copy-contents x y) Modified: trunk/src/vector2/level2-generic.lisp ============================================================================== --- trunk/src/vector2/level2-generic.lisp (original) +++ trunk/src/vector2/level2-generic.lisp Sun Nov 21 08:46:08 2010 @@ -32,6 +32,12 @@ ;;; Vector operations (ignore structure) +(defmethod copy ((a vector-base)) + (let ((x (make-matrix-instance (class-of a) (dim a) 0))) + (dotimes (i (size x)) + (setf (vref x i) (vref a i))) + x)) + (defmethod mmap ((type (eql t)) f (a vector-base) &rest args) "Maps with output type given by first matrix." (apply #'mmap (type-of a) f a args)) Modified: trunk/src/vector2/level2-matrix-dge.lisp ============================================================================== --- trunk/src/vector2/level2-matrix-dge.lisp (original) +++ trunk/src/vector2/level2-matrix-dge.lisp Sun Nov 21 08:46:08 2010 @@ -28,7 +28,7 @@ (defmethod copy ((a vector-d)) (let ((store (vector-store a))) (declare (type type-blas-store store)) - (make-instance (class-name (class-of a)) + (make-instance (class-of a) :store (copy-seq store) :dim (dim a)))) @@ -270,8 +270,9 @@ (defmethod .expt ((a vector-d) (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. Furthermore, 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))) From jivestgarden at common-lisp.net Thu Nov 25 20:33:07 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Thu, 25 Nov 2010 15:33:07 -0500 Subject: [lisplab-cvs] r196 - trunk/src/specfunc Message-ID: Author: jivestgarden Date: Thu Nov 25 15:33:07 2010 New Revision: 196 Log: besj fix from Dan Becker Modified: trunk/src/specfunc/level0-specfunc.lisp Modified: trunk/src/specfunc/level0-specfunc.lisp ============================================================================== --- trunk/src/specfunc/level0-specfunc.lisp (original) +++ trunk/src/specfunc/level0-specfunc.lisp Thu Nov 25 15:33:07 2010 @@ -20,24 +20,29 @@ (in-package :lisplab) +(defun neg-integer-p (x) + (and (< x 0) (= x (truncate x)))) + (defmethod .besj (n (x number)) "f2cl slatec based implementation" ;; Bessel J function, for n >=0, real and complex numbers. ;; TODO: what about negaive n and complex n? - (typecase x - (complex (let ((rx (to-df (realpart x))) - (cx (to-df (imagpart x))) - (ry (make-dvec 1)) - (cy (make-dvec 1))) - (slatec:zbesj rx cx (to-df n) 1 1 ry cy 0 0) - (complex (aref ry 0) (aref cy 0)))) - (t (let ((x (to-df x))) - (case n - (0 (slatec:dbesj0 x)) - (1 (slatec:dbesj1 x)) - (t (let ((y (make-dvec 1))) - (slatec:dbesj x (to-df n) 1 y 0) - (aref y 0)))))))) + (if (neg-integer-p n) + (* (expt -1 n) (.besj (- n) x)) + (typecase x + (complex (let ((rx (to-df (realpart x))) + (cx (to-df (imagpart x))) + (ry (make-dvec 1)) + (cy (make-dvec 1))) + (slatec:zbesj rx cx (to-df n) 1 1 ry cy 0 0) + (complex (aref ry 0) (aref cy 0)))) + (t (let ((x (to-df x))) + (case n + (0 (slatec:dbesj0 x)) + (1 (slatec:dbesj1 x)) + (t (let ((y (make-dvec 1))) + (slatec:dbesj x (to-df n) 1 y 0) + (aref y 0))))))))) (defmethod .besy (n (x number)) "f2cl slatec based implementation"