GIRAFFE Pipeline Reference Manual

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

This file is part of the GIRAFFE Pipeline Reference Manual 2.12.
Documentation copyright © 2002-2006 European Southern Observatory.
Generated on Mon Mar 24 2014 11:43:52 by doxygen 1.8.2 written by Dimitri van Heesch, © 1997-2004