matlisp-commit

[Akshay S. <ak...@us...>]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "matlisp".

The branch, tensor has been updated
       via  6cfc62a0b8737f16a23c7c971cd5055fefb42750 (commit)
       via  f3b37d1e92b7ee9cf9b508bd98df20df304bb958 (commit)
       via  f235ae0cca3dc81ef9fabf2a35681ffed8505c79 (commit)
       via  f82f9f87566e7359d0ad758dc61dc070cb29a3b0 (commit)
       via  03a936712182f839eec89db4ba08f0708af98dca (commit)
       via  6b070ed0049cd5271379c18e7a08e6f222d3b015 (commit)
       via  749437c8bb376d094b604c6977a7e7c037a522a0 (commit)
       via  8aebe561eef23310bcbb1cb2f93518a68f454231 (commit)
       via  9a4472e4325ca93c9bdbddfedf28de9ee724b6cc (commit)
       via  ae2c399227295cf632250d8ba6b0ddeb984d0cae (commit)
       via  1f0deb99d702dee0b93e3defe2404b307c7b3530 (commit)
      from  f38e6dde50fbe1552793f8146fa42734d522e9c9 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 6cfc62a0b8737f16a23c7c971cd5055fefb42750
Author: Akshay Srinivasan <aks...@gm...>
Date:   Fri Mar 7 00:53:06 2014 -0800

    Removed whitespace in compressed sparse.

diff --git a/src/base/compressed-sparse.lisp b/src/base/compressed-sparse.lisp
index 0f7db62..315a943 100644
--- a/src/base/compressed-sparse.lisp
+++ b/src/base/compressed-sparse.lisp
@@ -133,7 +133,7 @@
 			 :do (setf (aref ni i) r
 				   (aref vi i) v))))
 		  (t/store-set ,clname value (store tensor) idx))
-	      (when (>= idx 0)		
+	      (when (>= idx 0)
 		(let ((ns (neighbour-start tensor))
 		      (ni (neighbour-id tensor))
 		      (vi (store tensor)))
@@ -145,5 +145,5 @@
 				 (aref vi i) (aref vi (1+ i))))
 		    (loop :for i :from (1+ col) :below (length ns)
 		       :do (decf (aref ns i)))))))
-	    value))))	      
+	    value))))
     (setf (ref tensor (if (numberp (car subscripts)) subscripts (car subscripts))) value)))

commit f3b37d1e92b7ee9cf9b508bd98df20df304bb958
Author: Akshay Srinivasan <aks...@gm...>
Date:   Fri Mar 7 00:50:40 2014 -0800

    Added a ref method for compressed sparse matrices.

diff --git a/src/base/compressed-sparse.lisp b/src/base/compressed-sparse.lisp
index c4eb11e..0f7db62 100644
--- a/src/base/compressed-sparse.lisp
+++ b/src/base/compressed-sparse.lisp
@@ -30,7 +30,7 @@
 		 (lb (aref nst col) :type index-type)
 		 (ub (aref nst (1+ col)) :type index-type))
        (declare (type index-type row col))
