GIRAFFE Pipeline Reference Manual

gimatrix.c
1/*
2 * This file is part of the GIRAFFE Pipeline
3 * Copyright (C) 2002-2019 European Southern Observatory
4 *
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; either version 2 of the License, or
8 * (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
18 */
19
20#ifdef HAVE_CONFIG_H
21# include <config.h>
22#endif
23
24#include <math.h>
25
26#include <cxmessages.h>
27#include <cxstring.h>
28
29#include <cpl_msg.h>
30#include <cpl_error.h>
31
32#include "gimatrix.h"
33
34
43inline static void
44_giraffe_swap(cxdouble *a, cxdouble *b)
45{
46 register cxdouble tmp = *a;
47
48 *a = *b;
49 *b = tmp;
50
51 return;
52
53}
54
55
56inline static cxbool
57_giraffe_tiny(cxdouble a)
58{
59 return a < 0. ? (a > -1.e-30) : (a < 1.e-30);
60}
61
62#ifdef GIRAFFE_USE_giraffe_matrix_gausspiv
63/*
64 * @brief matrix_gausspiv
65 *
66 * @param ptra A matrix line.
67 * @param ptrc A matrix line.
68 * @param n Number of rows in each line.
69 *
70 * @retval int 1 if Ok, 0 else.
71 *
72 * Line simplification with Gauss method.
73 *
74 * The matrices @em ms[nx,ns], @em mse[nx,ns], @em msn[nx,ns] and
75 * @em msy[nx,ns] are pre-allocated matrices.
76 */
77
78static cxint
79_giraffe_matrix_gausspiv(cxdouble *ptra, cxdouble *ptrc, cxint n)
80/* c(n,n) = a(n,n)^-1 */
81{
82
83 register cxint i;
84 register cxint j;
85 register cxint k;
86 register cxint l;
87
88 cxint maj;
89
90 cxdouble max;
91 cxdouble r;
92 cxdouble t;
93 cxdouble *ptrb;
94
95
96 ptrb = (cxdouble *)cx_calloc(n * n, sizeof(cxdouble));
97
98 for(i = 0; i < n; i++) {
99 ptrb[i * n + i] = 1.0;
100 }
101
102 for (i = 1; i <= n; i++) {
103
104 /* Search max in current column */
105 max = CX_ABS(*(ptra + n * i - n));
106 maj = i;
107
108 for (j = i; j <= n; j++) {
109 if (CX_ABS(*(ptra + n * j + i - n - 1)) > max) {
110 maj = j;
111 max = CX_ABS(*(ptra + n * j + i - n - 1));
112 }
113 }
114
115 /* swap lines i and maj */
116 if (maj != i) {
117 for (j = i;j <= n;j++) {
118 r = *(ptra + n * maj + j - n - 1);
119 *(ptra + n * maj + j - n - 1) = *(ptra + n * i + j - n - 1);
120 *(ptra + n * i + j - n - 1) = r;
121 }
122
123 for(l = 0; l < n; l++) {
124 r = *(ptrb + l * n + maj - 1);
125 *(ptrb + l * n + maj - 1) = *(ptrb + l * n + i - 1);
126 *(ptrb + l * n + i - 1) = r;
127 }
128 }
129
130 /* Subtract line by line */
131 for (j = i + 1; j <= n; j++) {
132 t = (*(ptra + (n + 1) * i - n - 1));
133 if (_giraffe_tiny(t) == TRUE) {
134 return 0;
135 }
136 r = (*(ptra + n * j + i - n - 1)) / t;
137 for(l = 0; l < n; l++) {
138 *(ptrb + l * n + j - 1) -= r * (*(ptrb + l * n + i - 1));
139 }
140 for (k = i; k <= n; k++) {
141 *(ptra + n * j + k - n - 1) -=
142 r * (*(ptra + n * i + k - n - 1));
143 }
144 }
145 }
146
147 /* Triangular system resolution */
148 for(l = 0; l < n; l++) {
149 for (i = n; i >= 1; i--) {
150 t = (*(ptra + (n + 1) * i - n - 1));
151 if (_giraffe_tiny(t) == TRUE) {
152 return 0;
153 }
154 *(ptrc + l + (i - 1) * n) = (*(ptrb + l * n + i - 1)) / t;
155 if (i > 1) {
156 for (j = i - 1;j > 0;j--) {
157 *(ptrb + l * n + j - 1) -=
158 (*(ptra + n * j + i - n - 1)) *
159 (*(ptrc + l + (i - 1) * n));
160 }
161 }
162 }
163 }
164 cx_free(ptrb);
165
166 return 1;
167}
168#endif /* GIRAFFE_USE_giraffe_matrix_gausspiv */
169
170/*static cpl_matrix *
171_giraffe_matrix_inverse(cpl_matrix *aa)
172{
173 cxint test = 1;
174 cxint aa_ncol = 0;
175 cxint aa_nrow = 0;
176
177 cxdouble *pd_temp = NULL;
178 cxdouble *pd_bb = NULL;
179
180 cpl_matrix *bb = NULL;
181 cpl_matrix *temp = NULL;
182
183 aa_ncol = cpl_matrix_get_ncol(aa);
184 aa_nrow = cpl_matrix_get_nrow(aa);
185
186 if(aa_nrow != aa_ncol) {
187 return NULL;
188 }
189
190 bb = cpl_matrix_new(aa_nrow, aa_ncol);
191
192 temp = cpl_matrix_duplicate(aa);
193
194 pd_temp = cpl_matrix_get_data(temp);
195 pd_bb = cpl_matrix_get_data(bb);
196
197 if (_giraffe_matrix_gausspiv(pd_temp, pd_bb, aa_nrow) == 0) {
198 test = 0;
199 }
200
201 cpl_matrix_delete(temp);
202
203 if (test == 0) {
204 cpl_matrix_delete(bb);
205 return NULL;
206 }
207
208 return bb;
209}*/
210
211
228cxdouble
229giraffe_matrix_sigma_mean(const cpl_matrix *matrix, cxdouble mean)
230{
231
232 cxulong size = 0;
233 cxulong size2 = 0;
234
235 const cxdouble *pt = NULL;
236
237 cxdouble diff = 0.;
238 cxdouble sigma = 0.;
239
240
241 cx_assert(matrix != NULL);
242
243 size = cpl_matrix_get_ncol(matrix) * cpl_matrix_get_nrow(matrix);
244 size2 = size - 1;
245
246 pt = cpl_matrix_get_data_const(matrix);
247
248 while (size--) {
249 diff = *pt++ - mean;
250 sigma += diff * diff;
251 }
252
253 return sqrt(sigma / (cxdouble)size2);
254
255}
256
257
274cxdouble
275giraffe_matrix_sigma_fit(const cpl_matrix *matrix,
276 const cpl_matrix *matrix_fit)
277{
278
279 cxint ancol;
280 cxint anrow;
281 cxint fncol;
282 cxint fnrow;
283
284 cxulong size;
285 cxulong size2;
286
287 const cxdouble *pta = NULL;
288 const cxdouble *ptf = NULL;
289
290 cxdouble diff = 0.;
291 cxdouble sigma = 0.;
292
293
294 cx_assert(matrix != NULL);
295 cx_assert(matrix_fit != NULL);
296
297 ancol = cpl_matrix_get_ncol(matrix);
298 anrow = cpl_matrix_get_nrow(matrix);
299 fncol = cpl_matrix_get_ncol(matrix_fit);
300 fnrow = cpl_matrix_get_nrow(matrix_fit);
301
302 if ((ancol * anrow) != (fncol * fnrow)) {
303 return 0.0;
304 }
305
306 size = ancol * anrow;
307 size2 = size - 1;
308
309 pta = cpl_matrix_get_data_const(matrix);
310 ptf = cpl_matrix_get_data_const(matrix_fit);
311
312 while (size--) {
313 diff = *pta++ - *ptf++;
314 sigma += diff * diff;
315 }
316
317 return sqrt(sigma / (cxdouble) size2);
318
319}
320
321
336cpl_image *
337giraffe_matrix_create_image(const cpl_matrix *matrix)
338{
339
340 cpl_image *image = NULL;
341
342
343 if (matrix) {
344 cxint nx = cpl_matrix_get_ncol(matrix);
345 cxint ny = cpl_matrix_get_nrow(matrix);
346
347
348 image = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
349
350 if (image) {
351 cxsize sz = nx * ny;
352 cxdouble *pixels = cpl_image_get_data_double(image);
353
354 memcpy(pixels, cpl_matrix_get_data_const(matrix),
355 sz * sizeof(cxdouble));
356 }
357 }
358
359 return image;
360
361}
362
363#define PIX_STACK_SIZE 50
364
379cxint
380giraffe_matrix_sort(cpl_matrix *mA)
381{
382 register cxint i;
383 register cxint ir;
384 register cxint j;
385 register cxint j_stack;
386 register cxint k;
387 register cxint l;
388
389 register cxdouble a;
390 register cxdouble *pix_arr = NULL;
391
392 cxint i_stack[PIX_STACK_SIZE] ;
393
394
395 pix_arr = cpl_matrix_get_data(mA);
396 ir = cpl_matrix_get_nrow(mA) * cpl_matrix_get_ncol(mA);
397
398 l = 1 ;
399 j_stack = 0 ;
400 for (;;) {
401 if (ir - l < 7) {
402 for (j = l + 1 ; j <= ir ; j++) {
403 a = pix_arr[j - 1];
404 for (i = j - 1 ; i >= 1 ; i--) {
405 if (pix_arr[i - 1] <= a) {
406 break;
407 }
408 pix_arr[i] = pix_arr[i - 1];
409 }
410 pix_arr[i] = a;
411 }
412 if (j_stack == 0) {
413 break;
414 }
415 ir = i_stack[j_stack-- - 1];
416 l = i_stack[j_stack-- - 1];
417 }
418 else {
419 k = (l + ir) >> 1;
420 _giraffe_swap(&pix_arr[k - 1], &pix_arr[l]);
421 if (pix_arr[l] > pix_arr[ir - 1]) {
422 _giraffe_swap(&pix_arr[l], &pix_arr[ir - 1]);
423 }
424 if (pix_arr[l - 1] > pix_arr[ir - 1]) {
425 _giraffe_swap(&pix_arr[l - 1], &pix_arr[ir - 1]);
426 }
427 if (pix_arr[l] > pix_arr[l - 1]) {
428 _giraffe_swap(&pix_arr[l], &pix_arr[l - 1]);
429 }
430 i = l + 1;
431 j = ir;
432 a = pix_arr[l - 1];
433 for (;;) {
434 do {
435 i++;
436 } while (pix_arr[i - 1] < a);
437
438 do {
439 j--;
440 } while (pix_arr[j - 1] > a);
441
442 if (j < i) {
443 break;
444 }
445 _giraffe_swap(&pix_arr[i - 1], &pix_arr[j - 1]);
446 }
447 pix_arr[l - 1] = pix_arr[j - 1];
448 pix_arr[j - 1] = a;
449 j_stack += 2;
450 if (j_stack > PIX_STACK_SIZE) {
451 /* stack too small in pixel_qsort: aborting */
452 return -1 ;
453 }
454 if (ir - i + 1 >= j - l) {
455 i_stack[j_stack - 1] = ir;
456 i_stack[j_stack - 2] = i;
457 ir = j - 1;
458 }
459 else {
460 i_stack[j_stack - 1] = j - 1;
461 i_stack[j_stack - 2] = l;
462 l = i;
463 }
464 }
465 }
466
467 return 0;
468
469}
470
471#undef PIX_STACK_SIZE
472
473
502cpl_matrix *
503giraffe_matrix_leastsq(const cpl_matrix* mA, const cpl_matrix* mB)
504{
505
506 cpl_matrix* m1 = NULL;
507 cpl_matrix* m2 = NULL;
508 cpl_matrix* m3 = NULL;
509 cpl_matrix* mX = NULL;
510
511
512 cx_assert(mA != NULL);
513 cx_assert(mB != NULL);
514 cx_assert(cpl_matrix_get_ncol(mA) == cpl_matrix_get_ncol(mB));
515
516 m1 = cpl_matrix_transpose_create(mA);
517 m2 = cpl_matrix_product_create(mA, m1);
518 m3 = cpl_matrix_invert_create(m2);
519
520 if (m3 == NULL) {
521 cpl_matrix_delete(m2);
522 m2 = NULL;
523
524 cpl_matrix_delete(m1);
525 m1 = NULL;
526
527 return NULL;
528 }
529
530 cpl_matrix_delete(m2);
531
532 m2 = cpl_matrix_product_create(mB, m1);
533
534 cpl_matrix_delete(m1);
535 m1 = NULL;
536
537 mX = cpl_matrix_product_create(m2, m3);
538
539 cpl_matrix_delete(m2);
540 m2 = NULL;
541
542 cpl_matrix_delete(m3);
543 m3 = NULL;
544
545 return mX;
546
547}
548
549
578cpl_matrix*
579giraffe_matrix_solve_cholesky(const cpl_matrix* A, const cpl_matrix* b,
580 const cpl_matrix* Cb, cpl_matrix* Cx)
581{
582
583 const char* const _id = "giraffe_matrix_solve_cholesky";
584
585 cxint m = 0;
586 cxint n = 0;
587
588 cpl_matrix* AT = NULL;
589 cpl_matrix* ATC = NULL;
590 cpl_matrix* ATCA = NULL;
591 cpl_matrix* ATCb = NULL;
592 cpl_matrix* C = NULL;
593 cpl_matrix* X = NULL;
594 cpl_matrix* x = NULL;
595
596 cpl_error_code status = CPL_ERROR_NONE;
597
598
599 if ((A == NULL) || (b == NULL)) {
600
601 cpl_error_set(_id, CPL_ERROR_NULL_INPUT);
602 return NULL;
603
604 }
605
606 m = cpl_matrix_get_nrow(A);
607 n = cpl_matrix_get_ncol(A);
608
609 if ((cpl_matrix_get_nrow(b) != m) || (cpl_matrix_get_ncol(b) != 1)) {
610
611 cpl_error_set(_id, CPL_ERROR_INCOMPATIBLE_INPUT);
612 return NULL;
613
614 }
615
616 if (Cb != NULL) {
617
618 if ((cpl_matrix_get_nrow(Cb) != m) || (cpl_matrix_get_ncol(Cb) != m)) {
619 cpl_error_set(_id, CPL_ERROR_INCOMPATIBLE_INPUT);
620 return NULL;
621 }
622
623 }
624
625 if (Cx != NULL) {
626
627 if ((cpl_matrix_get_nrow(Cx) != n) || (cpl_matrix_get_ncol(Cx) != n)) {
628 cpl_error_set(_id, CPL_ERROR_ILLEGAL_INPUT);
629 return NULL;
630 }
631
632 }
633
634
635 if (Cb != NULL) {
636
637 /*
638 * Speed up matrix inversion in case it is a non-singular, diagonal
639 * matrix.
640 */
641
642 if (cpl_matrix_is_diagonal(Cb, CX_MINDOUBLE) == TRUE) {
643
644 register cxint i = 0;
645
646 C = cpl_matrix_new(m, m);
647
648 for (i = 0; i < m; ++i) {
649
650 register cxdouble value = cpl_matrix_get(Cb, i, i);
651
652 if (value <= CX_MINDOUBLE) {
653
654 cpl_matrix_delete(C);
655 C = NULL;
656
657 break;
658 }
659
660 cpl_matrix_set(C, i, i, 1. / value);
661
662 }
663
664 }
665 else {
666 C = cpl_matrix_invert_create(Cb);
667 }
668
669 if (C == NULL) {
670 cpl_error_set(_id, CPL_ERROR_SINGULAR_MATRIX);
671 return NULL;
672 }
673
674 }
675 else {
676
677 /*
678 * If no covariance matrix is given, it is assumed that the components
679 * of b are statistically independent, and they all are used with
680 * the same (arbitrary) weight, i.e. the covariance matrix has
681 * non-zero entries in the diagonal, and these entries are all the
682 * same constant.
683 *
684 * Using 1 as the constant value, the covariance matrix is the identity
685 * matrix and its inverse is the identity matrix itself.
686 */
687
688 C = cpl_matrix_new(m, m);
689 cpl_matrix_fill_diagonal(C, 1., 0);
690
691 }
692
693
694 AT = cpl_matrix_transpose_create(A);
695 ATC = cpl_matrix_product_create(AT, C);
696
697 cpl_matrix_delete(AT);
698 AT = NULL;
699
700 cpl_matrix_delete(C);
701 C = NULL;
702
703
704 ATCA = cpl_matrix_product_create(ATC, A);
705 ATCb = cpl_matrix_product_create(ATC, b);
706
707 cpl_matrix_delete(ATC);
708 ATC = NULL;
709
710
711 /*
712 * Cholesky decomposition of the matrix ATCA
713 */
714
715 status = cpl_matrix_decomp_chol(ATCA);
716
717 if (status != CPL_ERROR_NONE) {
718
719 cpl_matrix_delete(ATCA);
720 ATCA = NULL;
721
722 cpl_matrix_delete(ATCb);
723 ATCb = NULL;
724
725 return NULL;
726
727 }
728
729
730 /*
731 * Create a temporary storage for the solution x and its covariance
732 * matrix. This is done by passing the following right hand side matrix
733 * to the solver. It contains the (n x n) identity matrix in the
734 * columns 0 to n - 1, and the vector ATCb in its last column.
735 * The solver will replace the first column with the sought solution,
736 * and the identity matrix with the covariance matrix of the computed
737 * solution.
738 */
739
740 X = cpl_matrix_new(n, n + 1);
741
742 cpl_matrix_fill_diagonal(X, 1., 0);
743 cpl_matrix_copy(X, ATCb, 0, n);
744
745 cpl_matrix_delete(ATCb);
746 ATCb = NULL;
747
748
749 status = cpl_matrix_solve_chol(ATCA, X);
750
751 cpl_matrix_delete(ATCA);
752 ATCA = NULL;
753
754 if (status != CPL_ERROR_NONE) {
755 cpl_matrix_delete(X);
756 X = NULL;
757 }
758
759
760 /*
761 * Decompose the result of the solver into the solution and its
762 * covariance matrix (if requested).
763 */
764
765 x = cpl_matrix_extract_column(X, n);
766
767 if (Cx != NULL) {
768 cpl_matrix_copy(Cx, X, 0, 0);
769 }
770
771 cpl_matrix_delete(X);
772 X = NULL;
773
774 return x;
775
776}
777
778
779
780
781
795cxint
796giraffe_matrix_clear(cpl_matrix *matrix)
797{
798 cxint nr_matrix;
799 cxint nc_matrix;
800
801 cxdouble *pd_matrix = NULL;
802
803 cx_assert(matrix != NULL);
804
805 pd_matrix = cpl_matrix_get_data(matrix);
806 nc_matrix = cpl_matrix_get_ncol(matrix);
807 nr_matrix = cpl_matrix_get_nrow(matrix);
808
809 memset(pd_matrix, 0, nr_matrix * nc_matrix * sizeof(cxdouble));
810
811 return 0;
812
813}
814
815
835void
836giraffe_matrix_dump(const cpl_matrix *matrix, cxint max_rows)
837{
838
839 cxint i;
840 cxint j;
841 cxint k;
842 cxint nc;
843 cxint nr;
844 /*cxint ncw;*/
845
846 const cxdouble *pd_m = NULL;
847
848 cx_string *buffer = NULL;
849 cx_string *tmp = NULL;
850
851 if (matrix == NULL) {
852 return;
853 }
854
855 pd_m = cpl_matrix_get_data_const(matrix);
856
857 nr = cpl_matrix_get_nrow(matrix);
858 nc = cpl_matrix_get_ncol(matrix);
859
860 if (nr > max_rows) {
861 nr = max_rows;
862 }
863
864 buffer = cx_string_new();
865 tmp = cx_string_new();
866
867 /* print header */
868 for (i = 0; i < nc; i++) {
869 /*ncw =*/ cx_string_sprintf(tmp, " %d", i);
870 cx_string_append(buffer, cx_string_get(tmp));
871 }
872
873 cpl_msg_debug("", "%s", cx_string_get(buffer));
874
875 /* print values */
876 for (k = 0, i = 0; i < nr; i++) {
877 /*ncw =*/ cx_string_sprintf(buffer," %d", i);
878 for (j = 0; j < nc; j++, k++) {
879 /*ncw =*/ cx_string_sprintf(tmp, " %+18.12f", pd_m[k]);
880 cx_string_append(buffer, cx_string_get(tmp));
881 }
882
883 cpl_msg_debug("", "%s", cx_string_get(buffer));
884 }
885
886 cx_string_delete(tmp);
887 cx_string_delete(buffer);
888
889 return;
890
891}
cxint giraffe_matrix_clear(cpl_matrix *matrix)
Set all elements of a matrix to zero.
Definition: gimatrix.c:796
cpl_matrix * giraffe_matrix_solve_cholesky(const cpl_matrix *A, const cpl_matrix *b, const cpl_matrix *Cb, cpl_matrix *Cx)
Solve a linear system using the Cholesky decomposition.
Definition: gimatrix.c:579
void giraffe_matrix_dump(const cpl_matrix *matrix, cxint max_rows)
Output a maximum number of rows of the input matrix.
Definition: gimatrix.c:836
cpl_image * giraffe_matrix_create_image(const cpl_matrix *matrix)
Converts a matrix into an image.
Definition: gimatrix.c:337
cxdouble giraffe_matrix_sigma_fit(const cpl_matrix *matrix, const cpl_matrix *matrix_fit)
Compute sigma of matrix fit.
Definition: gimatrix.c:275
cpl_matrix * giraffe_matrix_leastsq(const cpl_matrix *mA, const cpl_matrix *mB)
Computes the solution of an equation using a pseudo-inverse.
Definition: gimatrix.c:503
cxint giraffe_matrix_sort(cpl_matrix *mA)
Sort in place the matrix elements in ascending order.
Definition: gimatrix.c:380
cxdouble giraffe_matrix_sigma_mean(const cpl_matrix *matrix, cxdouble mean)
Compute sigma of matrix elements, with a given mean value.
Definition: gimatrix.c:229

This file is part of the GIRAFFE Pipeline Reference Manual 2.18.4.
Documentation copyright © 2002-2006 European Southern Observatory.
Generated on Mon Jul 7 2025 10:23:39 by doxygen 1.9.6 written by Dimitri van Heesch, © 1997-2004