Menu
▾
▴
[Matlisp-commit] [matlisp-git]matlisp branch tensor updated. 2012-02-23-401-g5b77108
|
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 :store-size (store-size tensor) :max-idx lidx :tensor 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 s :across stds
+;; :for d :across dims
+;; :summing (the index-type (* s d)) :into sz :of-type index-type
+;; :do (progn
+;; (assert (and (>= s sz) (> s 0)) nil 'tensor-invalid-stride-value :argument i :stride s :tensor tensor)
+;; (assert (> d 0) nil 'tensor-invalid-dimension-value :argument i :dimension d :tensor tensor))
+;; :finally (assert (>= (the index-type (store-size tensor)) (the index-type (+ (the index-type (head tensor)) lidx))) nil 'tensor-insufficient-store :store-size (store-size tensor) :max-idx lidx :tensor tensor))))))))
(deft/generic (t/sparse-fill #'subtypep) sym ())
(deft/method t/sparse-fill (sym sparse-tensor) ()
diff --git a/src/classes/foreign.lisp b/src/classes/foreign.lisp
index c277850..e8e9a8a 100644
--- a/src/classes/foreign.lisp
+++ b/src/classes/foreign.lisp
@@ -9,21 +9,25 @@
'foreign-vector)
(deft/method t/store-size (sym foreign-numeric-tensor) (vec)
`(fv-size ,vec))
-(deft/method t/store-ref (sym foreign-numeric-tensor) (store idx)
- `(the ,(field-type sym) (fv-ref ,store ,idx)))
-(deft/method t/store-set (sym foreign-numeric-tensor) (value store idx)
- `(setf (fv-ref ,store ,idx) (the ,(field-type sym) ,value)))
+(deft/method t/store-ref (sym foreign-numeric-tensor) (store &rest idx)
+ (assert (null (cdr idx)) nil "given more than one index for linear-store")
+ `(the ,(field-type sym) (fv-ref ,store ,(car idx))))
+
+(deft/method t/store-set (sym foreign-numeric-tensor) (value store &rest idx)
+ (assert (null (cdr idx)) nil "given more than one index for linear-store")
+ `(setf (fv-ref ,store ,(car idx)) (the ,(field-type sym) ,value)))
+
+;;
(eval-when (:compile-toplevel :load-toplevel :execute)
- (defgeneric cl->cffi-type (type)
- (:method (type)
- (ecase type
- (character :char)
- (single-float :float)
- (double-float :double)
- (string :string)
- (t (error 'unknown-token :token type
- :message "Don't know how to convert type to CFFI."))))))
+ (definline cl->cffi-type (type)
+ (ecase type
+ (character :char)
+ (single-float :float)
+ (double-float :double)
+ (string :string)
+ (t (error 'unknown-token :token type
+ :message "Don't know how to convert type to CFFI.")))))
(deft/method with-field-element (sym foreign-numeric-tensor) (decl &rest body)
(destructuring-bind (var val &optional (count 1)) decl
diff --git a/src/special/map.lisp b/src/special/map.lisp
index 10de493..ab7b192 100644
--- a/src/special/map.lisp
+++ b/src/special/map.lisp
@@ -75,16 +75,13 @@
(loop :for x :of-type standard-tensor :in tensors
:with dims := nil
:do (let-typed ((xdims (dimensions x) :type index-store-vector))
- (assert (or (not dims) (= (order x) (length dims))) nil 'tensor-dimension-mismatch)
+ (assert (< axis (order x)) nil 'tensor-dimension-mismatch)
(if (null dims)
- (setf dims (copy-seq xdims))
- (loop :for i :from 0 :below (length dims)
- :do (if (/= i axis)
- (assert (= (aref xdims i) (aref dims i)) nil 'tensor-dimension-mismatch)
- (setf (aref dims i) (min (aref xdims i) (aref dims i)))))))
+ (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 (aref dims axis) strides slices))))
+ :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))
commit 56b707f789c453e157d0818fc8fcf0a16a699db8
Author: Akshay Srinivasan <aks...@gm...>
Date: Thu Apr 10 14:25:38 2014 -0700
Fixes to tweaks to map.lisp.
diff --git a/src/special/map.lisp b/src/special/map.lisp
index 044e491..10de493 100644
--- a/src/special/map.lisp
+++ b/src/special/map.lisp
@@ -90,7 +90,7 @@
(multiple-value-bind (d.axis strides slices) (check-dims axis (cons tensor more-tensors))
(loop :for i :from 0 :below d.axis
:collect (prog1 (apply func (mapcar #'copy slices))
- (unless (< i (1- d.axis))
+ (when (< i (1- d.axis))
(loop :for slc :in slices
:for std :in strides
:do (incf (slot-value slc 'head) std)))))))
@@ -99,7 +99,7 @@
(multiple-value-bind (d.axis strides slices) (check-dims axis (cons tensor more-tensors))
(loop :for i :from 0 :below d.axis
:collect (prog1 (apply func slices)
- (unless (< i (1- d.axis))
+ (when (< i (1- d.axis))
(loop :for slc :in slices
:for std :in strides
:do (incf (slot-value slc 'head) std)))))))
@@ -108,7 +108,7 @@
(multiple-value-bind (d.axis strides slices) (check-dims axis (cons tensor more-tensors))
(loop :for i :from 0 :below d.axis
:do (prog1 (apply func slices)
- (unless (< i (1- d.axis))
+ (when (< i (1- d.axis))
(loop :for slc :in slices
:for std :in strides
:do (incf (slot-value slc 'head) std))))))
commit 3caa822f9516b69bc5aba4bd2cb840a05b09e48b
Author: Akshay Srinivasan <aks...@gm...>
Date: Thu Apr 10 14:21:00 2014 -0700
Tweaks to map.lisp
diff --git a/src/reader/loadsave.lisp b/src/reader/loadsave.lisp
index 92ba338..ba37f29 100644
--- a/src/reader/loadsave.lisp
+++ b/src/reader/loadsave.lisp
@@ -12,9 +12,10 @@
(let* ((f-string (file->string fname))
(*read-default-float-format* 'double-float))
(multiple-value-bind (lns nrows) (split-seq #'(lambda (x) (member x newlines)) f-string)
- (incf nrows)
+ (setf nrows (+ nrows 1 (- skip-rows))
+ lns (nthcdr skip-rows lns))
(unless (null lns)
- (let* ((ncols (1+ (nth-value 1(split-seq #'(lambda (x) (member x delimiters)) (car lns)))))
+ (let* ((ncols (1+ (nth-value 1 (split-seq #'(lambda (x) (member x delimiters)) (car lns)))))
(ret (zeros (if (> ncols 1) (list nrows ncols) (list nrows)) 'real-tensor)))
(if (> ncols 1)
(loop :for line :in lns
@@ -68,7 +69,7 @@
((null line) mtx)
(let ((dat (mapcar #'read-from-string (split-seq #'(lambda (x) (member x delimiters)) line))))
(setf (ref mtx (mapcar #'1- (subseq dat 0 2))) (third dat)))))))
-
+
;; (multiple-value-bind (lns nrows) (split-seq #'(lambda (x) (member x newlines)) f-string)
;; (loop :for
;; (unless (null lns)
diff --git a/src/special/map.lisp b/src/special/map.lisp
index 99524eb..044e491 100644
--- a/src/special/map.lisp
+++ b/src/special/map.lisp
@@ -90,25 +90,28 @@
(multiple-value-bind (d.axis strides slices) (check-dims axis (cons tensor more-tensors))
(loop :for i :from 0 :below d.axis
:collect (prog1 (apply func (mapcar #'copy slices))
- (loop :for slc :in slices
- :for std :in strides
- :do (incf (slot-value slc 'head) std))))))
+ (unless (< i (1- d.axis))
+ (loop :for slc :in slices
+ :for std :in strides
+ :do (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))
(loop :for i :from 0 :below d.axis
:collect (prog1 (apply func slices)
- (loop :for slc :in slices
- :for std :in strides
- :do (incf (slot-value slc 'head) std))))))
+ (unless (< i (1- d.axis))
+ (loop :for slc :in slices
+ :for std :in strides
+ :do (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))
(loop :for i :from 0 :below d.axis
:do (prog1 (apply func slices)
- (loop :for slc :in slices
- :for std :in strides
- :do (incf (slot-value slc 'head) std)))))
+ (unless (< i (1- d.axis))
+ (loop :for slc :in slices
+ :for std :in strides
+ :do (incf (slot-value slc 'head) std))))))
(values-list (cons tensor more-tensors)))
;;
commit 3afe61642a8951b86133c79e1fbd19839f48b8b8
Author: Akshay Srinivasan <aks...@gm...>
Date: Wed Apr 9 16:03:43 2014 -0700
Added suptensor~ method.
diff --git a/src/base/base-tensor.lisp b/src/base/base-tensor.lisp
index 70f01fa..f0d8f99 100644
--- a/src/base/base-tensor.lisp
+++ b/src/base/base-tensor.lisp
@@ -288,6 +288,12 @@
(definline col-slice~ (x idx)
(slice~ x 1 idx))
;;
+(defgeneric suptensor~ (tensor ord &optional start)
+ (:method :before ((tensor base-tensor) ord &optional start)
+ (let ((tord (order tensor)))
+ (assert (and (<= tord ord) (or (not (integerp start)) (>= (- ord tord start) 0))) nil 'invalid-arguments))))
+
+;;
(defun tensor-typep (tensor subs)
"
Syntax
diff --git a/src/base/standard-tensor.lisp b/src/base/standard-tensor.lisp
index 76f92fd..82f9eaa 100644
--- a/src/base/standard-tensor.lisp
+++ b/src/base/standard-tensor.lisp
@@ -186,3 +186,23 @@
:store (store tensor)
:parent-tensor tensor))
(store-ref tensor hd)))))
+
+(defmethod suptensor~ ((ten standard-tensor) ord &optional start)
+ (if (= (order ten) ord)
+ ten
+ (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)
+ (lvec->list (strides ten))
+ (make-list (- ord tord start) :initial-element 1))))
+ (dims (make-index-store (append (make-list start :initial-element 1)
+ (dims ten)
+ (make-list (- ord tord start) :initial-element 1)))))
+ (with-no-init-checks
+ (make-instance (class-of ten)
+ :dimensions dims
+ :strides stds
+ :head (head ten)
+ :store (store ten)
+ :parent-tensor ten))))))
commit 0d327c3a710ab3bce416b0ac48093557e073e6b4
Author: Akshay Srinivasan <aks...@gm...>
Date: Mon Apr 7 22:33:35 2014 -0700
Added optimized methods for max,min.
diff --git a/src/special/norm.lisp b/src/special/norm.lisp
index 4d66e05..2ce9a29 100644
--- a/src/special/norm.lisp
+++ b/src/special/norm.lisp
@@ -12,37 +12,46 @@
((eql n :sup)
(tensor-foldl ,(cl vec) max vec (t/fid+ ,(field-type (cl vec))) :key abs))))
-;;It's fairly simple to write optimized versions. Optimize at your own discretion.
-;; (defun tomax (vec)
-;; (declare (type real-tensor vec))
-;; (let-typed ((max 0d0 :type double-float))
-;; (very-quickly
-;; (dorefs (idx (dimensions vec))
-;; ((rvec vec :type real-tensor))
-;; (let-typed ((r rvec :type double-float))
-;; (when (> r max)
-;; (setf max r)))))
-;; max))
(defgeneric tensor-max (vec &optional key))
-(define-tensor-method tensor-max ((vec standard-tensor :input) &optional (key #'id))
- `(let* ((max-idx (make-list (order vec) :initial-element 0))
- (max (funcall key (ref vec max-idx))))
- (dorefs (idx (dimensions vec))
- ((ref vec :type ,(cl vec)))
- (let ((kval (funcall key ref)))
- (when (> kval max)
- (setf max kval)
- (lvec->list! idx max-idx))))
- (values max max-idx)))
+(define-tensor-method tensor-max ((vec standard-tensor :input) &optional key)
+ `(if key
+ (let* ((ridx (make-list (order vec) :initial-element 0))
+ (rval (funcall key (ref vec ridx))))
+ (dorefs (idx (dimensions vec))
+ ((ref vec :type ,(cl vec)))
+ (let ((kval (funcall key ref)))
+ (when (> kval rval)
+ (setf rval kval)
+ (lvec->list! idx ridx))))
+ (values rval ridx))
+ (let*-typed ((ridx (make-list (order vec) :initial-element 0))
+ (rval (ref vec ridx) :type ,(field-type (cl vec))))
+ (dorefs (idx (dimensions vec))
+ ((ref vec :type ,(cl vec)))
+ (let-typed ((r ref :type ,(field-type (cl vec))))
+ (when (> r rval)
+ (setf rval r)
+ (lvec->list! idx ridx))))
+ (values rval ridx))))
(defgeneric tensor-min (vec &optional key))
-(define-tensor-method tensor-min ((vec standard-tensor :input) &optional (key #'id))
- `(let* ((min-idx (make-list (order vec) :initial-element 0))
- (min (funcall key (ref vec min-idx))))
- (dorefs (idx (dimensions vec))
- ((ref vec :type ,(cl vec)))
- (let ((kval (funcall key ref)))
- (when (< kval min)
- (setf min kval)
- (lvec->list! idx min-idx))))
- (values min min-idx)))
+(define-tensor-method tensor-min ((vec standard-tensor :input) &optional key)
+ `(if key
+ (let* ((ridx (make-list (order vec) :initial-element 0))
+ (rval (funcall key (ref vec ridx))))
+ (dorefs (idx (dimensions vec))
+ ((ref vec :type ,(cl vec)))
+ (let ((kval (funcall key ref)))
+ (when (< kval rval)
+ (setf rval kval)
+ (lvec->list! idx ridx))))
+ (values rval ridx))
+ (let*-typed ((ridx (make-list (order vec) :initial-element 0))
+ (rval (ref vec ridx) :type ,(field-type (cl vec))))
+ (dorefs (idx (dimensions vec))
+ ((ref vec :type ,(cl vec)))
+ (let-typed ((r ref :type ,(field-type (cl vec))))
+ (when (< r rval)
+ (setf rval r)
+ (lvec->list! idx ridx))))
+ (values rval ridx))))
commit f907ad7cfb43867bce9af5226162e4d9509d9a00
Author: Akshay Srinivasan <aks...@gm...>
Date: Mon Apr 7 22:23:36 2014 -0700
Added max,min methods.
diff --git a/src/special/norm.lisp b/src/special/norm.lisp
index d4736a9..4d66e05 100644
--- a/src/special/norm.lisp
+++ b/src/special/norm.lisp
@@ -1,13 +1,48 @@
(in-package :matlisp)
-(defun norm (vec &optional (n 2))
- (declare (type real-tensor vec))
- (cond
- ((typep n 'real)
- (let-typed ((sum 0d0 :type double-float))
- (dorefs (idx (dimensions vec))
- ((ref vec :type real-tensor))
- (incf sum (expt (abs ref) n)))
- (expt sum (/ 1 n))))
- ((eql n :sup)
- (tensor-foldl real-tensor max vec 0d0))))
+(defgeneric norm (vec &optional n))
+(define-tensor-method norm ((vec numeric-tensor :input) &optional (n 2))
+ `(cond
+ ((typep n 'real)
+ (let-typed ((sum (t/fid+ ,(field-type (cl vec))) :type ,(field-type (cl vec))))
+ (dorefs (idx (dimensions vec))
+ ((ref vec :type ,(cl vec)))
+ (setf sum (t/f+ ,(field-type (cl vec)) sum (expt (abs ref) n))))
+ (expt sum (/ n))))
+ ((eql n :sup)
+ (tensor-foldl ,(cl vec) max vec (t/fid+ ,(field-type (cl vec))) :key abs))))
+
+;;It's fairly simple to write optimized versions. Optimize at your own discretion.
+;; (defun tomax (vec)
+;; (declare (type real-tensor vec))
+;; (let-typed ((max 0d0 :type double-float))
+;; (very-quickly
+;; (dorefs (idx (dimensions vec))
+;; ((rvec vec :type real-tensor))
+;; (let-typed ((r rvec :type double-float))
+;; (when (> r max)
+;; (setf max r)))))
+;; max))
+(defgeneric tensor-max (vec &optional key))
+(define-tensor-method tensor-max ((vec standard-tensor :input) &optional (key #'id))
+ `(let* ((max-idx (make-list (order vec) :initial-element 0))
+ (max (funcall key (ref vec max-idx))))
+ (dorefs (idx (dimensions vec))
+ ((ref vec :type ,(cl vec)))
+ (let ((kval (funcall key ref)))
+ (when (> kval max)
+ (setf max kval)
+ (lvec->list! idx max-idx))))
+ (values max max-idx)))
+
+(defgeneric tensor-min (vec &optional key))
+(define-tensor-method tensor-min ((vec standard-tensor :input) &optional (key #'id))
+ `(let* ((min-idx (make-list (order vec) :initial-element 0))
+ (min (funcall key (ref vec min-idx))))
+ (dorefs (idx (dimensions vec))
+ ((ref vec :type ,(cl vec)))
+ (let ((kval (funcall key ref)))
+ (when (< kval min)
+ (setf min kval)
+ (lvec->list! idx min-idx))))
+ (values min min-idx)))
commit abb0a6f58d54ca9629afef9e56afbc41041ebb14
Author: Akshay Srinivasan <aks...@gm...>
Date: Mon Apr 7 21:40:33 2014 -0700
Added norm.lisp.
diff --git a/matlisp.asd b/matlisp.asd
index 0f12aa4..f6bccd0 100644
--- a/matlisp.asd
+++ b/matlisp.asd
@@ -178,6 +178,7 @@
:depends-on ("matlisp-base" "matlisp-classes" "matlisp-blas")
:components ((:file "random")
(:file "map")
+ (:file "norm")
(:file "seq")))
(:module "matlisp-sugar"
:pathname "sugar"
diff --git a/src/special/norm.lisp b/src/special/norm.lisp
new file mode 100644
index 0000000..d4736a9
--- /dev/null
+++ b/src/special/norm.lisp
@@ -0,0 +1,13 @@
+(in-package :matlisp)
+
+(defun norm (vec &optional (n 2))
+ (declare (type real-tensor vec))
+ (cond
+ ((typep n 'real)
+ (let-typed ((sum 0d0 :type double-float))
+ (dorefs (idx (dimensions vec))
+ ((ref vec :type real-tensor))
+ (incf sum (expt (abs ref) n)))
+ (expt sum (/ 1 n))))
+ ((eql n :sup)
+ (tensor-foldl real-tensor max vec 0d0))))
commit bd8ba7b1d0ba2971f28a1690fdea106397a90d04
Author: Akshay Srinivasan <aks...@gm...>
Date: Sat Apr 5 18:25:34 2014 -0700
Saving changes for working with negative indices.
diff --git a/src/base/blas-helpers.lisp b/src/base/blas-helpers.lisp
index 03fb327..d667bf3 100644
--- a/src/base/blas-helpers.lisp
+++ b/src/base/blas-helpers.lisp
@@ -51,8 +51,8 @@
(cond
;;The ordering of these conditions is important to meet certain assumed conditions
;;in GEMM, when MATRIX has strides of the form #(1 1).
- ((= rs 1) (values cs op :col-major))
- ((and (char/= op #\C) (= cs 1)) (values rs (fortran-nop op) :row-major)))))
+ ((and (= rs 1) (> cs 0)) (values cs op :col-major))
+ ((and (char/= op #\C) (= cs 1) (> rs 0)) (values rs (fortran-nop op) :row-major)))))
(definline call-fortran? ( x lb)
(declare (type standard-tensor x))
diff --git a/src/base/coordinate-sparse.lisp b/src/base/coordinate-sparse.lisp
index 28f9fab..12bdfa9 100644
--- a/src/base/coordinate-sparse.lisp
+++ b/src/base/coordinate-sparse.lisp
@@ -7,6 +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 :store-size (store-size tensor) :max-idx lidx :tensor tensor))))))))
+
(deft/generic (t/sparse-fill #'subtypep) sym ())
(deft/method t/sparse-fill (sym sparse-tensor) ()
`(t/fid+ (t/field-type ,sym)))
diff --git a/src/base/standard-tensor.lisp b/src/base/standard-tensor.lisp
index 2d092b3..76f92fd 100644
--- a/src/base/standard-tensor.lisp
+++ b/src/base/standard-tensor.lisp
@@ -37,10 +37,12 @@
(loop
:for i :of-type index-type :from 0 :below rank
:for cidx :across idx
+ :for d :across dims
+ :for s :across strides
:with sto-idx :of-type index-type := hd
:do (progn
- (assert (< -1 cidx (aref dims i)) nil 'tensor-index-out-of-bounds :argument i :index cidx :dimension (aref dims i))
- (incf sto-idx (the index-type (* (aref strides i) cidx))))
+ (assert (< (1- (- d)) cidx d) nil 'tensor-index-out-of-bounds :argument i :index cidx :dimension d)
+ (incf sto-idx (the index-type (* s (if (< cidx 0) (mod cidx d) cidx)))))
:finally (return sto-idx)))))
(defun store-indexing-lst (idx hd strides dims)
@@ -64,14 +66,15 @@
(type index-store-vector strides dims)
(type cons idx))
(let-typed ((rank (length strides) :type index-type))
- (assert (= rank (length dims)) nil 'tensor-dimension-mismatch)
(very-quickly
(loop :for cidx :of-type index-type :in idx
:for i :of-type index-type := 0 :then (1+ i)
+ :for d :across dims
+ :for s :across strides
:with sto-idx :of-type index-type := hd
:do (progn
- (assert (< -1 cidx (aref dims i)) nil 'tensor-index-out-of-bounds :argument i :index cidx :dimension (aref dims i))
- (incf sto-idx (the index-type (* (aref strides i) cidx))))
+ (assert (< (1- (- d)) cidx d) nil 'tensor-index-out-of-bounds :argument i :index cidx :dimension d)
+ (incf sto-idx (the index-type (* s (if (< cidx 0) (mod cidx d) cidx)))))
:finally (progn
(assert (= (1+ i) rank) nil 'tensor-index-rank-mismatch :index-rank (1+ i) :rank rank)
(return sto-idx))))))
@@ -144,11 +147,9 @@
(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 :store-size (store-size tensor) :max-idx lidx :tensor tensor))))))))
+ :summing (the index-type (the index-type (* (aref stds i) (1- (aref dims i))))) :into lidx :of-type index-type
+ :do (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)) 0) nil 'tensor-insufficient-store :store-size (store-size tensor) :max-idx (the index-type (+ (head tensor) lidx)) :tensor tensor))))))))
(defmethod ref ((tensor standard-tensor) &rest subscripts)
(let ((clname (class-name (class-of tensor))))
diff --git a/src/blas/copy.lisp b/src/blas/copy.lisp
index 0d140e6..29b2c73 100644
--- a/src/blas/copy.lisp
+++ b/src/blas/copy.lisp
@@ -102,6 +102,77 @@
,y))))
;;
+;;(t/copy! (real-coordinate-sparse-tensor real-compressed-sparse-matrix) x 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)
+ (declare (type ,clx ,x) (type ,cly ,y))
+ (let ((,cstd (aref (strides ,x) 1))
+ (,rstd (aref (strides ,x) 0))
+ (,rdat (make-array (if (transpose? ,y) (nrows ,x) (ncols ,x)) :initial-element nil)))
+ (if (transpose? ,y)
+ (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)
+ (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))))))
+ (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)
+ (multiple-value-bind (,r ,s?) (floor (the index-type ,r) ,rstd)
+ (when (zerop ,s?)
+ (push (cons ,r (t/coerce ,(field-type cly) ,value)) (aref ,rdat ,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 ((,row (sort (aref ,rdat ,i) #'(lambda (x y) (< (the index-type x) (the index-type y))) :key #'car)))
+ (loop :for (,r . ,v) :in ,row
+ :do (locally
+ (declare (type ,(field-type cly) ,v)
+ (type index-type ,r))
+ (setf (aref ,vr ,col-stop) ,r)
+ (t/store-set real-compressed-sparse-matrix ,v ,vd ,col-stop)
+ (incf ,col-stop)))
+ (setf (aref ,vi (1+ ,i)) ,col-stop)))))
+ ,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)
+;; (declare (type ,clx ,x) (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 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
+
+;; (let ((,cstd (aref (strides ,x) 1))
+;; (,rdat (make-array (ncols ,x) :initial-element nil)))
+;; (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)
+;; (push (cons ,r (t/coerce ,(field-type cly) ,value)) (aref ,rdat ,c))))
+;; (setf (aref ,vi 0) 0)
+;; (very-quickly
+;; (loop :for ,i :from 0 :below (ncols ,x)
+;; :with ,col-stop := 0
+;; :do (let ((,row (sort (aref ,rdat ,i) #'(lambda (x y) (< (the index-type x) (the index-type y))) :key #'car)))
+;; (loop :for (,r . ,v) :in ,row
+;; :do (locally
+;; (declare (type ,(field-type cly) ,v)
+;; (type index-type ,r))
+;; (setf (aref ,vr ,col-stop) ,r)
+;; (t/store-set real-compressed-sparse-matrix ,v ,vd ,col-stop)
+;; (incf ,col-stop)))
+;; (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)
diff --git a/src/reader/infix.lisp b/src/reader/infix.lisp
index 790fd10..4e55df6 100644
--- a/src/reader/infix.lisp
+++ b/src/reader/infix.lisp
@@ -40,7 +40,7 @@
(find operator *right-associative-operators*))
;; Matlisp helpers
-(defparameter *ref-list* '((cons elt) (array aref) (matlisp::base-tensor matlisp:ref)))
+(defparameter *ref-list* '((cons elt) (array aref) (matlisp::base-tensor matlisp:ref) ))
(defun process-slice (args)
(mapcar #'(lambda (x)
@@ -49,7 +49,7 @@
(if (eql (car x) ':slice)
`(list* ,@(cdr x))
(with-gensyms (idx)
- `(let ((,idx ,x)) (declare (type matlisp::index-type ,idx)) (list ,idx (1+ ,idx))))))
+ `(let ((,idx ,x)) (declare (type matlisp::index-type ,idx)) (list ,idx (unless (= ,idx -1) (1+ ,idx)))))))
((or (numberp x) (symbolp x)) `(list ,x (1+ ,x)))
(t (error 'parser-error :arguments x :message "unknown argument type"))))
args))
@@ -233,17 +233,18 @@
nil)))))))));; and return nil
(defun valid-numberp (string)
- (with-readtable (:common-lisp)
- (realp (read-from-string string))))
- ;; (let ((saw-dot nil))
- ;; (when (> (length string) 0)
- ;; (dolist (char (coerce string 'list) t)
- ;; (cond ((char= char #\.)
- ;; (if saw-dot
- ;; (return nil)
- ;; (setq saw-dot t)))
- ;; ((not (find char "01234567890" :test #'char=))
- ;; (return nil)))))))
+ (when (stringp string)
+ (with-readtable (:common-lisp)
+ (realp (read-from-string string nil nil)))))
+;; (let ((saw-dot nil))
+;; (when (> (length string) 0)
+;; (dolist (char (coerce string 'list) t)
+;; (cond ((char= char #\.)
+;; (if saw-dot
+;; (return nil)
+;; (setq saw-dot t)))
+;; ((not (find char "01234567890" :test #'char=))
+;; (return nil)))))))
;;; Gobbles an expression from the stream.
(defun gather-superiors (previous-operator stream)
commit e4f79071c3818c46ee389c04e01cc086497966e9
Author: Akshay Srinivasan <aks...@gm...>
Date: Thu Apr 3 19:12:13 2014 -0700
Fixed a silly bug in the parse-slice functions.
diff --git a/src/base/base-tensor.lisp b/src/base/base-tensor.lisp
index 9ce80a9..70f01fa 100644
--- a/src/base/base-tensor.lisp
+++ b/src/base/base-tensor.lisp
@@ -250,7 +250,7 @@
(end (proj end (if (> inc 0) d -1) d)))
(declare (type index-type start end inc))
(let ((nd (ceiling (- end start) inc)))
- (when (< nd 0) (return nil))
+ (when (<= nd 0) (return nil))
(collect nd into dims)
(collect (list* start end inc) into psubs))
(finally (return (values psubs dims))))))
@@ -268,7 +268,7 @@
(end (proj end (if (> inc 0) d -1) d)))
(declare (type index-type start end inc))
(let ((nd (ceiling (- end start) inc)))
- (when (< nd 0) (return (values -1 nil nil)))
+ (when (<= nd 0) (return (values -1 nil nil)))
(incf hd (* s start))
(when (or preserve-rank (> nd 1))
(collect nd into dims)
commit 5e67db6057fd19bc32ff2391f2e2a1aa278448b5
Author: Aksh...
[truncated message content] |
