SVD on a non-square matrix using LAPACK dgesvd_ - matlab

I have to compute SVD on a non-square matrix. I am using LAPACK's dgesvd_ routine for that. I have no problems with a square matrix, for which I receive expected values, compared with MATLAB. But I cannot produce expected results for a 4x5 matrix. I know the solution should match that of MATLAB since the singular values returned are sorted in descending order. I can see though that some of singular values can be found in original A input array to SVD. That indicates I must call dgesvd_ wrong or I refer incorrectly to the results, this might have to do with leading array dimensions.
In each case I first issue a call with LWORK = -1, querying LAPACK for optimal values, which are next input to the following call to compute SVD. I am not sure about all the meaning of the returned values and if they are valid, if they should be changed, etc. I assume they are OK, so I use them in a following call to compute SVD.
So this code works as expected (3x3 matrix):
41 /* Reference data. */
42 double ref_array_A[3][3] = {
43 { 1, 2, 3},
44 { 2, 4, 5 },
45 { 3, 5, 6 }
46 };
47
48 double ref_array_U[3][3] = {
49 { -0.327985, -0.736976, -0.591009 },
50 { -0.591009, -0.327985, 0.736976 },
51 { -0.736976, 0.591009, -0.327985 }
52 };
53
54 double ref_array_Sigma[3][1] = {
55 { 11.344814 },
56 { 0.515729 },
57 { 0.170915 }
58 };
59
60 double ref_array_VT[3][3] = {
61 { -0.327985, -0.591009, -0.736976 },
62 { 0.736976, 0.327985, -0.591009 },
63 { -0.591009, 0.736976, -0.327985 }
64 };
66 /* MATLAB result
67 *
68 * >> A = [ 1, 2, 3; 2, 4, 5; 3, 5, 6]
69 *
70 * A =
71 * 1 2 3
72 * 2 4 5
73 * 3 5 6
74 *
75 * >> [U, S, V] = svd(A)
76 *
77 * U =
78 * -0.3280 -0.7370 -0.5910
79 * -0.5910 -0.3280 0.7370
80 * -0.7370 0.5910 -0.3280
81 *
82 * S =
83 * 11.3448 0 0
84 * 0 0.5157 0
85 * 0 0 0.1709
86 *
87 * V =
88 * -0.3280 0.7370 -0.5910
89 * -0.5910 0.3280 0.7370
90 * -0.7370 -0.5910 -0.3280
91 */
double WORK_QUERY = 0;
206
207
208 /* Call dgesvd_ with lwork = -1 to query optimal workspace size. */
209
210 JOBU = 'A';
211 JOBVT = 'A';
212 M = 3;
213 N = 3;
214 LDA = 3; /* (out) */
215 LDU = 3; /* (out) */
216 S = NULL; /* (don't care) */
217 U = NULL; /* (don't care) */
218 VT = NULL; /* (don't care) */
219 LDVT = 3; /* (out) */
220 WORK = NULL; /* (out) , because LWORK is 0 do not care */
221 LWORK = 4 * M * N * M *N + 6 * M * N + dd_max(M, N);
222
223 A = calloc(M * N, sizeof(double));
224 if (!A) {
225 goto ddt2_fail_sys;
226 }
227 for (i = 0; i < M; ++i) {
228 for (j = 0; j < N; ++j) {
229 A[i * N + j] = ref_array_A[i][j];
230 }
231 }
232
233 S = calloc(dd_min(M, N), sizeof(double));
234 if (!S) {
235 goto ddt2_fail_sys;
236 }
237
238 U = calloc(LDU * M, sizeof(double));
239 if (!U) {
240 goto ddt2_fail_sys;
241 }
242
243 VT = calloc(LDVT * N, sizeof(double));
244 if (!A) {
245 goto ddt2_fail_sys;
246 }
247
248 fprintf(stderr, "Reference array A:\n");
249 dd_walk_dbl_arr_rowwise(A, M, N, cb_dbl, cb_dbl_row_end);
250
251 fprintf(stderr, "Reference array U:\n");
252 dd_walk_dbl_arr_rowwise(&ref_array_U[0][0], M, M, cb_dbl, cb_dbl_row_end);
253
254 fprintf(stderr, "Reference array Sigma:\n");
255 dd_walk_dbl_arr_rowwise(&ref_array_Sigma[0][0], dd_min(M, N), 1, cb_dbl, cb_dbl_row_end);
256
257 fprintf(stderr, "Reference array VT:\n");
258 dd_walk_dbl_arr_rowwise(&ref_array_VT[0][0], N, N, cb_dbl, cb_dbl_row_end);
LWORK = -1;
261 dgesvd_("A", "A", &M, &N, A, &LDA, S, U, &LDU, VT, &LDVT, &WORK_QUERY, &LWORK, &INFO);
262 if (INFO != 0) {
263 if (INFO < 0) {
264 fprintf(stderr, "Error on LAPACK's dgesvd_ query: \"the %d-th argument had illegal value\"\n", INFO);
265 } else {
266 fprintf(stderr, "Error on LAPACK's dgesvd_ query: \"DBDSDC didn't converge, updating process failed\"\n");
267 }
268 return -1;
269 }
270
271 LWORK = (int) WORK_QUERY;
272 WORK = calloc(LWORK, sizeof(double));
273 if (!WORK) {
274 goto ddt2_fail_sys;
275 }
276
277 fprintf(stderr, "LAPACK's dgesvd_ query optimal results: LDA %d, LDU %d, LDVT %d, LWORK %d, WORK_QUERY %f\n", LDA, LDU, LDVT, LWORK, WORK_QUERY);
278 fprintf(stderr, "Rest of params: M %d, N %d\n", M, N);
279
280 /* Compute SVD. */
281 dgesvd_(&JOBU, &JOBVT, &M, &N, A, &LDA, S, U, &LDU, VT, &LDVT, WORK, &LWORK, &INFO);
282 if (INFO != 0) {
283 if (INFO < 0) {
284 fprintf(stderr, "Error on LAPACK's dgesvd_ query: \"the %d-th argument had illegal value\"\n", INFO);
285 } else {
286 fprintf(stderr, "Error on LAPACK's dgesvd_ query: \"DBDSDC didn't converge, updating process failed\"\n");
287 }
288 return -1;
289 }
290
291 fprintf(stderr, "LAPACK's dgesvd_ SVD completed\n");
292
293 fprintf(stderr, "Result A:\n");
294 dd_walk_dbl_arr_rowwise(A, M, N, cb_dbl, cb_dbl_row_end);
295
296 fprintf(stderr, "Result U**T:\n");
297 dd_walk_dbl_arr_rowwise(U, LDU, M, cb_dbl, cb_dbl_row_end);
298 fprintf(stderr, "Result U:\n");
299 dd_walk_dbl_arr_colwise(U, LDU, M, cb_dbl, cb_dbl_row_end);
300
301
302 fprintf(stderr, "Result S:\n");
303 dd_walk_dbl_arr_rowwise(S, dd_min(M, N), 1, cb_dbl, cb_dbl_row_end);
304
305 fprintf(stderr, "Result VT:\n");
306 dd_walk_dbl_arr_rowwise(VT, LDVT, N, cb_dbl, cb_dbl_row_end);
307
308 free(WORK);
309 free(A);
310 free(S);
311 free(U);
312 free(VT);
313
314 return 0;
Proper result:
peter#xx:~$ ./test4
Reference array A:
1.000000 2.000000 3.000000
2.000000 4.000000 5.000000
3.000000 5.000000 6.000000
Reference array U:
-0.327985 -0.736976 -0.591009
-0.591009 -0.327985 0.736976
-0.736976 0.591009 -0.327985
Reference array Sigma:
11.344814
0.515729
0.170915
Reference array VT:
-0.327985 -0.591009 -0.736976
0.736976 0.327985 -0.591009
-0.591009 0.736976 -0.327985
LAPACK's dgesvd_ query optimal results: LDA 3, LDU 3, LDVT 3, LWORK 201, WORK_QUERY 201.000000
Rest of params: M 3, N 3
LAPACK's dgesvd_ SVD completed
Result A:
-3.741657 0.421793 0.632690
10.643576 1.261481 -0.720622
0.478213 -0.279401 -0.211863
Result U**T:
-0.327985 -0.591009 -0.736976
-0.736976 -0.327985 0.591009
-0.591009 0.736976 -0.327985
Result U:
-0.327985 -0.736976 -0.591009
-0.591009 -0.327985 0.736976
-0.736976 0.591009 -0.327985
Result S:
11.344814
0.515729
0.170915
Result VT:
-0.327985 0.736976 -0.591009
-0.591009 0.327985 0.736976
-0.736976 -0.591009 -0.327985
But not this (4x5 matrix):
39 /* Reference data. */
40 double ref_array_A[4][5] = {
41 { 1, 0, 0, 0, 2 },
42 { 0, 0, 3, 0, 0 },
43 { 0, 0, 0, 0, 0 },
44 { 0, 2, 0, 0, 0 }
45 };
46
47 double ref_array_U[4][4] = {
48 { 0, 0, 1, 0 },
49 { 0, 1, 0, 0 },
50 { 0, 0, 0, -1 },
51 { 1, 0, 0, 0 }
52 };
53
54 double ref_array_Sigma[4][5] = {
55 { 2, 0, 0, 0, 0 },
56 { 0, 3, 0, 0, 0 },
57 { 0, 0, 2.236068, 0, 0 },
58 { 0, 0, 0, 0, 0 }
59 };
60
61 double ref_array_VT[5][5] = {
62 { 0, 1, 0, 0, 0 },
63 { 0, 0, 1, 0, 0 },
64 { 0.447214, 0, 0, 0, 0.894427 },
65 { 0, 0, 0, 1, 0 },
66 { -0.894427, 0, 0, 0, -0.447214 }
67 };
68
69 /* MATLAB result
70 *
71 * >> A = [ 1 0 0 0 2; 0 0 3 0 0 ; 0 0 0 0 0 ;0 2 0 0 0 ];
72 * >> [U, S, V] = svd(A)
73 *
74 * U =
75 * 0 1 0 0
76 * 1 0 0 0
77 * 0 0 0 -1
78 * 0 0 1 0
79 *
80 * S =
81 * 3.0000 0 0 0 0
82 * 0 2.2361 0 0 0
83 * 0 0 2.0000 0 0
84 * 0 0 0 0 0
85 *
86 * V =
87 * 0 0.4472 0 0 -0.8944
88 * 0 0 1.0000 0 0
89 * 1.0000 0 0 0 0
90 * 0 0 0 1.0000 0
91 * 0 0.8944 0 0 0.4472
92 */
double WORK_QUERY = 0;
206
207
208 /* Call dgesvd_ with lwork = -1 to query optimal workspace size. */
209
210 JOBU = 'A';
211 JOBVT = 'A';
212 M = 4;
213 N = 5;
214 LDA = 4; /* (out) */
215 LDU = 4; /* (out) */
216 S = NULL; /* (don't care) */
217 U = NULL; /* (don't care) */
218 VT = NULL; /* (don't care) */
219 LDVT = 5; /* (out) */
220 WORK = NULL; /* (out) , because LWORK is 0 do not care */
221 LWORK = 4 * M * N * M *N + 6 * M * N + dd_max(M, N);
222
223 A = calloc(M * N, sizeof(double));
224 if (!A) {
225 goto ddt2_fail_sys;
226 }
227 for (i = 0; i < M; ++i) {
228 for (j = 0; j < N; ++j) {
229 A[i * N + j] = ref_array_A[i][j];
230 }
231 }
232
233 S = calloc(M * N, sizeof(double));
234 if (!S) {
235 goto ddt2_fail_sys;
236 }
237
238 U = calloc(LDU * M, sizeof(double));
239 if (!U) {
240 goto ddt2_fail_sys;
241 }
242
243 VT = calloc(LDVT * N, sizeof(double));
244 if (!A) {
245 goto ddt2_fail_sys;
246 }
247
248 fprintf(stderr, "Reference array A:\n");
249 dd_walk_dbl_arr_rowwise(A, M, N, cb_dbl, cb_dbl_row_end);
250
251 fprintf(stderr, "Reference array U:\n");
252 dd_walk_dbl_arr_rowwise(&ref_array_U[0][0], M, M, cb_dbl, cb_dbl_row_end);
253
254 fprintf(stderr, "Reference array Sigma:\n");
255 dd_walk_dbl_arr_rowwise(&ref_array_Sigma[0][0], M, N, cb_dbl, cb_dbl_row_end);
256
257 fprintf(stderr, "Reference array VT:\n");
258 dd_walk_dbl_arr_rowwise(&ref_array_VT[0][0], N, N, cb_dbl, cb_dbl_row_end);
259
260 LWORK = -1;
261 dgesvd_("A", "A", &M, &N, A, &LDA, S, U, &LDU, VT, &LDVT, &WORK_QUERY, &LWORK, &INFO);
if (INFO != 0) {
263 if (INFO < 0) {
264 fprintf(stderr, "Error on LAPACK's dgesvd_ query: \"the %d-th argument had illegal value\"\n", INFO);
265 } else {
266 fprintf(stderr, "Error on LAPACK's dgesvd_ query: \"DBDSDC didn't converge, updating process failed\"\n");
267 }
268 return -1;
269 }
270
271 LWORK = (int) WORK_QUERY;
272 WORK = calloc(LWORK, sizeof(double));
273 if (!WORK) {
274 goto ddt2_fail_sys;
275 }
276
277 fprintf(stderr, "LAPACK's dgesvd_ query optimal results: LDA %d, LDU %d, LDVT %d, LWORK %d, WORK_QUERY %f\n", LDA, LDU, LDVT, LWORK, WORK_QUERY);
278 fprintf(stderr, "Rest of params: M %d, N %d\n", M, N);
279
280 /* Compute SVD. */
281 dgesvd_(&JOBU, &JOBVT, &M, &N, A, &LDA, S, U, &LDU, VT, &LDVT, WORK, &LWORK, &INFO);
282 if (INFO != 0) {
283 if (INFO < 0) {
284 fprintf(stderr, "Error on LAPACK's dgesvd_ query: \"the %d-th argument had illegal value\"\n", INFO);
285 } else {
286 fprintf(stderr, "Error on LAPACK's dgesvd_ query: \"DBDSDC didn't converge, updating process failed\"\n");
287 }
288 return -1;
289 }
290
291 fprintf(stderr, "LAPACK's dgesvd_ SVD completed\n");
292
293 fprintf(stderr, "Result A:\n");
294 dd_walk_dbl_arr_rowwise(A, M, N, cb_dbl, cb_dbl_row_end);
295
296 fprintf(stderr, "Result U:\n");
297 dd_walk_dbl_arr_rowwise(U, LDU, M, cb_dbl, cb_dbl_row_end);
298
299 fprintf(stderr, "Result S:\n");
300 dd_walk_dbl_arr_rowwise(S, M, N, cb_dbl, cb_dbl_row_end);
301
302 fprintf(stderr, "Result VT:\n");
303 dd_walk_dbl_arr_rowwise(VT, LDVT, N, cb_dbl, cb_dbl_row_end);
304
305 free(WORK);
306 free(A);
307 free(S);
308 free(U);
309 free(VT);
310
311 return 0;
Bad result:
peter#xx:~/$ ./test2
Reference array A:
1.000000 0.000000 0.000000 0.000000 2.000000
0.000000 0.000000 3.000000 0.000000 0.000000
0.000000 0.000000 0.000000 0.000000 0.000000
0.000000 2.000000 0.000000 0.000000 0.000000
Reference array U:
0.000000 0.000000 1.000000 0.000000
0.000000 1.000000 0.000000 0.000000
0.000000 0.000000 0.000000 -1.000000
1.000000 0.000000 0.000000 0.000000
Reference array Sigma:
2.000000 0.000000 0.000000 0.000000 0.000000
0.000000 3.000000 0.000000 0.000000 0.000000
0.000000 0.000000 2.236068 0.000000 0.000000
0.000000 0.000000 0.000000 0.000000 0.000000
Reference array VT:
0.000000 1.000000 0.000000 0.000000 0.000000
0.000000 0.000000 1.000000 0.000000 0.000000
0.447214 0.000000 0.000000 0.000000 0.894427
0.000000 0.000000 0.000000 1.000000 0.000000
-0.894427 0.000000 0.000000 0.000000 -0.447214
LAPACK's dgesvd_ query optimal results: LDA 4, LDU 4, LDVT 5, LWORK 300, WORK_QUERY 300.000000
Rest of params: M 4, N 5
LAPACK's dgesvd_ SVD completed
Result A:
-3.000000 -2.000000 0.000000 -1.000000 0.500000
-2.236068 0.000000 0.000000 0.000000 0.000000
0.000000 0.000000 0.000000 0.000000 0.000000
0.000000 0.500000 -0.236068 0.000000 0.000000
Result U:
0.707107 0.000000 0.000000 0.707107
-0.707107 0.000000 -0.000000 0.707107
0.000000 0.000000 1.000000 0.000000
0.000000 1.000000 0.000000 0.000000
Result S:
3.872983 1.732051 0.000000 0.000000 0.000000
0.000000 0.000000 0.000000 0.000000 0.000000
0.000000 0.000000 0.000000 0.000000 0.000000
0.000000 0.000000 0.000000 0.000000 0.000000
Result VT:
0.182574 -0.408248 0.000000 0.000000 -0.894427
0.912871 0.408248 0.000000 0.000000 0.000000
-0.000000 -0.000000 1.000000 0.000000 0.000000
-0.000000 -0.000000 0.000000 1.000000 0.000000
0.365148 -0.816497 0.000000 0.000000 0.447214
What do I do wrong in general matrix case?

