Menu
▾
▴
matlisp-commit
|
From: Akshay S. <ak...@us...> - 2014-05-05 17:25:34
|
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 5b7710825010f450b71da9d0cbfb27411a86994e (commit)
via a596730f7a5d3c3d65335ce032e8ffc3df557837 (commit)
via 8b18fb736d6bae9c0fd16a0faa51efed07afb294 (commit)
via f4e59e53ce5f2de3462c3c554f6bd075b3f30b6b (commit)
via 6d0ed7f102650f8c775144d91c7e38901fa51ff9 (commit)
via b668733e8899254c129a7b1d109b4a229aa95246 (commit)
via c81e3b9bbaf654e5d5cf4b9082d013b6e0b9b1d4 (commit)
via 8e9e139ab7884f3811834aba6c9eb5d25c1c79e3 (commit)
via 56b707f789c453e157d0818fc8fcf0a16a699db8 (commit)
via 3caa822f9516b69bc5aba4bd2cb840a05b09e48b (commit)
via 3afe61642a8951b86133c79e1fbd19839f48b8b8 (commit)
via 0d327c3a710ab3bce416b0ac48093557e073e6b4 (commit)
via f907ad7cfb43867bce9af5226162e4d9509d9a00 (commit)
via abb0a6f58d54ca9629afef9e56afbc41041ebb14 (commit)
via bd8ba7b1d0ba2971f28a1690fdea106397a90d04 (commit)
via e4f79071c3818c46ee389c04e01cc086497966e9 (commit)
via 5e67db6057fd19bc32ff2391f2e2a1aa278448b5 (commit)
via a81b698f2e9335043ee0415bbb2cf5e8539c66e8 (commit)
via 6747a6d64abbad33df475d238be0be94a616df9d (commit)
via adf629e94fee94dd32c4741ecec91c7567a6049a (commit)
via f527df432b77c0cd1d129ac04c2ef388a6521622 (commit)
via 165d6ea255110612466567fab0f1d6b7352f0f65 (commit)
via e8da7463cc4af5a1ebb34f4f583e3fdf4612fcfa (commit)
via 9cb26abe19d52ce5bb7fc1873a6870ebde9954a7 (commit)
via 536427a4451d57ba660ed0dd09771ddcfc1b84ad (commit)
via a195dc65fdc34de0b32109511a06059f2eefa701 (commit)
via e9f2199b996e73e9e5f3a4836d28100bddb5dd04 (commit)
via 72f1265aef1909ad6ae4ba8221a1b13374fd0036 (commit)
via 312979c7214c49f9c0a2ffd29a27557be73ea104 (commit)
via a1b8de0759bc21deecec1b44462dbb022f30c768 (commit)
via 313c41e3170fff67f8495ddac3fc084d0dbbeb92 (commit)
via 2a305a1aabb5d33c5c1967e257d3802d66e2c0fc (commit)
via 59cc9209020a6f3f22a04760a7af7292b8959526 (commit)
via 25502e745746d57cb0255579aad4c3fad9cbb206 (commit)
via e7b1e34c36d42dd0a7d651b3ec3f4dee514dd44b (commit)
via e5d57952737b7558a81583609ae97dbd77b9b557 (commit)
via 6e9a51f360bdf55d86c0c905e836daeaa98f7bc3 (commit)
via 5f6a1194181a0702e3f8a67f401ef34eb8863c36 (commit)
via 0fad8e8adfab324824eb5be7bda579ed366f0a89 (commit)
via fb6d6c916959ee249a6d1e4726019307bdb29f0a (commit)
via 144f7817e8eb11597f795a76dbda9c6371b61c0b (commit)
via b301eaf23d1815d9d1521ceebf0d669e98f3170a (commit)
via f98c528e0f88148fe96c5c34cd085a0281bdd9fa (commit)
via 5b3e1bbdcd79e00b2dcd251d85dcd42f7e333cdd (commit)
via a6b74d7ce09d42adeeab287b8a4cce1fd47c58cb (commit)
via 24b661d49484fd9774bebf80c07c6dc836f69779 (commit)
via 731e677c5e9d7eb73033fbcbb78be1ab2987d5b0 (commit)
via c14d06055ad9164df1e9fe34ea2d285722134772 (commit)
via e17ae2b44b5956cb4a4ec3339273f1e208f501ae (commit)
via 1560a36faab44c6f9d293c57693045ebd21ca96b (commit)
via 5461bd2ef8e0e6b06b3977117de61d13d531600d (commit)
via 8198d66eaf11fef2717f452c4c41da00a2e1b429 (commit)
via 33d2c5fd06d3e60aead58431e268a2e42d7ea367 (commit)
via 9dc526079f9cc2b5a9e5c57d7c4b54236a385263 (commit)
via 6a5d74a7599f4ca6a8afcfaadfdc7b0c3c237bbd (commit)
via 7d21471d9da7de10e6a830dc0259efc17e8aa840 (commit)
via 3c4398cc36783ea7a321fbdc331b1160c35bebb4 (commit)
via 00de47b9b5cb595a23b37e2d98d2f2fdeb92dcba (commit)
via dd1f88674eb90b3af6743dae3cb48fcbf73b9a9a (commit)
via b34c2cbf5974f6f7f5c20dbb86a424cdcd88fd50 (commit)
via b3efc3a5938126c1010dec87d2a9d8b35d42b5ec (commit)
via c4f19e17ff8eaa53b4dc52ad6054fa0611700a66 (commit)
via 6833afe74673a047fa5916c95d91b76a1e449028 (commit)
via 0a01c0e5591324a538b86cbe8405e7a7f6639034 (commit)
via 5b70afc8934b8ca3116fd79b78eaa2a244f8d60c (commit)
via d085bd096912a652b2a620821669f7dea5b5649e (commit)
via 8df18050e19d4de26f326c870454f46af872de12 (commit)
via cb63f4927ad9d371a675ddc995df9119bc7afc17 (commit)
via 9621836c207ba1fe67ef27eb0f5f1d4b7287d849 (commit)
from 6cfc62a0b8737f16a23c7c971cd5055fefb42750 (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 5b7710825010f450b71da9d0cbfb27411a86994e
Author: Akshay Srinivasan <ak...@cs...>
Date: Sat May 3 17:24:20 2014 -0700
Added fibonacci.lisp to ASDF.
diff --git a/matlisp.asd b/matlisp.asd
index f6bccd0..5624aa8 100644
--- a/matlisp.asd
+++ b/matlisp.asd
@@ -188,7 +188,11 @@
(:module "matlisp-reader"
:pathname "reader"
:components ((:file "infix")
- (:file "loadsave")))))
+ (:file "loadsave")))
+ (:module "matlisp-graph"
+ :pathname "graph"
+ :depends-on ("matlisp-base" "matlisp-classes" "matlisp-blas" "matlisp-lapack")
+ :components ((:file "fibonacci")))))
;; (defclass f2cl-cl-source-file (asdf:cl-source-file)
commit a596730f7a5d3c3d65335ce032e8ffc3df557837
Author: Akshay Srinivasan <aks...@gm...>
Date: Sat May 3 17:19:20 2014 -0700
Added cs-matrix -> standard tensor copy method.
diff --git a/src/blas/copy.lisp b/src/blas/copy.lisp
index 29b2c73..35df0b3 100644
--- a/src/blas/copy.lisp
+++ b/src/blas/copy.lisp
@@ -102,7 +102,24 @@
,y))))
;;
-;;(t/copy! (real-coordinate-sparse-tensor real-compressed-sparse-matrix) x y)
+(deft/method t/copy! ((clx t) (cly standard-tensor)) (x y)
+ (using-gensyms (decl (x y))
+ (with-gensyms (sto-y of-y idx cx)
+ `(let* (,@decl
+ (,sto-y (store ,y))
+ (,cx (t/coerce ,(field-type cly) ,x)))
+ (declare (type ,cly ,y)
+ (type ,(field-type cly) ,cx)
+ (type ,(store-type cly) ,sto-y))
+ ;;This should be safe
+ (very-quickly
+ (mod-dotimes (,idx (dimensions ,y))
+ :with (linear-sums
+ (,of-y (strides ,y) (head ,y)))
+ :do (t/store-set ,cly ,cx ,sto-y ,of-y)))
+ ,y))))
+
+;;
(deft/method t/copy! ((clx coordinate-sparse-tensor) (cly compressed-sparse-matrix)) (x y)
(using-gensyms (decl (x y) (rstd cstd rdat key value r c s? v vi vr vd i col-stop row))
`(let (,@decl)
@@ -116,7 +133,7 @@
:do (multiple-value-bind (,c ,r) (floor (the index-type ,key) ,cstd)
(multiple-value-bind (,r ,s?) (floor (the index-type ,r) ,rstd)
(when (zerop ,s?)
- (push (cons ,c (t/coerce ,(field-type cly) ,value)) (aref ,rdat ,r))))))
+ (push (cons ,c `(t/strict-coerce (,(field-type clx) ,(field-type cly)) ,value)) (aref ,rdat ,r))))))
(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) ,cstd)
@@ -141,6 +158,25 @@
(setf (aref ,vi (1+ ,i)) ,col-stop)))))
,y))))
+(deft/method t/copy! ((clx compressed-sparse-matrix) (cly standard-tensor)) (x y)
+ (using-gensyms (decl (x y) (vi vr vd i j))
+ `(let (,@decl)
+ (declare (type ,clx ,x) (type ,cly ,y))
+ (copy! (t/fid+ ,(field-type cly)) ,y)
+ (let-typed ((,vi (neighbour-start ,x) :type index-store-vector)
+ (,vr (neighbour-id ,x) :type index-store-vector)
+ (,vd (store ,x) :type ,(store-type clx)))
+ (if (transpose? ,x)
+ (very-quickly
+ (loop :for ,j :from 0 :below (length ,vi)
+ :do (loop :for ,i :from (aref ,vi ,j) :below (aref ,vi (1+ ,j))
+ :do (setf (ref ,y ,j (aref ,vr ,i)) (t/strict-coerce (,(field-type clx) ,(field-type cly)) (aref ,vd ,i))))))
+ (very-quickly
+ (loop :for ,j :from 0 :below (length ,vi)
+ :do (loop :for ,i :from (aref ,vi ,j) :below (aref ,vi (1+ ,j))
+ :do (setf (ref ,y (aref ,vr ,i) ,j) (t/strict-coerce (,(field-type clx) ,(field-type cly)) (aref ,vd ,i))))))))
+ ,y)))
+
;; (deft/method t/copy! ((clx compressed-sparse-matrix) (cly coordinate-sparse-tensor)) (x y)
;; (using-gensyms (decl (x y) (cstd rdat key value r c v vi vr vd i col-stop row))
;; `(let (,@decl)
@@ -150,8 +186,7 @@
;; (,vd (store ,x) :type ,(store-type cly)))
;; (loop :for i :from 0 :below (1- (length ,vi))
;; :do (loop :for j :from (aref ,vi i) :below (aref ,vi (1+ i))
-;; :do (setf
-
+;; :do (setf
;; (let ((,cstd (aref (strides ,x) 1))
;; (,rdat (make-array (ncols ,x) :initial-element nil)))
;; (loop :for ,key :being :the :hash-keys :of (store ,x)
@@ -173,22 +208,6 @@
;; (setf (aref ,vi (1+ ,i)) ,col-stop)))))
;; ,y))))
;;
-(deft/method t/copy! ((clx t) (cly standard-tensor)) (x y)
- (using-gensyms (decl (x y))
- (with-gensyms (sto-y of-y idx cx)
- `(let* (,@decl
- (,sto-y (store ,y))
- (,cx (t/coerce ,(field-type cly) ,x)))
- (declare (type ,cly ,y)
- (type ,(field-type cly) ,cx)
- (type ,(store-type cly) ,sto-y))
- ;;This should be safe
- (very-quickly
- (mod-dotimes (,idx (dimensions ,y))
- :with (linear-sums
- (,of-y (strides ,y) (head ,y)))
- :do (t/store-set ,cly ,cx ,sto-y ,of-y)))
- ,y))))
;;
(defmethod copy! :before ((x base-tensor) (y base-tensor))
@@ -198,7 +217,7 @@
(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))
+(defmethod copy! ((x base-tensor) (y base-tensor))
(let ((clx (class-name (class-of x)))
(cly (class-name (class-of y))))
(assert (and (member clx *tensor-type-leaves*)
@@ -223,41 +242,6 @@
(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*))
@@ -337,4 +321,7 @@
((or (not type) (subtypep type 'sparse-tensor))
(let ((ret (zeros (dimensions tensor) (or type (class-of tensor)) (store-size tensor))))
(copy! tensor ret)))
+ ((subtypep type 'standard-tensor)
+ (let ((ret (zeros (dimensions tensor) type (store-size tensor))))
+ (copy! tensor ret)))
(t (error "don't know how to copy ~a into ~a." (class-name (class-of tensor)) type))))
commit 8b18fb736d6bae9c0fd16a0faa51efed07afb294
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Apr 25 20:35:41 2014 -0700
Made changes to accomodate negative axis in mapslice; fixed bugs in chol, t/store-ref.
diff --git a/src/base/base-tensor.lisp b/src/base/base-tensor.lisp
index f0d8f99..349a9df 100644
--- a/src/base/base-tensor.lisp
+++ b/src/base/base-tensor.lisp
@@ -270,16 +270,21 @@
(let ((nd (ceiling (- end start) inc)))
(when (<= nd 0) (return (values -1 nil nil)))
(incf hd (* s start))
- (when (or preserve-rank (> nd 1))
+ (when (or preserve-rank (> nd 1) (= nd d))
(collect nd into dims)
(collect (* inc s) into stds))))
(finally (return (if (and ref-single-element? (null dims))
(values hd nil nil)
(values hd (or dims (list 1)) (or stds (list 1)))))))))
+(definline modproj (i d &optional open?)
+ (assert (if open? (<= (1- (- d)) i d) (< (1- (- d)) i d)) nil 'invalid-value)
+ (if (< i 0) (mod i d) i))
+
(definline slice~ (x axis &optional (idx 0) (preserve-rank? nil))
- (let ((slst (make-list (order x) :initial-element '(nil nil))))
- (rplaca (nthcdr axis slst) (list idx (1+ idx)))
+ (let ((slst (make-list (order x) :initial-element '(nil nil)))
+ (axis (modproj axis (order x))))
+ (rplaca (nthcdr (mod axis (order x)) slst) (list idx (1+ (modproj idx (aref (dimensions x) axis)))))
(subtensor~ x slst preserve-rank? nil)))
(definline row-slice~ (x idx)
diff --git a/src/base/tensor-template.lisp b/src/base/tensor-template.lisp
index 1ce0d3f..3ef0542 100644
--- a/src/base/tensor-template.lisp
+++ b/src/base/tensor-template.lisp
@@ -43,12 +43,13 @@
(define-setf-expander t/store-ref (sym store &rest idx &environment env)
(multiple-value-bind (dummies vals newval setter getter)
(get-setf-expansion store env)
+ (declare (ignore newval setter))
(with-gensyms (nval)
(values dummies
vals
`(,nval)
`(t/store-set ,sym ,nval ,getter ,@idx)
- `(t/store-get ,sym ,getter ,@idx)))))
+ `(t/store-ref ,sym ,getter ,@idx)))))
;;standard-tensor specific.
;;Beware of infinite loops here.
diff --git a/src/lapack/chol.lisp b/src/lapack/chol.lisp
index f5c4f14..a3c1fb9 100644
--- a/src/lapack/chol.lisp
+++ b/src/lapack/chol.lisp
@@ -149,14 +149,16 @@
:given uplo :expected `(member uplo '(:u :l)))))
(define-tensor-method potrs! ((A blas-numeric-tensor :input) (B blas-numeric-tensor :output) &optional (uplo *default-uplo*))
- `(with-columnification (((A #\C)) (B))
- (multiple-value-bind (sto info) (t/lapack-potrs! ,(cl a)
- A (or (blas-matrix-compatiblep A #\N) 0)
- B (or (blas-matrix-compatiblep B #\N) 0)
- (aref (symbol-name uplo) 0))
- (declare (ignore sto))
- (unless (= info 0)
- (error "POTRS returned ~a. the ~:*~a'th argument had an illegal value." (- info)))))
+ `(if (tensor-vectorp B)
+ (potrs! A (suptensor~ B 2) uplo)
+ (with-columnification (((A #\C)) (B))
+ (multiple-value-bind (sto info) (t/lapack-potrs! ,(cl a)
+ A (or (blas-matrix-compatiblep A #\N) 0)
+ B (or (blas-matrix-compatiblep B #\N) 0)
+ (aref (symbol-name uplo) 0))
+ (declare (ignore sto))
+ (unless (= info 0)
+ (error "POTRS returned ~a. the ~:*~a'th argument had an illegal value." (- info))))))
'B)
;;
(defgeneric chol (a &optional uplo)
diff --git a/src/reader/infix.lisp b/src/reader/infix.lisp
index 67daf7a..2927657 100644
--- a/src/reader/infix.lisp
+++ b/src/reader/infix.lisp
@@ -19,7 +19,7 @@
;; Where should setf and friends go in the precedence?
( = += -= *= /=)
(|:|) ;;slicing
- ( \, newline ) ; progn (statement delimiter)
+ ( \, ) ; progn (statement delimiter)
( \] \) )
( %infix-end-token% )) ; end of infix expression
"Ordered list of operators of equal precedence.")
@@ -653,19 +653,19 @@
(define-token-operator \,
:infix `(progn ,left ,(gather-superiors '\, stream)))
-(define-character-tokenization #\Newline
- #'(lambda (stream char)
- (declare (ignore char stream))
- 'newline))
-
-(define-token-operator newline
- :infix (progn
- (ignore-characters +blank-characters+ stream)
- (case (peek-char nil stream t nil t)
- (#\)
- left)
- (t
- `(progn ,left ,(gather-superiors 'newline stream))))))
+;; (define-character-tokenization #\Newline
+;; #'(lambda (stream char)
+;; (declare (ignore char stream))
+;; 'newline))
+
+;; (define-token-operator newline
+;; :infix (progn
+;; (ignore-characters +blank-characters+ stream)
+;; (case (peek-char nil stream t nil t)
+;; (#\)
+;; left)
+;; (t
+;; `(progn ,left ,(gather-superiors 'newline stream))))))
;;---------------------------------------------------------------;;
(define-character-tokenization #\=
diff --git a/src/special/map.lisp b/src/special/map.lisp
index ab7b192..50f6128 100644
--- a/src/special/map.lisp
+++ b/src/special/map.lisp
@@ -72,16 +72,22 @@
;;
(defun check-dims (axis tensors)
- (loop :for x :of-type standard-tensor :in tensors
- :with dims := nil
- :do (let-typed ((xdims (dimensions x) :type index-store-vector))
- (assert (< axis (order x)) nil 'tensor-dimension-mismatch)
- (if (null dims)
- (setf dims (aref xdims axis))
- (setf dims (min (aref xdims axis) dims))))
- :collect (aref (strides x) axis) :into strides
- :collect (slice~ x axis) :into slices
- :finally (return (values dims strides slices))))
+ (iter (for x in tensors)
+ (with dims = nil)
+ (cond
+ ((typep x 'standard-tensor)
+ (let-typed ((xdims (dimensions x) :type index-store-vector))
+ (assert (< axis (order x)) nil 'tensor-dimension-mismatch)
+ (if (null dims)
+ (setf dims (aref xdims (mod axis (order x))))
+ (setf dims (min (aref xdims (mod axis (order x))) dims))))
+ (collect (aref (strides x) (mod axis (order x))) into strides)
+ (collect (slice~ x axis) into slices))
+ ((eq x nil)
+ (collect nil into strides)
+ (collect nil into slices))
+ (t (error 'invalid-arguments)))
+ (finally (return (values dims strides slices)))))
(defun mapslice (axis func tensor &rest more-tensors)
(multiple-value-bind (d.axis strides slices) (check-dims axis (cons tensor more-tensors))
@@ -90,7 +96,7 @@
(when (< i (1- d.axis))
(loop :for slc :in slices
:for std :in strides
- :do (incf (slot-value slc 'head) std)))))))
+ :do (when slc (incf (slot-value slc 'head) std))))))))
(defun mapslice~ (axis func tensor &rest more-tensors)
(multiple-value-bind (d.axis strides slices) (check-dims axis (cons tensor more-tensors))
@@ -99,7 +105,7 @@
(when (< i (1- d.axis))
(loop :for slc :in slices
:for std :in strides
- :do (incf (slot-value slc 'head) std)))))))
+ :do (when slc (incf (slot-value slc 'head) std))))))))
(defun mapslicec~ (axis func tensor &rest more-tensors)
(multiple-value-bind (d.axis strides slices) (check-dims axis (cons tensor more-tensors))
@@ -108,7 +114,7 @@
(when (< i (1- d.axis))
(loop :for slc :in slices
:for std :in strides
- :do (incf (slot-value slc 'head) std))))))
+ :do (when slc (incf (slot-value slc 'head) std)))))))
(values-list (cons tensor more-tensors)))
;;
diff --git a/src/special/norm.lisp b/src/special/norm.lisp
index 2ce9a29..f4018bd 100644
--- a/src/special/norm.lisp
+++ b/src/special/norm.lisp
@@ -55,3 +55,6 @@
(setf rval r)
(lvec->list! idx ridx))))
(values rval ridx))))
+
+(defun tr (mat)
+ (sum (tricopy! mat (zeros (lvec-min (dimensions mat)) (class-of mat)) :d)))
commit f4e59e53ce5f2de3462c3c554f6bd075b3f30b6b
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Apr 18 12:39:43 2014 -0700
Fixed bug in potrs, made suptensor~ choose strides more wisely.
diff --git a/src/base/standard-tensor.lisp b/src/base/standard-tensor.lisp
index 82f9eaa..aed16f2 100644
--- a/src/base/standard-tensor.lisp
+++ b/src/base/standard-tensor.lisp
@@ -193,9 +193,9 @@
(let ((tord (order ten)))
(unless (integerp start)
(setq start (if start (- ord tord) 0)))
- (let ((stds (make-index-store (append (make-list start :initial-element 1)
+ (let ((stds (make-index-store (append (make-list start :initial-element (size ten))
(lvec->list (strides ten))
- (make-list (- ord tord start) :initial-element 1))))
+ (make-list (- ord tord start) :initial-element (size ten)))))
(dims (make-index-store (append (make-list start :initial-element 1)
(dims ten)
(make-list (- ord tord start) :initial-element 1)))))
diff --git a/src/lapack/chol.lisp b/src/lapack/chol.lisp
index 27bb8cc..f5c4f14 100644
--- a/src/lapack/chol.lisp
+++ b/src/lapack/chol.lisp
@@ -142,21 +142,21 @@
Solution could not be computed.
")
(:method :before ((A standard-tensor) (B standard-tensor) &optional (uplo :l))
- (assert (and (tensor-matrixp A) (tensor-matrixp B)
- (= (nrows A) (ncols A) (nrows B)))
+ (assert (and (tensor-square-matrixp A) (<= (order B) 2)
+ (= (nrows A) (nrows B)))
nil 'tensor-dimension-mismatch)
(assert (member uplo '(:l :u)) nil 'invalid-value
:given uplo :expected `(member uplo '(:u :l)))))
(define-tensor-method potrs! ((A blas-numeric-tensor :input) (B blas-numeric-tensor :output) &optional (uplo *default-uplo*))
- `(with-columnification ((A #\C) (B))
+ `(with-columnification (((A #\C)) (B))
(multiple-value-bind (sto info) (t/lapack-potrs! ,(cl a)
A (or (blas-matrix-compatiblep A #\N) 0)
B (or (blas-matrix-compatiblep B #\N) 0)
(aref (symbol-name uplo) 0))
(declare (ignore sto))
(unless (= info 0)
- (error "POTRS returned ~a. the ~a'th argument had an illegal value." (- info)))))
+ (error "POTRS returned ~a. the ~:*~a'th argument had an illegal value." (- info)))))
'B)
;;
(defgeneric chol (a &optional uplo)
commit 6d0ed7f102650f8c775144d91c7e38901fa51ff9
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Apr 18 02:16:49 2014 -0700
Added a transpose-optimization to t*.
diff --git a/src/sugar/arithmetic.lisp b/src/sugar/arithmetic.lisp
index add10be..33b4221 100644
--- a/src/sugar/arithmetic.lisp
+++ b/src/sugar/arithmetic.lisp
@@ -101,10 +101,35 @@
;; :finally (return (cost 0 (1- n)))))))
-(definline t* (&rest objs)
- (reduce #'tb* objs))
-(definline m* (&rest objs)
- (apply #'t* objs))
+(defmacro t* (&rest objs)
+ (labels ((op (code)
+ (when (consp code)
+ (case (car code)
+ (htranspose #\C)
+ (transpose #\T))))
+ (optimizer (a b)
+ (let ((op.a (op a))
+ (op.b (op b)))
+ (if (not (or op.a op.b))
+ `(tb* ,a ,b)
+ (with-gensyms (ma mb)
+ `(let ((,ma ,(if op.a (cadr a) a))
+ (,mb ,(if op.b (cadr b) b)))
+ ;;This will not throw errors that one would expect, sometimes.
+ (if (and (tensor-matrixp ,ma) (tensor-matrixp ,mb))
+ (gemm 1 ,ma ,mb nil nil ,(intern (coerce (list (or op.a #\N) (or op.b #\N)) 'string) :keyword))
+ (tb* ,(if op.a `(,(car a) ,ma) ma) ,(if op.b `(,(car b) ,mb) mb))))))))
+ (ropt (lst)
+ (if (not (cdr lst)) (car lst)
+ (ropt (cons (optimizer (first lst) (second lst)) (cddr lst))))))
+ (ropt objs)))
+
+(defmacro m* (&rest objs)
+ `(t* ,@objs))
+;; (definline t* (&rest objs)
+;; (reduce #'tb* objs))
+;; (definline m* (&rest objs)
+;; (apply #'t* objs))
;;
(definline t.* (&rest objs)
(reduce #'scal objs))
commit b668733e8899254c129a7b1d109b4a229aa95246
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Apr 18 01:40:13 2014 -0700
Changed print to col-major; infix now uses the dispatch table for regular reads.
diff --git a/src/base/print.lisp b/src/base/print.lisp
index df5f7e8..66d168b 100644
--- a/src/base/print.lisp
+++ b/src/base/print.lisp
@@ -53,14 +53,14 @@ of a matrix (default 0)
(two-print-calls 0))
(labels ((two-print (tensor subs)
(let ((strs nil)
- (maxw (make-array (if (eq *print-max-len* t) (aref dims (- rank 1)) (1+ *print-max-len*)) :initial-element 0)))
+ (maxw (make-array (if (eq *print-max-len* t) (aref dims 1) (1+ *print-max-len*)) :initial-element 0)))
(setq strs
- (iter (for i from 0 below (aref dims (- rank 2)))
+ (iter (for i from 0 below (aref dims 0))
(if (or (eq *print-max-len* t) (< i *print-max-len*))
- (collect (iter (for j from 0 below (aref dims (- rank 1)))
+ (collect (iter (for j from 0 below (aref dims 1))
(if (or (eq *print-max-len* t) (< j *print-max-len*))
(let ((str (with-output-to-string (str)
- (print-element tensor (ref tensor (append subs `(,i ,j))) str))))
+ (print-element tensor (ref tensor (append `(,i ,j) subs)) str))))
(collect str into cprints)
(setf (aref maxw j) (max (aref maxw j) (length str))))
(let ((str (with-output-to-string (str) (format str "..."))))
@@ -77,17 +77,17 @@ of a matrix (default 0)
(for j initially 0 then (1+ j))
(format stream (replace (make-string (+ (aref maxw j) 4) :initial-element #\Space) cref :start1 (if (char= (aref cref 0) #\-) 0 1))))
(format stream "~%"))
- (unless (or (eq *print-max-len* t) (< (aref dims (- rank 2)) *print-max-len*))
+ (unless (or (eq *print-max-len* t) (< (aref dims 0) *print-max-len*))
(format stream (format nil "~~~AT.~~%~~~:*~AT:~~%" *print-indent*)))))
(rec-print (tensor idx subs)
- (if (< idx (- rank 2))
+ (if (>= idx 2)
(dotimes (i (aref dims idx) t)
- (unless (rec-print tensor (1+ idx) (append subs `(,i)))
+ (unless (rec-print tensor (1- idx) (append `(,i) subs))
(return nil)))
(progn
(if (or (eq *print-max-args* t) (< two-print-calls *print-max-args*))
(progn
- (format stream "~A~%" (append subs '(\: \:)))
+ (format stream "~A~%" (append '(\: \:) subs))
(two-print tensor subs)
(format stream "~%")
(incf two-print-calls)
@@ -111,7 +111,7 @@ of a matrix (default 0)
(2
(two-print tensor nil))
(t
- (rec-print tensor 0 nil))))))
+ (rec-print tensor (1- (order tensor)) nil))))))
(defmethod print-object ((tensor standard-tensor) stream)
(print-unreadable-object (tensor stream :type t)
diff --git a/src/reader/infix.lisp b/src/reader/infix.lisp
index 4e55df6..67daf7a 100644
--- a/src/reader/infix.lisp
+++ b/src/reader/infix.lisp
@@ -200,7 +200,7 @@
result))
(defun read-regular (stream)
- (with-readtable (:common-lisp)
+ (with-readtable (:infix-dispatch-table)
(read stream t nil t)))
;;; Hack to work around + and - being terminating macro characters,
commit c81e3b9bbaf654e5d5cf4b9082d013b6e0b9b1d4
Author: Akshay Srinivasan <ak...@cs...>
Date: Mon Apr 14 21:35:26 2014 -0700
Fixed bug in print.lisp, added u8-tensor.
diff --git a/src/base/print.lisp b/src/base/print.lisp
index a22524a..df5f7e8 100644
--- a/src/base/print.lisp
+++ b/src/base/print.lisp
@@ -77,7 +77,7 @@ of a matrix (default 0)
(for j initially 0 then (1+ j))
(format stream (replace (make-string (+ (aref maxw j) 4) :initial-element #\Space) cref :start1 (if (char= (aref cref 0) #\-) 0 1))))
(format stream "~%"))
- (unless (or (< (aref dims (- rank 2)) *print-max-len*) (eq *print-max-len* t))
+ (unless (or (eq *print-max-len* t) (< (aref dims (- rank 2)) *print-max-len*))
(format stream (format nil "~~~AT.~~%~~~:*~AT:~~%" *print-indent*)))))
(rec-print (tensor idx subs)
(if (< idx (- rank 2))
diff --git a/src/classes/numeric.lisp b/src/classes/numeric.lisp
index c046caa..9e6e63a 100644
--- a/src/classes/numeric.lisp
+++ b/src/classes/numeric.lisp
@@ -15,6 +15,10 @@
(defleaf fixnum-tensor (numeric-tensor) ())
(deft/method t/field-type (sym fixnum-tensor) ()
'fixnum)
+
+(defleaf u8-tensor (numeric-tensor) ())
+(deft/method t/field-type (sym u8-tensor) ()
+ '(unsigned-byte 8))
;;
(defclass blas-numeric-tensor (numeric-tensor) ())
(deft/generic (t/l1-lb #'subtypep) sym ())
commit 8e9e139ab7884f3811834aba6c9eb5d25c1c79e3
Author: Akshay Srinivasan <aks...@gm...>
Date: Mon Apr 14 11:49:40 2014 -0700
Tweaked the definitions for foreign stores, made mapslice more general.
diff --git a/src/base/coordinate-sparse.lisp b/src/base/coordinate-sparse.lisp
index 12bdfa9..25c9968 100644
--- a/src/base/coordinate-sparse.lisp
+++ b/src/base/coordinate-sparse.lisp
@@ -7,22 +7,23 @@
(strides :initarg :strides :reader strides :type index-store-vector
:documentation "Strides for accesing elements of the tensor.")))
-(defmethod initialize-instance :after ((tensor coordinate-sparse-tensor) &rest initargs)
- (declare (ignore initargs))
- (when *check-after-initializing?*
- (let-typed ((dims (dimensions tensor) :type index-store-vector))
- (assert (>= (head tensor) 0) nil 'tensor-invalid-head-value :head (head tensor) :tensor tensor)
- (if (not (slot-boundp tensor 'strides))
- (setf (slot-value tensor 'strides) (make-stride-cmj dims))
- (very-quickly
- (let-typed ((stds (strides tensor) :type index-store-vector))
- (loop :for i :of-type index-type :from 0 :below (order tensor)
- :for sz :of-type index-type := (aref dims 0) :then (the index-type (* sz (aref dims i)))
- :for lidx :of-type index-type := (the index-type (* (aref stds 0) (1- (aref dims 0)))) :then (the index-type (+ lidx (the index-type (* (aref stds i) (1- (aref dims i))))))
- :do (progn
- (assert (> (aref stds i) 0) nil 'tensor-invalid-stride-value :argument i :stride (aref stds i) :tensor tensor)
- (assert (> (aref dims i) 0) nil 'tensor-invalid-dimension-value :argument i :dimension (aref dims i) :tensor tensor))
- :finally (assert (>= (the index-type (store-size tensor)) (the index-type (+ (the index-type (head tensor)) lidx))) nil 'tensor-insufficient-store :stor...
[truncated message content] |
Thanks for helping keep SourceForge clean.
X