From jivestgarden at common-lisp.net Sat Aug 8 08:16:18 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 08 Aug 2009 04:16:18 -0400 Subject: [lisplab-cvs] r68 - in doc: html www Message-ID: Author: jivestgarden Date: Sat Aug 8 04:16:17 2009 New Revision: 68 Log: rename Added: doc/www/ (props changed) - copied from r62, /doc/html/ Removed: doc/html/ From jivestgarden at common-lisp.net Sat Aug 8 08:49:21 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 08 Aug 2009 04:49:21 -0400 Subject: [lisplab-cvs] r69 - doc/www Message-ID: Author: jivestgarden Date: Sat Aug 8 04:49:20 2009 New Revision: 69 Log: cleaned up webpage Modified: doc/www/index.html Modified: doc/www/index.html ============================================================================== --- doc/www/index.html (original) +++ doc/www/index.html Sat Aug 8 04:49:20 2009 @@ -10,40 +10,55 @@ - +

Introduction

- Lisplab is a mathematics library in common lisp + Lisplab is a mathematics library in Common Lisp released under the GNU General Public License (GPL). - Lisplab is based on code from Matlisp - to interface Blas/Lapack for computations, but has also a lots - of code written natively in Common Lisp in addition. The main purpose - of the library is to integration various sources - of mathematical software to a convenient platform for computations. - The sources of software include + Lisplab is based on code from Matlisp, + but has now moved quite far from the original code mass. +

+ The main purpose of Lisplab is to provide a framwork for + mathematical computations. This means that it should be easy + to create and manipulate mathematical objects and have + a consistent naming of methods and classes. + Lisplab is heavily based on CLOS. +

+ Lisplab contains

Interfaces to BLAS and LAPACK.
Interface to FFTW.
Numerical integration from QUADPACK and F2CL.
Special functions from SLATEC and F2CL. -
A lot of additional routines, for linear algebra, IO, fft, etc. +
Routines for linear algebra, + postscript output, PGM output, + Fast Fourier Transform (in Common Lisp), infix math, etc.

The part of Lisplab which is most mature is the matrix and linear algebra, and these should provide a good basis for matrix based modelling. - The interfaces to Blas/Matlisp are only to low degree finished. - However, new methods here should be quite easily added.

Documentation

- Module documentation with Tinaa -is here. +

+ The manual is in + + html + and in + + pdf. + There is also + + module documentation, made with + Tinaa. +

Mailing Lists

for announcements.

Download

@@ -70,12 +86,13 @@

You can get the latest version of the source code from subversion

-   svn checkout svn://common-lisp.net/project/lisplab/svn lisplab
-

+ svn checkout svn://common-lisp.net/project/lisplab/svn lisplab or browse it - here. + + here.

- +
+