The function dgesvd_ expects the matrices in column-major order, while your code supplies the data in row-major style:
227 for (i = 0; i < M; ++i) {
228 for (j = 0; j < N; ++j) {
229 A[i * N + j] = ref_array_A[i][j];
230 }
231 }
Effectively, your code is thus calculating SVD of
[ 1 2 0 0 2 ] [ 1 0 0 0 ] ^ T
[ 0 0 0 0 0 ] = [ 2 0 0 3 ]
[ 0 0 0 0 0 ] [ 0 0 0 0 ]
[ 0 3 0 0 0 ] [ 2 0 0 0 ]
which indeed yields approximately 3.87, 1.73.
This error does not occur in the first example since the matrix is square (M=N) and symmetric.
Also, the parameter S is supposed to be just one-dimensional array (as in your first example). Since you print it then in row-major format with dd_walk_dbl_arr_rowwise(S, M, N, cb_dbl, cb_dbl_row_end);, these values appear consecutively in the first row...

Related

Find the Median of a list<int> in Dart

I have a list of integers which contains times in milliseconds (ex. 1433, 834, 1020..). I need to calculate the Median. I developed the following code but the Median I get is completely wrong compared to the one I calculate in Excel. Any ideas? is there any Dart/flutter library I could use for statistics?
/// Calculate median
static int calculateMedian(TimeRecordNotifier timeRecordNotifier) {
List<int> mList = List();
timeRecordNotifier.timeRecords.forEach((element) {
mList.add(element.partialTime);
});
//clone list
List<int> clonedList = List();
clonedList.addAll(mList);
int median;
//sort list
clonedList.sort((a, b) => a.compareTo(b));
if (clonedList.length == 1)
median = mList[clonedList.length - 1];
else if (clonedList.length % 2 == 1)
median = mList[(((clonedList.length) / 2) - 1).round()];
else {
int lower = mList[((clonedList.length ~/ 2) - 1)];
int upper = mList[(clonedList.length ~/ 2)];
median = ((lower + upper) / 2.0).round();
}
return median;
}
On the following dataset the expected median value is 901,5, however this algorithm gives me 461
131
144
203
206
241
401
415
427
439
439
452
455
456
469
471
471
483
483
491
495
495
502
505
512
521
522
523
547
551
561
610
727
745
777
790
793
892
911
924
943
957
977
978
989
992
1008
1024
1039
1070
1074
1092
1115
1139
1155
1159
1174
1176
1194
1203
1208
1227
1228
1248
1270
1271
1272
1273
1276
1284
1290
1294
1439
1740
1786
I refactored the code into this using NumDart implementation and now it works. thanks #MartinM for you comment!
/// Calculate median
static int calculateMedian(TimeRecordNotifier timeRecordNotifier) {
List<int> mList = List();
timeRecordNotifier.timeRecords.forEach((element) {
mList.add(element.partialTime);
});
//clone list
List<int> clonedList = List();
clonedList.addAll(mList);
//sort list
clonedList.sort((a, b) => a.compareTo(b));
int median;
int middle = clonedList.length ~/ 2;
if (clonedList.length % 2 == 1) {
median = clonedList[middle];
} else {
median = ((clonedList[middle - 1] + clonedList[middle]) / 2.0).round();
}
return median;
}

