From jivestgarden at common-lisp.net Thu Dec 10 20:18:33 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Thu, 10 Dec 2009 15:18:33 -0500 Subject: [lisplab-cvs] r117 - src/matrix Message-ID: Author: jivestgarden Date: Thu Dec 10 15:18:32 2009 New Revision: 117 Log: optimizations for cross real and complex. Untested Modified: src/matrix/level2-matrix-zge.lisp src/matrix/store-operators.lisp Modified: src/matrix/level2-matrix-zge.lisp ============================================================================== --- src/matrix/level2-matrix-zge.lisp (original) +++ src/matrix/level2-matrix-zge.lisp Thu Dec 10 15:18:32 2009 @@ -21,6 +21,7 @@ (let ((rx (coerce (realpart value) 'double-float)) (cx (coerce (imagpart value) 'double-float)) (store (matrix-store a))) + (declare (type type-blas-store store)) (loop for i from 0 below (length store) by 2 do (setf (aref store i) rx (aref store (1+ i)) cx)))) @@ -92,7 +93,7 @@ (expand-generic-function-cdfa-cdf-map) -;;; Real and matrix +;;; Complex and matrix (define-constant +generic-function-cdf-cdfa-map+ '((.add . +_cdf-cdfa) @@ -167,8 +168,8 @@ `(progn (def-cross-complex-real-method ,name complex matrix-base-dge) (def-cross-complex-real-method ,name matrix-base-dge complex) - (def-cross-complex-real-method ,name matrix-base-zge matrix-base-dge) - (def-cross-complex-real-method ,name matrix-base-dge matrix-base-zge) + ;; (def-cross-complex-real-method ,name matrix-base-zge matrix-base-dge) + ;; (def-cross-complex-real-method ,name matrix-base-dge matrix-base-zge) 'done)) (def-all-cross-complex-real-methods .add) @@ -177,6 +178,82 @@ (def-all-cross-complex-real-methods .div) (def-all-cross-complex-real-methods .expt) +;;; Add + +(defmethod .add ((a matrix-base-zge) (b real)) + (let ((c (mcreate a))) + (+_cdfa-df (matrix-store a) (coerce b 'double-float) (matrix-store c)) + c)) + +(defmethod .add ((b real) (a matrix-base-zge) ) + (.add a b)) + +(defmethod .add ((a matrix-base-zge) (b matrix-base-dge)) + (let ((c (mcreate a))) + (+_cdfa-dfa (matrix-store a) (matrix-store b) (matrix-store c)) + c)) + +(defmethod .add ((b matrix-base-dge) (a matrix-base-zge)) + (.add a b)) + +;;; Sub + +(defmethod .sub ((a matrix-base-zge) (b real)) + (let ((c (mcreate a))) + (-_cdfa-df (matrix-store a) (coerce b 'double-float) (matrix-store c)) + c)) + +(defmethod .sub ((a real) (b matrix-base-zge)) + (let ((c (mcreate b))) + (-_df-cdfa (coerce a 'double-float) (matrix-store b) (matrix-store c)) + c)) + +(defmethod .sub ((a matrix-base-zge) (b matrix-base-dge)) + (let ((c (mcreate a))) + (-_cdfa-dfa (matrix-store a) (matrix-store b) (matrix-store c)) + c)) + +(defmethod .sub ((a matrix-base-dge) (b matrix-base-zge)) + (let ((c (mcreate b))) + (-_dfa-cdfa (matrix-store a) (matrix-store b) (matrix-store c)) + c)) + +;;; Mul + +(defmethod .mul ((a matrix-base-zge) (b real)) + (let ((c (mcreate a))) + (*_cdfa-df (matrix-store a) (coerce b 'double-float) (matrix-store c)) + c)) + +(defmethod .mul ((b real) (a matrix-base-zge) ) + (.mul a b)) + +(defmethod .mul ((a matrix-base-zge) (b matrix-base-dge)) + (let ((c (mcreate a))) + (*_cdfa-dfa (matrix-store a) (matrix-store b) (matrix-store c)) + c)) + +(defmethod .mul ((b matrix-base-dge) (a matrix-base-zge)) + (.mul a b)) + +;;; Div + +(defmethod .div ((a matrix-base-zge) (b real)) + (let ((c (mcreate a))) + (/_cdfa-df (matrix-store a) (coerce b 'double-float) (matrix-store c)) + c)) + +(defmethod .div ((a matrix-base-zge) (b matrix-base-dge)) + (let ((c (mcreate a))) + (/_cdfa-dfa (matrix-store a) (matrix-store b) (matrix-store c)) + c)) + +(def-cross-complex-real-method .div matrix-base-dge matrix-base-zge) + +;;; Expt + +(def-cross-complex-real-method .expt matrix-base-zge matrix-base-dge) +(def-cross-complex-real-method .expt matrix-base-dge matrix-base-zge) ;;;; Ordinary functions @@ -233,200 +310,3 @@ -#| - -(defmacro each-element-function-matrix-base-zge (x form) - "Applies a form on each element of an matrix-base-zge." - (let ((i (gensym)) - (y (gensym))) - `(let* ((,y (copy ,x))) - (declare (type matrix-base-zge ,y)) - (dotimes (,i (size ,y)) - (let ((,x (vref ,y ,i))) - (declare (type (complex double-float) ,x)) - (setf (vref ,y ,i) - ,form))) - ,y))) - -(defmacro expand-matrix-zge-num-num () - (cons 'progn - (mapcar (lambda (name) - `(defmethod ,(car name) ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (,(cdr name) x)))) - +functions-complex-to-complex+))) - -(expand-matrix-zge-num-num) - -(defmethod .log ((x matrix-base-zge) &optional base) - (if base - (each-element-function-matrix-base-zge x (log x base)) - (each-element-function-matrix-base-zge x (log x)))) - -;;; Bessel functions - -(defmethod .besj (n (x matrix-base-zge)) - (each-element-function-matrix-base-zge x (.besj n x))) - -(defmethod .besy (n (x matrix-base-zge)) - (each-element-function-matrix-base-zge x (.besy n x))) - -(defmethod .besi (n (x matrix-base-zge)) - (each-element-function-matrix-base-zge x (.besi n x))) - -(defmethod .besk (n (x matrix-base-zge)) - (each-element-function-matrix-base-zge x (.besk n x))) - -(defmethod .besh1 (n (x matrix-base-zge)) - (each-element-function-matrix-base-zge x (.besh1 n x))) - -(defmethod .besh2 (n (x matrix-base-zge)) - (each-element-function-matrix-base-zge x (.besh2 n x))) - - -|# - -#| - -#+nil (defmethod .sqr ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (* x x))) - - -(defmacro expand-on-matrix-zge-lisplab-two-argument-functions-alist () - (cons 'progn - (mapcar (lambda (name) - `(def-binary-op-matrix-base-zge ,(car name) ,(cdr name))) - +lisplab-two-argument-functions-alist+))) - -(expand-on-matrix-zge-lisplab-two-argument-functions-alist) -|# -#| -;;; Old code - -(defmacro def-binary-op-matrix-base-zge (new old) - ;;; TODO speed up for real numbers. Is it worth the work? - (let ((a (gensym "a")) - (b (gensym "b")) - (len (gensym "len")) - (store (gensym "store")) - (store2 (gensym "store2")) - (i (gensym "i"))) - `(progn - (defmethod ,new ((,a matrix-base-zge) (,b number)) - (let* ((,a (copy ,a)) - (,store (matrix-store ,a)) - (,b (coerce ,b '(complex double-float))) - (,len (size ,a))) - (declare (type (complex double-float) ,b) - (type type-blas-store ,store) - (type type-blas-idx ,len)) - (dotimes (,i ,len) - (setf (ref-blas-complex-store ,store ,i 0 ,len) - (,old (ref-blas-complex-store ,store ,i 0 ,len) ,b))) - ,a)) - (defmethod ,new ((,a number) (,b matrix-base-zge)) - (let* ((,b (copy ,b)) - (,store (matrix-store ,b)) - (,a (coerce ,a '(complex double-float))) - (,len (size ,b))) - (declare (type (complex double-float) ,a) - (type type-blas-store ,store) - (type type-blas-idx ,len)) - (dotimes (,i ,len) - (setf (ref-blas-complex-store ,store ,i 0 ,len) - (,old ,a (ref-blas-complex-store ,store ,i 0 ,len)))) - ,b)) - (defmethod ,new ((,a matrix-base-zge) (,b matrix-base-zge)) - (let* ((,a (copy ,a)) - (,store (matrix-store ,a)) - (,store2 (matrix-store ,b)) - (,len (size ,a))) - (declare (type type-blas-store ,store) - (type type-blas-store ,store2) - (type type-blas-idx ,len)) - - (dotimes (,i ,len) - (setf (ref-blas-complex-store ,store ,i 0 ,len) - (,old (ref-blas-complex-store ,store ,i 0 ,len) - (ref-blas-complex-store ,store2 ,i 0 ,len)))) - ,a)) - (defmethod ,new ((,a matrix-base-zge) (,b matrix-base-dge)) - (let* ((,a (copy ,a)) - (,store (matrix-store ,a)) - (,store2 (matrix-store ,b)) - (,len (size ,a))) - (declare (type type-blas-store ,store) - (type type-blas-store ,store2) - (type type-blas-idx ,len)) - (dotimes (,i ,len) - (setf (ref-blas-complex-store ,store ,i 0 ,len) - (,old (ref-blas-complex-store ,store ,i 0 ,len) - (aref ,store2 ,i)))) - ,a)) - (defmethod ,new ((,a matrix-base-dge) (,b matrix-base-zge)) - (let* ((,b (copy ,b)) - (,store (matrix-store ,a)) - (,store2 (matrix-store ,b)) - (,len (size ,a))) - (declare (type type-blas-store ,store) - (type type-blas-store ,store2) - (type type-blas-idx ,len)) - (dotimes (,i ,len) - (setf (ref-blas-complex-store ,store2 ,i 0 ,len) - (,old (aref ,store ,i) - (ref-blas-complex-store ,store2 ,i 0 ,len)))) - ,b))))) - -(def-binary-op-matrix-base-zge .add +) - -(def-binary-op-matrix-base-zge .sub -) - -(def-binary-op-matrix-base-zge .mul *) - -(def-binary-op-matrix-base-zge .div /) - -(def-binary-op-matrix-base-zge .expt expt) -|# - -;;; Hm, much shared code here. Could make a unifying macro. - -#+nil (defmethod .imagpart ((a matrix-base-zge)) - (let* ((description (create-matrix-description a :et :d)) - (b (make-matrix-instance description (dim a) 0)) - (store-a (matrix-store a)) - (store-b (matrix-store b)) - (len (size a))) - (declare (type type-blas-store store-a store-b) - (type type-blas-idx len)) - (dotimes (i len) - (setf (aref store-b i) - (aref store-a (1+ (* 2 i))))) - b)) - -#+nil (defmethod .realpart ((a matrix-base-zge)) - (let* ((description (create-matrix-description a :et :d)) - (b (make-matrix-instance description (dim a) 0)) - (store-a (matrix-store a)) - (store-b (matrix-store b)) - (len (size a))) - (declare (type type-blas-store store-a store-b) - (type type-blas-idx len)) - (dotimes (i len) - (setf (aref store-b i) - (aref store-a (* 2 i)))) - b)) - -#+nil (defmethod .abs ((a matrix-base-zge)) - (let* ((description (create-matrix-description a :et :d)) - (b (make-matrix-instance description (dim a) 0)) - (store-a (matrix-store a)) - (store-b (matrix-store b)) - (len (size a))) - (declare (type type-blas-store store-a store-b) - (type type-blas-idx len)) - (dotimes (i len) - (setf (aref store-b i) - (let ((x (aref store-a (* 2 i))) - (y (aref store-a (1+ (* 2 i))))) - (sqrt (+ (* x x) (* y y)))))) - b)) - Modified: src/matrix/store-operators.lisp ============================================================================== --- src/matrix/store-operators.lisp (original) +++ src/matrix/store-operators.lisp Thu Dec 10 15:18:32 2009 @@ -246,4 +246,101 @@ `(defun-cdfa-cdfa ,(cdr x) ,(car x))) +operators-cdfa-cdfa-map+))) -(expand-operators-cdfa-cdfa-map) \ No newline at end of file +(expand-operators-cdfa-cdfa-map) + + +;;;; Now, some special cases of real and imaginary mixing +;;; Other cases could be optimized too, but these cases are not so obvious. + +(defun +_cdfa-df (a b c) + (declare (type type-blas-store a c) + (type double-float b)) + (dotimes (i (floor (the type-blas-idx (size a)) 2)) + (let* ((2i (truly-the type-blas-idx (* 2 i))) + (2i+1 (the type-blas-idx (1+ 2i)))) + (declare (type type-blas-idx 2i 2i+1)) + (setf (aref c 2i) (+ (aref a 2i) b) + (aref c 2i+1) (aref a 2i+1) ))) + c) + +(defun +_cdfa-dfa (a b c) + (declare (type type-blas-store a b c)) + (dotimes (i (the type-blas-idx (size b))) + (let* ((2i (truly-the type-blas-idx (* 2 i))) + (2i+1 (the type-blas-idx (1+ 2i)))) + (declare (type type-blas-idx 2i 2i+1)) + (setf (aref c 2i) (+ (aref a 2i) (aref b i)) + (aref c 2i+1) (aref a 2i+1) ))) + c) + +(defun -_cdfa-df (a b c) + (declare (type type-blas-store a c) + (type double-float b)) + (dotimes (i (floor (the type-blas-idx (size a)) 2)) + (let* ((2i (truly-the type-blas-idx (* 2 i))) + (2i+1 (the type-blas-idx (1+ 2i)))) + (declare (type type-blas-idx 2i 2i+1)) + (setf (aref c 2i) (- (aref a 2i) b) + (aref c 2i+1) (aref a 2i+1) ))) + c) + +(defun -_cdfa-dfa (a b c) + (declare (type type-blas-store a b c)) + (dotimes (i (the type-blas-idx (size b))) + (let* ((2i (truly-the type-blas-idx (* 2 i))) + (2i+1 (the type-blas-idx (1+ 2i)))) + (declare (type type-blas-idx 2i 2i+1)) + (setf (aref c 2i) (- (aref a 2i) (aref b i)) + (aref c 2i+1) (aref a 2i+1) ))) + c) + +(defun -_df-cdfa (a b c) + (declare (type type-blas-store b c) + (type double-float a)) + (dotimes (i (floor (the type-blas-idx (size b)) 2)) + (let* ((2i (truly-the type-blas-idx (* 2 i))) + (2i+1 (the type-blas-idx (1+ 2i)))) + (declare (type type-blas-idx 2i 2i+1)) + (setf (aref c 2i) (- a (aref b 2i)) + (aref c 2i+1) (- (aref b 2i+1) )))) + c) + +(defun -_dfa-cdfa (a b c) + (declare (type type-blas-store a b c)) + (dotimes (i (the type-blas-idx (size a))) + (let* ((2i (truly-the type-blas-idx (* 2 i))) + (2i+1 (the type-blas-idx (1+ 2i)))) + (declare (type type-blas-idx 2i 2i+1)) + (setf (aref c 2i) (- (aref a i) (aref b 2i)) + (aref c 2i+1) (- (aref b 2i+1) )))) + c) + +(defun *_cdfa-df (a b c) + ;; Well, the same as +_dfa-df, but length is twice + (*_dfa-df a b c)) + +(defun *_cdfa-dfa (a b c) + (declare (type type-blas-store a b c)) + (dotimes (i (the type-blas-idx (size b))) + (let* ((2i (truly-the type-blas-idx (* 2 i))) + (2i+1 (the type-blas-idx (1+ 2i)))) + (declare (type type-blas-idx 2i 2i+1)) + (setf (aref c 2i) (* (aref a 2i) (aref b i)) + (aref c 2i+1) (* (aref a 2i+1) (aref b i))))) + c) + + +(defun /_cdfa-df (a b c) + ;; Well, the same as +_dfa-df, but length is twice + (/_dfa-df a b c)) + +(defun /_cdfa-dfa (a b c) + (declare (type type-blas-store a b c)) + (dotimes (i (the type-blas-idx (size b))) + (let* ((2i (truly-the type-blas-idx (* 2 i))) + (2i+1 (the type-blas-idx (1+ 2i)))) + (declare (type type-blas-idx 2i 2i+1)) + (setf (aref c 2i) (/ (aref a 2i) (aref b i)) + (aref c 2i+1) (/ (aref a 2i+1) (aref b i))))) + c) + From jivestgarden at common-lisp.net Sat Dec 12 19:31:02 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 12 Dec 2009 14:31:02 -0500 Subject: [lisplab-cvs] r118 - in src: core matrix Message-ID: Author: jivestgarden Date: Sat Dec 12 14:31:02 2009 New Revision: 118 Log: optimized and cleaned up functions and operators Modified: src/core/level0-default.lisp src/matrix/level2-function.lisp src/matrix/level2-matrix-dge.lisp src/matrix/level2-matrix-zge.lisp src/matrix/store-operators.lisp src/matrix/store-ordinary-functions.lisp Modified: src/core/level0-default.lisp ============================================================================== --- src/core/level0-default.lisp (original) +++ src/core/level0-default.lisp Sat Dec 12 14:31:02 2009 @@ -42,6 +42,12 @@ ;;; Some known exepctions +(defmethod function-output-type-spec ((fun (eql '.ln)) (input-spec (eql :d))) + :z) + +(defmethod function-output-type-spec ((fun (eql '.sqrt)) (input-spec (eql :d))) + :z) + (defmethod function-output-type-spec ((fun (eql '.asin)) (input-spec (eql :d))) :z) Modified: src/matrix/level2-function.lisp ============================================================================== --- src/matrix/level2-function.lisp (original) +++ src/matrix/level2-function.lisp Sat Dec 12 14:31:02 2009 @@ -40,10 +40,8 @@ `(def-each-element-function ,name)) +ordinary-functions-number-to-number-list+ ))) - (expand-each-element-ordinary-functions) - ;;; Some special functions. Should maybe be separated out. @@ -103,53 +101,3 @@ a)) - -#| - - -(defmacro each-element-function-matrix-ge (x form) - "Applies a form on each element of an matrix-ge." - (let ((i (gensym)) - (y (gensym))) - `(let* ((,y (copy ,x))) - (dotimes (,i (size ,y)) - (let ((,x (vref ,y ,i))) - (setf (vref ,y ,i) - ,form))) - ,y))) - -(defmacro expand-matrix-ge-num-num () - (cons 'progn - (mapcar (lambda (name) - ;; Note: not using the (cdr name) , which is only valid - ;; for build in lisp types. - `(defmethod ,(car name) ((x matrix-ge)) - (each-element-function-matrix-ge x (,(car name) x)))) - +functions-real-to-real+))) - -(expand-matrix-ge-num-num) - -(defmethod .log ((x matrix-ge) &optional base) - (each-element-function-matrix-ge x (.log x base))) - -;;; Bessel functions - -(defmethod .besj (n (x matrix-ge)) - (each-element-function-matrix-ge x (.besj n x))) - -(defmethod .besy (n (x matrix-ge)) - (each-element-function-matrix-ge x (.besy n x))) - -(defmethod .besi (n (x matrix-ge)) - (each-element-function-matrix-ge x (.besi n x))) - -(defmethod .besk (n (x matrix-ge)) - (each-element-function-matrix-ge x (.besk n x))) - -(defmethod .besh1 (n (x matrix-ge)) - (each-element-function-matrix-ge x (.besh1 n x))) - -(defmethod .besh2 (n (x matrix-ge)) - (each-element-function-matrix-ge x (.besh2 n x))) - -|# \ No newline at end of file Modified: src/matrix/level2-matrix-dge.lisp ============================================================================== --- src/matrix/level2-matrix-dge.lisp (original) +++ src/matrix/level2-matrix-dge.lisp Sat Dec 12 14:31:02 2009 @@ -26,13 +26,16 @@ (fill store x))) (defmethod copy ((matrix matrix-base-dge)) - (make-instance (class-name (class-of matrix)) - :store (copy-seq (the type-blas-store (matrix-store matrix))) - :dim (dim matrix))) + (let ((store (matrix-store matrix))) + (declare (type type-blas-store store)) + (make-instance (class-name (class-of matrix)) + :store store + :dim (dim matrix)))) (defmethod copy-contents ((a matrix-base-dge) (b matrix-base-dge) &optional (converter nil)) (let ((store-a (matrix-store a)) (store-b (matrix-store b))) + (declare (type type-blas-store store-a store-b)) (if converter (map-into store-b converter store-a) (copy-matrix-stores store-a store-b))) @@ -47,12 +50,18 @@ out) (defmethod mmap ((type (eql nil)) f (a matrix-base-dge) &rest args) - (apply #'map - nil - (lambda (&rest args) - (coerce (apply f args) 'double-float)) - (matrix-store a) (mapcar #'matrix-store args)) - nil) + "No output. Called for side effects." + (declare (type (function (double-float) t) f)) + (if args + (apply #'map + nil + (lambda (&rest args) + (apply f args)) + (matrix-store a) (mapcar #'matrix-store args)) + (let ((store (matrix-store a))) + (declare (type type-blas-store store)) + (map nil f store))) + nil) (defmethod msum ((m matrix-base-dge)) (let ((sum 0.0)) @@ -153,17 +162,21 @@ (expand-generic-function-dfa-dfa-map) -;;; The ordinary functions -;;;; Ordinary functions +;;;; Ordinary functions that map real to real (define-constant +generic-function-dfa-to-dfa-map+ ;really bad name - '((.sin . sin_dfa) (.cos . cos_dfa) (.tan . tan_dfa) - (.atan . atan_dfa) - (.sinh . sinh_dfa) (.cosh . cosh_dfa) (.tanh . tanh_dfa) - (.asinh . asinh_dfa) (.acosh . acosh_dfa) - (.exp . exp_dfa) (.ln . log_dfa) (.sqrt . sqrt_dfat) (.conjugate . conjugate_dfa) - (.re . realpart_dfa) (.im . imagpart_dfa) (.abs . abs_dfa))) + '((.sin . sin_dfa-to-dfa) (.cos . cos_dfa-to-dfa) (.tan . tan_dfa-to-dfa) + (.atan . atan_dfa-to-dfa) + (.sinh . sinh_dfa-to-dfa) (.cosh . cosh_dfa-to-dfa) (.tanh . tanh_dfa-to-dfa) + (.asinh . asinh_dfa-to-dfa) (.acosh . acosh_dfa-to-dfa) + (.exp . exp_dfa-to-dfa) + #+nil (.ln . log_dfa) + #+nil (.sqrt . sqrt_dfat) + #+nil (.conj . conjugate_dfa) + #+nil (.re . realpart_dfa) + #+nil (.im . imagpart_dfa) + (.abs . abs_dfa-to-dfa))) (defmacro defmethod-dfa-to-dfa (name underlying-function) (let ((a (gensym "a")) @@ -181,144 +194,42 @@ (expand-generic-function-dfa-to-dfa-map) -;;; The rest must wait until tomorrow - - - - - -;;;; Old code - -#| - -(defmacro each-matrix-element-df-to-df (x form) - "Applies a form on each element of an matrix-dge. The form must -make real output for real arguments" - (let ((i (gensym)) - (store (gensym))) - `(let* ((,x (copy ,x)) - (,store (matrix-store ,x))) - (declare (type type-blas-store ,store)) - (dotimes (,i (length ,store)) - (let ((,x (aref ,store ,i))) - (declare (type type-blas-idx ,i) - (type double-float ,x)) - (setf (aref ,store ,i) - ,form))) - ,x))) - -(defmacro expand-matrix-dge-num-num () - (cons 'progn - (mapcar (lambda (name) - `(defmethod ,(car name) ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (,(cdr name) x)))) - +functions-real-to-real+))) - -(expand-matrix-dge-num-num) - -;;; Bessel functions +;;; Some trivialities -(defmethod .besj (n (x matrix-base-dge)) - (each-matrix-element-df-to-df x (.besj n x))) - -(defmethod .besy (n (x matrix-base-dge)) - (each-matrix-element-df-to-df x (.besy n x))) +(defmethod .re ((a matrix-base-dge)) + (copy a)) -(defmethod .besi (n (x matrix-base-dge)) - (each-matrix-element-df-to-df x (.besi n x))) +(defmethod .im ((a matrix-base-dge)) + (mcreate a)) -(defmethod .besk (n (x matrix-base-dge)) - (each-matrix-element-df-to-df x (.besk n x))) +(defmethod .conj ((a matrix-base-dge)) + (copy a)) -(defmacro each-matrix-element-df-to-complex-df (x form) - "Applies a form on each element of an matrix-dge. The form must -make complex output for real arguments. TODO optimize? Probably no need. The -Hankel functions are slow anyway." - (let ((i (gensym)) - (b (gensym)) - (spec-b (gensym))) - `(let* ((,spec-b (create-matrix-description ,x :et :z)) - (,b (convert ,x ,spec-b) )) - (dotimes (,i (size ,x)) - (let ((,x (vref ,x ,i))) - (setf (vref ,b ,i) ,form))) - ,b))) +;;; Now these sad cases where output might be complex for real input -(defmethod .asin ((x matrix-base-dge)) - (each-matrix-element-df-to-complex-df x (asin x))) +(define-constant +generic-function-dfa-to-cdfa-map+ ;really bad name + '((.sqrt . sqrt_dfa) + (.ln . log_dfa) + (.asin . asin_dfa) + (.acos . acos_dfa) + (.atanh . atanh_dfa) + ;; Some more? + )) -(defmethod .acos ((x matrix-base-dge)) - (each-matrix-element-df-to-complex-df x (asin x))) - -(defmethod .atanh ((x matrix-base-dge)) - (each-matrix-element-df-to-complex-df x (asin x))) - -(defmethod .besh1 (n (x matrix-base-dge)) - (each-matrix-element-df-to-complex-df x (.besh1 n x))) - -(defmethod .besh2 (n (x matrix-base-dge)) - (each-matrix-element-df-to-complex-df x (.besh2 n x))) - -|# - -#| - -;;; Old code - -(defmacro def-binary-op-matrix-base-dge (new old) +(defmacro defmethod-dfa-to-cdfa (name underlying-function) (let ((a (gensym "a")) (b (gensym "b")) - (len (gensym "len")) - (store (gensym "store")) - (store2 (gensym "store2")) - (i (gensym "i"))) - `(progn - (defmethod ,new ((,a matrix-base-dge) (,b real)) - (let* ((,a (copy ,a)) - (,store (matrix-store ,a)) - (,b (coerce ,b 'double-float)) - (,len (size ,a))) - (declare (type double-float ,b) - (type type-blas-store ,store) - (type type-blas-idx ,len)) - (dotimes (,i ,len) - (setf (aref ,store ,i) (,old (aref ,store ,i) ,b))) - ,a)) - (defmethod ,new ((,a real) (,b matrix-base-dge)) - (let* ((,b (copy ,b)) - (,store (matrix-store ,b)) - (,a (coerce ,a 'double-float)) - (,len (size ,b))) - (declare (type double-float ,a) - (type type-blas-store ,store) - (type type-blas-idx ,len)) - (dotimes (,i ,len) - (setf (aref ,store ,i) (,old ,a (aref ,store ,i)))) - ,b)) - (defmethod ,new ((,a matrix-base-dge) (,b matrix-base-dge)) - (let* ((,a (copy ,a)) - (,store (matrix-store ,a)) - (,store2 (matrix-store ,b)) - (,len (size ,a))) - (declare (type type-blas-store ,store) - (type type-blas-store ,store2) - (type type-blas-idx ,len)) - (dotimes (,i ,len) - (setf (aref ,store ,i) (,old (aref ,store ,i) (aref ,store2 ,i)))) - ,a))))) - -(def-binary-op-matrix-base-dge .add +) - -(def-binary-op-matrix-base-dge .sub -) - -(def-binary-op-matrix-base-dge .mul *) - -(def-binary-op-matrix-base-dge .div /) - -(def-binary-op-matrix-base-dge .expt expt) - -(def-binary-op-matrix-base-dge .min min) + (spec (gensym "spec"))) + `(defmethod ,name ((,a matrix-base-dge)) + (let* ((,spec (cons :z (cdr (type-spec ,a)))) + (,b (make-matrix-instance ,spec (dim ,a) 0))) + (,underlying-function (matrix-store ,a) (matrix-store ,b) ) + ,b)))) -(def-binary-op-matrix-base-dge .max max) +(defmacro expand-generic-function-dfa-to-cdfa-map () + (cons 'progn + (mapcar (lambda (x) + `(defmethod-dfa-to-cdfa ,(car x) ,(cdr x))) + +generic-function-dfa-to-cdfa-map+))) -|# \ No newline at end of file +(expand-generic-function-dfa-to-cdfa-map) Modified: src/matrix/level2-matrix-zge.lisp ============================================================================== --- src/matrix/level2-matrix-zge.lisp (original) +++ src/matrix/level2-matrix-zge.lisp Sat Dec 12 14:31:02 2009 @@ -50,7 +50,7 @@ (declare (type type-blas-store store-a store-b) (type type-blas-idx len)) (dotimes (i len) - (setf (aref store-b (* 2 i)) (aref store-a i))) + (setf (aref store-b (truly-the type-blas-idx (* 2 i))) (aref store-a i))) to))) (defmethod msum ((m matrix-base-zge)) @@ -263,7 +263,7 @@ (.asin . asin_cdfa) (.acos . acos_cdfa) (.atan . atan_cdfa) (.sinh . sinh_cdfa) (.cosh . cosh_cdfa) (.tanh . tanh_cdfa) (.asinh . asinh_cdfa) (.acosh . acosh_cdfa) (.atanh . atanh_cdfa) - (.exp . exp_cdfa) (.ln . log_cdfa) (.sqrt . sqrt_cdfat) (.conjugate . conjugate_cdfa))) + (.exp . exp_cdfa) (.ln . log_cdfa) (.sqrt . sqrt_cdfat) (.conj . conjugate_cdfa))) (defmacro defmethod-cdfa-to-cdfa (name underlying-function) (let ((a (gensym "a")) @@ -284,26 +284,20 @@ ;;;; Exceptions, in that output is real for complex input (defmethod .im ((a matrix-base-zge)) - (let ((out (make-matrix-instance - (function-output-type-spec '.im (type-spec a)) - (dim a) - 0))) + (let* ((spec-out (cons :d (cdr (type-spec a)))) + (out (make-matrix-instance spec-out (dim a) 0))) (imagpart_cdfa (matrix-store a) (matrix-store out)) out)) (defmethod .re ((a matrix-base-zge)) - (let ((out (make-matrix-instance - (function-output-type-spec '.re (type-spec a)) - (dim a) - 0))) + (let* ((spec-out (cons :d (cdr (type-spec a)))) + (out (make-matrix-instance spec-out (dim a) 0))) (realpart_cdfa (matrix-store a) (matrix-store out)) out)) (defmethod .abs ((a matrix-base-zge)) - (let ((out (make-matrix-instance - (function-output-type-spec '.abs (type-spec a)) - (dim a) - 0))) + (let* ((spec-out (cons :d (cdr (type-spec a)))) + (out (make-matrix-instance spec-out (dim a) 0))) (abs_cdfa (matrix-store a) (matrix-store out)) out)) Modified: src/matrix/store-operators.lisp ============================================================================== --- src/matrix/store-operators.lisp (original) +++ src/matrix/store-operators.lisp Sat Dec 12 14:31:02 2009 @@ -33,10 +33,11 @@ ;;; 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 correct. +;;; 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! +;;; 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 @@ -48,8 +49,126 @@ ;;; They use a naming conventions, which should be pretty easy to ;;; guess, such as df = double float and cdfa = complex double float array. ;;; -;;; (The last one should for consistnt naming be changed to zdfa, but its not really important) +;;; (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) + +;;; The below operations are based on map-into. It is hope that some +;;; clever lisp machine can be very fast on them (On my SBCL 32 they are exactly +;;; the same speed as the iterative versions +(defun +_dfa-dfa (a b c) + (declare (type type-blas-store a b c)) + (map-into c #'+ a b)) + +(defun +_dfa-df (a b c) + (declare (type type-blas-store a c) + (type double-float b)) + (map-into c (lambda (x) (+ x b)) a)) + +(defun +_df-dfa (a b c) + (declare (type type-blas-store b c) + (type double-float a)) + (map-into c (lambda (x) (+ a x)) b)) + +(defun -_dfa-dfa (a b c) + (declare (type type-blas-store a b c)) + (map-into c #'- a b)) + +(defun -_dfa-df (a b c) + (declare (type type-blas-store a c) + (type double-float b)) + (map-into c (lambda (x) (- x b)) a)) + +(defun -_df-dfa (a b c) + (declare (type type-blas-store b c) + (type double-float a)) + (map-into c (lambda (x) (- a x)) b)) + +(defun *_dfa-dfa (a b c) + (declare (type type-blas-store a b c)) + (map-into c #'* a b)) + +(defun *_dfa-df (a b c) + (declare (type type-blas-store a c) + (type double-float b)) + (map-into c (lambda (x) (* x b)) a)) + +(defun *_df-dfa (a b c) + (declare (type type-blas-store b c) + (type double-float a)) + (map-into c (lambda (x) (* a x)) b)) + +(defun /_dfa-dfa (a b c) + (declare (type type-blas-store a b c)) + (map-into c #'/ a b)) + +(defun /_dfa-df (a b c) + (declare (type type-blas-store a c) + (type double-float b)) + (map-into c (lambda (x) (/ x b)) a)) + +(defun /_df-dfa (a b c) + (declare (type type-blas-store b c) + (type double-float a)) + (map-into c (lambda (x) (/ a x)) b)) + +(defun ^_dfa-dfa (a b c) + (declare (type type-blas-store a b c)) + (map-into c #'expt a b)) + +(defun ^_dfa-df (a b c) + (declare (type type-blas-store a c) + (type double-float b)) + (map-into c (lambda (x) (expt x b)) a)) + +(defun ^_df-dfa (a b c) + (declare (type type-blas-store b c) + (type double-float a)) + (map-into c (lambda (x) (expt a x)) b)) + +(defun max_dfa-dfa (a b c) + (declare (type type-blas-store a b c)) + (map-into c #'max a b)) + +(defun max_dfa-df (a b c) + (declare (type type-blas-store a c) + (type double-float b)) + (map-into c (lambda (x) (max x b)) a)) + +(defun max_df-dfa (a b c) + (declare (type type-blas-store b c) + (type double-float a)) + (map-into c (lambda (x) (max a x)) b)) + +(defun min_dfa-dfa (a b c) + (declare (type type-blas-store a b c)) + (map-into c #'min a b)) + +(defun min_dfa-df (a b c) + (declare (type type-blas-store a c) + (type double-float b)) + (map-into c (lambda (x) (min x b)) a)) + +(defun min_df-dfa (a b c) + (declare (type type-blas-store b c) + (type double-float a)) + (map-into c (lambda (x) (min a x)) b)) + + + +;;; Complex map-into-operations + +(defun +_cdfa-cdfa (a b c) + (+_dfa-dfa a b c)) + +(defun -_cdfa-cdfa (a b c) + (-_dfa-dfa a b c)) ;;; Array and number @@ -82,7 +201,7 @@ `(defun-dfa-df ,(cdr x) ,(car x))) +operators-dfa-df-map+))) -(expand-operators-dfa-df-map) +#+nil (expand-operators-dfa-df-map) ; These are the iterative versions ;;; The three parts of code below contains some common strucutre that could ;;; in principle be joined, and there is also some clumsy code, @@ -118,7 +237,7 @@ `(defun-df-dfa ,(cdr x) ,(car x))) +operators-df-dfa-map+))) -(expand-operators-df-dfa-map) +#+nil (expand-operators-df-dfa-map) ; These are the iterative versions ;;; Array and array @@ -149,7 +268,7 @@ `(defun-dfa-dfa ,(cdr x) ,(car x))) +operators-dfa-dfa-map+))) -(expand-operators-dfa-dfa-map) +#+nil (expand-operators-dfa-dfa-map) ; These are the iterative versions ;;; Now the complex operators @@ -158,8 +277,8 @@ ;;; Array and number (define-constant +operators-cdfa-cdf-map+ - '((+ . +_cdfa-cdf) - (- . -_cdfa-cdf) + '((+ . +_cdfa-cdf) ; iterative version + (- . -_cdfa-cdf) ; iterative version (* . *_cdfa-cdf) (/ . /_cdfa-cdf) (expt . ^_cdfa-cdf) @@ -222,8 +341,8 @@ ;;; Array and array (define-constant +operators-cdfa-cdfa-map+ - '((+ . +_cdfa-cdfa) - (- . -_cdfa-cdfa) + '(; (+ . +_cdfa-cdfa) + ; (- . -_cdfa-cdfa) (* . *_cdfa-cdfa) (/ . /_cdfa-cdfa) (expt . ^_cdfa-cdfa))) Modified: src/matrix/store-ordinary-functions.lisp ============================================================================== --- src/matrix/store-ordinary-functions.lisp (original) +++ src/matrix/store-ordinary-functions.lisp Sat Dec 12 14:31:02 2009 @@ -19,8 +19,6 @@ ;;; with this program; if not, write to the Free Software Foundation, Inc., ;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -;;; TODO: change name of this to something about blas store -;;; ;;; 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 @@ -28,6 +26,14 @@ ;;; ;;; The content of this file must be highly optimized ;;; and should not depend anything exept Common Lisp itself. +;;; +;;; I use map-into for the real functions (impossible for the complex functions) +;;; but keep the iterative versions still in the file since future versions +;;; of lisplab might use them. + +;;; Generate more real-to-real functions. With some kind of input these will +;;; fail and give complex output but for speed it can be ok to have them + (in-package :lisplab) @@ -36,14 +42,18 @@ ;;; Double-float to double float (define-constant +ordinary-functions-dfa-to-dfa-map+ - '((sin . sin_dfa) (cos . cos_dfa) (tan . tan_dfa) - (atan . atan_dfa) - (sinh . sinh_dfa) (cosh . cosh_dfa) (tanh . tanh_dfa) - (asinh . asinh_dfa) (acosh . acosh_dfa) - (exp . exp_dfa) (log . log_dfa) (sqrt . sqrt_dfat) (conjugate . conjugate_dfa) - (realpart . realpart_dfa) (imagpart . imagpart_dfa) (abs . abs_dfa))) + ;; List of functions that should map real to real. The list + ;; is not that long, since many functions, such as sqrt, have + ;; potentially complex output + '((sin . sin_dfa-to-dfa) (cos . cos_dfa-to-dfa) (tan . tan_dfa-to-dfa) + (atan . atan_dfa-to-dfa) + (sinh . sinh_dfa-to-dfa) (cosh . cosh_dfa-to-dfa) (tanh . tanh_dfa-to-dfa) + (asinh . asinh_dfa-to-dfa) (acosh . acosh_dfa-to-dfa) + (exp . exp_dfa-to-dfa) + (abs . abs_dfa-to-dfa))) -(defmacro defun-dfa-to-dfa (name op) +;; the iterative version +#+lisplab-iterative (defmacro defun-dfa-to-dfa-iterative (name op) (let ((a (gensym)) (out (gensym)) (i (gensym))) @@ -53,18 +63,44 @@ (setf (aref ,out ,i) (,op (aref ,a ,i)))) ,out))) +;; the iterative version +#+lisplab-iterative (defmacro expand-ordinary-functions-dfa-to-dfa-map-iterative () + (cons 'progn + (mapcar (lambda (x) + `(defun-dfa-to-dfa-iterative ,(cdr x) ,(car x))) + +ordinary-functions-dfa-to-dfa-map+))) + +;; the iterative version +#+lisplab-iterative (expand-ordinary-functions-dfa-to-dfa-map-iterative) + +;;; Non-iterative version +#-lisplab-iterative +(defmacro defun-dfa-to-dfa (name op) + (let ((a (gensym)) + (out (gensym))) + `(defun ,name (,a ,out) + (declare (type type-blas-store ,a ,out)) + (map-into ,out #',op ,a) + ,out))) + +;;; Non-iterative version +#-lisplab-iterative (defmacro expand-ordinary-functions-dfa-to-dfa-map () (cons 'progn (mapcar (lambda (x) `(defun-dfa-to-dfa ,(cdr x) ,(car x))) +ordinary-functions-dfa-to-dfa-map+))) -(expand-ordinary-functions-dfa-to-dfa-map) +;;; Non-iterative version +#-lisplab-iterative +(expand-ordinary-functions-dfa-to-dfa-map) ; the iterative version + ;;; double float to complex double float (define-constant +ordinary-functions-dfa-to-cdfa-map+ - '((asin . asin_dfa) (acos . acos_dfa) (atanh . atanh_dfa))) + '((asin . asin_dfa) (acos . acos_dfa) (atanh . atanh_dfa) + (log . log_dfa) (sqrt . sqrt_dfa))) (defmacro defun-dfa-to-cdfa (name op) (let ((a (gensym)) @@ -73,7 +109,8 @@ `(defun ,name (,a ,out) (declare (type type-blas-store ,a ,out)) (dotimes (,i (length ,a)) - (setf (vref-blas-complex-store ,out ,i) (,op (aref ,a ,i)))) + (setf (vref-blas-complex-store ,out ,i) + (coerce (,op (aref ,a ,i)) '(complex double-float)))) ,out))) (defmacro expand-ordinary-functions-dfa-to-cdfa-map () @@ -86,26 +123,26 @@ ;;; Complex double float to double float -(define-constant +ordinary-functions-cdfa-to-dfa-map+ - '((realpart . realpart_cdfa) (imagpart . imagpart_cdfa) (abs . abs_cdfa))) - -(defmacro defun-cdfa-to-dfa (name op) - (let ((a (gensym)) - (out (gensym)) - (i (gensym))) - `(defun ,name (,a ,out) - (declare (type type-blas-store ,a ,out)) - (dotimes (,i (floor (length ,a) 2)) - (setf (aref ,out ,i) (,op (vref-blas-complex-store ,a ,i)))) - ,out))) - -(defmacro expand-ordinary-functions-cdfa-to-dfa-map () - (cons 'progn - (mapcar (lambda (x) - `(defun-cdfa-to-dfa ,(cdr x) ,(car x))) - +ordinary-functions-cdfa-to-dfa-map+))) - -(expand-ordinary-functions-cdfa-to-dfa-map) +(defun abs_cdfa (a out) + (declare (type type-blas-store a out)) + (dotimes (i (length out)) + (setf (aref out i) + (abs (vref-blas-complex-store a i)))) + out) + +(defun realpart_cdfa (a out) + (declare (type type-blas-store a out)) + (dotimes (i (length out)) + (setf (aref out i) + (aref a (truly-the type-blas-idx (* 2 i))))) + out) + +(defun imagpart_cdfa (a out) + (declare (type type-blas-store a out)) + (dotimes (i (length out)) + (setf (aref out i) + (aref a (truly-the type-blas-idx (1+ (* 2 i)))))) + out) ;;; Complex double float to complex double float @@ -114,7 +151,8 @@ (atan . atan_cdfa) (sinh . sinh_cdfa) (cosh . cosh_cdfa) (tanh . tanh_cdfa) (asinh . asinh_cdfa) (acosh . acosh_cdfa) - (exp . exp_cdfa) (log . log_cdfa) (sqrt . sqrt_cdfat) (conjugate . conjugate_cdfa) + (exp . exp_cdfa) (log . log_cdfa) (sqrt . sqrt_cdfat) + #+nil (conjugate . conjugate_cdfa) ;; separate implementation! (asin . asin_cdfa) (acos . acos_cdfa) (atanh . atanh_cdfa))) (defmacro defun-cdfa-to-cdfa (name op) @@ -133,4 +171,16 @@ `(defun-cdfa-to-cdfa ,(cdr x) ,(car x))) +ordinary-functions-cdfa-to-cdfa-map+))) -(expand-ordinary-functions-cdfa-to-cdfa-map) \ No newline at end of file +(expand-ordinary-functions-cdfa-to-cdfa-map) + +;; Conjugate + +(defun conjugate_cdfa (a out) + (declare (type type-blas-store a out)) + (dotimes (i (floor (length a) 2)) + (let* ((2i (* 2 i)) + (2i+1 (1+ 2i))) + (declare (type type-blas-idx 2i 2i+1)) + (setf (aref out 2i) (aref a 2i) + (aref out 2i+1) (- (aref a 2i+1))))) + out) \ No newline at end of file From jivestgarden at common-lisp.net Sat Dec 12 19:48:02 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 12 Dec 2009 14:48:02 -0500 Subject: [lisplab-cvs] r119 - src/matrix Message-ID: Author: jivestgarden Date: Sat Dec 12 14:48:01 2009 New Revision: 119 Log: optimized mmax mmin mabsmax mabsmin Modified: src/matrix/level2-matrix-dge.lisp Modified: src/matrix/level2-matrix-dge.lisp ============================================================================== --- src/matrix/level2-matrix-dge.lisp (original) +++ src/matrix/level2-matrix-dge.lisp Sat Dec 12 14:48:01 2009 @@ -69,6 +69,54 @@ (incf sum x)) sum)) +(defmethod mmax ((m matrix-base-dge)) + "Retuns the minimum element of m." + (let* ((store (matrix-store m)) + (max (aref store 0))) + (declare (type type-blas-store store) + (type double-float max)) + (dotimes (i (length store)) + (when (> (aref store i) max) + (setf max (aref store i)))) + max)) + +(defmethod mmin ((m matrix-base-dge)) + "Retuns the minimum element of m." + (let* ((store (matrix-store m)) + (min (aref store 0))) + (declare (type type-blas-store store) + (type double-float min)) + (dotimes (i (length store)) + (when (< (aref store i) min) + (setf min (aref store i)))) + min)) + +(defmethod mabsmax ((m matrix-base-dge)) + "Retuns the minimum element of m." + (let* ((store (matrix-store m)) + (max (aref store 0))) + (declare (type type-blas-store store) + (type double-float max)) + (dotimes (i (length store)) + (when (> (abs (aref store i)) (abs max)) + (setf max (aref store i)))) + max)) + +(defmethod mabsmin ((m matrix-base-dge)) + "Retuns the minimum element of m." + (let* ((store (matrix-store m)) + (min (aref store 0))) + (declare (type type-blas-store store) + (type double-float min)) + (dotimes (i (length store)) + (when (< (abs (aref store i)) (abs min)) + (setf min (aref store i)))) + min)) + + + + + (defmethod .some (pred (a matrix-base-dge) &rest args) (let ((stores (mapcar #'matrix-store (cons a args)))) (apply #'some pred stores))) From jivestgarden at common-lisp.net Sun Dec 13 14:03:05 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sun, 13 Dec 2009 09:03:05 -0500 Subject: [lisplab-cvs] r120 - src/matrix Message-ID: Author: jivestgarden Date: Sun Dec 13 09:03:04 2009 New Revision: 120 Log: special cases or mixed real and complex Modified: src/matrix/level2-generic.lisp src/matrix/level2-interface.lisp src/matrix/level2-matrix-dge.lisp src/matrix/level2-matrix-zge.lisp src/matrix/store-ordinary-functions.lisp Modified: src/matrix/level2-generic.lisp ============================================================================== --- src/matrix/level2-generic.lisp (original) +++ src/matrix/level2-generic.lisp Sun Dec 13 09:03:04 2009 @@ -173,6 +173,17 @@ (setf min (vref m i)))) min)) +(defmethod mminmax ((m matrix-base)) + "Retuns the maximum element of m." + (let ((max (vref m 0)) + (min (vref m 0))) + (dotimes (i (size m)) + (when (.> (vref m i) max) + (setf max (vref m i))) + (when (.< (vref m i) min) + (setf min (vref m i)))) + (list min max))) + (defmethod mfill ((a matrix-base) val) (dotimes (i (size a)) (setf (vref a i) val)) Modified: src/matrix/level2-interface.lisp ============================================================================== --- src/matrix/level2-interface.lisp (original) +++ src/matrix/level2-interface.lisp Sun Dec 13 09:03:04 2009 @@ -130,6 +130,9 @@ (defgeneric mabsmax (m) (:documentation "Retuns the matrix element with largest absolute value")) +(defgeneric mminmax (m) + (:documentation "Retuns a list with (minumum maximum)")) + (defgeneric circ-shift (m shifts) (:documentation "Shifts the matrix with periodic indecices")) Modified: src/matrix/level2-matrix-dge.lisp ============================================================================== --- src/matrix/level2-matrix-dge.lisp (original) +++ src/matrix/level2-matrix-dge.lisp Sun Dec 13 09:03:04 2009 @@ -51,12 +51,10 @@ (defmethod mmap ((type (eql nil)) f (a matrix-base-dge) &rest args) "No output. Called for side effects." - (declare (type (function (double-float) t) f)) (if args (apply #'map nil - (lambda (&rest args) - (apply f args)) + f (matrix-store a) (mapcar #'matrix-store args)) (let ((store (matrix-store a))) (declare (type type-blas-store store)) @@ -91,6 +89,20 @@ (setf min (aref store i)))) min)) +(defmethod mminmax ((m matrix-base-dge)) + "Retuns the minimum element of m." + (let* ((store (matrix-store m)) + (max (aref store 0)) + (min (aref store 0))) + (declare (type type-blas-store store) + (type double-float max min)) + (dotimes (i (length store)) + (when (> (aref store i) max) + (setf max (aref store i))) + (when (< (aref store i) min) + (setf min (aref store i)))) + (list min max))) + (defmethod mabsmax ((m matrix-base-dge)) "Retuns the minimum element of m." (let* ((store (matrix-store m)) @@ -113,10 +125,6 @@ (setf min (aref store i)))) min)) - - - - (defmethod .some (pred (a matrix-base-dge) &rest args) (let ((stores (mapcar #'matrix-store (cons a args)))) (apply #'some pred stores))) @@ -211,13 +219,21 @@ (expand-generic-function-dfa-dfa-map) -;;;; Ordinary functions that map real to real + (define-constant +generic-function-dfa-to-dfa-map+ ;really bad name - '((.sin . sin_dfa-to-dfa) (.cos . cos_dfa-to-dfa) (.tan . tan_dfa-to-dfa) + ;; Ordinary functions that map real to real + ;; Some functions like sqrt are not part of the list + ;; since they possibly spit out complex numbers + '((.sin . sin_dfa-to-dfa) + (.cos . cos_dfa-to-dfa) + (.tan . tan_dfa-to-dfa) (.atan . atan_dfa-to-dfa) - (.sinh . sinh_dfa-to-dfa) (.cosh . cosh_dfa-to-dfa) (.tanh . tanh_dfa-to-dfa) - (.asinh . asinh_dfa-to-dfa) (.acosh . acosh_dfa-to-dfa) + (.sinh . sinh_dfa-to-dfa) + (.cosh . cosh_dfa-to-dfa) + (.tanh . tanh_dfa-to-dfa) + (.asinh . asinh_dfa-to-dfa) + (.acosh . acosh_dfa-to-dfa) (.exp . exp_dfa-to-dfa) #+nil (.ln . log_dfa) #+nil (.sqrt . sqrt_dfat) @@ -242,7 +258,7 @@ (expand-generic-function-dfa-to-dfa-map) -;;; Some trivialities +;;; Some exceptions, where output can be either real or complex. (defmethod .re ((a matrix-base-dge)) (copy a)) @@ -253,6 +269,71 @@ (defmethod .conj ((a matrix-base-dge)) (copy a)) +(defmethod .sqrt ((a matrix-base-dge)) + (if (>= (mmin a) 0.0) + (let ((out (mcreate a))) + (sqrt_dfa-to-dfa (matrix-store a) (matrix-store out)) + out) + (let ((out (make-matrix-instance (cons :z (cdr (type-spec a))) + (dim a) + 0.0))) + (sqrt_dfa-to-cdfa (matrix-store a) (matrix-store out)) + out))) + +(defmethod .ln ((a matrix-base-dge)) + (if (> (mmin a) 0.0) + (let ((out (mcreate a))) + (log_dfa-to-dfa (matrix-store a) (matrix-store out)) + out) + (let ((out (make-matrix-instance (cons :z (cdr (type-spec a))) + (dim a) + 0.0))) + (log_dfa-to-cdfa (matrix-store a) (matrix-store out)) + out))) + +(defmethod .asin ((a matrix-base-dge)) + (destructuring-bind (min max) + (mminmax a) + (if (and (>= min -1.0) + (<= max 1.0)) + (let ((out (mcreate a))) + (asin_dfa-to-dfa (matrix-store a) (matrix-store out)) + out) + (let ((out (make-matrix-instance (cons :z (cdr (type-spec a))) + (dim a) + 0.0))) + (asin_dfa-to-cdfa (matrix-store a) (matrix-store out)) + out)))) + +(defmethod .acos ((a matrix-base-dge)) + (destructuring-bind (min max) + (mminmax a) + (if (and (>= min -1.0) + (<= max 1.0)) + (let ((out (mcreate a))) + (acos_dfa-to-dfa (matrix-store a) (matrix-store out)) + out) + (let ((out (make-matrix-instance (cons :z (cdr (type-spec a))) + (dim a) + 0.0))) + (acos_dfa-to-cdfa (matrix-store a) (matrix-store out)) + out)))) + +(defmethod .atanh ((a matrix-base-dge)) + (destructuring-bind (min max) + (mminmax a) + (if (and (> min -1.0) + (< max 1.0)) + (let ((out (mcreate a))) + (atanh_dfa-to-dfa (matrix-store a) (matrix-store out)) + out) + (let ((out (make-matrix-instance (cons :z (cdr (type-spec a))) + (dim a) + 0.0))) + (atanh_dfa-to-cdfa (matrix-store a) (matrix-store out)) + out)))) + +#| ;;; Now these sad cases where output might be complex for real input (define-constant +generic-function-dfa-to-cdfa-map+ ;really bad name @@ -281,3 +362,4 @@ +generic-function-dfa-to-cdfa-map+))) (expand-generic-function-dfa-to-cdfa-map) +|# \ No newline at end of file Modified: src/matrix/level2-matrix-zge.lisp ============================================================================== --- src/matrix/level2-matrix-zge.lisp (original) +++ src/matrix/level2-matrix-zge.lisp Sun Dec 13 09:03:04 2009 @@ -100,7 +100,7 @@ (.sub . -_cdf-cdfa) (.mul . *_cdf-cdfa) (.div . /_cdf-cdfa) - (.expt . ^_cdf-cdfa) )) + (.expt . ^_cdf-cdfa))) (defmacro defmethod-cdf-cdfa (name underlying-function) (let ((a (gensym "a")) @@ -259,11 +259,22 @@ ;;;; Ordinary functions (define-constant +generic-function-cdfa-to-cdfa-map+ ;really bad name - '((.sin . sin_cdfa) (.cos . cos_cdfa) (.tan . tan_cdfa) - (.asin . asin_cdfa) (.acos . acos_cdfa) (.atan . atan_cdfa) - (.sinh . sinh_cdfa) (.cosh . cosh_cdfa) (.tanh . tanh_cdfa) - (.asinh . asinh_cdfa) (.acosh . acosh_cdfa) (.atanh . atanh_cdfa) - (.exp . exp_cdfa) (.ln . log_cdfa) (.sqrt . sqrt_cdfat) (.conj . conjugate_cdfa))) + '((.sin . sin_cdfa-to-cdfa) + (.cos . cos_cdfa-to-cdfa) + (.tan . tan_cdfa-to-cdfa) + (.asin . asin_cdfa-to-cdfa) + (.acos . acos_cdfa-to-cdfa) + (.atan . atan_cdfa-to-cdfa) + (.sinh . sinh_cdfa-to-cdfa) + (.cosh . cosh_cdfa-to-cdfa) + (.tanh . tanh_cdfa-to-cdfa) + (.asinh . asinh_cdfa-to-cdfa) + (.acosh . acosh_cdfa-to-cdfa) + (.atanh . atanh_cdfa-to-cdfa) + (.exp . exp_cdfa-to-cdfa) + (.ln . log_cdfa-to-cdfa) + (.sqrt . sqrt_cdfa-to-cdfa) + (.conj . conjugate_cdfa-to-cdfa))) (defmacro defmethod-cdfa-to-cdfa (name underlying-function) (let ((a (gensym "a")) Modified: src/matrix/store-ordinary-functions.lisp ============================================================================== --- src/matrix/store-ordinary-functions.lisp (original) +++ src/matrix/store-ordinary-functions.lisp Sun Dec 13 09:03:04 2009 @@ -42,14 +42,24 @@ ;;; Double-float to double float (define-constant +ordinary-functions-dfa-to-dfa-map+ - ;; List of functions that should map real to real. The list - ;; is not that long, since many functions, such as sqrt, have - ;; potentially complex output - '((sin . sin_dfa-to-dfa) (cos . cos_dfa-to-dfa) (tan . tan_dfa-to-dfa) - (atan . atan_dfa-to-dfa) - (sinh . sinh_dfa-to-dfa) (cosh . cosh_dfa-to-dfa) (tanh . tanh_dfa-to-dfa) - (asinh . asinh_dfa-to-dfa) (acosh . acosh_dfa-to-dfa) + ;; Real to real functions. Note that not all of the + ;; functions are safe to use, such as sqrt. The caller + ;; must make sure that the input give real output also. + '((sin . sin_dfa-to-dfa) + (cos . cos_dfa-to-dfa) + (tan . tan_dfa-to-dfa) + (asin . asin_dfa-to-dfa) + (acos . acos_dfa-to-dfa) + (atan . atan_dfa-to-dfa) + (sinh . sinh_dfa-to-dfa) + (cosh . cosh_dfa-to-dfa) + (tanh . tanh_dfa-to-dfa) + (asinh . asinh_dfa-to-dfa) + (acosh . acosh_dfa-to-dfa) + (atanh . atanh_dfa-to-dfa) + (sqrt . sqrt_dfa-to-dfa) (exp . exp_dfa-to-dfa) + (log . log_dfa-to-dfa) (abs . abs_dfa-to-dfa))) ;; the iterative version @@ -95,12 +105,14 @@ #-lisplab-iterative (expand-ordinary-functions-dfa-to-dfa-map) ; the iterative version - -;;; double float to complex double float - (define-constant +ordinary-functions-dfa-to-cdfa-map+ - '((asin . asin_dfa) (acos . acos_dfa) (atanh . atanh_dfa) - (log . log_dfa) (sqrt . sqrt_dfa))) + ;; double float to complex double float + ;; Hm the list should include most functions. + '((asin . asin_dfa-to-cdfa) + (acos . acos_dfa-to-cdfa) + (atanh . atanh_dfa-to-cdfa) + (log . log_dfa-to-cdfa) + (sqrt . sqrt_dfa-to-cdfa))) (defmacro defun-dfa-to-cdfa (name op) (let ((a (gensym)) @@ -147,13 +159,22 @@ ;;; Complex double float to complex double float (define-constant +ordinary-functions-cdfa-to-cdfa-map+ - '((sin . sin_cdfa) (cos . cos_cdfa) (tan . tan_cdfa) - (atan . atan_cdfa) - (sinh . sinh_cdfa) (cosh . cosh_cdfa) (tanh . tanh_cdfa) - (asinh . asinh_cdfa) (acosh . acosh_cdfa) - (exp . exp_cdfa) (log . log_cdfa) (sqrt . sqrt_cdfat) + '((sin . sin_cdfa-to-cdfa) + (cos . cos_cdfa-to-cdfa) + (tan . tan_cdfa-to-cdfa) + (atan . atan_cdfa-to-cdfa) + (sinh . sinh_cdfa-to-cdfa) + (cosh . cosh_cdfa-to-cdfa) + (tanh . tanh_cdfa-to-cdfa) + (asinh . asinh_cdfa-to-cdfa) + (acosh . acosh_cdfa-to-cdfa) + (exp . exp_cdfa-to-cdfa) + (log . log_cdfa-to-cdfa) + (sqrt . sqrt_cdfa-to-cdfa) #+nil (conjugate . conjugate_cdfa) ;; separate implementation! - (asin . asin_cdfa) (acos . acos_cdfa) (atanh . atanh_cdfa))) + (asin . asin_cdfa-to-cdfa) + (acos . acos_cdfa-to-cdfa) + (atanh . atanh_cdfa-to-cdfa))) (defmacro defun-cdfa-to-cdfa (name op) (let ((a (gensym)) @@ -175,7 +196,7 @@ ;; Conjugate -(defun conjugate_cdfa (a out) +(defun conjugate_cdfa-to-cdfa (a out) (declare (type type-blas-store a out)) (dotimes (i (floor (length a) 2)) (let* ((2i (* 2 i)) From jivestgarden at common-lisp.net Sun Dec 13 14:19:16 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sun, 13 Dec 2009 09:19:16 -0500 Subject: [lisplab-cvs] r121 - in src: fft matrix Message-ID: Author: jivestgarden Date: Sun Dec 13 09:19:15 2009 New Revision: 121 Log: optimized constuctores and fftshift Modified: src/fft/level3-fft-zge.lisp src/matrix/level2-constructors.lisp Modified: src/fft/level3-fft-zge.lisp ============================================================================== --- src/fft/level3-fft-zge.lisp (original) +++ src/fft/level3-fft-zge.lisp Sun Dec 13 09:19:15 2009 @@ -19,8 +19,53 @@ ;;; TODO should use the normal ref-blas-complex-store ? +;;; TODO make shift routines for complex matrices also. + (in-package :lisplab) +;; Optimized shift methods for real matrix. +(defmethod fft-shift ((m matrix-base-dge)) + (let* ((rows (rows m)) + (fr (floor rows 2)) + (cr (ceiling rows 2)) + (cols (cols m)) + (fc (floor cols 2)) + (cc (ceiling cols 2)) + (store-m (matrix-store m)) + (m2 (mcreate m)) + (store-m2 (matrix-store m2))) + + (declare (type type-blas-store store-m store-m2) + (type type-blas-idx fr cr fc cc rows cols)) + (dotimes (i rows) + (dotimes (j cols) + (setf (aref store-m2 (column-major-idx i j rows)) + (aref store-m (column-major-idx (if (< i fr) (+ i cr) (- i fr)) + (if (< j fc) (+ j cc) (- j fc)) + rows))))) + m2)) + +(defmethod ifft-shift ((m matrix-base-dge)) + (let* ((rows (rows m)) + (fr (floor rows 2)) + (cr (ceiling rows 2)) + (cols (cols m)) + (fc (floor cols 2)) + (cc (ceiling cols 2)) + (store-m (matrix-store m)) + (m2 (mcreate m)) + (store-m2 (matrix-store m2))) + + (declare (type type-blas-store store-m store-m2) + (type type-blas-idx fr cr fc cc rows cols)) + (dotimes (i rows) + (dotimes (j cols) + (setf (aref store-m2 (column-major-idx i j rows)) + (aref store-m (column-major-idx (if (< i cr) (+ i fr) (- i cr)) + (if (< j cc) (+ j fc) (- j cc)) + rows))))) + m2)) + ;;;; The implementing methods (defmethod fft1! ((x matrix-lisp-zge) &key) @@ -119,10 +164,15 @@ (type (integer 0 30) bit) (type (complex double-float) W tmp)) (loop for b from 0 below n by (* 2 dual) do - (let* ((wd (ref-blas-complex-store2 ftx (truly-the type-blas-idx (+ b dual)) start step))) + (let* ((wd (ref-blas-complex-store2 ftx + (truly-the type-blas-idx (+ b dual)) + start + step))) (declare (type-blas-idx b) ((complex double-float) Wd)) - (setf (ref-blas-complex-store2 ftx (truly-the type-blas-idx (+ b dual)) start step) + (setf (ref-blas-complex-store2 ftx (truly-the type-blas-idx (+ b dual)) + start + step) (- (ref-blas-complex-store2 ftx b start step) wd)) (incf (ref-blas-complex-store2 ftx b start step) wd))) @@ -151,8 +201,10 @@ (declare (type-blas-idx i k)) (when (< i j) (let ((tmp (ref-blas-complex-store2 vec i start step))) - (setf (ref-blas-complex-store2 vec i start step) (ref-blas-complex-store2 vec j start step) - (ref-blas-complex-store2 vec j start step) tmp))) + (setf (ref-blas-complex-store2 vec i start step) + (ref-blas-complex-store2 vec j start step) + (ref-blas-complex-store2 vec j start step) + tmp))) (do () ((> k j)) (setf j (the type-blas-idx (- j k)) k (floor k 2))) Modified: src/matrix/level2-constructors.lisp ============================================================================== --- src/matrix/level2-constructors.lisp (original) +++ src/matrix/level2-constructors.lisp Sun Dec 13 09:19:15 2009 @@ -113,27 +113,41 @@ For example: (drange 4 0 1) -> 0 1 2 3, while (drange 4 0 1 0.5) -> 0.5 1.5 2.5 3.5." - (let ((x (dnew 0 n 1)) - (dx (./ (.- to from) N))) - (dotimes (i n) - (setf (vref x i) (.+ from (.* dx (.+ i shift))))) - x)) + (let* ((x (dnew 0 n 1)) + (store (matrix-store x)) + (dx (/ (- (to-df to) (to-df from)) (to-df N))) + (shift (* dx (to-df shift)))) + (declare (type type-blas-store store) + (type type-blas-idx n) + (type double-float dx shift)) + (do ((i 0 (1+ i)) + (v (to-df from) (+ v dx))) + ((>= i n) x) + (declare (type double-float v)) + (setf (aref store i) (+ shift v))))) (defun dgrid (xv yv) "Creates grid matrices from input vectors. Input are the x and y vectors and outputs are a list of x and y matrices. The input vectors are typically created with drange." - (let* ((r (size xv)) - (c (size yv)) - (x (dnew 0 r c)) - (y (dnew 0 r c))) + (let* ((r (size xv)) + (c (size yv)) + (x (dnew 0 r c)) + (y (dnew 0 r c)) + (xv* (matrix-store xv)) + (yv* (matrix-store yv)) + (x* (matrix-store x)) + (y* (matrix-store y))) + (declare (type type-blas-store xv* yv* x* y*) + (type type-blas-idx r c)) (dotimes (i r) - (dotimes (j c) - (setf (mref x i j) (vref xv i) - (mref y i j) (vref yv j)))) + (dotimes (j c) + (let ((k (column-major-idx i j r))) + (declare (type type-blas-idx k)) + (setf (aref x* k) (aref xv* i) + (aref y* k) (aref yv* j))))) (list x y))) - ;;; Constructors for matrix-zge (defmacro zmat (&body args) From jivestgarden at common-lisp.net Sun Dec 13 15:17:43 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sun, 13 Dec 2009 10:17:43 -0500 Subject: [lisplab-cvs] r122 - in src: core matrix Message-ID: Author: jivestgarden Date: Sun Dec 13 10:17:43 2009 New Revision: 122 Log: changed function matrix constructors from macro to function Modified: src/core/level0-permutation.lisp src/matrix/level2-constructors.lisp Modified: src/core/level0-permutation.lisp ============================================================================== --- src/core/level0-permutation.lisp (original) +++ src/core/level0-permutation.lisp Sun Dec 13 10:17:43 2009 @@ -1,4 +1,4 @@ -;;; Level2-funmat.lisp +;;; Level2-permutations.lisp ;;; Permutation of matrix indices. ;;; Copyright (C) 2009 Joern Inge Vestgaarden Modified: src/matrix/level2-constructors.lisp ============================================================================== --- src/matrix/level2-constructors.lisp (original) +++ src/matrix/level2-constructors.lisp Sun Dec 13 10:17:43 2009 @@ -180,28 +180,24 @@ ;;; Function matrix -(defmacro funmat (dim args &body body) - "Creates a read only function matrix" - (let ((rows2 (gensym "rows")) - (cols2 (gensym "cols")) - (i (gensym)) - (r (gensym)) - (c (gensym))) - `(let ((,rows2 (first ,dim)) - (,cols2 (second ,dim))) - (make-instance 'function-matrix - :rows ,rows2 - :cols ,cols2 - :mref (lambda (self , at args) - #+sbcl(declare (sb-ext::muffle-conditions style-warning)) - , at body) - :vref (lambda (self ,i) - ;; Default self vector reference in column major order - (multiple-value-bind (,r ,c) (floor ,i ,rows2) - (mref self ,r ,c))))))) +(defun funmat (dim fun) + "Creates a read only function matrix with column major order." + (let ((rows (first dim)) + (cols (second dim))) + (make-instance 'function-matrix + :rows rows + :cols cols + :mref (lambda (self i j) + (funcall fun i j)) + :vref (lambda (self i) + (multiple-value-bind (c r) + (floor i rows) + (funcall fun r c)))))) -(defmacro fmat (type dim args &body body) - `(convert (funmat ,dim ,args , at body) - ,type)) +(defun fmat (type dim fun) + "Creates a matrix of of type type, dim dim from the function definition. +Row major order" + (convert (funmat dim fun) + type)) From jivestgarden at common-lisp.net Sun Dec 13 15:20:02 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sun, 13 Dec 2009 10:20:02 -0500 Subject: [lisplab-cvs] r123 - Message-ID: Author: jivestgarden Date: Sun Dec 13 10:20:02 2009 New Revision: 123 Log: changed function matrix constructors from macro to function Modified: example.lisp Modified: example.lisp ============================================================================== --- example.lisp (original) +++ example.lisp Sun Dec 13 10:20:02 2009 @@ -1,6 +1,6 @@ ;;; A simple demonstration of how to use lisplab -(in-package :ll) +(in-package :ll-user) ;;; 19 ways to create a matrix (defparameter *test-matrices* @@ -29,14 +29,16 @@ (zmat (0 #C(0 2) -2) (1 3 -5) (-2 %i 0)) ;; Setting of structure - (funmat '(4 4) (i j) (if (= i j) 1 0)) - (fmat 'matrix-dge '(3 4) (i j) (if (< i j) 1 0.5)) + (funmat '(4 4) (lambda (i j) + (if (= i j) 1 0))) + (fmat 'matrix-dge '(3 4) (lambda (i j) + (if (< i j) 1 0.5))) ;; From another matrix (copy (dmat (1 4) (-2 3))) (mcreate (dmat (1 4) (-2 3))) (convert '((3 2 4) (1 4 2)) 'matrix-dge) - (convert (funmat '(3 3) (i j) (random 1.0)) 'matrix-dge) + (convert (funmat '(3 3) (lambda (i j) (random 1.0))) 'matrix-dge) (mmap '(:z :ge :any) #'random (mnew '(:d :ge :any) 1 3 3)) (.+ 3 (dmat (2 3) (-2 9))))) From jivestgarden at common-lisp.net Sun Dec 20 20:42:01 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sun, 20 Dec 2009 15:42:01 -0500 Subject: [lisplab-cvs] r124 - doc/manual Message-ID: Author: jivestgarden Date: Sun Dec 20 15:42:00 2009 New Revision: 124 Log: added missing features Modified: doc/manual/lisplab.texi Modified: doc/manual/lisplab.texi ============================================================================== --- doc/manual/lisplab.texi (original) +++ doc/manual/lisplab.texi Sun Dec 20 15:42:00 2009 @@ -57,10 +57,9 @@ and working in an free general purpose programming language. And best of all: you can enjoy you favorite data-types in addition to the matrices: functions, hash tables, structures, -classes, arbitrary precision -integers, rationals, and lists. +classes, arbitrary precision integers, rationals, and lists. -Note that Lisplab is not unique in building Matlab-like +Lisplab is not unique in building Matlab-like syntax on top of Common Lisp. Other Common Lisp matrix libraries are Matlisp, Femlisp and NLISP. Lisplab itself was started as a branch of Matlisp, but has now moved @@ -151,13 +150,13 @@ @item The generic functions of the basic algebra start with a dot: @code{.+}, @code{.-}, @code{.*}, @code{./}, @code{.^}, @code{.sin} - at code{.cos}, @code{.tan}, @code{.besj}, @code{.realpart}, etc. -These functions work on numbers as the non-dotted Common Lisp functions -and work element-vise on matrices. + at code{.cos}, @code{.tan}, @code{.besj}, @code{.re}, etc. +On numbers these functions work as the non-dotted Common Lisp functions +and on matrices they work element-vise. @item Linear algebra functions tend to start with @i{m}: @code{m*}, @code{minv}, @code{mmax}, @code{mtp}, etc., -but this conventions is followed only to low degree. +but this conventions is not strictly followed. @item The naming convention of files follow the layered structure of Lisplab, with level0 to level3. @@ -168,25 +167,22 @@ @section Status - past and future -The purpose of Lisplab -is to provide a complete mathematics programming environment, -not just linear algebra. Currently it contains much -matrix manipulation and linear algebra stuff, -as well as fast Fourier transform and special functions. -It lacks special matrices, such as diagonal, tridiagonal, -and sparse matrices. - -Lisplab started as a refactoring of Matlisp (To make my simulations -run on Windows for my professor), but -I (Joern Inge) ended up by reimplementing most of it, keeping -only the interfaces to Blas and Lapack. Currently, +Lisplab contains a lot of linear algebra stuff, but +in the future it is hope it can be broad mathematics programming environment, +not just linear algebra. + +Lisplab has been developed for physics simulations and data handling. +Lisplab started as a refactoring of Matlisp, but the code +has been to large degree rewritten, except the +interfaces to Blas and Lapack. Currently, Lisplab and Matlisp have more or less the same functionality. Lisplab differ from Matlisp in the following ways @itemize + at item Implementation. @item Layered structure (@xref{Structure}.) @item Shorter names. - at item Using the standard Lapack and Blas libraries, not a special build. - at item Native Common Lisp linear algebra implementations. + at item Lisplab uses the standard Lapack and Blas libraries, not a special build. + at item Rich matrix class hierarchy. @end itemize The future I will mainly do minor changes and bug-fixes, @@ -208,6 +204,45 @@ @end itemize So it this sounds interesting, please contact if you want to contribute. + at section Bugs and limitations +The purpose of Lisplab is to be a platform for +mathematical computations. From this perspective it +is clear it will never be complete. Also, since there is no +spec it is not obvious what is a bug and what is not! + +Hence, the list in this section must be read as non-systematic gathering +of problem features. + at itemize + at item Lisplab runs only on SBCL. +Lisplab is mainly ANSI Common Lisp, so just minor changes +in the build-system should make it +run on other lisps, but the problem is that it will most +probably be slow. It should be fast on CMUCL, though. + at item Lacks a formal spec. + at item Poorly tested. + at item Lacks error checks (but these should not be made before a spec!) + at end itemize + +Missing features: + at itemize + at item There is no way to iterate through the elements of +a general matrix in a fast way. (The map functions are currently the only +thing, but these are structure agnostic and also not fast.) There +should maybe be an macro @code{w/matrix}. + at item There should be linear algebra primitives, like row exchange, +in level 2, so that level 3 can be made entirely without knowledge about +internal structure of matrices. (Structure similar to blas - lapack) + at item Integer matrices. + at item Vectorized execution of operations. + at item Numerical integration. + at item Symbolic math. Should be separate module, only with knowledge +of the dotted algebra generic functions. + at item The dotted algebra should also work on functions +so the one could write @code{(.+ (lambda (x) (+ x 1)) 3)} +and get a new functions as result. It might even +be possible to make beautiful optimizations this way. + at end itemize + @node Tutorial @chapter Tutorial @@ -523,8 +558,8 @@ @code{.sinh}, @code{.cosh}, @code{.sinh}, @code{.tanh}, @code{.asin}, @code{.acos}, @code{.asin}, @code{.atan}, @code{.asinh}, @code{.acosh}, @code{.asinh}, @code{.atanh}, - at code{.conj}, - at code{.realpart}, @code{.imagpart}, @code{.exp}, @code{.abs}. + at code{.conj}, @code{.re}, @code{.im}, @code{.abs}, + at code{.sqrt}, @code{.exp}. @section Special functions @@ -547,7 +582,8 @@ @end example The @code{w/infix} messes as little as possible with the Lisp semantics, so that if you have a lot of formulas just wrap all -of it inside the macro. +of it inside the macro. The infix math also works with the +functions @code{+, -, *, /} and @code{^}. @node Structure @@ -565,11 +601,13 @@ (There should be no need for optimized math in FFIs or special languages like Maxima) @item Every common mathematical operator and function -is represented by a @i{CLOS generic function}. This is called the dotted algebra. +is represented by a @i{CLOS generic function}. +This is called the dotted algebra. @item Modular structure (Inspired by GSL). @item Trust the Lisp system and use foreign code as little as possible. @item Avoid programming mathematical algorithms in macros. Despite the -advantages (fast and generic at the same time) it is hard to understand and debug. +advantages (fast and generic at the same time) it is hard to +understand and debug. @item Error checks is primarily callers responsibility, not Lisplab's! @item To steal as much code as possible from as many as possible (I love free software). @@ -587,8 +625,8 @@ @section Package structure So far, there is only one main package, called, you might guess it: @i{lisplab}. Except from that there are only a few special packages -for generated code and FFIs: Slatec, Blas, and FFTW. There is also -a package @i{lisplab-user} for test code and applications. +for generated code and FFIs: Slatec, Blas, and FFTW. For test +code an applications you have the package @i{lisplab-user}. @section The four levels, 0 -- 3.