[lisplab-cvs] r231 - in trunk: . src/matrix/1/array src/matrix/2/array src/vector/1/array src/vector/1/funmat
jivestgarden at common-lisp.net
jivestgarden at common-lisp.net
Sat Apr 28 15:37:43 UTC 2012
Author: jivestgarden
Date: Sat Apr 28 08:37:42 2012
New Revision: 231
Log:
arrays as matrices
Added:
trunk/src/matrix/1/array/
trunk/src/matrix/1/array/matrix1-array.lisp
trunk/src/matrix/2/array/
trunk/src/matrix/2/array/matrix2-array.lisp
trunk/src/vector/1/array/
trunk/src/vector/1/array/vector1-array.lisp
trunk/src/vector/1/funmat/vector1-funmat.lisp
Modified:
trunk/lisplab.asd
Modified: trunk/lisplab.asd
==============================================================================
--- trunk/lisplab.asd Fri Apr 20 12:42:28 2012 (r230)
+++ trunk/lisplab.asd Sat Apr 28 08:37:42 2012 (r231)
@@ -130,13 +130,16 @@
(:module :src/vector/1/funmat
:depends-on (:src/interface/1)
- :serial t
:components
((:file "vector1-funmat")))
+ (:module :src/vector/1/array
+ :depends-on (:src/interface/1)
+ :components
+ ((:file "vector1-array")))
+
(:module :src/matrix/1
:depends-on (:src/interface/1)
- :serial t
:components
((:file "matrix1-constructors")))
@@ -170,9 +173,13 @@
(:module :src/matrix/1/funmat
:depends-on (:src/interface/1)
- :serial t
:components
((:file "level1-funmat")))
+
+ (:module :src/matrix/1/array
+ :depends-on (:src/interface/1)
+ :components
+ ((:file "matrix1-array")))
))
@@ -234,6 +241,11 @@
:components
((:file "matrix2-integer-constructors")))
+ (:module :src/matrix/2/array
+ :depends-on (:src/interface/2)
+ :components
+ ((:file "matrix2-array")))
+
))
Added: trunk/src/matrix/1/array/matrix1-array.lisp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/matrix/1/array/matrix1-array.lisp Sat Apr 28 08:37:42 2012 (r231)
@@ -0,0 +1,36 @@
+;;; Lisplab, matrix1-array.lisp
+;;; Level1, treats normal lisp arrays as matrices
+
+;;; Copyright (C) 2012 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 rows ((a array))
+ (array-dimension a 0))
+
+(defmethod cols ((a array))
+ (array-dimension a 1))
+
+(defmethod mref ((a array) row col)
+ "Row major order"
+ (aref a row col))
+
+(defmethod (setf mref) (value (a array) row col)
+ (setf (aref a row col) (convert value (element-type a))))
+
+(defmethod make-matrix-instance ((x (eql 'array)) dim value)
+ (make-array dim :initial-element value))
\ No newline at end of file
Added: trunk/src/matrix/2/array/matrix2-array.lisp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/matrix/2/array/matrix2-array.lisp Sat Apr 28 08:37:42 2012 (r231)
@@ -0,0 +1,30 @@
+;;; Lisplab, matrix2-array.lisp
+;;; Lisp array methods.
+
+;;; Copyright (C) 2012 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 copy ((a array))
+ (if (vectorp a)
+ (copy-seq a)
+ (let ((y (make-array (dim a) :element-type (element-type a))))
+ (dotimes (i (size a))
+ (setf (row-major-aref y i)
+ (row-major-aref a i)))
+ y)))
+
Added: trunk/src/vector/1/array/vector1-array.lisp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/vector/1/array/vector1-array.lisp Sat Apr 28 08:37:42 2012 (r231)
@@ -0,0 +1,47 @@
+;;; Lisplab, vector1-array.lisp
+;;; Level1, treats normal lisp arrays as vectors
+
+;;; Copyright (C) 2012 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 vector-p ((a array))
+ "True for any array through row-major-aref"
+ t)
+
+(defmethod dim ((a array) &optional axis)
+ (if axis
+ (array-dimension a axis)
+ (array-dimensions a)))
+
+(defmethod size ((a array))
+ (reduce #'* (dim a)))
+
+(defmethod rank ((a array))
+ (array-rank a))
+
+(defmethod element-type ((a array))
+ "Gets the element type of the array"
+ (array-element-type a))
+
+(defmethod vref ((a array) idx)
+ "Row major order"
+ (row-major-aref a idx))
+
+(defmethod (setf vref) (value (a array) idx)
+ (setf (row-major-aref a idx) value))
+
Added: trunk/src/vector/1/funmat/vector1-funmat.lisp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/src/vector/1/funmat/vector1-funmat.lisp Sat Apr 28 08:37:42 2012 (r231)
@@ -0,0 +1,43 @@
+;;; Lisplab, vector1-funmat.lisp
+;;; General, storeless vectors
+
+;;; Copyright (C) 2012 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)
+
+;;; Function matrices (matrices without a store)
+
+(defclass function-vector (vector-base)
+ ((vref
+ :initarg :vref
+ :initform (constantly 0)
+ :accessor function-matrix-vref
+ :type function)
+ (set-vref
+ :initarg :set-vref
+ :initform (constantly nil)
+ :accessor function-matrix-set-vref
+ :type function))
+ (:documentation "Vector without a store."))
+
+;;; Level1 methods specialized for the function matrix
+
+(defmethod vref ((f function-vector) idx)
+ (funcall (function-matrix-vref f) f idx))
+
+(defmethod (setf vref) (value (f function-vector) idx)
+ (funcall (function-matrix-set-vref f) value f idx))
More information about the lisplab-cvs
mailing list