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 
43 inline 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 
56 inline 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 
78 static 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 
228 cxdouble
229 giraffe_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 
274 cxdouble
275 giraffe_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 
336 cpl_image *
337 giraffe_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 
379 cxint
380 giraffe_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 
502 cpl_matrix *
503 giraffe_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 
578 cpl_matrix*
579 giraffe_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 
795 cxint
796 giraffe_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 
835 void
836 giraffe_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
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_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
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.16.10.
Documentation copyright © 2002-2006 European Southern Observatory.
Generated on Thu Dec 15 2022 21:18:51 by doxygen 1.9.1 written by Dimitri van Heesch, © 1997-2004