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