-       (if (or (= lb ub) (< row (aref nid lb)) (> row (aref nid (1- ub)))) -1
+       (if (or (= lb ub) (< row (aref nid lb)) (> row (aref nid (1- ub)))) (values -1 row col)
 	   (values
 	    (very-quickly
 	      (loop :with j := (ash (+ lb ub) -1)
@@ -87,28 +87,63 @@
 	      (t/store-ref ,clname (store tensor) idx)))))
     (apply #'ref (cons tensor subscripts))))
 
-;; (defmethod (setf ref) (value (tensor compressed-sparse-matrix) &rest subscripts)
-;;   (let ((clname (class-name (class-of tensor))))
-;;     (assert (member clname *tensor-type-leaves*) nil 'tensor-abstract-class :tensor-class clname)
-;;     (compile-and-eval
-;;      `(defmethod (setf ref) (value (tensor ,clname) &rest subscripts)
-;; 	(multiple-value-bind (idx row col) (compressed-sparse-indexing (if (numberp (car subscripts)) subscripts (car subscripts)) tensor)
-;; 	  (if (< idx 0)
-;; 	      (let ((ns (neighbour-start tensor))
-;; 		    (ni (neighbour-id tensor))
-;; 		    (vi (store tensor)))
-;; 		(unless (> (store-size tensor) (aref ns (1- (length ns))))
-;; 		  (let ((sto-new (make-a-bigger-array)))
-;; 		    (move-things forward)
-;; 		    copy-back-to-vi..))
-;; 		(let ((row-data (merge 'list
-;; 				       (cons row (t/coerce ,(field-type clname) value))
-;; 				       (loop :for j :from (aref ns col) :to (aref ns (1+ col))
-;; 					  :collect (cons (aref ni j) (aref vi j)))
-;; 				       #'< :key #'car)))
-		  
-		
-;; 		)
-;; 	      (t/store-set ,clname (t/coerce ,(field-type clname) value) (store tensor) idx)))))
-;;     (setf (ref tensor (if (numberp (car subscripts)) subscripts (car subscripts))) value)))
-;;
+(defmethod (setf ref) (value (tensor compressed-sparse-matrix) &rest subscripts)
+  (let ((clname (class-name (class-of tensor))))
+    (assert (member clname *tensor-type-leaves*) nil 'tensor-abstract-class :tensor-class clname)
+    (compile-and-eval
+     `(defmethod (setf ref) (value (tensor ,clname) &rest subscripts)
+	(multiple-value-bind (idx row col) (compressed-sparse-indexing (if (numberp (car subscripts)) subscripts (car subscripts)) tensor)
+	  (declare (type index-type idx row col))
+	  (let-typed ((value (t/coerce ,(field-type clname) value) :type ,(field-type clname)))
+	    (if (/= value (t/fid+ ,(field-type clname)))
+	      (if (< idx 0)
+		  (let* ((ns (neighbour-start tensor))
+			 (value (t/coerce ,(field-type clname) value))
+			 (row-data (let ((ni (neighbour-id tensor))
+					 (vi (store tensor)))
+				     (merge 'list
+					    (list (cons row value))
+					    (loop :for j :from (aref ns col) :below (aref ns (1+ col))
+					       :collect (cons (aref ni j) (aref vi j)))
+					    #'< :key #'car))))
+		    (unless (> (store-size tensor) (aref ns (1- (length ns))))
+		      (destructuring-bind (ni vi) (t/store-allocator ,clname (dims tensor) (+ (store-size tensor) *default-sparse-store-increment*))
+			(let ((nio (neighbour-id tensor))
+			      (vio (store tensor)))
+			  (very-quickly
+			    (declare (type index-store-vector nio ni ns)
+				     (type ,(store-type clname) vio vi))
+			    (loop :for i :from 0 :below (aref ns col)
+			       :do (setf (aref nio i) (aref ni i)
+					 (aref vio i) (aref vi i)))
+			    (loop :for i :from (aref ns (1+ col)) :below (aref ns (1- (length ns)))
+			       :do (setf (aref nio (1+ i)) (aref ni i)
+					 (aref vio (1+ i)) (aref vi i))))
+			  (setf (slot-value tensor 'neighbour-id) ni
+				(slot-value tensor 'store) vi))))
+		    (let ((ni (neighbour-id tensor))
+			  (vi (store tensor)))
+		      (very-quickly
+			(declare (type index-store-vector ni ns)
+				 (type ,(store-type clname) vi))
+			(loop :for i :from (1+ col) :below (length ns)
+			   :do (incf (aref ns i))))
+		      (loop :for (r . v) :in row-data
+			 :for i := (aref ns col) :then (1+ i)
+			 :do (setf (aref ni i) r
+				   (aref vi i) v))))
+		  (t/store-set ,clname value (store tensor) idx))
+	      (when (>= idx 0)		
+		(let ((ns (neighbour-start tensor))
+		      (ni (neighbour-id tensor))
+		      (vi (store tensor)))
+		  (very-quickly
+		    (declare (type index-store-vector ns ni)
+			     (type ,(store-type clname) vi))
+		    (loop :for i :from idx :below (aref ns (1- (length ns)))
+		       :do (setf (aref ni i) (aref ni (1+ i))
+				 (aref vi i) (aref vi (1+ i))))
+		    (loop :for i :from (1+ col) :below (length ns)
+		       :do (decf (aref ns i)))))))
+	    value))))	      
+    (setf (ref tensor (if (numberp (car subscripts)) subscripts (car subscripts))) value)))
diff --git a/src/base/coordinate-sparse.lisp b/src/base/coordinate-sparse.lisp
index af77ead..6f4b7f2 100644
--- a/src/base/coordinate-sparse.lisp
+++ b/src/base/coordinate-sparse.lisp
@@ -1,9 +1,6 @@
 (in-package :matlisp)
 
 ;;One may to do better than a Hash-table for this.
-(defparameter *default-sparsity* 1/1000)
-(defparameter *max-sparse-size* 10000)
-
 (defclass coordinate-sparse-tensor (sparse-tensor)
   ((strides :initarg :strides :reader strides :type index-store-vector
 	    :documentation "Strides for accesing elements of the tensor.")))
diff --git a/src/base/tweakable.lisp b/src/base/tweakable.lisp
index cab998f..32918db 100644
--- a/src/base/tweakable.lisp
+++ b/src/base/tweakable.lisp
@@ -6,6 +6,21 @@
 ;;that you use lexical scoping to affect local changes to
 ;;code (global variables are only bad if you overwrite them :)
 
+(defparameter *default-sparse-store-increment* 100
+  "
+  Determines the increment by which the store of a compressed sparse matrix is increased,
+  when it runs out of store.")
+
+(defparameter *default-sparsity* 1/1000
+  "
+  Determines the default sparsity for a newly created sparse matrix, when the number of non-zero is
+  not specified.")
+
+(defparameter *max-sparse-size* 10000
+  "
+  Upper bounds the store size for a newly created sparse matrix, when the number of non-zero is
+  not specified.")
+
 ;;Default ordering of strides
 (defparameter *default-stride-ordering* :col-major
   "

commit f235ae0cca3dc81ef9fabf2a35681ffed8505c79
Author: Akshay Srinivasan <aks...@gm...>
Date:   Thu Mar 6 22:43:58 2014 -0800

    Added "ignorable" declarations to deft/method; gets rid of all those annoying style warnings.

diff --git a/src/utilities/template.lisp b/src/utilities/template.lisp
index 4f40e41..d802043 100644
--- a/src/utilities/template.lisp
+++ b/src/utilities/template.lisp
@@ -115,12 +115,17 @@
 			     (error "Undefined template : ~a~%" ',name)))
 	      (,meth-sym (getf ,data-sym :methods))
 	      (,afun-sym (lambda (,(if single? disp-vars disp-sym) ,@args)
-			   ,(recursive-append 
+			   (declare (ignorable ,@(remove-if #'(lambda (x) (char= #\& (aref (symbol-name x) 0)))
+							    (mapcar #'(lambda (x) (if (consp x) (car x) x))
+								    (cons (if single? disp-vars disp-sym) args)))))
+			   ,(recursive-append
 			     (unless single?
-			       `(destructuring-bind (,@disp-vars) ,disp-sym))
+			       `(destructuring-bind (,@disp-vars) ,disp-sym
+				  (declare (ignorable ,@disp-vars))))
 			     `(progn
 				,@body))))
 	      (,sort-sym (getf ,data-sym :sorter)))
+	 (declare (ignorable ,data-sym ,meth-sym ,afun-sym ,sort-sym))
 	 (setf ,meth-sym (topological-sort (setadd ,meth-sym (list ,afun-sym ',disp-spls) #'(lambda (a b) (list-eq (second a) (second b)))) #'(lambda (a b) (funcall ,sort-sym (second a) (second b)))))
 	 (setf (getf ,data-sym :methods) ,meth-sym)
 	 ,afun-sym)))))

commit f82f9f87566e7359d0ad758dc61dc070cb29a3b0
Author: Akshay Srinivasan <aks...@gm...>
Date:   Thu Mar 6 22:14:19 2014 -0800

    Switched from vanilla sort to topological sort to deal with the lack of total ordering on types.

diff --git a/src/blas/copy.lisp b/src/blas/copy.lisp
index 146e1b6..7b3a189 100644
--- a/src/blas/copy.lisp
+++ b/src/blas/copy.lisp
@@ -124,7 +124,7 @@
   (assert (very-quickly (lvec-eq (the index-store-vector (dimensions x)) (the index-store-vector (dimensions y)) #'=)) nil
 	  'tensor-dimension-mismatch))
 
-(defmethod :before copy! ((a sparse-tensor) (b sparse-tensor))
+(defmethod copy! :before ((a base-tensor) (b compressed-sparse-matrix))
   (assert (< (store-size a) (store-size b)) nil 'tensor-insufficient-store))
 
 (defmethod copy! ((x standard-tensor) (y standard-tensor))
diff --git a/src/utilities/template.lisp b/src/utilities/template.lisp
index f11fe68..4f40e41 100644
--- a/src/utilities/template.lisp
+++ b/src/utilities/template.lisp
@@ -6,6 +6,37 @@
 
 (defvar *template-table* (make-hash-table))
 
+(defun topological-sort (lst func &optional (test #'eql))
+  (multiple-value-bind (nlst len) (loop :for ele :in lst
+				     :for i := 0 :then (1+ i)
+				     :collect (cons i ele) :into ret
+				     :finally (return (values ret (1+ i))))
+    (let* ((S nil)
+	   (graph (let ((ret (make-array len)))
+		    (loop :for (i . ele) :in nlst
+		       :do (let ((children (mapcar #'car (remove-if-not #'(lambda (x) (and (not (funcall test (cdr x) ele)) (funcall func (cdr x) ele))) nlst)))
+				 (parents (mapcar #'car (remove-if-not #'(lambda (x) (and (not (funcall test (cdr x) ele)) (funcall func ele (cdr x)))) nlst))))
+			     (when (null parents)
+			       (push i S))
+			     (setf (aref ret i) (list ele children parents))))
+		    ret))
+	   (ordering nil))
+    (let ((last-S (last S)))
+      (do ((slst S (cdr slst)))
+	  ((null slst))
+	(let* ((i (car slst))
+	       (children (second (aref graph i))))
+	  (mapcar #'(lambda (x)
+		      (let ((par (third (aref graph x))))
+			(let ((par (remove i par)))
+			  (setf (third (aref graph x)) par)
+			  (when (null par)
+			    (setf (cdr last-S) (cons x nil)
+				  last-S (cdr last-S))))))
+		  children)
+	  (push i ordering))))
+    (mapcar #'(lambda (x) (car (aref graph x))) ordering))))
+
 (defun match-lambda-lists (lsta lstb)
   (let ((optional? nil))
     (labels ((optp? (a b)
@@ -90,7 +121,7 @@
 			     `(progn
 				,@body))))
 	      (,sort-sym (getf ,data-sym :sorter)))
-	 (setf ,meth-sym (sort (setadd ,meth-sym (list ,afun-sym ',disp-spls) #'(lambda (a b) (list-eq (second a) (second b)))) #'(lambda (a b) (funcall ,sort-sym (second a) (second b)))))
+	 (setf ,meth-sym (topological-sort (setadd ,meth-sym (list ,afun-sym ',disp-spls) #'(lambda (a b) (list-eq (second a) (second b)))) #'(lambda (a b) (funcall ,sort-sym (second a) (second b)))))
 	 (setf (getf ,data-sym :methods) ,meth-sym)
 	 ,afun-sym)))))
 

commit 03a936712182f839eec89db4ba08f0708af98dca
Author: Akshay Srinivasan <aks...@gm...>
Date:   Tue Mar 4 02:13:21 2014 -0800

    Saving state on the sparse tensor.

diff --git a/matlisp.asd b/matlisp.asd
index a356b04..92f4b31 100644
--- a/matlisp.asd
+++ b/matlisp.asd
@@ -126,12 +126,15 @@
 			 (:file "blas-helpers"
 				:depends-on ("standard-tensor" "permutation"))
 			 (:file "print"
-				:depends-on ("standard-tensor"))))
+				:depends-on ("base-tensor" "standard-tensor"))
+			 (:file "coordinate-sparse")
+			 (:file "compressed-sparse")))
 
    (:module "matlisp-classes"
 	    :pathname "classes"
 	    :depends-on ("matlisp-base")
 	    :components ((:file "numeric")
+			 (:file "sparse")
 			 #+maxima
 			 (:file "symbolic-tensor")
 			 (:file "matrix"
diff --git a/src/base/compressed-sparse.lisp b/src/base/compressed-sparse.lisp
index 85b65d3..c4eb11e 100644
--- a/src/base/compressed-sparse.lisp
+++ b/src/base/compressed-sparse.lisp
@@ -24,41 +24,41 @@
 	(setf row (the index-type (aref subs 0))
 	      col (the index-type (aref subs 1)))))
      (when (transpose? tensor)
-       (rotatef row col))     
-     (let*-typed ((nst (neighbour-start tensor) :type index-store-vector)
-		  (nid (neighbour-id tensor) :type index-store-vector)
-		  (lb (aref nst col) :type index-type)
-		  (ub (aref nst (1+ col)) :type index-type))
+       (rotatef row col))
+    (let*-typed ((nst (neighbour-start tensor) :type index-store-vector)
+		 (nid (neighbour-id tensor) :type index-store-vector)
+		 (lb (aref nst col) :type index-type)
+		 (ub (aref nst (1+ col)) :type index-type))
        (declare (type index-type row col))
        (if (or (= lb ub) (< row (aref nid lb)) (> row (aref nid (1- ub)))) -1
-	   (very-quickly
-	     (loop :with j := (ash (+ lb ub) -1)
-		:repeat 64
-		:do (progn
-		      #+nil(format t "~a, ~a, ~a~%" lb j ub)
-		      (cond
-			((= (aref nid j) row) (return j))
-			((>= lb (1- ub)) (return -1))
-			(t
-			 (if (< row (aref nid j))
-			     (setf ub j)
-			     (setf lb (1+ j)))
-			 (setf j (ash (+ lb ub) -1)))))))))))
-
-(deft/method t/store-allocator (sym compressed-sparse-matrix) (size &optional initial-element)
-  (let ((sto-type (store-element-type sym)))
-    (using-gensyms (decl (size))
-      `(let (,@decl)
-	 (destructuring-bind (ni nz) (t/compute-store-size ,sym ,size)
-	   (list
-	    (allocate-index-store (1+ ni))
-	    (allocate-index-store nz)
-	    (make-array nz :element-type ',sto-type :initial-element ,(if (subtypep sto-type 'number) `(t/fid+ ,sto-type) nil))))))))
+	   (values
+	    (very-quickly
+	      (loop :with j := (ash (+ lb ub) -1)
+		 :repeat 64
+		 :do (progn
+		       #+nil(format t "~a, ~a, ~a~%" lb j ub)
+		       (cond
+			 ((= (aref nid j) row) (return j))
+			 ((>= lb (1- ub)) (return -1))
+			 (t
+			  (if (< row (aref nid j))
+			      (setf ub j)
+			      (setf lb (1+ j)))
+			  (setf j (ash (+ lb ub) -1)))))))
+	    row col)))))
+
+;;Templates
+(deft/method t/store-allocator (cl compressed-sparse-matrix) (size &optional nz)
+  (let ((sto-type (store-element-type cl)))
+    `(destructuring-bind (nr nc) ,size
+       (let ((nz (or ,nz (min (ceiling (* nr nc *default-sparsity*)) *max-sparse-size*))))
+	 (list
+	  (allocate-index-store nz)
+	  (make-array (t/compute-store-size ,cl nz) :element-type ',sto-type :initial-element ,(if (subtypep sto-type 'number) `(t/fid+ ,sto-type) nil)))))))
 
 (deft/method t/compute-store-size (sym compressed-sparse-matrix) (size)
-  `(destructuring-bind (nr nc &optional nz) ,size
-     (list nc (or nz (min (ceiling (* nr nc *default-sparsity*)) *max-sparse-size*)))))
-
+  size)
+;;
 (deft/method t/store-type (sym compressed-sparse-matrix) (&optional (size '*))
   `(simple-array ,(store-element-type sym) (,size)))
 
