;;; Lisplab, level1-dge.lisp
;;; Diagonal double-float 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.

;;; TODO: bidiagnonal matrices

;;; Note: not optimzied, but I see no good reason to optimzized them either.

(in-package :lisplab)

(defclass matrix-base-ddi 
    (structure-diagonal
     vector-d
     implementation-base) 
  ())

(defmethod initialize-instance :after ((m matrix-base-ddi) &key dim (value 0))
  (with-slots (rowcols size store) m
    (setf rowcols (if (integerp dim)
		      dim
		      (if (= (car dim) (cadr dim))
			  (car dim)
			  (error "You try to create a non-square diagonal matrix.")))
	  size rowcols)
    (unless store
      (setf store (allocate-real-store rowcols value)))))

(defclass matrix-lisp-ddi (implementation-lisp matrix-base-ddi) ())

(defclass matrix-foreign-ddi (implementation-foreign matrix-lisp-ddi) ())

(defclass matrix-ddi (matrix-foreign-ddi) ())

(defmethod make-matrix-class ((a (eql :d)) (b (eql :di)) (c (eql :base)))
  (find-class 'matrix-base-ddi))

(defmethod make-matrix-class ((a (eql :d)) (b (eql :di)) (c (eql :lisp)))
  (find-class 'matrix-lisp-ddi))

(defmethod make-matrix-class ((a (eql :d)) (b (eql :di)) (c (eql :ffi)))
  (find-class 'matrix-foreign-ddi))

(defmethod make-matrix-class ((a (eql :d)) (b (eql :di)) (c (eql :ffi)))
  (find-class 'matrix-foreign-ddi))

(defmethod make-matrix-class ((a (eql :d)) (b (eql :di)) (c (eql :blas)))
  (find-class 'matrix-foreign-ddi))

(defmethod make-matrix-class ((a (eql :d)) (b (eql :di)) (c (eql :any)))
  (find-class 'matrix-ddi))

;;; Methods spezilied for the diagnoal matrices

(defmethod mref ((matrix matrix-base-ddi) row col)
  (if (= row col)
      (aref (slot-value matrix 'store) row)
      0d0))

(defmethod (setf mref) (value (matrix  matrix-base-ddi) row col)
  (if (= row col)
      (setf (aref (slot-value matrix 'store) row)
	    (coerce value 'double-float))
      (warn "Array out of bonds for diagonal matrix. Ignored.")))