From jivestgarden at common-lisp.net Sun Oct 9 12:38:47 2011 From: jivestgarden at common-lisp.net (jivestgarden at common-lisp.net) Date: Sun, 09 Oct 2011 05:38:47 -0700 Subject: [lisplab-cvs] r201 - in trunk: . src/matrix2 src/vector2 Message-ID: Author: jivestgarden Date: Sun Oct 9 05:38:46 2011 New Revision: 201 Log: Moved matrix generic function out to new interface. Added two optimizations for dge Added: trunk/src/matrix2/matrix2-dge.lisp trunk/src/matrix2/matrix2-interface.lisp Modified: trunk/lisplab.asd trunk/src/vector2/level2-interface.lisp Modified: trunk/lisplab.asd ============================================================================== --- trunk/lisplab.asd Sat Jul 2 10:55:33 2011 (r200) +++ trunk/lisplab.asd Sun Oct 9 05:38:46 2011 (r201) @@ -123,9 +123,11 @@ :depends-on (:src/core :src/vector1 :src/matrix1 :src/util) :serial t :components - ((:file "level2-constructors") + ((:file "matrix2-interface") + (:file "level2-constructors") (:file "matrix2-generic") (:file "level2-view") + (:file "matrix2-dge") )) ;; Added: trunk/src/matrix2/matrix2-dge.lisp ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ trunk/src/matrix2/matrix2-dge.lisp Sun Oct 9 05:38:46 2011 (r201) @@ -0,0 +1,60 @@ +;;; Level two optimizations for double matrices + +;;; 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) + +(defmethod circ-shift ((A matrix-base-dge) shift) + (let* ((rows (rows A)) + (cols (cols A)) + (A-store (vector-store A)) + (B (mcreate A)) + (B-store (vector-store B)) + (dr (first shift)) + (dc (second shift))) + (declare (type type-blas-store A-store B-store) + (type type-blas-idx rows cols) + (fixnum dr dc)) + (dotimes (i rows) + (dotimes (j cols) + (setf (aref B-store (column-major-idx + (mod (+ i dr) rows) + (mod (+ j dc) cols) + rows)) + (aref A-store (column-major-idx i j rows))))) + B)) + +(defmethod pad-shift ((A matrix-base-dge) shift &optional (value 0d0)) + (let* ((rows (rows A)) + (cols (cols A)) + (A-store (vector-store A)) + (B (mcreate A value)) + (B-store (vector-store B)) + (dr (first shift)) + (dc (second shift))) + (declare (type type-blas-store A-store B-store) + (type type-blas-idx rows cols) + (fixnum dr dc)) + (loop for i from (max 0 dr) below (min rows (+ rows dr)) do + (loop for j from (max 0 dc) below (min cols (+ cols dc)) do + (setf (aref B-store + (column-major-idx i j rows)) + (aref A-store + (column-major-idx (- i dr) + (- j dc) + rows))))) + B)) Added: trunk/src/matrix2/matrix2-interface.lisp ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ trunk/src/matrix2/matrix2-interface.lisp Sun Oct 9 05:38:46 2011 (r201) @@ -0,0 +1,98 @@ +;;; 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-user) + +(defgeneric sub-matrix (m rr cc) + (:documentation "Copies a sub matrix of m. The format of rr = (start stop) +or rr = (start step stop) and the same for the columns.")) + +(defgeneric mnew (class value rows &optional cols) + (:documentation "General matrix constructor. Creates a new matrix +filled with numeric arguments.")) + +(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.")) + +(defgeneric mcreate* (a &key value dim element-type structure implementation) + (:documentation "Extended version of mcreate. Creates a new matrix of the same type +and with the same value as the other, but with all elements set to value.")) + +(defgeneric diag (v) + (:documentation "Creates a diagnoal matrix from the vector.")) + +(defgeneric to-vector! (a) + (:documentation "Reshape the object to 1D. Destructive")) + +(defgeneric to-vector (a) + (:documentation "Reshape the object to 1D")) + +(defgeneric to-matrix! (a rows) + (:documentation "Reshape the object to 2D. Destructive")) + +(defgeneric to-matrix (a rows) + (:documentation "Reshape the object to 2D")) + +(defgeneric reshape! (a shape) + (:documentation "Reshapes the object. Detructive")) + +(defgeneric reshape (a shape) + (:documentation "Reshapes the object")) + +(defgeneric get-row! (matrix row) + (:documentation "Gets rows. Destructive")) + +(defgeneric get-row (matrix row) + (:documentation "Gets rows. Destructive")) + +(defgeneric get-col! (matrix col) + (:documentation "Gets rows. Destructive")) + +(defgeneric get-col (matrix col) + (:documentation "Gets rows. Destructive")) + +;;; Row operations + +(defgeneric row-swap! (matrix i j) + (:documentation "Swaps row i and j of matrix. Destructive.")) + +(defgeneric row-mul! (matrix i number) + (:documentation "Multiplies row i with number. Destructive.")) + +(defgeneric row-add! (matrix i j number) + (:documentation "Adds a multiplicum of row j to row i. A_ic=A_ic+number*A_jc. Destructive.")) + + +;;;; Views + +(defgeneric view-row (matrix row) + (:documentation "Returns a shared structure view of the row")) + +(defgeneric view-col (matrix col) + (:documentation "Returns a shared structure view of the row")) + +(defgeneric view-matrix (matrix dim &optional (type)) + (:documentation "Returns a shared structure view of the matrix")) + +(defgeneric view-transpose (a) + (:documentation "Returns a transposed matrix with same (shared) elements")) + +(defgeneric circ-shift (m shifts) + (:documentation "Shifts the matrix with periodic indices")) + +(defgeneric pad-shift (m shifts &optional value) + (:documentation "Shifts the matrix and pads results")) Modified: trunk/src/vector2/level2-interface.lisp ============================================================================== --- trunk/src/vector2/level2-interface.lisp Sat Jul 2 10:55:33 2011 (r200) +++ trunk/src/vector2/level2-interface.lisp Sun Oct 9 05:38:46 2011 (r201) @@ -33,83 +33,10 @@ (defgeneric .every (pred a &rest matrices) (:documentation "Generalizes every.")) -(defgeneric sub-matrix (m rr cc) - (:documentation "Copies a sub matrix of m. The format of rr = (start stop) -or rr = (start step stop) and the same for the columns.")) - (defgeneric copy-contents (a b &optional converter) (:documentation "Copies all elements from a to b.")) -(defgeneric mnew (class value rows &optional cols) - (:documentation "General matrix constructor. Creates a new matrix -filled with numeric arguments.")) - -(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.")) - -(defgeneric mcreate* (a &key value dim element-type structure implementation) - (:documentation "Extended version of mcreate. Creates a new matrix of the same type -and with the same value as the other, but with all elements set to value.")) - -(defgeneric diag (v) - (:documentation "Creates a diagnoal matrix from the vector.")) - -(defgeneric to-vector! (a) - (:documentation "Reshape the object to 1D. Destructive")) - -(defgeneric to-vector (a) - (:documentation "Reshape the object to 1D")) - -(defgeneric to-matrix! (a rows) - (:documentation "Reshape the object to 2D. Destructive")) - -(defgeneric to-matrix (a rows) - (:documentation "Reshape the object to 2D")) - -(defgeneric reshape! (a shape) - (:documentation "Reshapes the object. Detructive")) - -(defgeneric reshape (a shape) - (:documentation "Reshapes the object")) - -(defgeneric get-row! (matrix row) - (:documentation "Gets rows. Destructive")) - -(defgeneric get-row (matrix row) - (:documentation "Gets rows. Destructive")) -(defgeneric get-col! (matrix col) - (:documentation "Gets rows. Destructive")) - -(defgeneric get-col (matrix col) - (:documentation "Gets rows. Destructive")) - -;;; Row operations - -(defgeneric row-swap! (matrix i j) - (:documentation "Swaps row i and j of matrix. Destructive.")) - -(defgeneric row-mul! (matrix i number) - (:documentation "Multiplies row i with number. Destructive.")) - -(defgeneric row-add! (matrix i j number) - (:documentation "Adds a multiplicum of row j to row i. A_ic=A_ic+number*A_jc. Destructive.")) - - -;;;; Views - -(defgeneric view-row (matrix row) - (:documentation "Returns a shared structure view of the row")) - -(defgeneric view-col (matrix col) - (:documentation "Returns a shared structure view of the row")) - -(defgeneric view-matrix (matrix dim &optional (type)) - (:documentation "Returns a shared structure view of the matrix")) - -(defgeneric view-transpose (a) - (:documentation "Returns a transposed matrix with same (shared) elements")) ;;;; Single-element operations @@ -147,11 +74,6 @@ (defgeneric mminmax (m) (:documentation "Returns a list with (minimum maximum)")) -(defgeneric circ-shift (m shifts) - (:documentation "Shifts the matrix with periodic indices")) - -(defgeneric pad-shift (m shifts &optional value) - (:documentation "Shifts the matrix and pads results")) (defgeneric mreverse (m) (:documentation "Reverts elements of matrix or vector. Similar to cl:reverse")) From jivestgarden at common-lisp.net Sun Oct 9 13:45:43 2011 From: jivestgarden at common-lisp.net (jivestgarden at common-lisp.net) Date: Sun, 09 Oct 2011 06:45:43 -0700 Subject: [lisplab-cvs] r203 - trunk/src/list Message-ID: Author: jivestgarden Date: Sun Oct 9 06:45:43 2011 New Revision: 203 Log: Dir for list methods Added: trunk/src/list/ From jivestgarden at common-lisp.net Sun Oct 9 13:50:13 2011 From: jivestgarden at common-lisp.net (jivestgarden at common-lisp.net) Date: Sun, 09 Oct 2011 06:50:13 -0700 Subject: [lisplab-cvs] r204 - in trunk: . src/list src/vector2 Message-ID: Author: jivestgarden Date: Sun Oct 9 06:50:13 2011 New Revision: 204 Log: Restructured Added: trunk/src/list/level2-list.lisp - copied unchanged from r200, trunk/src/vector2/level2-list.lisp Deleted: trunk/src/vector2/level2-list.lisp trunk/src/vector2/level2-vector.lisp Modified: trunk/lisplab.asd trunk/src/vector2/vector2-generic.lisp Modified: trunk/lisplab.asd ============================================================================== --- trunk/lisplab.asd Sun Oct 9 06:45:43 2011 (r203) +++ trunk/lisplab.asd Sun Oct 9 06:50:13 2011 (r204) @@ -114,11 +114,15 @@ ;; Level2, spezialized (:file "vector2-dge") (:file "vector2-zge") - - (:file "level2-list") - (:file "level2-vector") )) + + (:module :src/list + :depends-on (:src/core) + :serial t + :components ((:file "level2-list"))) + + (:module :src/matrix2 :depends-on (:src/core :src/vector1 :src/matrix1 :src/util) :serial t Copied: trunk/src/list/level2-list.lisp (from r200, trunk/src/vector2/level2-list.lisp) ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ trunk/src/list/level2-list.lisp Sun Oct 9 06:50:13 2011 (r204, copy of r200, trunk/src/vector2/level2-list.lisp) @@ -0,0 +1,74 @@ +;;; Lisplab, level2-list.lisp +;;; Basic algebra stuff for lists + +;;; Copyright (C) 2009 Joern Inge Vestgaarden +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License along +;;; with this program; if not, write to the Free Software Foundation, Inc., +;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Should it be somewhere else. It has nothing to do with matrices, really. + +(in-package :lisplab) + +(defmethod convert ((x cons) type) + (let* ((cols (length (car x))) + (rows (length x)) + (m (make-matrix-instance type (list rows cols) 0))) + (fill-matrix-with-list m x) + m)) + +(defmethod .mul ((x cons) (y cons)) + (mapcar #'.mul x y)) + +(defmethod .mul ((x cons) (y number)) + (mapcar (lambda (x) (.mul x y)) x)) + +(defmethod .mul ((x number) (y cons)) + (mapcar (lambda (y) (.mul x y)) y)) + +(defmethod .add ((x cons) (y cons)) + (mapcar #'.add x y)) + +(defmethod .add ((x cons) (y number)) + (mapcar (lambda (x) (.add x y)) x)) + +(defmethod .add ((x number) (y cons)) + (mapcar (lambda (y) (.add x y)) y)) + +(defmethod .sub ((x cons) (y cons)) + (mapcar #'.sub x y)) + +(defmethod .sub ((x cons) (y number)) + (mapcar (lambda (x) (.sub x y)) x)) + +(defmethod .sub ((x number) (y cons)) + (mapcar (lambda (y) (.sub x y)) y)) + +(defmethod .div ((x cons) (y cons)) + (mapcar #'.div x y)) + +(defmethod .div ((x cons) (y number)) + (mapcar (lambda (x) (.div x y)) x)) + +(defmethod .div ((x number) (y cons)) + (mapcar (lambda (y) (.div x y)) y)) + +(defmethod .expt ((x cons) (y cons)) + (mapcar #'.expt x y)) + +(defmethod .expt ((x cons) (y number)) + (mapcar (lambda (x) (.expt x y)) x)) + +(defmethod .expt ((x number) (y cons)) + (mapcar (lambda (y) (.expt x y)) y)) Modified: trunk/src/vector2/vector2-generic.lisp ============================================================================== --- trunk/src/vector2/vector2-generic.lisp Sun Oct 9 06:45:43 2011 (r203) +++ trunk/src/vector2/vector2-generic.lisp Sun Oct 9 06:50:13 2011 (r204) @@ -30,6 +30,27 @@ (in-package :lisplab) +;;; For general vector + +(defmethod vdot ((a vector-base) (b vector-base)) + (msum (.* a b))) + +(defmethod vcross :before ((a vector-base) (b vector-base)) + (assert (= (size a) (size b) 3))) + +(defmethod vcross ((a vector-base) (b vector-base)) + (let ((out (mcreate a))) + (setf (vref out 0) (.- (.* (vref a 1) (vref b 2)) + (.* (vref a 2) (vref b 1))) + (vref out 1) (.- (.* (vref a 2) (vref b 0)) + (.* (vref a 0) (vref b 2))) + (vref out 2) (.- (.* (vref a 0) (vref b 1)) + (.* (vref a 1) (vref b 0)))) + out)) + +(defmethod vnorm ((a vector-base)) + (.sqrt (vdot (.conj a) a))) + ;;; Vector operations (ignore structure) (defmethod copy ((a vector-base)) From jivestgarden at common-lisp.net Sun Oct 9 13:52:00 2011 From: jivestgarden at common-lisp.net (jivestgarden at common-lisp.net) Date: Sun, 09 Oct 2011 06:52:00 -0700 Subject: [lisplab-cvs] r205 - in trunk: . src/list Message-ID: Author: jivestgarden Date: Sun Oct 9 06:51:59 2011 New Revision: 205 Log: Rename list file Added: trunk/src/list/list.lisp - copied unchanged from r204, trunk/src/list/level2-list.lisp Deleted: trunk/src/list/level2-list.lisp Modified: trunk/lisplab.asd Modified: trunk/lisplab.asd ============================================================================== --- trunk/lisplab.asd Sun Oct 9 06:50:13 2011 (r204) +++ trunk/lisplab.asd Sun Oct 9 06:51:59 2011 (r205) @@ -120,7 +120,7 @@ (:module :src/list :depends-on (:src/core) :serial t - :components ((:file "level2-list"))) + :components ((:file "list"))) (:module :src/matrix2 Copied: trunk/src/list/list.lisp (from r204, trunk/src/list/level2-list.lisp) ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ trunk/src/list/list.lisp Sun Oct 9 06:51:59 2011 (r205, copy of r204, trunk/src/list/level2-list.lisp) @@ -0,0 +1,74 @@ +;;; Lisplab, level2-list.lisp +;;; Basic algebra stuff for lists + +;;; Copyright (C) 2009 Joern Inge Vestgaarden +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License along +;;; with this program; if not, write to the Free Software Foundation, Inc., +;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Should it be somewhere else. It has nothing to do with matrices, really. + +(in-package :lisplab) + +(defmethod convert ((x cons) type) + (let* ((cols (length (car x))) + (rows (length x)) + (m (make-matrix-instance type (list rows cols) 0))) + (fill-matrix-with-list m x) + m)) + +(defmethod .mul ((x cons) (y cons)) + (mapcar #'.mul x y)) + +(defmethod .mul ((x cons) (y number)) + (mapcar (lambda (x) (.mul x y)) x)) + +(defmethod .mul ((x number) (y cons)) + (mapcar (lambda (y) (.mul x y)) y)) + +(defmethod .add ((x cons) (y cons)) + (mapcar #'.add x y)) + +(defmethod .add ((x cons) (y number)) + (mapcar (lambda (x) (.add x y)) x)) + +(defmethod .add ((x number) (y cons)) + (mapcar (lambda (y) (.add x y)) y)) + +(defmethod .sub ((x cons) (y cons)) + (mapcar #'.sub x y)) + +(defmethod .sub ((x cons) (y number)) + (mapcar (lambda (x) (.sub x y)) x)) + +(defmethod .sub ((x number) (y cons)) + (mapcar (lambda (y) (.sub x y)) y)) + +(defmethod .div ((x cons) (y cons)) + (mapcar #'.div x y)) + +(defmethod .div ((x cons) (y number)) + (mapcar (lambda (x) (.div x y)) x)) + +(defmethod .div ((x number) (y cons)) + (mapcar (lambda (y) (.div x y)) y)) + +(defmethod .expt ((x cons) (y cons)) + (mapcar #'.expt x y)) + +(defmethod .expt ((x cons) (y number)) + (mapcar (lambda (x) (.expt x y)) x)) + +(defmethod .expt ((x number) (y cons)) + (mapcar (lambda (y) (.expt x y)) y)) From jivestgarden at common-lisp.net Sun Oct 9 14:12:52 2011 From: jivestgarden at common-lisp.net (jivestgarden at common-lisp.net) Date: Sun, 09 Oct 2011 07:12:52 -0700 Subject: [lisplab-cvs] r206 - in trunk: . src/core src/util Message-ID: Author: jivestgarden Date: Sun Oct 9 07:12:51 2011 New Revision: 206 Log: changed utilities dependency Added: trunk/src/util/level0-basic.lisp - copied unchanged from r205, trunk/src/core/level0-basic.lisp trunk/src/util/level0-const.lisp - copied unchanged from r205, trunk/src/core/level0-const.lisp Deleted: trunk/src/core/level0-basic.lisp trunk/src/core/level0-const.lisp Modified: trunk/lisplab.asd Modified: trunk/lisplab.asd ============================================================================== --- trunk/lisplab.asd Sun Oct 9 06:51:59 2011 (r205) +++ trunk/lisplab.asd Sun Oct 9 07:12:51 2011 (r206) @@ -47,6 +47,20 @@ (:file "package") (:file "version") + (:module :src/util + :depends-on () + :serial t + :components + ((:file "type") + (:file "level0-basic") + (:file "level0-const") + (:file "ref") + (:file "level1-util") + (:file "store-operators") + (:file "store-ordinary-functions") + (:file "permutation") + )) + ;; ;; All core none-matrix stuff (level 0) ;; @@ -54,27 +68,12 @@ :depends-on ("package") :serial t :components - ( - (:file "level0-basic") - (:file "level0-const") - (:file "level0-interface") + ((:file "level0-interface") ;; (:file "level0-default") (:file "level0-functions") (:file "level0-thread") )) - (:module :src/util - :depends-on (src/core) ; Fixit: it only needs package and define-constant - :serial t - :components - ((:file "type") - (:file "ref") - (:file "level1-util") - (:file "store-operators") - (:file "store-ordinary-functions") - (:file "permutation") - )) - (:module :src/vector1 :depends-on (:src/core :src/util) :serial t @@ -116,7 +115,6 @@ (:file "vector2-zge") )) - (:module :src/list :depends-on (:src/core) :serial t Copied: trunk/src/util/level0-basic.lisp (from r205, trunk/src/core/level0-basic.lisp) ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ trunk/src/util/level0-basic.lisp Sun Oct 9 07:12:51 2011 (r206, copy of r205, trunk/src/core/level0-basic.lisp) @@ -0,0 +1,52 @@ +;;; Lisplab, level0-basic.lisp +;;; Basic definitions, speical variables and general macros. + +;;; 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. + +;; TODO clean up. Here's a lot of unused stuff + +(in-package :lisplab) + +;; Here non ansi stuff. +;; First we need the truely-the macro + +#+sbcl(import 'sb-ext::truly-the) +;; Help, not tested +#-sbcl(defmacro truely-the (type val) `(the ,type ,val)) + +(defmacro define-constant (name value &optional doc) + "Works as defconstant. Made to avoid trouble with sbcl's strict +interpretation of the ansi standard." + (let ((old-value (gensym))) + `(defconstant ,name + (if (boundp ',name) + (let ((,old-value (symbol-value ',name))) + (if (equalp ,old-value ,value) + ,old-value + ,value)) + ,value) + ,@(when doc (list doc))))) + +(defun to-df (x) + "Coerce x to double float." + (coerce x 'double-float)) + +(defun make-dvec (n) + "Creates a double vector with n elements." + (make-array n :element-type 'double-float :initial-element 0d0)) + + Copied: trunk/src/util/level0-const.lisp (from r205, trunk/src/core/level0-const.lisp) ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ trunk/src/util/level0-const.lisp Sun Oct 9 07:12:51 2011 (r206, copy of r205, trunk/src/core/level0-const.lisp) @@ -0,0 +1,62 @@ +;;; Lisplab, level0-const.lisp +;;; General purpose constants + +;;; 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) + +;;; Float and complex constants +(define-constant %e (exp 1d0) "The number e = exp(1).") +(define-constant %i #C(0d0 1d0) "The imaginary unit i=sqrt(-1).") +(define-constant -%i #C(0d0 -1d0) "The negative imaginary unit -i=-sqrt(-1).") + +;;; Type constants +;;; TODO: throw them out or use deftype in stead +(define-constant %df 'double-float) +(define-constant %cdf '(complex double-float)) +(define-constant %sb32 '(signed-byte 32)) +(define-constant %ub32 '(unsigned-byte 32)) + +;;;; Constants from gsl. + +;;; TODO: throw them out + +(define-constant +lisplab-dbl-epsilon+ 2.2204460492503131d-16) +(define-constant +lisplab-sqrt-dbl-epsilon+ 1.4901161193847656d-08) +(define-constant +lisplab-root3-dbl-epsilon+ 6.0554544523933429d-06) +(define-constant +lisplab-root4-dbl-epsilon+ 1.2207031250000000d-04) +(define-constant +lisplab-root5-dbl-epsilon+ 7.4009597974140505d-04) +(define-constant +lisplab-root6-dbl-epsilon+ 2.4607833005759251d-03) +(define-constant +lisplab-log-dbl-epsilon+ -3.6043653389117154d+01) + +(define-constant +lisplab-dbl-min+ 2.2250738585072014d-308) +(define-constant +lisplab-sqrt-dbl-min+ 1.4916681462400413d-154) +(define-constant +lisplab-root3-dbl-min+ 2.8126442852362996d-103) +(define-constant +lisplab-root4-dbl-min+ 1.2213386697554620d-77) +(define-constant +lisplab-root5-dbl-min+ 2.9476022969691763d-62) +(define-constant +lisplab-root6-dbl-min+ 5.3034368905798218d-52) +(define-constant +lisplab-log-dbl-min+ -7.0839641853226408d+02) + +(define-constant +lisplab-dbl-max+ 1.7976931348623157d+308) +(define-constant +lisplab-sqrt-dbl-max+ 1.3407807929942596d+154) +(define-constant +lisplab-root3-dbl-max+ 5.6438030941222897d+102) +(define-constant +lisplab-root4-dbl-max+ 1.1579208923731620d+77) +(define-constant +lisplab-root5-dbl-max+ 4.4765466227572707d+61) +(define-constant +lisplab-root6-dbl-max+ 2.3756689782295612d+51) +(define-constant +lisplab-log-dbl-max+ 7.0978271289338397d+02) + + From jivestgarden at common-lisp.net Sun Oct 9 15:06:36 2011 From: jivestgarden at common-lisp.net (jivestgarden at common-lisp.net) Date: Sun, 09 Oct 2011 08:06:36 -0700 Subject: [lisplab-cvs] r207 - in trunk: . src/util Message-ID: Author: jivestgarden Date: Sun Oct 9 08:06:36 2011 New Revision: 207 Log: changed util dep Modified: trunk/lisplab.asd trunk/src/util/level0-basic.lisp trunk/src/util/store-ordinary-functions.lisp Modified: trunk/lisplab.asd ============================================================================== --- trunk/lisplab.asd Sun Oct 9 07:12:51 2011 (r206) +++ trunk/lisplab.asd Sun Oct 9 08:06:36 2011 (r207) @@ -44,6 +44,7 @@ :serial t :components ( + (:file "package") (:file "version") @@ -75,7 +76,7 @@ )) (:module :src/vector1 - :depends-on (:src/core :src/util) + :depends-on (:src/core) :serial t :components ((:file "level1-interface") @@ -83,7 +84,7 @@ )) (:module :src/matrix1 - :depends-on (:src/core :src/vector1 :src/util) + :depends-on (:src/core :src/vector1) :serial t :components ((:file "level1-classes") @@ -102,7 +103,7 @@ )) (:module :src/vector2 - :depends-on (:src/core :src/vector1 :src/util) + :depends-on (:src/core :src/vector1) :serial t :components ((:file "vector2-interface") @@ -122,7 +123,7 @@ (:module :src/matrix2 - :depends-on (:src/core :src/vector1 :src/matrix1 :src/util) + :depends-on (:src/core :src/vector1 :src/matrix1) :serial t :components ((:file "matrix2-interface") @@ -148,7 +149,7 @@ ;; Linear algebra lisp implementation (Level 3) ;; (:module :src/linalg - :depends-on (:src/matrix2 :src/util) + :depends-on (:src/matrix2) :serial t :components ((:file "level3-linalg-interface") @@ -159,7 +160,7 @@ ;; Fast Fourier transform (Level 3) ;; (:module :src/fft - :depends-on (:src/matrix2 :src/util) + :depends-on (:src/matrix2) :serial t :components ( Modified: trunk/src/util/level0-basic.lisp ============================================================================== --- trunk/src/util/level0-basic.lisp Sun Oct 9 07:12:51 2011 (r206) +++ trunk/src/util/level0-basic.lisp Sun Oct 9 08:06:36 2011 (r207) @@ -17,8 +17,6 @@ ;;; with this program; if not, write to the Free Software Foundation, Inc., ;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -;; TODO clean up. Here's a lot of unused stuff - (in-package :lisplab) ;; Here non ansi stuff. Modified: trunk/src/util/store-ordinary-functions.lisp ============================================================================== --- trunk/src/util/store-ordinary-functions.lisp Sun Oct 9 07:12:51 2011 (r206) +++ trunk/src/util/store-ordinary-functions.lisp Sun Oct 9 08:06:36 2011 (r207) @@ -34,7 +34,6 @@ ;;; Generate more real-to-real functions. With some kind of input these will ;;; fail and give complex output but for speed it can be ok to have them - (in-package :lisplab) ;;; Now the ordinary functions