@@ -66,122 +66,49 @@
    (assert (null (cdr idx)) nil "given more than one index for compressed-store")
   `(aref (the ,(store-type sym) ,store) (the index-type ,(car idx))))
 
-(deft/method t/store-size (sym compressed-sparse-matrix) (ele)
-  `(length ,ele))
-
-(deft/method t/store-element-type (sym compressed-sparse-matrix) ()
-  (macroexpand `(t/field-type ,sym)))
-
-;;
 (deft/method t/store-set (sym compressed-sparse-matrix) (value store &rest idx)
    (assert (null (cdr idx)) nil "given more than one index for compressed store")
   `(setf (aref (the ,(store-type sym) ,store) (the index-type ,(car idx))) (the ,(field-type sym) ,value)))
-;; (deft/method t/store-set (sym coordinate-sparse-tensor) (value store &rest idx)
-;;    (assert (null (cdr idx)) nil "given more than one index for hashtable.")
-;;    (with-gensyms (val)
-;;      `(let-typed ((,val ,value :type ,(field-type sym)))
-;; 	(unless (t/f= ,(field-type sym) ,val (t/fid+ ,(field-type sym)))
-;; 	  (setf (gethash ,(car idx) ,store) (the ,(field-type sym) ,value))))))
 
+(deft/method t/store-size (sym compressed-sparse-matrix) (ele)
+  `(length ,ele))
 
+(deft/method t/store-element-type (sym compressed-sparse-matrix) ()
+  (macroexpand `(t/field-type ,sym)))
 ;;
 (defmethod ref ((tensor compressed-sparse-matrix) &rest subscripts)
   (let ((clname (class-name (class-of tensor))))
     (assert (member clname *tensor-type-leaves*) nil 'tensor-abstract-class :tensor-class clname)
     (compile-and-eval
-     `(defmethod ref ((tensor ,clname) &rest subscripts)	
+     `(defmethod ref ((tensor ,clname) &rest subscripts)
 	(let ((idx (compressed-sparse-indexing (if (numberp (car subscripts)) subscripts (car subscripts)) tensor)))
 	  (if (< idx 0)
 	      (t/sparse-fill ,clname)
 	      (t/store-ref ,clname (store tensor) idx)))))
     (apply #'ref (cons tensor subscripts))))
 
-#+nil
-(defmethod (setf ref) (value (tensor compressed-sparse-matrix) &rest subscripts)
-  (let ((clname (class-name (class-of tensor))))
-    (assert (member clname *tensor-type-leaves*) nil 'tensor-abstract-class :tensor-class clname)
-    (compile-and-eval
-     `(defmethod (setf ref) (value (tensor ,clname) &rest subscripts)
-	(let* ((subs (if (numberp (car subscripts)) subscripts (car subscripts)))
-	       (idx (store-indexing subs tensor))
-	       (sto (store tensor)))
-	  (t/store-set ,clname (t/coerce ,(field-type clname) value) sto idx)
-	  (t/store-ref ,clname sto idx))))
-    (setf (ref tensor (if (numberp (car subscripts)) subscripts (car subscripts))) value)))
-;;
-(defleaf real-compressed-sparse-matrix (compressed-sparse-matrix) ())
-(deft/method t/field-type (sym real-compressed-sparse-matrix) ()
-  'double-float)
-
+;; (defmethod (setf ref) (value (tensor compressed-sparse-matrix) &rest subscripts)
+;;   (let ((clname (class-name (class-of tensor))))
+;;     (assert (member clname *tensor-type-leaves*) nil 'tensor-abstract-class :tensor-class clname)
+;;     (compile-and-eval
+;;      `(defmethod (setf ref) (value (tensor ,clname) &rest subscripts)
+;; 	(multiple-value-bind (idx row col) (compressed-sparse-indexing (if (numberp (car subscripts)) subscripts (car subscripts)) tensor)
+;; 	  (if (< idx 0)
+;; 	      (let ((ns (neighbour-start tensor))
+;; 		    (ni (neighbour-id tensor))
+;; 		    (vi (store tensor)))
+;; 		(unless (> (store-size tensor) (aref ns (1- (length ns))))
+;; 		  (let ((sto-new (make-a-bigger-array)))
+;; 		    (move-things forward)
+;; 		    copy-back-to-vi..))
+;; 		(let ((row-data (merge 'list
+;; 				       (cons row (t/coerce ,(field-type clname) value))
+;; 				       (loop :for j :from (aref ns col) :to (aref ns (1+ col))
+;; 					  :collect (cons (aref ni j) (aref vi j)))
+;; 				       #'< :key #'car)))
+		  
+		
+;; 		)
+;; 	      (t/store-set ,clname (t/coerce ,(field-type clname) value) (store tensor) idx)))))
+;;     (setf (ref tensor (if (numberp (car subscripts)) subscripts (car subscripts))) value)))
 ;;
-(defmethod :before copy! ((a sparse-tensor) (b sparse-tensor))
-  (assert (< (store-size a) (store-size b)) nil 'tensor-insufficient-store))
-
-(deft/method t/zeros (class compressed-sparse-matrix) (dims &optional nz)
-  `(destructuring-bind (vi vr vd) (t/store-allocator ,class (append ,dims ,@(when nz `((list ,nz)))))
-     (make-instance ',class
-		    :dimensions (make-index-store ,dims)
-		    :neighbour-start vi
-		    :neighbour-id vr
-		    :store vd)))
-
-(defmethod copy! ((x coordinate-sparse-tensor) (y compressed-sparse-matrix))
-  (let ((clx (class-name (class-of x)))
-	(cly (class-name (class-of y))))
-    (assert (and (member clx *tensor-type-leaves*)
-		 (member cly *tensor-type-leaves*))
-	    nil 'tensor-abstract-class :tensor-class (list clx cly))
-    (compile-and-eval
-     `(defmethod copy! ((x ,clx) (y ,cly))
-	(let-typed ((stds (strides x) :type index-store-vector))
-	  (assert (and (tensor-matrixp x) (= (aref stds 0) 1)) nil 'tensor-invalid-stride-value)
-	  (let ((col-stride (aref stds 1))
-		(row-data (make-array (ncols x) :initial-element nil)))
-	    (very-quickly
-	      (loop :for key :being :the :hash-keys :of (store x)
-		 :using (hash-value value)
-		 :do (multiple-value-bind (c r) (floor (the index-type key) col-stride)
-		       (push (cons r value) (aref row-data c)))))
-	    (let-typed ((vi (neighbour-start y) :type index-store-vector)
-			(vr (neighbour-id y) :type index-store-vector)
-			(vd (store y) :type ,(store-type cly)))
-	      (setf (aref vi 0) 0)
-	      (very-quickly
-		(loop :for i :from 0 :below (ncols x)
-		   :with col-stop := 0
-		   :do (let ((rowd (sort (aref row-data i) #'(lambda (x y) (< (the index-type x) (the index-type y))) :key #'car)))
-			 (loop :for (r . v) :in rowd
-			    :do (locally
-				    (declare (type ,(field-type clx) v))
-				  (setf (aref vr col-stop) r)
-				  (t/store-set real-compressed-sparse-matrix (t/coerce ,(field-type cly) v) vd col-stop)
-				  (incf col-stop)))
-			 (setf (aref vi (1+ i)) col-stop)))))
-	    y))))
-    (copy! x y)))
-
-(defmethod copy-generic ((a sparse-tensor) (type (eql 'real-compressed-sparse-matrix)))
-  (let-typed ((stds (strides a) :type index-store-vector))
-    (assert (and (tensor-matrixp a) (= (aref stds 0) 1)) nil 'tensor-not-matrix)
-    (let ((col-stride (aref stds 1))
-	  (row-data (make-array (ncols a) :initial-element nil)))
-      (loop :for key :being :the :hash-keys :of (store a)
-	 :using (hash-value value)
-	 :do (multiple-value-bind (c r) (floor key col-stride)
-	       (push (cons r value) (aref row-data c))))
-      (destructuring-bind (vi vr vd) (t/store-allocator real-compressed-sparse-matrix (append (dims a) (list (store-size a))))
-	(setf (aref vi 0) 0)
-	(loop :for i :from 0 :below (ncols a)
-	   :with col-stop := 0
-	   :do (let ((rowd (sort (aref row-data i) #'< :key #'car)))
-		 (loop :for (r . v) :in rowd
-		    :do (progn
-			  (setf (aref vr col-stop) r
-				(aref vd col-stop) v)
-			  (incf col-stop)))
-		 (setf (aref vi (1+ i)) col-stop)))
-	(make-instance 'real-compressed-sparse-matrix
-		       :dimensions (copy-seq (dimensions a))
-		       :neighbour-start vi
-		       :neighbour-id vr
-		       :store vd)))))
diff --git a/src/base/coordinate-sparse.lisp b/src/base/coordinate-sparse.lisp
index 2365eb0..af77ead 100644
--- a/src/base/coordinate-sparse.lisp
+++ b/src/base/coordinate-sparse.lisp
@@ -12,9 +12,9 @@
 (deft/method t/sparse-fill (sym sparse-tensor) ()
  `(t/fid+ (t/field-type ,sym)))
 
-(deft/method t/store-allocator (sym coordinate-sparse-tensor) (size &optional initial-element)
+(deft/method t/store-allocator (sym coordinate-sparse-tensor) (size &optional nz)
   (with-gensyms (size-sym)
-    `(let ((,size-sym (t/compute-store-size ,sym ,size)))
+    `(let ((,size-sym (or ,nz (min (max sb-impl::+min-hash-table-size+ (ceiling (/ ,size *default-sparsity*))) *max-sparse-size*))))
        (make-hash-table :size ,size-sym))))
 
 (deft/method t/store-ref (sym coordinate-sparse-tensor) (store &rest idx)
@@ -37,16 +37,8 @@
 (deft/method t/store-type (sym coordinate-sparse-tensor) (&optional (size '*))
   'hash-table)
 
-(deft/method t/compute-store-size (sym coordinate-sparse-tensor) (size)
- `(max (min sb-impl::+min-hash-table-size+ (ceiling (/ ,size *default-sparsity*))) *max-sparse-size*))
-
 (defmethod head ((tensor coordinate-sparse-tensor))
   0)
-;firefox;
-(defleaf real-coordinate-sparse-tensor (coordinate-sparse-tensor) ())
-
-(deft/method t/field-type (sym real-coordinate-sparse-tensor) ()
-  'double-float)
 ;;
 (defmethod ref ((tensor coordinate-sparse-tensor) &rest subscripts)
   (let ((clname (class-name (class-of tensor))))
@@ -69,14 +61,3 @@
 	  (t/store-ref ,clname sto idx))))
     (setf (ref tensor (if (numberp (car subscripts)) subscripts (car subscripts))) value)))
 ;;
-
-(deft/method t/zeros (class coordinate-sparse-tensor) (dims &optional initial-element)
-  (with-gensyms (astrs adims sizs)
-    `(let* ((,adims (make-index-store ,dims)))
-       (declare (type index-store-vector ,adims))
-       (multiple-value-bind (,astrs ,sizs) (make-stride-cmj ,adims)
-	 (declare (type index-store-vector ,astrs))
-	 (make-instance ',class
-			:dimensions ,adims
-			:strides ,astrs
-			:store (t/store-allocator ,class ,sizs))))))
diff --git a/src/base/sparse-tensor.lisp b/src/base/sparse-tensor.lisp
deleted file mode 100644
index e69de29..0000000
diff --git a/src/blas/copy.lisp b/src/blas/copy.lisp
index af584dd..146e1b6 100644
--- a/src/blas/copy.lisp
+++ b/src/blas/copy.lisp
@@ -124,6 +124,9 @@
   (assert (very-quickly (lvec-eq (the index-store-vector (dimensions x)) (the index-store-vector (dimensions y)) #'=)) nil
 	  'tensor-dimension-mismatch))
 
+(defmethod :before copy! ((a sparse-tensor) (b sparse-tensor))
+  (assert (< (store-size a) (store-size b)) nil 'tensor-insufficient-store))
+
 (defmethod copy! ((x standard-tensor) (y standard-tensor))
   (let ((clx (class-name (class-of x)))
 	(cly (class-name (class-of y))))
@@ -149,6 +152,41 @@
        (error "Don't know how to copy from ~a to ~a" clx cly))))
   (copy! x y))
 
+(defmethod copy! ((x coordinate-sparse-tensor) (y compressed-sparse-matrix))
+  (let ((clx (class-name (class-of x)))
+	(cly (class-name (class-of y))))
+    (assert (and (member clx *tensor-type-leaves*)
+		 (member cly *tensor-type-leaves*))
+	    nil 'tensor-abstract-class :tensor-class (list clx cly))
+    (compile-and-eval
+     `(defmethod copy! ((x ,clx) (y ,cly))
+	(let-typed ((stds (strides x) :type index-store-vector))
+	  (assert (and (tensor-matrixp x) (= (aref stds 0) 1)) nil 'tensor-invalid-stride-value)
+	  (let ((col-stride (aref stds 1))
+		(row-data (make-array (ncols x) :initial-element nil)))
+	    (very-quickly
+	      (loop :for key :being :the :hash-keys :of (store x)
+		 :using (hash-value value)
+		 :do (multiple-value-bind (c r) (floor (the index-type key) col-stride)
+		       (push (cons r value) (aref row-data c)))))
+	    (let-typed ((vi (neighbour-start y) :type index-store-vector)
+			(vr (neighbour-id y) :type index-store-vector)
+			(vd (store y) :type ,(store-type cly)))
+	      (setf (aref vi 0) 0)
+	      (very-quickly
+		(loop :for i :from 0 :below (ncols x)
+		   :with col-stop := 0
+		   :do (let ((rowd (sort (aref row-data i) #'(lambda (x y) (< (the index-type x) (the index-type y))) :key #'car)))
+			 (loop :for (r . v) :in rowd
+			    :do (locally
+				    (declare (type ,(field-type clx) v))
+				  (setf (aref vr col-stop) r)
+				  (t/store-set real-compressed-sparse-matrix (t/coerce ,(field-type cly) v) vd col-stop)
+				  (incf col-stop)))
+			 (setf (aref vi (1+ i)) col-stop)))))
+	    y))))
+    (copy! x y)))
+
 (defmethod copy! ((x t) (y standard-tensor))
   (let ((cly (class-name (class-of y))))
     (assert (and (member cly *tensor-type-leaves*))
@@ -178,4 +216,10 @@
     ((or (not type) (subtypep type 'standard-tensor))
      (let ((ret (zeros (dimensions tensor) (or type (class-of tensor)))))
        (copy! tensor ret)))))
-  
+
+(defmethod copy-generic ((tensor sparse-tensor) type)
+  (cond
+    ((or (not type) (subtypep type 'sparse-tensor))
+     (let ((ret (zeros (dimensions tensor) (or type (class-of tensor)) (store-size tensor))))
+       (copy! tensor ret)))))
+
diff --git a/src/blas/maker.lisp b/src/blas/maker.lisp
index cffe047..797b623 100644
--- a/src/blas/maker.lisp
+++ b/src/blas/maker.lisp
@@ -13,9 +13,32 @@
 			:strides ,astrs
 			:store (t/store-allocator ,class ,sizs ,@(when initial-element `((t/coerce ,(field-type class) ,initial-element)))))))))
 
+(deft/method t/zeros (class coordinate-sparse-tensor) (dims &optional nz)
+  (with-gensyms (astrs adims sizs)
+    `(let* ((,adims (make-index-store ,dims)))
+       (declare (type index-store-vector ,adims))
+       (multiple-value-bind (,astrs ,sizs) (make-stride-cmj ,adims)
+	 (declare (type index-store-vector ,astrs))
+	 (make-instance ',class
+			:dimensions ,adims
+			:strides ,astrs
+			:store (t/store-allocator ,class ,sizs ,nz))))))
+
+(deft/method t/zeros (class compressed-sparse-matrix) (dims &optional nz)
+  (with-gensyms (dsym)
+    `(let ((,dsym ,dims))
+       (destructuring-bind (vr vd) (t/store-allocator ,class ,dsym ,nz)
+	 (make-instance ',class
+			:dimensions (make-index-store ,dims)
+			:neighbour-start (allocate-index-store (1+ (second ,dsym)))
+			:neighbour-id vr
+			:store vd)))))
+
 ;;
 (defgeneric zeros-generic (dims dtype &optional initial-element)
-  (:documentation "A generic version of @func{zeros}.")
+  (:documentation "
+    A generic version of @func{zeros}.
+")
   (:method ((dim...
 
[truncated message content]