strange result with JPEG compression

I want to implement the JPEG compression by using MATLAB. Well at the point where the symbols' probabilities (Huffman coding) are calculated i can see some NEGATIVE values. I am sure that this is not correct!!! if someone can give some help or directions i would really appreciate it. Thank all of you in advance. I use MATLAB R2012b. Here is the code:
clc;
clear all;
a = imread('test.png');
b = rgb2gray(a);
b = imresize(b, [256 256]);
b = double(b);
final = zeros(256, 256);
mask = [1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 0
1 1 1 1 1 1 0 0
1 1 1 1 1 0 0 0
1 1 1 1 0 0 0 0
1 1 1 0 0 0 0 0
1 1 0 0 0 0 0 0
1 0 0 0 0 0 0 0];
qv1 = [ 16 11 10 16 24 40 51 61
12 12 14 19 26 58 60 55
14 13 16 24 40 57 69 56
14 17 22 29 51 87 80 62
18 22 37 56 68 109 103 77
24 35 55 64 81 104 113 92
49 64 78 87 103 121 120 101
72 92 95 98 112 100 103 99];
t = dctmtx(8);
DCT2D = #(block_struct) t*block_struct.data*t';
msk = #(block_struct) mask.*block_struct.data;
for row = 1:8:256
for column = 1:8:256
x = (b(row:row+7, column:column+7));
xf = blockproc(x, [8 8], DCT2D);
xf1 = blockproc(xf, [8 8], msk);
xf1 = round(xf1./qv1).*qv1;
final(row:row+7, column:column+7) = xf1;
end
end
[symbols,p] = hist(final,unique(final));
bar(p, symbols);
p = p/sum(p); %NEGATIVE VALUES????
I think you might have the outputs of hist (symbols and p) swapped. The probability should be calculated from the bin counts, which is the first output of hist.
[nelements,centers] = hist(data,xvalues) returns an additional row vector, centers, indicating the location of each bin center on the x-axis. To plot the histogram, you can use bar(centers,nelements).
In other words, instead of your current line,
[symbols,p] = hist(final,unique(final));
just use,
[p,symbols] = hist(final,unique(final));
Also, final is a matrix rather than a vector, so nelements will be a matrix:
If data is a matrix, then a histogram is created separately for each column. Each histogram plot is displayed on the same figure with a different color.

