SINFONI Pipeline Reference Manual  2.5.2
sinfo_recipes.c
1 /*
2  * This file is part of the ESO SINFONI Pipeline
3  * Copyright (C) 2004,2005 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, 51 Franklin St, Fifth Floor, Boston, MA 02111-1307 USA
18  */
19 /***************************************************************************
20 * E.S.O. - VLT project
21 *
22 *
23 *
24 * who when what
25 * -------- -------- ----------------------------------------------
26 * schreib 05/06/00 created
27 */
28 
29 #ifdef HAVE_CONFIG_H
30 # include <config.h>
31 #endif
32 
33 #include "sinfo_vltPort.h"
34 
35 /*
36  * System Headers
37  */
38 
39 /*
40  * Local Headers
41  */
42 
43 #include "sinfo_recipes.h"
44 #include "sinfo_globals.h"
45 
46 /*----------------------------------------------------------------------------
47  * Local variables
48  *--------------------------------------------------------------------------*/
49 
50 static float sqrarg ;
51 
52 static double chi1 ; /* old reduced chi-squared */
53 static double sinfo_chi2 ; /* new reduced chi-squared */
54 static double labda ; /* mixing parameter */
55 static double vec[MAXPAR] ; /* correction sinfo_vector */
56 static double matrix1[MAXPAR][MAXPAR] ; /* original sinfo_matrix */
57 static double matrix2[MAXPAR][MAXPAR] ; /* inverse of matrix1 */
58 static int nfree ; /* number of free parameters */
59 static int parptr[MAXPAR] ; /* parameter pointer */
60 
61 /*----------------------------------------------------------------------------
62  * Defines
63  *--------------------------------------------------------------------------*/
64 
65 #define SQR(a) (sqrarg = (a) , sqrarg*sqrarg)
66 
67 /*----------------------------------------------------------------------------
68  * Functions private to this module
69  *--------------------------------------------------------------------------*/
70 
71 
72 static int new_inv_mat (void) ;
73 
74 static void new_get_mat ( float * xdat,
75  int * xdim,
76  float * ydat,
77  float * wdat,
78  int * ndat,
79  float * fpar,
80  float * epar/*,
81  int * npar */) ;
82 
83 static int new_get_vec ( float * xdat,
84  int * xdim,
85  float * ydat,
86  float * wdat,
87  int * ndat,
88  float * fpar,
89  float * epar,
90  int * npar ) ;
91 
92 static float
93 new_gaussian ( float * xdat, float * parlist/*, int * npar*/ );
94 static void
95 new_gaussian_deriv( float * xdat, float * parlist,
96  float * dervs/*, int * npar*/ );
97 
98 
99 
107 /*----------------------------------------------------------------------------
108  * Function codes
109  *--------------------------------------------------------------------------*/
110 
111 
112 float sinfo_new_f_median(float * array, int n)
113 {
114  pixelvalue p_array[100];
115  int i;
116 
117  for (i=0;i<n;i++)
118  p_array[i]= (pixelvalue) array[i];
119 
120  return (float) sinfo_new_median(p_array, n);
121 }
122 
123 
140 float sinfo_new_clean_mean( float * array,
141  int n_elements,
142  float throwaway_low,
143  float throwaway_high )
144 {
145  int i, n ;
146  int lo_n, hi_n ;
147  float sum ;
148 
149  if ( array == NULL )
150  {
151  sinfo_msg_error(" no array given in sinfo_clean_mean!") ;
152  return FLT_MAX ;
153  }
154 
155  if ( n_elements <= 0 )
156  {
157  sinfo_msg_error("wrong number of elements given") ;
158  return FLT_MAX ;
159  }
160 
161  if ( throwaway_low < 0. || throwaway_high < 0. ||
162  throwaway_low + throwaway_high >= 100. )
163  {
164  sinfo_msg_error("wrong throw away percentage given!") ;
165  return FLT_MAX ;
166  }
167 
168  lo_n = (int) (throwaway_low * (float)n_elements / 100.) ;
169  hi_n = (int) (throwaway_high * (float)n_elements / 100.) ;
170 
171  /* sort the array */
172  sinfo_pixel_qsort( array, n_elements ) ;
173 
174  n = 0 ;
175  sum = 0. ;
176  for ( i = lo_n ; i < n_elements - hi_n ; i++ )
177  {
178  if ( !isnan(array[i]) )
179  {
180  sum += array[i] ;
181  n++ ;
182  }
183  }
184  if ( n == 0 )
185  {
186  return FLAG ;
187  }
188  else
189  {
190  return sum/(float)n ;
191  }
192 }
193 
194 /*--------------------------------------------------------------------------*/
207 pixelvalue sinfo_new_median(pixelvalue * array, int n)
208 {
209  pixelvalue med ;
210 
211  if ( array == NULL || n <= 0 )
212  {
213  sinfo_msg_warning("nothing in the pixelvalue array, ZERO returned");
214  return ZERO ;
215  }
216 
217  if ( n == 1 )
218  {
219  return array[0] ;
220  }
221 
222  sinfo_pixel_qsort((float*) array, n) ;
223  if ( n % 2 == 1 )
224  {
225  med = array[n/2] ;
226  }
227  else
228  {
229  med = (array[n/2] + array[n/2 - 1])/2. ;
230  }
231  return med ;
232 }
233 
234 
235 
236 
237 
285 int sinfo_new_lsqfit_c ( float * xdat,
286  int * xdim,
287  float * ydat,
288  float * wdat,
289  int * ndat,
290  float * fpar,
291  float * epar,
292  int * mpar,
293  int * npar,
294  float * tol ,
295  int * its ,
296  float * lab )
297 {
298  int i, n, r ;
299  int itc ; /* fate of fit */
300  int found ; /* fit converged: 1, not yet converged: 0 */
301  int nuse ; /* number of useable data points */
302  double tolerance ; /* accuracy */
303 
304  itc = 0 ; /* fate of fit */
305  found = 0 ; /* reset */
306  nfree = 0 ; /* number of free parameters */
307  nuse = 0 ; /* number of legal data points */
308 
309  if ( *tol < (FLT_EPSILON * 10.0 ) )
310  {
311  tolerance = FLT_EPSILON * 10.0 ; /* default tolerance */
312  }
313  else
314  {
315  tolerance = *tol ; /* tolerance */
316  }
317 
318  labda = fabs( *lab ) * LABFAC ; /* start value for mixing parameter */
319  for ( i = 0 ; i < (*npar) ; i++ )
320  {
321  if ( mpar[i] )
322  {
323  if ( nfree > MAXPAR ) /* too many free parameters */
324  {
325  return -1 ;
326  }
327  parptr[nfree++] = i ; /* a free parameter */
328  }
329  }
330 
331  if (nfree == 0) /* no free parameters */
332  {
333  return -2 ;
334  }
335 
336  for ( n = 0 ; n < (*ndat) ; n++ )
337  {
338  if ( wdat[n] > 0.0 ) /* legal weight */
339  {
340  nuse ++ ;
341  }
342  }
343 
344  if ( nfree >= nuse )
345  {
346  return -3 ; /* no degrees of freedom */
347  }
348  if ( labda == 0.0 ) /* linear fit */
349  {
350  /* initialize fpar array */
351  for ( i = 0 ; i < nfree ; fpar[parptr[i++]] = 0.0 ) ;
352  new_get_mat ( xdat, xdim, ydat, wdat, ndat, fpar, epar/*, npar*/ ) ;
353  r = new_get_vec ( xdat, xdim, ydat, wdat, ndat, fpar, epar, npar ) ;
354  if ( r ) /* error */
355  {
356  return r ;
357  }
358  for ( i = 0 ; i < (*npar) ; i++ )
359  {
360  fpar[i] = epar[i] ; /* save new parameters */
361  epar[i] = 0.0 ; /* and set errors to zero */
362  }
363  chi1 = sqrt( chi1 / (double) (nuse - nfree) ) ;
364  for ( i = 0 ; i < nfree ; i++ )
365  {
366  if ( (matrix1[i][i] <= 0.0 ) || (matrix2[i][i] <= 0.0) )
367  {
368  return -7 ;
369  }
370  epar[parptr[i]] = chi1 * sqrt( matrix2[i][i] ) /
371  sqrt( matrix1[i][i] ) ;
372  }
373  }
374  else /* non-linear fit */
375  {
376  /*----------------------------------------------------------------
377  * the non-linear fit uses the steepest descent method in combination
378  * with the Taylor method. The mixing of these methods is controlled
379  * by labda. In the outer loop ( called the iteration loop ) we build
380  * the matrix and calculate the correction vector. In the inner loop
381  * (called the interpolation loop) we check whether we have obtained a
382  * better solution than the previous one. If so, we leave the inner
383  loop else we increase labda (give more weight to the steepest
384  descent method) calculate the correction vector and check again.
385  After the inner loop we do a final check on the goodness of the
386  fit and if this satisfies
387  * the tolerance we calculate the errors of the fitted parameters.
388  */
389  while ( !found ) /* iteration loop */
390  {
391  if ( itc++ == (*its) ) /* increase iteration counter */
392  {
393  return -4 ;
394  }
395  new_get_mat( xdat, xdim, ydat, wdat, ndat, fpar, epar/*, npar */) ;
396 
397  /*-------------------------------------------------------------
398  * here we decrease labda since we may assume that each iteration
399  * brings us closer to the answer.
400  */
401  if ( labda > LABMIN )
402  {
403  labda = labda / LABFAC ; /* decrease labda */
404  }
405  r = new_get_vec( xdat, xdim, ydat, wdat, ndat, fpar, epar, npar ) ;
406  if ( r ) /* error */
407  {
408  return r ;
409  }
410 
411  while ( chi1 >= sinfo_chi2 ) /* interpolation loop */
412  {
413  /*-----------------------------------------------------------
414  * The next statement is based on experience, not on the
415  mathematics of the problem. It is assumed that we have
416  reached convergence when the pure steepest descent method
417  does not produce a better solution.
418  */
419  if ( labda > LABMAX ) /* assume solution found */
420  {
421  break ;
422  }
423  labda = labda * LABFAC ; /* increase mixing parameter */
424  r = new_get_vec(xdat,xdim,ydat,wdat,ndat,fpar,epar,npar) ;
425  if ( r ) /* error */
426  {
427  return r ;
428  }
429  }
430 
431  if ( labda <= LABMAX ) /* save old parameters */
432  {
433  for ( i = 0 ; i < *npar ; i++ )
434  {
435  fpar[i] = epar[i] ;
436  }
437  }
438  if ( (fabs( sinfo_chi2 - chi1 ) <= (tolerance * chi1)) ||
439  (labda > LABMAX) )
440  {
441  /*-------------------------------------------------------------
442  * we have a satisfying solution, so now we need to calculate
443  the correct errors of the fitted parameters. This we do by
444  using the pure Taylor method because we are very close to
445  the real solution.
446  */
447  labda = 0.0 ; /* for Taylor solution */
448  new_get_mat(xdat,xdim,ydat,wdat,ndat,fpar,epar/*, npar */) ;
449  r = new_get_vec(xdat,xdim,ydat,wdat,ndat,fpar,epar,npar) ;
450 
451  if ( r ) /* error */
452  {
453  return r ;
454  }
455  for ( i = 0 ; i < (*npar) ; i++ )
456  {
457  epar[i] = 0.0 ; /* set error to zero */
458  }
459  sinfo_chi2 = sqrt ( sinfo_chi2 / (double) (nuse - nfree) ) ;
460 
461  for ( i = 0 ; i < nfree ; i++ )
462  {
463  if ( (matrix1[i][i] <= 0.0) || (matrix2[i][i] <= 0.0) )
464  {
465  return -7 ;
466  }
467  epar[parptr[i]] = sinfo_chi2 * sqrt( matrix2[i][i] ) /
468  sqrt( matrix1[i][i] ) ;
469  }
470  found = 1 ; /* we found a solution */
471  }
472  }
473  }
474  return itc ; /* return number of iterations */
475 }
476 
477 
478 
485 void sinfo_new_convert_ZEROs_to_0_for_images(cpl_image * im)
486 {
487  int i ;
488  int ilx=0;
489  int ily=0;
490  float* pidata=NULL;
491 
492  if ( im == NULL )
493  {
494  sinfo_msg_error("no input image given!\n") ;
495  return ;
496  }
497  ilx=cpl_image_get_size_x(im);
498  ily=cpl_image_get_size_y(im);
499  pidata=cpl_image_get_data(im);
500  for ( i = 0 ; i < (int) ilx*ily ; i++ )
501  {
502  if( isnan(pidata[i]) )
503  {
504  pidata[i] = 0. ;
505  }
506  }
507  return ;
508 }
509 
518 void sinfo_new_convert_ZEROs_to_0_for_cubes(cpl_imagelist * cube)
519 {
520  int i ;
521  int inp=0;
522  cpl_image* i_img=NULL;
523 
524  if ( cube == NULL )
525  {
526  sinfo_msg_error("no input cube given!") ;
527  return ;
528  }
529  inp=cpl_imagelist_get_size(cube);
530 
531  for ( i = 0 ; i < inp ; i++ )
532  {
533  i_img=cpl_imagelist_get(cube,i);
534  sinfo_new_convert_ZEROs_to_0_for_images(i_img) ;
535  cpl_imagelist_set(cube,i_img,i);
536  }
537  return ;
538 }
539 
540 
549 void
550 sinfo_new_convert_ZEROs_to_0_for_cubes_range(cpl_imagelist * cube,
551  const int z_min,const int z_max)
552 {
553  int i ;
554  cpl_image* i_img=NULL;
555 
556  if ( cube == NULL )
557  {
558  sinfo_msg_error("no input cube given!") ;
559  return ;
560  }
561  for ( i = z_min ; i < z_max ; i++ )
562  {
563  i_img=cpl_imagelist_get(cube,i);
564  sinfo_new_convert_ZEROs_to_0_for_images(i_img) ;
565  cpl_imagelist_set(cube,i_img,i);
566  }
567  return ;
568 }
575 void sinfo_new_convert_0_to_ZEROs_for_images(cpl_image * im)
576 {
577  int i ;
578  int ilx=0;
579  int ily=0;
580  float* pidata=NULL;
581 
582  if ( im == NULL )
583  {
584  sinfo_msg_error("no input image given!") ;
585  return ;
586  }
587  ilx=cpl_image_get_size_x(im);
588  ily=cpl_image_get_size_y(im);
589  pidata=cpl_image_get_data(im);
590  for ( i = 0 ; i < (int) ilx*ily ; i++ )
591  {
592  if( pidata[i] == 0. )
593  {
594  pidata[i] = ZERO ;
595  }
596  }
597  return ;
598 }
599 
606 void sinfo_new_convert_0_to_ZERO_for_cubes(cpl_imagelist * cube)
607 {
608  int i ;
609  int inp=0;
610  cpl_image* i_img=NULL;
611 
612  if ( cube == NULL )
613  {
614  sinfo_msg_error("no input cube given!") ;
615  return ;
616  }
617  inp=cpl_imagelist_get_size(cube);
618  for ( i = 0 ; i < inp ; i++ )
619  {
620  i_img=cpl_imagelist_get(cube,i);
621  sinfo_new_convert_0_to_ZEROs_for_images(i_img) ;
622  cpl_imagelist_set(cube,i_img,i);
623  }
624  return ;
625 }
626 
627 
636 void
637 sinfo_new_convert_0_to_ZERO_for_cubes_range(cpl_imagelist * cube,
638  const int z_min,const int z_max)
639 {
640  int i ;
641  //int inp=0;
642  cpl_image* i_img=NULL;
643 
644  if ( cube == NULL )
645  {
646  sinfo_msg_error("no input cube given!") ;
647  return ;
648  }
649  //inp=cpl_imagelist_get_size(cube);
650  for ( i = z_min ; i < z_max ; i++ )
651  {
652  i_img=cpl_imagelist_get(cube,i);
653  sinfo_new_convert_0_to_ZEROs_for_images(i_img) ;
654  cpl_imagelist_set(cube,i_img,i);
655  }
656  return ;
657 }
664 void sinfo_new_invert(cpl_image * im)
665 {
666  int i ;
667  int ilx=0;
668  int ily=0;
669  float* pidata=NULL;
670 
671  ilx=cpl_image_get_size_x(im);
672  ily=cpl_image_get_size_y(im);
673  pidata=cpl_image_get_data(im);
674 
675  for ( i = 0 ; i < (int) ilx*ily ; i++ )
676  {
677  pidata[i] = -pidata[i] ;
678  }
679  return ;
680 }
681 
689 int sinfo_new_nint ( double x )
690 {
691  int k ;
692 
693  k = x ;
694  if ( x >= 0. )
695  {
696  if ( (x - (double) k) <= 0.5 )
697  {
698  return k ;
699  }
700  else
701  {
702  return k + 1 ;
703  }
704  }
705  else
706  {
707  if ( (x - (double) k) <= -0.5 )
708  {
709  return k - 1;
710  }
711  else
712  {
713  return k ;
714  }
715  }
716 }
717 
718 
732 #define STEP_MIN (-half_search)
733 #define STEP_MAX (half_search)
734 
735 double * sinfo_new_xcorrel(
736  float * line_i,
737  int width_i,
738  float * line_t,
739  int width_t,
740  int half_search,
741  int * delta,
742  int * maxpos,
743  double * xcorr_max
744 
745 )
746 {
747  double * xcorr ;
748  double mean_i, mean_t ;
749  double rms_i, rms_t ;
750  double sum, sqsum ;
751  double norm ;
752  int nsteps ;
753  int i ;
754  int step ;
755  int nval ;
756  /*double r;*/
757 
758 
759  /* Compute normalization factors */
760  sum = sqsum = 0.00 ;
761  for (i=0 ; i<width_i ; i++) {
762  sum += (double)line_i[i] ;
763  sqsum += (double)line_i[i] * (double)line_i[i];
764  }
765  mean_i = sum / (double)width_i ;
766  sqsum /= (double)width_i ;
767  rms_i = sqsum - mean_i*mean_i ;
768 
769  sum = sqsum = 0.00 ;
770  for (i=0 ; i<width_t ; i++) {
771  sum += (double)line_t[i] ;
772  sqsum += (double)line_t[i] * (double)line_t[i];
773  }
774  mean_t = sum / (double)width_t ;
775  sqsum /= (double)width_t ;
776  rms_t = sqsum - mean_t*mean_t ;
777 
778  norm = 1.00 / sqrt(rms_i * rms_t);
779 
780  nsteps = (STEP_MAX - STEP_MIN) ;
781  xcorr = cpl_malloc(nsteps * sizeof(double));
782  for (step=STEP_MIN ; step<STEP_MAX ; step++) {
783  xcorr[step-STEP_MIN] = 0.00 ;
784  nval = 0 ;
785  for (i=0 ; i<width_t ; i++) {
786  if ((i+step >= 0) &&
787  (i+step < width_i)) {
788  xcorr[step-STEP_MIN] += ((double)line_t[i] - mean_t) *
789  ((double)line_i[i+step] - mean_i) *
790  norm ;
791  nval++ ;
792  }
793  }
794  xcorr[step-STEP_MIN] /= (double)nval ;
795  }
796  *xcorr_max = xcorr[0] ;
797  *maxpos = 0 ;
798  for (i=0 ; i<nsteps ; i++) {
799  if (xcorr[i]>*xcorr_max) {
800  *maxpos = i ;
801  *xcorr_max = xcorr[i];
802  }
803  }
804  (*delta) = + (STEP_MIN + *maxpos);
805  return xcorr ;
806 }
807 
808 /* FILE ELEMENT: sinfo_nev_ille.c */
809 /* */
810 /**********************************************************************/
811 /* */
812 /* double sinfo_nev_ille() */
813 /* */
814 /**********************************************************************/
815 /* */
816 /* DESCRIPTION: */
817 /* For a given table (x , f(x )), i = 0(1)n and a given argument z */
818 /* the function computes the interpolated value for the argument z */
819 /* using Neville's interpolation/ extrapolation algorithm. */
820 /* */
821 /* FUNCTIONS CALLED: */
822 /* System library: <stdio.h> printf(), fabs(); */
823 /* Numlib library: None */
824 /* Local functions: nevtable(); */
825 /* User supplied: None */
826 /* */
827 /* PROGRAMMED BY: T.Haavie */
828 /* DATE/VERSION: 88-07-06/1.0 */
829 /* */
830 /**********************************************************************/
831 double sinfo_nev_ille(double x[], double f[], int n, double z, int* flag)
832  /* PARAMETERS(input): */
833 /* double x[]; Abscissae values in the table. */
834 /* double f[]; Function values in the table. */
835 /* int n; The number of elements in the table is n+1. */
836 /* double z; Argument to be used in interpolation/extrapolation. */
837 
838 
839 /* PARAMETERS(input/output): */
840 /* int *flag; Flag parameter(output): */
841  /* = 0, n < 0 and/or eps < 0, should be positive+. */
842  /* = 1, required rel.err. is not obtained. */
843  /* = 2, required rel. err. is obtained. */
844 
845 /* the computed estimate for the interpolated/extrapolated value re- */
846 /* turned through function name sinfo_nev_ille. */
847 
848 {
849  double p[11]; /* Array used for storing the new row elements */
850  /* in the interpolation/extrapolation table. */
851  double q[11]; /* Array used for storing the old row elements */
852  /* in the interpolation/extrapolation table */
853 
854  double factor;
855  int m, k;
856 
857 
858 
859  if (n < 0 )
860  {
861  *flag = 0;
862  return(0.);
863  }
864 
865 
866  q[0] = f[0]; /* Set initial value in the table. */
867 
868  for (k = 1; k <= n; k++) /* k counts rows in the table. */
869  {
870  p[0] = f[k];
871  for (m = 1; m <= k; m++) /* m counts element in row. */
872  {
873  factor = (z - x[k]) / (x[k] - x[k-m]);
874  p[m] = p[m-1] + factor * (p[m-1] - q[m-1]);
875  }
876 
877 
878  for (m = 0; m <= k; m++) /* Shift old row to new row. */
879  q[m] = p[m];
880 
881  } /* End of k-loop. */
882 
883  *flag = 1; /* Required rel.error is not obtained. */
884  return(p[n]);
885 
886 } /* End of sinfo_nev_ille(). */
887 
888 
889 
890 float sinfo_new_nev_ille(float x[], float f[], int n, float z, int* flag)
891  /* PARAMETERS(input): */
892 /* float x[]; Abscissae values in the table. */
893 /* float f[]; Function values in the table. */
894 /* int n; The number of elements in the table is n+1. */
895 /* float z; Argument to be used in interpolation/extrapolation. */
896 
897 
898 /* PARAMETERS(input/output): */
899 /* int *flag; Flag parameter(output): */
900  /* = 0, n < 0 and/or eps < 0, should be positive+. */
901  /* = 1, required rel.err. is not obtained. */
902  /* = 2, required rel. err. is obtained. */
903 
904 /* the computed estimate for the interpolated/extrapolated value re- */
905 /* turned through function name sinfo_nev_ille. */
906 
907 {
908  float p[11]; /* Array used for storing the new row elements */
909  /* in the interpolation/extrapolation table. */
910  float q[11]; /* Array used for storing the old row elements */
911  /* in the interpolation/extrapolation table */
912 
913  float factor;
914  int m, k;
915 
916 
917 
918  if (n < 0 )
919  {
920  *flag = 0;
921  return(0.);
922  }
923 
924 
925  q[0] = f[0]; /* Set initial value in the table. */
926 
927  for (k = 1; k <= n; k++) /* k counts rows in the table. */
928  {
929  p[0] = f[k];
930  for (m = 1; m <= k; m++) /* m counts element in row. */
931  {
932  factor = (z - x[k]) / (x[k] - x[k-m]);
933  p[m] = p[m-1] + factor * (p[m-1] - q[m-1]);
934  }
935 
936 
937  for (m = 0; m <= k; m++) /* Shift old row to new row. */
938  q[m] = p[m];
939 
940  } /* End of k-loop. */
941 
942  *flag = 1; /* Required rel.error is not obtained. */
943  return(p[n]);
944 
945 } /* End of sinfo_nev_ille(). */
946 
947 
972 static int new_get_vec ( float * xdat,
973  int * xdim,
974  float * ydat,
975  float * wdat,
976  int * ndat,
977  float * fpar,
978  float * epar,
979  int * npar )
980 {
981  double dj ;
982  double dy ;
983  double mii ;
984  double mji ;
985  double mjj ;
986  double wn ;
987  int i, j, n, r ;
988 
989  /* loop to modify and scale the sinfo_matrix */
990  for ( j = 0 ; j < nfree ; j++ )
991  {
992  mjj = matrix1[j][j] ;
993  if ( mjj <= 0.0 ) /* diagonal element wrong */
994  {
995  return -5 ;
996  }
997  mjj = sqrt( mjj ) ;
998  for ( i = 0 ; i < j ; i++ )
999  {
1000  mji = matrix1[j][i] / mjj / sqrt( matrix1[i][i] ) ;
1001  matrix2[i][j] = matrix2[j][i] = mji ;
1002  }
1003  matrix2[j][j] = 1.0 + labda ; /* scaled value on diagonal */
1004  }
1005 
1006  if ( (r = new_inv_mat()) ) /* sinfo_invert sinfo_matrix inlace */
1007  {
1008  return r ;
1009  }
1010 
1011  for ( i = 0 ; i < (*npar) ; i ++ )
1012  {
1013  epar[i] = fpar[i] ;
1014  }
1015 
1016  /* loop to calculate correction sinfo_vector */
1017  for ( j = 0 ; j < nfree ; j++ )
1018  {
1019  dj = 0.0 ;
1020  mjj = matrix1[j][j] ;
1021  if ( mjj <= 0.0) /* not allowed */
1022  {
1023  return -7 ;
1024  }
1025  mjj = sqrt ( mjj ) ;
1026  for ( i = 0 ; i < nfree ; i++ )
1027  {
1028  mii = matrix1[i][i] ;
1029  if ( mii <= 0.0 )
1030  {
1031  return -7 ;
1032  }
1033  mii = sqrt( mii ) ;
1034  dj += vec[i] * matrix2[j][i] / mjj / mii ;
1035  }
1036  epar[parptr[j]] += dj ; /* new parameters */
1037  }
1038  chi1 = 0.0 ; /* reset reduced chi-squared */
1039 
1040  /* loop through the data points */
1041  for ( n = 0 ; n < (*ndat) ; n++ )
1042  {
1043  wn = wdat[n] ; /* get weight */
1044  if ( wn > 0.0 ) /* legal weight */
1045  {
1046  dy = ydat[n] - new_gaussian( &xdat[(*xdim) * n], epar/*, npar*/ ) ;
1047  chi1 += wdat[n] * dy * dy ;
1048  }
1049  }
1050  return 0 ;
1051 }
1052 
1053 
1069 static void new_get_mat ( float * xdat,
1070  int * xdim,
1071  float * ydat,
1072  float * wdat,
1073  int * ndat,
1074  float * fpar,
1075  float * epar/*,
1076  int * npar */)
1077 {
1078  double wd ;
1079  double wn ;
1080  double yd ;
1081  int i, j, n ;
1082 
1083  for ( j = 0 ; j < nfree ; j++ )
1084  {
1085  vec[j] = 0.0 ; /* zero sinfo_vector */
1086  for ( i = 0 ; i<= j ; i++ )
1087  /* zero sinfo_matrix only on and below diagonal */
1088  {
1089  matrix1[j][i] = 0.0 ;
1090  }
1091  }
1092  sinfo_chi2 = 0.0 ; /* reset reduced chi-squared */
1093 
1094  /* loop through data points */
1095  for ( n = 0 ; n < (*ndat) ; n++ )
1096  {
1097  wn = wdat[n] ;
1098  if ( wn > 0.0 ) /* legal weight ? */
1099  {
1100  yd = ydat[n] - new_gaussian( &xdat[(*xdim) * n], fpar/*, npar*/ ) ;
1101  new_gaussian_deriv( &xdat[(*xdim) * n], fpar, epar/*, npar*/ ) ;
1102  sinfo_chi2 += yd * yd * wn ; /* add to chi-squared */
1103  for ( j = 0 ; j < nfree ; j++ )
1104  {
1105  wd = epar[parptr[j]] * wn ; /* weighted derivative */
1106  vec[j] += yd * wd ; /* fill sinfo_vector */
1107  for ( i = 0 ; i <= j ; i++ ) /* fill sinfo_matrix */
1108  {
1109  matrix1[j][i] += epar[parptr[i]] * wd ;
1110  }
1111  }
1112  }
1113  }
1114 }
1115 
1116 
1117 
1118 
1119 
1120 
1129 static int new_inv_mat (void)
1130 {
1131  double even ;
1132  double hv[MAXPAR] ;
1133  double mjk ;
1134  double rowmax ;
1135  int evin ;
1136  int i, j, k, row ;
1137  int per[MAXPAR] ;
1138 
1139  /* set permutation array */
1140  for ( i = 0 ; i < nfree ; i++ )
1141  {
1142  per[i] = i ;
1143  }
1144 
1145  for ( j = 0 ; j < nfree ; j++ ) /* in j-th column */
1146  {
1147  /* determine largest element of a row */
1148  rowmax = fabs ( matrix2[j][j] ) ;
1149  row = j ;
1150 
1151  for ( i = j + 1 ; i < nfree ; i++ )
1152  {
1153  if ( fabs ( matrix2[i][j] ) > rowmax )
1154  {
1155  rowmax = fabs( matrix2[i][j] ) ;
1156  row = i ;
1157  }
1158  }
1159 
1160  /* determinant is zero! */
1161  if ( matrix2[row][j] == 0.0 )
1162  {
1163  return -6 ;
1164  }
1165 
1166  /*if the largest element is not on the diagonal, then permutate rows */
1167  if ( row > j )
1168  {
1169  for ( k = 0 ; k < nfree ; k++ )
1170  {
1171  even = matrix2[j][k] ;
1172  matrix2[j][k] = matrix2[row][k] ;
1173  matrix2[row][k] = even ;
1174  }
1175  /* keep track of permutation */
1176  evin = per[j] ;
1177  per[j] = per[row] ;
1178  per[row] = evin ;
1179  }
1180 
1181  /* modify column */
1182  even = 1.0 / matrix2[j][j] ;
1183  for ( i = 0 ; i < nfree ; i++ )
1184  {
1185  matrix2[i][j] *= even ;
1186  }
1187  matrix2[j][j] = even ;
1188 
1189  for ( k = 0 ; k < j ; k++ )
1190  {
1191  mjk = matrix2[j][k] ;
1192  for ( i = 0 ; i < j ; i++ )
1193  {
1194  matrix2[i][k] -= matrix2[i][j] * mjk ;
1195  }
1196  for ( i = j + 1 ; i < nfree ; i++ )
1197  {
1198  matrix2[i][k] -= matrix2[i][j] * mjk ;
1199  }
1200  matrix2[j][k] = -even * mjk ;
1201  }
1202 
1203  for ( k = j + 1 ; k < nfree ; k++ )
1204  {
1205  mjk = matrix2[j][k] ;
1206  for ( i = 0 ; i < j ; i++ )
1207  {
1208  matrix2[i][k] -= matrix2[i][j] * mjk ;
1209  }
1210  for ( i = j + 1 ; i < nfree ; i++ )
1211  {
1212  matrix2[i][k] -= matrix2[i][j] * mjk ;
1213  }
1214  matrix2[j][k] = -even * mjk ;
1215  }
1216  }
1217 
1218  /* finally, repermute the columns */
1219  for ( i = 0 ; i < nfree ; i++ )
1220  {
1221  for ( k = 0 ; k < nfree ; k++ )
1222  {
1223  hv[per[k]] = matrix2[i][k] ;
1224  }
1225  for ( k = 0 ; k < nfree ; k++ )
1226  {
1227  matrix2[i][k] = hv[k] ;
1228  }
1229  }
1230 
1231  /* all is well */
1232  return 0 ;
1233 }
1234 
1235 
1236 
1237 
1258 float new_gaussian ( float * xdat, float * parlist/*, int * npar*/ )
1259 {
1260  double xd ; /* FWHM's of gauss function */
1261  double x ; /* position */
1262 
1263  xd = fabs((double) parlist[1]) ;
1264  x = (double) xdat[0] - (double) parlist[2] ;
1265  return (float) (
1266  (double) parlist[0] * exp( -4.0 * log(2.0) * (x/xd) * (x/xd) )
1267  + (double) parlist[3] ) ;
1268 }
1269 
1270 
1295 void
1296 new_gaussian_deriv(float * xdat,float * parlist,float * dervs/*, int * npar*/ )
1297 {
1298  double xd ; /* FWHM of sinfo_gaussian */
1299  double x, expon ; /* position and exponent */
1300 
1301  xd = fabs( (double) parlist[1] ) ;
1302 
1303  /* offset from peak position */
1304  x = (double) xdat[0] - (double) parlist[2] ;
1305 
1306  /* determine the derivatives: */
1307  expon = -4.0 * log(2.0) * (x/xd) * (x/xd) ;
1308  expon = exp( expon ) ;
1309 
1310  /* partial derivative by the amplitude */
1311  dervs[0] = (float) expon ;
1312 
1313  /* calculate a * exp(-arg) */
1314  expon = (double) parlist[0] * expon ;
1315 
1316  /* partial derivative by FWHM */
1317  dervs[1] = (float) ( expon * 8.0 * log(2.0) * x*x / (xd*xd*xd) ) ;
1318 
1319  /* partial derivative by the x position (parlist[2]) */
1320  dervs[2] = (float) (expon * 8.0 * log(2.0) * x/(xd*xd) ) ;
1321 
1322  /* partial derivative by the zero level */
1323  dervs[3] = 1.0 ;
1324 }
1325 
1326 
1327 /*==================================================================*/
1328 
1329 
1349 void
1350 sinfo_my_fit(float x[], float y[], int ndata, float sig[], int mwt, float *a,
1351  float *b, float *siga, float *sigb, float *chi2, float *q)
1352 {
1353  int i ;
1354  float wt, t, sxoss, sx=0., sy=0., st2=0., ss, sigdat ;
1355 
1356  *b = 0. ; /*accumulate sums ...*/
1357  if ( mwt )
1358  {
1359  ss = 0. ;
1360  for ( i = 0 ; i < ndata ; i++ ) /*... with weights*/
1361  {
1362  wt = 1./SQR(sig[i]) ;
1363  ss += wt ;
1364  sx += x[i]*wt ;
1365  sy += y[i]*wt ;
1366  }
1367  }
1368  else
1369  {
1370  for ( i = 0 ; i < ndata ; i++ ) /*... or without weights*/
1371  {
1372  sx += x[i] ;
1373  sy += y[i] ;
1374  }
1375  ss = ndata ;
1376  }
1377  sxoss = sx/ss ;
1378 
1379  if ( mwt )
1380  {
1381  for ( i = 0 ; i < ndata ; i ++ )
1382  {
1383  t = (x[i] - sxoss)/sig[i] ;
1384  st2 += t*t ;
1385  *b += t*y[i]/sig[i] ;
1386  }
1387  }
1388  else
1389  {
1390  for ( i = 0 ; i < ndata ; i++ )
1391  {
1392  t = x[i] - sxoss ;
1393  st2 += t*t ;
1394  *b += t*y[i] ;
1395  }
1396  }
1397 
1398  *b /= st2 ;
1399  *a = (sy - sx*(*b))/ss ;
1400  *siga = sqrt ((1.0 + sx*sx/(ss*st2))/ss) ;
1401  *sigb = sqrt (1.0/st2) ;
1402  *chi2 = 0.0 ; /*calculate chi-square*/
1403  if ( mwt == 0 )
1404  {
1405  for ( i = 0 ; i < ndata ; i++ )
1406  {
1407  *chi2 += SQR (y[i] - (*a) - (*b)*x[i]) ;
1408  }
1409  *q = 1. ;
1410 
1411  /*------------------------------------------------------------------
1412  * for unweighted data evaluate typical sig using chi2, and adjust
1413  * the standard deviation
1414  */
1415  sigdat = sqrt ((*chi2)/(ndata - 2)) ;
1416  *siga *= sigdat ;
1417  *sigb *= sigdat ;
1418  }
1419  else
1420  {
1421  for (i = 0 ; i < ndata ; i++)
1422  {
1423  *chi2 += SQR ((y[i] - (*a) - (*b) * x[i])/sig[i]) ;
1424  }
1425  *q = 1. ; /* delete rest of lines. q is not a good value */
1426  }
1427 }
1428 
1443 int sinfo_new_correlation ( float * data1, float * data2, int ndata )
1444 {
1445  /*float help[3*ndata] ;
1446  float corsum[3*ndata] ;*/
1447  float* help=NULL ;
1448  float* corsum=NULL ;
1449  float maxval ;
1450  int i, j, k, position, shift ;
1451  int /*start,end,size,*/ndata3,limit;
1452 
1453 
1454  /*ndata3=3*ndata;*/
1455  ndata3=ndata+300;
1456 
1457  if ( NULL == data1 || NULL == data2 || ndata <= 1 )
1458  {
1459  sinfo_msg_error(" wrong input for sinfo_correlation\n") ;
1460  return INT32_MAX ;
1461  }
1462 
1463  /* initialize the help arrays with zeros */
1464  help=cpl_calloc(ndata+300,sizeof(float));
1465  for ( i = 0 ; i < ndata3 ; i++ )
1466  {
1467  help[i] = 0. ;
1468  }
1469 
1470  /* shift the second data array by ndata in the help array */
1471  for ( i = 0 ; i < ndata ; i++ )
1472  {
1473  help[(300/2) + i] = data2[i] ;
1474  }
1475 
1476  /* compute the cross sinfo_correlation sum array */
1477  corsum=cpl_calloc(ndata+300,sizeof(float));
1478  for ( j = 0 ; j < ndata3 ; j++ )
1479  {
1480  if ( ndata3-j <= ndata)
1481  limit = ndata3-j;
1482  else
1483  limit = ndata;
1484  corsum[j] = 0. ;
1485  for ( k = 0 ; k < limit ; k++ )
1486  {
1487  /*if ( k + j >= ndata3 )
1488  {
1489  break ;
1490  }*/
1491  corsum[j] += data1[k] * help[k + j] ;
1492  }
1493  }
1494 
1495  /* search for the maximal corsum value and determine its position */
1496  maxval = -FLT_MAX ;
1497  position = -1 ;
1498  for ( i = 0 ; i < ndata3 ; i++ )
1499  {
1500  if ( maxval < corsum[i] )
1501  {
1502  maxval = corsum[i] ;
1503  position = i ;
1504  }
1505  }
1506 
1507  /* determine shift of data2 relative to the data1 array */
1508  shift = position - 300/2 ;
1509  cpl_free(help);
1510  cpl_free(corsum);
1511 
1512  return shift ;
1513 }
1514 
1515 /*--------------------------------------------------------------------------*/