/
unittests-vector.lisp
235 lines (201 loc) · 8.7 KB
/
unittests-vector.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
;;; -*- mode: lisp -*-
;;;
;;; Copyright (c) 2007--2008, by A.J. Rossini <blindglobe@gmail.com>
;;; See COPYRIGHT file for any additional restrictions (BSD license).
;;; Since 1991, ANSI was finally finished. Edited for ANSI Common Lisp.
;;; This is part of the unittests package. See unittests.lisp for
;;; general philosophy.
;; (asdf:oos 'asdf:compile-op 'lift :force t)
;; (asdf:oos 'asdf:load-op 'lift)
;; (asdf:oos 'asdf:compile-op 'lisp-matrix)
;; (asdf:oos 'asdf:load-op 'lisp-matrix)
(in-package :lisp-matrix-unittests)
;; EVERYTHING
;; (run-lisp-matrix-tests)
;; (describe (run-lisp-matrix-tests))
;; VECTOR TESTS
;; (run-tests :suite 'lisp-matrix-ut-vectors)
;; (describe (run-tests :suite 'lisp-matrix-ut-vectors))
;; (run-test :test-case ' :suite 'lisp-matrix-ut-vectors)
;; REMINDER IF NEEDED
;; (remove-test :test-case 'data-initialize :suite 'lisp-matrix-ut)
;;; TEST SUITES in file.
(deftestsuite lisp-matrix-ut-vectors (lisp-matrix-ut) ())
(deftestsuite lisp-matrix-ut-vectors-gemm (lisp-matrix-ut-vectors) ())
;;; SUPPORT FUNCTIONS
;; (in general, see unittests.lisp; any specific to vectors would be here...)
;;; TESTS: VECTORS
(addtest (lisp-matrix-ut-vectors)
construct-vectors-and-same-as-matrix
(for-all-implementations
(ensure (m= (make-vector 3 :initial-element 0d0)
(make-matrix 1 3 :initial-element 0d0)))
(ensure (m= (make-vector 3 :initial-element 0d0 :type :column)
(make-matrix 3 1 :initial-element 0d0)))
(ensure (col-vector-p (rand 3 1)))
(ensure (row-vector-p (rand 1 3)))
;; FIXME: M x 1 or 1 x M matrices should not be considered
;; transposed when we think of their storage. But we cannot
;; transpose them without resorting to a TRANSPOSE-VECVIEW. So it
;; would be best to introduce a function like STORAGE-TRANSPOSED-P
;; (ensure (not (transposed-p (transpose (make-matrix 1 10)))))
;; (ensure (not (transposed-p (transpose (make-matrix 10 1)))))
;; transpose should return the original matrix if dimensions are
;; 1 x 1
(let ((m (rand 1 1)))
(ensure (eq m (transpose m))))))
(addtest (lisp-matrix-ut-vectors)
matview-row-and-col-access-and-equiv
(for-all-implementations
(let ((a (rand 7 9)))
;; strides and window should return vectors when appropriate
(ensure (row-vector-p (window a :nrows 1)))
(ensure (col-vector-p (window a :ncols 1)))
;; column access and row access, matviews.
(dotimes (i 7)
(ensure (v= (row a i) (col (transpose a) i)))
(ensure (not (m= (row a i) (col (transpose a) i))))
(ensure (row-vector-p (row a i)))
(ensure (col-vector-p (col a i)))
(ensure (row-vector-p (row (transpose a) i)))
(ensure (col-vector-p (col (transpose a) i)))))))
(addtest (lisp-matrix-ut-vectors)
strided-matrix-row-access
(let* ((a (make-matrix 6 5 :initial-contents '((1d0 2d0 3d0 4d0 5d0)
(6d0 7d0 8d0 9d0 10d0)
(11d0 12d0 13d0 14d0 15d0)
(16d0 17d0 18d0 19d0 20d0)
(21d0 22d0 23d0 24d0 25d0)
(26d0 27d0 28d0 29d0 30d0))))
(b (strides a :nrows 3 :row-stride 2))) ;; need an indexed variant
(ensure (m= (row b 0)
(make-matrix 1 5 :initial-contents '((1d0 2d0 3d0 4d0 5d0)))))
;; (ensure (m= (princ (row b 0) )
;; (princ (make-matrix 1 5 :initial-contents '((1d0 2d0 3d0 4d0 5d0))))) )
(ensure (m= (row b 1)
(make-matrix 1 5 :initial-contents '((11d0 12d0 13d0 14d0 15d0)))))
(ensure (m= (row b 2)
(make-matrix 1 5 :initial-contents '((21d0 22d0 23d0 24d0 25d0)))))))
(addtest (lisp-matrix-ut-vectors)
strided-matrix-column-access
(let* ((a (make-matrix 6 5 :initial-contents '((1d0 2d0 3d0 4d0 5d0)
(6d0 7d0 8d0 9d0 10d0)
(11d0 12d0 13d0 14d0 15d0)
(16d0 17d0 18d0 19d0 20d0)
(21d0 22d0 23d0 24d0 25d0)
(26d0 27d0 28d0 29d0 30d0))))
(b (strides a :nrows 3 :row-stride 2)))
;; (princ b)
;; (ensure (m= (princ (col b 0))
;; (princ (make-matrix 3 1 :initial-contents '((1d0) (11d0) (21d0))))))
;; (ensure (m= (princ (col b 1))
;; (princ (make-matrix 3 1 :initial-contents '((2d0) (12d0) (22d0))))))
;; (ensure (m= (princ (col b 2) )
;; (princ (make-matrix 3 1 :initial-contents '((3d0) (13d0) (23d0))))))
(ensure (m= (col b 0)
(make-matrix 3 1 :initial-contents '((1d0) (11d0) (21d0)))))
(ensure (m= (col b 1)
(make-matrix 3 1 :initial-contents '((2d0) (12d0) (22d0)))))
(ensure (m= (col b 2)
(make-matrix 3 1 :initial-contents '((3d0) (13d0) (23d0)))))
(ensure (m= (col b 3)
(make-matrix 3 1 :initial-contents '((4d0) (14d0) (24d0)))))
(ensure (m= (col b 4)
(make-matrix 3 1 :initial-contents '((5d0) (15d0) (25d0)))))))
(addtest (lisp-matrix-ut-vectors)
v=-col-row-transpose
(let ((a (rand 3 4)))
(dotimes (i 2)
(ensure (v= (row a i) (col (transpose a) i)))
(ensure (v= (col a i) (row (transpose a) i))))))
(addtest (lisp-matrix-ut-vectors)
row-of-window
(let* ((a (rand 5 10 :element-type 'integer :value 10))
(b (window a :row-offset 1 :nrows 4 :col-offset 2 :ncols 5)))
(dotimes (i 4)
(ensure (m= (row b i)
(window a :row-offset (+ i 1) :nrows 1 :col-offset 2 :ncols 5)))))
(let* ((a (rand 10 5 :element-type 'integer :value 10))
(b (window (transpose a) :row-offset 1 :nrows 4 :col-offset 2 :ncols 5)))
(dotimes (i 4)
(ensure (m= (row b i)
(window (transpose a) :row-offset (+ i 1) :nrows 1 :col-offset 2
:ncols 5))))))
(addtest (lisp-matrix-ut-vectors)
real-stride
(ensure (= 1 (real-stride (zeros 2 2))))
(ensure (= 2 (real-stride (row (zeros 2 2) 0))))
(ensure (= 1 (real-stride (col (zeros 2 2) 0))))
(ensure (= 1 (real-stride (row (transpose (zeros 2 2)) 0))))
(ensure (= 2 (real-stride (col (transpose (zeros 2 2)) 0))))
(ensure (null (real-stride (window (zeros 4 4) :nrows 2)))))
(addtest (lisp-matrix-ut-vectors-gemm)
m*-vectors
(for-all-implementations
(let* ((a (make-matrix 4 4 :initial-contents '((0d0 1d0 2d0 3d0)
(1d0 2d0 3d0 4d0)
(2d0 3d0 4d0 5d0)
(3d0 4d0 5d0 6d0))))
(x (slice (col a 3) :stride 2 :nelts 2 :type :row))
(y (slice (col a 2) :stride 2 :nelts 2 :type :column)))
(ensure (m= x (make-matrix 1 2 :initial-contents '((3d0 5d0)))))
(ensure (m= y (make-matrix 2 1 :initial-contents '((2d0) (4d0)))))
(ensure (m= (m* x y) (scal 26d0 (ones 1 1))))
(ensure (m= (m* y x) (make-matrix 2 2 :initial-contents '((6d0 10d0)
(12d0 20d0))))))
(ensure (m= (m* (ones 1 10) (ones 10 1))
(scal 10d0 (ones 1 1))))
(ensure (m= (m* (ones 10 1)
(scal 2d0 (ones 1 10)))
(scal 2d0 (ones 10 10))))))
;;; DIAGONAL CLASS TESTS
(addtest (lisp-matrix-ut-vectors)
diagonal!-vectors
(for-all-implementations
(let* ((a (make-matrix 4 4
:initial-contents '((0d0 1d0 2d0 3d0)
(1d0 2d0 3d0 4d0)
(2d0 3d0 4d0 5d0)
(3d0 4d0 5d0 6d0))))
(b (make-matrix 1 4
:initial-contents '((0d0 2d0 4d0 6d0))))
(c (make-vector 4
:initial-contents '((0d0 2d0 4d0 6d0))
:type :row))
(d (make-vector 4
:initial-contents '((0d0)( 2d0)( 4d0)( 6d0))
:type :column)))
(ensure (m= (diagonal! a)
b))
(ensure (m= (diagonal! (transpose a))
b))
(ensure (v= (diagonal! a)
b))
(ensure (v= (diagonal! (transpose a))
b)))))
(addtest (lisp-matrix-ut-vectors)
diagonalf-vectors
(for-all-implementations
(let* ((a (make-matrix 4 4
:initial-contents '((0d0 1d0 2d0 3d0)
(1d0 2d0 3d0 4d0)
(2d0 3d0 4d0 5d0)
(3d0 4d0 5d0 6d0))))
(b (make-matrix 1 4
:initial-contents '((0d0 2d0 4d0 6d0))))
(c (make-vector 4
:initial-contents '((0d0 2d0 4d0 6d0))
:type :row))
(d (make-vector 4
:initial-contents '((0d0)( 2d0)( 4d0)( 6d0))
:type :column)))
(ensure (m= (diagonalf a)
b))
(ensure (m= (diagonalf (transpose a))
b))
(ensure (v= (diagonalf a)
b))
(ensure (v= (diagonalf (transpose a))
b)))))
;; (describe (run-test :test-case 'diagonalf-vectors))
;; (describe (run-test :test-case 'diagonal!-vectors))