Set colorbar ranges in 3d graph in matlab

I would like to create a three dimensional surface using this:
>> a=X
a =
Columns 1 through 8
0 50 100 150 200 250 300 350
Columns 9 through 16
400 450 500 550 600 650 700 750
Columns 17 through 21
800 850 900 950 1000
>> b=Y
b =
0
50
100
150
200
250
300
350
400
>> c=Z
c =
Columns 1 through 8
0 0 0 0 0 0 0 0
16 32 67 98 127 164 194 234
120 171 388 773 1086 1216 1770 2206
189 270 494 1978 2755 3134 5060 10469
133 166 183 348 647 937 1446 2304
192 162 154 113 161 189 266 482
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
Columns 9 through 16
0 0 0 0 0 0 0 0
366 604 529 504 346 226 228 179
4027 11186 10276 5349 2560 1322 996 799
27413 76387 37949 15591 5804 2654 1803 1069
9844 24152 14772 4613 1777 849 459 290
1288 2623 1538 582 280 148 90 56
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
Columns 17 through 21
0 0 0 0 0
108 94 79 0 0
646 476 612 0 0
884 858 722 0 0
266 215 139 0 0
48 48 31 0 0
0 0 0 0 0
0 0 0 0 0
0 0 0 0 0
>> surf(X,Y,Z)
At the same time I would like to define that Z values < = 1803 will be shown with red color on the surface graph, 1803 < Z < 2755 yellow and Z > = 2755 green. The limits of the colorbar can be the min and max values of Z (from 0 to 76387). How can I set the ranges of the colorbar in order to get this result?
This will do as you ask:
%# add red (row 1), yellow (row 2), green (row 2)
map = [1 0 0; 0 1 1; 0 1 0];
%# set the new map as the current map
colormap(map);
colors = zeros(size(c)); %# create colors array
colors(c <= 1803) = 1; %# red (1)
colors(c > 1803 & c < 2755) = 2; %# yellow (2)
colors(c >= 2755) = 3; %# green (3)
%# and pass it into surf
surf(a,b,c, colors)

