1 ;; define a bunch of functions to convert an {1,2,3}-dimensional array
2 ;; from one type into another type.
5 ;; for writing several type conversion functions will have a name like
6 ;; convert-3-ub8/cdf-mul the rank is looped over 1, 2 and 3. here the
7 ;; suffix mul indicates that type (up-)conversion is forced by a
8 ;; multiplication. other suffixes are floor for conversion into fixed
9 ;; type and coerce. coerce seemed to be quite slow last time i
10 ;; tried. thats why i prefer the multiplication for most conversions.
12 (def-generator (convert (rank type out_type func short_func
))
13 (let ((long-out-type (get-long-type out_type
))
14 ;; override the name that is constructed by def-generator
15 (name (format-symbol "convert-~a-~a/~a-~a"
18 (store-new-function name
)
20 (declare ((simple-array ,long-type
,rank
) a
)
21 (values (simple-array ,long-out-type
,rank
) &optional
))
22 (let* ((result (make-array (array-dimensions a
)
23 :element-type
(quote ,long-out-type
)))
24 (result1 (sb-ext:array-storage-vector result
))
25 (a1 (sb-ext:array-storage-vector a
))
28 (setf (aref result1 i
)
29 (funcall ,func
(aref a1 i
))))
33 (def-convert-rank-type-out_type-func-short_func
34 1 sf df
#'(lambda (x) (* 1d0 x
)) coerce
)
36 (def-convert-rank-type-out_type-func-short_func
37 1 ub8 csf
#'(lambda (x) (complex (* 1d0 x
))) complex
)
39 (convert-1-sf/df-coerce
40 (make-array 4 :element-type
'single-float
))
43 (defmacro def-convert-functions
()
44 (labels ( ;; create a spec like this: ub8 sf (* 1s0 x) mul
45 ;; down can be used to convert double into float
46 (def (in-type out-type
&optional
(fun t
))
52 (:coerce
`(coerce x
',(get-long-type out-type
)))
53 (t `(* ,(coerce 1 (get-long-type out-type
)) x
))))
58 ;; create downconversions from complex types like
59 ;; cdf df #'realpart realpart
60 (def-comps (in-type out-type functions
&optional
(fun t
))
61 (loop for func in functions collect
65 (:floor
`#'(lambda (x) (floor (funcall #',func x
))))
68 ;; an element of spec looks like this: (ub8 sf #'(lambda(x) (* 1s0 x))
69 ;; mul) the first two cols define input and output types, then
70 ;; comes a function that does this conversion followed by a short
71 ;; name describing the function. this name is attached to the
73 (let ((specs `(;; upconvert from ub8 into sf and similar
85 ;; upconvert complex to complex
88 ;; downconvert from double into single
89 ,(def 'df
'sf
:coerce
)
90 ,(def 'cdf
'csf
:coerce
)
92 ;; downconvert from float into bytes
93 ,(def 'sf
'ub8
:floor
)
94 ,(def 'df
'ub8
:floor
)
96 ;; convert from complex into real
97 ,@(def-comps 'csf
'sf
'(realpart imagpart abs phase
))
98 ,@(def-comps 'cdf
'df
'(realpart imagpart abs phase
))
100 ;; complex into real and conversion into fixed
101 ,@(def-comps 'csf
'ub8
'(realpart imagpart abs phase
) :floor
)
102 ,@(def-comps 'cdf
'ub8
'(realpart imagpart abs phase
) :floor
)
105 (loop for rank in
'(1 2 3) do
106 (loop for spec in specs do
107 (destructuring-bind (in out fun name
)
109 (push `(def-convert-rank-type-out_type-func-short_func
110 ,rank
,in
,out
,fun
,name
)
114 (def-convert-functions)
117 (convert-3-cdf/ub8-realpart
118 (make-array (list 3 3 3) :element-type
'(complex double-float
)))
121 (convert-3-csf/cdf-mul
122 (make-array (list 3 3 3) :element-type
'(complex single-float
)))
125 ;; converting complex into real with some function and converting into
126 ;; out_type, the name of the functions will be like:
127 ;; normalize-3-cdf/ub8-realpart. the function is evaluated into an
128 ;; intermediate real array (either double or float depending on the
129 ;; input type) and then normalized into the result. float results are
130 ;; in 0..1 and ub8 results in 0..255.
131 (def-generator (normalize-complex (rank type out_type func short_func
))
132 (let ((long-out-type (get-long-type out_type
))
133 ;; override the name that is constructed by def-generator
134 (name (format-symbol "normalize-~a-~a/~a-~a"
135 rank type out_type short_func
))
136 (intermed-type (ecase type
138 (csf 'single-float
))))
139 (store-new-function name
)
141 (declare ((simple-array ,long-type
,rank
) a
)
142 (values (simple-array ,long-out-type
,rank
) &optional
))
143 (let* ((result (make-array (array-dimensions a
)
144 :element-type
',long-out-type
))
145 (result1 (sb-ext:array-storage-vector result
))
146 (a1 (sb-ext:array-storage-vector a
))
149 (make-array n
:element-type
',intermed-type
)))
151 (setf (aref intermediate1 i
) (funcall ,func
(aref a1 i
))))
152 (let* ((ma (reduce #'max intermediate1
))
153 (mi (reduce #'min intermediate1
))
155 (coerce 0 ',intermed-type
)
158 (let ((v (* s
(- (aref intermediate1 i
) mi
))))
159 (setf (aref result1 i
) ,(if (eq 'ub8 out_type
)
161 `(* (coerce 1 ',long-out-type
) v
)))))
165 (def-normalize-complex-rank-type-out_type-func-short_func
166 1 csf ub8
#'realpart realpart
)
168 (defmacro def-normalize-complex-functions
(ranks out-types funcs
)
170 (loop for rank in ranks do
171 (loop for type in
'(csf cdf
) do
172 (loop for otype in out-types do
173 (loop for func in funcs do
174 (push `(def-normalize-complex-rank-type-out_type-func-short_func ,rank
,type
,otype
#',func
,func
)
178 (def-normalize-complex-functions
179 (1 2 3) (ub8 sf df
) (realpart imagpart phase abs
))
182 (normalize-1-csf/ub8-realpart
183 (make-array 3 :element-type
'(complex single-float
)
184 :initial-contents
'(#C
(1s0 0s0
) #C
(2s0 0s0
) #C
(3s0 0s0
))))
187 (normalize-1-csf/df-phase
188 (make-array 3 :element-type
'(complex single-float
)
189 :initial-contents
'(#C
(1s0 .2s0
) #C
(2s0 1s0
) #C
(3s0 0s0
))))
191 ;; normalize real arrays, name like: normalize-2-sf/ub8
192 (def-generator (normalize (rank type out_type
))
193 (let ((long-out-type (get-long-type out_type
))
194 ;; override the name that is constructed by def-generator
195 (name (format-symbol "normalize-~a-~a/~a"
196 rank type out_type
)))
197 (store-new-function name
)
199 (declare ((simple-array ,long-type
,rank
) a
)
200 (values (simple-array ,long-out-type
,rank
) &optional
))
201 (let* ((result (make-array (array-dimensions a
)
202 :element-type
',long-out-type
))
203 (result1 (sb-ext:array-storage-vector result
))
204 (a1 (sb-ext:array-storage-vector a
))
206 (ma (reduce #'max a1
))
207 (mi (reduce #'min a1
))
209 (coerce 0 ',(get-long-type type
))
212 (let ((v (* s
(- (aref a1 i
) mi
))))
213 (setf (aref result1 i
) ,(if (eq 'ub8 out_type
)
215 `(* (coerce 1 ',long-out-type
) v
)))))
218 (def-normalize-rank-type-out_type 1 df ub8
)
220 (normalize-1-df/ub8
(make-array 3 :element-type
'double-float
221 :initial-contents
'(1d0 2d0
3d0
)))
223 (defmacro def-normalize-functions
(ranks in-types out-types
)
225 (loop for rank in ranks do
226 (loop for type in in-types do
227 (loop for otype in out-types do
228 (push `(def-normalize-rank-type-out_type ,rank
,type
,otype
)
232 (def-normalize-functions (1 2 3) (ub8 sf df
) (ub8 sf df
))
235 (normalize-1-sf/sf
(make-array 3 :element-type
'single-float
236 :initial-contents
'(1s0 2s0
3s0
)))
238 (normalize-1-sf/ub8
(make-array 3 :element-type
'single-float
239 :initial-contents
'(1s0 2s0
3s0
)))
241 (normalize-1-ub8/sf
(make-array 3 :element-type
'(unsigned-byte 8)
242 :initial-contents
'(1 2 3)))
244 (normalize-1-ub8/ub8
(make-array 3 :element-type
'(unsigned-byte 8)
245 :initial-contents
'(1 2 3)))
247 #+nil
;; find the names of all the functions that were defined by the
248 ;; above macros, for exporting
249 ;; 2010-08-14 I don't think I need this anymore
251 (with-package-iterator (next-symbol *package
* :internal
)
252 (loop (multiple-value-bind (more? symbol
)
257 (loop for s in
(delete-if-not #'(lambda (x)
258 (let* ((pat "CONVERT"
262 (when (< lpat
(length x
))
266 (mapcar #'(lambda (x)
267 (format nil
"~a" x
)) res
))
268 do
(format t
"#:~a~%" (string-downcase s
))))