1 ;; some operations that are defined between and on n-arrays,
2 ;; e.g. point-wise addition or averaging
5 ;; the functions .* .+ ./ .- will do a point-wise operation on an
6 ;; n-array. here I define specific functions like: .*-2-df. Both
7 ;; volumes A and B must have the same dimensions or B must be smaller
8 ;; in all dimensions. In the latter case a vec-i has to be supplied in
9 ;; B-START to define the relative position of B inside A.
11 (def-generator (point-wise (op rank type
))
12 (let ((name (format-symbol ".~a-~a-~a" op rank type
)))
13 (store-new-function name
)
14 `(defun ,name
(a b
&optional
(b-start (make-vec-i)))
15 (declare ((simple-array ,long-type
,rank
) a b
)
17 (values (simple-array ,long-type
,rank
) &optional
))
18 (let ((result (make-array (array-dimensions b
)
19 :element-type
',long-type
)))
21 (1 `(destructuring-bind (x)
23 (let ((sx (vec-i-x b-start
)))
28 (2 `(destructuring-bind (y x
)
30 (let ((sx (vec-i-x b-start
))
31 (sy (vec-i-y b-start
)))
32 (do-region ((j i
) (y x
))
33 (setf (aref result j i
)
34 (+ (aref a
(+ j sy
) (+ i sx
))
36 (3 `(destructuring-bind (z y x
)
38 (let ((sx (vec-i-x b-start
))
39 (sy (vec-i-y b-start
))
40 (sz (vec-i-z b-start
)))
41 (do-region ((k j i
) (z y x
))
42 (setf (aref result k j i
)
43 (+ (aref a
(+ k sz
) (+ j sy
) (+ i sx
))
47 (def-point-wise-op-rank-type * 1 sf
)
49 (def-point-wise-op-rank-type * 1 cdf
)
53 :element-type
'single-float
54 :initial-contents
'(1s0 2s0
3s0
))
56 :element-type
'single-float
57 :initial-contents
'(2s0 2s0
3s0
)))
59 (defmacro def-point-wise-functions
(ops ranks types
)
60 (let ((specific-funcs nil
)
62 (loop for rank in ranks do
63 (loop for type in types do
64 (loop for op in ops do
65 (push `(def-point-wise-op-rank-type ,op
,rank
,type
)
67 (loop for op in ops do
69 (loop for rank in ranks do
70 (loop for type in types do
71 (push `((simple-array ,(get-long-type type
) ,rank
)
72 (,(format-symbol ".~a-~a-~a" op rank type
)
75 (let ((name (format-symbol ".~a" op
)))
76 (store-new-function name
)
77 (push `(defun ,name
(a b
&optional
(b-start (make-vec-i)))
80 (t (error "The given type can't be handled with a generic
81 point-wise function."))))
83 `(progn ,@specific-funcs
86 (def-point-wise-functions (+ -
* /) (1 2 3) (ub8 sf df csf cdf
))
89 (.
* (make-array 3 :element-type
'single-float
90 :initial-contents
'(1s0 2s0
3s0
))
91 (make-array 3 :element-type
'single-float
92 :initial-contents
'(2s0 2s0
3s0
)))
94 ;; now I define multiplication and addition with a scalar. I can't
95 ;; remember that I needed those, therefore the slower non-generic
98 (let* ((a (sb-ext:array-storage-vector vol
))
101 (setf (aref a i
) (* s
(aref a i
)))))
104 (let* ((a (sb-ext:array-storage-vector vol
))
107 (setf (aref a i
) (+ s
(aref a i
)))))
110 (def-generator (mean (rank type
))
112 "Calculate the average value over all the samples in array A."
113 (declare ((simple-array ,long-type
,rank
) a
)
114 (values ,long-type
&optional
))
115 (let* ((a1 (sb-ext:array-storage-vector a
))
116 (sum (coerce 0 ',long-type
))
118 (declare (,(if (eq type
'ub8
)
122 (incf sum
(aref a1 i
)))
125 (def-mean-rank-type 1 sf
)
128 (make-array 3 :element-type
'single-float
129 :initial-contents
'(2s0 2s0
3s0
)))
131 (defmacro def-mean-functions
(ranks types
)
134 (loop for rank in ranks do
135 (loop for type in types do
136 (push `(def-mean-rank-type ,rank
,type
)
138 (loop for rank in ranks do
139 (loop for type in types do
140 (push `((simple-array ,(get-long-type type
) ,rank
)
141 (,(format-symbol "mean-~a-~a" rank type
)
144 (store-new-function (format-symbol "mean"))
149 (t (error "The given type can't be handled with a generic
150 averaging function mean.")))))))
152 (def-mean-functions (1 2 3) (ub8 sf df csf cdf
))
156 (make-array 4 :element-type
'single-float
157 :initial-contents
'(2s0 2s0
3s0
3s0
)))