Menu
▾
▴
[Matlisp-commit] [matlisp-git]matlisp branch tensor updated. 2012-02-23-104-gd5f7ad3
|
From: Akshay S. <ak...@us...> - 2012-07-04 14:18:51
|
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 d5f7ad309ca59d41c6e405c512f9a3544be01ea2 (commit)
from a005336f729ed3ce87bb327a6fa6441612fa20f9 (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 d5f7ad309ca59d41c6e405c512f9a3544be01ea2
Author: Akshay Srinivasan <aks...@gm...>
Date: Wed Jul 4 19:43:59 2012 +0530
Optimised blas-copyable-p with the permutation sorter.
diff --git a/matlisp.asd b/matlisp.asd
index cbdbae3..5db4d00 100644
--- a/matlisp.asd
+++ b/matlisp.asd
@@ -91,10 +91,10 @@
;;
(:file "loopy"
:depends-on ("standard-tensor"))
- (:file "blas-helpers"
- :depends-on ("standard-tensor"))
(:file "permutation"
:depends-on ("standard-tensor"))
+ (:file "blas-helpers"
+ :depends-on ("standard-tensor" "permutation"))
;;
(:file "real-tensor"
:depends-on ("standard-tensor"))
@@ -115,7 +115,7 @@
:depends-on ("copy" "loopy"))
(:file "realimag"
:depends-on ("real-tensor" "complex-tensor" "copy"))
- ))))
+ ))))
;; (defclass f2cl-cl-source-file (asdf:cl-source-file)
diff --git a/src/blas-helpers.lisp b/src/blas-helpers.lisp
index 3817137..1d7f147 100644
--- a/src/blas-helpers.lisp
+++ b/src/blas-helpers.lisp
@@ -1,100 +1,40 @@
(in-package :matlisp)
-(definline idx-max (seq)
- (declare (type (index-array *) seq))
- (reduce #'max seq))
-
-(definline idx-min (seq)
- (declare (type (index-array *) seq))
- (reduce #'min seq))
-
-(defun idx= (a b)
- (declare (type (index-array *) a b))
- (when (= (length a) (length b))
- (very-quickly
- (loop
- for ele-a across a
- for ele-b across b
- unless (= ele-a ele-b)
- do (return nil)
- finally (return t)))))
-
-(definline idx->list (a)
- (declare (type (index-array *) a))
- (loop for ele across a
- collect ele))
-
(defun blas-copyable-p (ten-a ten-b)
- ;; (declare (type standard-tensor ten-a ten-b))
- ;; (let ((stdi-a (very-quickly
- ;; (sort (apply #'vector
- ;; (loop
- ;; for std across (strides ten-a)
- ;; and dim across (dimensions ten-a)
- ;; collect `(,std ,dim)))
- ;; #'< :key #'first))))
- ;; t))
-
-
- (let ((stdi-list (very-quickly
- (loop
- for ten of-type standard-tensor in tensors
- and pten = nil then ten
- for i of-type index-type = 0 then (1+ i)
- when (> i 0)
- do (unless (idx= (dimensions ten) (dimensions pten))
- (return nil))
- collect (progn
- (assert (typep ten 'standard-tensor) nil
- 'invalid-type :given (type-of ten) :expected 'standard-tensor)
- (very-quickly
- (sort (apply #'vector
- (loop
- for std of-type index-type across (strides ten)
- and dim of-type index-type across (dimensions ten)
- collect `(,std ,dim)))
- #'< :key #'car)))))))
- (if (null stdi-list) (values nil nil)
- (very-quickly
- (loop
- for stdi in stdi-list
- and p-stdi = (first stdi-list) then stdi
- for i of-type index-type = 0 then (1+ i)
- when (> i 0)
- do (unless (loop
- for a-stdi across stdi
- and a-aoff = (first (aref stdi 0)) then (* a-aoff (second a-stdi))
- for b-stdi across p-stdi
- and b-aoff = (first (aref p-stdi 0)) then (* b-aoff (second b-stdi))
- do (unless (and (= (first a-stdi) a-aoff)
- (= (first b-stdi) b-aoff)
- (= (second a-stdi) (second b-stdi)))
- (return nil))
- finally (return t))
- (return (values t nil)))
- finally (return (values t (mapcar #'(lambda (x) (first (aref x 0))) stdi-list))))))))
+ (declare (type standard-tensor ten-a ten-b))
+ (mlet*
+ (((sort-std-a std-a-perm) (idx-sort-permute (copy-seq (strides ten-a)) #'<) :type ((index-array *) permutation))
+ (perm-a-dims (permute (dimensions ten-a) std-a-perm) :type (index-array *))
+ ;;If blas-copyable then the strides must have the same sorting permutation.
+ (sort-std-b (permute (strides ten-b) std-a-perm) :type (index-array *))
+ (perm-b-dims (permute (dimensions ten-b) std-a-perm) :type (index-array *)))
+ (very-quickly
+ (loop
+ for sost-a across sort-std-a
+ for sodi-a across perm-a-dims
+ for a-aoff of-type index-type = (aref sort-std-a 0) then (the index-type (* a-aoff sodi-a))
+ ;;
+ for sost-b across sort-std-b
+ for sodi-b across perm-b-dims
+ for b-aoff of-type index-type = (aref sort-std-b 0) then (the index-type (* b-aoff sodi-b))
+ ;;
+ do (unless (and (= sost-a a-aoff)
+ (= sost-b b-aoff)
+ (= sodi-a sodi-b))
+ (return nil))
+ finally (return (list (aref sort-std-a 0) (aref sort-std-b 0)))))))
(defun consecutive-store-p (tensor)
(declare (type standard-tensor tensor))
- (let ((strides (strides tensor))
- (dims (dimensions tensor)))
- (declare (type (index-array *) strides dims))
- (let* ((stride-dims (very-quickly
- (sort (apply #'vector
- (loop
- for std across strides
- and dim across dims
- collect `(,std ,dim)))
- #'< :key #'car)))
- (stride-min (first (aref stride-dims 0))))
- (declare (type index-type stride-min)
- (type (simple-vector *) stride-dims))
+ (mlet* (((sort-std std-perm) (idx-sort-permute (copy-seq (strides tensor)) #'<) :type ((index-array *) permutation))
+ (perm-dims (permute (dimensions tensor) std-perm) :type (index-array *)))
(very-quickly
(loop
- for st-di across stride-dims
- and accumulated-off = stride-min then (* accumulated-off (second st-di))
- unless (= (first st-di) accumulated-off) do (return nil)
- finally (return stride-min))))))
+ for so-st across sort-std
+ for so-di across perm-dims
+ and accumulated-off = (aref sort-std 0) then (the index-type (* accumulated-off so-di))
+ unless (= so-st accumulated-off) do (return nil)
+ finally (return (aref sort-std 0))))))
;; (defun blas-matrix-compatible-p (matrix &optional (op :n))
diff --git a/src/copy.lisp b/src/copy.lisp
index 95bcaf2..56866f8 100644
--- a/src/copy.lisp
+++ b/src/copy.lisp
@@ -86,23 +86,20 @@
(assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
`(defun ,func (from to)
(declare (type ,tensor-class from to))
- (multiple-value-bind (dims-p strd-p) (blas-copyable-p from to)
- (unless dims-p
- (error 'tensor-dimension-mismatch))
- (if strd-p
- (,blas-func (number-of-elements from) (store from) (first strd-p) (store to) (second strd-p) (head from) (head to))
- (let ((f-sto (store from))
- (t-sto (store to)))
- (declare (type ,(linear-array-type (getf opt :store-type)) f-sto t-sto))
- (very-quickly
- ;;Can possibly make this faster (x2) by using ,blas-func in one of
- ;;the inner loops, but this is to me messy and as of now unnecessary.
- ;;SBCL can already achieve Fortran-ish speed inside this loop.
- (mod-dotimes (idx (dimensions from))
- with (linear-sums
- (f-of (strides from) (head from))
- (t-of (strides to) (head to)))
- do ,(funcall (getf opt :reader-writer) 'f-sto 'f-of 't-sto 't-of))))))
+ (if-let (strd-p (blas-copyable-p from to))
+ (,blas-func (number-of-elements from) (store from) (first strd-p) (store to) (second strd-p) (head from) (head to))
+ (let ((f-sto (store from))
+ (t-sto (store to)))
+ (declare (type ,(linear-array-type (getf opt :store-type)) f-sto t-sto))
+ (very-quickly
+ ;;Can possibly make this faster (x2) by using ,blas-func in one of
+ ;;the inner loops, but this is to me messy and as of now unnecessary.
+ ;;SBCL can already achieve Fortran-ish speed inside this loop.
+ (mod-dotimes (idx (dimensions from))
+ with (linear-sums
+ (f-of (strides from) (head from))
+ (t-of (strides to) (head to)))
+ do ,(funcall (getf opt :reader-writer) 'f-sto 'f-of 't-sto 't-of)))))
to)))
(defmacro generate-typed-num-copy! (func (tensor-class blas-func))
diff --git a/src/permutation.lisp b/src/permutation.lisp
index 40e0af2..d00653e 100644
--- a/src/permutation.lisp
+++ b/src/permutation.lisp
@@ -10,9 +10,35 @@
do (setf (aref ret i) i)))
ret))
+(definline idx-max (seq)
+ (declare (type (index-array *) seq))
+ (reduce #'max seq))
+
+(definline idx-min (seq)
+ (declare (type (index-array *) seq))
+ (reduce #'min seq))
+
+(defun idx= (a b)
+ (declare (type (index-array *) a b))
+ (when (= (length a) (length b))
+ (very-quickly
+ (loop
+ for ele-a across a
+ for ele-b across b
+ unless (= ele-a ele-b)
+ do (return nil)
+ finally (return t)))))
+
+(definline idx->list (a)
+ (declare (type (index-array *) a))
+ (loop for ele across a
+ collect ele))
+
+;;Write a uniform randomiser
(defun seqrnd (seq)
"Randomize the elements of a sequence. Destructive on SEQ."
- (sort seq #'> :key #'(lambda (x) (random 1.0))))
+ (sort seq #'> :key #'(lambda (x) (declare (ignore x))
+ (random 1.0))))
;;Class definitions----------------------------------------------;;
(defclass permutation ()
diff --git a/src/realimag.lisp b/src/realimag.lisp
index 4dbc7c3..1b9a00e 100644
--- a/src/realimag.lisp
+++ b/src/realimag.lisp
@@ -140,4 +140,4 @@
See IMAG, REALPART, IMAGPART
"
- (copy (tensor-imagpart tensor)))
+ (copy (tensor-imagpart~ tensor)))
-----------------------------------------------------------------------
Summary of changes:
matlisp.asd | 6 +-
src/blas-helpers.lisp | 118 ++++++++++++-------------------------------------
src/copy.lisp | 31 ++++++-------
src/permutation.lisp | 28 +++++++++++-
src/realimag.lisp | 2 +-
5 files changed, 74 insertions(+), 111 deletions(-)
hooks/post-receive
--
matlisp
|