Why am I not getting a warning from Perl?

Consider these two use cases:
sub test1 {
my $v = 1;
sub test2 { print $v }
# ...
}
and
for (0..3) {
my $foo = $_;
sub test1 { print $foo }
# ...
}
The first one produces a Variable will not stay shared warning, while the second doesn't. It seems that the variable is not shared in both cases. Why isn't there any warning in the second case?
It seems that this may be a bug or omission in the warnings pragma.
Adding to the fun, this arrangement gives a different warning:
BEGIN {*outer = sub {
my $x;
sub inner {$x}
}}
Which warns Variable "$x" is not available
These warnings all come from the pad_findlex() API call defined in pad.c.
806 =for apidoc pad_findlex
807
808 Find a named lexical anywhere in a chain of nested pads. Add fake entries
809 in the inner pads if it's found in an outer one.
810
811 Returns the offset in the bottom pad of the lex or the fake lex.
812 cv is the CV in which to start the search, and seq is the current cop_seq
813 to match against. If warn is true, print appropriate warnings. The out_*
814 vars return values, and so are pointers to where the returned values
815 should be stored. out_capture, if non-null, requests that the innermost
816 instance of the lexical is captured; out_name_sv is set to the innermost
817 matched namesv or fake namesv; out_flags returns the flags normally
818 associated with the IVX field of a fake namesv.
819
820 Note that pad_findlex() is recursive; it recurses up the chain of CVs,
821 then comes back down, adding fake entries as it goes. It has to be this way
822 because fake namesvs in anon protoypes have to store in xlow the index into
823 the parent pad.
824
825 =cut
826 */
827
828 /* the CV has finished being compiled. This is not a sufficient test for
829 * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
830 #define CvCOMPILED(cv) CvROOT(cv)
831
832 /* the CV does late binding of its lexicals */
833 #define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
834
835
836 STATIC PADOFFSET
837 S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
838 SV** out_capture, SV** out_name_sv, int *out_flags)
839 {
840 dVAR;
841 I32 offset, new_offset;
842 SV *new_capture;
843 SV **new_capturep;
844 const AV * const padlist = CvPADLIST(cv);
845
846 PERL_ARGS_ASSERT_PAD_FINDLEX;
847
848 *out_flags = 0;
849
850 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
851 "Pad findlex cv=0x%"UVxf" searching \"%s\" seq=%d%s\n",
852 PTR2UV(cv), name, (int)seq, out_capture ? " capturing" : "" ));
853
854 /* first, search this pad */
855
856 if (padlist) { /* not an undef CV */
857 I32 fake_offset = 0;
858 const AV * const nameav = MUTABLE_AV(AvARRAY(padlist)[0]);
859 SV * const * const name_svp = AvARRAY(nameav);
860
861 for (offset = AvFILLp(nameav); offset > 0; offset--) {
862 const SV * const namesv = name_svp[offset];
863 if (namesv && namesv != &PL_sv_undef
864 && strEQ(SvPVX_const(namesv), name))
865 {
866 if (SvFAKE(namesv)) {
867 fake_offset = offset; /* in case we don't find a real one */
868 continue;
869 }
870 /* is seq within the range _LOW to _HIGH ?
871 * This is complicated by the fact that PL_cop_seqmax
872 * may have wrapped around at some point */
873 if (COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO)
874 continue; /* not yet introduced */
875
876 if (COP_SEQ_RANGE_HIGH(namesv) == PERL_PADSEQ_INTRO) {
877 /* in compiling scope */
878 if (
879 (seq > COP_SEQ_RANGE_LOW(namesv))
880 ? (seq - COP_SEQ_RANGE_LOW(namesv) < (U32_MAX >> 1))
881 : (COP_SEQ_RANGE_LOW(namesv) - seq > (U32_MAX >> 1))
882 )
883 break;
884 }
885 else if (
886 (COP_SEQ_RANGE_LOW(namesv) > COP_SEQ_RANGE_HIGH(namesv))
887 ?
888 ( seq > COP_SEQ_RANGE_LOW(namesv)
889 || seq <= COP_SEQ_RANGE_HIGH(namesv))
890
891 : ( seq > COP_SEQ_RANGE_LOW(namesv)
892 && seq <= COP_SEQ_RANGE_HIGH(namesv))
893 )
894 break;
895 }
896 }
897
898 if (offset > 0 || fake_offset > 0 ) { /* a match! */
899 if (offset > 0) { /* not fake */
900 fake_offset = 0;
901 *out_name_sv = name_svp[offset]; /* return the namesv */
902
903 /* set PAD_FAKELEX_MULTI if this lex can have multiple
904 * instances. For now, we just test !CvUNIQUE(cv), but
905 * ideally, we should detect my's declared within loops
906 * etc - this would allow a wider range of 'not stayed
907 * shared' warnings. We also treated already-compiled
908 * lexes as not multi as viewed from evals. */
909
910 *out_flags = CvANON(cv) ?
911 PAD_FAKELEX_ANON :
912 (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
913 ? PAD_FAKELEX_MULTI : 0;
914
915 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
916 "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%lu,%lu)\n",
917 PTR2UV(cv), (long)offset,
918 (unsigned long)COP_SEQ_RANGE_LOW(*out_name_sv),
919 (unsigned long)COP_SEQ_RANGE_HIGH(*out_name_sv)));
920 }
921 else { /* fake match */
922 offset = fake_offset;
923 *out_name_sv = name_svp[offset]; /* return the namesv */
924 *out_flags = PARENT_FAKELEX_FLAGS(*out_name_sv);
925 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
926 "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
927 PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
928 (unsigned long) PARENT_PAD_INDEX(*out_name_sv)
929 ));
930 }
931
932 /* return the lex? */
933
934 if (out_capture) {
935
936 /* our ? */
937 if (SvPAD_OUR(*out_name_sv)) {
938 *out_capture = NULL;
939 return offset;
940 }
941
942 /* trying to capture from an anon prototype? */
943 if (CvCOMPILED(cv)
944 ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
945 : *out_flags & PAD_FAKELEX_ANON)
946 {
947 if (warn)
948 Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
949 "Variable \"%s\" is not available", name);
950 *out_capture = NULL;
951 }
952
953 /* real value */
954 else {
955 int newwarn = warn;
956 if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
957 && !SvPAD_STATE(name_svp[offset])
958 && warn && ckWARN(WARN_CLOSURE)) {
959 newwarn = 0;
960 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
961 "Variable \"%s\" will not stay shared", name);
962 }
963
964 if (fake_offset && CvANON(cv)
965 && CvCLONE(cv) &&!CvCLONED(cv))
966 {
967 SV *n;
968 /* not yet caught - look further up */
969 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
970 "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
971 PTR2UV(cv)));
972 n = *out_name_sv;
973 (void) pad_findlex(name, CvOUTSIDE(cv),
974 CvOUTSIDE_SEQ(cv),
975 newwarn, out_capture, out_name_sv, out_flags);
976 *out_name_sv = n;
977 return offset;
978 }
979
980 *out_capture = AvARRAY(MUTABLE_AV(AvARRAY(padlist)[
981 CvDEPTH(cv) ? CvDEPTH(cv) : 1]))[offset];
982 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
983 "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
984 PTR2UV(cv), PTR2UV(*out_capture)));
985
986 if (SvPADSTALE(*out_capture)
987 && !SvPAD_STATE(name_svp[offset]))
988 {
989 Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
990 "Variable \"%s\" is not available", name);
991 *out_capture = NULL;
992 }
993 }
994 if (!*out_capture) {
995 if (*name == '#')
996 *out_capture = sv_2mortal(MUTABLE_SV(newAV()));
997 else if (*name == '%')
998 *out_capture = sv_2mortal(MUTABLE_SV(newHV()));
999 else
1000 *out_capture = sv_newmortal();
1001 }
1002 }
1003
1004 return offset;
1005 }
1006 }
1007
1008 /* it's not in this pad - try above */
1009
1010 if (!CvOUTSIDE(cv))
1011 return NOT_IN_PAD;
1012
1013 /* out_capture non-null means caller wants us to capture lex; in
1014 * addition we capture ourselves unless it's an ANON/format */
1015 new_capturep = out_capture ? out_capture :
1016 CvLATE(cv) ? NULL : &new_capture;
1017
1018 offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
1019 new_capturep, out_name_sv, out_flags);
1020 if ((PADOFFSET)offset == NOT_IN_PAD)
1021 return NOT_IN_PAD;
1022
1023 /* found in an outer CV. Add appropriate fake entry to this pad */
1024
1025 /* don't add new fake entries (via eval) to CVs that we have already
1026 * finished compiling, or to undef CVs */
1027 if (CvCOMPILED(cv) || !padlist)
1028 return 0; /* this dummy (and invalid) value isnt used by the caller */
1029
1030 {
1031 /* This relies on sv_setsv_flags() upgrading the destination to the same
1032 type as the source, independent of the flags set, and on it being
1033 "good" and only copying flag bits and pointers that it understands.
1034 */
1035 SV *new_namesv = newSVsv(*out_name_sv);
1036 AV * const ocomppad_name = PL_comppad_name;
1037 PAD * const ocomppad = PL_comppad;
1038 PL_comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
1039 PL_comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
1040 PL_curpad = AvARRAY(PL_comppad);
1041
1042 new_offset
1043 = pad_add_name_sv(new_namesv,
1044 (SvPAD_STATE(*out_name_sv) ? padadd_STATE : 0),
1045 SvPAD_TYPED(*out_name_sv)
1046 ? SvSTASH(*out_name_sv) : NULL,
1047 SvOURSTASH(*out_name_sv)
1048 );
1049
1050 SvFAKE_on(new_namesv);
1051 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1052 "Pad addname: %ld \"%.*s\" FAKE\n",
1053 (long)new_offset,
1054 (int) SvCUR(new_namesv), SvPVX(new_namesv)));
1055 PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
1056
1057 PARENT_PAD_INDEX_set(new_namesv, 0);
1058 if (SvPAD_OUR(new_namesv)) {
1059 NOOP; /* do nothing */
1060 }
1061 else if (CvLATE(cv)) {
1062 /* delayed creation - just note the offset within parent pad */
1063 PARENT_PAD_INDEX_set(new_namesv, offset);
1064 CvCLONE_on(cv);
1065 }
1066 else {
1067 /* immediate creation - capture outer value right now */
1068 av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
1069 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1070 "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
1071 PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
1072 }
1073 *out_name_sv = new_namesv;
1074 *out_flags = PARENT_FAKELEX_FLAGS(new_namesv);
1075
1076 PL_comppad_name = ocomppad_name;
1077 PL_comppad = ocomppad;
1078 PL_curpad = ocomppad ? AvARRAY(ocomppad) : NULL;
1079 }
1080 return new_offset;
1081 }
It seems it has to do with if the containing pad is held within a CV or not, but I am not sure of the exact specifics.

