DETMON Pipeline Reference Manual  1.3.0
irplib_wlxcorr.c
1 /*
2  * This file is part of the IRPLIB package
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 #include "irplib_wlxcorr.h"
31 
32 #include <cpl.h>
33 
34 #include <math.h>
35 #include <string.h>
36 
37 /*----------------------------------------------------------------------------*/
47 /*----------------------------------------------------------------------------*/
48 
49 /*-----------------------------------------------------------------------------
50  Defines
51  -----------------------------------------------------------------------------*/
52 
53 #ifndef inline
54 #define inline /* inline */
55 #endif
56 
57 #define IRPLIB_MAX(A,B) ((A) > (B) ? (A) : (B))
58 #define IRPLIB_MIN(A,B) ((A) < (B) ? (A) : (B))
59 
60 #define IRPLIB_PTR_SWAP(a,b) \
61  do { void * irplib_ptr_swap =(a);(a)=(b);(b)=irplib_ptr_swap; } while (0)
62 
63 /*-----------------------------------------------------------------------------
64  Private functions
65  -----------------------------------------------------------------------------*/
66 
67 static void irplib_wlxcorr_estimate(cpl_vector *, cpl_vector *,
68  const cpl_vector *,
69  const cpl_bivector *,
70  const cpl_vector *,
71  const cpl_polynomial *,
72  double, double);
73 
74 static int irplib_wlxcorr_signal_resample(cpl_vector *, const cpl_vector *,
75  const cpl_bivector *) ;
76 static cpl_error_code cpl_vector_fill_lss_profile_symmetric(cpl_vector *,
77  double, double);
78 static cpl_error_code irplib_wlcalib_fill_spectrum(cpl_vector *,
79  const cpl_bivector *,
80  const cpl_vector *,
81  const cpl_polynomial *, int);
82 
83 static cpl_boolean irplib_wlcalib_is_lines(const cpl_vector *,
84  const cpl_polynomial *,
85  int, double);
86 
90 /*----------------------------------------------------------------------------*/
126 /*----------------------------------------------------------------------------*/
127 cpl_polynomial * irplib_wlxcorr_best_poly(const cpl_vector * spectrum,
128  const cpl_bivector * lines_catalog,
129  int degree,
130  const cpl_polynomial * guess_poly,
131  const cpl_vector * wl_error,
132  int nsamples,
133  double slitw,
134  double fwhm,
135  double * xc,
136  cpl_table ** wlres,
137  cpl_vector ** xcorrs)
138 {
139  const int spec_sz = cpl_vector_get_size(spectrum);
140  const int nfree = cpl_vector_get_size(wl_error);
141  int ntests = 1;
142  cpl_vector * model;
143  cpl_vector * vxc;
144  cpl_vector * init_pts_wl;
145  cpl_matrix * init_pts_x;
146  cpl_vector * pts_wl;
147  cpl_vector * vxcorrs;
148  cpl_vector * conv_kernel = NULL;
149  cpl_polynomial * poly_sol;
150  cpl_polynomial * poly_candi;
151  const double * pwl_error = cpl_vector_get_data_const(wl_error);
152  const double * dxc;
153  cpl_size degree_loc ;
154  const cpl_boolean symsamp = CPL_TRUE; /* init_pts_x is symmetric */
155  const cpl_boolean is_lines
156  = irplib_wlcalib_is_lines(cpl_bivector_get_x_const(lines_catalog),
157  guess_poly, spec_sz, 1.0);
158  int i;
159 
160  /* FIXME: Need mode parameter for catalogue type (lines <=> profile) */
161 
162  /* In case of failure */
163  if (wlres != NULL) *wlres = NULL;
164  if (xcorrs != NULL) *xcorrs = NULL;
165 
166  /* Useful for knowing if resampling is used */
167  cpl_msg_debug(cpl_func, "Checking %d^%d dispersion polynomials (slitw=%g, "
168  "fwhm=%g) against %d-point observed spectrum with%s "
169  "catalog resampling", nsamples, nfree, slitw, fwhm, spec_sz,
170  is_lines ? "out" : "");
171 
172  cpl_ensure(xc != NULL, CPL_ERROR_NULL_INPUT, NULL);
173  *xc = -1.0;
174  cpl_ensure(spectrum != NULL, CPL_ERROR_NULL_INPUT, NULL);
175  cpl_ensure(lines_catalog != NULL, CPL_ERROR_NULL_INPUT, NULL);
176  cpl_ensure(guess_poly != NULL, CPL_ERROR_NULL_INPUT, NULL);
177  cpl_ensure(wl_error != NULL, CPL_ERROR_NULL_INPUT, NULL);
178  cpl_ensure(nfree >= 2, CPL_ERROR_ILLEGAL_INPUT, NULL);
179  cpl_ensure(nsamples > 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
180  /* FIXME: degree is redundant */
181  cpl_ensure(1 + degree == nfree, CPL_ERROR_ILLEGAL_INPUT, NULL);
182 
183  cpl_ensure(cpl_polynomial_get_dimension(guess_poly) == 1,
184  CPL_ERROR_ILLEGAL_INPUT, NULL);
185 
186  if (nsamples > 1) {
187  /* Search place must consist of more than one point */
188  /* FIXME: The bounds should probably not be negative */
189  for (i = 0; i < nfree; i++) {
190  if (pwl_error[i] != 0.0) break;
191  }
192  cpl_ensure(i < nfree, CPL_ERROR_ILLEGAL_INPUT, NULL);
193  }
194 
195  if (!is_lines) {
196  /* Create the convolution kernel */
197  conv_kernel = irplib_wlxcorr_convolve_create_kernel(slitw, fwhm);
198  cpl_ensure(conv_kernel != NULL, CPL_ERROR_ILLEGAL_INPUT, NULL);
199  }
200 
201  /* Create initial test points */
202  init_pts_x = cpl_matrix_new(1, nfree);
203  init_pts_wl = cpl_vector_new(nfree);
204  pts_wl = cpl_vector_new(nfree);
205  for (i = 0; i < nfree; i++) {
206  const double xpos = spec_sz * i / (double)degree;
207  const double wlpos = cpl_polynomial_eval_1d(guess_poly, xpos, NULL)
208  - 0.5 * pwl_error[i];
209 
210  cpl_matrix_set(init_pts_x, 0, i, xpos);
211  cpl_vector_set(init_pts_wl, i, wlpos);
212 
213  ntests *= nsamples; /* Count number of tests */
214 
215  }
216 
217  vxcorrs = xcorrs != NULL ? cpl_vector_new(ntests) : NULL;
218 
219  poly_sol = cpl_polynomial_new(1);
220  poly_candi = cpl_polynomial_new(1);
221  model = cpl_vector_new(spec_sz);
222  vxc = cpl_vector_new(1);
223  dxc = cpl_vector_get_data_const(vxc);
224 
225  /* Create the polynomial candidates and estimate them */
226  for (i=0; i < ntests; i++) {
227  int idiv = i;
228  int deg;
229 
230  /* Update wavelength at one anchor point - and reset wavelengths
231  to their default for any anchor point(s) at higher wavelengths */
232  for (deg = degree; deg >= 0; deg--, idiv /= nsamples) {
233  const int imod = idiv % nsamples;
234  const double wlpos = cpl_vector_get(init_pts_wl, deg)
235  + imod * pwl_error[deg] / nsamples;
236 
237  /* FIXME: If wlpos causes pts_wl to be non-increasing, the
238  solution will be non-physical with no need for evaluation.
239  (*xc could be set to -1 in this case). */
240  cpl_vector_set(pts_wl, deg, wlpos);
241 
242  if (imod > 0) break;
243  }
244 
245  /* Generate */
246  degree_loc = (cpl_size)degree ;
247  cpl_polynomial_fit(poly_candi, init_pts_x, &symsamp, pts_wl,
248  NULL, CPL_FALSE, NULL, &degree_loc);
249  /* *** Estimate *** */
250  irplib_wlxcorr_estimate(vxc, model, spectrum, lines_catalog,
251  conv_kernel, poly_candi, slitw, fwhm);
252  if (vxcorrs != NULL) cpl_vector_set(vxcorrs, i, *dxc);
253  if (*dxc > *xc) {
254  /* Found a better solution */
255  *xc = *dxc;
256  IRPLIB_PTR_SWAP(poly_sol, poly_candi);
257  }
258  }
259 
260  cpl_vector_delete(model);
261  cpl_vector_delete(vxc);
262  cpl_vector_delete(conv_kernel);
263  cpl_vector_delete(pts_wl);
264  cpl_matrix_delete(init_pts_x);
265  cpl_vector_delete(init_pts_wl);
266  cpl_polynomial_delete(poly_candi);
267 
268 #ifdef CPL_WLCALIB_FAIL_ON_CONSTANT
269  /* FIXME: */
270  if (cpl_polynomial_get_degree(poly_sol) == 0) {
271  cpl_polynomial_delete(poly_sol);
272  cpl_vector_delete(vxcorrs);
273  *xc = 0.0;
274  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT,
275  __FILE__, __LINE__, "Found a constant "
276  "dispersion");
277  cpl_errorstate_dump(prestate, CPL_FALSE, NULL);
278  return NULL;
279  }
280 #endif
281 
282  if (wlres != NULL) {
283  /* FIXME: A failure in the table creation is not considered a failure
284  of the whole function call (although all outputs may be useless) */
285 
286  cpl_errorstate prestate = cpl_errorstate_get();
287  /* Create the spc_table */
288  *wlres = irplib_wlxcorr_gen_spc_table(spectrum, lines_catalog, slitw,
289  fwhm, guess_poly, poly_sol);
290  if (*wlres == NULL) {
291  cpl_polynomial_delete(poly_sol);
292  cpl_vector_delete(vxcorrs);
293  *xc = -1.0;
294  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT,
295  __FILE__, __LINE__, "Cannot generate "
296  "infos table");
297  /* cpl_errorstate_dump(prestate, CPL_FALSE, NULL); */
298  cpl_errorstate_set(prestate);
299  return NULL;
300  }
301  }
302 
303  if (xcorrs != NULL) {
304  *xcorrs = vxcorrs;
305  } else {
306  /* assert(vxcorrs == NULL); */
307  }
308 
309  return poly_sol;
310 }
311 
312 /*----------------------------------------------------------------------------*/
330 /*----------------------------------------------------------------------------*/
331 cpl_table * irplib_wlxcorr_gen_spc_table(
332  const cpl_vector * spectrum,
333  const cpl_bivector * lines_catalog,
334  double slitw,
335  double fwhm,
336  const cpl_polynomial * guess_poly,
337  const cpl_polynomial * corr_poly)
338 {
339 
340  cpl_vector * conv_kernel = NULL;
341  cpl_bivector * gen_init ;
342  cpl_bivector * gen_corr ;
343  cpl_table * spc_table ;
344  const double * pgen ;
345  const double xtrunc = 0.5 * slitw + 5.0 * fwhm * CPL_MATH_SIG_FWHM;
346  const int spec_sz = cpl_vector_get_size(spectrum);
347  const cpl_boolean guess_resamp
348  = !irplib_wlcalib_is_lines(cpl_bivector_get_x_const(lines_catalog),
349  guess_poly, spec_sz, 1.0);
350  const cpl_boolean corr_resamp
351  = !irplib_wlcalib_is_lines(cpl_bivector_get_x_const(lines_catalog),
352  corr_poly, spec_sz, 1.0);
353  cpl_error_code error;
354 
355  cpl_msg_debug(cpl_func, "Tabel for guess dispersion polynomial (slitw=%g, "
356  "fwhm=%g) with %d-point observed spectrum with%s catalog re"
357  "sampling", slitw, fwhm, spec_sz, guess_resamp ? "out" : "");
358  cpl_msg_debug(cpl_func, "Tabel for corr. dispersion polynomial (slitw=%g, "
359  "fwhm=%g) with %d-point observed spectrum with%s catalog re"
360  "sampling", slitw, fwhm, spec_sz, corr_resamp ? "out" : "");
361 
362  /* Test inputs */
363  cpl_ensure(spectrum, CPL_ERROR_NULL_INPUT, NULL) ;
364  cpl_ensure(lines_catalog, CPL_ERROR_NULL_INPUT, NULL) ;
365  cpl_ensure(guess_poly, CPL_ERROR_NULL_INPUT, NULL) ;
366  cpl_ensure(corr_poly, CPL_ERROR_NULL_INPUT, NULL) ;
367 
368  /* Create the convolution kernel */
369  if (guess_resamp || corr_resamp) {
370  conv_kernel = irplib_wlxcorr_convolve_create_kernel(slitw, fwhm);
371 
372  if (conv_kernel == NULL) {
373  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
374  __FILE__, __LINE__, "Cannot create "
375  "convolution kernel") ;
376  return NULL ;
377  }
378  }
379 
380  /* Get the emission at initial wavelengths */
381  gen_init = cpl_bivector_new(spec_sz);
382  if (guess_resamp) {
383  error = irplib_wlcalib_fill_spectrum(cpl_bivector_get_y(gen_init),
384  lines_catalog, conv_kernel,
385  guess_poly, 0);
386  } else {
388  (cpl_bivector_get_y(gen_init), NULL, NULL,
389  guess_poly, lines_catalog,
390  slitw, fwhm, xtrunc, 0, CPL_FALSE, CPL_FALSE, NULL);
391  }
392 
393  if (error || cpl_vector_fill_polynomial(cpl_bivector_get_x(gen_init),
394  guess_poly, 1, 1)) {
395  cpl_vector_delete(conv_kernel);
396  cpl_bivector_delete(gen_init);
397  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
398  __FILE__, __LINE__, "Cannot get the "
399  "emission spectrum");
400  return NULL;
401  }
402 
403  /* Get the emission at corrected wavelengths */
404  gen_corr = cpl_bivector_new(spec_sz);
405  if (corr_resamp) {
406  error = irplib_wlcalib_fill_spectrum(cpl_bivector_get_y(gen_corr),
407  lines_catalog, conv_kernel,
408  corr_poly, 0);
409  } else {
411  (cpl_bivector_get_y(gen_corr), NULL, NULL,
412  corr_poly, lines_catalog,
413  slitw, fwhm, xtrunc, 0, CPL_FALSE, CPL_FALSE, NULL);
414  }
415 
416  if (error || cpl_vector_fill_polynomial(cpl_bivector_get_x(gen_corr),
417  corr_poly, 1, 1)) {
418  cpl_vector_delete(conv_kernel);
419  cpl_bivector_delete(gen_init);
420  cpl_bivector_delete(gen_corr) ;
421  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
422  __FILE__, __LINE__, "Cannot get the "
423  "emission spectrum");
424  return NULL;
425  }
426  cpl_vector_delete(conv_kernel) ;
427 
428  /* Create the ouput table */
429  spc_table = cpl_table_new(spec_sz);
430  cpl_table_new_column(spc_table, IRPLIB_WLXCORR_COL_WAVELENGTH,
431  CPL_TYPE_DOUBLE);
432  cpl_table_new_column(spc_table, IRPLIB_WLXCORR_COL_CAT_INIT,
433  CPL_TYPE_DOUBLE);
434  cpl_table_new_column(spc_table, IRPLIB_WLXCORR_COL_CAT_FINAL,
435  CPL_TYPE_DOUBLE);
436  cpl_table_new_column(spc_table, IRPLIB_WLXCORR_COL_OBS, CPL_TYPE_DOUBLE);
437 
438  /* Update table */
439  pgen = cpl_bivector_get_x_data_const(gen_corr) ;
440  cpl_table_copy_data_double(spc_table, IRPLIB_WLXCORR_COL_WAVELENGTH, pgen) ;
441  pgen = cpl_bivector_get_y_data_const(gen_corr) ;
442  cpl_table_copy_data_double(spc_table, IRPLIB_WLXCORR_COL_CAT_FINAL, pgen) ;
443  pgen = cpl_vector_get_data_const(spectrum) ;
444  cpl_table_copy_data_double(spc_table, IRPLIB_WLXCORR_COL_OBS, pgen) ;
445  pgen = cpl_bivector_get_y_data_const(gen_init) ;
446  cpl_table_copy_data_double(spc_table, IRPLIB_WLXCORR_COL_CAT_INIT, pgen);
447  cpl_bivector_delete(gen_init);
448  cpl_bivector_delete(gen_corr);
449 
450  return spc_table ;
451 }
452 
453 /*----------------------------------------------------------------------------*/
465 /*----------------------------------------------------------------------------*/
466 cpl_bivector * irplib_wlxcorr_cat_extract(
467  const cpl_bivector * lines_catalog,
468  double wave_min,
469  double wave_max)
470 {
471  const int nlines = cpl_bivector_get_size(lines_catalog);
472  int wave_min_id, wave_max_id ;
473  cpl_vector * sub_cat_wl ;
474  cpl_vector * sub_cat_int ;
475  const cpl_vector * xlines = cpl_bivector_get_x_const(lines_catalog);
476  const double * dxlines = cpl_vector_get_data_const(xlines);
477 
478  cpl_ensure(lines_catalog != NULL, CPL_ERROR_NULL_INPUT, NULL);
479 
480  /* Find the 1st line */
481  wave_min_id = (int)cpl_vector_find(xlines, wave_min);
482  if (wave_min_id < 0) {
483  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
484  __FILE__, __LINE__,
485  "The starting wavelength cannot be found") ;
486  return NULL ;
487  }
488 
489  /* The first line must be greater than (at least?) wave_min */
490  if (dxlines[wave_min_id] <= wave_min) wave_min_id++;
491 
492  /* Find the last line */
493  wave_max_id = (int)cpl_vector_find(xlines, wave_max);
494  if (wave_max_id < 0) {
495  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
496  __FILE__, __LINE__,
497  "The ending wavelength cannot be found") ;
498  return NULL ;
499  }
500  /* The last line must be less than wave_max */
501  if (dxlines[wave_max_id] >= wave_min) wave_max_id--;
502 
503  /* Checking the wavelength range at this point via the indices also
504  verifies that they were not found using non-increasing wavelengths */
505  cpl_ensure(wave_min_id <= wave_max_id, CPL_ERROR_ILLEGAL_INPUT, NULL);
506 
507  if (wave_min_id < 0 || wave_max_id == nlines) {
508  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
509  __FILE__, __LINE__, "The %d-line catalogue "
510  "has no lines in the range %g -> %g",
511  nlines, wave_min, wave_max);
512  return NULL ;
513  }
514 
515  sub_cat_wl = cpl_vector_extract(xlines, wave_min_id, wave_max_id, 1);
516  sub_cat_int = cpl_vector_extract(cpl_bivector_get_y_const(lines_catalog),
517  wave_min_id, wave_max_id, 1);
518 
519  return cpl_bivector_wrap_vectors(sub_cat_wl, sub_cat_int);
520 }
521 
522 /*----------------------------------------------------------------------------*/
539 /*----------------------------------------------------------------------------*/
540 cpl_vector * irplib_wlxcorr_convolve_create_kernel(double slitw,
541  double fwhm)
542 {
543  const double sigma = fwhm * CPL_MATH_SIG_FWHM;
544  const int size = 1 + (int)(5.0 * sigma + 0.5*slitw);
545  cpl_vector * kernel = cpl_vector_new(size);
546 
547 
548  if (cpl_vector_fill_lss_profile_symmetric(kernel, slitw, fwhm)) {
549  cpl_vector_delete(kernel);
550  cpl_ensure(0, cpl_error_get_code(), NULL);
551  }
552 
553  return kernel;
554 }
555 
556 /*----------------------------------------------------------------------------*/
569 /*----------------------------------------------------------------------------*/
570 int irplib_wlxcorr_convolve(
571  cpl_vector * smoothed,
572  const cpl_vector * conv_kernel)
573 {
574  int nsamples ;
575  int ihwidth ;
576  cpl_vector * raw ;
577  double * psmoothe ;
578  double * praw ;
579  const double* psymm ;
580  int i, j ;
581 
582  /* Test entries */
583  cpl_ensure(smoothed, CPL_ERROR_NULL_INPUT, -1) ;
584  cpl_ensure(conv_kernel, CPL_ERROR_NULL_INPUT, -1) ;
585 
586  /* Initialise */
587  nsamples = cpl_vector_get_size(smoothed) ;
588  ihwidth = cpl_vector_get_size(conv_kernel) - 1 ;
589  cpl_ensure(ihwidth<nsamples, CPL_ERROR_ILLEGAL_INPUT, -1) ;
590  psymm = cpl_vector_get_data_const(conv_kernel) ;
591  psmoothe = cpl_vector_get_data(smoothed) ;
592 
593  /* Create raw vector */
594  raw = cpl_vector_duplicate(smoothed) ;
595  praw = cpl_vector_get_data(raw) ;
596 
597  /* Convolve with the symmetric function */
598  for (i=0 ; i<ihwidth ; i++) {
599  psmoothe[i] = praw[i] * psymm[0];
600  for (j=1 ; j <= ihwidth ; j++) {
601  const int k = i-j < 0 ? 0 : i-j;
602  psmoothe[i] += (praw[k]+praw[i+j]) * psymm[j];
603  }
604  }
605 
606  for (i=ihwidth ; i<nsamples-ihwidth ; i++) {
607  psmoothe[i] = praw[i] * psymm[0];
608  for (j=1 ; j<=ihwidth ; j++)
609  psmoothe[i] += (praw[i-j]+praw[i+j]) * psymm[j];
610  }
611  for (i=nsamples-ihwidth ; i<nsamples ; i++) {
612  psmoothe[i] = praw[i] * psymm[0];
613  for (j=1 ; j<=ihwidth ; j++) {
614  const int k = i+j > nsamples-1 ? nsamples - 1 : i+j;
615  psmoothe[i] += (praw[k]+praw[i-j]) * psymm[j];
616  }
617  }
618  cpl_vector_delete(raw) ;
619  return 0 ;
620 }
621 
622 /*----------------------------------------------------------------------------*/
632 /*----------------------------------------------------------------------------*/
633 int irplib_wlxcorr_plot_solution(
634  const cpl_polynomial * init,
635  const cpl_polynomial * comp,
636  const cpl_polynomial * sol,
637  int pix_start,
638  int pix_stop)
639 {
640  int nsamples, nplots ;
641  cpl_vector ** vectors ;
642  int i ;
643 
644  /* Test entries */
645  if (init == NULL || comp == NULL) return -1 ;
646 
647  /* Initialise */
648  nsamples = pix_stop - pix_start + 1 ;
649  if (sol != NULL) nplots = 3 ;
650  else nplots = 2 ;
651 
652  /* Create vectors */
653  vectors = cpl_malloc((nplots+1)*sizeof(cpl_vector*)) ;
654  for (i=0 ; i<nplots+1 ; i++) vectors[i] = cpl_vector_new(nsamples) ;
655 
656  /* First plot with the lambda/pixel relation */
657  /* Fill vectors */
658  for (i=0 ; i<nsamples ; i++) {
659  cpl_vector_set(vectors[0], i, pix_start+i) ;
660  cpl_vector_set(vectors[1], i,
661  cpl_polynomial_eval_1d(init, (double)(pix_start+i), NULL)) ;
662  cpl_vector_set(vectors[2], i,
663  cpl_polynomial_eval_1d(comp, (double)(pix_start+i), NULL)) ;
664  if (sol != NULL)
665  cpl_vector_set(vectors[3], i,
666  cpl_polynomial_eval_1d(sol, (double)(pix_start+i), NULL)) ;
667  }
668 
669  /* Plot */
670  cpl_plot_vectors("set grid;set xlabel 'Position (pixels)';",
671  "t '1-Initial / 2-Computed / 3-Solution' w lines",
672  "", (const cpl_vector **)vectors, nplots+1);
673 
674  /* Free vectors */
675  for (i=0 ; i<nplots+1 ; i++) cpl_vector_delete(vectors[i]) ;
676  cpl_free(vectors) ;
677 
678  /* Allocate vectors */
679  nplots -- ;
680  vectors = cpl_malloc((nplots+1)*sizeof(cpl_vector*)) ;
681  for (i=0 ; i<nplots+1 ; i++) vectors[i] = cpl_vector_new(nsamples) ;
682 
683  /* Second plot with the delta-lambda/pixel relation */
684  /* Fill vectors */
685  for (i=0 ; i<nsamples ; i++) {
686  double diff ;
687  cpl_vector_set(vectors[0], i, pix_start+i) ;
688  diff = cpl_polynomial_eval_1d(comp, (double)(pix_start+i), NULL) -
689  cpl_polynomial_eval_1d(init, (double)(pix_start+i), NULL) ;
690  cpl_vector_set(vectors[1], i, diff) ;
691  if (sol != NULL) {
692  diff = cpl_polynomial_eval_1d(sol, (double)(pix_start+i), NULL) -
693  cpl_polynomial_eval_1d(init, (double)(pix_start+i), NULL) ;
694  cpl_vector_set(vectors[2], i, diff) ;
695  }
696  }
697 
698  /* Plot */
699  if (sol == NULL) {
700  cpl_bivector * bivector ;
701  bivector = cpl_bivector_wrap_vectors(vectors[0], vectors[1]) ;
702  cpl_plot_bivector(
703 "set grid;set xlabel 'Position (pixels)';set ylabel 'Wavelength difference';",
704  "t 'Computed-Initial wavelenth' w lines", "", bivector);
705  cpl_bivector_unwrap_vectors(bivector) ;
706  } else {
707  cpl_plot_vectors("set grid;set xlabel 'Position (pixels)';",
708  "t '1-Computed - Initial / 2--Solution - Initial' w lines",
709  "", (const cpl_vector **)vectors, nplots+1);
710  }
711 
712  /* Free vectors */
713  for (i=0 ; i<nplots+1 ; i++) cpl_vector_delete(vectors[i]) ;
714  cpl_free(vectors) ;
715 
716  /* Return */
717  return 0 ;
718 }
719 
720 /*----------------------------------------------------------------------------*/
731 /*----------------------------------------------------------------------------*/
732 int irplib_wlxcorr_plot_spc_table(
733  const cpl_table * spc_table,
734  const char * title,
735  int first_plotted_line,
736  int last_plotted_line)
737 {
738  char title_loc[1024] ;
739  cpl_vector ** vectors ;
740  cpl_vector ** sub_vectors ;
741  cpl_vector * tmp_vec ;
742  int nsamples ;
743  double mean1, mean3 ;
744  int start_ind, stop_ind, hsize_pix ;
745  int i, j ;
746 
747  /* Test entries */
748  if (first_plotted_line > last_plotted_line) return -1 ;
749  if (spc_table == NULL) return -1 ;
750 
751  /* Initialise */
752  nsamples = cpl_table_get_nrow(spc_table) ;
753  hsize_pix = 10 ;
754 
755  sprintf(title_loc,
756  "t '%s - 1-Initial catalog/2-Corrected catalog/3-Observed' w lines",
757  title) ;
758  title_loc[1023] = (char)0 ;
759 
760  vectors = cpl_malloc(4*sizeof(cpl_vector*)) ;
761  vectors[0] = cpl_vector_wrap(nsamples,
762  cpl_table_get_data_double((cpl_table*)spc_table,
763  IRPLIB_WLXCORR_COL_WAVELENGTH));
764  vectors[1] = cpl_vector_wrap(nsamples,
765  cpl_table_get_data_double((cpl_table*)spc_table,
766  IRPLIB_WLXCORR_COL_CAT_INIT));
767  vectors[2] = cpl_vector_wrap(nsamples,
768  cpl_table_get_data_double((cpl_table*)spc_table,
769  IRPLIB_WLXCORR_COL_CAT_FINAL));
770  vectors[3] = cpl_vector_wrap(nsamples,
771  cpl_table_get_data_double((cpl_table*)spc_table,
772  IRPLIB_WLXCORR_COL_OBS)) ;
773 
774  /* Scale the signal for a bettre display */
775  mean1 = cpl_vector_get_mean(vectors[1]) ;
776  mean3 = cpl_vector_get_mean(vectors[3]) ;
777  if (fabs(mean3) > 1)
778  cpl_vector_multiply_scalar(vectors[3], fabs(mean1/mean3)) ;
779 
780  cpl_plot_vectors("set grid;set xlabel 'Wavelength (nm)';", title_loc,
781  "", (const cpl_vector **)vectors, 4);
782 
783  /* Unscale the signal */
784  if (fabs(mean3) > 1)
785  cpl_vector_multiply_scalar(vectors[3], mean3/mean1) ;
786 
787  /* Loop on the brightest lines and zoom on them */
788  sprintf(title_loc,
789 "t '%s - 1-Initial catalog/2-Corrected catalog/3-Observed (ZOOMED)' w lines",
790  title) ;
791  title_loc[1023] = (char)0 ;
792  tmp_vec = cpl_vector_duplicate(vectors[2]) ;
793  for (i=0 ; i<last_plotted_line ; i++) {
794  double max;
795  /* Find the brightest line */
796  if ((max = cpl_vector_get_max(tmp_vec)) <= 0.0) break ;
797  for (j=0 ; j<nsamples ; j++) {
798  if (cpl_vector_get(tmp_vec, j) == max) break ;
799  }
800  if (j-hsize_pix < 0) start_ind = 0 ;
801  else start_ind = j-hsize_pix ;
802  if (j+hsize_pix > nsamples-1) stop_ind = nsamples-1 ;
803  else stop_ind = j+hsize_pix ;
804  for (j=start_ind ; j<=stop_ind ; j++) cpl_vector_set(tmp_vec, j, 0.0) ;
805 
806  if (i+1 >= first_plotted_line) {
807  sub_vectors = cpl_malloc(4*sizeof(cpl_vector*)) ;
808  sub_vectors[0]=cpl_vector_extract(vectors[0],start_ind,stop_ind,1);
809  sub_vectors[1]=cpl_vector_extract(vectors[1],start_ind,stop_ind,1);
810  sub_vectors[2]=cpl_vector_extract(vectors[2],start_ind,stop_ind,1);
811  sub_vectors[3]=cpl_vector_extract(vectors[3],start_ind,stop_ind,1);
812 
813  cpl_plot_vectors("set grid;set xlabel 'Wavelength (nm)';",
814  title_loc, "", (const cpl_vector **)sub_vectors, 4);
815 
816  cpl_vector_delete(sub_vectors[0]) ;
817  cpl_vector_delete(sub_vectors[1]) ;
818  cpl_vector_delete(sub_vectors[2]) ;
819  cpl_vector_delete(sub_vectors[3]) ;
820  cpl_free(sub_vectors) ;
821  }
822  }
823  cpl_vector_delete(tmp_vec) ;
824 
825  cpl_vector_unwrap(vectors[0]) ;
826  cpl_vector_unwrap(vectors[1]) ;
827  cpl_vector_unwrap(vectors[2]) ;
828  cpl_vector_unwrap(vectors[3]) ;
829  cpl_free(vectors) ;
830 
831  return 0 ;
832 }
833 
834 /*----------------------------------------------------------------------------*/
842 /*----------------------------------------------------------------------------*/
843 int irplib_wlxcorr_catalog_plot(
844  const cpl_bivector * cat,
845  double wmin,
846  double wmax)
847 {
848  int start, stop ;
849  cpl_bivector * subcat ;
850  cpl_vector * subcat_x ;
851  cpl_vector * subcat_y ;
852  const double * pwave ;
853  int nvals, nvals_tot ;
854  int i ;
855 
856  /* Test entries */
857  if (cat == NULL) return -1 ;
858  if (wmax <= wmin) return -1 ;
859 
860  /* Initialise */
861  nvals_tot = cpl_bivector_get_size(cat) ;
862 
863  /* Count the nb of values */
864  pwave = cpl_bivector_get_x_data_const(cat) ;
865  if (pwave[0] >= wmin) start = 0 ;
866  else start = -1 ;
867  if (pwave[nvals_tot-1] <= wmax) stop = nvals_tot-1 ;
868  else stop = -1 ;
869  i=0 ;
870  while ((i<nvals_tot-1) && (pwave[i] < wmin)) i++ ;
871  start = i ;
872  i= nvals_tot-1 ;
873  while ((i>0) && (pwave[i] > wmax)) i-- ;
874  stop = i ;
875 
876  if (start>=stop) {
877  cpl_msg_error(cpl_func, "Cannot plot the catalog") ;
878  return -1 ;
879  }
880  nvals = stop - start + 1 ;
881 
882  /* Create the bivector to plot */
883  subcat_x = cpl_vector_extract(cpl_bivector_get_x_const(cat),start,stop, 1) ;
884  subcat_y = cpl_vector_extract(cpl_bivector_get_y_const(cat),start,stop, 1) ;
885  subcat = cpl_bivector_wrap_vectors(subcat_x, subcat_y) ;
886 
887  /* Plot */
888  if (nvals > 500) {
889  cpl_plot_bivector(
890  "set grid;set xlabel 'Wavelength (nm)';set ylabel 'Emission';",
891  "t 'Catalog Spectrum' w lines", "", subcat);
892  } else {
893  cpl_plot_bivector(
894  "set grid;set xlabel 'Wavelength (nm)';set ylabel 'Emission';",
895  "t 'Catalog Spectrum' w impulses", "", subcat);
896  }
897  cpl_bivector_unwrap_vectors(subcat) ;
898  cpl_vector_delete(subcat_x) ;
899  cpl_vector_delete(subcat_y) ;
900 
901  return 0 ;
902 }
903 
906 /*----------------------------------------------------------------------------*/
921 /*----------------------------------------------------------------------------*/
922 static void irplib_wlxcorr_estimate(cpl_vector * vxc,
923  cpl_vector * model,
924  const cpl_vector * spectrum,
925  const cpl_bivector * lines_catalog,
926  const cpl_vector * conv_kernel,
927  const cpl_polynomial * poly_candi,
928  double slitw,
929  double fwhm)
930 {
931  cpl_errorstate prestate = cpl_errorstate_get();
932  const int hsize = cpl_vector_get_size(vxc) / 2;
933 
934  if (conv_kernel != NULL) {
935  irplib_wlcalib_fill_spectrum(model, lines_catalog, conv_kernel,
936  poly_candi, hsize);
937  } else {
938  const double xtrunc = 0.5 * slitw + 5.0 * fwhm * CPL_MATH_SIG_FWHM;
939 
940  irplib_vector_fill_line_spectrum_model(model, NULL, NULL, poly_candi,
941  lines_catalog, slitw, fwhm,
942  xtrunc, 0, CPL_FALSE, CPL_FALSE,
943  NULL);
944  }
945 
946  if (cpl_errorstate_is_equal(prestate))
947  cpl_vector_correlate(vxc, model, spectrum);
948 
949  if (!cpl_errorstate_is_equal(prestate)) {
950  cpl_vector_fill(vxc, 0.0);
951 
952  /* cpl_errorstate_dump(prestate, CPL_FALSE, NULL); */
953  cpl_errorstate_set(prestate);
954 
955  }
956 
957  return;
958 }
959 
960 
961 /*----------------------------------------------------------------------------*/
971 /*----------------------------------------------------------------------------*/
972 static cpl_boolean irplib_wlcalib_is_lines(const cpl_vector * wavelengths,
973  const cpl_polynomial * disp1d,
974  int spec_sz,
975  double tol)
976 {
977  const int nlines = cpl_vector_get_size(wavelengths);
978  /* The dispersion on the detector center */
979  const double dispersion = cpl_polynomial_eval_1d_diff(disp1d,
980  0.5 * spec_sz + 1.0,
981  0.5 * spec_sz,
982  NULL);
983  const double range = cpl_vector_get(wavelengths, nlines-1)
984  - cpl_vector_get(wavelengths, 0);
985 
986  cpl_ensure(wavelengths != NULL, CPL_ERROR_NULL_INPUT, CPL_FALSE);
987  cpl_ensure(disp1d != NULL, CPL_ERROR_NULL_INPUT, CPL_FALSE);
988  cpl_ensure(cpl_polynomial_get_dimension(disp1d) == 1,
989  CPL_ERROR_ILLEGAL_INPUT, CPL_FALSE);
990  cpl_ensure(range > 0.0, CPL_ERROR_ILLEGAL_INPUT, CPL_FALSE);
991 
992  return nlines * fabs(dispersion) <= tol * fabs(range) ? CPL_TRUE
993  : CPL_FALSE;
994 
995 }
996 
997 /*----------------------------------------------------------------------------*/
1012 /*----------------------------------------------------------------------------*/
1013 static
1014 cpl_error_code irplib_wlcalib_fill_spectrum(cpl_vector * self,
1015  const cpl_bivector * lines_catalog,
1016  const cpl_vector * conv_kernel,
1017  const cpl_polynomial * poly,
1018  int search_hs)
1019 {
1020 
1021 
1022  const int size = cpl_vector_get_size(self);
1023  const int nlines = cpl_bivector_get_size(lines_catalog);
1024  const cpl_vector * xlines = cpl_bivector_get_x_const(lines_catalog);
1025  const double * dxlines = cpl_vector_get_data_const(xlines);
1026  cpl_bivector * sub_cat ;
1027  cpl_vector * sub_cat_x;
1028  cpl_vector * sub_cat_y;
1029  cpl_vector * wl_limits;
1030  double wave_min, wave_max;
1031  int wave_min_id, wave_max_id;
1032  int nsub;
1033  int error;
1034 
1035  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
1036  cpl_ensure_code(lines_catalog != NULL, CPL_ERROR_NULL_INPUT);
1037  cpl_ensure_code(conv_kernel != NULL, CPL_ERROR_NULL_INPUT);
1038  cpl_ensure_code(poly != NULL, CPL_ERROR_NULL_INPUT);
1039  cpl_ensure_code(size > 0, CPL_ERROR_ILLEGAL_INPUT);
1040 
1041 
1042  /* Resample the spectrum */
1043  wl_limits = cpl_vector_new(size + 1);
1044  cpl_vector_fill_polynomial(wl_limits, poly, 0.5 - search_hs, 1);
1045 
1046  /* The spectrum wavelength bounds */
1047  wave_min = cpl_vector_get(wl_limits, 0);
1048  wave_max = cpl_vector_get(wl_limits, size);
1049 
1050  /* Find the 1st line */
1051  wave_min_id = cpl_vector_find(xlines, wave_min);
1052  /* The first line must be less than or equal to wave_min */
1053  if (dxlines[wave_min_id] > wave_min) wave_min_id--;
1054 
1055  if (wave_min_id < 0) {
1056  cpl_vector_delete(wl_limits);
1057  return cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
1058  __FILE__, __LINE__, "The %d-line "
1059  "catalogue only has lines above %g",
1060  nlines, wave_min);
1061  }
1062 
1063  /* Find the last line */
1064  wave_max_id = cpl_vector_find(xlines, wave_max);
1065  /* The last line must be greater than or equal to wave_max */
1066  if (dxlines[wave_max_id] < wave_max) wave_max_id++;
1067 
1068  if (wave_max_id == nlines) {
1069  cpl_vector_delete(wl_limits);
1070  return cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
1071  __FILE__, __LINE__, "The %d-line "
1072  "catalogue only has lines below %g",
1073  nlines, wave_max);
1074  }
1075 
1076  /* Checking the wavelength range at this point via the indices also
1077  verifies that they were not found using non-increasing wavelengths */
1078  nsub = 1 + wave_max_id - wave_min_id;
1079  cpl_ensure_code(nsub > 1, CPL_ERROR_ILLEGAL_INPUT);
1080 
1081  /* Wrap a new bivector around the relevant part of the catalog */
1082  /* The data is _not_ modified */
1083  sub_cat_x = cpl_vector_wrap(nsub, wave_min_id + (double*)dxlines);
1084  sub_cat_y = cpl_vector_wrap(nsub, wave_min_id + (double*)
1085  cpl_bivector_get_y_data_const(lines_catalog));
1086  sub_cat = cpl_bivector_wrap_vectors(sub_cat_x, sub_cat_y);
1087 
1088  /* High resolution catalog */
1089  error = irplib_wlxcorr_signal_resample(self, wl_limits, sub_cat);
1090 
1091  cpl_vector_delete(wl_limits);
1092  cpl_bivector_unwrap_vectors(sub_cat);
1093  (void)cpl_vector_unwrap(sub_cat_x);
1094  (void)cpl_vector_unwrap(sub_cat_y);
1095 
1096  cpl_ensure_code(!error, CPL_ERROR_ILLEGAL_INPUT);
1097 
1098  /* Smooth the instrument resolution */
1099  cpl_ensure_code(!irplib_wlxcorr_convolve(self, conv_kernel),
1100  cpl_error_get_code());
1101 
1102  return CPL_ERROR_NONE;
1103 }
1104 
1105 
1106 /*----------------------------------------------------------------------------*/
1116 /*----------------------------------------------------------------------------*/
1117 static int irplib_wlxcorr_signal_resample(
1118  cpl_vector * resampled,
1119  const cpl_vector * xbounds,
1120  const cpl_bivector * hires)
1121 {
1122  const int hrsize = cpl_bivector_get_size(hires);
1123  const cpl_vector* xhires ;
1124  const cpl_vector* yhires ;
1125  const double * pxhires ;
1126  const double * pyhires ;
1127  const double * pxbounds ;
1128  cpl_vector * ybounds ;
1129  cpl_bivector * boundary ;
1130  double * pybounds ;
1131  double * presampled ;
1132  int nsamples ;
1133  int i, itt ;
1134 
1135  /* Test entries */
1136  if ((!resampled) || (!xbounds) || (!hires)) return -1 ;
1137 
1138  /* Initialise */
1139  nsamples = cpl_vector_get_size(resampled) ;
1140 
1141  /* Initialise */
1142  presampled = cpl_vector_get_data(resampled) ;
1143  pxbounds = cpl_vector_get_data_const(xbounds) ;
1144  xhires = cpl_bivector_get_x_const(hires) ;
1145  yhires = cpl_bivector_get_y_const(hires) ;
1146  pxhires = cpl_vector_get_data_const(xhires) ;
1147  pyhires = cpl_vector_get_data_const(yhires) ;
1148 
1149  /* Create a new vector */
1150  ybounds = cpl_vector_new(cpl_vector_get_size(xbounds)) ;
1151  boundary = cpl_bivector_wrap_vectors((cpl_vector*)xbounds,ybounds) ;
1152  pybounds = cpl_vector_get_data(ybounds) ;
1153 
1154  /* Test entries */
1155  if (cpl_bivector_get_size(boundary) != nsamples + 1) {
1156  cpl_bivector_unwrap_vectors(boundary) ;
1157  cpl_vector_delete(ybounds) ;
1158  return -1 ;
1159  }
1160 
1161  /* Get the ind */
1162  itt = cpl_vector_find(xhires, pxbounds[0]);
1163 
1164  /* Interpolate the signal */
1165  if (cpl_bivector_interpolate_linear(boundary, hires)) {
1166  cpl_bivector_unwrap_vectors(boundary) ;
1167  cpl_vector_delete(ybounds) ;
1168  return -1 ;
1169  }
1170 
1171  /* At this point itt most likely points to element just below
1172  pxbounds[0] */
1173  while (pxhires[itt] < pxbounds[0]) itt++;
1174 
1175  for (i=0; i < nsamples; i++) {
1176  /* The i'th signal is the weighted average of the two interpolated
1177  signals at the pixel boundaries and those table signals in
1178  between */
1179 
1180  double xlow = pxbounds[i];
1181  double x = pxhires[itt];
1182 
1183  if (x > pxbounds[i+1]) x = pxbounds[i+1];
1184  /* Contribution from interpolated value at wavelength at lower pixel
1185  boundary */
1186  presampled[i] = pybounds[i] * (x - xlow);
1187 
1188  /* Contribution from table values in between pixel boundaries */
1189  while ((pxhires[itt] < pxbounds[i+1]) && (itt < hrsize)) {
1190  const double xprev = x;
1191  x = pxhires[itt+1];
1192  if (x > pxbounds[i+1]) x = pxbounds[i+1];
1193  presampled[i] += pyhires[itt] * (x - xlow);
1194  xlow = xprev;
1195  itt++;
1196  }
1197 
1198  /* Contribution from interpolated value at wavelength at upper pixel
1199  boundary */
1200  presampled[i] += pybounds[i+1] * (pxbounds[i+1] - xlow);
1201 
1202  /* Compute average by dividing integral by length of pixel range
1203  (the factor 2 comes from the contributions) */
1204  presampled[i] /= 2 * (pxbounds[i+1] - pxbounds[i]);
1205  }
1206  cpl_bivector_unwrap_vectors(boundary) ;
1207  cpl_vector_delete(ybounds) ;
1208  return 0 ;
1209 }
1210 
1211 
1212 
1213 /*----------------------------------------------------------------------------*/
1234 /*----------------------------------------------------------------------------*/
1235 static cpl_error_code cpl_vector_fill_lss_profile_symmetric(cpl_vector * self,
1236  double slitw,
1237  double fwhm)
1238 {
1239 
1240  const double sigma = fwhm * CPL_MATH_SIG_FWHM;
1241  const int n = cpl_vector_get_size(self);
1242  int i;
1243 
1244 
1245  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
1246  cpl_ensure_code(slitw > 0.0, CPL_ERROR_ILLEGAL_INPUT);
1247  cpl_ensure_code(fwhm > 0.0, CPL_ERROR_ILLEGAL_INPUT);
1248 
1249  /* Cannot fail now */
1250 
1251  /* Special case for i = 0 */
1252  (void)cpl_vector_set(self, 0,
1253  (irplib_erf_antideriv(0.5*slitw + 0.5, sigma) -
1254  irplib_erf_antideriv(0.5*slitw - 0.5, sigma)) / slitw);
1255 
1256  for (i = 1; i < n; i++) {
1257  /* FIXME: Reuse two irplib_erf_antideriv() calls from previous value */
1258  const double x1p = i + 0.5*slitw + 0.5;
1259  const double x1n = i - 0.5*slitw + 0.5;
1260  const double x0p = i + 0.5*slitw - 0.5;
1261  const double x0n = i - 0.5*slitw - 0.5;
1262  const double val = 0.5/slitw *
1263  (irplib_erf_antideriv(x1p, sigma) - irplib_erf_antideriv(x1n, sigma) -
1264  irplib_erf_antideriv(x0p, sigma) + irplib_erf_antideriv(x0n, sigma));
1265  (void)cpl_vector_set(self, i, val);
1266  }
1267 
1268  return CPL_ERROR_NONE;
1269 }
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.
double irplib_erf_antideriv(double x, double sigma)
The antiderivative of erx(x/sigma/sqrt(2)) with respect to x.