From 62c82e9831e5f616ac3e088adceb854a47d78500 Mon Sep 17 00:00:00 2001 From: mk Date: Mon, 16 Aug 2010 00:08:03 +0100 Subject: [PATCH] i can use convert to switch between vector types ideally I would specify the definitions in vector.lisp with def-generator as well. now the test of convolve runs but i haven't verified the result --- vol-bbox.lisp | 88 +++++++++++++++++++++------------------------------ vol-convert.lisp | 10 +++++- vol-convolve.lisp | 13 ++++++-- vol-macro-macros.lisp | 1 + 4 files changed, 56 insertions(+), 56 deletions(-) diff --git a/vol-bbox.lisp b/vol-bbox.lisp index d2e8f9a..04eff2d 100644 --- a/vol-bbox.lisp +++ b/vol-bbox.lisp @@ -10,59 +10,43 @@ (def-generator (extract-bbox (rank type)) `(defun ,name (a bbox) (declare ((simple-array ,long-type ,rank) a) - ((or vec-i bbox) bbox) + (bbox bbox) (values (simple-array ,long-type ,rank) &optional)) - (let ((bbox (etypecase bbox - (vec-i - (let ((start (v (* 1d0 (vec-i-x bbox)) - (* 1d0 (vec-i-y bbox)) - (* 1d0 (vec-i-z bbox)))) - (db (array-dimensions a))) - (make-bbox :start start - :end (v- (v (* 1d0 (elt db 0)) - (* 1d0 (elt db 1)) - ,(if (= rank 3) - '(* 1d0 (elt db 2)) - '0d0)) - (v 1d0 1d0 ,(if (= rank 3) - '1d0 - '0d0)))))) - (bbox bbox)))) - ,(ecase - rank - (2 `(destructuring-bind (y x) (array-dimensions a) - (with-slots (start end) bbox - (unless (and (< (vec-x end) x) (< (vec-y end) y)) - (error "bbox is bigger than array")) - (let* ((sx (floor (vec-x start))) - (sy (floor (vec-y start))) - (widths (v+ (v- end start) (v 1d0 1d0))) - (res (make-array (list (floor (vec-y widths)) - (floor (vec-x widths))) - :element-type ',long-type))) - (destructuring-bind (yy xx) - (array-dimensions res) - (do-region ((j i) (yy xx)) - (setf (aref res j i) (aref a (+ j sy) (+ i sx))))) - res)))) - (3 `(destructuring-bind (z y x) (array-dimensions a) - (with-slots (start end) bbox - (unless (and (< (vec-x end) x) (< (vec-y end) y) (< (vec-z end) z)) - (error "bbox is bigger than array")) - (let* ((sx (floor (vec-x start))) - (sy (floor (vec-y start))) - (sz (floor (vec-z start))) - (widths (v+ (v- end start) (v 1d0 1d0 1d0))) - (res (make-array (list (floor (vec-z widths)) - (floor (vec-y widths)) - (floor (vec-x widths))) - :element-type ',long-type))) - (destructuring-bind (zz yy xx) - (array-dimensions res) - (do-region ((k j i) (zz yy xx)) - (setf (aref res k j i) - (aref a (+ k sz) (+ j sy) (+ i sx))))) - res)))))))) + ,(ecase + rank + (2 `(destructuring-bind (y x) (array-dimensions a) + (with-slots (start end) bbox + (unless (and (< (vec-x end) x) (< (vec-y end) y)) + (error "bbox is bigger than array")) + (let* ((sx (floor (vec-x start))) + (sy (floor (vec-y start))) + (widths (v+ (v- end start) (v 1d0 1d0))) + (res (make-array (list (floor (vec-y widths)) + (floor (vec-x widths))) + :element-type ',long-type))) + (destructuring-bind (yy xx) + (array-dimensions res) + (do-region ((j i) (yy xx)) + (setf (aref res j i) (aref a (+ j sy) (+ i sx))))) + res)))) + (3 `(destructuring-bind (z y x) (array-dimensions a) + (with-slots (start end) bbox + (unless (and (< (vec-x end) x) (< (vec-y end) y) (< (vec-z end) z)) + (error "bbox is bigger than array")) + (let* ((sx (floor (vec-x start))) + (sy (floor (vec-y start))) + (sz (floor (vec-z start))) + (widths (v+ (v- end start) (v 1d0 1d0 1d0))) + (res (make-array (list (floor (vec-z widths)) + (floor (vec-y widths)) + (floor (vec-x widths))) + :element-type ',long-type))) + (destructuring-bind (zz yy xx) + (array-dimensions res) + (do-region ((k j i) (zz yy xx)) + (setf (aref res k j i) + (aref a (+ k sz) (+ j sy) (+ i sx))))) + res))))))) (defmacro def-extract-box-functions (ranks types) (let ((specifics nil) diff --git a/vol-convert.lisp b/vol-convert.lisp index e6b2c26..3a159b2 100644 --- a/vol-convert.lisp +++ b/vol-convert.lisp @@ -75,6 +75,12 @@ ,(def 'ub8 'df) ,(def 'ub8 'csf) ,(def 'ub8 'cdf) + + ,(def 'fix 'sf) + ,(def 'fix 'df) + ,(def 'fix 'csf) + ,(def 'fix 'cdf) + ,(def 'sf 'df) ,(def 'sf 'csf) @@ -92,7 +98,9 @@ ;; downconvert from float into bytes ,(def 'sf 'ub8 :floor) ,(def 'df 'ub8 :floor) - + ,(def 'sf 'fix :floor) + ,(def 'df 'fix :floor) + ;; convert from complex into real ,@(def-comps 'csf 'sf '(realpart imagpart abs phase)) ,@(def-comps 'cdf 'df '(realpart imagpart abs phase)) diff --git a/vol-convolve.lisp b/vol-convolve.lisp index ee347cd..0dde048 100644 --- a/vol-convolve.lisp +++ b/vol-convolve.lisp @@ -128,12 +128,19 @@ VOLA in RESULT." (defun convolve (vola volb) (multiple-value-bind (conv start) (convolve-nocrop vola volb) - (extract-bbox conv start))) + (let ((s (convert-1-fix/df-mul start)) + (b (convert-1-fix/df-mul + (make-array 3 :element-type 'fixnum + :initial-contents + (reverse (array-dimensions volb)))))) + (extract-bbox conv + (make-bbox :start s + :end (v+ s b)))))) #+nil -(let ((a (make-array (list 100 200 300) +(let ((a (make-array (list 20 40 30) :element-type '(complex single-float))) - (b (make-array (list 10 200 30) + (b (make-array (list 10 20 30) :element-type '(complex single-float)))) (convolve a b) nil) diff --git a/vol-macro-macros.lisp b/vol-macro-macros.lisp index cd47809..a5906eb 100644 --- a/vol-macro-macros.lisp +++ b/vol-macro-macros.lisp @@ -8,6 +8,7 @@ ((complex single-float) . csf) (double-float . df) (single-float . sf) + (fixnum . fix) ((signed-byte 16) . sb16) ((unsigned-byte 16) . ub16) ((unsigned-byte 8) . ub8)))) -- 2.11.4.GIT