[common-math-cvs] r2 - in trunk/common-math: . numerics/linear-algebra
mantoniotti at common-lisp.net
mantoniotti at common-lisp.net
Thu Aug 17 16:39:36 UTC 2006
Author: mantoniotti
Date: Thu Aug 17 12:39:36 2006
New Revision: 2
Modified:
trunk/common-math/common-math.lisp
trunk/common-math/numerics/linear-algebra/matrix.lisp
Log:
Added a few missing operations (.*%2 ./%2 .%\\2) and fixed
a couple of loose things.
Modified: trunk/common-math/common-math.lisp
==============================================================================
--- trunk/common-math/common-math.lisp (original)
+++ trunk/common-math/common-math.lisp Thu Aug 17 12:39:36 2006
@@ -52,6 +52,8 @@
;;; purposes and setting up a separate readtable seems a little bit
;;; too much for the time being.
+;;; <%2
+
(defgeneric <%2 (x y)
(:documentation "The <%2 generic function.
The binary LESS generic function which is specialized for various
@@ -90,6 +92,12 @@
)
+(defmethod <%2 ((x symbol) (y symbol))
+ (string< x y))
+
+
+;;; >%2
+
(defgeneric >%2 (x y)
(:method ((x number) (y number))
(cl:> x y))
@@ -122,14 +130,13 @@
)
-(defmethod <%2 ((x symbol) (y symbol))
- (string< x y))
-
(defmethod >%2 ((x symbol) (y symbol))
(string> y x))
+;;; <=%2
+
(defgeneric <=%2 (x y)
(:method ((x number) (y number))
(cl:<= x y))
@@ -162,6 +169,8 @@
)
+;;; >=%2
+
(defgeneric >=%2 (x y)
(:method ((x number) (y number))
(cl:>= x y))
@@ -194,6 +203,8 @@
)
+;;; +%2
+
(defgeneric +%2 (x y &optional r)
(:method ((x number) (y number) &optional r)
(declare (ignore r))
@@ -237,6 +248,8 @@
)
+;;; *%2
+
(defgeneric *%2 (x y &optional r)
(:method ((x number) (y number) &optional r)
(declare (ignore r))
@@ -289,12 +302,16 @@
)
+;;; -%2
+
(defgeneric -%2 (x y &optional r)
(:method ((x t) (y t) &optional r)
(declare (ignore r))
(+%2 x (-%1 y))))
+;;; /%2
+
(defgeneric /%2 (x y &optional r)
(:method ((x number) (y number) &optional r)
(declare (ignore r))
@@ -305,6 +322,8 @@
(*%2 x (/%1 y))))
+;;; +%1
+
(defgeneric +%1 (x &optional r)
(:method ((x number) &optional r)
(declare (ignore r))
@@ -320,6 +339,9 @@
)
+
+;;; *%1
+
(defgeneric *%1 (x &optional r)
(:method ((x number) &optional r)
(declare (ignore r))
@@ -335,6 +357,9 @@
)
+
+;;; -%1
+
(defgeneric -%1 (x &optional r)
(:method ((x number) &optional r)
(declare (ignore r))
@@ -350,6 +375,9 @@
)
+
+;;; /%1
+
(defgeneric /%1 (x &optional r)
(:method ((x number) &optional r)
(declare (ignore r))
@@ -365,6 +393,8 @@
)
+;;; =2%
+
(defgeneric =%2 (x y)
(:method ((x number) (y number)) (cl:= x y))
@@ -396,11 +426,17 @@
)
+;;; =%1
+
(defgeneric =%1 (x)
(:method ((x t)) T)
)
+;;;---------------------------------------------------------------------------
+;;; Other operations
+
+
(defgeneric gcd%2 (x y)
(:method ((x integer) (y integer))
(cl:gcd x y)))
Modified: trunk/common-math/numerics/linear-algebra/matrix.lisp
==============================================================================
--- trunk/common-math/numerics/linear-algebra/matrix.lisp (original)
+++ trunk/common-math/numerics/linear-algebra/matrix.lisp Thu Aug 17 12:39:36 2006
@@ -773,20 +773,10 @@
(defmethod *%2 ((y array) (x number) &optional (r (copy-matrix y) r-supplied-p))
+ (declare (ignore r-supplied-p))
(*%2 x y r))
-;;; The next one breaks the return type convention.
-#| Defined in 'vector.lisp'.
-(defmethod *%2 ((x vector) (y vector) &optional r)
- (declare (ignore r))
- (assert (conforming-*-dimensions-p x y nil))
- (let ((result 0))
- (dotimes (i (length x) result)
- (setf result (+%2 result (* (aref x i) (aref y i)))))))
-|#
-
-
;;;---------------------------------------------------------------------------
;;; Division.
;;; Only the simple form of division is implemented here.
@@ -810,6 +800,8 @@
;;;---------------------------------------------------------------------------
;;; Element-wise operations.
+;;; .*%2
+
(defmethod .*%2 ((x number) (y matrix)
&optional (r (copy-matrix y) r-supplied-p))
(when r-supplied-p (assert (shape-equal-p y r)))
@@ -850,6 +842,187 @@
(*%2 (row-major-aref x i) (row-major-aref y i)))))
+(defmethod .*%2 ((x matrix) (y matrix) &optional (r (copy-matrix y) r-supplied-p))
+ (when r-supplied-p (assert (shape-equal-p y r)))
+ (assert (shape-equal-p x y))
+
+ (with-slots ((x-data data)) x
+ (with-slots ((y-data data)) y
+ (with-slots ((result data)) r
+
+ (dotimes (i (array-total-size result) r)
+ (setf (row-major-aref result i)
+ (*%2 (row-major-aref x-data i) (row-major-aref y-data i)))))
+ )))
+
+
+(defmethod .*%2 ((x matrix) (y array) &optional (r (copy-matrix y) r-supplied-p))
+ (when r-supplied-p (assert (shape-equal-p y r)))
+ (assert (shape-equal-p x y))
+ (.*%2 (matrix-data x) y r))
+
+
+(defmethod .*%2 ((x array) (y matrix) &optional (r (copy-matrix y) r-supplied-p))
+ (when r-supplied-p (assert (shape-equal-p y r)))
+ (assert (shape-equal-p x y))
+
+ (with-slots ((y-data data)) y
+ (with-slots ((result data)) r
+ (dotimes (i (array-total-size result) r)
+ (setf (row-major-aref result i)
+ (*%2 (row-major-aref x i) (row-major-aref y-data i))))
+ )))
+
+
+
+;;; ./%2
+
+(defmethod ./%2 ((x number) (y matrix)
+ &optional (r (copy-matrix y) r-supplied-p))
+ (when r-supplied-p (assert (shape-equal-p y r)))
+ (with-slots (data) y
+ (with-slots ((result data)) r
+ (dotimes (i (array-total-size data) r)
+ (setf (row-major-aref result i) (/%2 x (row-major-aref data i))))
+ )))
+
+
+(defmethod ./%2 ((y matrix) (x number) &optional (r (copy-matrix y)))
+ (.*%2 y (cl:/ x) r))
+
+
+(defmethod ./%2 ((x number) (y array)
+ &optional (r (copy-matrix y) r-supplied-p))
+ (assert (matrix-array-p y))
+ (when r-supplied-p (assert (shape-equal-p y r)))
+ (let* ((data y)
+ (result r)
+ )
+ (dotimes (i (array-total-size data) r)
+ (setf (row-major-aref result i) (/%2 x (row-major-aref data i))))
+ ))
+
+
+(defmethod ./%2 ((y array) (x number) &optional (r (copy-matrix y)))
+ (.*%2 y (cl:/ x) r))
+
+
+
+(defmethod ./%2 ((x array) (y array) &optional (r (copy-matrix y) r-supplied-p))
+ (when r-supplied-p (assert (shape-equal-p y r)))
+ (assert (shape-equal-p x y))
+
+ (dotimes (i (array-total-size y) r)
+ (setf (row-major-aref r i)
+ (/%2 (row-major-aref x i) (row-major-aref y i)))))
+
+
+(defmethod ./%2 ((x matrix) (y matrix) &optional (r (copy-matrix y) r-supplied-p))
+ (when r-supplied-p (assert (shape-equal-p y r)))
+ (assert (shape-equal-p x y))
+
+ (with-slots ((x-data data)) x
+ (with-slots ((y-data data)) y
+ (with-slots ((result data)) r
+
+ (dotimes (i (array-total-size result) r)
+ (setf (row-major-aref result i)
+ (/%2 (row-major-aref x-data i) (row-major-aref y-data i)))))
+ )))
+
+
+(defmethod ./%2 ((x matrix) (y array) &optional (r (copy-matrix y) r-supplied-p))
+ (when r-supplied-p (assert (shape-equal-p y r)))
+ (assert (shape-equal-p x y))
+ (./%2 (matrix-data x) y r))
+
+
+(defmethod ./%2 ((x array) (y matrix) &optional (r (copy-matrix y) r-supplied-p))
+ (when r-supplied-p (assert (shape-equal-p y r)))
+ (assert (shape-equal-p x y))
+
+ (with-slots ((y-data data)) y
+ (with-slots ((result data)) r
+ (dotimes (i (array-total-size result) r)
+ (setf (row-major-aref result i)
+ (/%2 (row-major-aref x i) (row-major-aref y-data i))))
+ )))
+
+
+;;; .\\%2
+
+(defmethod .\\%2 ((x number) (y matrix)
+ &optional (r (copy-matrix y) r-supplied-p))
+ (when r-supplied-p (assert (shape-equal-p y r)))
+ (with-slots (data) y
+ (with-slots ((result data)) r
+ (dotimes (i (array-total-size data) r)
+ (setf (row-major-aref result i) (/%2 (row-major-aref data i) x)))
+ )))
+
+
+(defmethod .\\%2 ((y matrix) (x number) &optional (r (copy-matrix y)))
+ (./%2 x y r))
+
+
+(defmethod .\\%2 ((x number) (y array)
+ &optional (r (copy-matrix y) r-supplied-p))
+ (assert (matrix-array-p y))
+ (when r-supplied-p (assert (shape-equal-p y r)))
+ (let* ((data y)
+ (result r)
+ )
+ (dotimes (i (array-total-size data) r)
+ (setf (row-major-aref result i) (/%2 (row-major-aref data i) x)))
+ ))
+
+
+(defmethod .\\%2 ((y array) (x number) &optional (r (copy-matrix y)))
+ (./%2 x y r))
+
+
+
+(defmethod .\\%2 ((x array) (y array) &optional (r (copy-matrix y) r-supplied-p))
+ (when r-supplied-p (assert (shape-equal-p y r)))
+ (assert (shape-equal-p x y))
+
+ (dotimes (i (array-total-size y) r)
+ (setf (row-major-aref r i)
+ (/%2 (row-major-aref y i) (row-major-aref x i)))))
+
+
+(defmethod .\\%2 ((x matrix) (y matrix) &optional (r (copy-matrix y) r-supplied-p))
+ (when r-supplied-p (assert (shape-equal-p y r)))
+ (assert (shape-equal-p x y))
+
+ (with-slots ((x-data data)) x
+ (with-slots ((y-data data)) y
+ (with-slots ((result data)) r
+
+ (dotimes (i (array-total-size result) r)
+ (setf (row-major-aref result i)
+ (/%2 (row-major-aref y-data i) (row-major-aref x-data i)))))
+ )))
+
+
+(defmethod .\\%2 ((x matrix) (y array) &optional (r (copy-matrix y) r-supplied-p))
+ (when r-supplied-p (assert (shape-equal-p y r)))
+ (assert (shape-equal-p x y))
+ (.\\%2 (matrix-data x) y r))
+
+
+(defmethod .\\%2 ((x array) (y matrix) &optional (r (copy-matrix y) r-supplied-p))
+ (when r-supplied-p (assert (shape-equal-p y r)))
+ (assert (shape-equal-p x y))
+
+ (with-slots ((y-data data)) y
+ (with-slots ((result data)) r
+ (dotimes (i (array-total-size result) r)
+ (setf (row-major-aref result i)
+ (/%2 (row-major-aref y-data i) (row-major-aref x i))))
+ )))
+
+
;;;---------------------------------------------------------------------------
;;; Transpose
More information about the Common-math-cvs
mailing list