From jivestgarden at common-lisp.net Sat Aug 8 11:49:42 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 08 Aug 2009 07:49:42 -0400 Subject: [lisplab-cvs] r70 - src/core Message-ID: Author: jivestgarden Date: Sat Aug 8 07:49:41 2009 New Revision: 70 Log: tria and error on symbolic expressions Modified: src/core/level0-expression.lisp Modified: src/core/level0-expression.lisp ============================================================================== --- src/core/level0-expression.lisp (original) +++ src/core/level0-expression.lisp Sat Aug 8 07:49:41 2009 @@ -99,5 +99,38 @@ (def-sym-expr-method .sub .-) (def-sym-expr-method .expt .^) +;;;; Then the derivatives +(defmethod .= ((x symbol) (y symbol) &optional whatever) + (eql x y)) + +(defmethod .log ((x symbol) &optional (n nil)) + (if x + (expr '.log x n) + (expr '.log x))) + +(defgeneric .partial (epxr var) + (:documentation "Parial derivative of the expressions with regards to the variable.")) + +(defmethod .partial ((x symbol) (y symbol)) + (if (eql x y) + 1 + 0)) + +(defmethod .partial ((x expression) (y symbol))) + +(defgeneric .partial-of-function (fun arg-num args) + (:documentation "The parial derivive of a function")) + +(defmethod .partial-of-function ((f (eql '.log)) (arg-num (eql 0)) args) + "Args must be a list" + (if (cdr args) + (expr './ 1 (car args) (.log (cadr args))) + (expr './ (car args)))) + +(defmethod .partial-of-function ((f (eql '.sin)) (arg-num (eql 0)) args) + (expr '.cos (car args))) + +(defmethod .partial-of-function ((f (eql '.cos)) (arg-num (eql 0)) args) + (expr '.- (expr '.sin (car args)))) From jivestgarden at common-lisp.net Sat Aug 8 12:19:40 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 08 Aug 2009 08:19:40 -0400 Subject: [lisplab-cvs] r71 - in src: core matrix Message-ID: Author: jivestgarden Date: Sat Aug 8 08:19:39 2009 New Revision: 71 Log: minor Modified: src/core/level0-const.lisp src/core/level0-functions.lisp src/matrix/level1-classes.lisp Modified: src/core/level0-const.lisp ============================================================================== --- src/core/level0-const.lisp (original) +++ src/core/level0-const.lisp Sat Aug 8 08:19:39 2009 @@ -22,9 +22,9 @@ (export '(%i %e -%i)) ;;; Float and complex constants -(define-constant %e (exp 1.0)) -(define-constant %i #C(0.0 1.0)) -(define-constant -%i #C(0.0 -1.0)) +(define-constant %e (exp 1.0) "The number e = exp(1).") +(define-constant %i #C(0.0 1.0) "The imaginary unit i=sqrt(-1).") +(define-constant -%i #C(0.0 -1.0) "The negative imaginary unit -i=-sqrt(-1).") ;;; Type constants ;;; TODO: throw them out or use deftype in stead Modified: src/core/level0-functions.lisp ============================================================================== --- src/core/level0-functions.lisp (original) +++ src/core/level0-functions.lisp Sat Aug 8 08:19:39 2009 @@ -30,7 +30,7 @@ (defun ^ (x n) "Synonym for expt" (expt x n)) (defun .+ (&rest args) - "Generlized +. Reduces the arguments with .add." + "Generalized +. Reduces the arguments with .add." (if (and args (cdr args)) (reduce #'.add args) (car args))) Modified: src/matrix/level1-classes.lisp ============================================================================== --- src/matrix/level1-classes.lisp (original) +++ src/matrix/level1-classes.lisp Sat Aug 8 08:19:39 2009 @@ -23,7 +23,8 @@ (in-package :lisplab) -(export '(matrix-base +(export '(matrix-ge + matrix-base matrix-dge matrix-zge function-matrix From jivestgarden at common-lisp.net Sat Aug 8 12:20:05 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 08 Aug 2009 08:20:05 -0400 Subject: [lisplab-cvs] r72 - doc/manual Message-ID: Author: jivestgarden Date: Sat Aug 8 08:20:02 2009 New Revision: 72 Log: freeze manual Modified: doc/manual/Makefile doc/manual/lisplab.texi Modified: doc/manual/Makefile ============================================================================== --- doc/manual/Makefile (original) +++ doc/manual/Makefile Sat Aug 8 08:20:02 2009 @@ -1,9 +1,28 @@ source=lisplab.texi -all: html +default: html + +all: html pdf html: $(source) makeinfo --html $(source) pdf: $(source) - texi2pdf $(source) \ No newline at end of file + texi2pdf $(source) + +clean: + -rm lisplab.aux + -rm lisplab.cp + -rm lisplab.fn + -rm lisplab.pg + -rm lisplab.log + -rm lisplab.ky + -rm lisplab.tp + -rm lisplab.toc + -rm lisplab.vr + +distclean: clean + -rm lisplab.pdf + -rm -r lisplab + -rm lisplab.html + -rm *~ Modified: doc/manual/lisplab.texi ============================================================================== --- doc/manual/lisplab.texi (original) +++ doc/manual/lisplab.texi Sat Aug 8 08:20:02 2009 @@ -22,7 +22,6 @@ @node Top @top Lisplab manual -This is a short sample Texinfo file. @end ifnottex @menu @@ -37,9 +36,11 @@ @node Introduction @chapter Introduction -Lisplab is a mathematics library in Common Lisp and offers -an easy-to-use and rich programming framework with linear algebra, -Fast Fourier Transform, Special functions, Runge-Kutta solver, +Lisplab is a mathematics library in Common Lisp. It is +placed under the Gnu general public license and offers +an easy-to-use and rich programming framework for mathematics, +including linear algebra, +Fast Fourier Transform, special functions, Runge-Kutta solver, infix notation, and general matrix utility functions. The name Lisplab is inspired by Matlab and Lisplab offers much of the same kind of programming style as Matlab, with high level @@ -54,10 +55,10 @@ integers, rationals, and lists. Note that Lisplab is not unique in building Matlab-like -syntax on top of Common Lisp. Lisplab contains code from -Matlisp, but has also a lot of new code, refactored -code and rewritten code. Other Common Lisp matrix libraries -are Matlisp, Femlisp and NLISP. +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 +far from the original code mass. @node Getting started @@ -139,7 +140,7 @@ with double float elements, while @i{matrix-zge} is a general matrix with complex double float elements. @item -The generic functions of the basic algebra start with period: +The generic functions of the basic algebra start with a dot: @code{.+}, @code{.-}, @code{.*}, @code{./}, @code{.^}, @code{.sin} @code{.cos}, @code{.tan}, @code{.besj}, @code{.realpart}, etc. These functions work on numbers as the non-dotted Common Lisp functions @@ -159,13 +160,14 @@ @section Status - past and future The purpose of Lisplab is to provide a complete mathematics programming environment, -not just linear algebra. Currently it contains a fairly -large matrix manipulation basis and linear algebra, +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, but +Lisplab started as a refactoring of Matlisp (To make my simulations +run on Windows for my professor), but I ended up by reimplementing most of it, keeping only the interfaces to Blas and Lapack. Currently, Lisplab and Matlisp have more or less the same functionality. @@ -179,8 +181,7 @@ The future I will mainly do minor changes and bug-fixes, since it now covers my basic needs. I will only add new -modules when needed. - +modules when I personally needed them. However, there are many exiting extensions that can be made, such as @@ -195,8 +196,7 @@ image processing or cryptography. @item Interface to new foreign libraries, e.g. GSL. @end itemize - -Please contact if you want to contribute. +So it this sounds interesting, please contact if you want to contribute. @node Tutorial @@ -213,7 +213,7 @@ use it. - at section Basic algebra + at section The dotted algebra Central in Lisplab is an algebra with the functions @code{.+}, @code{.-}, @code{.*}, @code{./}, and @code{.^}. These are generalization of @@ -484,6 +484,8 @@ These are: @code{.sin}, @code{.cos}, @code{.sin}, @code{.tan}, @code{.sinh}, @code{.cosh}, @code{.sinh}, @code{.tanh}, + at code{.asin}, @code{.acos}, @code{.asin}, @code{.atan}, + at code{.asinh}, @code{.acosh}, @code{.asinh}, @code{.atanh}, @code{.conj}, @code{.realpart}, @code{.imagpart}, @code{.exp}, @code{.abs}. @@ -492,7 +494,7 @@ @code{.besj}, @code{.besy}, @code{.besi}, @code{.besk}, @code{.besh1}, @code{.besh2}, - at code{.ai}. + at code{.ai}, @code{.gamma}. @section Infix notation Infix input is with the macro @code{w/infix}, @@ -515,7 +517,7 @@ @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. +for generated code and FFIs: Slatec, Blas, and FFTW. @section The four levels, 0 -- 3. Lisplab has a layered structure with four levels, 0 -- 3, @@ -562,7 +564,7 @@ (non matrix code). @section Class structure - +TODO From jivestgarden at common-lisp.net Sat Aug 8 17:42:45 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 08 Aug 2009 13:42:45 -0400 Subject: [lisplab-cvs] r73 - src/matrix Message-ID: Author: jivestgarden Date: Sat Aug 8 13:42:45 2009 New Revision: 73 Log: optimized mref Modified: src/matrix/level1-matrix.lisp Modified: src/matrix/level1-matrix.lisp ============================================================================== --- src/matrix/level1-matrix.lisp (original) +++ src/matrix/level1-matrix.lisp Sat Aug 8 13:42:45 2009 @@ -18,6 +18,8 @@ ;;; with this program; if not, write to the Free Software Foundation, Inc., ;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +;;; Note: use the slot-value rather than the methods, since slot-value is faster. + ;;; TODO: clean up (in-package :lisplab) @@ -65,61 +67,65 @@ ;;; The general matrix (defmethod mref ((matrix matrix-ge) row col) - (aref (matrix-store matrix) (column-major-idx row col (rows matrix)))) + (aref (slot-value matrix 'matrix-store) + (column-major-idx row col (slot-value matrix 'rows)))) (defmethod (setf mref) (value (matrix matrix-ge) row col) - (setf (aref (matrix-store matrix) (column-major-idx row col (rows matrix))) + (setf (aref (slot-value matrix 'matrix-store) + (column-major-idx row col (slot-value matrix 'rows))) value)) (defmethod vref ((matrix matrix-ge) idx) - (aref (matrix-store matrix) idx)) + (aref (slot-value matrix 'matrix-store) idx)) (defmethod (setf vref) (value (matrix matrix-ge) idx) - (setf (aref (matrix-store matrix) idx) + (setf (aref (slot-value matrix 'matrix-store) idx) value)) ;;; Spcialized for blas-dge (defmethod mref ((matrix matrix-base-dge) row col) - (ref-blas-real-store (matrix-store matrix) row col (rows matrix))) + (ref-blas-real-store (slot-value matrix 'matrix-store) row col (slot-value matrix 'rows))) (defmethod (setf mref) (value (matrix matrix-base-dge) row col) (let ((val2 (coerce value 'double-float))) (declare (type double-float val2)) - (setf (ref-blas-real-store (matrix-store matrix) row col (rows matrix)) + (setf (ref-blas-real-store (slot-value matrix 'matrix-store) + row col (slot-value matrix 'rows)) val2) val2)) (defmethod vref ((matrix matrix-base-dge) idx) - (aref (the type-blas-store (matrix-store matrix)) idx)) + (aref (the type-blas-store (slot-value matrix 'matrix-store)) idx)) (defmethod (setf vref) (value (matrix matrix-base-dge) idx) (let ((val2 (coerce value 'double-float))) (declare (type double-float val2)) - (setf (aref (the type-blas-store (matrix-store matrix)) idx) + (setf (aref (the type-blas-store (slot-value matrix 'matrix-store)) idx) val2) val2)) ;;; Spcialized for blas-zge (defmethod mref ((matrix matrix-base-zge) row col) - (ref-blas-complex-store (matrix-store matrix) - row col (rows matrix))) + (ref-blas-complex-store (slot-value matrix 'matrix-store) + row col (slot-value matrix 'rows))) (defmethod (setf mref) (value (matrix matrix-base-zge) row col) (let ((val2 (coerce value '(complex double-float)))) (declare (type (complex double-float) val2)) - (setf (ref-blas-complex-store (matrix-store matrix) row col (rows matrix)) + (setf (ref-blas-complex-store (slot-value matrix 'matrix-store) + row col (slot-value matrix 'rows)) val2) val2)) (defmethod vref ((matrix matrix-base-zge) i) - (ref-blas-complex-store (matrix-store matrix) i 0 1)) + (ref-blas-complex-store (slot-value matrix 'matrix-store) i 0 1)) (defmethod (setf vref) (value (matrix matrix-base-zge) i) (let ((val2 (coerce value '(complex double-float)))) (declare (type (complex double-float) val2)) - (setf (ref-blas-complex-store (matrix-store matrix) i 0 1) + (setf (ref-blas-complex-store (slot-value matrix 'matrix-store) i 0 1) val2) val2)) From jivestgarden at common-lisp.net Sat Aug 8 17:44:28 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 08 Aug 2009 13:44:28 -0400 Subject: [lisplab-cvs] r74 - src/core Message-ID: Author: jivestgarden Date: Sat Aug 8 13:44:28 2009 New Revision: 74 Log: removed sb-ext dep of package Modified: package.lisp src/core/level0-basic.lisp Modified: package.lisp ============================================================================== --- package.lisp (original) +++ package.lisp Sat Aug 8 13:44:28 2009 @@ -21,7 +21,7 @@ (defpackage "LISPLAB" (:nicknames "LL") - (:use "COMMON-LISP" "SB-EXT") + (:use "COMMON-LISP") (:documentation "Mathematics and linear algebra library")) (defpackage "FORTRAN-FFI-ACCESSORS" Modified: src/core/level0-basic.lisp ============================================================================== --- src/core/level0-basic.lisp (original) +++ src/core/level0-basic.lisp Sat Aug 8 13:44:28 2009 @@ -23,6 +23,11 @@ (export '(in-dir )) +;; Here non ansi stuff. +;; First we need the truely-the macro + +#+cbcl(import 'sb-ext::truly-the) + (setf *READ-DEFAULT-FLOAT-FORMAT* 'double-float) ; TODO make part of pacakge import? (defmacro with-gensyms ((&rest names) . body) From jivestgarden at common-lisp.net Sat Aug 8 17:59:06 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 08 Aug 2009 13:59:06 -0400 Subject: [lisplab-cvs] r75 - in src: linalg matrix Message-ID: Author: jivestgarden Date: Sat Aug 8 13:59:06 2009 New Revision: 75 Log: fill changed to mfill Modified: src/linalg/level3-linalg-blas-real.lisp src/linalg/level3-linalg-generic.lisp src/matrix/level2-array-functions.lisp src/matrix/level2-generic.lisp src/matrix/level2-interface.lisp src/matrix/level2-matrix-dge.lisp src/matrix/level2-matrix-zge.lisp Modified: src/linalg/level3-linalg-blas-real.lisp ============================================================================== --- src/linalg/level3-linalg-blas-real.lisp (original) +++ src/linalg/level3-linalg-blas-real.lisp Sat Aug 8 13:59:06 2009 @@ -153,7 +153,7 @@ (N (rows A))) (destructuring-bind (LU p det) (LU-factor! LU (make-permutation-vector N)) - (fill! A 0) + (mfill A 0) (dotimes (i N) (setf (mref A i (vref p i)) 1) (LU-solve!-blas-real LU A (vref p i))))) Modified: src/linalg/level3-linalg-generic.lisp ============================================================================== --- src/linalg/level3-linalg-generic.lisp (original) +++ src/linalg/level3-linalg-generic.lisp Sat Aug 8 13:59:06 2009 @@ -55,7 +55,7 @@ (let ((LU (copy A))) (destructuring-bind (LU p det) (LU-factor! LU (make-permutation-vector (rows A))) - (fill! A 0) ; Use A for the results + (mfill A 0) ; Use A for the results (dotimes (i (rows A)) (let ((col (view-col A (vref p i)))) (setf (vref col i) 1) Modified: src/matrix/level2-array-functions.lisp ============================================================================== --- src/matrix/level2-array-functions.lisp (original) +++ src/matrix/level2-array-functions.lisp Sat Aug 8 13:59:06 2009 @@ -54,7 +54,7 @@ (setf (row-major-aref ,c ,i) (,old (row-major-aref ,c ,i) (row-major-aref ,b ,i)))) ,c) - (let ((,c (create ,a 0))) + (let ((,c (mcreate ,a 0))) (dotimes (,i (min (size ,c) (size ,a))) (setf (vref ,c ,i) (,new (vref ,a ,i) (vref ,b ,i)))) @@ -72,7 +72,7 @@ (setf (row-major-aref ,c ,i) (,old (row-major-aref ,c ,i) ,b))) ,c) - (let ((,c (create ,a 0))) + (let ((,c (mcreate ,a 0))) (dotimes (,i (size ,c)) (setf (vref ,c ,i) (,new (vref ,a ,i) ,b))) @@ -90,7 +90,7 @@ (setf (row-major-aref ,c ,i) (,old ,b (row-major-aref ,c ,i)))) ,c) - (let ((,c (create ,b 0))) + (let ((,c (mcreate ,b 0))) (dotimes (,i (size ,c)) (setf (vref ,c ,i) (,new ,b (vref ,b ,i)))) @@ -116,7 +116,7 @@ (declare (type double-float ,x)) (setf (row-major-aref ,y ,i) ,form))) ,y) - (let ((,y (create ,x 0))) + (let ((,y (mcreate ,x 0))) (dotimes (,i (size ,y)) (let ((,x (vref ,x ,i))) (setf (vref ,y ,i) ,form))) @@ -136,7 +136,7 @@ (declare (type double-float ,x)) (setf (row-major-aref ,y ,i) ,form))) ,y) - (let ((,y (create ,x 0))) ; TOOD must make sure to allow complex values + (let ((,y (mcreate ,x 0))) ; TOOD must make sure to allow complex values (dotimes (,i (size ,y)) (let ((,x (vref ,x ,i))) (setf (vref ,y ,i) ,form))) Modified: src/matrix/level2-generic.lisp ============================================================================== --- src/matrix/level2-generic.lisp (original) +++ src/matrix/level2-generic.lisp Sat Aug 8 13:59:06 2009 @@ -137,8 +137,7 @@ (setf min (vref m i)))) min)) -(defmethod fill! ((a matrix-base) val) - "Sets all elemnts of a to val." +(defmethod mfill ((a matrix-base) val) (dotimes (i (size a)) (setf (vref a i) val)) val) Modified: src/matrix/level2-interface.lisp ============================================================================== --- src/matrix/level2-interface.lisp (original) +++ src/matrix/level2-interface.lisp Sat Aug 8 13:59:06 2009 @@ -27,7 +27,7 @@ mnew mcreate copy-contents - .map mmap fill! + .map mmap mfill ; dlmwrite dlmread to-vector! to-vector to-matrix! to-matrix @@ -63,10 +63,6 @@ (defgeneric mnew (class value rows &optional cols) (:documentation "General matrix constructor. Creates a new matrix filled with numeric arguments.")) -(defgeneric create (a &optional value dim) - (:documentation "Deprecated. Use mcreate in stead. Creates a new matrix of the same type and with the same value as the other, -but with all elements set to value.")) - (defgeneric mcreate (a &optional value dim) (:documentation "Creates a new matrix of the same type and with the same value as the other, but with all elements set to value.")) @@ -149,7 +145,7 @@ (:documentation "Maps the function on each element. The returned object has dimensionality of the first object")) -(defgeneric fill! (a value) +(defgeneric mfill (a value) (:documentation "Sets each element to the value. Destructive")) Modified: src/matrix/level2-matrix-dge.lisp ============================================================================== --- src/matrix/level2-matrix-dge.lisp (original) +++ src/matrix/level2-matrix-dge.lisp Sat Aug 8 13:59:06 2009 @@ -19,7 +19,7 @@ (in-package :lisplab) -(defmethod fill! ((a matrix-base-dge) value) +(defmethod mfill ((a matrix-base-dge) value) (let ((x (coerce value 'double-float)) (store (matrix-store a))) (declare (type type-blas-store store)) Modified: src/matrix/level2-matrix-zge.lisp ============================================================================== --- src/matrix/level2-matrix-zge.lisp (original) +++ src/matrix/level2-matrix-zge.lisp Sat Aug 8 13:59:06 2009 @@ -18,7 +18,7 @@ (in-package :lisplab) -(defmethod fill! ((a matrix-base-zge) value) +(defmethod mfill ((a matrix-base-zge) value) (let ((rx (coerce (realpart value) 'double-float)) (cx (coerce (imagpart value) 'double-float)) (store (matrix-store a))) From jivestgarden at common-lisp.net Sat Aug 8 18:26:56 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 08 Aug 2009 14:26:56 -0400 Subject: [lisplab-cvs] r76 - src/matrix Message-ID: Author: jivestgarden Date: Sat Aug 8 14:26:56 2009 New Revision: 76 Log: Refactored function names Modified: src/matrix/level2-generic.lisp src/matrix/level2-interface.lisp src/matrix/level2-matrix-dge.lisp Modified: src/matrix/level2-generic.lisp ============================================================================== --- src/matrix/level2-generic.lisp (original) +++ src/matrix/level2-generic.lisp Sat Aug 8 14:26:56 2009 @@ -79,6 +79,12 @@ (return-from .every nil))) t) +(defmethod mmap ((type (eql t)) f (a matrix-base) &rest args) + (apply #'mmap (type-of a) f a args)) + +(defmethod mmap ((type symbol) f (a matrix-base) &rest args) + (apply #'mmap (find-class type) f a args)) + (defmethod mmap (type f (a matrix-base) &rest args) (let ((b (make-matrix-instance type (dim a) 0))) (cond ((not args) @@ -95,7 +101,7 @@ args)))))) b)) -(defmethod .map (f (a matrix-base) &rest args) +#+nil (defmethod .map (f (a matrix-base) &rest args) (apply #'mmap (class-name (class-of a)) f a args)) (defmethod msum ((m matrix-base)) Modified: src/matrix/level2-interface.lisp ============================================================================== --- src/matrix/level2-interface.lisp (original) +++ src/matrix/level2-interface.lisp Sat Aug 8 14:26:56 2009 @@ -27,7 +27,8 @@ mnew mcreate copy-contents - .map mmap mfill +; .map + mmap mfill ; dlmwrite dlmread to-vector! to-vector to-matrix! to-matrix @@ -139,15 +140,16 @@ ;;;; Single-element operations (defgeneric mmap (type f m &rest args) - (:documentation "Generalization of map")) - -(defgeneric .map (f m &rest rest) - (:documentation "Maps the function on each element. The returned -object has dimensionality of the first object")) + (:documentation "Generalization of map, where type = t gives output +type equals type of m.")) (defgeneric mfill (a value) (:documentation "Sets each element to the value. Destructive")) +#+nil (defgeneric .map (f m &rest rest) + (:documentation "Maps the function on each element. The returned +object has dimensionality of the first object")) + ;;; Helpers Modified: src/matrix/level2-matrix-dge.lisp ============================================================================== --- src/matrix/level2-matrix-dge.lisp (original) +++ src/matrix/level2-matrix-dge.lisp Sat Aug 8 14:26:56 2009 @@ -31,7 +31,16 @@ :rows (rows matrix) :cols (cols matrix))) -(defmethod .map (f (a matrix-base-dge) &rest args) +(defmethod mmap ((type matrix-base-dge) f (a matrix-base-dge) &rest args) + (let ((b (copy a))) + (apply #'map-into + (matrix-store b) + (lambda (&rest args) + (coerce (apply f args) 'double-float)) + (matrix-store a) (mapcar #'matrix-store args)) + b)) + +#+nil (defmethod .map (f (a matrix-base-dge) &rest args) (let ((b (copy a))) (apply #'map-into (matrix-store b) From jivestgarden at common-lisp.net Sat Aug 8 19:37:35 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 08 Aug 2009 15:37:35 -0400 Subject: [lisplab-cvs] r77 - src/matrix Message-ID: Author: jivestgarden Date: Sat Aug 8 15:37:35 2009 New Revision: 77 Log: drandom Modified: src/matrix/level2-constructors.lisp Modified: src/matrix/level2-constructors.lisp ============================================================================== --- src/matrix/level2-constructors.lisp (original) +++ src/matrix/level2-constructors.lisp Sat Aug 8 15:37:35 2009 @@ -23,6 +23,7 @@ fmat mat col row dmat dnew dcol drow + drandom zmat znew zcol zrow)) (defmethod copy ((a matrix-base)) @@ -84,6 +85,10 @@ ;;; Constructors for matrix-dge +(defun drandom (rows cols) + "Creates a double matrix with random element between 0 and 1." + (mmap t #'random (dnew 1.0 rows cols))) + (defmacro dmat (&body args) "Creates a matrix-dge matrix." `(mat 'matrix-dge , at args)) From jivestgarden at common-lisp.net Sat Aug 8 19:43:16 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 08 Aug 2009 15:43:16 -0400 Subject: [lisplab-cvs] r78 - src/matrix Message-ID: Author: jivestgarden Date: Sat Aug 8 15:43:14 2009 New Revision: 78 Log: cleaned up Modified: src/matrix/level2-constructors.lisp src/matrix/level2-generic.lisp src/matrix/level2-matrix-dge.lisp src/matrix/level2-matrix-zge.lisp Modified: src/matrix/level2-constructors.lisp ============================================================================== --- src/matrix/level2-constructors.lisp (original) +++ src/matrix/level2-constructors.lisp Sat Aug 8 15:43:14 2009 @@ -139,7 +139,7 @@ :rows ,rows2 :cols ,cols2 :mref (lambda (self , at args) - (declare (muffle-conditions style-warning)) + #+cbcl(declare (sb-ext::muffle-conditions style-warning)) , at body) :vref (lambda (self ,i) ;; Default self vector reference in column major order Modified: src/matrix/level2-generic.lisp ============================================================================== --- src/matrix/level2-generic.lisp (original) +++ src/matrix/level2-generic.lisp Sat Aug 8 15:43:14 2009 @@ -101,9 +101,6 @@ args)))))) b)) -#+nil (defmethod .map (f (a matrix-base) &rest args) - (apply #'mmap (class-name (class-of a)) f a args)) - (defmethod msum ((m matrix-base)) "Sums all elements of m." (let ((sum 0)) @@ -340,42 +337,5 @@ (each-element-function-matrix-ge x (.besh2 n x))) -;;; TRASH - -#| - -(defmethod .conj ((x matrix-ge)) - (each-element-function-matrix-ge x (.conj x))) - -;;; Trignometric functions - -(defmethod .sin ((x matrix-ge)) - (each-element-function-matrix-ge x (.sin x))) - -(defmethod .cos ((x matrix-ge)) - (each-element-function-matrix-ge x (.cos x))) - -(defmethod .tan ((x matrix-ge)) - (each-element-function-matrix-ge x (.tan x))) -;;; Hyperbolic functions -(defmethod .sinh ((x matrix-ge)) - (each-element-function-matrix-ge x (.sinh x))) - -(defmethod .cosh ((x matrix-ge)) - (each-element-function-matrix-ge x (.cosh x))) - -(defmethod .tanh ((x matrix-ge)) - (each-element-function-matrix-ge x (.tanh x))) - -;;; Logarithms and exponents - -(defmethod .exp ((x matrix-ge)) - (each-element-function-matrix-ge x (.exp x))) - - -(defmethod .sqrt ((x matrix-ge)) - (each-element-function-matrix-ge x (.sqrt x))) - -|# Modified: src/matrix/level2-matrix-dge.lisp ============================================================================== --- src/matrix/level2-matrix-dge.lisp (original) +++ src/matrix/level2-matrix-dge.lisp Sat Aug 8 15:43:14 2009 @@ -40,14 +40,6 @@ (matrix-store a) (mapcar #'matrix-store args)) b)) -#+nil (defmethod .map (f (a matrix-base-dge) &rest args) - (let ((b (copy a))) - (apply #'map-into - (matrix-store b) - (lambda (&rest args) - (coerce (apply f args) 'double-float)) - (matrix-store a) (mapcar #'matrix-store args)) - b)) (defmethod msum ((m matrix-base-dge)) (let ((sum 0.0) @@ -206,73 +198,3 @@ (defmethod .besh2 (n (x matrix-base-dge)) (each-matrix-element-df-to-complex-df x (.besh2 n x))) - -;;;;;;;;;;;;;;; TRASH - -#| -(def-binary-op-matrix-base-dge .add +) - -(def-binary-op-matrix-base-dge .mul *) - -(def-binary-op-matrix-base-dge .sub -) - -(def-binary-op-matrix-base-dge .div /) - -(def-binary-op-matrix-base-dge .expt expt) - -(def-binary-op-matrix-base-dge .max max) - -(def-binary-op-matrix-base-dge .min min) - -|# - - - -#| -;;; Trignometric functions -(defmethod .sin ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (sin x))) - -(defmethod .cos ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (cos x))) - -(defmethod .tan ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (tan x))) - -(defmethod .asin ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (asin x))) - -(defmethod .acos ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (acos x))) - -(defmethod .atan ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (atan x))) - -;;; Hyperbolic functions - -(defmethod .sinh ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (sinh x))) - -(defmethod .cosh ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (cosh x))) - -(defmethod .tanh ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (tanh x))) - -(defmethod .asinh ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (asinh x))) - -(defmethod .acosh ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (acosh x))) - -(defmethod .atanh ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (atanh x))) - -(defmethod .exp ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (exp x))) - -(defmethod .sqrt ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (sqrt x))) - - -|# Modified: src/matrix/level2-matrix-zge.lisp ============================================================================== --- src/matrix/level2-matrix-zge.lisp (original) +++ src/matrix/level2-matrix-zge.lisp Sat Aug 8 15:43:14 2009 @@ -194,74 +194,3 @@ (each-element-function-matrix-base-zge x (.besh2 n x))) - -;;; TRASH - - -#| -(def-binary-op-blas-complex .add +) - -(def-binary-op-blas-complex .mul *) - -(def-binary-op-blas-complex .sub -) - -(def-binary-op-blas-complex .div /) - -(def-binary-op-blas-complex .expt expt) -|# - - -#| -(defmethod .exp ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (exp x))) - -(defmethod .sqrt ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (sqrt x))) - - - -(defmethod .conj ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (conjugate x))) - -;;; Trignometric functions - -(defmethod .sin ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (sin x))) - -(defmethod .cos ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (cos x))) - -(defmethod .tan ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (tan x))) - -(defmethod .asin ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (asin x))) - -(defmethod .acos ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (acos x))) - -(defmethod .atan ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (atan x))) - -;;; Hyperbolic functions - -(defmethod .sinh ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (sinh x))) - -(defmethod .cosh ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (cosh x))) - -(defmethod .tanh ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (tanh x))) - -(defmethod .asinh ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (asinh x))) - -(defmethod .acosh ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (acosh x))) - -(defmethod .atanh ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (atanh x))) - -;;; Logarithm and exponent -|# \ No newline at end of file From jivestgarden at common-lisp.net Sat Aug 8 20:16:56 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 08 Aug 2009 16:16:56 -0400 Subject: [lisplab-cvs] r79 - doc/www Message-ID: Author: jivestgarden Date: Sat Aug 8 16:16:56 2009 New Revision: 79 Log: performance comparison Added: doc/www/compare-matrix-inversion.jpg (contents, props changed) Added: doc/www/compare-matrix-inversion.jpg ============================================================================== Binary file. No diff available. From jivestgarden at common-lisp.net Mon Aug 10 18:57:50 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Mon, 10 Aug 2009 14:57:50 -0400 Subject: [lisplab-cvs] r80 - src/core Message-ID: Author: jivestgarden Date: Mon Aug 10 14:57:49 2009 New Revision: 80 Log: some testing on symbolic stuff Modified: src/core/level0-expression.lisp Modified: src/core/level0-expression.lisp ============================================================================== --- src/core/level0-expression.lisp (original) +++ src/core/level0-expression.lisp Mon Aug 10 14:57:49 2009 @@ -25,6 +25,9 @@ (defun expr (&rest args) (make-instance 'expression :list args)) +(defun make-expression (args) + (make-instance 'expression :list args)) + (defmethod print-object ((ex expression) stream) (prin1 (expression-list ex) stream)) @@ -102,12 +105,19 @@ ;;;; Then the derivatives (defmethod .= ((x symbol) (y symbol) &optional whatever) + (declare (ignore whatever)) (eql x y)) (defmethod .log ((x symbol) &optional (n nil)) (if x - (expr '.log x n) - (expr '.log x))) + (make-expression `(.log ,x ,n)) + (make-expression `(.log ,x)))) + +(defmethod .sin ((x symbol)) + (make-expression `(.sin ,x))) + +(defmethod .cos ((x symbol)) + (make-expression `(.cos ,x))) (defgeneric .partial (epxr var) (:documentation "Parial derivative of the expressions with regards to the variable.")) @@ -117,20 +127,151 @@ 1 0)) -(defmethod .partial ((x expression) (y symbol))) +(defmethod .partial ((x number) (y symbol)) + 0) + +(defmethod .partial ((x expression) (var symbol)) + ;; The best would'we been to have no special treatment of .+ and .*, + ;; and just go through the partial-of-function. + (let ((expr (expression-list x))) + (if (atom expr) + (.partial expr var) + (case (car expr) + (.+ (apply #'.+ (mapcar (lambda (expr) + (.partial (make-expression expr) var)) + (cdr expr)))) + (.* 'todo) + (t (let* ((args-val (cdr expr)) + (args-sym (mapcar (lambda (x) (gensym)) args-val)) + (pos (position var args-val))) + (if pos + (.partial-of-function (car expr) pos args-val) ; argument is a symbol + (.* (make-expression + (sublis (mapcar #'cons args-sym args-val) + (expression-list + (.partial-of-function (car expr) 0 args-sym)))) + (.partial (make-expression (car args-val)) ; Todo make sum + var))))))))) + + + +;;; Now test the idea of symbolic functions + +(defclass symbolic-function () + ((args :initarg :args :initform '(x y) :accessor symbolic-function-args) + (body :initarg :body :initform '(* x y) :accessor symbolic-function-body)) + (:metaclass sb-mop:funcallable-standard-class)) + +(defmethod initialize-instance :after ((sf symbolic-function) &key) + (with-slots (args body) + sf + (sb-mop:set-funcallable-instance-function + sf + (let* ((args2 args) + (body2 body) + (code `(lambda ,args2 ,body2)) + (fun (eval code))) + fun)))) + +(defun make-symbolic-function (args body) + (make-instance 'symbolic-function :args args :body body)) + +(defmacro .fun (args &body body) + `(make-symbolic-function ',args ', at body)) + + +(defmethod print-object ((o symbolic-function) stream) + (format stream "(.fun ~a ~a)" + (symbolic-function-args o) + (symbolic-function-body o))) + +(defun change-argument-names (sf args) + "Makes an identical symbolic function, but with new argument names." + (let* ((alst (mapcar #'cons (symbolic-function-args sf) args)) + (new-body (sublis alst (symbolic-function-body sf)))) + (make-symbolic-function args new-body))) (defgeneric .partial-of-function (fun arg-num args) - (:documentation "The parial derivive of a function")) + (:documentation "The parial derivive of a function. Retuns a list.")) (defmethod .partial-of-function ((f (eql '.log)) (arg-num (eql 0)) args) - "Args must be a list" + ;; Args must be a list (if (cdr args) - (expr './ 1 (car args) (.log (cadr args))) - (expr './ (car args)))) + (./ 1 (car args) (.log (cadr args))) + (./ (car args)))) (defmethod .partial-of-function ((f (eql '.sin)) (arg-num (eql 0)) args) - (expr '.cos (car args))) + (.cos (car args))) (defmethod .partial-of-function ((f (eql '.cos)) (arg-num (eql 0)) args) - (expr '.- (expr '.sin (car args)))) + (.- (.sin (car args)))) + + + + +;;;; Some simplifications +(defmethod .add ((a symbolic-function) (b symbolic-function)) + (if (equal (symbolic-function-args a) + (symbolic-function-args b)) + (make-symbolic-function + (symbolic-function-args a) + (append '(.+) (symbolic-function-body a) (symbolic-function-body b))) + `(.+ ,a ,b))) + + +(defmethod .mul ((a symbolic-function) (b symbolic-function)) + (if (equal (symbolic-function-args a) + (symbolic-function-args b)) + (make-symbolic-function + (symbolic-function-args a) + (append '(.+) (symbolic-function-body a) (symbolic-function-body b))) + `(.* ,a ,b))) + + + +;;; Some simple simlifications + +(defmethod .add :around ((a symbol) (b number)) + (if (eql b 0) + a + (call-next-method))) + +(defmethod .add :around ((b number) (a symbol)) + (if (eql b 0) + a + (call-next-method))) + +(defmethod .add :around ((a expression) (b number)) + (if (eql b 0) + a + (call-next-method))) + +(defmethod .add :around ((b number) (a expression)) + (if (eql b 0) + a + (call-next-method))) + +(defmethod .mul :around ((a symbol) (b number)) + (case b + (0 0) + (1 a) + (t (call-next-method)))) + +(defmethod .mul :around ((b number) (a symbol)) + (case b + (0 0) + (1 a) + (t (call-next-method)))) + +(defmethod .mul :around ((a expression) (b number)) + (case b + (0 0) + (1 a) + (t (call-next-method)))) + +(defmethod .mul :around ((b number) (a expression)) + (case b + (0 0) + (1 a) + (t (call-next-method)))) \ No newline at end of file From jivestgarden at common-lisp.net Mon Aug 10 18:58:47 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Mon, 10 Aug 2009 14:58:47 -0400 Subject: [lisplab-cvs] r81 - in src: core matrix Message-ID: Author: jivestgarden Date: Mon Aug 10 14:58:46 2009 New Revision: 81 Log: cleaned up on function expansions. Modified: src/core/level0-basic.lisp src/core/level0-functions.lisp src/core/level0-interface.lisp src/matrix/level2-generic.lisp src/matrix/level2-matrix-dge.lisp src/matrix/level2-matrix-zge.lisp Modified: src/core/level0-basic.lisp ============================================================================== --- src/core/level0-basic.lisp (original) +++ src/core/level0-basic.lisp Mon Aug 10 14:58:46 2009 @@ -26,7 +26,9 @@ ;; Here non ansi stuff. ;; First we need the truely-the macro -#+cbcl(import 'sb-ext::truly-the) +#+sbcl(import 'sb-ext::truly-the) +;; Help, not tested +#-sbcl(defmacro truely-the (type val) `(the ,type ,val)) (setf *READ-DEFAULT-FLOAT-FORMAT* 'double-float) ; TODO make part of pacakge import? Modified: src/core/level0-functions.lisp ============================================================================== --- src/core/level0-functions.lisp (original) +++ src/core/level0-functions.lisp Mon Aug 10 14:58:46 2009 @@ -92,31 +92,35 @@ (defmethod .>= ((a number) (b number)) (>= a b)) -(defmacro expand-on-numbers-lisplab-two-argument-functions-alist () - ;; TODO: optimize? why? - (cons 'progn - (mapcar (lambda (name) - `(defmethod ,(car name) ((a number) (b number)) - (,(cdr name) a b))) - +lisplab-two-argument-functions-alist+))) -(expand-on-numbers-lisplab-two-argument-functions-alist) +;;; The default operators on numbers -#+why-did-I-do-this?(defmethod .expt ((a real) (b real)) - (expt (to-df a) b)) +(defmethod .add ((a number) (b number)) + (+ a b)) + +(defmethod .mul ((a number) (b number)) + (* a b)) -(defmacro expand-on-numbers-lisplab-one-argument-functions-alist () +(defmethod .div ((a number) (b number)) + (/ a b)) + +(defmethod .sub ((a number) (b number)) + (- a b)) + +(defmethod .expt ((a number) (b number)) + (expt a b)) + + +(defmacro expand-num-num () ;; TODO: optimize? why? (cons 'progn (mapcar (lambda (name) `(progn (defmethod ,(car name) ((a number)) - (,(cdr name) a)) - (defmethod ,(car name) ((a real)) - (,(cdr name) (to-df a))))) - +lisplab-one-argument-functions-alist+))) + (,(cdr name) a)))) + +functions-real-to-real+))) -(expand-on-numbers-lisplab-one-argument-functions-alist) +(expand-num-num) (defmethod .log ((x number) &optional (base nil)) (if base @@ -131,28 +135,35 @@ (defmethod .sqr ((x number)) (* x x)) -(defmethod .sqr ((x real)) +(defmethod .sqr ((x float)) (let ((x (to-df x))) (* x x))) -#| -(defmethod .add ((a number) (b number)) - (+ a b)) -(defmethod .mul ((a number) (b number)) - (* a b)) -(defmethod .div ((a number) (b number)) - (/ a b)) -(defmethod .sub ((a number) (b number)) - (- a b)) -(defmethod .expt ((a number) (b number)) - (expt a b)) + + +#+nil (defmacro expand-on-numbers-lisplab-two-argument-functions-alist () + ;; TODO: optimize? why? + (cons 'progn + (mapcar (lambda (name) + `(defmethod ,(car name) ((a number) (b number)) + (,(cdr name) a b))) + +lisplab-two-argument-functions-alist+))) + +#+nil (expand-on-numbers-lisplab-two-argument-functions-alist) + +#+why-did-I-do-this?(defmethod .expt ((a real) (b real)) + (expt (to-df a) b)) + + +#| + (defmethod .expt ((a real) (b real)) Modified: src/core/level0-interface.lisp ============================================================================== --- src/core/level0-interface.lisp (original) +++ src/core/level0-interface.lisp Mon Aug 10 14:58:46 2009 @@ -43,32 +43,28 @@ .erf .erfc .gamma)) -(define-constant +lisplab-one-argument-functions+ - '(.sin .cos .tan .asin .acos .atan - .sinh .cosh .tanh .asinh .acosh .atanh - .exp .sqr .sqrt .conj) - ;; List of "nice" functions that output real to real, have one argument. - ;; Not part of the list: .log, .conj, .realpart, .imagpart and most special functions - "Functions functions that takes exactly one argument and preserve type.") +(define-constant +functions-real-to-real+ + '((.sin . sin) (.cos . cos) (.tan . tan) + (.asin . asin) (.acos . acos) (.atan . atan) + (.sinh . sinh) (.cosh . cosh) (.tanh . tanh) + (.asinh . asinh) (.acosh . acosh) (.atanh . atanh) + (.exp . exp) (.sqr . .sqr) (.sqrt . sqrt) (.conj . conjugate) + (.realpart . realpart) (.imagpart . imagpart) (.abs . abs) + (.erf . .erf) (.erfc . .erfc) + (.gamma . .gamma)) + "Functions of one argument that map real to real.") + +;; Other functions: log, .besj, .besy, .besi, .besk, .besh1, .besh2, .ai -(define-constant +lisplab-one-argument-functions-alist+ +(define-constant +functions-complex-to-complex+ '((.sin . sin) (.cos . cos) (.tan . tan) (.asin . asin) (.acos . acos) (.atan . atan) (.sinh . sinh) (.cosh . cosh) (.tanh . tanh) (.asinh . asinh) (.acosh . acosh) (.atanh . atanh) - (exp. . exp) (.sqrt . sqrt) (.conj . conjugate)) - ;; List of "nice" functions that output real to real, have one argument, - ;; and a analogy in the Common Lisp package. - ;; Note part of the list: .log, .sq, and all special functions - "A map between lisplab and common lisp functions that take exactly one argument.") - -(define-constant +lisplab-two-argument-functions+ - '(.add .sub .mul .div .expt) - "Functions functions that takes exactly one argument and preserve type.") - -(define-constant +lisplab-two-argument-functions-alist+ - '((.add . +) (.sub . -) (.mul . *) (.div . /) (.expt . expt)) - "A map between lisplab and common lisp functions that take exactly two arguments.") + (.exp . exp) (.sqrt . sqrt) (.conj . conjugate) + (.erf . .erf) (.erfc . .erfc) + (.gamma . .gamma)) + "Functions of one argument that maps complex to complex.") (defgeneric scalar? (x) (:documentation "A scalar is a object with ignored internal structure.")) Modified: src/matrix/level2-generic.lisp ============================================================================== --- src/matrix/level2-generic.lisp (original) +++ src/matrix/level2-generic.lisp Mon Aug 10 14:58:46 2009 @@ -257,15 +257,6 @@ (setf (vref ,a ,i) (,op (vref ,a ,i) (vref ,b ,i)))) ,a))))) -(defmacro expand-on-matrix-ge-lisplab-two-argument-functions-alist () - (cons 'progn - (mapcar (lambda (name) - `(def-binary-op-matrix-ge ,(car name))) - +lisplab-two-argument-functions-alist+))) - -(expand-on-matrix-ge-lisplab-two-argument-functions-alist) - -#| (def-binary-op-matrix-ge .add) (def-binary-op-matrix-ge .mul) @@ -275,7 +266,10 @@ (def-binary-op-matrix-ge .div) (def-binary-op-matrix-ge .expt) -|# + +(def-binary-op-matrix-ge .min) + +(def-binary-op-matrix-ge .max) (defmacro each-element-function-matrix-ge (x form) "Applies a form on each element of an matrix-ge." @@ -288,33 +282,19 @@ ,form))) ,y))) -(defmacro expand-on-matrix-ge-lisplab-one-argument-functions-alist () +(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)))) - +lisplab-one-argument-functions-alist+))) - -(expand-on-matrix-ge-lisplab-one-argument-functions-alist) - - - -(defmethod .imagpart ((x matrix-ge)) - (each-element-function-matrix-ge x (.imagpart x))) - -(defmethod .realpart ((x matrix-ge)) - (each-element-function-matrix-ge x (.realpart x))) - -(defmethod .abs ((x matrix-ge)) - (each-element-function-matrix-ge x (.abs 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))) -(defmethod .sqr ((x matrix-ge)) - (each-element-function-matrix-ge x (.sqr x))) - ;;; Bessel functions Modified: src/matrix/level2-matrix-dge.lisp ============================================================================== --- src/matrix/level2-matrix-dge.lisp (original) +++ src/matrix/level2-matrix-dge.lisp Mon Aug 10 14:58:46 2009 @@ -50,18 +50,6 @@ (incf sum (aref m0 i))) sum)) - -(defmethod .imagpart ((a matrix-base-dge)) - (mcreate a 0)) - -(defmethod .realpart ((a matrix-base-dge)) - (copy a)) - -(defmethod .abs ((a matrix-base-dge)) - (let ((b (mcreate a))) - (copy-contents a b #'abs) - b)) - (defmethod .some (pred (a matrix-base-dge) &rest args) (let ((stores (mapcar #'matrix-store (cons a args)))) (apply #'some pred stores))) @@ -112,13 +100,20 @@ (setf (aref ,store ,i) (,old (aref ,store ,i) (aref ,store2 ,i)))) ,a))))) -(defmacro expand-on-matrix-dge-lisplab-two-argument-functions-alist () - (cons 'progn - (mapcar (lambda (name) - `(def-binary-op-matrix-base-dge ,(car name) ,(cdr name))) - +lisplab-two-argument-functions-alist+))) +(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) + +(def-binary-op-matrix-base-dge .max max) -(expand-on-matrix-dge-lisplab-two-argument-functions-alist) (defmacro each-matrix-element-df-to-df (x form) "Applies a form on each element of an matrix-dge. The form must @@ -133,36 +128,24 @@ (declare (type type-blas-idx ,i) (type double-float ,x)) (setf (aref ,store ,i) - ,form))) + ,form))) ,x))) -(defmacro expand-on-matrix-dge-lisplab-one-argument-functions-alist () +(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)))) - +lisplab-one-argument-functions-alist+))) + +functions-real-to-real+))) + +(expand-matrix-dge-num-num) -(expand-on-matrix-dge-lisplab-one-argument-functions-alist) (defmethod .log ((x matrix-base-dge) &optional base) (if base (each-matrix-element-df-to-df x (log x base)) (each-matrix-element-df-to-df x (log x)))) -(defmethod .sqr ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (* x x))) - -;;; Other spacial functions - -(defmethod .erf ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (.erf x))) - -(defmethod .erfc ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (.erfc x))) - -(defmethod .gamma ((x matrix-base-dge)) - (each-matrix-element-df-to-df x (.gamma x))) ;;; Bessel functions @@ -198,3 +181,27 @@ (defmethod .besh2 (n (x matrix-base-dge)) (each-matrix-element-df-to-complex-df x (.besh2 n x))) + +#| + + +(defmethod .imagpart ((a matrix-base-dge)) + (mcreate a 0)) + +(defmethod .realpart ((a matrix-base-dge)) + (copy a)) + +(defmethod .abs ((a matrix-base-dge)) + (let ((b (mcreate a))) + (copy-contents a b #'abs) + b)) + + +(defmacro expand-on-matrix-dge-lisplab-two-argument-functions-alist () + (cons 'progn + (mapcar (lambda (name) + `(def-binary-op-matrix-base-dge ,(car name) ,(cdr name))) + +lisplab-two-argument-functions-alist+))) + +(expand-on-matrix-dge-lisplab-two-argument-functions-alist) +|# \ 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 Mon Aug 10 14:58:46 2009 @@ -135,13 +135,16 @@ (ref-blas-complex-store ,store2 ,i 0 ,len)))) ,b))))) -(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+))) +(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) -(expand-on-matrix-zge-lisplab-two-argument-functions-alist) (defmacro each-element-function-matrix-base-zge (x form) "Applies a form on each element of an matrix-base-zge." @@ -156,23 +159,20 @@ ,form))) ,y))) -(defmacro expand-on-matrix-zge-lisplab-one-argument-functions-alist () +(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)))) - +lisplab-one-argument-functions-alist+))) + +functions-complex-to-complex+))) -(expand-on-matrix-zge-lisplab-one-argument-functions-alist) +(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)))) -(defmethod .sqr ((x matrix-base-zge)) - (each-element-function-matrix-base-zge x (* x x))) - ;;; Bessel functions (defmethod .besj (n (x matrix-base-zge)) @@ -194,3 +194,20 @@ (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) +|# + From jivestgarden at common-lisp.net Wed Aug 12 19:41:16 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Wed, 12 Aug 2009 15:41:16 -0400 Subject: [lisplab-cvs] r82 - doc/manual Message-ID: Author: jivestgarden Date: Wed Aug 12 15:41:16 2009 New Revision: 82 Log: more manual Modified: doc/manual/lisplab.texi Modified: doc/manual/lisplab.texi ============================================================================== --- doc/manual/lisplab.texi (original) +++ doc/manual/lisplab.texi Wed Aug 12 15:41:16 2009 @@ -89,9 +89,9 @@ specify the location of the foreign libraries. You specify these in three special variables, @itemize - at item *lisplab-libblas-path* - at item *lisplab-liblapack-path* - at item *lisplab-libfftw-path* + at item @code{*lisplab-libblas-path*} + at item @code{*lisplab-liblapack-path*} + at item @code{*lisplab-libfftw-path*} @end itemize that live their lives in the Common-Lisp-User package. You can either assign them on the top-level, in you Common Lisp @@ -108,10 +108,10 @@ FFIs to BLAS and LAPACK. These are modified version from Matlisp. @item @emph{Lisplab-fftw} -- FFI to FFTW for Fast Fourier Transform. - at item Slatec -- + at item @emph{Slatec} -- special functions, generated from Fortran by f2cl. Originally made for Maxima. - at item Quadpack -- + at item @emph{Quadpack} -- integration routines, generated from Fortran by f2cl. @end itemize @@ -157,6 +157,7 @@ of matrix classes. @end itemize + @section Status - past and future The purpose of Lisplab is to provide a complete mathematics programming environment, @@ -214,7 +215,8 @@ @section The dotted algebra -Central in Lisplab is an algebra with the functions +Central in Lisplab is an algebra (in the widest possible sense of the word) +with the functions @code{.+}, @code{.-}, @code{.*}, @code{./}, and @code{.^}. These are generalization of @code{+}, @code{-}, @code{*}, @code{/}, and @code{^}. @@ -514,6 +516,37 @@ @node Structure @chapter Structure + at section Design principles +Design principles for the full library + at itemize + at item Lisplab is free software. + at item It makes a @i{homogeneous platform} for all +kinds of mathematical calculations. (So it's a lot more +than just a matrix library) + at item User applications need only to stay in Common Lisp. +(There should be no need +for optimized math in FFIs or special languages like Maxima) + at item Every common mathematical operator and function +is represented by a @i{CLOS generic function}. (By convention +the names of the operators start with a dot and is called +the dotted algebra, where algebra is used in the widest possible sense +of the word). + at item Modular structure (Inspired by GSL). + at item To steal as much as possible from as many as possible +(I love free software). + at end itemize + +Design principles for the matrix part + at itemize + at item Layered structure where dependencies are +primarily on the layer below -- not vertical in the layer. + at item The layers get larger upwards. Combined with the previous +principle it ensures a modular structure! + at end itemize + + + + @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 @@ -563,8 +596,19 @@ denote the level, it is most probably level 3, or outside the level system (non matrix code). - at section Class structure -TODO + at section Matrix class hierarchy +The matrix class hierarchy has three independent +lines of inheritance + at itemize + at item On structure + at item On element type + at item On implementation + at end itemize +The structure is inspired by the stream example in +Object-Oriented Programming in Common Lisp, +by Sonya E. Keene. + + From jivestgarden at common-lisp.net Sat Aug 15 18:26:01 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 15 Aug 2009 14:26:01 -0400 Subject: [lisplab-cvs] r83 - src/core src/fft src/io src/linalg src/matrix src/util Message-ID: Author: jivestgarden Date: Sat Aug 15 14:26:00 2009 New Revision: 83 Log: centralized the package structure. Not tested Modified: package.lisp src/core/level0-basic.lisp src/core/level0-const.lisp src/core/level0-functions.lisp src/core/level0-infpre.lisp src/core/level0-interface.lisp src/core/level0-permutation.lisp src/fft/level3-fft-interface.lisp src/io/level3-io.lisp src/linalg/level3-linalg-interface.lisp src/matrix/level1-classes.lisp src/matrix/level1-interface.lisp src/matrix/level2-constructors.lisp src/matrix/level2-interface.lisp src/util/level3-euler.lisp src/util/level3-rk4.lisp Modified: package.lisp ============================================================================== --- package.lisp (original) +++ package.lisp Sat Aug 15 14:26:00 2009 @@ -19,11 +19,6 @@ ;;; TODO split this out -(defpackage "LISPLAB" - (:nicknames "LL") - (:use "COMMON-LISP") - (:documentation "Mathematics and linear algebra library")) - (defpackage "FORTRAN-FFI-ACCESSORS" (:use "COMMON-LISP" "SB-ALIEN" "SB-C") (:export "DEF-FORTRAN-ROUTINE" @@ -32,10 +27,183 @@ "WITH-VECTOR-DATA-ADDRESSES") (:documentation "Fortran foreign function interface")) +(defpackage "LISPLAB" + (:use "COMMON-LISP") + (:export + ;; Numerical constants + "%I" + "%E" + "-%I" + + ;; Some general methods + "COPY" + "CONVERT" + "SCALAR?" + "VECTOR?" + "MATRIX?" + + ;; Basic methods (The dotted algebra) + ".+" + ".*" + "./" + ".-" + ".^" + "^" + ".MAX" + ".MIN" + ".ABS" + ".IMAGPART" + ".REALPART" + ".=" + "./=" + ".<" + ".<=" + ".>" + ".>=" + ".ADD" + ".MUL" + ".DIV" + ".SUB" + ".EXPT" + ".CONJ" + ".SIN" + ".COS" + ".TAN" + ".ASIN" + ".ACOS" + ".ATAN" + ".SINH" + ".COSH" + ".TANH" + ".ASINH" + ".ACOSH" + ".ATANH" + ".LOG" + ".EXP" + ".SQR" + ".SQRT" + ".AI" + ".BESJ" + ".BESY" + ".BESI" + ".BESK" + ".BESH1" + ".BESH2" + ".ERF" + ".ERFC" + ".GAMMA" + + ;; Infix notation + "*SEPARATORS*" + "W/INFIX" + "INFIX->PREFIX" + "PREFIX->INFIX" + + ;; Now the matrix stuff + ;; Matrix classes + "MATRIX-BASE" + "MATRIX-GE" + "MATRIX-DGE" + "MATRIX-ZGE" + "FUNCTION-MATRIX" + "*LISPLAB-PRINT-SIZE*" + ;; Matrix level 1 methods + "MAKE-MATRIX-INSTANCE" + "MREF" + "VREF" + "DIM" + "ELEMENT-TYPE" + "SIZE" + "RANK" + "ROWS" + "COLS" + ;; Matrix level 2 constructors + "FUNMAT" + "FMAT" + "MAT" + "COL" + "ROW" + "DMAT" + "DNEW" + "DCOL" + "DROW" + "DRANDOM" + "ZMAT" + "ZNEW" + "ZCOL" + "ZROW" + ;; Matrix level 2 methods + + ".EVERY"; to level0 or change name? + ".SOME" ; to level0 or change name? + "SQUARE-MATRIX?" + "MNEW" + "MCREATE" + "COPY-CONTENTS" + + "MMAP" + "MFILL" + "TO-VECTOR" + "TO-MATRIX" + "RESHAPE" + "GET-ROW" + "GET-COL" + "VIEW-ROW" + "VIEW-COL" + "VIEW-MATRIX" + "VIEW-MATRIX-AS-VECTOR" + "VIEW-VECTOR-AS-MATRIX" + "VIEW-TRANSPOSE" + "MSUM" + "MMIN" + "MMAX" + "MABSMIN" + "MABSMAX" + "SUB-MATRIX" ; To level3 ? + "CIRC-SHIFT" + "PAD-SHIFT" + + ;; Matrix level 3 + ;; IO + "PGMWRITE" + "PSWRITE" + "DLMREAD" + "DLMWRITE" + + ;; ODE solvers + "EULER" ; todo change name + "RK4" ; todo change name + + ;; Linear algebra + "MTP" + "MCT" + "MTR" + "MDET" + "MINV" + "M*" + "M/" + "LU-FACTOR" + "LIN-SOLVE" + "EIGENVALUES" + "EIGENVECTORS" + + ;; FFT + "ffT1" + "IFFT1" + "FFT2" + "IFFT2" + "FFT-SHIFT" + "IFFT-SHIFT" + )) + (defpackage "LISPLAB-BLAS" - (:nicknames "LL-BLAS") - (:use "COMMON-LISP" "SB-EXT" "LISPLAB") - (:documentation "Mathematics and linear algebra library")) + (:use "COMMON-LISP" "LISPLAB") + (:documentation "Mathematics and linear algebra library.")) + + + + + Modified: src/core/level0-basic.lisp ============================================================================== --- src/core/level0-basic.lisp (original) +++ src/core/level0-basic.lisp Sat Aug 15 14:26:00 2009 @@ -21,8 +21,6 @@ (in-package :lisplab) -(export '(in-dir )) - ;; Here non ansi stuff. ;; First we need the truely-the macro Modified: src/core/level0-const.lisp ============================================================================== --- src/core/level0-const.lisp (original) +++ src/core/level0-const.lisp Sat Aug 15 14:26:00 2009 @@ -19,8 +19,6 @@ (in-package :lisplab) -(export '(%i %e -%i)) - ;;; Float and complex constants (define-constant %e (exp 1.0) "The number e = exp(1).") (define-constant %i #C(0.0 1.0) "The imaginary unit i=sqrt(-1).") @@ -33,8 +31,6 @@ (define-constant %sb32 '(signed-byte 32)) (define-constant %ub32 '(unsigned-byte 32)) - - ;;;; Constants from gsl. ;;; TODO: throw them out Modified: src/core/level0-functions.lisp ============================================================================== --- src/core/level0-functions.lisp (original) +++ src/core/level0-functions.lisp Sat Aug 15 14:26:00 2009 @@ -19,8 +19,6 @@ (in-package :lisplab) -(export '(.+ .* ./ .- .^ ^)) - (defmethod matrix? ((a number)) nil) (defmethod vector? ((a number)) nil) @@ -140,119 +138,3 @@ (* x x))) - - - - - - - - -#+nil (defmacro expand-on-numbers-lisplab-two-argument-functions-alist () - ;; TODO: optimize? why? - (cons 'progn - (mapcar (lambda (name) - `(defmethod ,(car name) ((a number) (b number)) - (,(cdr name) a b))) - +lisplab-two-argument-functions-alist+))) - -#+nil (expand-on-numbers-lisplab-two-argument-functions-alist) - -#+why-did-I-do-this?(defmethod .expt ((a real) (b real)) - (expt (to-df a) b)) - - -#| - - - -(defmethod .expt ((a real) (b real)) - (expt (to-df a) b)) -|# - -#| -(defmethod .sin ((x number)) - (sin x)) - -(defmethod .sin ((x real)) - (sin (to-df x))) - -(defmethod .cos ((x number)) - (cos x)) - -(defmethod .cos ((x real)) - (cos (to-df x))) - -(defmethod .tan ((x number)) - (tan x)) - -(defmethod .tan ((x real)) - (tan (to-df x))) - -(defmethod .asin ((x real)) - (asin (to-df x))) - -(defmethod .acos ((x number)) - (acos x)) - -(defmethod .acos ((x real)) - (acos (to-df x))) - -(defmethod .atan ((x number)) - (atan x)) - -(defmethod .atan ((x real)) - (atan (to-df x))) - -(defmethod .exp ((x number)) - (exp x)) - -(defmethod .exp ((x real)) - (exp (to-df x))) - - -(defmethod .sqrt ((x number)) - (sqrt x)) - -(defmethod .sqrt ((x real)) - (sqrt (to-df x))) - -(defmethod .sinh ((x number)) - (sinh x)) - -(defmethod .sinh ((x real)) - (sinh (to-df x))) - -(defmethod .cosh ((x number)) - (cosh x)) - -(defmethod .cosh ((x real)) - (cosh (to-df x))) - -(defmethod .tanh ((x number)) - (tanh x)) - -(defmethod .tanh ((x real)) - (tanh (to-df x))) - -(defmethod .asinh ((x number)) - (asinh x)) - -(defmethod .asinh ((x real)) - (asinh (to-df x))) - -(defmethod .acosh ((x number)) - (acosh x)) - -(defmethod .acosh ((x real)) - (acosh (to-df x))) - -(defmethod .atanh ((x number)) - (atanh x)) - -(defmethod .atanh ((x real)) - (atanh (to-df x))) - -|# - - Modified: src/core/level0-infpre.lisp ============================================================================== --- src/core/level0-infpre.lisp (original) +++ src/core/level0-infpre.lisp Sat Aug 15 14:26:00 2009 @@ -35,8 +35,6 @@ (in-package :lisplab) -(export '(*separators* w/infix infix->prefix prefix->infix)) - (defvar *separators* '(.+ + .- - .* * ./ / .^ ^) "Default operators for the math macros") Modified: src/core/level0-interface.lisp ============================================================================== --- src/core/level0-interface.lisp (original) +++ src/core/level0-interface.lisp Sat Aug 15 14:26:00 2009 @@ -20,29 +20,6 @@ (in-package :lisplab) -(export '(copy convert - scalar? - vector? matrix? - .max .min - .abs .imagpart .realpart - .= ./= .< .<= .> .>= - .add .add! - .mul mul! - .div .div! - .sub .sub! - .expt .expt! - .conj - .sin .cos .tan - .asin .acos .atan - .sinh .cosh .tanh - .asinh .acosh .atanh - .log .exp - .sqr .sqrt - .Ai - .besj .besy .besi .besk .besh1 .besh2 - .erf .erfc - .gamma)) - (define-constant +functions-real-to-real+ '((.sin . sin) (.cos . cos) (.tan . tan) (.asin . asin) (.acos . acos) (.atan . atan) Modified: src/core/level0-permutation.lisp ============================================================================== --- src/core/level0-permutation.lisp (original) +++ src/core/level0-permutation.lisp Sat Aug 15 14:26:00 2009 @@ -1,5 +1,5 @@ ;;; Level2-funmat.lisp -;;; Functions as matrix +;;; Permutation of matrix indices. ;;; Copyright (C) 2009 Joern Inge Vestgaarden ;;; @@ -19,8 +19,9 @@ (in-package :lisplab) -(deftype type-permutation () - '(MOD 536870911)) +(deftype type-permutation () + ;; This should be the same as the max size of arrays + '(MOD 536870911)) (deftype type-permutation-vector () '(simple-array type-permutation (*))) Modified: src/fft/level3-fft-interface.lisp ============================================================================== --- src/fft/level3-fft-interface.lisp (original) +++ src/fft/level3-fft-interface.lisp Sat Aug 15 14:26:00 2009 @@ -19,9 +19,6 @@ (in-package :lisplab) -(export '(fft1 ifft1 fft1! ifft! fft2 ifft2 fft2! ifft2! - fft-shift ifft-shift)) - ;;;; Fourier stuff (defgeneric fft1 (x) Modified: src/io/level3-io.lisp ============================================================================== --- src/io/level3-io.lisp (original) +++ src/io/level3-io.lisp Sat Aug 15 14:26:00 2009 @@ -25,8 +25,6 @@ (in-package :lisplab) -(export '(pgmwrite dlmread dlmwrite pswrite)) - (defun dlmwrite (a &optional (out t) &key (dlm " ") Modified: src/linalg/level3-linalg-interface.lisp ============================================================================== --- src/linalg/level3-linalg-interface.lisp (original) +++ src/linalg/level3-linalg-interface.lisp Sat Aug 15 14:26:00 2009 @@ -19,14 +19,6 @@ (in-package :lisplab) -(export '(mtp mtp! mct mct! - mtr mdet minv! minv - m* m*! m/ m/! - LU-factor LU-factor! - lin-solve - eigenvalues - eigenvectors)) - (defgeneric mtp (matrix) (:documentation "Matrix transpose.")) Modified: src/matrix/level1-classes.lisp ============================================================================== --- src/matrix/level1-classes.lisp (original) +++ src/matrix/level1-classes.lisp Sat Aug 15 14:26:00 2009 @@ -23,14 +23,6 @@ (in-package :lisplab) -(export '(matrix-ge - matrix-base - matrix-dge - matrix-zge - function-matrix - ;; Do we need the others? - )) - (declaim (inline matrix-store)) (defclass matrix-base () ()) Modified: src/matrix/level1-interface.lisp ============================================================================== --- src/matrix/level1-interface.lisp (original) +++ src/matrix/level1-interface.lisp Sat Aug 15 14:26:00 2009 @@ -20,12 +20,6 @@ (in-package :lisplab) -(export '(*lisplab-print-size* - make-matrix-instance - ref mref vref - dim element-type - size rank rows cols)) - (defvar *lisplab-print-size* 10 "Suggested number of rows and columns printed to standard output. Not all matrices, such as ordinary lisp arrays, will care about the value.") (defgeneric make-matrix-instance (type dim value) Modified: src/matrix/level2-constructors.lisp ============================================================================== --- src/matrix/level2-constructors.lisp (original) +++ src/matrix/level2-constructors.lisp Sat Aug 15 14:26:00 2009 @@ -19,13 +19,6 @@ (in-package :lisplab) -(export '(funmat - fmat - mat col row - dmat dnew dcol drow - drandom - zmat znew zcol zrow)) - (defmethod copy ((a matrix-base)) (let ((x (make-matrix-instance (class-of a) (dim a) 0))) (dotimes (i (size x)) Modified: src/matrix/level2-interface.lisp ============================================================================== --- src/matrix/level2-interface.lisp (original) +++ src/matrix/level2-interface.lisp Sat Aug 15 14:26:00 2009 @@ -21,30 +21,6 @@ ;;; TODO sort and possibly move to other levels -(export '( - .every .some ; to level0 ? - square-matrix? - mnew - mcreate - copy-contents -; .map - mmap mfill -; dlmwrite dlmread - to-vector! to-vector - to-matrix! to-matrix - reshape! reshape - get-row! get-row - get-col! get-col - view-row view-col - view-matrix - view-matrix-as-vector - view-vector-as-matrix - view-transpose - msum mmin mmax mabsmin mabsmax - sub-matrix ; To level3 ? - circ-shift - pad-shift)) - (defgeneric .some (pred a &rest matrices) (:documentation "Generalizes some")) Modified: src/util/level3-euler.lisp ============================================================================== --- src/util/level3-euler.lisp (original) +++ src/util/level3-euler.lisp Sat Aug 15 14:26:00 2009 @@ -19,8 +19,6 @@ (in-package :lisplab) -(export '(euler)) - (defun euler (func y x &key (step) Modified: src/util/level3-rk4.lisp ============================================================================== --- src/util/level3-rk4.lisp (original) +++ src/util/level3-rk4.lisp Sat Aug 15 14:26:00 2009 @@ -20,8 +20,6 @@ (in-package :lisplab) -(export '(rk4)) - (defun rk4 (func y x &key (step) From jivestgarden at common-lisp.net Sun Aug 16 09:46:41 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sun, 16 Aug 2009 05:46:41 -0400 Subject: [lisplab-cvs] r84 - doc/manual src/fft src/linalg src/matlisp Message-ID: Author: jivestgarden Date: Sun Aug 16 05:46:41 2009 New Revision: 84 Log: cleaning and error handling Modified: Makefile README TODO doc/manual/Makefile lisplab.asd package.lisp src/fft/level3-fft-fftw.lisp src/fft/level3-fft-zge.lisp src/linalg/level3-linalg-interface.lisp src/matlisp/geev.lisp src/matlisp/inv.lisp src/matlisp/mul.lisp start.lisp Modified: Makefile ============================================================================== --- Makefile (original) +++ Makefile Sun Aug 16 05:46:41 2009 @@ -1,7 +1,12 @@ +# Makefile for admin tasks +.PHONY: first, manual, touch, lispclean, clean, distclean first: echo "Please specify target." +manual: + make -C"doc/manual" all + touch: touch system/lisplab.asd Modified: README ============================================================================== --- README (original) +++ README Sun Aug 16 05:46:41 2009 @@ -1,56 +1,45 @@ -INTRODUCTION -Lisplab is a mathematics library for common lisp, released under GPL. +============================================================ +LISPLAB - a mathematics library for Common Lisp +============================================================ +Lisplab is a mathematics library for common lisp, released +under the GNU General Public License (GPL), except files +that state something else. -Directory structure: - src/ Lisplab source code - src/matliap From the Matlisp project. Rewritten for Lisplab matrices. - shared/ Unmodified code from other projects. - doc/ Documentation. +Homepage: http://common-lisp.net/projects/lisplab/ +Manual: doc/manual/lisplab.texi -STATUS -The project is not in finished state and names will change without warning. -However, the basic matrix code is a level where it is useful for doing -mathematical modelling. - -NAMING CONVENTION -The files including "interface" in the name defines generic functions only. -The files including "generic" in the name defines only unspecialized methods. -The levels in the names of source code is dependency levels: -level 0: - Methods that work on non-index objects, - but the methods here are also typically reimplemented - for matrices. - Exampels: copy, .+, .*, ... -level 1: - Basic matrix/tensor methods for indexing, element reference - and dimensionality. In order to make a new kind of matrix, all - mathods on this level must be reimplmented. - Examples: mref, dim, rows, cols, new, ... -level 2: - Basic functionality related to matrices. - Examples: mmax, mmap, diag, ... -level 3: - Linear algebra and anything else based on the matrices. - Examples: minv, m*, ... - +============================================================ INSTALLING -Lisplab is asdf-installable. It has only been tested on SBCL on Linux, -but should be fairly portable to other platforms, as soon as some minor -dependencies of the package sb-ext are resolved. - -The Matlisp linear algebra depends on externally libraries and these must -be specified in the variable asdf:*lisplab-external-libraries* before loading, -as seen in start.lisp. The order of the libraries matter and Blas must be -before Lapack. - -On Linux the Blas and Lapack libraries can often be installed by the operating -system package system. In Ubuntu, to get the Atlas build of Blas/Lapack, type - % aptitude install libatlas3gf-base - - -GOOD TO KNOW -Lisplab only works with double floats and single-floats should not be used. -To ensure this, use +============================================================ +Lisplab is asdf-installable. It has only been tested on SBCL +on Linux, but should be fairly portable to other platforms. + +Lisplab uses BLAS, LAPACK, and FFTW, and the path to these +libraries must be set before loading. See file "start.lisp" +for how. + +Lisplab has only been run with double-floats, so +your ".sbclrc" should include (setf *READ-DEFAULT-FLOAT-FORMAT* 'double-float) + + +============================================================ +Organization of the source code +============================================================ + src/ Lisplab source code. + shared/ Code from Slatec and Quadpack. + doc/ Documentation. + + +============================================================ +STATUS +============================================================ +Think of it as late alpha cycle. The Library is rather extensive, +the API is fairly stable, and the implementation has OK structure. +It also has fairly good documentation and a manual. +But it is poorly tested. + +(In general, Lisplab needs more users and more developers.) + Modified: TODO ============================================================================== --- TODO (original) +++ TODO Sun Aug 16 05:46:41 2009 @@ -1,21 +1,10 @@ TODO -o About arrays. Handle them by making wrappers in the matrix - hierarcy. This will be rather slow but saves work. - And in this way it is possible to avoid the non-speialized methods. -o Matrices with general element type. -o Some way to just extend the exact input matrix type -o Documentation. o Check if there is some non-threadsafe code in the fortran interface, i.e. array pre-alocation for the workspaces. -o Find out how to dynamically switch between common-lisp specialized - blas-arrays and fortan specialized blas-arrays. Currently this - is a mess. -o Test code. +o Testing. o Error handling. -o Added spcialized matrix types, in an ordered way. -o Package structure. +o More matrix types. (Sparse matrices) Extensions: -o Symbolic maniputions, similar to Ginac in C++. -o Threaded and paralell execution. Use CUDA? - \ No newline at end of file +o Symbolic manipulations - similar to C++s GINAC. +o Threaded and paralell execution. Use CUDA, SMP, or just threads?. Modified: doc/manual/Makefile ============================================================================== --- doc/manual/Makefile (original) +++ doc/manual/Makefile Sun Aug 16 05:46:41 2009 @@ -4,10 +4,10 @@ all: html pdf -html: $(source) +html: makeinfo --html $(source) -pdf: $(source) +pdf: texi2pdf $(source) clean: Modified: lisplab.asd ============================================================================== --- lisplab.asd (original) +++ lisplab.asd Sun Aug 16 05:46:41 2009 @@ -2,23 +2,22 @@ (in-package :cl-user) -(defvar *lisplab-libblas-path* nil "Path to blas shared object file") -(defvar *lisplab-liblapack-path* nil "Path to lapack shared object file") -(defvar *lisplab-fftw-path* nil "Path to fftw shared object file") +(defvar *lisplab-libblas-path* nil "Path to BLAS shared object file.") +(defvar *lisplab-liblapack-path* nil "Path to LAPACK shared object file.") +(defvar *lisplab-libfftw-path* nil "Path to FFTW shared object file.") (defpackage :asdf-lisplab (:use :asdf :cl)) (in-package :asdf-lisplab) (defun load-lisplab-lib (name) - (sb-alien:load-shared-object name)) + (when name + (sb-alien:load-shared-object name))) + +(defun explain-lisplab-lib (name path) + (format t "Loads ~A. Path ~a" name path)) -(defsystem :lisplab - ;; Default system, without external libs - :depends-on - (:lisplab-base - :quadpack)) -(defsystem :lisplab-all +(defsystem :lisplab ;; Default system, without all libs :depends-on (:lisplab-base @@ -136,15 +135,17 @@ (load-lisplab-lib cl-user::*lisplab-libblas-path*)) :explain (asdf:load-op :after (op c) - (format t "Loads alien object <~A>" - cl-user::*lisplab-libblas-path*))) + (explain-lisplab-lib + "BLAS" + cl-user::*lisplab-libblas-path*))) (:module :lapack-libs :perform (asdf:load-op :after (op c) (load-lisplab-lib cl-user::*lisplab-liblapack-path*)) :explain (asdf:load-op :after (op c) - (format t "Loads alien object <~A>" - cl-user::*lisplab-liblapack-path*))) + (explain-lisplab-lib + "LAPACK" + cl-user::*lisplab-liblapack-path*))) (:file "f77-package") (:file "ffi-sbcl") (:file "blas") @@ -171,8 +172,9 @@ (load-lisplab-lib cl-user::*lisplab-libfftw-path*)) :explain (asdf:load-op :after (op c) - (format t "Loads alien object <~A>" - cl-user::*lisplab-libfftw-path*))) + (explain-lisplab-lib + "FFTW" + cl-user::*lisplab-libfftw-path*))) (:file "fftw-ffi") (:file "level3-fft-fftw"))))) Modified: package.lisp ============================================================================== --- package.lisp (original) +++ package.lisp Sun Aug 16 05:46:41 2009 @@ -17,7 +17,13 @@ ;;; with this program; if not, write to the Free Software Foundation, Inc., ;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -;;; TODO split this out + +;;; It could be possible to split the big Lisplab package +;;; in smaller packages as indicated by the comments, but +;;; this would be more work and I see litle gain from it. +;;; As it is now, the asdf system tells the dependencies, not +;;; the pacakges. Think its OK. + (defpackage "FORTRAN-FFI-ACCESSORS" (:use "COMMON-LISP" "SB-ALIEN" "SB-C") @@ -29,7 +35,17 @@ (defpackage "LISPLAB" (:use "COMMON-LISP") - (:export + (:nicknames "LL") + (:documentation + "Lisplab is mathematics library released under the +GNU General Public License (GPL). + +Lisplab contains mathematical functions, matrices, +linear algebra, Fast Fourier Transform, +diff-solvers, and a lot more. + +Lisplab provides high level interfaces to BLAS, LAPACK and FFTW.") + (:export ;; Numerical constants "%I" "%E" @@ -195,15 +211,3 @@ "FFT-SHIFT" "IFFT-SHIFT" )) - -(defpackage "LISPLAB-BLAS" - (:use "COMMON-LISP" "LISPLAB") - (:documentation "Mathematics and linear algebra library.")) - - - - - - - - Modified: src/fft/level3-fft-fftw.lisp ============================================================================== --- src/fft/level3-fft-fftw.lisp (original) +++ src/fft/level3-fft-fftw.lisp Sun Aug 16 05:46:41 2009 @@ -16,13 +16,16 @@ ;;; with this program; if not, write to the Free Software Foundation, Inc., ;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +;;; There is a sligh missuse of notation here, since the method +;;; specialize on matrix-blas-zge, rather than matrix-fftw-zge, which +;;; would have a more correct name. + (in-package :lisplab) (defun fft1!-forward-or-backward (x direction) (let* ((rows (rows x)) (cols (cols x)) (store (matrix-store x))) - (print "allois") (dotimes (i cols) (fftw-ffi:fftw-fft1 rows @@ -35,27 +38,37 @@ x) (defmethod fft1! ((x matrix-blas-zge)) - (fft1!-forward-or-backward x fftw-ffi:+fftw-forward+)) + (if cl-user::*lisplab-libfftw-path* + (fft1!-forward-or-backward x fftw-ffi:+fftw-forward+) + (call-next-method))) (defmethod ifft1! ((x matrix-blas-zge)) - (fft1!-forward-or-backward x fftw-ffi:+fftw-backward+)) + (if cl-user::*lisplab-libfftw-path* + (fft1!-forward-or-backward x fftw-ffi:+fftw-backward+) + (call-next-method))) (defmethod fft2! ((x matrix-blas-zge)) - (fftw-ffi:fftw-fft2 - (rows x) - (cols x) - (matrix-store x) - (matrix-store x) - fftw-ffi:+fftw-forward+ - fftw-ffi:+FFTW-ESTIMATE+) - x) + (if cl-user::*lisplab-libfftw-path* + (progn + (fftw-ffi:fftw-fft2 + (rows x) + (cols x) + (matrix-store x) + (matrix-store x) + fftw-ffi:+fftw-forward+ + fftw-ffi:+FFTW-ESTIMATE+) + x) + (call-next-method))) (defmethod ifft2! ((x matrix-blas-zge)) - (fftw-ffi:fftw-fft2 - (rows x) - (cols x) - (matrix-store x) - (matrix-store x) - fftw-ffi:+fftw-backward+ - fftw-ffi:+FFTW-ESTIMATE+) - x) + (if cl-user::*lisplab-libfftw-path* + (progn + (fftw-ffi:fftw-fft2 + (rows x) + (cols x) + (matrix-store x) + (matrix-store x) + fftw-ffi:+fftw-backward+ + fftw-ffi:+FFTW-ESTIMATE+) + x) + (call-next-method))) Modified: src/fft/level3-fft-zge.lisp ============================================================================== --- src/fft/level3-fft-zge.lisp (original) +++ src/fft/level3-fft-zge.lisp Sun Aug 16 05:46:41 2009 @@ -21,25 +21,37 @@ (in-package :lisplab) + + + ;;;; The implementing methods + + (defmethod fft1! ((x matrix-lisp-zge)) + (assert (= 1 (logcount (rows x)))) (dotimes (i (cols x)) (fft-radix-2-blas-complex-store! :f (matrix-store x) (rows x) (* (rows x) i) 1)) x) (defmethod ifft1! ((x matrix-lisp-zge)) + (assert (= 1 (logcount (rows x)))) (dotimes (i (cols x)) (fft-radix-2-blas-complex-store! :r (matrix-store x) (rows x) (* (rows x) i) 1)) x) (defmethod fft2! ((x matrix-lisp-zge)) + (assert (and (= 1 (logcount (rows x))) + (= 1 (logcount (cols x))))) (fft1! x) (dotimes (i (rows x)) (fft-radix-2-blas-complex-store! :f (matrix-store x) (cols x) i (rows x))) x) (defmethod ifft2! ((x matrix-lisp-zge)) + (assert (and (= 1 (logcount (rows x))) + (= 1 (logcount (cols x))))) + (ifft1! x) (dotimes (i (rows x)) (fft-radix-2-blas-complex-store! :r (matrix-store x) (cols x) i (rows x))) Modified: src/linalg/level3-linalg-interface.lisp ============================================================================== --- src/linalg/level3-linalg-interface.lisp (original) +++ src/linalg/level3-linalg-interface.lisp Sun Aug 16 05:46:41 2009 @@ -35,16 +35,22 @@ (:documentation "Matrix trace (sum of diagonal elements).")) (defgeneric mdet (matrix) - (:documentation "Matrix determinant.")) + (:documentation "Matrix determinant.") + (:method :before (m) + (assert (square-matrix? m)))) (defgeneric minv! (a) (:documentation "Matrix inverse. Destructive.")) (defgeneric minv (a) - (:documentation "Matrix inverse.")) + (:documentation "Matrix inverse.") + (:method :before (m) + (assert (square-matrix? m)))) (defgeneric m* (a b) - (:documentation "Matrix product.")) + (:documentation "Matrix product.") + (:method :before (a b) + (assert (= (cols a) (rows b))))) (defgeneric m*! (a b) (:documentation "Matrix product. Destructive.")) Modified: src/matlisp/geev.lisp ============================================================================== --- src/matlisp/geev.lisp (original) +++ src/matlisp/geev.lisp Sun Aug 16 05:46:41 2009 @@ -33,14 +33,18 @@ (in-package :lisplab) (defmethod eigenvectors ((a matrix-blas-dge)) - (destructuring-bind (evals vl-mat vr-mat) - (dgeev (copy a) nil (mcreate a 0)) - (list evals vr-mat))) + (if cl-user::*lisplab-liblapack-path* + (destructuring-bind (evals vl-mat vr-mat) + (dgeev (copy a) nil (mcreate a 0)) + (list evals vr-mat)) + (call-next-method))) (defmethod eigenvalues ((a matrix-blas-dge)) - (destructuring-bind (evals vl-mat vr-mat) - (dgeev (copy a) nil nil) - evals)) + (if cl-user::*lisplab-liblapack-path* + (destructuring-bind (evals vl-mat vr-mat) + (dgeev (copy a) nil nil) + evals) + (call-next-method))) (defgeneric rearrange-eigenvector-matrix (v p)) @@ -129,14 +133,18 @@ (list evec vl-mat2 vr-mat2))))) (defmethod eigenvectors ((a matrix-zge)) - (destructuring-bind (evals vl-mat vr-mat) - (zgeev (copy a) nil (mcreate a 0)) - (list evals vr-mat))) + (if cl-user::*lisplab-liblapack-path* + (destructuring-bind (evals vl-mat vr-mat) + (zgeev (copy a) nil (mcreate a 0)) + (list evals vr-mat)) + (call-next-method))) (defmethod eigenvalues ((a matrix-zge)) - (destructuring-bind (evals vl-mat vr-mat) - (zgeev (copy a) nil nil) - evals)) + (if cl-user::*lisplab-liblapack-path* + (destructuring-bind (evals vl-mat vr-mat) + (zgeev (copy a) nil nil) + evals) + (call-next-method))) (defun zgeev-workspace-size (n lv? rv?) ;; Ask geev how much space it wants for the work array Modified: src/matlisp/inv.lisp ============================================================================== --- src/matlisp/inv.lisp (original) +++ src/matlisp/inv.lisp Sun Aug 16 05:46:41 2009 @@ -20,41 +20,47 @@ (in-package :lisplab) (defmethod minv! ((a matrix-blas-dge)) - (let* ((N (rows a)) - (ipiv (make-array N :element-type '(unsigned-byte 32))) - (msg "argument A given to minv is singular to working machine precision")) - (multiple-value-bind (_ ipiv info) - (f77::dgetrf N N (matrix-store a) N ipiv 0) - (declare (ignore _)) - (unless (zerop info) - (error msg)) - (let ((work (make-array N :element-type 'double-float))) - (multiple-value-bind (_ __ info) - (f77::dgetri N (matrix-store a) N ipiv work N 0) - (declare (ignore _ __)) - (unless (zerop info) - (error msg)) - a))))) + (if cl-user::*lisplab-liblapack-path* + (let* ((N (rows a)) + (ipiv (make-array N :element-type '(unsigned-byte 32))) + (msg "argument A given to minv is singular to working machine precision")) + (multiple-value-bind (_ ipiv info) + (f77::dgetrf N N (matrix-store a) N ipiv 0) + (declare (ignore _)) + (unless (zerop info) + (error msg)) + (let ((work (make-array N :element-type 'double-float))) + (multiple-value-bind (_ __ info) + (f77::dgetri N (matrix-store a) N ipiv work N 0) + (declare (ignore _ __)) + (unless (zerop info) + (error msg)) + a)))) + ;; Othervise, call native lisp implementation + (call-next-method))) (defmethod minv ((a matrix-blas-dge)) (minv! (copy a))) (defmethod minv! ((a matrix-blas-zge)) - (let* ((N (rows a)) - (ipiv (make-array N :element-type '(unsigned-byte 32))) - (msg "argument A given to mdiv is singular to working machine precision")) - (multiple-value-bind (_ ipiv info) - (f77::zgetrf N N (matrix-store a) N ipiv 0) - (declare (ignore _)) - (unless (zerop info) - (error msg )) - (let ((work (make-array (* 2 N) :element-type 'double-float))) - (multiple-value-bind (_ __ info) - (f77::zgetri N (matrix-store a) N ipiv work N 0) - (declare (ignore _ __)) - (unless (zerop info) - (error msg)) - a))))) + (if cl-user::*lisplab-liblapack-path* + (let* ((N (rows a)) + (ipiv (make-array N :element-type '(unsigned-byte 32))) + (msg "argument A given to mdiv is singular to working machine precision")) + (multiple-value-bind (_ ipiv info) + (f77::zgetrf N N (matrix-store a) N ipiv 0) + (declare (ignore _)) + (unless (zerop info) + (error msg )) + (let ((work (make-array (* 2 N) :element-type 'double-float))) + (multiple-value-bind (_ __ info) + (f77::zgetri N (matrix-store a) N ipiv work N 0) + (declare (ignore _ __)) + (unless (zerop info) + (error msg)) + a)))) + ;; Othervise, call native lisp implementation + (call-next-method))) (defmethod minv ((a matrix-blas-zge)) (minv! (copy a))) Modified: src/matlisp/mul.lisp ============================================================================== --- src/matlisp/mul.lisp (original) +++ src/matlisp/mul.lisp Sun Aug 16 05:46:41 2009 @@ -20,17 +20,23 @@ (in-package :lisplab) (defmethod m* ((a matrix-blas-dge) (b matrix-blas-dge)) - (let* ((m (rows a)) - (n (cols b)) - (k (cols a)) - (c (mcreate a 0 (list m n)))) - (f77::dgemm "N" "N" m n k 1.0 (matrix-store a) m (matrix-store b) k 0.0 (matrix-store c) m) - c)) + (if cl-user::*lisplab-liblapack-path* + (let* ((m (rows a)) + (n (cols b)) + (k (cols a)) + (c (mcreate a 0 (list m n)))) + (f77::dgemm "N" "N" m n k 1.0 + (matrix-store a) m (matrix-store b) k 0.0 (matrix-store c) m) + c) + (call-next-method))) (defmethod m* ((a matrix-blas-zge) (b matrix-blas-zge)) - (let* ((m (rows a)) - (n (cols b)) - (k (cols a)) - (c (mcreate a 0 (list m n)))) - (f77::zgemm "N" "N" m n k #C(1.0 0.0) (matrix-store a) m (matrix-store b) k #C(0.0 0.0) (matrix-store c) m) - c)) + (if cl-user::*lisplab-liblapack-path* + (let* ((m (rows a)) + (n (cols b)) + (k (cols a)) + (c (mcreate a 0 (list m n)))) + (f77::zgemm "N" "N" m n k #C(1.0 0.0) + (matrix-store a) m (matrix-store b) k #C(0.0 0.0) (matrix-store c) m) + c) + (call-next-method))) Modified: start.lisp ============================================================================== --- start.lisp (original) +++ start.lisp Sun Aug 16 05:46:41 2009 @@ -1,30 +1,17 @@ -;; Loads lisplab. Hack this file to fit your setup -;; and your shared libraries. +;; Script that loads Lisplab. (in-package :cl-user) -;; TODO make this part of the package -(setf *READ-DEFAULT-FLOAT-FORMAT* 'double-float) - +;; Uncomment or move to .sbslrc ;; (defvar *lisplab-libblas-path* #P"/usr/lib/atlas/libblas.so.3.0") ;; (defvar *lisplab-liblapack-path* #P"/usr/lib/atlas/liblapack.so.3.0") ;; (defvar *lisplab-libfftw-path* #P"/usr/lib/libfftw3.so.3") -(defun load-lisplab () - (asdf:oos 'asdf:load-op 'lisplab) - (let ((asdf:*compile-file-failure-behaviour* :ignore)) + +(require :lisplab) +(let ((asdf:*compile-file-failure-behaviour* :ignore)) ;; There seems to bee some compilation trouble in SBCL ;; due to type interference. Should be fixed, not just skipped. - (asdf:oos 'asdf:load-op 'slatec)) - - ;; The system lisplab-matlisp depends on libblas.so and liblapack.so - ;; (asdf:oos 'asdf:load-op 'lisplab-matlisp) - - ;; The system lisplab-fftw depends on libfftw.so - ;; (asdf:oos 'asdf:load-op 'lisplab-fftw) - ) + (require :slatec)) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(load-lisplab) -(format t "Lisplab is loaded~%") -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; \ No newline at end of file +(format t "Lisplab is loaded.~%") From jivestgarden at common-lisp.net Mon Aug 17 19:21:52 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Mon, 17 Aug 2009 15:21:52 -0400 Subject: [lisplab-cvs] r85 - src/core src/matrix src/test Message-ID: Author: jivestgarden Date: Mon Aug 17 15:21:51 2009 New Revision: 85 Log: testing and fixing Added: src/test/test-methods.lisp Modified: lisplab.asd package.lisp src/core/level0-functions.lisp src/core/level0-interface.lisp src/matrix/level2-matrix-dge.lisp Modified: lisplab.asd ============================================================================== --- lisplab.asd (original) +++ lisplab.asd Mon Aug 17 15:21:51 2009 @@ -243,14 +243,12 @@ :depends-on (:lisplab-base) :components ( - - ;; - ;; Slatec in lisplab - ;; (:module :src/specfunc :depends-on (:shared/slatec) :components ((:file "level0-specfunc"))) - + ;; + ;; Slatec in lisplab + ;; (:module :shared/slatec :components ( Modified: package.lisp ============================================================================== --- package.lisp (original) +++ package.lisp Mon Aug 17 15:21:51 2009 @@ -204,10 +204,14 @@ "EIGENVECTORS" ;; FFT - "ffT1" + "FFT1" "IFFT1" "FFT2" "IFFT2" "FFT-SHIFT" "IFFT-SHIFT" )) + +(defpackage "LISPLAB-USER" + (:use "COMMON-LISP" "LISPLAB" "SB-EXT") + (:nicknames "LL-USER")) \ No newline at end of file Modified: src/core/level0-functions.lisp ============================================================================== --- src/core/level0-functions.lisp (original) +++ src/core/level0-functions.lisp Mon Aug 17 15:21:51 2009 @@ -116,7 +116,7 @@ `(progn (defmethod ,(car name) ((a number)) (,(cdr name) a)))) - +functions-real-to-real+))) + +ordinary-functions-number-to-number+ ))) (expand-num-num) @@ -125,16 +125,8 @@ (log x base) (log x))) -(defmethod .log ((x real) &optional (base nil)) - (if base - (log (to-df x) base) - (log (to-df x)))) - (defmethod .sqr ((x number)) (* x x)) -(defmethod .sqr ((x float)) - (let ((x (to-df x))) - (* x x))) Modified: src/core/level0-interface.lisp ============================================================================== --- src/core/level0-interface.lisp (original) +++ src/core/level0-interface.lisp Mon Aug 17 15:21:51 2009 @@ -22,9 +22,11 @@ (define-constant +functions-real-to-real+ '((.sin . sin) (.cos . cos) (.tan . tan) - (.asin . asin) (.acos . acos) (.atan . atan) + ;; (.asin . asin) (.acos . acos) + (.atan . atan) (.sinh . sinh) (.cosh . cosh) (.tanh . tanh) - (.asinh . asinh) (.acosh . acosh) (.atanh . atanh) + (.asinh . asinh) (.acosh . acosh) + ;; (.atanh . atanh) (.exp . exp) (.sqr . .sqr) (.sqrt . sqrt) (.conj . conjugate) (.realpart . realpart) (.imagpart . imagpart) (.abs . abs) (.erf . .erf) (.erfc . .erfc) @@ -32,17 +34,29 @@ "Functions of one argument that map real to real.") ;; Other functions: log, .besj, .besy, .besi, .besk, .besh1, .besh2, .ai +;;; yes, and: asin, acos, atanh (define-constant +functions-complex-to-complex+ '((.sin . sin) (.cos . cos) (.tan . tan) (.asin . asin) (.acos . acos) (.atan . atan) (.sinh . sinh) (.cosh . cosh) (.tanh . tanh) (.asinh . asinh) (.acosh . acosh) (.atanh . atanh) - (.exp . exp) (.sqrt . sqrt) (.conj . conjugate) + (.realpart . realpart) (.imagpart . imagpart) (.abs . abs) + (.exp . exp) (.sqr . .sqr) (.sqrt . sqrt) (.conj . conjugate) (.erf . .erf) (.erfc . .erfc) (.gamma . .gamma)) "Functions of one argument that maps complex to complex.") +(define-constant +ordinary-functions-number-to-number+ + '((.sin . sin) (.cos . cos) (.tan . tan) + (.asin . asin) (.acos . acos) (.atan . atan) + (.sinh . sinh) (.cosh . cosh) (.tanh . tanh) + (.asinh . asinh) (.acosh . acosh) (.atanh . atanh) + (.exp . exp) (.sqrt . sqrt) (.conj . conjugate)) + "Functions with a twin in the Common Lisp package.") + + + (defgeneric scalar? (x) (:documentation "A scalar is a object with ignored internal structure.")) Modified: src/matrix/level2-matrix-dge.lisp ============================================================================== --- src/matrix/level2-matrix-dge.lisp (original) +++ src/matrix/level2-matrix-dge.lisp Mon Aug 17 15:21:51 2009 @@ -175,6 +175,15 @@ (setf (vref ,b ,i) ,form))) ,b))) +(defmethod .asin ((x matrix-base-dge)) + (each-matrix-element-df-to-complex-df x (asin x))) + +(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))) Added: src/test/test-methods.lisp ============================================================================== --- (empty file) +++ src/test/test-methods.lisp Mon Aug 17 15:21:51 2009 @@ -0,0 +1,118 @@ +;; Simple test routines. Just calls the methods and +;; prints if there are errors or conditions. +;; The purpose of just to look for obvious flaws. +;; Just run an instpect the output. +;; +;; (Ideally the output should be zero, but it isn't) + +(in-package :lisplab-user) + +(defun simple-non-nil-check (fun args) + (multiple-value-bind (ok err) + (ignore-errors + (apply fun args)) + (if ok + (format t "~&OK : (~a ~s) ~%" fun (mapcar #'type-of args)) + (progn + (format t "~&FAILED: (~a ~s) ~%" fun (mapcar #'type-of args)) + (format t "~& - ~s~%" err))) + ok)) + +(defun test-level0-methods () + (let* ((a 1) + (b 1.0) + (c %i) + (x (dmat (1 2) (3 4))) + (y (zmat (1 2) (3 4))) + (w (mat 'matrix-ge (1 2) (3 4))) + (args (list a b c x y w))) + (mapc (lambda (fun) + (mapc (lambda (x) + (simple-non-nil-check fun (list x))) + args)) + ;; The following list is hard coded to make + ;; the test independent of Lisplab. + '(.sin .cos .tan + .asin .acos .atan + .sinh .cosh .tanh + .asinh .acosh .atanh + .exp .sqr .sqrt .conj + .realpart .imagpart .abs + .erf .erfc + .gamma )) + (mapc (lambda (x) (simple-non-nil-check '.besj (list 1 x))) args) + (mapc (lambda (x) (simple-non-nil-check '.besy (list 1 x))) args) + (mapc (lambda (x) (simple-non-nil-check '.besi (list 1 x))) args) + (mapc (lambda (x) (simple-non-nil-check '.besk (list 1 x))) args) + (mapc (lambda (x) (simple-non-nil-check '.besh1 (list 1 x))) args) + (mapc (lambda (x) (simple-non-nil-check '.besh2 (list 1 x))) args) + + (mapc (lambda (x) (simple-non-nil-check '.besj (list 5 x))) args) + (mapc (lambda (x) (simple-non-nil-check '.besy (list 5 x))) args) + (mapc (lambda (x) (simple-non-nil-check '.besi (list 5 x))) args) + (mapc (lambda (x) (simple-non-nil-check '.besk (list 5 x))) args) + (mapc (lambda (x) (simple-non-nil-check '.besh1 (list 5 x))) args) + (mapc (lambda (x) (simple-non-nil-check '.besh2 (list 5 x))) args) + + (mapc (lambda (x) (simple-non-nil-check '.besj (list 7.1 x))) args) + (mapc (lambda (x) (simple-non-nil-check '.besy (list 7.1 x))) args) + (mapc (lambda (x) (simple-non-nil-check '.besi (list 7.1 x))) args) + (mapc (lambda (x) (simple-non-nil-check '.besk (list 7.1 x))) args) + (mapc (lambda (x) (simple-non-nil-check '.besh1 (list 7.1 x))) args) + (mapc (lambda (x) (simple-non-nil-check '.besh2 (list 7.1 x))) args) + 'done)) + + +(defun test-level3-fft () + (let ((a (dmat (1 2) (3 4))) + (b (zmat (1 2) (3 5))) + (c (dmat (1 2 -1) (3 4 9) (1 1 1))) + (d (zmat (1 2 2.1) (3 5 %i) (-%i -%i -%i)))) + (simple-non-nil-check #'fft1 (list a)) + (simple-non-nil-check #'fft1 (list b)) + (simple-non-nil-check #'fft2 (list a)) + (simple-non-nil-check #'fft2 (list b)) + (simple-non-nil-check #'fft1 (list c)) + (simple-non-nil-check #'fft1 (list d)) + (simple-non-nil-check #'fft2 (list c)) + (simple-non-nil-check #'fft2 (list d)) + (simple-non-nil-check #'ifft1 (list a)) + (simple-non-nil-check #'ifft1 (list b)) + (simple-non-nil-check #'ifft2 (list a)) + (simple-non-nil-check #'ifft2 (list b)) + (simple-non-nil-check #'ifft1 (list c)) + (simple-non-nil-check #'ifft1 (list d)) + (simple-non-nil-check #'ifft2 (list c)) + (simple-non-nil-check #'ifft2 (list d)) + (simple-non-nil-check #'fft-shift (list a)) + (simple-non-nil-check #'fft-shift (list b)) + (simple-non-nil-check #'fft-shift (list c)) + (simple-non-nil-check #'fft-shift (list d)) + (simple-non-nil-check #'ifft-shift (list a)) + (simple-non-nil-check #'ifft-shift (list b)) + (simple-non-nil-check #'ifft-shift (list c)) + (simple-non-nil-check #'ifft-shift (list d)) + 'done)) + +(defun test-level3-linalg () + (let* ((a (dmat (1 2) (3 4))) + (b (zmat (1 2) (3 5))) + (c (dmat (1 2 -1) (3 4 9) (1 1 1))) + (d (zmat (1 2 2.1) (3 5 %i) (-%i %i -%i))) + (x (mat 'matrix-ge (1 2 2.1) (3 5 %i) (-%i %i -%i))) + (args (list a b c d x))) + (mapc (lambda (x) (simple-non-nil-check #'mtp (list x))) args) + (mapc (lambda (x) (simple-non-nil-check #'mct (list x))) args) + (mapc (lambda (x) (simple-non-nil-check #'minv (list x))) args) + (mapc (lambda (x) (simple-non-nil-check #'mdet (list x))) args) + (mapc (lambda (x) (simple-non-nil-check #'mtr (list x))) args) + (mapc (lambda (x) (simple-non-nil-check #'LU-factor (list x))) args) + (mapc (lambda (x) (simple-non-nil-check #'m* (list x x))) args) + (mapc (lambda (x) (simple-non-nil-check #'m/ (list x x))) args) + ) + 'done) + +(defun test-all () + (test-level0-methods) + (test-level3-fft) + (test-level3-linalg)) \ No newline at end of file From jivestgarden at common-lisp.net Tue Aug 18 13:21:23 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Tue, 18 Aug 2009 09:21:23 -0400 Subject: [lisplab-cvs] r86 - src/core Message-ID: Author: jivestgarden Date: Tue Aug 18 09:21:22 2009 New Revision: 86 Log: bugfix Modified: package.lisp src/core/level0-interface.lisp Modified: package.lisp ============================================================================== --- package.lisp (original) +++ package.lisp Tue Aug 18 09:21:22 2009 @@ -46,6 +46,10 @@ Lisplab provides high level interfaces to BLAS, LAPACK and FFTW.") (:export + ;; Utilities + "IN-DIR" + "STRCAT" + ;; Numerical constants "%I" "%E" Modified: src/core/level0-interface.lisp ============================================================================== --- src/core/level0-interface.lisp (original) +++ src/core/level0-interface.lisp Tue Aug 18 09:21:22 2009 @@ -41,7 +41,6 @@ (.asin . asin) (.acos . acos) (.atan . atan) (.sinh . sinh) (.cosh . cosh) (.tanh . tanh) (.asinh . asinh) (.acosh . acosh) (.atanh . atanh) - (.realpart . realpart) (.imagpart . imagpart) (.abs . abs) (.exp . exp) (.sqr . .sqr) (.sqrt . sqrt) (.conj . conjugate) (.erf . .erf) (.erfc . .erfc) (.gamma . .gamma)) @@ -52,6 +51,7 @@ (.asin . asin) (.acos . acos) (.atan . atan) (.sinh . sinh) (.cosh . cosh) (.tanh . tanh) (.asinh . asinh) (.acosh . acosh) (.atanh . atanh) + (.realpart . realpart) (.imagpart . imagpart) (.abs . abs) (.exp . exp) (.sqrt . sqrt) (.conj . conjugate)) "Functions with a twin in the Common Lisp package.") From jivestgarden at common-lisp.net Tue Aug 25 19:34:30 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Tue, 25 Aug 2009 15:34:30 -0400 Subject: [lisplab-cvs] r87 - src/fft Message-ID: Author: jivestgarden Date: Tue Aug 25 15:34:30 2009 New Revision: 87 Log: prepeared for threads in fftw Modified: lisplab.asd src/fft/fftw-ffi.lisp src/fft/level3-fft-fftw.lisp src/fft/level3-fft-generic.lisp src/fft/level3-fft-interface.lisp src/fft/level3-fft-zge.lisp Modified: lisplab.asd ============================================================================== --- lisplab.asd (original) +++ lisplab.asd Tue Aug 25 15:34:30 2009 @@ -4,7 +4,8 @@ (defvar *lisplab-libblas-path* nil "Path to BLAS shared object file.") (defvar *lisplab-liblapack-path* nil "Path to LAPACK shared object file.") -(defvar *lisplab-libfftw-path* nil "Path to FFTW shared object file.") +(defvar *lisplab-libfftw-path* nil "Path to FFTW 3 shared object file.") +(defvar *lisplab-libfftw-threads-path* nil "Path to FFTW 3 thread extension shared object file.") (defpackage :asdf-lisplab (:use :asdf :cl)) (in-package :asdf-lisplab) @@ -170,11 +171,16 @@ (:module :fftw-libs :perform (asdf:load-op :after (op c) (load-lisplab-lib - cl-user::*lisplab-libfftw-path*)) + cl-user::*lisplab-libfftw-path*) + (load-lisplab-lib + cl-user::*lisplab-libfftw-threads-path*)) :explain (asdf:load-op :after (op c) (explain-lisplab-lib - "FFTW" - cl-user::*lisplab-libfftw-path*))) + "FFTW" + cl-user::*lisplab-libfftw-path*) + (explain-lisplab-lib + "FFTW threads" + cl-user::*lisplab-libfftw-threads-path*))) (:file "fftw-ffi") (:file "level3-fft-fftw"))))) Modified: src/fft/fftw-ffi.lisp ============================================================================== --- src/fft/fftw-ffi.lisp (original) +++ src/fft/fftw-ffi.lisp Tue Aug 25 15:34:30 2009 @@ -1,4 +1,4 @@ -;;; Foreign function interfaces for FFTW +;;; Foreign function interfaces for FFTW version 3. ;;; Copyright (C) 2009 Joern Inge Vestgaarden ;;; @@ -16,6 +16,9 @@ ;;; with this program; if not, write to the Free Software Foundation, Inc., ;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +;;; TODO: the calls should be wrapped in unwind protect +;;; to avoid memory leaks + (in-package :fftw-ffi) (defconstant +double-float-bytes+ (truncate (sb-alien:ALIEN-SIZE sb-alien:double-float) 8)) @@ -60,7 +63,7 @@ ;; TODO we should handle conditions to avoid mem-leaks (let ((astart (* astart +double-float-bytes+)) (bstart (* bstart +double-float-bytes+))) - (without-gcing + (with-pinned-objects (a b) (let ((plan (|fftw_plan_dft_1d| n (sap+ (vector-sap a) astart) @@ -74,7 +77,7 @@ (defun fftw-fft2 (m n in out direction flag) "Two dimensional fft by forign call to fftw." ;; TODO we should handle conditions to avoid mem-leaks - (without-gcing + (with-pinned-objects (in out) (let ((plan (|fftw_plan_dft_2d| n ; swap n and m due to row major order m @@ -87,3 +90,19 @@ out) +;;;; Now multi-thread code + +(declaim (inline |fftw_init_threads|)) +(define-alien-routine |fftw_init_threads| + int) + +(declaim (inline |fftw_plan_with_nthreads|)) +(define-alien-routine |fftw_plan_with_nthreads| + void + (nthreads int)) + +(declaim (inline |fftw_cleanup_threads|)) +(define-alien-routine |fftw_cleanup_threads| + void) + + Modified: src/fft/level3-fft-fftw.lisp ============================================================================== --- src/fft/level3-fft-fftw.lisp (original) +++ src/fft/level3-fft-fftw.lisp Tue Aug 25 15:34:30 2009 @@ -37,17 +37,17 @@ fftw-ffi:+FFTW-ESTIMATE+))) x) -(defmethod fft1! ((x matrix-blas-zge)) +(defmethod fft1! ((x matrix-blas-zge) &key) (if cl-user::*lisplab-libfftw-path* (fft1!-forward-or-backward x fftw-ffi:+fftw-forward+) (call-next-method))) -(defmethod ifft1! ((x matrix-blas-zge)) +(defmethod ifft1! ((x matrix-blas-zge) &key) (if cl-user::*lisplab-libfftw-path* (fft1!-forward-or-backward x fftw-ffi:+fftw-backward+) (call-next-method))) -(defmethod fft2! ((x matrix-blas-zge)) +(defmethod fft2! ((x matrix-blas-zge) &key) (if cl-user::*lisplab-libfftw-path* (progn (fftw-ffi:fftw-fft2 @@ -60,7 +60,7 @@ x) (call-next-method))) -(defmethod ifft2! ((x matrix-blas-zge)) +(defmethod ifft2! ((x matrix-blas-zge) &key) (if cl-user::*lisplab-libfftw-path* (progn (fftw-ffi:fftw-fft2 Modified: src/fft/level3-fft-generic.lisp ============================================================================== --- src/fft/level3-fft-generic.lisp (original) +++ src/fft/level3-fft-generic.lisp Tue Aug 25 15:34:30 2009 @@ -28,28 +28,28 @@ ;;;; Real matrices -(defmethod fft1 ((x matrix-base-dge)) +(defmethod fft1 ((x matrix-base-dge) &key) (fft1! (convert-to-matrix-zge x))) -(defmethod ifft1 ((x matrix-base-dge)) +(defmethod ifft1 ((x matrix-base-dge) &key) (ifft1! (convert-to-matrix-zge x))) -(defmethod ifft2 ((x matrix-base-dge)) +(defmethod ifft2 ((x matrix-base-dge) &key) (ifft2! (convert-to-matrix-zge x))) -(defmethod fft2 ((x matrix-base-dge)) +(defmethod fft2 ((x matrix-base-dge) &key) (fft2! (convert-to-matrix-zge x))) ;;; Complex matrices -(defmethod fft1 ((x matrix-base-zge)) +(defmethod fft1 ((x matrix-base-zge) &key) (fft1! (copy x))) -(defmethod ifft1 ((x matrix-base-zge)) +(defmethod ifft1 ((x matrix-base-zge) &key) (ifft1! (copy x))) -(defmethod ifft2 ((x matrix-base-zge)) +(defmethod ifft2 ((x matrix-base-zge) &key) (ifft2! (copy x))) -(defmethod fft2 ((x matrix-base-zge)) +(defmethod fft2 ((x matrix-base-zge) &key) (fft2! (copy x))) Modified: src/fft/level3-fft-interface.lisp ============================================================================== --- src/fft/level3-fft-interface.lisp (original) +++ src/fft/level3-fft-interface.lisp Tue Aug 25 15:34:30 2009 @@ -21,28 +21,28 @@ ;;;; Fourier stuff -(defgeneric fft1 (x) +(defgeneric fft1 (x &key) (:documentation "Forward fast fourier transform on all columns")) -(defgeneric fft1! (x) +(defgeneric fft1! (x &key) (:documentation "Forward fast fourier transform on all columns. Destructive")) -(defgeneric ifft1 (x) +(defgeneric ifft1 (x &key) (:documentation "Inverse fast fourier transform on all columns")) -(defgeneric ifft1! (x) +(defgeneric ifft1! (x &key) (:documentation "Inverse fast fourier transform on all columns. Destructive")) -(defgeneric fft2 (x) +(defgeneric fft2 (x &key) (:documentation "Forward fast fourier transform on all rows and columns")) -(defgeneric fft2! (x) +(defgeneric fft2! (x &key) (:documentation "Forward fast fourier transform on all rows and columns. Destructive")) -(defgeneric ifft2 (x) +(defgeneric ifft2 (x &key) (:documentation "Inverse fast fourier transform on all rows and columns")) -(defgeneric ifft2! (x) +(defgeneric ifft2! (x &key) (:documentation "Inverse fast fourier transform on all rows and columns. Destructive")) (defgeneric fft-shift (x) Modified: src/fft/level3-fft-zge.lisp ============================================================================== --- src/fft/level3-fft-zge.lisp (original) +++ src/fft/level3-fft-zge.lisp Tue Aug 25 15:34:30 2009 @@ -23,24 +23,23 @@ - ;;;; The implementing methods -(defmethod fft1! ((x matrix-lisp-zge)) +(defmethod fft1! ((x matrix-lisp-zge) &key) (assert (= 1 (logcount (rows x)))) (dotimes (i (cols x)) (fft-radix-2-blas-complex-store! :f (matrix-store x) (rows x) (* (rows x) i) 1)) x) -(defmethod ifft1! ((x matrix-lisp-zge)) +(defmethod ifft1! ((x matrix-lisp-zge) &key) (assert (= 1 (logcount (rows x)))) (dotimes (i (cols x)) (fft-radix-2-blas-complex-store! :r (matrix-store x) (rows x) (* (rows x) i) 1)) x) -(defmethod fft2! ((x matrix-lisp-zge)) +(defmethod fft2! ((x matrix-lisp-zge) &key) (assert (and (= 1 (logcount (rows x))) (= 1 (logcount (cols x))))) (fft1! x) @@ -48,7 +47,7 @@ (fft-radix-2-blas-complex-store! :f (matrix-store x) (cols x) i (rows x))) x) -(defmethod ifft2! ((x matrix-lisp-zge)) +(defmethod ifft2! ((x matrix-lisp-zge) &key) (assert (and (= 1 (logcount (rows x))) (= 1 (logcount (cols x))))) From jivestgarden at common-lisp.net Thu Aug 27 13:17:04 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Thu, 27 Aug 2009 09:17:04 -0400 Subject: [lisplab-cvs] r88 - src/core src/fft Message-ID: Author: jivestgarden Date: Thu Aug 27 09:17:04 2009 New Revision: 88 Log: paralell fftw Modified: Makefile lisplab.asd package.lisp src/core/level0-basic.lisp src/core/level0-interface.lisp src/fft/fftw-ffi-package.lisp src/fft/fftw-ffi.lisp src/fft/level3-fft-fftw.lisp Modified: Makefile ============================================================================== --- Makefile (original) +++ Makefile Thu Aug 27 09:17:04 2009 @@ -11,9 +11,9 @@ touch system/lisplab.asd lispclean: - -find . -name "*.fasl" -execdir rm \{} \; + -find . -name "*.fasl" -exec rm \{} \; clean: lispclean distclean: clean - -find . -name "*~" -execdir rm \{} \; \ No newline at end of file + -find . -name "*~" -exec rm \{} \; \ No newline at end of file Modified: lisplab.asd ============================================================================== --- lisplab.asd (original) +++ lisplab.asd Thu Aug 27 09:17:04 2009 @@ -17,6 +17,9 @@ (defun explain-lisplab-lib (name path) (format t "Loads ~A. Path ~a" name path)) +(declaim (inline |fftw_init_threads|)) +(sb-alien:define-alien-routine |fftw_init_threads| + sb-alien:int) (defsystem :lisplab ;; Default system, without all libs @@ -173,7 +176,9 @@ (load-lisplab-lib cl-user::*lisplab-libfftw-path*) (load-lisplab-lib - cl-user::*lisplab-libfftw-threads-path*)) + cl-user::*lisplab-libfftw-threads-path*) + (when cl-user::*lisplab-libfftw-threads-path* + (assert (/= 0 (|fftw_init_threads|))))) :explain (asdf:load-op :after (op c) (explain-lisplab-lib "FFTW" Modified: package.lisp ============================================================================== --- package.lisp (original) +++ package.lisp Thu Aug 27 09:17:04 2009 @@ -49,6 +49,8 @@ ;; Utilities "IN-DIR" "STRCAT" + "INIT-THREADS" + "CLEANUP-THREADS" ;; Numerical constants "%I" Modified: src/core/level0-basic.lisp ============================================================================== --- src/core/level0-basic.lisp (original) +++ src/core/level0-basic.lisp Thu Aug 27 09:17:04 2009 @@ -73,4 +73,16 @@ (defun dvec (n) "Creates a double vector with n elements." - (make-array n :element-type 'double-float :initial-element 0.0)) \ No newline at end of file + (make-array n :element-type 'double-float :initial-element 0.0)) + + +;;; THREADS stuff. TODO: move away from here + +(defvar *lisplab-num-threads* 0) + +(defmethod init-threads (num-threads) + (cleanup-threads) + (setf *lisplab-num-threads* num-threads)) + +(defmethod cleanup-threads ()) + Modified: src/core/level0-interface.lisp ============================================================================== --- src/core/level0-interface.lisp (original) +++ src/core/level0-interface.lisp Thu Aug 27 09:17:04 2009 @@ -55,7 +55,11 @@ (.exp . exp) (.sqrt . sqrt) (.conj . conjugate)) "Functions with a twin in the Common Lisp package.") +(defgeneric init-threads (num-threads) + (:documentation "Request to use a certain number of threads for calculations.")) +(defgeneric cleanup-threads () + (:documentation "Kills unused threads and frees resources.")) (defgeneric scalar? (x) (:documentation "A scalar is a object with ignored internal structure.")) Modified: src/fft/fftw-ffi-package.lisp ============================================================================== --- src/fft/fftw-ffi-package.lisp (original) +++ src/fft/fftw-ffi-package.lisp Thu Aug 27 09:17:04 2009 @@ -21,5 +21,7 @@ "+FFTW-FORWARD+" "+FFTW-BACKWARD+" "FFTW-FFT1" - "FFTW-FFT2") + "FFTW-FFT2" + "FFTW-INIT-THREADS" + "FFTW-CLEANUP-THREADS") (:documentation "Simple ffi for fftw.")) Modified: src/fft/fftw-ffi.lisp ============================================================================== --- src/fft/fftw-ffi.lisp (original) +++ src/fft/fftw-ffi.lisp Thu Aug 27 09:17:04 2009 @@ -77,7 +77,7 @@ (defun fftw-fft2 (m n in out direction flag) "Two dimensional fft by forign call to fftw." ;; TODO we should handle conditions to avoid mem-leaks - (with-pinned-objects (in out) + (with-pinned-objects (in out m n direction flag) (let ((plan (|fftw_plan_dft_2d| n ; swap n and m due to row major order m @@ -105,4 +105,10 @@ (define-alien-routine |fftw_cleanup_threads| void) +(defun fftw-init-threads (num-threads) + ;; Note: assumes that |fftw_init_threads| has been called! + (|fftw_plan_with_nthreads| num-threads)) + +(defun fftw-cleanup-threads () + (|fftw_cleanup_threads|)) Modified: src/fft/level3-fft-fftw.lisp ============================================================================== --- src/fft/level3-fft-fftw.lisp (original) +++ src/fft/level3-fft-fftw.lisp Thu Aug 27 09:17:04 2009 @@ -22,6 +22,101 @@ (in-package :lisplab) +(defmethod fft1 ((x matrix-blas-dge) &key) + (fft1 (convert-to-matrix-zge x))) + +(defmethod ifft1 ((x matrix-blas-dge) &key) + (ifft1 (convert-to-matrix-zge x))) + +(defmethod fft2 ((x matrix-blas-dge) &key) + (fft2 (convert-to-matrix-zge x))) + +(defmethod ifft2 ((x matrix-blas-dge) &key) + (ifft2 (convert-to-matrix-zge x))) + +(defun use-fftw-p () + cl-user::*lisplab-libfftw-path*) + +(defun fftw-use-threads-p () + (and cl-user::*lisplab-libfftw-threads-path* + (> *lisplab-num-threads* 0))) + +(defmethod init-threads :after (num-threads) + (when (fftw-use-threads-p) + (fftw-ffi:fftw-init-threads num-threads))) + +(defmethod cleanup-threads :after () + (when (fftw-use-threads-p) + (fftw-ffi:fftw-cleanup-threads))) + +(defmethod fft1 ((x matrix-blas-zge) &key) + (if (not (use-fftw-p)) + (call-next-method) + (let* ((rows (rows x)) + (cols (cols x)) + (store-x (matrix-store x)) + (y (mcreate x)) + (store-y (matrix-store y))) + (dotimes (i cols) + ;; Could be made in parallel + (fftw-ffi:fftw-fft1 + rows + store-x + (* i cols) + store-y + (* i cols) + fftw-ffi:+FFTW-FORWARD+ + fftw-ffi:+FFTW-ESTIMATE+)) + y))) + +(defmethod ifft1 ((x matrix-blas-zge) &key) + (if (not (use-fftw-p)) + (call-next-method) + (let* ((rows (rows x)) + (cols (cols x)) + (store-x (matrix-store x)) + (y (mcreate x)) + (store-y (matrix-store y))) + (dotimes (i cols) + ;; Could be made in parallel + (fftw-ffi:fftw-fft1 + rows + store-x + (* i cols) + store-y + (* i cols) + fftw-ffi:+FFTW-BACKWARD+ + fftw-ffi:+FFTW-ESTIMATE+)) + y))) + +(defmethod fft2 ((x matrix-blas-zge) &key) + (if (not (use-fftw-p)) + (call-next-method) + (let ((y (mcreate x))) + (fftw-ffi:fftw-fft2 + (rows x) + (cols x) + (matrix-store x) + (matrix-store y) + fftw-ffi:+fftw-forward+ + fftw-ffi:+FFTW-ESTIMATE+) + y))) + +(defmethod ifft2 ((x matrix-blas-zge) &key) + (if (not (use-fftw-p)) + (call-next-method) + (let ((y (mcreate x))) + (fftw-ffi:fftw-fft2 + (rows x) + (cols x) + (matrix-store x) + (matrix-store y) + fftw-ffi:+fftw-backward+ + fftw-ffi:+FFTW-ESTIMATE+) + y))) + +;;; TODO: remove the destructive mothods below. They only mess things up + (defun fft1!-forward-or-backward (x direction) (let* ((rows (rows x)) (cols (cols x)) From jivestgarden at common-lisp.net Fri Aug 28 19:04:23 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Fri, 28 Aug 2009 15:04:23 -0400 Subject: [lisplab-cvs] r89 - src/matrix Message-ID: Author: jivestgarden Date: Fri Aug 28 15:04:22 2009 New Revision: 89 Log: efficency of allocation Modified: src/matrix/level1-classes.lisp src/matrix/level1-util.lisp Modified: src/matrix/level1-classes.lisp ============================================================================== --- src/matrix/level1-classes.lisp (original) +++ src/matrix/level1-classes.lisp Fri Aug 28 15:04:22 2009 @@ -107,7 +107,7 @@ :initarg :store :initform nil :reader matrix-store - :type (array t (*)))) + :type (simple-array t (*)))) (:documentation "A full matrix (rows x cols) with unspecified matrix element types.")) (defmethod initialize-instance :after ((m matrix-ge) &key (value 0)) Modified: src/matrix/level1-util.lisp ============================================================================== --- src/matrix/level1-util.lisp (original) +++ src/matrix/level1-util.lisp Fri Aug 28 15:04:22 2009 @@ -20,18 +20,6 @@ (in-package :lisplab) -(defun fill-matrix-with-list (m x) - (let* ((rows (rows m)) - (cols (cols m))) - (do ((xx x (cdr xx)) - (i 0 (1+ i))) - ((= i rows)) - (do ((yy (car xx) (cdr yy)) - (j 0 (1+ j))) - ((= j cols)) - (setf (mref m i j) (car yy)))) - m)) - (deftype type-blas-store () '(simple-array double-float (*))) @@ -84,6 +72,18 @@ (complex double-float)) (setf ref-blas-complex-store))) +(defun fill-matrix-with-list (m x) + (let* ((rows (rows m)) + (cols (cols m))) + (do ((xx x (cdr xx)) + (i 0 (1+ i))) + ((= i rows)) + (do ((yy (car xx) (cdr yy)) + (j 0 (1+ j))) + ((= j cols)) + (setf (mref m i j) (car yy)))) + m)) + (defun column-major-idx (i j rows) (truly-the type-blas-idx (+ i (truly-the type-blas-idx (* j rows))))) @@ -95,19 +95,30 @@ (truly-the type-blas-idx col) rows)))) + (defun (setf ref-blas-real-store) (value store row col rows) (setf (aref (truly-the type-blas-store store) (truly-the type-blas-idx (column-major-idx (truly-the type-blas-idx row) (truly-the type-blas-idx col) rows))) - value)) + value) + value) (defun allocate-real-store (size &optional (initial-element 0.0)) - (make-array size :element-type 'double-float - :initial-element - (coerce initial-element 'double-float))) - + (let ((x (coerce initial-element 'double-float))) + (declare (type double-float x) + (type type-blas-idx size)) + ;; Stupid efficiency hack, on SBCL. All matrix double and complex double + ;; should call this one + (if (= x 0.0) + (make-array size + :element-type 'double-float + :initial-element 0.0) + (make-array size + :element-type 'double-float + :initial-element x)))) + (defun ref-blas-complex-store (store row col rows) "Accessor for the complet blas store" (let ((idx (truly-the type-blas-idx @@ -133,8 +144,10 @@ (rv (coerce (realpart value) 'double-float)) (iv (coerce (imagpart value) 'double-float)) (store (allocate-real-store 2size iv))) - (declare (type type-blas-idx 2size)) - (loop for i from 0 below 2size by 2 do - (setf (aref store i) rv)) + (declare (type type-blas-idx 2size) + (type double-float rv iv)) + (when (/= rv iv) + (loop for i from 0 below 2size by 2 do + (setf (aref store i) rv))) store)) From jivestgarden at common-lisp.net Fri Aug 28 19:18:29 2009 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Fri, 28 Aug 2009 15:18:29 -0400 Subject: [lisplab-cvs] r90 - src/core src/fft Message-ID: Author: jivestgarden Date: Fri Aug 28 15:18:28 2009 New Revision: 90 Log: thread stuff Added: src/core/level0-thread.lisp Modified: lisplab.asd src/core/level0-basic.lisp src/fft/fftw-ffi.lisp src/fft/level3-fft-fftw.lisp Modified: lisplab.asd ============================================================================== --- lisplab.asd (original) +++ lisplab.asd Fri Aug 28 15:18:28 2009 @@ -49,6 +49,7 @@ (:file "level0-interface") (:file "level0-functions") (:file "level0-permutation") + (:file "level0-thread") (:file "level0-infpre"))) ;; Modified: src/core/level0-basic.lisp ============================================================================== --- src/core/level0-basic.lisp (original) +++ src/core/level0-basic.lisp Fri Aug 28 15:18:28 2009 @@ -76,13 +76,3 @@ (make-array n :element-type 'double-float :initial-element 0.0)) -;;; THREADS stuff. TODO: move away from here - -(defvar *lisplab-num-threads* 0) - -(defmethod init-threads (num-threads) - (cleanup-threads) - (setf *lisplab-num-threads* num-threads)) - -(defmethod cleanup-threads ()) - Added: src/core/level0-thread.lisp ============================================================================== --- (empty file) +++ src/core/level0-thread.lisp Fri Aug 28 15:18:28 2009 @@ -0,0 +1,29 @@ +;;; Lisplab, level0-thread.lisp +;;; Threads code. So far only for SBCL. + +;;; 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) + +(defvar *lisplab-num-threads* 1) + +(defmethod init-threads (num-threads) + (cleanup-threads) + (setf *lisplab-num-threads* num-threads)) + +(defmethod cleanup-threads ()) \ No newline at end of file Modified: src/fft/fftw-ffi.lisp ============================================================================== --- src/fft/fftw-ffi.lisp (original) +++ src/fft/fftw-ffi.lisp Fri Aug 28 15:18:28 2009 @@ -77,7 +77,7 @@ (defun fftw-fft2 (m n in out direction flag) "Two dimensional fft by forign call to fftw." ;; TODO we should handle conditions to avoid mem-leaks - (with-pinned-objects (in out m n direction flag) + (with-pinned-objects (in out) (let ((plan (|fftw_plan_dft_2d| n ; swap n and m due to row major order m Modified: src/fft/level3-fft-fftw.lisp ============================================================================== --- src/fft/level3-fft-fftw.lisp (original) +++ src/fft/level3-fft-fftw.lisp Fri Aug 28 15:18:28 2009 @@ -39,7 +39,7 @@ (defun fftw-use-threads-p () (and cl-user::*lisplab-libfftw-threads-path* - (> *lisplab-num-threads* 0))) + (> *lisplab-num-threads* 1))) (defmethod init-threads :after (num-threads) (when (fftw-use-threads-p)

LISPLAB

Mathematics library for Common Lisp

Lisplab

A mathematics library for Common Lisp

Introduction

Documentation

Mailing Lists

Download