DETMON Pipeline Reference Manual  1.3.0
irplib_wavecal.c
1 /*
2  * This file is part of the IRPLIB Pipeline
3  * Copyright (C) 2002,2003,2014 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 02111-1307 USA
18  */
19 
20 #ifdef HAVE_CONFIG_H
21 #include <config.h>
22 #endif
23 
24 /*-----------------------------------------------------------------------------
25  Includes
26  -----------------------------------------------------------------------------*/
27 
28 #include "irplib_wavecal_impl.h"
29 
30 /* Needed for irplib_errorstate_dump_debug() */
31 #include "irplib_utils.h"
32 
33 #include <cpl.h>
34 
35 #include <string.h>
36 #include <math.h>
37 
38 #ifdef HAVE_GSL
39 #include <gsl/gsl_multimin.h>
40 #endif
41 
42 /*-----------------------------------------------------------------------------
43  Private types
44  -----------------------------------------------------------------------------*/
45 
46 #ifdef HAVE_GSL
47 
48 typedef struct {
49 
50  const cpl_vector * observed;
51  cpl_polynomial * disp1d;
52  cpl_vector * spectrum;
53  irplib_base_spectrum_model * param;
54  cpl_error_code (* filler)(cpl_vector *, const cpl_polynomial *,
55  irplib_base_spectrum_model *);
56  cpl_vector * vxc;
57  double xc;
58  int maxxc;
59  double mxc;
60  cpl_polynomial * mdisp;
61  int ishift;
62 
63 } irplib_multimin;
64 
65 #endif /* HAVE_GSL */
66 
67 /*-----------------------------------------------------------------------------
68  Defines
69  -----------------------------------------------------------------------------*/
70 
71 #ifndef inline
72 #define inline /* inline */
73 #endif
74 
75 #define IRPLIB_MAX(A,B) ((A) > (B) ? (A) : (B))
76 #define IRPLIB_MIN(A,B) ((A) < (B) ? (A) : (B))
77 
78 /*-----------------------------------------------------------------------------
79  Private functions
80  -----------------------------------------------------------------------------*/
81 
82 #ifdef HAVE_GSL
83 static double irplib_gsl_correlation(const gsl_vector *, void *);
84 #endif
85 
86 static cpl_error_code
87 irplib_polynomial_find_1d_from_correlation_(cpl_polynomial *, int,
88  const cpl_vector *,
89  irplib_base_spectrum_model *,
90  cpl_error_code (*)
91  (cpl_vector *,
92  const cpl_polynomial *,
93  irplib_base_spectrum_model *),
94  double, double, int, int,
95  double *, cpl_boolean *);
96 
97 
98 /*----------------------------------------------------------------------------*/
102 /*----------------------------------------------------------------------------*/
103 
107 /*----------------------------------------------------------------------------*/
115 /*----------------------------------------------------------------------------*/
116 int irplib_bivector_count_positive(const cpl_bivector * self,
117  double x_min,
118  double x_max)
119 {
120 
121  const int nself = cpl_bivector_get_size(self);
122  const double * px = cpl_bivector_get_x_data_const(self);
123  const double * py = cpl_bivector_get_y_data_const(self);
124  int npos = 0;
125  int i = 0;
126 
127  cpl_ensure(self != NULL, CPL_ERROR_NULL_INPUT, -1);
128  cpl_ensure(x_min <= x_max, CPL_ERROR_ILLEGAL_INPUT, -2);
129 
130  /* FIXME: Use cpl_vector_find() */
131  while (i < nself && px[i] < x_min) i++;
132  while (i < nself && px[i] < x_max)
133  if (py[i++] > 0) npos++;
134 
135  return npos;
136 }
137 
138 /*----------------------------------------------------------------------------*/
148 /*----------------------------------------------------------------------------*/
149 cpl_error_code irplib_polynomial_fit_2d_dispersion(cpl_polynomial * self,
150  const cpl_image * imgwave,
151  int fitdeg, double * presid)
152 {
153 
154  const int nx = cpl_image_get_size_x(imgwave);
155  const int ny = cpl_image_get_size_y(imgwave);
156  const int nbad = cpl_image_count_rejected(imgwave);
157  const int nsamp = nx * ny - nbad;
158  cpl_matrix * xy_pos;
159  double * xdata;
160  double * ydata;
161  cpl_vector * wlen;
162  double * dwlen;
163  const cpl_size nfitdeg = (cpl_size)fitdeg;
164  int i, j;
165  int k = 0;
166 
167  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
168  cpl_ensure_code(imgwave != NULL, CPL_ERROR_NULL_INPUT);
169  cpl_ensure_code(presid != NULL, CPL_ERROR_NULL_INPUT);
170  cpl_ensure_code(fitdeg > 0, CPL_ERROR_ILLEGAL_INPUT);
171 
172  cpl_ensure_code(cpl_polynomial_get_dimension(self) == 2,
173  CPL_ERROR_ILLEGAL_INPUT);
174 
175  xy_pos = cpl_matrix_new(2, nsamp);
176  xdata = cpl_matrix_get_data(xy_pos);
177  ydata = xdata + nsamp;
178 
179  dwlen = (double*)cpl_malloc(nsamp * sizeof(double));
180  wlen = cpl_vector_wrap(nsamp, dwlen);
181 
182  for (i=1; i <= nx; i++) {
183  for (j=1; j <= ny; j++) {
184  int is_bad;
185  const double value = cpl_image_get(imgwave, i, j, &is_bad);
186  if (!is_bad) {
187  xdata[k] = i;
188  ydata[k] = j;
189  dwlen[k] = value;
190  k++;
191  }
192  }
193  }
194 
195  cpl_msg_info(cpl_func, "Fitting 2D polynomial to %d X %d image, ignoring "
196  "%d poorly calibrated pixels", nx, ny, nbad);
197 
198  if (cpl_polynomial_fit(self, xy_pos, NULL, wlen, NULL, CPL_FALSE, NULL,
199  &nfitdeg) == CPL_ERROR_NONE && presid != NULL) {
200  cpl_vector_fill_polynomial_fit_residual(wlen, wlen, NULL, self, xy_pos,
201  NULL);
202  *presid = cpl_vector_product(wlen, wlen)/nsamp;
203  }
204  cpl_matrix_delete(xy_pos);
205  cpl_vector_delete(wlen);
206 
207  cpl_ensure_code(k == nsamp, CPL_ERROR_UNSPECIFIED);
208 
209  return CPL_ERROR_NONE;
210 }
211 
212 
213 /*----------------------------------------------------------------------------*/
231 /*----------------------------------------------------------------------------*/
232 cpl_error_code
234  int maxdeg,
235  const cpl_vector * obs,
236  irplib_base_spectrum_model * model,
237  cpl_error_code (* filler)
238  (cpl_vector *,
239  const cpl_polynomial *,
240  irplib_base_spectrum_model *),
241  double pixtol,
242  double pixstep,
243  int hsize,
244  int maxite,
245  double * pxc)
246 {
247  cpl_boolean restart = CPL_FALSE;
248  const cpl_error_code error = irplib_polynomial_find_1d_from_correlation_
249  (self, maxdeg, obs, model, filler, pixtol, pixstep, hsize, maxite, pxc,
250  &restart);
251 
252  return error ? cpl_error_set_where(cpl_func) :
253  (restart ? cpl_error_set(cpl_func, CPL_ERROR_CONTINUE)
254  : CPL_ERROR_NONE);
255 }
256 
257 /*----------------------------------------------------------------------------*/
278 /*----------------------------------------------------------------------------*/
279 static cpl_error_code
280 irplib_polynomial_find_1d_from_correlation_(cpl_polynomial * self,
281  int maxdeg,
282  const cpl_vector * obs,
283  irplib_base_spectrum_model * model,
284  cpl_error_code (* filler)
285  (cpl_vector *,
286  const cpl_polynomial *,
287  irplib_base_spectrum_model *),
288  double pixtol,
289  double pixstep,
290  int hsize,
291  int maxite,
292  double * pxc,
293  cpl_boolean * prestart)
294 {
295 
296 #ifdef HAVE_GSL
297  const gsl_multimin_fminimizer_type * T = gsl_multimin_fminimizer_nmsimplex;
298  gsl_multimin_fminimizer * minimizer;
299  gsl_multimin_function my_func;
300  irplib_multimin data;
301  gsl_vector * dispgsl;
302  gsl_vector * stepsize;
303  gsl_vector * dispprev;
304  int status = GSL_CONTINUE;
305  const int nobs = cpl_vector_get_size(obs);
306  const cpl_size nfit = maxdeg + 1;
307  cpl_errorstate prestate = cpl_errorstate_get();
308  /* Convert pixel step to wavelength step on detector center */
309  const double wlstep =
310  cpl_polynomial_eval_1d_diff(self, 0.5 * (nobs + pixstep),
311  0.5 * (nobs - pixstep), NULL);
312  double wlstepi = wlstep;
313  int iter;
314  cpl_size i;
315 
316 #endif
317 
318  cpl_ensure_code(prestart != NULL, CPL_ERROR_NULL_INPUT);
319  *prestart = CPL_FALSE;
320  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
321  cpl_ensure_code(obs != NULL, CPL_ERROR_NULL_INPUT);
322  cpl_ensure_code(model != NULL, CPL_ERROR_NULL_INPUT);
323  cpl_ensure_code(filler != NULL, CPL_ERROR_NULL_INPUT);
324  cpl_ensure_code(pxc != NULL, CPL_ERROR_NULL_INPUT);
325 
326  cpl_ensure_code(cpl_polynomial_get_dimension(self) == 1,
327  CPL_ERROR_ILLEGAL_INPUT);
328 
329  cpl_ensure_code(cpl_polynomial_get_degree(self) > 0,
330  CPL_ERROR_ILLEGAL_INPUT);
331 
332  cpl_ensure_code(maxdeg >= 0, CPL_ERROR_ILLEGAL_INPUT);
333  cpl_ensure_code(pixtol > 0.0, CPL_ERROR_ILLEGAL_INPUT);
334  cpl_ensure_code(pixstep > 0.0, CPL_ERROR_ILLEGAL_INPUT);
335  cpl_ensure_code(hsize >= 0, CPL_ERROR_ILLEGAL_INPUT);
336  cpl_ensure_code(maxite >= 0, CPL_ERROR_ILLEGAL_INPUT);
337 
338 #ifndef HAVE_GSL
339  return cpl_error_set_message(cpl_func, CPL_ERROR_UNSUPPORTED_MODE,
340  "GSL is not available");
341 #else
342 
343  minimizer = gsl_multimin_fminimizer_alloc(T, (size_t)nfit);
344 
345  cpl_ensure_code(minimizer != NULL, CPL_ERROR_ILLEGAL_OUTPUT);
346 
347  dispgsl = gsl_vector_alloc((size_t)nfit);
348  stepsize = gsl_vector_alloc((size_t)nfit);
349  dispprev = gsl_vector_alloc((size_t)nfit);
350 
351  for (i=0; i < nfit; i++) {
352  const double value = cpl_polynomial_get_coeff(self, &i);
353  gsl_vector_set(dispgsl, (size_t)i, value);
354  gsl_vector_set(stepsize, (size_t)i, wlstepi);
355  wlstepi /= (double)nobs;
356  }
357 
358  my_func.n = nfit;
359  my_func.f = &irplib_gsl_correlation;
360  my_func.params = (void *)(&data);
361 
362  data.observed = obs;
363  data.disp1d = self;
364  data.spectrum = cpl_vector_new(nobs + 2 * hsize);
365  data.vxc = cpl_vector_new(1 + 2 * hsize);
366  data.xc = 0;
367  data.param = model;
368  data.filler = filler;
369  data.maxxc = 0; /* Output */
370  data.ishift = 0; /* Output */
371  data.mxc = -1.0; /* Output */
372  data.mdisp = NULL; /* Output */
373 
374  gsl_multimin_fminimizer_set (minimizer, &my_func, dispgsl, stepsize);
375 
376  for (iter = 0; status == GSL_CONTINUE && iter < maxite; iter++) {
377 
378  double size;
379  const double fprev = minimizer->fval;
380 
381  gsl_vector_memcpy(dispprev, minimizer->x);
382  status = gsl_multimin_fminimizer_iterate(minimizer);
383 
384  if (status || !cpl_errorstate_is_equal(prestate)) break;
385 
386  size = gsl_multimin_fminimizer_size (minimizer);
387  status = gsl_multimin_test_size (size, pixtol);
388 
389  if (status == GSL_SUCCESS) {
390  cpl_msg_debug(cpl_func, "converged to minimum at");
391 
392  if (nfit == 0) {
393  cpl_msg_debug(cpl_func, "%5d %g df() = %g size = %g",
394  iter,
395  gsl_vector_get (minimizer->x, 0)
396  - gsl_vector_get (dispprev, 0),
397  minimizer->fval - fprev, size);
398  } else if (nfit == 1) {
399  cpl_msg_debug(cpl_func, "%5d %g %g df() = %g size = %g",
400  iter,
401  gsl_vector_get (minimizer->x, 0)
402  - gsl_vector_get (dispprev, 0),
403  gsl_vector_get (minimizer->x, 1)
404  - gsl_vector_get (dispprev, 1),
405  minimizer->fval - fprev, size);
406  } else {
407  cpl_msg_debug(cpl_func, "%5d %g %g %g df() = %g size = %g",
408  iter,
409  gsl_vector_get (minimizer->x, 0)
410  - gsl_vector_get (dispprev, 0),
411  gsl_vector_get (minimizer->x, 1)
412  - gsl_vector_get (dispprev, 1),
413  gsl_vector_get (minimizer->x, 2)
414  - gsl_vector_get (dispprev, 2),
415  minimizer->fval - fprev, size);
416  }
417  }
418  }
419 
420  if (status == GSL_SUCCESS && cpl_errorstate_is_equal(prestate)) {
421  if (data.mxc > -minimizer->fval) {
422  *pxc = data.mxc;
423  cpl_msg_warning(cpl_func, "Local maximum: %g(%d) > %g",
424  data.mxc, data.ishift, -minimizer->fval);
425  cpl_polynomial_shift_1d(data.mdisp, 0, (double)data.ishift);
426  cpl_polynomial_copy(self, data.mdisp);
427  *prestart = CPL_TRUE;
428  } else {
429  *pxc = -minimizer->fval;
430  for (i=0; i < nfit; i++) {
431  const double value = gsl_vector_get(minimizer->x, i);
432  cpl_polynomial_set_coeff(self, &i, value);
433  }
434  }
435  }
436 
437  cpl_vector_delete(data.spectrum);
438  cpl_vector_delete(data.vxc);
439  cpl_polynomial_delete(data.mdisp);
440  gsl_multimin_fminimizer_free(minimizer);
441  gsl_vector_free(dispgsl);
442  gsl_vector_free(dispprev);
443  gsl_vector_free(stepsize);
444 
445  cpl_ensure_code(status != GSL_CONTINUE, CPL_ERROR_CONTINUE);
446  cpl_ensure_code(status == GSL_SUCCESS, CPL_ERROR_DATA_NOT_FOUND);
447  cpl_ensure_code(cpl_errorstate_is_equal(prestate), cpl_error_get_code());
448 
449  return CPL_ERROR_NONE;
450 #endif
451 }
452 
453 
454 /*----------------------------------------------------------------------------*/
482 /*----------------------------------------------------------------------------*/
483 cpl_error_code
485  const cpl_polynomial * disp,
486  irplib_base_spectrum_model * lsslamp)
487 {
488 
489  irplib_line_spectrum_model * arclamp
490  = (irplib_line_spectrum_model *)lsslamp;
491  cpl_error_code error;
492 
493  cpl_ensure_code(arclamp != NULL, CPL_ERROR_NULL_INPUT);
494 
495  arclamp->cost++;
496 
498  arclamp->linepix,
499  arclamp->erftmp,
500  disp,
501  arclamp->lines,
502  arclamp->wslit,
503  arclamp->wfwhm,
504  arclamp->xtrunc,
505  0, CPL_FALSE, CPL_FALSE,
506  &(arclamp->ulines));
507  cpl_ensure_code(!error, error);
508 
509  arclamp->xcost++;
510 
511  return CPL_ERROR_NONE;
512 }
513 
514 /*----------------------------------------------------------------------------*/
527 /*----------------------------------------------------------------------------*/
528 cpl_error_code
530  const cpl_polynomial * disp,
531  irplib_base_spectrum_model * lsslamp)
532 {
533 
534  irplib_line_spectrum_model * arclamp
535  = (irplib_line_spectrum_model *)lsslamp;
536  cpl_error_code error;
537 
538  cpl_ensure_code(arclamp != NULL, CPL_ERROR_NULL_INPUT);
539 
540  arclamp->cost++;
541 
543  arclamp->linepix,
544  arclamp->erftmp,
545  disp,
546  arclamp->lines,
547  arclamp->wslit,
548  arclamp->wfwhm,
549  arclamp->xtrunc,
550  0, CPL_FALSE, CPL_TRUE,
551  &(arclamp->ulines));
552  cpl_ensure_code(!error, error);
553 
554  arclamp->xcost++;
555 
556  return CPL_ERROR_NONE;
557 }
558 
559 
560 /*----------------------------------------------------------------------------*/
573 /*----------------------------------------------------------------------------*/
574 cpl_error_code
576  const cpl_polynomial * disp,
577  irplib_base_spectrum_model * lsslamp)
578 {
579 
580  irplib_line_spectrum_model * arclamp
581  = (irplib_line_spectrum_model *)lsslamp;
582  cpl_error_code error;
583 
584  cpl_ensure_code(arclamp != NULL, CPL_ERROR_NULL_INPUT);
585 
586  arclamp->cost++;
587 
589  arclamp->linepix,
590  arclamp->erftmp,
591  disp,
592  arclamp->lines,
593  arclamp->wslit,
594  arclamp->wfwhm,
595  arclamp->xtrunc,
596  0, CPL_TRUE, CPL_FALSE,
597  &(arclamp->ulines));
598  cpl_ensure_code(!error, error);
599 
600  arclamp->xcost++;
601 
602  return CPL_ERROR_NONE;
603 }
604 
605 /*----------------------------------------------------------------------------*/
618 /*----------------------------------------------------------------------------*/
619 cpl_error_code
621  const cpl_polynomial * disp,
622  irplib_base_spectrum_model * lsslamp)
623 {
624 
625  irplib_line_spectrum_model * arclamp
626  = (irplib_line_spectrum_model *)lsslamp;
627  cpl_error_code error;
628 
629  cpl_ensure_code(arclamp != NULL, CPL_ERROR_NULL_INPUT);
630 
631  arclamp->cost++;
632 
634  arclamp->linepix,
635  arclamp->erftmp,
636  disp,
637  arclamp->lines,
638  arclamp->wslit,
639  arclamp->wfwhm,
640  arclamp->xtrunc,
641  0, CPL_TRUE, CPL_TRUE,
642  &(arclamp->ulines));
643  cpl_ensure_code(!error, error);
644 
645  arclamp->xcost++;
646 
647  return CPL_ERROR_NONE;
648 }
649 
650 /*----------------------------------------------------------------------------*/
661 /*----------------------------------------------------------------------------*/
662 cpl_error_code irplib_plot_spectrum_and_model(const cpl_vector * self,
663  const cpl_polynomial * disp1d,
664  irplib_base_spectrum_model * model,
665  cpl_error_code (* filler)
666  (cpl_vector *,
667  const cpl_polynomial *,
668  irplib_base_spectrum_model *))
669 {
670 
671  cpl_errorstate prestate = cpl_errorstate_get();
672  cpl_vector * wl;
673  cpl_vector * spectrum;
674  cpl_vector * vxc;
675  const int len = cpl_vector_get_size(self);
676  double maxval, xc;
677  int ixc;
678  int error = 0;
679 
680  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
681  cpl_ensure_code(disp1d != NULL, CPL_ERROR_NULL_INPUT);
682  cpl_ensure_code(model != NULL, CPL_ERROR_NULL_INPUT);
683  cpl_ensure_code(filler != NULL, CPL_ERROR_NULL_INPUT);
684 
685  cpl_ensure_code(cpl_polynomial_get_dimension(disp1d) == 1,
686  CPL_ERROR_ILLEGAL_INPUT);
687 
688  cpl_ensure_code(cpl_polynomial_get_degree(disp1d) > 0,
689  CPL_ERROR_ILLEGAL_INPUT);
690 
691  wl = cpl_vector_new(len);
692  spectrum = cpl_vector_new(len);
693  vxc = cpl_vector_new(1);
694 
695  error |= (int)cpl_vector_fill_polynomial(wl, disp1d, 1.0, 1.0);
696  error |= filler(spectrum, disp1d, model);
697 
698  ixc = cpl_vector_correlate(vxc, self, spectrum);
699  xc = cpl_vector_get(vxc, ixc);
700 
701  maxval = cpl_vector_get_max(spectrum);
702  if (maxval != 0.0)
703  error |= cpl_vector_multiply_scalar(spectrum,
704  cpl_vector_get_max(self)/maxval);
705  if (!error) {
706  const cpl_vector * spair[] = {wl, self, spectrum};
707  char * pre = cpl_sprintf("set grid;set xlabel 'Wavelength (%g -> %g)'; "
708  "set ylabel 'Intensity';", cpl_vector_get(wl, 0),
709  cpl_vector_get(wl, len-1));
710  char * title = cpl_sprintf("t 'Observed and modelled spectra (%d pixel "
711  "XC=%g) ' w linespoints", len, xc);
712 
713  (void)cpl_plot_vectors(pre, title, "", spair, 3);
714  cpl_free(pre);
715  cpl_free(title);
716  }
717 
718  cpl_vector_delete(wl);
719  cpl_vector_delete(spectrum);
720  cpl_vector_delete(vxc);
721 
722  cpl_errorstate_set(prestate);
723 
724  return CPL_ERROR_NONE;
725 }
726 
727 /*----------------------------------------------------------------------------*/
747 /*----------------------------------------------------------------------------*/
748 cpl_error_code
750  const cpl_polynomial * disp,
751  const cpl_vector * obs,
752  irplib_base_spectrum_model * model,
753  cpl_error_code (*filler)
754  (cpl_vector *,
755  const cpl_polynomial *,
756  irplib_base_spectrum_model *),
757  int hsize,
758  cpl_boolean doplot,
759  double *pxc)
760 {
761 
762  const int nobs = cpl_vector_get_size(obs);
763  const int nmodel = 2 * hsize + nobs;
764  cpl_polynomial * shdisp;
765  cpl_vector * xself = cpl_bivector_get_x(self);
766  cpl_vector * yself = cpl_bivector_get_y(self);
767  cpl_vector * mspec1d;
768  cpl_vector * xcorr;
769  cpl_error_code error = CPL_ERROR_NONE;
770  double xcprev, xcnext;
771  int ixc, imax = 0;
772  int i;
773 
774  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
775  cpl_ensure_code(disp != NULL, CPL_ERROR_NULL_INPUT);
776  cpl_ensure_code(obs != NULL, CPL_ERROR_NULL_INPUT);
777  cpl_ensure_code(model != NULL, CPL_ERROR_NULL_INPUT);
778  cpl_ensure_code(filler != NULL, CPL_ERROR_NULL_INPUT);
779  cpl_ensure_code(hsize > 0, CPL_ERROR_ILLEGAL_INPUT);
780 
781  shdisp = cpl_polynomial_duplicate(disp);
782 
783  /* Shift reference by -hsize so filler can be used without offset */
784  if (cpl_polynomial_shift_1d(shdisp, 0, -hsize)) {
785  cpl_polynomial_delete(shdisp);
786  return cpl_error_set_where(cpl_func);
787  }
788 
789  mspec1d = cpl_vector_new(nmodel);
790 
791  if (filler(mspec1d, shdisp, model)) {
792  cpl_vector_delete(mspec1d);
793  return cpl_error_set_where(cpl_func);
794  }
795 
796  /* Should not be able to fail now */
797  xcorr = cpl_vector_new(1 + 2 * hsize);
798  ixc = cpl_vector_correlate(xcorr, mspec1d, obs);
799 
800 #ifdef IRPLIB_SPC_DUMP
801  /* Need irplib_wavecal.c rev. 1.12 through 1.15 */
802  irplib_polynomial_dump_corr_step(shdisp, xcorr, "Shift");
803 #endif
804 
805  cpl_vector_delete(mspec1d);
806  cpl_polynomial_delete(shdisp);
807 
808  /* Find local maxima. */
809  /* FIXME(?): Also include stationary points */
810  i = 0;
811  xcprev = cpl_vector_get(xcorr, i);
812  xcnext = cpl_vector_get(xcorr, i+1);
813 
814  if (xcprev >= xcnext) {
815  /* 1st data point is an extreme */
816  /* FIXME: This could also be an error, recoverable by caller by
817  increasing hsize */
818  imax++;
819 
820  cpl_vector_set(xself, 0, i - hsize);
821  cpl_vector_set(yself, 0, xcprev);
822 
823  }
824 
825  for (i = 1; i < 2 * hsize; i++) {
826  const double xc = xcnext;
827  xcnext = cpl_vector_get(xcorr, i+1);
828  if (xc >= xcprev && xc >= xcnext) {
829  /* Found (local) maximum at shift i - hsize */
830  int j;
831 
832  imax++;
833 
834  if (cpl_bivector_get_size(self) < imax) {
835  cpl_vector_set_size(xself, imax);
836  cpl_vector_set_size(yself, imax);
837  }
838 
839  for (j = imax-1; j > 0; j--) {
840  if (xc <= cpl_vector_get(yself, j-1)) break;
841  cpl_vector_set(xself, j, cpl_vector_get(xself, j-1));
842  cpl_vector_set(yself, j, cpl_vector_get(yself, j-1));
843  }
844  cpl_vector_set(xself, j, i - hsize);
845  cpl_vector_set(yself, j, xc);
846  }
847  xcprev = xc;
848  }
849 
850  /* assert( i == 2 * hsize ); */
851 
852  if (xcnext >= xcprev) {
853  /* Last data point is an extreme */
854  /* FIXME: This could also be an error, recoverable by caller by
855  increasing hsize */
856  int j;
857 
858  imax++;
859 
860  if (cpl_bivector_get_size(self) < imax) {
861  cpl_vector_set_size(xself, imax);
862  cpl_vector_set_size(yself, imax);
863  }
864 
865  for (j = imax-1; j > 0; j--) {
866  if (xcnext <= cpl_vector_get(yself, j-1)) break;
867  cpl_vector_set(xself, j, cpl_vector_get(xself, j-1));
868  cpl_vector_set(yself, j, cpl_vector_get(yself, j-1));
869  }
870  cpl_vector_set(xself, j, i - hsize);
871  cpl_vector_set(yself, j, xcnext);
872 
873  }
874 
875  if (doplot) {
876  /* Vector of -hsize, 1-hsize, 2-hsize, ..., 0, ..., hsize */
877  cpl_vector * xvals = cpl_vector_new(1 + 2 * hsize);
878  cpl_bivector * bcorr = cpl_bivector_wrap_vectors(xvals, xcorr);
879  double x = (double)-hsize;
880  char * title = cpl_sprintf("t 'Cross-correlation of shifted %d-pixel "
881  "spectrum (XCmax=%g at %d)' w linespoints",
882  nobs, cpl_vector_get(xcorr, ixc),
883  ixc - hsize);
884 
885  for (i = 0; i < 1 + 2 * hsize; i++, x += 1.0) {
886  cpl_vector_set(xvals, i, x);
887  }
888 
889  cpl_plot_bivector("set grid;set xlabel 'Offset [pixel]';", title,
890  "", bcorr);
891  cpl_bivector_unwrap_vectors(bcorr);
892  cpl_vector_delete(xvals);
893  cpl_free(title);
894  }
895 
896  if (pxc != NULL) *pxc = cpl_vector_get(xcorr, hsize);
897 
898  cpl_vector_delete(xcorr);
899 
900  if (imax < 1) {
901  error = CPL_ERROR_DATA_NOT_FOUND;
902  } else if (cpl_bivector_get_size(self) > imax) {
903  cpl_vector_set_size(xself, imax);
904  cpl_vector_set_size(yself, imax);
905  }
906 
907  /* Propagate error, if any */
908  return cpl_error_set(cpl_func, error);
909 }
910 
911 /*----------------------------------------------------------------------------*/
924 /*----------------------------------------------------------------------------*/
925 cpl_error_code
927  const cpl_vector * obs,
928  irplib_base_spectrum_model * model,
929  cpl_error_code (*filler)
930  (cpl_vector *,
931  const cpl_polynomial *,
932  irplib_base_spectrum_model *),
933  int hsize,
934  cpl_boolean doplot,
935  double * pxc)
936 {
937 
938  const int nobs = cpl_vector_get_size(obs);
939  const int nmodel = 2 * hsize + nobs;
940  cpl_vector * mspec1d;
941  cpl_vector * xcorr;
942  cpl_error_code error;
943  int ixc, xxc;
944  double xc;
945 
946  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
947  cpl_ensure_code(obs != NULL, CPL_ERROR_NULL_INPUT);
948  cpl_ensure_code(model != NULL, CPL_ERROR_NULL_INPUT);
949  cpl_ensure_code(filler != NULL, CPL_ERROR_NULL_INPUT);
950  cpl_ensure_code(hsize > 0, CPL_ERROR_ILLEGAL_INPUT);
951 
952  /* Shift reference by -hsize so filler can be used without offset */
953  cpl_ensure_code(!cpl_polynomial_shift_1d(self, 0, -hsize),
954  cpl_error_get_code());
955 
956  mspec1d = cpl_vector_new(nmodel);
957 
958  if (filler(mspec1d, self, model)) {
959  cpl_vector_delete(mspec1d);
960  cpl_ensure_code(0, cpl_error_get_code());
961  }
962 
963  /* Should not be able to fail now */
964  xcorr = cpl_vector_new(1 + 2 * hsize);
965  ixc = cpl_vector_correlate(xcorr, mspec1d, obs);
966 
967 #ifdef IRPLIB_SPC_DUMP
968  /* Need irplib_wavecal.c rev. 1.12 through 1.15 */
969  irplib_polynomial_dump_corr_step(self, xcorr, "Shift");
970 #endif
971 
972  cpl_vector_delete(mspec1d);
973 
974  error = cpl_polynomial_shift_1d(self, 0, (double)ixc);
975 
976  xc = cpl_vector_get(xcorr, ixc);
977 
978  xxc = ixc - hsize; /* The effect of the two shifts */
979 
980  cpl_msg_info(cpl_func, "Shifting %d pixels (%g < %g)", xxc,
981  cpl_vector_get(xcorr, hsize), xc);
982 
983  if (doplot) {
984  cpl_vector * xvals = cpl_vector_new(1 + 2 * hsize);
985  cpl_bivector * bcorr = cpl_bivector_wrap_vectors(xvals, xcorr);
986  int i;
987  double x = (double)-hsize;
988  char * title = cpl_sprintf("t 'Cross-correlation of shifted %d-pixel "
989  "spectrum (XCmax=%g at %d)' w linespoints",
990  nobs, cpl_vector_get(xcorr, ixc), xxc);
991 
992  for (i = 0; i < 1 + 2 * hsize; i++, x += 1.0) {
993  cpl_vector_set(xvals, i, x);
994  }
995 
996  cpl_plot_bivector("set grid;set xlabel 'Offset [pixel]';", title,
997  "", bcorr);
998  cpl_bivector_unwrap_vectors(bcorr);
999  cpl_vector_delete(xvals);
1000  cpl_free(title);
1001  }
1002 
1003  cpl_vector_delete(xcorr);
1004 
1005  cpl_ensure_code(!error, error);
1006 
1007  if (pxc != NULL) *pxc = xc;
1008 
1009  return CPL_ERROR_NONE;
1010 
1011 }
1012 
1013 
1014 /*----------------------------------------------------------------------------*/
1034 /*----------------------------------------------------------------------------*/
1035 cpl_error_code
1037  cpl_vector * linepix,
1038  cpl_vector * erftmp,
1039  const cpl_polynomial * disp,
1040  const cpl_bivector * lines,
1041  double wslit,
1042  double wfwhm,
1043  double xtrunc,
1044  int hsize,
1045  cpl_boolean dofast,
1046  cpl_boolean dolog,
1047  cpl_size * pulines)
1048 {
1049 
1050  cpl_errorstate prestate;
1051  const double sigma = wfwhm * CPL_MATH_SIG_FWHM;
1052  const cpl_vector * xlines = cpl_bivector_get_x_const(lines);
1053  const double * dxlines = cpl_vector_get_data_const(xlines);
1054  const double * dylines = cpl_bivector_get_y_data_const(lines);
1055  double * plinepix
1056  = linepix ? cpl_vector_get_data(linepix) : NULL;
1057  const int nlines = cpl_vector_get_size(xlines);
1058  const int nself = cpl_vector_get_size(self);
1059  double * dself = cpl_vector_get_data(self);
1060  cpl_polynomial * dispi;
1061  double * profile = NULL;
1062  const cpl_size i0 = 0;
1063  const double p0 = cpl_polynomial_get_coeff(disp, &i0);
1064  double wl;
1065  double xpos = (double)(1-hsize)-xtrunc;
1066  const double xmax = (double)(nself-hsize)+xtrunc;
1067  double xderiv, xextreme;
1068  cpl_error_code error = CPL_ERROR_NONE;
1069  int iline;
1070  cpl_size ulines = 0;
1071 
1072  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
1073  cpl_ensure_code(disp != NULL, CPL_ERROR_NULL_INPUT);
1074  cpl_ensure_code(lines != NULL, CPL_ERROR_NULL_INPUT);
1075 
1076  cpl_ensure_code(wslit > 0.0, CPL_ERROR_ILLEGAL_INPUT);
1077  cpl_ensure_code(wfwhm > 0.0, CPL_ERROR_ILLEGAL_INPUT);
1078  cpl_ensure_code(hsize >= 0, CPL_ERROR_ILLEGAL_INPUT);
1079  cpl_ensure_code(xtrunc > 0.0, CPL_ERROR_ILLEGAL_INPUT);
1080  cpl_ensure_code(nself > 2 * hsize, CPL_ERROR_ILLEGAL_INPUT);
1081 
1082  cpl_ensure_code(cpl_polynomial_get_dimension(disp) == 1,
1083  CPL_ERROR_ILLEGAL_INPUT);
1084  cpl_ensure_code(cpl_polynomial_get_degree(disp) > 0,
1085  CPL_ERROR_ILLEGAL_INPUT);
1086 
1087  /* The smallest wavelength contributing to the spectrum. */
1088  wl = cpl_polynomial_eval_1d(disp, xpos, &xderiv);
1089 
1090  if (wl <= 0.0) return
1091  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT, __FILE__,
1092  __LINE__, "Non-positive wavelength at x=%g: "
1093  "P(x)=%g, P'(x)=%g", xpos, wl, xderiv);
1094 
1095  if (xderiv <= 0.0) return
1096  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT, __FILE__,
1097  __LINE__, "Non-increasing dispersion at "
1098  "x=%g: P'(x)=%g, P(x)=%g", xpos, xderiv, wl);
1099 
1100  /* Find the 1st line */
1101  iline = cpl_vector_find(xlines, wl);
1102 
1103  /* The first line must be at least at wl */
1104  if (dxlines[iline] < wl) iline++;
1105 
1106  if (iline >= nlines) return
1107  cpl_error_set_message_macro(cpl_func, CPL_ERROR_DATA_NOT_FOUND, __FILE__,
1108  __LINE__, "The %d-line catalogue has only "
1109  "lines below P(%g)=%g > %g", nlines, xpos,
1110  wl, dxlines[nlines-1]);
1111 
1112  memset(dself, 0, nself * sizeof(double));
1113 
1114  dispi = cpl_polynomial_duplicate(disp);
1115 
1116  /* Verify monotony of dispersion */
1117  cpl_polynomial_derivative(dispi, 0);
1118 
1119  prestate = cpl_errorstate_get();
1120 
1121  if (cpl_polynomial_solve_1d(dispi, 0.5*(nlines+1), &xextreme, 1)) {
1122  cpl_errorstate_set(prestate);
1123  } else if (xpos < xextreme && xextreme < xmax) {
1124  cpl_polynomial_delete(dispi);
1125  return cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
1126  __FILE__, __LINE__, "Non-monotone "
1127  "dispersion at x=%g: P'(x)=0, "
1128  "P(x)=%g", xextreme,
1129  cpl_polynomial_eval_1d(disp, xextreme,
1130  NULL));
1131  }
1132 
1133  if (dofast) {
1134  const int npix = 1+(int)xtrunc;
1135 
1136  if (erftmp != NULL && cpl_vector_get_size(erftmp) == npix &&
1137  cpl_vector_get(erftmp, 0) > 0.0) {
1138  profile = cpl_vector_get_data(erftmp);
1139  } else {
1140 
1141  const double yval = 0.5 / wslit;
1142  const double x0p = 0.5 * wslit + 0.5;
1143  const double x0n = -0.5 * wslit + 0.5;
1144  double x1diff
1145  = irplib_erf_antideriv(x0p, sigma)
1146  - irplib_erf_antideriv(x0n, sigma);
1147  int ipix;
1148 
1149  if (erftmp == NULL) {
1150  profile = (double*)cpl_malloc(sizeof(double)*(size_t)npix);
1151  } else {
1152  cpl_vector_set_size(erftmp, npix);
1153  profile = cpl_vector_get_data(erftmp);
1154  }
1155 
1156  profile[0] = 2.0 * yval * x1diff;
1157 
1158  for (ipix = 1; ipix < npix; ipix++) {
1159  const double x1 = (double)ipix;
1160  const double x1p = x1 + 0.5 * wslit + 0.5;
1161  const double x1n = x1 - 0.5 * wslit + 0.5;
1162  const double x0diff = x1diff;
1163 
1164  x1diff = irplib_erf_antideriv(x1p, sigma)
1165  - irplib_erf_antideriv(x1n, sigma);
1166 
1167  profile[ipix] = yval * (x1diff - x0diff);
1168 
1169  }
1170  }
1171  }
1172 
1173  cpl_polynomial_copy(dispi, disp);
1174 
1175  /* FIXME: A custom version of cpl_polynomial_solve_1d() which returns
1176  P'(xpos) can be used for the 1st NR-iteration. */
1177  /* Further, the sign of P'(xpos) could be checked for all lines. */
1178  /* Perform 1st NR-iteration in solving for P(xpos) = dxlines[iline] */
1179  xpos -= (wl - dxlines[iline]) / xderiv;
1180 
1181  /* Iterate through the lines */
1182  for (; !error && iline < nlines; iline++) {
1183 
1184  /* Lines may have a non-physical intensity (e.g. zero) to indicate some
1185  property of the line, e.g. unknown intensity due to blending */
1186  if (dylines[iline] <= 0.0) continue;
1187 
1188  /* Use 1st guess, if available (Use 0.0 to flag unavailable) */
1189  if (plinepix != NULL && plinepix[iline] > 0.0) xpos = plinepix[iline];
1190 
1191  if (xpos > xmax) xpos = xmax; /* FIXME: Better to limit xpos ? */
1192 
1193  /* Find the (sub-) pixel position of the line */
1194  error = cpl_polynomial_set_coeff(dispi, &i0, p0 - dxlines[iline]) ||
1195  cpl_polynomial_solve_1d(dispi, xpos, &xpos, 1);
1196 
1197  if (xpos > xmax) {
1198  if (error) {
1199  error = 0;
1200  cpl_msg_debug(cpl_func, "Stopping spectrum fill at line %d/%d "
1201  "at xpos=%g > xmax=%g",
1202  iline, nlines, xpos, xmax);
1203  cpl_errorstate_dump(prestate, CPL_FALSE,
1205  cpl_errorstate_set(prestate);
1206  }
1207  break;
1208  } else if (error) {
1209  if (linepix != NULL && ulines) (void)cpl_vector_fill(linepix, 0.0);
1210  (void)cpl_error_set_message_macro(cpl_func, cpl_error_get_code(),
1211  __FILE__, __LINE__,
1212  "Could not find pixel-position "
1213  "of line %d/%d at wavelength=%g."
1214  " xpos=%g, xmax=%g",
1215  iline, nlines, dxlines[iline],
1216  xpos, xmax);
1217  break;
1218  } else if (dofast) {
1219  const double frac = fabs(xpos - floor(xpos));
1220 #ifdef IRPLIB_WAVECAL_FAST_FAST
1221  const double frac0 = 1.0 - frac; /* Weight opposite of distance */
1222 #else
1223  /* Center intensity correctly */
1224  const double ep1pw = irplib_erf_antideriv(frac + 0.5 * wslit, sigma);
1225  const double en1pw = irplib_erf_antideriv(frac + 0.5 * wslit - 1.0,
1226  sigma);
1227  const double ep1nw = irplib_erf_antideriv(frac - 0.5 * wslit, sigma);
1228  const double en1nw = irplib_erf_antideriv(frac - 0.5 * wslit - 1.0,
1229  sigma);
1230  const double frac0
1231  = (en1nw - en1pw) / (ep1pw - en1pw - ep1nw + en1nw);
1232 
1233 #endif
1234  const double frac1 = 1.0 - frac0;
1235  const double yval0 = frac0 * dylines[iline];
1236  const double yval1 = frac1 * dylines[iline];
1237  const int npix = 1+(int)xtrunc;
1238  int ipix;
1239  int i0n = hsize - 1 + floor(xpos);
1240  int i0p = i0n;
1241  int i1n = i0n + 1;
1242  int i1p = i1n;
1243  cpl_boolean didline = CPL_FALSE;
1244 
1245 
1246  /* Update 1st guess for next time, if available */
1247  if (plinepix != NULL) plinepix[iline] = xpos;
1248 
1249  if (frac0 < 0.0) {
1250  (void)cpl_error_set_message_macro(cpl_func,
1251  CPL_ERROR_UNSPECIFIED,
1252  __FILE__, __LINE__,
1253  "Illegal split at x=%g: %g + "
1254  "%g = 1", xpos, frac0, frac1);
1255 #ifdef IRPLIB_WAVEVAL_DEBUG
1256  } else {
1257  cpl_msg_warning(cpl_func,"profile split at x=%g: %g + %g = 1",
1258  xpos, frac0, frac1);
1259 #endif
1260  }
1261 
1262  for (ipix = 0; ipix < npix; ipix++, i0n--, i0p++, i1n--, i1p++) {
1263 
1264  if (i0n >= 0 && i0n < nself) {
1265  dself[i0n] += yval0 * profile[ipix];
1266  didline = CPL_TRUE;
1267  }
1268  if (i1n >= 0 && i1n < nself && ipix + 1 < npix) {
1269  dself[i1n] += yval1 * profile[ipix+1];
1270  didline = CPL_TRUE;
1271  }
1272 
1273  if (ipix == 0) continue;
1274 
1275  if (i0p >= 0 && i0p < nself) {
1276  dself[i0p] += yval0 * profile[ipix];
1277  didline = CPL_TRUE;
1278  }
1279  if (i1p >= 0 && i1p < nself && ipix + 1 < npix) {
1280  dself[i1p] += yval1 * profile[ipix+1];
1281  didline = CPL_TRUE;
1282  }
1283  }
1284 
1285  if (didline) ulines++;
1286 
1287  } else {
1288  const double yval = 0.5 * dylines[iline] / wslit;
1289  const int ifirst = IRPLIB_MAX((int)(xpos-xtrunc+0.5), 1-hsize);
1290  const int ilast = IRPLIB_MIN((int)(xpos+xtrunc), nself-hsize);
1291  int ipix;
1292  const double x0 = (double)ifirst - xpos;
1293  const double x0p = x0 + 0.5*wslit - 0.5;
1294  const double x0n = x0 - 0.5*wslit - 0.5;
1295  double x1diff
1296  = irplib_erf_antideriv(x0p, sigma)
1297  - irplib_erf_antideriv(x0n, sigma);
1298 
1299  /* Update 1st guess for next time, if available */
1300  if (plinepix != NULL) plinepix[iline] = xpos;
1301 
1302  if (ilast >= ifirst) ulines++;
1303 
1304  for (ipix = ifirst; ipix <= ilast; ipix++) {
1305  const double x1 = (double)ipix - xpos;
1306  const double x1p = x1 + 0.5*wslit + 0.5;
1307  const double x1n = x1 - 0.5*wslit + 0.5;
1308  const double x0diff = x1diff;
1309 
1310  x1diff = irplib_erf_antideriv(x1p, sigma)
1311  - irplib_erf_antideriv(x1n, sigma);
1312 
1313  dself[ipix+hsize-1] += yval * (x1diff - x0diff);
1314 
1315  }
1316  }
1317  }
1318 
1319  cpl_polynomial_delete(dispi);
1320  if (erftmp == NULL) cpl_free(profile);
1321 
1322  cpl_ensure_code(!error, cpl_error_get_code());
1323 
1324  if (dolog) {
1325  int i;
1326  for (i = 0; i < nself; i++) {
1327  dself[i] = dself[i] > 0.0 ? log(1.0 + dself[i]) : 0.0;
1328  }
1329  }
1330 
1331  if (!ulines) return
1332  cpl_error_set_message_macro(cpl_func, CPL_ERROR_DATA_NOT_FOUND,
1333  __FILE__, __LINE__, "The %d-line "
1334  "catalogue has no lines in the range "
1335  "%g -> P(%g)=%g", nlines, wl, xmax,
1336  cpl_polynomial_eval_1d(disp, xmax, NULL));
1337 
1338  if (pulines != NULL) *pulines = ulines;
1339 
1340  return CPL_ERROR_NONE;
1341 }
1342 
1343 /*----------------------------------------------------------------------------*/
1352 /*----------------------------------------------------------------------------*/
1353 inline double irplib_erf_antideriv(double x, double sigma)
1354 {
1355  return x * erf( x / (sigma * CPL_MATH_SQRT2))
1356  + 2.0 * sigma/CPL_MATH_SQRT2PI * exp(-0.5 * x * x / (sigma * sigma));
1357 }
1358 
1359 
1360 #ifdef HAVE_GSL
1361 
1362 /*----------------------------------------------------------------------------*/
1369 /*----------------------------------------------------------------------------*/
1370 static double irplib_gsl_correlation(const gsl_vector * self, void * data)
1371 {
1372 
1373  irplib_multimin * mindata = (irplib_multimin *)data;
1374  cpl_errorstate prestate = cpl_errorstate_get();
1375  int nobs, nmodel, ndiff;
1376  cpl_size i;
1377 
1378  cpl_ensure(self != NULL, CPL_ERROR_NULL_INPUT, GSL_NAN);
1379  cpl_ensure(data != NULL, CPL_ERROR_NULL_INPUT, GSL_NAN);
1380 
1381  cpl_ensure(mindata->filler != NULL, CPL_ERROR_NULL_INPUT, GSL_NAN);
1382  cpl_ensure(mindata->observed != NULL, CPL_ERROR_NULL_INPUT, GSL_NAN);
1383  cpl_ensure(mindata->spectrum != NULL, CPL_ERROR_NULL_INPUT, GSL_NAN);
1384 
1385  nobs = cpl_vector_get_size(mindata->observed);
1386  nmodel = cpl_vector_get_size(mindata->spectrum);
1387  ndiff = nmodel - nobs;
1388 
1389  cpl_ensure((ndiff & 1) == 0, CPL_ERROR_ILLEGAL_INPUT, GSL_NAN);
1390 
1391  cpl_ensure(cpl_vector_get_size(mindata->vxc) == 1 + ndiff,
1392  CPL_ERROR_ILLEGAL_INPUT, GSL_NAN);
1393 
1394  ndiff /= 2;
1395 
1396  for (i=0; i < (cpl_size)self->size; i++) {
1397  const double value = gsl_vector_get(self, (size_t)i);
1398  cpl_polynomial_set_coeff(mindata->disp1d, &i, value);
1399  }
1400 
1401  /* Shift reference by -ndiff so filler can be used without offset.
1402  The subsequent polynomial shift is reduced by -ndiff. */
1403  cpl_ensure_code(!cpl_polynomial_shift_1d(mindata->disp1d, 0, -ndiff),
1404  cpl_error_get_code());
1405 
1406  if (mindata->filler(mindata->spectrum, mindata->disp1d,
1407  mindata->param)
1408  || !cpl_errorstate_is_equal(prestate)) {
1409 
1410  /* The fill failed. Ensure the discarding of this candidate by
1411  setting the cross-correlation to its minimum possible value. */
1412 
1413  (void)cpl_vector_fill(mindata->vxc, -1.0);
1414 
1415  mindata->maxxc = ndiff;
1416 
1417  if (!cpl_errorstate_is_equal(prestate)) {
1418  cpl_msg_debug(cpl_func, "Spectrum fill failed:");
1419  cpl_errorstate_dump(prestate, CPL_FALSE,
1421  cpl_errorstate_set(prestate);
1422  }
1423  } else {
1424 
1425  mindata->maxxc = cpl_vector_correlate(mindata->vxc,
1426  mindata->spectrum,
1427  mindata->observed);
1428  }
1429 
1430 #ifdef IRPLIB_SPC_DUMP
1431  /* Need irplib_wavecal.c rev. 1.12 through 1.15 */
1432  irplib_polynomial_dump_corr_step(mindata->disp1d, mindata->vxc,
1433  "Optimize");
1434 #endif
1435 
1436  mindata->xc = cpl_vector_get(mindata->vxc, ndiff);
1437 
1438  if (mindata->maxxc != ndiff &&
1439  cpl_vector_get(mindata->vxc, mindata->maxxc) > mindata->mxc) {
1440  const irplib_base_spectrum_model * arclamp
1441  = (const irplib_base_spectrum_model *)mindata->param;
1442 
1443  if (mindata->mdisp == NULL) {
1444  mindata->mdisp = cpl_polynomial_duplicate(mindata->disp1d);
1445  } else {
1446  cpl_polynomial_copy(mindata->mdisp, mindata->disp1d);
1447  }
1448  mindata->mxc = cpl_vector_get(mindata->vxc, mindata->maxxc);
1449  mindata->ishift = mindata->maxxc; /* Offset -ndiff pre-shifted above */
1450  cpl_msg_debug(cpl_func, "Local maximum: %g(%d) > %g(%d) (cost=%u:%u. "
1451  "lines=%u)", mindata->mxc, mindata->maxxc, mindata->xc,
1452  ndiff, (unsigned)arclamp->cost, (unsigned)arclamp->xcost,
1453  (unsigned)arclamp->ulines);
1454  }
1455 
1456  return -mindata->xc;
1457 }
1458 
1459 #endif
1460 
1461 /*----------------------------------------------------------------------------*/
1484 /*----------------------------------------------------------------------------*/
1485 cpl_error_code
1487  int maxdeg,
1488  const cpl_vector * obs,
1489  int nmaxima,
1490  int linelim,
1491  irplib_base_spectrum_model* model,
1492  cpl_error_code (* filler)
1493  (cpl_vector *,
1494  const cpl_polynomial *,
1495  irplib_base_spectrum_model *),
1496  double pixtol,
1497  double pixstep,
1498  int hsize,
1499  int maxite,
1500  int maxfail,
1501  int maxcont,
1502  cpl_boolean doplot,
1503  double * pxc)
1504 {
1505 
1506 #ifdef HAVE_GSL
1507 
1508  cpl_errorstate prestate = cpl_errorstate_get();
1509  cpl_polynomial * start;
1510  cpl_polynomial * cand;
1511  cpl_polynomial * backup;
1512  cpl_error_code error = CPL_ERROR_NONE;
1513  double xc;
1514  cpl_bivector * xtshift = cpl_bivector_new(nmaxima ? nmaxima : 1);
1515  const cpl_vector * xtshiftx = cpl_bivector_get_x_const(xtshift);
1516  const cpl_vector * xtshifty = cpl_bivector_get_y_const(xtshift);
1517  int nshift;
1518  int imaximum = -1;
1519  int imaxima;
1520 
1521 #endif
1522 
1523  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
1524  cpl_ensure_code(obs != NULL, CPL_ERROR_NULL_INPUT);
1525  cpl_ensure_code(model != NULL, CPL_ERROR_NULL_INPUT);
1526  cpl_ensure_code(filler != NULL, CPL_ERROR_NULL_INPUT);
1527  cpl_ensure_code(pxc != NULL, CPL_ERROR_NULL_INPUT);
1528 
1529  cpl_ensure_code(cpl_polynomial_get_dimension(self) == 1,
1530  CPL_ERROR_ILLEGAL_INPUT);
1531 
1532  cpl_ensure_code(cpl_polynomial_get_degree(self) > 0,
1533  CPL_ERROR_ILLEGAL_INPUT);
1534 
1535  cpl_ensure_code(maxdeg >= 0, CPL_ERROR_ILLEGAL_INPUT);
1536  cpl_ensure_code(pixtol > 0.0, CPL_ERROR_ILLEGAL_INPUT);
1537  cpl_ensure_code(pixstep > 0.0, CPL_ERROR_ILLEGAL_INPUT);
1538  cpl_ensure_code(hsize >= 0, CPL_ERROR_ILLEGAL_INPUT);
1539  cpl_ensure_code(maxite >= 0, CPL_ERROR_ILLEGAL_INPUT);
1540  cpl_ensure_code(nmaxima >= 0, CPL_ERROR_ILLEGAL_INPUT);
1541  cpl_ensure_code(maxfail > 0, CPL_ERROR_ILLEGAL_INPUT);
1542  cpl_ensure_code(maxcont > 0, CPL_ERROR_ILLEGAL_INPUT);
1543  cpl_ensure_code(linelim >= 0, CPL_ERROR_ILLEGAL_INPUT);
1544 
1545 #ifndef HAVE_GSL
1546  /* Avoid unused variable warning */
1547  cpl_ensure_code(doplot == CPL_TRUE || doplot == CPL_FALSE,
1548  CPL_ERROR_ILLEGAL_INPUT);
1549  return cpl_error_set_message(cpl_func, CPL_ERROR_UNSUPPORTED_MODE,
1550  "GSL is not available");
1551 #else
1552 
1553  if (irplib_bivector_find_shift_from_correlation(xtshift, self, obs,
1554  model, filler,
1555  hsize, doplot, &xc)) {
1556  cpl_bivector_delete(xtshift);
1557  return cpl_error_set_where(cpl_func);
1558  }
1559 
1560  if (model->ulines > (cpl_size)linelim) {
1561  /* The initial, optimal (integer) shift */
1562  const double xxc = cpl_vector_get(xtshiftx, 0);
1563  const double xc0 = cpl_vector_get(xtshifty, 0);
1564 
1565  cpl_msg_warning(cpl_func, "Doing only shift=%g pixels with lines=%u > "
1566  "%d and XC=%g", xxc, (unsigned)model->ulines, linelim,
1567  xc0);
1568 
1569  cpl_polynomial_shift_1d(self, 0, xxc);
1570 
1571  *pxc = xc0;
1572 
1573  cpl_bivector_delete(xtshift);
1574 
1575  return CPL_ERROR_NONE;
1576  }
1577 
1578  start = cpl_polynomial_duplicate(self);
1579  cand = cpl_polynomial_new(1);
1580  backup = cpl_polynomial_new(1);
1581 
1582  /* Number of (local) maxima to use as starting point of the optimization */
1583  nshift = cpl_bivector_get_size(xtshift);
1584  if (nmaxima == 0 || nmaxima > nshift) nmaxima = nshift;
1585 
1586  cpl_msg_info(cpl_func, "Optimizing %d/%d local shift-maxima "
1587  "(no-shift xc=%g. linelim=%d)", nmaxima, nshift, xc, linelim);
1588  if (cpl_msg_get_level() <= CPL_MSG_DEBUG)
1589  cpl_bivector_dump(xtshift, stdout);
1590 
1591  for (imaxima = 0; imaxima < nmaxima; imaxima++) {
1592  /* The initial, optimal (integer) shift */
1593  const double xxc = cpl_vector_get(xtshiftx, imaxima);
1594  double xtpixstep = pixstep;
1595  double xtpixtol = pixtol;
1596  double xtxc;
1597  cpl_boolean ok = CPL_FALSE;
1598  int nfail;
1599 
1600 
1601  cpl_polynomial_copy(cand, start);
1602  cpl_polynomial_shift_1d(cand, 0, xxc);
1603  cpl_polynomial_copy(backup, cand);
1604 
1605  /* Increase tolerance until convergence */
1606  for (nfail = 0; nfail < maxfail; nfail++, xtpixtol *= 2.0,
1607  xtpixstep *= 2.0) {
1608  int restart = maxcont;
1609  cpl_boolean redo;
1610 
1611  do {
1612  if (error) {
1613  cpl_errorstate_dump(prestate, CPL_FALSE,
1615  cpl_errorstate_set(prestate);
1616  }
1617  error = irplib_polynomial_find_1d_from_correlation_
1618  (cand, maxdeg, obs, model,
1619  filler, xtpixtol, xtpixstep, 2,
1620  maxite, &xtxc, &redo);
1621  if (redo && !error) error = CPL_ERROR_CONTINUE;
1622  } while (((!error && redo) || error == CPL_ERROR_CONTINUE)
1623  && --restart);
1624 
1625  if (!error && !redo) {
1626  cpl_msg_debug(cpl_func, "XC(imax=%d/%d:xtpixtol=%g): %g "
1627  "(cost=%u:%u)", 1+imaxima, nmaxima, xtpixtol,
1628  xtxc, (unsigned)model->cost,
1629  (unsigned)model->xcost);
1630  break;
1631  }
1632  cpl_msg_warning(cpl_func, "Increasing xtpixtol from %g (%g, imax="
1633  "%d/%d)", xtpixtol, xtpixstep, 1+imaxima, nmaxima);
1634  if (model->ulines > (cpl_size)linelim) {
1635  cpl_msg_warning(cpl_func, "Stopping search-refinement via "
1636  "catalogue with %u lines > %d",
1637  (unsigned)model->ulines, linelim);
1638  break;
1639  }
1640  cpl_polynomial_copy(cand, start);
1641  }
1642 
1643  /* Decrease tolerance until divergence, keep previous */
1644  for (; !error && xtpixtol > 0.0; xtpixtol *= 0.25, xtpixstep *= 0.5) {
1645  int restart = maxcont;
1646  cpl_boolean redo;
1647 
1648  cpl_polynomial_copy(backup, cand);
1649  do {
1650  if (error) {
1651  cpl_errorstate_dump(prestate, CPL_FALSE,
1653  cpl_errorstate_set(prestate);
1654  }
1655  error = irplib_polynomial_find_1d_from_correlation_
1656  (cand, maxdeg, obs, model, filler,
1657  xtpixtol, xtpixstep, 2, maxite, &xtxc, &redo);
1658  if (redo && !error) error = CPL_ERROR_CONTINUE;
1659  } while (((!error && redo) || error == CPL_ERROR_CONTINUE)
1660  && --restart);
1661  if (error) break;
1662  ok = CPL_TRUE;
1663  if (redo) break;
1664  cpl_msg_debug(cpl_func, "XC(imax=%d/%d:xtpixtol=%g): %g (cost=%u:%u"
1665  ". ulines=%u)", 1+imaxima, nmaxima, xtpixtol, xtxc,
1666  (unsigned)model->cost, (unsigned)model->xcost,
1667  (unsigned)model->ulines);
1668  if (model->ulines > (cpl_size)linelim) {
1669  cpl_msg_info(cpl_func, "Stopping search-refinement via "
1670  "catalogue with %u lines > %u",
1671  (unsigned)model->ulines, linelim);
1672  break;
1673  }
1674  }
1675 
1676  if (error) {
1677  error = 0;
1678  cpl_errorstate_dump(prestate, CPL_FALSE,
1680  cpl_errorstate_set(prestate);
1681  cpl_polynomial_copy(cand, backup);
1682  }
1683  if (ok && xtxc > xc) {
1684  imaximum = imaxima;
1685  cpl_polynomial_copy(self, cand);
1686  xc = xtxc;
1687 
1688  cpl_msg_info(cpl_func, "XC(imax=%d/%d): %g -> %g (initial-shift=%g. "
1689  "cost=%u:%u. lines=%u)", 1+imaxima, nmaxima,
1690  cpl_vector_get(xtshifty, imaxima), xtxc,
1691  cpl_vector_get(xtshiftx, imaxima),
1692  (unsigned)model->cost, (unsigned)model->xcost,
1693  (unsigned)model->ulines);
1694  } else {
1695  cpl_msg_info(cpl_func, "xc(imax=%d/%d): %g -> %g (initial-shift=%g. "
1696  "cost=%u:%u. lines=%u)", 1+imaxima, nmaxima,
1697  cpl_vector_get(xtshifty, imaxima), xtxc,
1698  cpl_vector_get(xtshiftx, imaxima),
1699  (unsigned)model->cost, (unsigned)model->xcost,
1700  (unsigned)model->ulines);
1701  }
1702  }
1703 
1704  cpl_polynomial_delete(start);
1705  cpl_polynomial_delete(backup);
1706  cpl_polynomial_delete(cand);
1707 
1708  if (imaximum < 0) {
1709  /* The initial, optimal (integer) shift */
1710  const double xxc = cpl_vector_get(xtshiftx, 0);
1711  const double xc0 = cpl_vector_get(xtshifty, 0);
1712 
1713  error = cpl_error_set_message(cpl_func, CPL_ERROR_DATA_NOT_FOUND,
1714  "Could not improve XC=%g over %d "
1715  "local shift-maxima, best at shift %g",
1716  xc0, nmaxima, xxc);
1717  } else {
1718  cpl_msg_info(cpl_func, "Maximal XC=%g (up from %g, with initial pixel-"
1719  "shift of %g) at %d/%d local shift-maximi", xc,
1720  cpl_vector_get(xtshifty, imaximum),
1721  cpl_vector_get(xtshiftx, imaximum),
1722  1+imaximum, nmaxima);
1723 
1724  if (doplot) {
1725  irplib_plot_spectrum_and_model(obs, self, model, filler);
1726  }
1727 
1728  *pxc = xc;
1729  }
1730 
1731  cpl_bivector_delete(xtshift);
1732 
1733  return error;
1734 
1735 #endif
1736 
1737 }
cpl_error_code irplib_vector_fill_line_spectrum_model(cpl_vector *self, cpl_vector *linepix, cpl_vector *erftmp, const cpl_polynomial *disp, const cpl_bivector *lines, double wslit, double wfwhm, double xtrunc, int hsize, cpl_boolean dofast, cpl_boolean dolog, cpl_size *pulines)
Generate a 1D spectrum from (arc) lines and a dispersion relation.
cpl_error_code irplib_vector_fill_line_spectrum(cpl_vector *self, const cpl_polynomial *disp, irplib_base_spectrum_model *lsslamp)
Generate a 1D spectrum from a model and a dispersion relation.
cpl_error_code irplib_bivector_find_shift_from_correlation(cpl_bivector *self, const cpl_polynomial *disp, const cpl_vector *obs, irplib_base_spectrum_model *model, cpl_error_code(*filler)(cpl_vector *, const cpl_polynomial *, irplib_base_spectrum_model *), int hsize, cpl_boolean doplot, double *pxc)
Find shift(s) that maximizes (locally) the cross-correlation.
cpl_error_code irplib_vector_fill_logline_spectrum_fast(cpl_vector *self, const cpl_polynomial *disp, irplib_base_spectrum_model *lsslamp)
Generate a 1D spectrum from a model and a dispersion relation.
cpl_error_code irplib_polynomial_shift_1d_from_correlation(cpl_polynomial *self, const cpl_vector *obs, irplib_base_spectrum_model *model, cpl_error_code(*filler)(cpl_vector *, const cpl_polynomial *, irplib_base_spectrum_model *), int hsize, cpl_boolean doplot, double *pxc)
Shift self by the amount that maximizes the cross-correlation.
cpl_error_code irplib_polynomial_find_1d_from_correlation(cpl_polynomial *self, int maxdeg, const cpl_vector *obs, irplib_base_spectrum_model *model, cpl_error_code(*filler)(cpl_vector *, const cpl_polynomial *, irplib_base_spectrum_model *), double pixtol, double pixstep, int hsize, int maxite, double *pxc)
Modify self by maximizing the cross-correlation.
void irplib_errorstate_dump_debug(unsigned self, unsigned first, unsigned last)
Dump a single CPL error at the CPL debug level.
Definition: irplib_utils.c:160
cpl_error_code irplib_vector_fill_logline_spectrum(cpl_vector *self, const cpl_polynomial *disp, irplib_base_spectrum_model *lsslamp)
Generate a 1D spectrum from a model and a dispersion relation.
cpl_error_code irplib_polynomial_fit_2d_dispersion(cpl_polynomial *self, const cpl_image *imgwave, int fitdeg, double *presid)
Fit a 2D-dispersion from an image of wavelengths.
cpl_error_code irplib_vector_fill_line_spectrum_fast(cpl_vector *self, const cpl_polynomial *disp, irplib_base_spectrum_model *lsslamp)
Generate a 1D spectrum from a model and a dispersion relation.
cpl_error_code irplib_plot_spectrum_and_model(const cpl_vector *self, const cpl_polynomial *disp1d, irplib_base_spectrum_model *model, cpl_error_code(*filler)(cpl_vector *, const cpl_polynomial *, irplib_base_spectrum_model *))
Plot a 1D spectrum and one from a model.
cpl_error_code irplib_polynomial_find_1d_from_correlation_all(cpl_polynomial *self, int maxdeg, const cpl_vector *obs, int nmaxima, int linelim, irplib_base_spectrum_model *model, cpl_error_code(*filler)(cpl_vector *, const cpl_polynomial *, irplib_base_spectrum_model *), double pixtol, double pixstep, int hsize, int maxite, int maxfail, int maxcont, cpl_boolean doplot, double *pxc)
Modify self by maximizing the cross-correlation across all maxima.
int irplib_bivector_count_positive(const cpl_bivector *self, double x_min, double x_max)
Count the positive Y-entries in a given X-range.
double irplib_erf_antideriv(double x, double sigma)
The antiderivative of erx(x/sigma/sqrt(2)) with respect to x.