NACO Pipeline Reference Manual  4.4.0
irplib_wlxcorr.c
1 /* $Id: irplib_wlxcorr.c,v 1.58 2013-01-29 08:43:33 jtaylor Exp $
2  *
3  * This file is part of the IRPLIB package
4  * Copyright (C) 2002,2003 European Southern Observatory
5  *
6  * This program is free software; you can redistribute it and/or modify
7  * it under the terms of the GNU General Public License as published by
8  * the Free Software Foundation; either version 2 of the License, or
9  * (at your option) any later version.
10  *
11  * This program is distributed in the hope that it will be useful,
12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14  * GNU General Public License for more details.
15  *
16  * You should have received a copy of the GNU General Public License
17  * along with this program; if not, write to the Free Software
18  * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1307 USA
19  */
20 
21 /*
22  * $Author: jtaylor $
23  * $Date: 2013-01-29 08:43:33 $
24  * $Revision: 1.58 $
25  * $Name: not supported by cvs2svn $
26  */
27 
28 #ifdef HAVE_CONFIG_H
29 #include <config.h>
30 #endif
31 
32 /*-----------------------------------------------------------------------------
33  Includes
34  -----------------------------------------------------------------------------*/
35 
36 #include <math.h>
37 #include <string.h>
38 
39 #include <cpl.h>
40 
41 #include "irplib_wavecal_impl.h"
42 
43 #include "irplib_wlxcorr.h"
44 
45 /*----------------------------------------------------------------------------*/
55 /*----------------------------------------------------------------------------*/
56 
57 /*-----------------------------------------------------------------------------
58  Defines
59  -----------------------------------------------------------------------------*/
60 
61 /* TEMPORARY SUPPORT OF CPL 5.x */
62 #ifndef CPL_SIZE_FORMAT
63 #define CPL_SIZE_FORMAT "d"
64 #define cpl_size int
65 #endif
66 /* END TEMPORARY SUPPORT OF CPL 5.x */
67 
68 #ifndef inline
69 #define inline /* inline */
70 #endif
71 
72 #define IRPLIB_MAX(A,B) ((A) > (B) ? (A) : (B))
73 #define IRPLIB_MIN(A,B) ((A) < (B) ? (A) : (B))
74 
75 #define IRPLIB_PTR_SWAP(a,b) \
76  do { void * irplib_ptr_swap =(a);(a)=(b);(b)=irplib_ptr_swap; } while (0)
77 
78 /*-----------------------------------------------------------------------------
79  Private functions
80  -----------------------------------------------------------------------------*/
81 
82 static void irplib_wlxcorr_estimate(cpl_vector *, cpl_vector *,
83  const cpl_vector *,
84  const cpl_bivector *,
85  const cpl_vector *,
86  const cpl_polynomial *,
87  double, double);
88 
89 static int irplib_wlxcorr_signal_resample(cpl_vector *, const cpl_vector *,
90  const cpl_bivector *) ;
91 static cpl_error_code cpl_vector_fill_lss_profile_symmetric(cpl_vector *,
92  double, double);
93 static cpl_error_code irplib_wlcalib_fill_spectrum(cpl_vector *,
94  const cpl_bivector *,
95  const cpl_vector *,
96  const cpl_polynomial *, int);
97 
98 static cpl_boolean irplib_wlcalib_is_lines(const cpl_vector *,
99  const cpl_polynomial *,
100  int, double);
101 
105 /*----------------------------------------------------------------------------*/
141 /*----------------------------------------------------------------------------*/
142 cpl_polynomial * irplib_wlxcorr_best_poly(const cpl_vector * spectrum,
143  const cpl_bivector * lines_catalog,
144  int degree,
145  const cpl_polynomial * guess_poly,
146  const cpl_vector * wl_error,
147  int nsamples,
148  double slitw,
149  double fwhm,
150  double * xc,
151  cpl_table ** wlres,
152  cpl_vector ** xcorrs)
153 {
154  const int spec_sz = cpl_vector_get_size(spectrum);
155  const int nfree = cpl_vector_get_size(wl_error);
156  int ntests = 1;
157  cpl_vector * model;
158  cpl_vector * vxc;
159  cpl_vector * init_pts_wl;
160  cpl_matrix * init_pts_x;
161  cpl_vector * pts_wl;
162  cpl_vector * vxcorrs;
163  cpl_vector * conv_kernel = NULL;
164  cpl_polynomial * poly_sol;
165  cpl_polynomial * poly_candi;
166  const double * pwl_error = cpl_vector_get_data_const(wl_error);
167  const double * dxc;
168  cpl_size degree_loc ;
169  const cpl_boolean symsamp = CPL_TRUE; /* init_pts_x is symmetric */
170  const cpl_boolean is_lines
171  = irplib_wlcalib_is_lines(cpl_bivector_get_x_const(lines_catalog),
172  guess_poly, spec_sz, 1.0);
173  int i;
174 
175  /* FIXME: Need mode parameter for catalogue type (lines <=> profile) */
176 
177  /* In case of failure */
178  if (wlres != NULL) *wlres = NULL;
179  if (xcorrs != NULL) *xcorrs = NULL;
180 
181  /* Useful for knowing if resampling is used */
182  cpl_msg_debug(cpl_func, "Checking %d^%d dispersion polynomials (slitw=%g, "
183  "fwhm=%g) against %d-point observed spectrum with%s "
184  "catalog resampling", nsamples, nfree, slitw, fwhm, spec_sz,
185  is_lines ? "out" : "");
186 
187  cpl_ensure(xc != NULL, CPL_ERROR_NULL_INPUT, NULL);
188  *xc = -1.0;
189  cpl_ensure(spectrum != NULL, CPL_ERROR_NULL_INPUT, NULL);
190  cpl_ensure(lines_catalog != NULL, CPL_ERROR_NULL_INPUT, NULL);
191  cpl_ensure(guess_poly != NULL, CPL_ERROR_NULL_INPUT, NULL);
192  cpl_ensure(wl_error != NULL, CPL_ERROR_NULL_INPUT, NULL);
193  cpl_ensure(nfree >= 2, CPL_ERROR_ILLEGAL_INPUT, NULL);
194  cpl_ensure(nsamples > 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
195  /* FIXME: degree is redundant */
196  cpl_ensure(1 + degree == nfree, CPL_ERROR_ILLEGAL_INPUT, NULL);
197 
198  cpl_ensure(cpl_polynomial_get_dimension(guess_poly) == 1,
199  CPL_ERROR_ILLEGAL_INPUT, NULL);
200 
201  if (nsamples > 1) {
202  /* Search place must consist of more than one point */
203  /* FIXME: The bounds should probably not be negative */
204  for (i = 0; i < nfree; i++) {
205  if (pwl_error[i] != 0.0) break;
206  }
207  cpl_ensure(i < nfree, CPL_ERROR_ILLEGAL_INPUT, NULL);
208  }
209 
210  if (!is_lines) {
211  /* Create the convolution kernel */
212  conv_kernel = irplib_wlxcorr_convolve_create_kernel(slitw, fwhm);
213  cpl_ensure(conv_kernel != NULL, CPL_ERROR_ILLEGAL_INPUT, NULL);
214  }
215 
216  /* Create initial test points */
217  init_pts_x = cpl_matrix_new(1, nfree);
218  init_pts_wl = cpl_vector_new(nfree);
219  pts_wl = cpl_vector_new(nfree);
220  for (i = 0; i < nfree; i++) {
221  const double xpos = spec_sz * i / (double)degree;
222  const double wlpos = cpl_polynomial_eval_1d(guess_poly, xpos, NULL)
223  - 0.5 * pwl_error[i];
224 
225  cpl_matrix_set(init_pts_x, 0, i, xpos);
226  cpl_vector_set(init_pts_wl, i, wlpos);
227 
228  ntests *= nsamples; /* Count number of tests */
229 
230  }
231 
232  vxcorrs = xcorrs != NULL ? cpl_vector_new(ntests) : NULL;
233 
234  poly_sol = cpl_polynomial_new(1);
235  poly_candi = cpl_polynomial_new(1);
236  model = cpl_vector_new(spec_sz);
237  vxc = cpl_vector_new(1);
238  dxc = cpl_vector_get_data_const(vxc);
239 
240  /* Create the polynomial candidates and estimate them */
241  for (i=0; i < ntests; i++) {
242  int idiv = i;
243  int deg;
244 
245  /* Update wavelength at one anchor point - and reset wavelengths
246  to their default for any anchor point(s) at higher wavelengths */
247  for (deg = degree; deg >= 0; deg--, idiv /= nsamples) {
248  const int imod = idiv % nsamples;
249  const double wlpos = cpl_vector_get(init_pts_wl, deg)
250  + imod * pwl_error[deg] / nsamples;
251 
252  /* FIXME: If wlpos causes pts_wl to be non-increasing, the
253  solution will be non-physical with no need for evaluation.
254  (*xc could be set to -1 in this case). */
255  cpl_vector_set(pts_wl, deg, wlpos);
256 
257  if (imod > 0) break;
258  }
259 
260  /* Generate */
261  degree_loc = (cpl_size)degree ;
262  cpl_polynomial_fit(poly_candi, init_pts_x, &symsamp, pts_wl,
263  NULL, CPL_FALSE, NULL, &degree_loc);
264  /* *** Estimate *** */
265  irplib_wlxcorr_estimate(vxc, model, spectrum, lines_catalog,
266  conv_kernel, poly_candi, slitw, fwhm);
267  if (vxcorrs != NULL) cpl_vector_set(vxcorrs, i, *dxc);
268  if (*dxc > *xc) {
269  /* Found a better solution */
270  *xc = *dxc;
271  IRPLIB_PTR_SWAP(poly_sol, poly_candi);
272  }
273  }
274 
275  cpl_vector_delete(model);
276  cpl_vector_delete(vxc);
277  cpl_vector_delete(conv_kernel);
278  cpl_vector_delete(pts_wl);
279  cpl_matrix_delete(init_pts_x);
280  cpl_vector_delete(init_pts_wl);
281  cpl_polynomial_delete(poly_candi);
282 
283 #ifdef CPL_WLCALIB_FAIL_ON_CONSTANT
284  /* FIXME: */
285  if (cpl_polynomial_get_degree(poly_sol) == 0) {
286  cpl_polynomial_delete(poly_sol);
287  cpl_vector_delete(vxcorrs);
288  *xc = 0.0;
289  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT,
290  __FILE__, __LINE__, "Found a constant "
291  "dispersion");
292  cpl_errorstate_dump(prestate, CPL_FALSE, NULL);
293  return NULL;
294  }
295 #endif
296 
297  if (wlres != NULL) {
298  /* FIXME: A failure in the table creation is not considered a failure
299  of the whole function call (although all outputs may be useless) */
300 
301  cpl_errorstate prestate = cpl_errorstate_get();
302  /* Create the spc_table */
303  *wlres = irplib_wlxcorr_gen_spc_table(spectrum, lines_catalog, slitw,
304  fwhm, guess_poly, poly_sol);
305  if (*wlres == NULL) {
306  cpl_polynomial_delete(poly_sol);
307  cpl_vector_delete(vxcorrs);
308  *xc = -1.0;
309  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT,
310  __FILE__, __LINE__, "Cannot generate "
311  "infos table");
312  /* cpl_errorstate_dump(prestate, CPL_FALSE, NULL); */
313  cpl_errorstate_set(prestate);
314  return NULL;
315  }
316  }
317 
318  if (xcorrs != NULL) {
319  *xcorrs = vxcorrs;
320  } else {
321  /* assert(vxcorrs == NULL); */
322  }
323 
324  return poly_sol;
325 }
326 
327 /*----------------------------------------------------------------------------*/
345 /*----------------------------------------------------------------------------*/
346 cpl_table * irplib_wlxcorr_gen_spc_table(
347  const cpl_vector * spectrum,
348  const cpl_bivector * lines_catalog,
349  double slitw,
350  double fwhm,
351  const cpl_polynomial * guess_poly,
352  const cpl_polynomial * corr_poly)
353 {
354 
355  cpl_vector * conv_kernel = NULL;
356  cpl_bivector * gen_init ;
357  cpl_bivector * gen_corr ;
358  cpl_table * spc_table ;
359  const double * pgen ;
360  const double xtrunc = 0.5 * slitw + 5.0 * fwhm * CPL_MATH_SIG_FWHM;
361  const int spec_sz = cpl_vector_get_size(spectrum);
362  const cpl_boolean guess_resamp
363  = !irplib_wlcalib_is_lines(cpl_bivector_get_x_const(lines_catalog),
364  guess_poly, spec_sz, 1.0);
365  const cpl_boolean corr_resamp
366  = !irplib_wlcalib_is_lines(cpl_bivector_get_x_const(lines_catalog),
367  corr_poly, spec_sz, 1.0);
368  cpl_error_code error;
369 
370  cpl_msg_debug(cpl_func, "Tabel for guess dispersion polynomial (slitw=%g, "
371  "fwhm=%g) with %d-point observed spectrum with%s catalog re"
372  "sampling", slitw, fwhm, spec_sz, guess_resamp ? "out" : "");
373  cpl_msg_debug(cpl_func, "Tabel for corr. dispersion polynomial (slitw=%g, "
374  "fwhm=%g) with %d-point observed spectrum with%s catalog re"
375  "sampling", slitw, fwhm, spec_sz, corr_resamp ? "out" : "");
376 
377  /* Test inputs */
378  cpl_ensure(spectrum, CPL_ERROR_NULL_INPUT, NULL) ;
379  cpl_ensure(lines_catalog, CPL_ERROR_NULL_INPUT, NULL) ;
380  cpl_ensure(guess_poly, CPL_ERROR_NULL_INPUT, NULL) ;
381  cpl_ensure(corr_poly, CPL_ERROR_NULL_INPUT, NULL) ;
382 
383  /* Create the convolution kernel */
384  if (guess_resamp || corr_resamp) {
385  conv_kernel = irplib_wlxcorr_convolve_create_kernel(slitw, fwhm);
386 
387  if (conv_kernel == NULL) {
388  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
389  __FILE__, __LINE__, "Cannot create "
390  "convolution kernel") ;
391  return NULL ;
392  }
393  }
394 
395  /* Get the emission at initial wavelengths */
396  gen_init = cpl_bivector_new(spec_sz);
397  if (guess_resamp) {
398  error = irplib_wlcalib_fill_spectrum(cpl_bivector_get_y(gen_init),
399  lines_catalog, conv_kernel,
400  guess_poly, 0);
401  } else {
403  (cpl_bivector_get_y(gen_init), NULL, NULL,
404  guess_poly, lines_catalog,
405  slitw, fwhm, xtrunc, 0, CPL_FALSE, CPL_FALSE, NULL);
406  }
407 
408  if (error || cpl_vector_fill_polynomial(cpl_bivector_get_x(gen_init),
409  guess_poly, 1, 1)) {
410  cpl_vector_delete(conv_kernel);
411  cpl_bivector_delete(gen_init);
412  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
413  __FILE__, __LINE__, "Cannot get the "
414  "emission spectrum");
415  return NULL;
416  }
417 
418  /* Get the emission at corrected wavelengths */
419  gen_corr = cpl_bivector_new(spec_sz);
420  if (corr_resamp) {
421  error = irplib_wlcalib_fill_spectrum(cpl_bivector_get_y(gen_corr),
422  lines_catalog, conv_kernel,
423  corr_poly, 0);
424  } else {
426  (cpl_bivector_get_y(gen_corr), NULL, NULL,
427  corr_poly, lines_catalog,
428  slitw, fwhm, xtrunc, 0, CPL_FALSE, CPL_FALSE, NULL);
429  }
430 
431  if (error || cpl_vector_fill_polynomial(cpl_bivector_get_x(gen_corr),
432  corr_poly, 1, 1)) {
433  cpl_vector_delete(conv_kernel);
434  cpl_bivector_delete(gen_init);
435  cpl_bivector_delete(gen_corr) ;
436  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
437  __FILE__, __LINE__, "Cannot get the "
438  "emission spectrum");
439  return NULL;
440  }
441  cpl_vector_delete(conv_kernel) ;
442 
443  /* Create the ouput table */
444  spc_table = cpl_table_new(spec_sz);
445  cpl_table_new_column(spc_table, IRPLIB_WLXCORR_COL_WAVELENGTH,
446  CPL_TYPE_DOUBLE);
447  cpl_table_new_column(spc_table, IRPLIB_WLXCORR_COL_CAT_INIT,
448  CPL_TYPE_DOUBLE);
449  cpl_table_new_column(spc_table, IRPLIB_WLXCORR_COL_CAT_FINAL,
450  CPL_TYPE_DOUBLE);
451  cpl_table_new_column(spc_table, IRPLIB_WLXCORR_COL_OBS, CPL_TYPE_DOUBLE);
452 
453  /* Update table */
454  pgen = cpl_bivector_get_x_data_const(gen_corr) ;
455  cpl_table_copy_data_double(spc_table, IRPLIB_WLXCORR_COL_WAVELENGTH, pgen) ;
456  pgen = cpl_bivector_get_y_data_const(gen_corr) ;
457  cpl_table_copy_data_double(spc_table, IRPLIB_WLXCORR_COL_CAT_FINAL, pgen) ;
458  pgen = cpl_vector_get_data_const(spectrum) ;
459  cpl_table_copy_data_double(spc_table, IRPLIB_WLXCORR_COL_OBS, pgen) ;
460  pgen = cpl_bivector_get_y_data_const(gen_init) ;
461  cpl_table_copy_data_double(spc_table, IRPLIB_WLXCORR_COL_CAT_INIT, pgen);
462  cpl_bivector_delete(gen_init);
463  cpl_bivector_delete(gen_corr);
464 
465  return spc_table ;
466 }
467 
468 /*----------------------------------------------------------------------------*/
480 /*----------------------------------------------------------------------------*/
481 cpl_bivector * irplib_wlxcorr_cat_extract(
482  const cpl_bivector * lines_catalog,
483  double wave_min,
484  double wave_max)
485 {
486  const int nlines = cpl_bivector_get_size(lines_catalog);
487  int wave_min_id, wave_max_id ;
488  cpl_vector * sub_cat_wl ;
489  cpl_vector * sub_cat_int ;
490  const cpl_vector * xlines = cpl_bivector_get_x_const(lines_catalog);
491  const double * dxlines = cpl_vector_get_data_const(xlines);
492 
493  cpl_ensure(lines_catalog != NULL, CPL_ERROR_NULL_INPUT, NULL);
494 
495  /* Find the 1st line */
496  wave_min_id = (int)cpl_vector_find(xlines, wave_min);
497  if (wave_min_id < 0) {
498  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
499  __FILE__, __LINE__,
500  "The starting wavelength cannot be found") ;
501  return NULL ;
502  }
503 
504  /* The first line must be greater than (at least?) wave_min */
505  if (dxlines[wave_min_id] <= wave_min) wave_min_id++;
506 
507  /* Find the last line */
508  wave_max_id = (int)cpl_vector_find(xlines, wave_max);
509  if (wave_max_id < 0) {
510  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
511  __FILE__, __LINE__,
512  "The ending wavelength cannot be found") ;
513  return NULL ;
514  }
515  /* The last line must be less than wave_max */
516  if (dxlines[wave_max_id] >= wave_min) wave_max_id--;
517 
518  /* Checking the wavelength range at this point via the indices also
519  verifies that they were not found using non-increasing wavelengths */
520  cpl_ensure(wave_min_id <= wave_max_id, CPL_ERROR_ILLEGAL_INPUT, NULL);
521 
522  if (wave_min_id < 0 || wave_max_id == nlines) {
523  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
524  __FILE__, __LINE__, "The %d-line catalogue "
525  "has no lines in the range %g -> %g",
526  nlines, wave_min, wave_max);
527  return NULL ;
528  }
529 
530  sub_cat_wl = cpl_vector_extract(xlines, wave_min_id, wave_max_id, 1);
531  sub_cat_int = cpl_vector_extract(cpl_bivector_get_y_const(lines_catalog),
532  wave_min_id, wave_max_id, 1);
533 
534  return cpl_bivector_wrap_vectors(sub_cat_wl, sub_cat_int);
535 }
536 
537 /*----------------------------------------------------------------------------*/
554 /*----------------------------------------------------------------------------*/
555 cpl_vector * irplib_wlxcorr_convolve_create_kernel(double slitw,
556  double fwhm)
557 {
558  const double sigma = fwhm * CPL_MATH_SIG_FWHM;
559  const int size = 1 + (int)(5.0 * sigma + 0.5*slitw);
560  cpl_vector * kernel = cpl_vector_new(size);
561 
562 
563  if (cpl_vector_fill_lss_profile_symmetric(kernel, slitw, fwhm)) {
564  cpl_vector_delete(kernel);
565  cpl_ensure(0, cpl_error_get_code(), NULL);
566  }
567 
568  return kernel;
569 }
570 
571 /*----------------------------------------------------------------------------*/
584 /*----------------------------------------------------------------------------*/
585 int irplib_wlxcorr_convolve(
586  cpl_vector * smoothed,
587  const cpl_vector * conv_kernel)
588 {
589  int nsamples ;
590  int ihwidth ;
591  cpl_vector * raw ;
592  double * psmoothe ;
593  double * praw ;
594  const double* psymm ;
595  int i, j ;
596 
597  /* Test entries */
598  cpl_ensure(smoothed, CPL_ERROR_NULL_INPUT, -1) ;
599  cpl_ensure(conv_kernel, CPL_ERROR_NULL_INPUT, -1) ;
600 
601  /* Initialise */
602  nsamples = cpl_vector_get_size(smoothed) ;
603  ihwidth = cpl_vector_get_size(conv_kernel) - 1 ;
604  cpl_ensure(ihwidth<nsamples, CPL_ERROR_ILLEGAL_INPUT, -1) ;
605  psymm = cpl_vector_get_data_const(conv_kernel) ;
606  psmoothe = cpl_vector_get_data(smoothed) ;
607 
608  /* Create raw vector */
609  raw = cpl_vector_duplicate(smoothed) ;
610  praw = cpl_vector_get_data(raw) ;
611 
612  /* Convolve with the symmetric function */
613  for (i=0 ; i<ihwidth ; i++) {
614  psmoothe[i] = praw[i] * psymm[0];
615  for (j=1 ; j <= ihwidth ; j++) {
616  const int k = i-j < 0 ? 0 : i-j;
617  psmoothe[i] += (praw[k]+praw[i+j]) * psymm[j];
618  }
619  }
620 
621  for (i=ihwidth ; i<nsamples-ihwidth ; i++) {
622  psmoothe[i] = praw[i] * psymm[0];
623  for (j=1 ; j<=ihwidth ; j++)
624  psmoothe[i] += (praw[i-j]+praw[i+j]) * psymm[j];
625  }
626  for (i=nsamples-ihwidth ; i<nsamples ; i++) {
627  psmoothe[i] = praw[i] * psymm[0];
628  for (j=1 ; j<=ihwidth ; j++) {
629  const int k = i+j > nsamples-1 ? nsamples - 1 : i+j;
630  psmoothe[i] += (praw[k]+praw[i-j]) * psymm[j];
631  }
632  }
633  cpl_vector_delete(raw) ;
634  return 0 ;
635 }
636 
637 /*----------------------------------------------------------------------------*/
647 /*----------------------------------------------------------------------------*/
648 int irplib_wlxcorr_plot_solution(
649  const cpl_polynomial * init,
650  const cpl_polynomial * comp,
651  const cpl_polynomial * sol,
652  int pix_start,
653  int pix_stop)
654 {
655  int nsamples, nplots ;
656  cpl_vector ** vectors ;
657  cpl_bivector * bivector ;
658  double diff ;
659  int i ;
660 
661  /* Test entries */
662  if (init == NULL || comp == NULL) return -1 ;
663 
664  /* Initialise */
665  nsamples = pix_stop - pix_start + 1 ;
666  if (sol != NULL) nplots = 3 ;
667  else nplots = 2 ;
668 
669  /* Create vectors */
670  vectors = cpl_malloc((nplots+1)*sizeof(cpl_vector*)) ;
671  for (i=0 ; i<nplots+1 ; i++) vectors[i] = cpl_vector_new(nsamples) ;
672 
673  /* First plot with the lambda/pixel relation */
674  /* Fill vectors */
675  for (i=0 ; i<nsamples ; i++) {
676  cpl_vector_set(vectors[0], i, pix_start+i) ;
677  cpl_vector_set(vectors[1], i,
678  cpl_polynomial_eval_1d(init, (double)(pix_start+i), NULL)) ;
679  cpl_vector_set(vectors[2], i,
680  cpl_polynomial_eval_1d(comp, (double)(pix_start+i), NULL)) ;
681  if (sol != NULL)
682  cpl_vector_set(vectors[3], i,
683  cpl_polynomial_eval_1d(sol, (double)(pix_start+i), NULL)) ;
684  }
685 
686  /* Plot */
687  cpl_plot_vectors("set grid;set xlabel 'Position (pixels)';",
688  "t '1-Initial / 2-Computed / 3-Solution' w lines",
689  "", (const cpl_vector **)vectors, nplots+1);
690 
691  /* Free vectors */
692  for (i=0 ; i<nplots+1 ; i++) cpl_vector_delete(vectors[i]) ;
693  cpl_free(vectors) ;
694 
695  /* Allocate vectors */
696  nplots -- ;
697  vectors = cpl_malloc((nplots+1)*sizeof(cpl_vector*)) ;
698  for (i=0 ; i<nplots+1 ; i++) vectors[i] = cpl_vector_new(nsamples) ;
699 
700  /* Second plot with the delta-lambda/pixel relation */
701  /* Fill vectors */
702  for (i=0 ; i<nsamples ; i++) {
703  cpl_vector_set(vectors[0], i, pix_start+i) ;
704  diff = cpl_polynomial_eval_1d(comp, (double)(pix_start+i), NULL) -
705  cpl_polynomial_eval_1d(init, (double)(pix_start+i), NULL) ;
706  cpl_vector_set(vectors[1], i, diff) ;
707  if (sol != NULL) {
708  diff = cpl_polynomial_eval_1d(sol, (double)(pix_start+i), NULL) -
709  cpl_polynomial_eval_1d(init, (double)(pix_start+i), NULL) ;
710  cpl_vector_set(vectors[2], i, diff) ;
711  }
712  }
713 
714  /* Plot */
715  if (sol == NULL) {
716  bivector = cpl_bivector_wrap_vectors(vectors[0], vectors[1]) ;
717  cpl_plot_bivector(
718 "set grid;set xlabel 'Position (pixels)';set ylabel 'Wavelength difference';",
719  "t 'Computed-Initial wavelenth' w lines", "", bivector);
720  cpl_bivector_unwrap_vectors(bivector) ;
721  } else {
722  cpl_plot_vectors("set grid;set xlabel 'Position (pixels)';",
723  "t '1-Computed - Initial / 2--Solution - Initial' w lines",
724  "", (const cpl_vector **)vectors, nplots+1);
725  }
726 
727  /* Free vectors */
728  for (i=0 ; i<nplots+1 ; i++) cpl_vector_delete(vectors[i]) ;
729  cpl_free(vectors) ;
730 
731  /* Return */
732  return 0 ;
733 }
734 
735 /*----------------------------------------------------------------------------*/
746 /*----------------------------------------------------------------------------*/
747 int irplib_wlxcorr_plot_spc_table(
748  const cpl_table * spc_table,
749  const char * title,
750  int first_plotted_line,
751  int last_plotted_line)
752 {
753  char title_loc[1024] ;
754  cpl_vector ** vectors ;
755  cpl_vector ** sub_vectors ;
756  cpl_vector * tmp_vec ;
757  int nsamples ;
758  double max, mean1, mean3 ;
759  int start_ind, stop_ind, hsize_pix ;
760  int i, j ;
761 
762  /* Test entries */
763  if (first_plotted_line > last_plotted_line) return -1 ;
764  if (spc_table == NULL) return -1 ;
765 
766  /* Initialise */
767  nsamples = cpl_table_get_nrow(spc_table) ;
768  hsize_pix = 10 ;
769 
770  sprintf(title_loc,
771  "t '%s - 1-Initial catalog/2-Corrected catalog/3-Observed' w lines",
772  title) ;
773  title_loc[1023] = (char)0 ;
774 
775  vectors = cpl_malloc(4*sizeof(cpl_vector*)) ;
776  vectors[0] = cpl_vector_wrap(nsamples,
777  cpl_table_get_data_double((cpl_table*)spc_table,
778  IRPLIB_WLXCORR_COL_WAVELENGTH));
779  vectors[1] = cpl_vector_wrap(nsamples,
780  cpl_table_get_data_double((cpl_table*)spc_table,
781  IRPLIB_WLXCORR_COL_CAT_INIT));
782  vectors[2] = cpl_vector_wrap(nsamples,
783  cpl_table_get_data_double((cpl_table*)spc_table,
784  IRPLIB_WLXCORR_COL_CAT_FINAL));
785  vectors[3] = cpl_vector_wrap(nsamples,
786  cpl_table_get_data_double((cpl_table*)spc_table,
787  IRPLIB_WLXCORR_COL_OBS)) ;
788 
789  /* Scale the signal for a bettre display */
790  mean1 = cpl_vector_get_mean(vectors[1]) ;
791  mean3 = cpl_vector_get_mean(vectors[3]) ;
792  if (fabs(mean3) > 1)
793  cpl_vector_multiply_scalar(vectors[3], fabs(mean1/mean3)) ;
794 
795  cpl_plot_vectors("set grid;set xlabel 'Wavelength (nm)';", title_loc,
796  "", (const cpl_vector **)vectors, 4);
797 
798  /* Unscale the signal */
799  if (fabs(mean3) > 1)
800  cpl_vector_multiply_scalar(vectors[3], mean3/mean1) ;
801 
802  /* Loop on the brightest lines and zoom on them */
803  sprintf(title_loc,
804 "t '%s - 1-Initial catalog/2-Corrected catalog/3-Observed (ZOOMED)' w lines",
805  title) ;
806  title_loc[1023] = (char)0 ;
807  tmp_vec = cpl_vector_duplicate(vectors[2]) ;
808  for (i=0 ; i<last_plotted_line ; i++) {
809  /* Find the brightest line */
810  if ((max = cpl_vector_get_max(tmp_vec)) <= 0.0) break ;
811  for (j=0 ; j<nsamples ; j++) {
812  if (cpl_vector_get(tmp_vec, j) == max) break ;
813  }
814  if (j-hsize_pix < 0) start_ind = 0 ;
815  else start_ind = j-hsize_pix ;
816  if (j+hsize_pix > nsamples-1) stop_ind = nsamples-1 ;
817  else stop_ind = j+hsize_pix ;
818  for (j=start_ind ; j<=stop_ind ; j++) cpl_vector_set(tmp_vec, j, 0.0) ;
819 
820  if (i+1 >= first_plotted_line) {
821  sub_vectors = cpl_malloc(4*sizeof(cpl_vector*)) ;
822  sub_vectors[0]=cpl_vector_extract(vectors[0],start_ind,stop_ind,1);
823  sub_vectors[1]=cpl_vector_extract(vectors[1],start_ind,stop_ind,1);
824  sub_vectors[2]=cpl_vector_extract(vectors[2],start_ind,stop_ind,1);
825  sub_vectors[3]=cpl_vector_extract(vectors[3],start_ind,stop_ind,1);
826 
827  cpl_plot_vectors("set grid;set xlabel 'Wavelength (nm)';",
828  title_loc, "", (const cpl_vector **)sub_vectors, 4);
829 
830  cpl_vector_delete(sub_vectors[0]) ;
831  cpl_vector_delete(sub_vectors[1]) ;
832  cpl_vector_delete(sub_vectors[2]) ;
833  cpl_vector_delete(sub_vectors[3]) ;
834  cpl_free(sub_vectors) ;
835  }
836  }
837  cpl_vector_delete(tmp_vec) ;
838 
839  cpl_vector_unwrap(vectors[0]) ;
840  cpl_vector_unwrap(vectors[1]) ;
841  cpl_vector_unwrap(vectors[2]) ;
842  cpl_vector_unwrap(vectors[3]) ;
843  cpl_free(vectors) ;
844 
845  return 0 ;
846 }
847 
848 /*----------------------------------------------------------------------------*/
856 /*----------------------------------------------------------------------------*/
857 int irplib_wlxcorr_catalog_plot(
858  const cpl_bivector * cat,
859  double wmin,
860  double wmax)
861 {
862  int start, stop ;
863  cpl_bivector * subcat ;
864  cpl_vector * subcat_x ;
865  cpl_vector * subcat_y ;
866  const double * pwave ;
867  int nvals, nvals_tot ;
868  int i ;
869 
870  /* Test entries */
871  if (cat == NULL) return -1 ;
872  if (wmax <= wmin) return -1 ;
873 
874  /* Initialise */
875  nvals_tot = cpl_bivector_get_size(cat) ;
876 
877  /* Count the nb of values */
878  pwave = cpl_bivector_get_x_data_const(cat) ;
879  if (pwave[0] >= wmin) start = 0 ;
880  else start = -1 ;
881  if (pwave[nvals_tot-1] <= wmax) stop = nvals_tot-1 ;
882  else stop = -1 ;
883  i=0 ;
884  while ((pwave[i] < wmin) && (i<nvals_tot-1)) i++ ;
885  start = i ;
886  i= nvals_tot-1 ;
887  while ((pwave[i] > wmax) && (i>0)) i-- ;
888  stop = i ;
889 
890  if (start>=stop) {
891  cpl_msg_error(cpl_func, "Cannot plot the catalog") ;
892  return -1 ;
893  }
894  nvals = stop - start + 1 ;
895 
896  /* Create the bivector to plot */
897  subcat_x = cpl_vector_extract(cpl_bivector_get_x_const(cat),start,stop, 1) ;
898  subcat_y = cpl_vector_extract(cpl_bivector_get_y_const(cat),start,stop, 1) ;
899  subcat = cpl_bivector_wrap_vectors(subcat_x, subcat_y) ;
900 
901  /* Plot */
902  if (nvals > 500) {
903  cpl_plot_bivector(
904  "set grid;set xlabel 'Wavelength (nm)';set ylabel 'Emission';",
905  "t 'Catalog Spectrum' w lines", "", subcat);
906  } else {
907  cpl_plot_bivector(
908  "set grid;set xlabel 'Wavelength (nm)';set ylabel 'Emission';",
909  "t 'Catalog Spectrum' w impulses", "", subcat);
910  }
911  cpl_bivector_unwrap_vectors(subcat) ;
912  cpl_vector_delete(subcat_x) ;
913  cpl_vector_delete(subcat_y) ;
914 
915  return 0 ;
916 }
917 
920 /*----------------------------------------------------------------------------*/
935 /*----------------------------------------------------------------------------*/
936 static void irplib_wlxcorr_estimate(cpl_vector * vxc,
937  cpl_vector * model,
938  const cpl_vector * spectrum,
939  const cpl_bivector * lines_catalog,
940  const cpl_vector * conv_kernel,
941  const cpl_polynomial * poly_candi,
942  double slitw,
943  double fwhm)
944 {
945  cpl_errorstate prestate = cpl_errorstate_get();
946  const int hsize = cpl_vector_get_size(vxc) / 2;
947 
948  if (conv_kernel != NULL) {
949  irplib_wlcalib_fill_spectrum(model, lines_catalog, conv_kernel,
950  poly_candi, hsize);
951  } else {
952  const double xtrunc = 0.5 * slitw + 5.0 * fwhm * CPL_MATH_SIG_FWHM;
953 
954  irplib_vector_fill_line_spectrum_model(model, NULL, NULL, poly_candi,
955  lines_catalog, slitw, fwhm,
956  xtrunc, 0, CPL_FALSE, CPL_FALSE,
957  NULL);
958  }
959 
960  if (cpl_errorstate_is_equal(prestate))
961  cpl_vector_correlate(vxc, model, spectrum);
962 
963  if (!cpl_errorstate_is_equal(prestate)) {
964  cpl_vector_fill(vxc, 0.0);
965 
966  /* cpl_errorstate_dump(prestate, CPL_FALSE, NULL); */
967  cpl_errorstate_set(prestate);
968 
969  }
970 
971  return;
972 }
973 
974 
975 /*----------------------------------------------------------------------------*/
985 /*----------------------------------------------------------------------------*/
986 static cpl_boolean irplib_wlcalib_is_lines(const cpl_vector * wavelengths,
987  const cpl_polynomial * disp1d,
988  int spec_sz,
989  double tol)
990 {
991  const int nlines = cpl_vector_get_size(wavelengths);
992  /* The dispersion on the detector center */
993  const double dispersion = cpl_polynomial_eval_1d_diff(disp1d,
994  0.5 * spec_sz + 1.0,
995  0.5 * spec_sz,
996  NULL);
997  const double range = cpl_vector_get(wavelengths, nlines-1)
998  - cpl_vector_get(wavelengths, 0);
999 
1000  cpl_ensure(wavelengths != NULL, CPL_ERROR_NULL_INPUT, CPL_FALSE);
1001  cpl_ensure(disp1d != NULL, CPL_ERROR_NULL_INPUT, CPL_FALSE);
1002  cpl_ensure(cpl_polynomial_get_dimension(disp1d) == 1,
1003  CPL_ERROR_ILLEGAL_INPUT, CPL_FALSE);
1004  cpl_ensure(range > 0.0, CPL_ERROR_ILLEGAL_INPUT, CPL_FALSE);
1005 
1006  return nlines * fabs(dispersion) <= tol * fabs(range) ? CPL_TRUE
1007  : CPL_FALSE;
1008 
1009 }
1010 
1011 /*----------------------------------------------------------------------------*/
1026 /*----------------------------------------------------------------------------*/
1027 static
1028 cpl_error_code irplib_wlcalib_fill_spectrum(cpl_vector * self,
1029  const cpl_bivector * lines_catalog,
1030  const cpl_vector * conv_kernel,
1031  const cpl_polynomial * poly,
1032  int search_hs)
1033 {
1034 
1035 
1036  const int size = cpl_vector_get_size(self);
1037  const int nlines = cpl_bivector_get_size(lines_catalog);
1038  const cpl_vector * xlines = cpl_bivector_get_x_const(lines_catalog);
1039  const double * dxlines = cpl_vector_get_data_const(xlines);
1040  cpl_bivector * sub_cat ;
1041  cpl_vector * sub_cat_x;
1042  cpl_vector * sub_cat_y;
1043  cpl_vector * wl_limits;
1044  double wave_min, wave_max;
1045  int wave_min_id, wave_max_id;
1046  int nsub;
1047  int error;
1048 
1049  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
1050  cpl_ensure_code(lines_catalog != NULL, CPL_ERROR_NULL_INPUT);
1051  cpl_ensure_code(conv_kernel != NULL, CPL_ERROR_NULL_INPUT);
1052  cpl_ensure_code(poly != NULL, CPL_ERROR_NULL_INPUT);
1053  cpl_ensure_code(size > 0, CPL_ERROR_ILLEGAL_INPUT);
1054 
1055 
1056  /* Resample the spectrum */
1057  wl_limits = cpl_vector_new(size + 1);
1058  cpl_vector_fill_polynomial(wl_limits, poly, 0.5 - search_hs, 1);
1059 
1060  /* The spectrum wavelength bounds */
1061  wave_min = cpl_vector_get(wl_limits, 0);
1062  wave_max = cpl_vector_get(wl_limits, size);
1063 
1064  /* Find the 1st line */
1065  wave_min_id = cpl_vector_find(xlines, wave_min);
1066  /* The first line must be less than or equal to wave_min */
1067  if (dxlines[wave_min_id] > wave_min) wave_min_id--;
1068 
1069  if (wave_min_id < 0) {
1070  cpl_vector_delete(wl_limits);
1071  return cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
1072  __FILE__, __LINE__, "The %d-line "
1073  "catalogue only has lines above %g",
1074  nlines, wave_min);
1075  }
1076 
1077  /* Find the last line */
1078  wave_max_id = cpl_vector_find(xlines, wave_max);
1079  /* The last line must be greater than or equal to wave_max */
1080  if (dxlines[wave_max_id] < wave_max) wave_max_id++;
1081 
1082  if (wave_max_id == nlines) {
1083  cpl_vector_delete(wl_limits);
1084  return cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
1085  __FILE__, __LINE__, "The %d-line "
1086  "catalogue only has lines below %g",
1087  nlines, wave_max);
1088  }
1089 
1090  /* Checking the wavelength range at this point via the indices also
1091  verifies that they were not found using non-increasing wavelengths */
1092  nsub = 1 + wave_max_id - wave_min_id;
1093  cpl_ensure_code(nsub > 1, CPL_ERROR_ILLEGAL_INPUT);
1094 
1095  /* Wrap a new bivector around the relevant part of the catalog */
1096  /* The data is _not_ modified */
1097  sub_cat_x = cpl_vector_wrap(nsub, wave_min_id + (double*)dxlines);
1098  sub_cat_y = cpl_vector_wrap(nsub, wave_min_id + (double*)
1099  cpl_bivector_get_y_data_const(lines_catalog));
1100  sub_cat = cpl_bivector_wrap_vectors(sub_cat_x, sub_cat_y);
1101 
1102  /* High resolution catalog */
1103  error = irplib_wlxcorr_signal_resample(self, wl_limits, sub_cat);
1104 
1105  cpl_vector_delete(wl_limits);
1106  cpl_bivector_unwrap_vectors(sub_cat);
1107  (void)cpl_vector_unwrap(sub_cat_x);
1108  (void)cpl_vector_unwrap(sub_cat_y);
1109 
1110  cpl_ensure_code(!error, CPL_ERROR_ILLEGAL_INPUT);
1111 
1112  /* Smooth the instrument resolution */
1113  cpl_ensure_code(!irplib_wlxcorr_convolve(self, conv_kernel),
1114  cpl_error_get_code());
1115 
1116  return CPL_ERROR_NONE;
1117 }
1118 
1119 
1120 /*----------------------------------------------------------------------------*/
1130 /*----------------------------------------------------------------------------*/
1131 static int irplib_wlxcorr_signal_resample(
1132  cpl_vector * resampled,
1133  const cpl_vector * xbounds,
1134  const cpl_bivector * hires)
1135 {
1136  const int hrsize = cpl_bivector_get_size(hires);
1137  const cpl_vector* xhires ;
1138  const cpl_vector* yhires ;
1139  const double * pxhires ;
1140  const double * pyhires ;
1141  const double * pxbounds ;
1142  cpl_vector * ybounds ;
1143  cpl_bivector * boundary ;
1144  double * pybounds ;
1145  double * presampled ;
1146  int nsamples ;
1147  int i, itt ;
1148 
1149  /* Test entries */
1150  if ((!resampled) || (!xbounds) || (!hires)) return -1 ;
1151 
1152  /* Initialise */
1153  nsamples = cpl_vector_get_size(resampled) ;
1154 
1155  /* Initialise */
1156  presampled = cpl_vector_get_data(resampled) ;
1157  pxbounds = cpl_vector_get_data_const(xbounds) ;
1158  xhires = cpl_bivector_get_x_const(hires) ;
1159  yhires = cpl_bivector_get_y_const(hires) ;
1160  pxhires = cpl_vector_get_data_const(xhires) ;
1161  pyhires = cpl_vector_get_data_const(yhires) ;
1162 
1163  /* Create a new vector */
1164  ybounds = cpl_vector_new(cpl_vector_get_size(xbounds)) ;
1165  boundary = cpl_bivector_wrap_vectors((cpl_vector*)xbounds,ybounds) ;
1166  pybounds = cpl_vector_get_data(ybounds) ;
1167 
1168  /* Test entries */
1169  if (cpl_bivector_get_size(boundary) != nsamples + 1) {
1170  cpl_bivector_unwrap_vectors(boundary) ;
1171  cpl_vector_delete(ybounds) ;
1172  return -1 ;
1173  }
1174 
1175  /* Get the ind */
1176  itt = cpl_vector_find(xhires, pxbounds[0]);
1177 
1178  /* Interpolate the signal */
1179  if (cpl_bivector_interpolate_linear(boundary, hires)) {
1180  cpl_bivector_unwrap_vectors(boundary) ;
1181  cpl_vector_delete(ybounds) ;
1182  return -1 ;
1183  }
1184 
1185  /* At this point itt most likely points to element just below
1186  pxbounds[0] */
1187  while (pxhires[itt] < pxbounds[0]) itt++;
1188 
1189  for (i=0; i < nsamples; i++) {
1190  /* The i'th signal is the weighted average of the two interpolated
1191  signals at the pixel boundaries and those table signals in
1192  between */
1193 
1194  double xlow = pxbounds[i];
1195  double x = pxhires[itt];
1196 
1197  if (x > pxbounds[i+1]) x = pxbounds[i+1];
1198  /* Contribution from interpolated value at wavelength at lower pixel
1199  boundary */
1200  presampled[i] = pybounds[i] * (x - xlow);
1201 
1202  /* Contribution from table values in between pixel boundaries */
1203  while ((pxhires[itt] < pxbounds[i+1]) && (itt < hrsize)) {
1204  const double xprev = x;
1205  x = pxhires[itt+1];
1206  if (x > pxbounds[i+1]) x = pxbounds[i+1];
1207  presampled[i] += pyhires[itt] * (x - xlow);
1208  xlow = xprev;
1209  itt++;
1210  }
1211 
1212  /* Contribution from interpolated value at wavelength at upper pixel
1213  boundary */
1214  presampled[i] += pybounds[i+1] * (pxbounds[i+1] - xlow);
1215 
1216  /* Compute average by dividing integral by length of pixel range
1217  (the factor 2 comes from the contributions) */
1218  presampled[i] /= 2 * (pxbounds[i+1] - pxbounds[i]);
1219  }
1220  cpl_bivector_unwrap_vectors(boundary) ;
1221  cpl_vector_delete(ybounds) ;
1222  return 0 ;
1223 }
1224 
1225 
1226 
1227 /*----------------------------------------------------------------------------*/
1248 /*----------------------------------------------------------------------------*/
1249 static cpl_error_code cpl_vector_fill_lss_profile_symmetric(cpl_vector * self,
1250  double slitw,
1251  double fwhm)
1252 {
1253 
1254  const double sigma = fwhm * CPL_MATH_SIG_FWHM;
1255  const int n = cpl_vector_get_size(self);
1256  int i;
1257 
1258 
1259  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
1260  cpl_ensure_code(slitw > 0.0, CPL_ERROR_ILLEGAL_INPUT);
1261  cpl_ensure_code(fwhm > 0.0, CPL_ERROR_ILLEGAL_INPUT);
1262 
1263  /* Cannot fail now */
1264 
1265  /* Special case for i = 0 */
1266  (void)cpl_vector_set(self, 0,
1267  (irplib_erf_antideriv(0.5*slitw + 0.5, sigma) -
1268  irplib_erf_antideriv(0.5*slitw - 0.5, sigma)) / slitw);
1269 
1270  for (i = 1; i < n; i++) {
1271  /* FIXME: Reuse two irplib_erf_antideriv() calls from previous value */
1272  const double x1p = i + 0.5*slitw + 0.5;
1273  const double x1n = i - 0.5*slitw + 0.5;
1274  const double x0p = i + 0.5*slitw - 0.5;
1275  const double x0n = i - 0.5*slitw - 0.5;
1276  const double val = 0.5/slitw *
1277  (irplib_erf_antideriv(x1p, sigma) - irplib_erf_antideriv(x1n, sigma) -
1278  irplib_erf_antideriv(x0p, sigma) + irplib_erf_antideriv(x0n, sigma));
1279  (void)cpl_vector_set(self, i, val);
1280  }
1281 
1282  return CPL_ERROR_NONE;
1283 }
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.