How to compare a matrix element with its neighbours without using a loop in MATLAB?

I have a matrix in MATLAB. I want to check the 4-connected neighbours (left, right, top, bottom) for every element. If the current element is less than any of the neighbours then we set it to zero otherwise it will keep its value. It can easily be done with loop, but it is very expensive as I have thousands of these matrices.
You might recognize it as nonmaxima suppression after edge detection.
If you have the image processing toolbox, you can do this with a morpological dilation to find local maxima and suppress all other elements.
array = magic(6); %# make some data
msk = [0 1 0;1 0 1;0 1 0]; %# make a 4-neighbour mask
%# dilation will replace the center pixel with the
%# maximum of its neighbors
maxNeighbour = imdilate(array,msk);
%# set pix to zero if less than neighbors
array(array<maxNeighbour) = 0;
array =
35 0 0 26 0 0
0 32 0 0 0 25
31 0 0 0 27 0
0 0 0 0 0 0
30 0 34 0 0 16
0 36 0 0 18 0
edited to use the same data as #gnovice, and to fix the code
One way to do this is with the function NLFILTER from the Image Processing Toolbox, which applies a given function to each M-by-N block of a matrix:
>> A = magic(6) %# A sample matrix
A =
35 1 6 26 19 24
3 32 7 21 23 25
31 9 2 22 27 20
8 28 33 17 10 15
30 5 34 12 14 16
4 36 29 13 18 11
>> B = nlfilter(A,[3 3],#(b) b(5)*all(b(5) >= b([2 4 6 8])))
B =
35 0 0 26 0 0
0 32 0 0 0 25
31 0 0 0 27 0
0 0 0 0 0 0
30 0 34 0 0 16
0 36 0 0 18 0
The above code defines an anonymous function which uses linear indexing to get the center element of a 3-by-3 submatrix b(5) and compare it to its 4-connected neighbors b([2 4 6 8]). The value in the center element is multiplied by the logical result returned by the function ALL, which is 1 when the center element is larger than all of its nearest neighbors and 0 otherwise.
If you don't have access to the Image Processing Toolbox, another way to accomplish this is by constructing four matrices representing the top, right, bottom and left first differences for each point and then searching for corresponding elements in all four matrices that are non-negative (i.e. the element exceeds all of its neighbours).
Here's the idea broken down...
Generate some test data:
>> sizeA = 3;
A = randi(255, sizeA)
A =
254 131 94
135 10 124
105 191 84
Pad the borders with zero-elements:
>> A2 = zeros(sizeA+2) * -Inf;
A2(2:end-1,2:end-1) = A
A2 =
0 0 0 0 0
0 254 131 94 0
0 135 10 124 0
0 105 191 84 0
0 0 0 0 0
Construct the four first-difference matrices:
>> leftDiff = A2(2:end-1,2:end-1) - A2(2:end-1,1:end-2)
leftDiff =
254 -123 -37
135 -125 114
105 86 -107
>> topDiff = A2(2:end-1,2:end-1) - A2(1:end-2,2:end-1)
topDiff =
254 131 94
-119 -121 30
-30 181 -40
>> rightDiff = A2(2:end-1,2:end-1) - A2(2:end-1,3:end)
rightDiff =
123 37 94
125 -114 124
-86 107 84
>> bottomDiff = A2(2:end-1,2:end-1) - A2(3:end,2:end-1)
bottomDiff =
119 121 -30
30 -181 40
105 191 84
Find the elements that exceed all of the neighbours:
indexKeep = find(leftDiff >= 0 & topDiff >= 0 & rightDiff >= 0 & bottomDiff >= 0)
Create the resulting matrix:
>> B = zeros(sizeA);
B(indexKeep) = A(indexKeep)
B =
254 0 0
0 0 124
0 191 0
After wrapping this all into a function and testing it on 1000 random 100x100 matrices, the algorithm appears to be quite fast:
>> tic;
for ii = 1:1000
A = randi(255, 100);
B = test(A);
end; toc
Elapsed time is 0.861121 seconds.