;;; Lisplab, level1-sparse.lisp
;;; General sparse matrices base on hash tables

;;; 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.

;;; Purpose of the sparse matrices is to save space. 
;;; Currently you won't save much time on most operations 
;;; since they by default go through all elements. 

(in-package :lisplab)

(defclass matrix-sparse
    (structure-general element-base implementation-lisp vector-base) 
  ((hash-store
    :initarg :store
    :initform nil
    :reader matrix-hash-store)
   (default-element
    :initarg :default-element 
    :initform nil
    :accessor matrix-default-element))
  (:documentation "A sparse matrix")) 

(defmethod initialize-instance :after ((m matrix-sparse) &key dim (value 0))
  (with-slots (rows cols size hash-store default-element ) m
    (setf rows (car dim)
	  cols (cadr dim)
          size (* rows cols))
    (unless hash-store
      ;; Uses eq as test. It should be safe since the keys are matrix indices 
      ;; and they should be fixnum (or fixnum size) on most platforms. 
      (setf hash-store (make-hash-table :test 'eq))) 
    (unless default-element
      (setf default-element value))))

(defmethod make-matrix-class ((a (eql :any)) (b (eql :any)) (c (eql :any)))
  (find-class 'matrix-sparse))

(defmethod make-matrix-class ((a (eql :any)) (b (eql :any)) (c (eql :lisp)))
  (find-class 'matrix-sparse))

;;; Adds classes to the description system
#+todo-remove(add-matrix-class 'matrix-sparse :any :sparse :any)

(defmethod mref ((matrix matrix-sparse) row col)
  (multiple-value-bind (val ok) 
      (gethash (column-major-idx row col (slot-value matrix 'rows))
	       (slot-value matrix 'hash-store))
    (if ok
	val
	(slot-value matrix 'default-element))))

(defmethod (setf mref) (value (matrix  matrix-sparse) row col)
  (if (eql value (slot-value matrix 'default-element))
      value
      (setf (gethash (column-major-idx row col (slot-value matrix 'rows))
		     (slot-value matrix 'hash-store))
	    value)))
  
(defmethod vref ((matrix  matrix-sparse) idx)
 (multiple-value-bind (val ok) 
      (gethash idx
	       (slot-value matrix 'hash-store))
    (if ok
	val
	(slot-value matrix 'default-element))))

(defmethod (setf vref) (value (matrix matrix-sparse) idx)
 (setf (gethash idx
		(slot-value matrix 'hash-store))
	value))