Re: Extreme dynamic extent...
On Wed, 16 Oct 2013 18:35:41 +0100, Martin Simmons <martin@lispworks.com>
wrote:
>> it does seem to be quite low on consing, it is about 60% slower than
>> typed-aref version but its allocation is about 30% of the typed-aref's.
>
> It would be interesting to see the code. Are both examples using the
> same
> float type?
I assume they both are using double-floats. The performance difference
became less drastic once I used (debug 0) in your version. Also, in my
version I use lookup tables instead of multiplication of twiddle factors,
that seems to be faster.
Following below is my code with typed arrays (I hope other humans can read
it too). Hopefully it should compile for you straight away, you'll only
need to call a couple of functions from the top level to get it working:
(reinit 2048 1 'cos) ;will create two typed arrays A and B with B blank
and A containing a cosine wave of frequency 1, (reinit) will do it by
default
or
(reinit2 0 2048) ;will create two typed arrays A and B with B blank and A
containing a 1000.0d0 value at position 0 with the rest being 0.0d0,
(reinit2) will do it by default
(forward a b) ;will preform a forward transform
(inverse a b) ;will perform an inverse transform
(test 1000) ;will perform a 1000 forward/inverse transform pairs using the
typed arrays A and B defined earlier by (reinit) and (reinit2)
(defmacro with-gensyms ((&rest vars) &body body)
`(let ,(mapcar (lambda (x) `(,x (gensym))) vars)
,@body))
;;A faster trimmed down iterator
(defmacro for ((num &optional (var 'x) (incr 1) (from 0))&body body)
(with-gensyms (count by start)
`(let ((,var ,from) (,count ,num) (,by ,incr))
(declare (fixnum ,var ,count ,by))
(tagbody
,start
,@body
(setq ,var (+ ,var ,by))
(if (< ,var ,count) (go ,start))))))
;;Number of stages calculator
(defun logn (len)
(declare (optimize (float 0) (safety 0) (debug 0) (speed 3)
(space 0) (compilation-speed 0)))
(declare (fixnum len))
(truncate (log len 2)))
;;Shorthands of some lengthy access expressions
(defmacro mtav (float-num) `(sys:make-typed-aref-vector (* 8 ,float-num)))
(defmacro faref (tar x) `(sys:typed-aref 'double-float ,tar ,x))
(defmacro ar (x) `(faref rex ,x))
(defmacro ai (x) `(faref img ,x))
;;Multiplication of the real part of two complex numbers (a + bj)*(c + dj)
(defmacro cr* (a b c d) `(- (* ,a ,c) (* ,b ,d)))
;;Multiplication of the imaginary part of two complex numbers (a + bj)*(c
+ dj)
(defmacro ci* (a b c d) `(+ (* ,a ,d) (* ,c ,b)))
;;This retrieves sr and si values from lookup array by using variable
capture
(define-symbol-macro sr (faref cos x))
(define-symbol-macro si (faref sin x))
;;Default length
(defparameter *len* 2048)
;;Generates a lookup array for a specific DFT length len and a function,
either cos, or -sin
(defun tri (&optional (len *len*)(fn (lambda (x) (- (sin x)))))
(declare (optimize (float 0) (safety 0) (debug 0)))
(loop with stages = (logn len)
with out = (make-array stages)
for stage below stages
for size = (expt 2 stage)
for w = (/ pi size)
for arr = (setf (aref out stage) (mtav size))
do (for (size)
(setf (faref arr (* x 8))
(funcall fn (* w x))))
finally return out))
;;Bit-reverse sorting
(defun bsort (rex img)
(declare (optimize (float 0) (safety 0) (debug 0) (speed 3)
(space 0) (compilation-speed 0)))
(let* ((len (length rex))
(n/2 (* len 4))
(j n/2)
(k 0) (tr 0.0d0) (ti 0.0d0))
(declare (fixnum len n/2 j k)
(double-float tr ti))
(for ((* 8 (1- len)) i 8 8)
(if (>= i j) (go l1190))
(setq tr (ar j)
ti (ai j))
(setf (ar j) (ar i)
(ai j) (ai i)
(ar i) tr
(ai i) ti)
l1190
(setq k n/2)
l1200
(if (> k j) (go l1240))
(setq j (- j k)
k (/ k 2))
(go l1200)
l1240
(setq j (+ j k)))))
(let ((sins (tri *len*))
(coss (tri *len* 'cos)))
(defun forward (rex img)
(declare (optimize (float 0) (safety 0) (debug 0)))
(let* ((len (length rex))
(stages (logn len))
(len8 (* 8 len)))
(declare (fixnum len stages len8))
(bsort rex img)
(let ((dft-size 0) (2x-dft-size 0) (end 0)
(tr 0.0d0) (ti 0.0d0) cos sin)
(declare (fixnum dft-size 2x-dft-size end)
(double-float tr ti))
(for (stages stage)
(setq dft-size (expt 2 (+ stage 3))
2x-dft-size (* dft-size 2)
cos (svref coss stage)
sin (svref sins stage))
(for (dft-size x 8)
(for (len8 pos 2x-dft-size x)
(setq end (+ pos dft-size)
tr (cr* (ar end) (ai end) sr si)
ti (ci* (ar end) (ai end) sr si))
(setf (ar end) (- (ar pos) (the double-float tr)) ;Seems
like specifying temp values as double floats
(ai end) (- (ai pos) (the double-float ti)) ;made it a
tad faster
(ar pos) (+ (ar pos) (the double-float tr))
(ai pos) (+ (ai pos) (the double-float ti))))))))))
(defmacro for8 (num &rest body) `(for ((* 8 ,num) x 8) ,@body)) ;Just a
little shorthand
(defun inverse (rex img)
(declare (optimize (float 0) (safety 0) (debug 0) (speed 3)
(space 0) (compilation-speed 0)))
(let* ((len (length rex))
(lenf (coerce len 'double-float)))
(declare (fixnum len) (double-float lenf))
(for8 len
(setf (ai x) (- (/ (ai x) lenf))
(ar x) (/ (ar x) lenf)))
(forward rex img)
(for8 len
(setf (ai x) (- (ai x))))))
(defun reinit (&optional (size *len*) (f 1) (fn 'cos))
(setf a (mtav size)
b (mtav size))
(loop for x below size
for y by 8
with w = (* 2 pi (/ f size))
do (setf (faref a y) (* 1000 (funcall fn (* x w)))
(faref b y) 0.0d0)))
(defun reinit2 (&optional (pos 0) (size *len*))
(setf a (mtav size)
b (mtav size))
(for ((* size 8) x 8)
(setf (faref a x) 1000.0d0 (faref b x) 0.0d0))
(setf (faref a (* 8 pos)) 1000.0d0
(faref b (* 8 pos)) 0.0d0)
(values a b))
(defun test (n)
(declare (optimize (float 0) (safety 0) (debug 0) (speed 3)
(space 0) (compilation-speed 0)))
(for (n)
(forward a b)
(inverse a b)))
_______________________________________________
Lisp Hug - the mailing list for LispWorks users
lisp-hug@lispworks.com
http://www.lispworks.com/support/lisp-hug.html