;;; Lisplab, level1-dge.lisp ;;; General, untyped matrices ;;; Copyright (C) 2009 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) ;;;; General matrices with unspecified element types (defclass matrix-ge (structure-general vector-any implementation-lisp) () (:documentation "A full matrix (rows x cols) with unspecified matrix element types.")) (defmethod make-matrix-class ((a (eql :any)) (b (eql :ge)) (c (eql :any))) (find-class 'matrix-ge)) (defmethod initialize-instance :after ((m matrix-ge) &key dim (value 0)) (with-slots (rows cols size store) m (setf rows (car dim) cols (cadr dim) size (* rows cols)) (unless store (setf store (make-array size :initial-element value))))) ;;; Level methods specialized for untyped, general matrices (defmethod print-object ((matrix matrix-ge) stream) (if (not *lisplab-print-size*) (call-next-method) (progn (format stream "~&#mm(" ) (print-matrix-contents matrix :stream stream :pr (if *lisplab-element-printer* *lisplab-element-printer* (lambda (x stream) (format stream "~a" x))) :rmax (if (eq *lisplab-print-size* t) (rows matrix) *lisplab-print-size*) :cmax (if (eq *lisplab-print-size* t) (cols matrix) *lisplab-print-size*) :indent 4 :braket-p t) (format stream ")" )))) (defmethod mref ((matrix matrix-ge) row col) (aref (slot-value matrix 'store) (column-major-idx row col (slot-value matrix 'rows)))) (defmethod (setf mref) (value (matrix matrix-ge) row col) (setf (aref (slot-value matrix 'store) (column-major-idx row col (slot-value matrix 'rows))) value))