clem 0.4.1, ch-asdf 0.2.8, ch-util 0.2.2, lift 1.3.1, darcs ignored, smarkup 0.3.3
[CommonLispStat.git] / external / clem / src / scale.lisp
blob6fd1a59728848ae2468baeb2cb3889b33ddfed8b
2 (in-package :clem)
4 (defgeneric mat-scale-range-2 (m n q startr endr startc endc))
5 (defgeneric mat-scale-2 (m n q))
7 (defmacro def-matrix-scale-2 (input-class result-class)
8 (let ((input-class-element-type (element-type (find-class `,input-class)))
9 (result-class-element-type (element-type (find-class `,result-class))))
10 `(progn
11 (defmethod mat-scale-range-2
12 ((m ,input-class) (n ,result-class) q startr endr startc endc)
13 (with-typed-mref (m ,input-class-element-type)
14 (with-typed-mref (n ,result-class-element-type)
15 (do ((i startr (1+ i)))
16 ((> i endr))
17 (declare (dynamic-extent i) (type fixnum i))
18 (do ((j startc (1+ j)))
19 ((> j endc))
20 (declare (dynamic-extent j) (type fixnum j))
21 (setf (mref n i j) (* (mref m i j) q))))))
24 (defmethod mat-scale-2
25 ((m ,input-class) (n ,result-class) q)
26 (with-typed-mref (m ,input-class-element-type)
27 (with-typed-mref (n ,result-class-element-type)
28 (loop for i from 0 below (matrix-total-size m)
29 do (setf (row-major-mref n i)
30 (* (row-major-mref m i) q))))
31 n)))))
33 (progn
34 (def-matrix-scale-2 double-float-matrix complex-matrix)
35 (def-matrix-scale-2 double-float-matrix double-float-matrix)
37 (def-matrix-scale-2 single-float-matrix complex-matrix)
38 (def-matrix-scale-2 single-float-matrix double-float-matrix)
39 (def-matrix-scale-2 single-float-matrix single-float-matrix)
41 (def-matrix-scale-2 unsigned-byte-matrix complex-matrix)
42 (def-matrix-scale-2 unsigned-byte-matrix double-float-matrix)
43 (def-matrix-scale-2 unsigned-byte-matrix single-float-matrix)
44 (def-matrix-scale-2 unsigned-byte-matrix integer-matrix)
45 (def-matrix-scale-2 unsigned-byte-matrix unsigned-byte-matrix)
47 (def-matrix-scale-2 ub8-matrix complex-matrix)
48 (def-matrix-scale-2 ub8-matrix double-float-matrix)
49 (def-matrix-scale-2 ub8-matrix single-float-matrix)
50 (def-matrix-scale-2 ub8-matrix ub8-matrix)
51 (def-matrix-scale-2 ub8-matrix ub16-matrix)
52 (def-matrix-scale-2 ub8-matrix ub32-matrix)
54 (def-matrix-scale-2 ub16-matrix complex-matrix)
55 (def-matrix-scale-2 ub16-matrix double-float-matrix)
56 (def-matrix-scale-2 ub16-matrix single-float-matrix)
57 (def-matrix-scale-2 ub16-matrix ub16-matrix)
58 (def-matrix-scale-2 ub16-matrix ub32-matrix)
60 (def-matrix-scale-2 ub32-matrix complex-matrix)
61 (def-matrix-scale-2 ub32-matrix double-float-matrix)
62 (def-matrix-scale-2 ub32-matrix single-float-matrix)
63 (def-matrix-scale-2 ub32-matrix ub32-matrix)
65 (def-matrix-scale-2 sb8-matrix complex-matrix)
66 (def-matrix-scale-2 sb8-matrix double-float-matrix)
67 (def-matrix-scale-2 sb8-matrix single-float-matrix)
68 (def-matrix-scale-2 sb8-matrix sb8-matrix)
69 (def-matrix-scale-2 sb8-matrix sb16-matrix)
70 (def-matrix-scale-2 sb8-matrix sb32-matrix)
72 (def-matrix-scale-2 sb16-matrix complex-matrix)
73 (def-matrix-scale-2 sb16-matrix double-float-matrix)
74 (def-matrix-scale-2 sb16-matrix single-float-matrix)
75 (def-matrix-scale-2 sb16-matrix sb16-matrix)
76 (def-matrix-scale-2 sb16-matrix sb32-matrix)
78 (def-matrix-scale-2 sb32-matrix complex-matrix)
79 (def-matrix-scale-2 sb32-matrix double-float-matrix)
80 (def-matrix-scale-2 sb32-matrix single-float-matrix)
81 (def-matrix-scale-2 sb32-matrix sb32-matrix)
83 (def-matrix-scale-2 bit-matrix ub8-matrix)
84 (def-matrix-scale-2 bit-matrix sb32-matrix)
85 (def-matrix-scale-2 fixnum-matrix fixnum-matrix)
86 (def-matrix-scale-2 real-matrix real-matrix)
87 (def-matrix-scale-2 integer-matrix integer-matrix)
88 (def-matrix-scale-2 complex-matrix complex-matrix)
89 (def-matrix-scale-2 t-matrix t-matrix))
91 (defgeneric compute-mat-scale-result-class (m q))
93 (defmethod compute-mat-scale-result-class ((m double-float-matrix) q)
94 (typecase q
95 (complex 'complex-matrix)
96 (t (class-of m))))
98 (defmethod compute-mat-scale-result-class ((m single-float-matrix) q)
99 (typecase q
100 (complex 'complex-matrix)
101 (double-float 'double-float-matrix)
102 (t (class-of m))))
104 (defmethod compute-mat-scale-result-class ((m unsigned-byte-matrix) q)
105 (typecase q
106 (complex 'complex-matrix)
107 (double-float 'double-float-matrix)
108 (single-float 'single-float-matrix)
109 (t (cond
110 ((complexp q) 'complex-matrix)
111 ((floatp q) 'double-float-matrix)
112 ((minusp q) 'integer-matrix)
113 (t (class-of m))))))
115 (defmethod compute-mat-scale-result-class ((m integer-matrix) q)
116 (typecase q
117 (complex 'complex-matrix)
118 (double-float 'double-float-matrix)
119 (single-float 'single-float-matrix)
120 (t (cond
121 ((complexp q) 'complex-matrix)
122 ((floatp q) 'double-float-matrix)
123 (t 'sb32-matrix)))))
125 (defmethod compute-mat-scale-result-class ((m bit-matrix) q)
126 (typecase q
127 (complex 'complex-matrix)
128 (double-float 'double-float-matrix)
129 (single-float 'single-float-matrix)
130 (t (cond
131 ((complexp q) 'complex-matrix)
132 ((floatp q) 'double-float-matrix)
133 (t 'sb32-matrix)))))
135 (defmethod compute-mat-scale-result-class ((m t-matrix) q)
136 (class-of m))
138 (defmethod mat-scale (m q
139 &key
140 in-place
141 (result-class (unless in-place
142 (compute-mat-scale-result-class m q))))
143 (if in-place
144 (mat-scale-2 m m q)
145 (let ((n (make-instance result-class :dimensions (dim m))))
146 (mat-scale-2 m n q))))