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