| Paste number 82956: | leo2007 - Destructive Matrix OP |
| Pasted by: | tmh |
| When: | 2 years, 7 months ago |
| Share: | Tweet this! | http://paste.lisp.org/+1S0C |
| Channel: | #lisp |
| Paste contents: |
;;; Something like this
(define-test destructive-matrix-op
(let* ((matrix (generate-matrix ...)))
(destructive-matrix-op matrix ...)
(assert-numerical-equal
exact-matrix matrix)))
;;; As a design note, most destructive operations still return the
;;; modified object. So, it would be good if DESTRUCTIVE-MATRIX-OP
;;; return the matrix.
Annotations for this paste:
| Annotation number 1: | untitled |
| Pasted by: | leo2007 |
| When: | 2 years, 7 months ago |
| Share: | Tweet this! | http://paste.lisp.org/+1S0C/1 |
| Paste contents: |
MONTE-CARLO-TEST> (run-tests)
MAP-MATRIX!-TEST: 1 assertions passed, 0 failed.
MAP-MATRIX-TEST: 1 assertions passed, 0 failed.
MATRIX-TEST: 8 assertions passed, 0 failed.
TOTAL: 10 assertions passed, 0 failed, 0 execution errors.
; No value
MONTE-CARLO-TEST> (run-tests)
MAP-MATRIX!-TEST: MATRIX failed:
Expected #2A((0.84147096 0.9092974) (0.14112 -0.7568025))
but saw #2A((0.7456241 0.78907233) (0.14065208 -0.68660027))
MAP-MATRIX!-TEST: 0 assertions passed, 1 failed.
MAP-MATRIX-TEST: 1 assertions passed, 0 failed.
MATRIX-TEST: 8 assertions passed, 0 failed.
TOTAL: 9 assertions passed, 1 failed, 0 execution errors.
| Annotation number 2: | untitled |
| Pasted by: | leo2007 |
| When: | 2 years, 7 months ago |
| Share: | Tweet this! | http://paste.lisp.org/+1S0C/2 |
| Paste contents: |
(define-test map-matrix!-test
(let ((matrix #2A((1 2) (3 4))))
(map-matrix! #'sin matrix)
(assert-numerical-equal
#2A((0.841470985 0.909297427)
(0.141120001 -0.756802495))
matrix)))| Annotation number 3: | leo2007 - Use MAKE-ARRAY |
| Pasted by: | tmh |
| When: | 2 years, 7 months ago |
| Share: | Tweet this! | http://paste.lisp.org/+1S0C/3 |
| Paste contents: |
(define-test map-matrix!-test
(let ((matrix (make-array '(2 2) :initial-contents
'((1 2)
(3 4)))))
(map-matrix! #'sin matrix)
(assert-numerical-equal
#2A((0.841470985 0.909297427)
(0.141120001 -0.756802495))
matrix)))| Annotation number 4: | untitled |
| Pasted by: | leo2007 |
| When: | 2 years, 7 months ago |
| Share: | Tweet this! | http://paste.lisp.org/+1S0C/4 |
| Paste contents: |
(defun map-matrix (function first-matrix &rest more-matrixes)
"Apply FUNCTION on the elements of matrix."
(let ((result (make-array (array-dimensions first-matrix))))
(handler-case
(loop for i below (array-total-size first-matrix)
do (setf (row-major-aref result i)
(apply function
(row-major-aref first-matrix i)
(mapcar (lambda (m)
(row-major-aref m i))
more-matrixes)))
finally (return result))
(error nil
(format t "Matrix size does not match or too few arguments")
(return-from map-matrix nil)))))
(defun map-matrix! (function result-matrix &rest more-matrixes)
"Apply FUNCTION on the elements of matrix MAT."
(handler-case
(loop for i below (array-total-size result-matrix)
do (setf (row-major-aref result-matrix i)
(apply function
(row-major-aref result-matrix i)
(mapcar (lambda (m)
(row-major-aref m i))
more-matrixes)))
finally (return result-matrix))
(error nil
(format t "Matrix size does not match or too few arguments")
(return-from map-matrix! nil))))
| Annotation number 5: | leo2007 : MAP-MATRIX and MAP-INTO-MATRIX |
| Pasted by: | tmh |
| When: | 2 years, 7 months ago |
| Share: | Tweet this! | http://paste.lisp.org/+1S0C/5 |
| Paste contents: |
;;; Lightly tested; needs to be factored; generally models MAP and MAP-INTO
(defun %validate-dimensions (matrix matrices)
"Return the dimensions validating that all are equal."
(if (= 2 (array-rank matrix))
(let ((dimensions (array-dimensions matrix)))
(dolist (mat matrices dimensions)
(unless (equal dimensions (array-dimensions mat))
(error "Unequal matrix dimensions."))))
(error "Matrix rank, ~S, does not equal 2."
(array-rank matrix))))
;;; FIXME : The result element type should be set to the most general
;;; type of all of the matrices according to UPGRADED-ARRAY-ELEMENT-TYPE
(defun map-matrix (function matrix &rest matrices)
"Apply FUNCTION on the elements of matrix."
(declare (optimize debug))
(if matrices
;; The function accepts more than one matrix.
(destructuring-bind (rows columns)
(%validate-dimensions matrix matrices)
(let ((arglist (make-list (length matrices)))
(result (make-array (list rows columns)
:element-type
(array-element-type matrix))))
(dotimes (i0 rows result)
(dotimes (i1 columns)
(setf
(aref result i0 i1)
(apply function
(aref matrix i0 i1)
(map-into arglist
(lambda (mat) (aref mat i0 i1))
matrices)))))))
;; The function accepts one matrix.
(destructuring-bind (rows columns)
(array-dimensions matrix)
(let ((result (make-array (list rows columns)
:element-type
(array-element-type matrix))))
(dotimes (i0 rows result)
(dotimes (i1 columns)
(setf
(aref result i0 i1)
(funcall function (aref matrix i0 i1)))))))))
(defun map-into-matrix (result-matrix function &rest matrices)
"Apply FUNCTION on the elements of matrix MAT."
(if matrices
;; The result is built from other matrices.
(destructuring-bind (rows columns)
(%validate-dimensions result-matrix matrices)
(let ((arglist (make-list (length matrices))))
(dotimes (i0 rows result-matrix)
(dotimes (i1 columns)
(setf
(aref result-matrix i0 i1)
(apply function
(map-into arglist
(lambda (mat) (aref mat i0 i1))
matrices)))))))
;; The result is built from a function.
(destructuring-bind (rows columns)
(array-dimensions result-matrix)
(dotimes (i0 rows result-matrix)
(dotimes (i1 columns)
(setf
(aref result-matrix i0 i1)
(funcall function)))))))
;;; FIXME : There are some opportunities for abstraction,
;;; but you get what you pay for.