NACO Pipeline Reference Manual  4.4.0
irplib_wlxcorr-test.c
1 /* $Id: irplib_wlxcorr-test.c,v 1.16 2013-01-29 08:43:33 jtaylor Exp $
2  *
3  * This file is part of the ESO Common Pipeline Library
4  * Copyright (C) 2001-2004 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.16 $
25  * $Name: not supported by cvs2svn $
26  */
27 
28 /*-----------------------------------------------------------------------------
29  Includes
30  -----------------------------------------------------------------------------*/
31 
32 #ifdef HAVE_CONFIG_H
33 #include <config.h>
34 #endif
35 
36 #include <irplib_wlxcorr.h>
37 
38 #include <irplib_wavecal_impl.h>
39 
40 #include <cpl_plot.h>
41 
42 #include <math.h>
43 #include <float.h>
44 
45 /* TEMPORARY SUPPORT OF CPL 5.x */
46 #ifndef CPL_SIZE_FORMAT
47 #define CPL_SIZE_FORMAT "d"
48 #define cpl_size int
49 #endif
50 /* END TEMPORARY SUPPORT OF CPL 5.x */
51 
52 
53 
54 /*----------------------------------------------------------------------------*/
58 /*----------------------------------------------------------------------------*/
59 
60 
61 /*-----------------------------------------------------------------------------
62  Private Function prototypes
63  -----------------------------------------------------------------------------*/
64 
65 static void irplib_wlxcorr_best_poly_test(void);
66 static void irplib_wlxcorr_best_poly_test_one(int, int, cpl_boolean, int, int);
67 static void irplib_wlxcorr_convolve_create_kernel_test(void);
68 static void irplib_wlxcorr_convolve_create_kernel_test_one(double, double);
69 static double irplib_wlcalib_lss(double, double, double);
70 static void irplib_wavecal_profile_compare(int, double, double);
71 
72 
73 /*----------------------------------------------------------------------------*/
77 /*----------------------------------------------------------------------------*/
78 
79 /*-----------------------------------------------------------------------------
80  Main
81  -----------------------------------------------------------------------------*/
82 int main(void)
83 {
84  /* Initialize CPL + IRPLIB */
85  cpl_test_init(PACKAGE_BUGREPORT, CPL_MSG_WARNING);
86 
87  irplib_wavecal_profile_compare(100, 4.0, 4.0);
88  irplib_wlxcorr_convolve_create_kernel_test();
89  irplib_wlxcorr_best_poly_test();
90 
91  return cpl_test_end(0);
92 }
93 
94 
95 static void irplib_wlxcorr_best_poly_test(void)
96 {
97  cpl_polynomial * poly;
98  const cpl_boolean do_bench = cpl_msg_get_level() <= CPL_MSG_INFO
99  ? CPL_TRUE : CPL_FALSE;
100  const int spec_size = do_bench ? 1024 : 256;
101  const int nreps = do_bench ? 3 : 1;
102  const int nsamples = do_bench ? 30 : 10;
103 
104 
105  /* 1st test: NULL input */
106  poly = irplib_wlxcorr_best_poly(NULL, NULL, 1, NULL, NULL, 1, 1.0, 1.0,
107  NULL, NULL, NULL);
108  cpl_test_error(CPL_ERROR_NULL_INPUT);
109  cpl_test_null( poly );
110 
111 #if 1
112  /* 2nd test: Resampling of catalog lines */
113  irplib_wlxcorr_best_poly_test_one(spec_size, spec_size*10, CPL_TRUE,
114  nsamples, nreps);
115 #endif
116 
117  /* 3rd test: No resampling of catalog lines */
118  irplib_wlxcorr_best_poly_test_one(spec_size, spec_size/50, CPL_FALSE,
119  nsamples, nreps);
120 }
121 
122 static void irplib_wlxcorr_best_poly_test_one(int spec_size, int cat_size,
123  cpl_boolean do_resample,
124  int nsamples, int nreps)
125 {
126  const int degree = 2;
127  cpl_vector * spectrum = cpl_vector_new(spec_size);
128  cpl_bivector * catalog = cpl_bivector_new(cat_size);
129  cpl_polynomial * true_poly = cpl_polynomial_new(1);
130  cpl_polynomial * guess_poly = cpl_polynomial_new(1);
131  cpl_vector * wl_err = cpl_vector_new(degree+1);
132  double xc;
133  const double slitw = 2.0;
134  const double fwhm = 2.0;
135  const double xtrunc = 0.5 * slitw + 5.0 * fwhm * CPL_MATH_SIG_FWHM;
136  const double rel_error = 0.05; /* Introduce error */
137 
138  /* A black-body with T=253K should emit mostly in the range [2;50[ micron */
139  const double temp_bb = 253.0;
140 
141  const double b_true = 2e-6;
142  const double a_true = 48e-6 / spec_size;
143 
144  const double a_error = a_true * rel_error;
145  const double b_error = b_true * rel_error;
146  const double a = a_true + a_error;
147  const double b = b_true + b_error;
148  double wl_errmax;
149  cpl_size pow_ind;
150  int i;
151  FILE * stream = cpl_msg_get_level() > CPL_MSG_INFO
152  ? fopen("/dev/null", "a") : stdout;
153 
154 
155  cpl_test_nonnull( stream );
156 
157  /* First guess P(x) = ax + b */
158  /* The true and distorted polynomials */
159  pow_ind = 1;
160  cpl_polynomial_set_coeff(true_poly, &pow_ind, a_true);
161  cpl_polynomial_set_coeff(guess_poly, &pow_ind, a);
162  pow_ind = 0;
163  cpl_polynomial_set_coeff(true_poly, &pow_ind, b_true);
164  cpl_polynomial_set_coeff(guess_poly, &pow_ind, b);
165 
166  cpl_msg_info(cpl_func, "First guess polynomial:");
167  cpl_polynomial_dump(guess_poly, stream);
168 
169  /* Try also to shift the guess of the solution */
170  cpl_test_zero(cpl_polynomial_shift_1d(guess_poly, 0, 25.0));
171 
172  cpl_msg_info(cpl_func, "True polynomial:");
173  cpl_polynomial_dump(true_poly, stream);
174 
175 
176  if (do_resample) {
177  cpl_vector * evalpoints = cpl_vector_new(spec_size);
178 
179  /* Wavelengths of the spectrum */
180  cpl_vector_fill_polynomial(evalpoints, true_poly, 1.0, 1.0);
181 
182  /* Catalog */
183  /* The sampled profile is a black body radiation */
184  cpl_vector_fill_polynomial(cpl_bivector_get_x(catalog), true_poly,
185  -1.0, 1.5 * spec_size / cat_size);
186 
187  cpl_photom_fill_blackbody(cpl_bivector_get_y(catalog), CPL_UNIT_LESS,
188  cpl_bivector_get_x_const(catalog),
189  CPL_UNIT_LENGTH, temp_bb);
190 
191  cpl_photom_fill_blackbody(spectrum, CPL_UNIT_LESS,
192  evalpoints, CPL_UNIT_LENGTH, temp_bb);
193 
194  cpl_vector_delete(evalpoints);
195 
196  } else {
197  /* Place some lines with different intensities */
198  double * dx = cpl_bivector_get_x_data(catalog);
199  double * dy = cpl_bivector_get_y_data(catalog);
200 
201  for (i = 0; i < cat_size; i++) {
202  const double wli = cpl_polynomial_eval_1d(true_poly, 3.0 * i * i
203  -10.0, NULL);
204 
205  dx[i] = wli;
206  dy[i] = sin(i * CPL_MATH_PI / cat_size);
207 
208  }
209 
210  irplib_vector_fill_line_spectrum_model(spectrum, NULL, NULL, true_poly,
211  catalog, slitw, fwhm, xtrunc,
212  0, CPL_FALSE, CPL_FALSE, NULL);
213  cpl_test_error(CPL_ERROR_NONE);
214  }
215 
216  /* FIXME: Add some random noise to the spectrum */
217 
218  if (cpl_msg_get_level() <= CPL_MSG_DEBUG) {
219  cpl_plot_bivector( "", "t 'Catalog' w lines", "", catalog);
220  cpl_plot_vector( "", "t 'Spectrum' w lines", "", spectrum);
221  }
222 
223 
224  /* Error */
225  /* Compute an error bound certain to include to true solution */
226  wl_errmax = cpl_polynomial_eval_1d(guess_poly, spec_size, NULL)
227  - cpl_polynomial_eval_1d(true_poly, spec_size, NULL);
228  cpl_vector_fill(wl_err, 2.0 * wl_errmax);
229 
230  /* Multiple calls for bench-marking */
231 
232  for (i=0; i < nreps; i++) {
233  cpl_table * wl_res;
234  cpl_vector * xcorrs;
235  cpl_polynomial * poly
236  = irplib_wlxcorr_best_poly(spectrum, catalog, degree,
237  guess_poly, wl_err, nsamples,
238  slitw, fwhm, &xc, &wl_res, &xcorrs);
239  cpl_test_nonnull(poly);
240  cpl_test_error(CPL_ERROR_NONE);
241 
242  if (i == 0 && poly != NULL) {
243  if (cpl_msg_get_level() <= CPL_MSG_DEBUG) {
244  const char * labels[] = {IRPLIB_WLXCORR_COL_WAVELENGTH,
245  IRPLIB_WLXCORR_COL_CAT_INIT,
246  IRPLIB_WLXCORR_COL_CAT_FINAL,
247  IRPLIB_WLXCORR_COL_OBS};
248 
249  cpl_plot_vector( "", "t 'X corr values' w lines", "", xcorrs);
250 
251  cpl_test_zero(cpl_plot_columns("", "", "", wl_res, labels, 4));
252  }
253 
254  cpl_msg_info(cpl_func, "Corrected polynomial:");
255  cpl_polynomial_dump(poly, stream);
256 
257  /* Corrected polynomial must be monotone, with same sign
258  as a_true. */
259  cpl_test_zero(cpl_polynomial_derivative(poly, 0));
260  cpl_test_leq(0.0, a_true * cpl_polynomial_eval_1d(poly, 1.0, NULL));
261  cpl_test_leq(0.0, a_true
262  * cpl_polynomial_eval_1d(poly, 0.5 * spec_size, NULL));
263  cpl_test_leq(0.0, a_true
264  * cpl_polynomial_eval_1d(poly, spec_size, NULL));
265 
266  cpl_test_error(CPL_ERROR_NONE);
267 
268  }
269 
270  cpl_table_delete(wl_res);
271  cpl_vector_delete(xcorrs);
272  cpl_polynomial_delete(poly);
273  }
274 
275  cpl_vector_delete(wl_err);
276  cpl_vector_delete(spectrum);
277  cpl_bivector_delete(catalog);
278  cpl_polynomial_delete(true_poly);
279  cpl_polynomial_delete(guess_poly);
280  cpl_test_error(CPL_ERROR_NONE);
281 
282  if (stream != stdout) cpl_test_zero( fclose(stream) );
283 
284  return;
285 }
286 
287 
288 static void irplib_wlxcorr_convolve_create_kernel_test_one(double slitw,
289  double fwhm)
290 {
291 
292  cpl_vector * kernel;
293  double sum = 0.0;
294  /* Maximum value of profile */
295  const double maxval = irplib_wlcalib_lss(0.0, slitw, fwhm);
296  double prev = maxval;
297  int n, i;
298 
299  cpl_msg_info(cpl_func, "Slit-width=%g, FWHM=%g", slitw, fwhm);
300 
301  kernel = irplib_wlxcorr_convolve_create_kernel(0.0, fwhm);
302 
303  cpl_test_error(CPL_ERROR_ILLEGAL_INPUT);
304  cpl_test_null(kernel);
305 
306  kernel = irplib_wlxcorr_convolve_create_kernel(slitw, 0.0);
307 
308  cpl_test_error(CPL_ERROR_ILLEGAL_INPUT);
309  cpl_test_null(kernel);
310 
311  kernel = irplib_wlxcorr_convolve_create_kernel(slitw, fwhm);
312 
313  cpl_test_nonnull(kernel);
314 
315  n = cpl_vector_get_size(kernel);
316 
317  for (i = 0; i < n; i++) {
318  const double val = cpl_vector_get(kernel, i);
319  sum += i ? 2.0*val : val; /* Non-central elements twice */
320 
321  /* Profile consists of non-negative values */
322  cpl_test_leq(0.0, val);
323 
324  /* The max of the profile is less than maxval and decreases */
325  cpl_test_leq(val, prev);
326 
327  if (i > 0) {
328  /* The profile at i is less than the continuous profile at
329  i - 0.5, and greater than that at i + 0.5 */
330  cpl_test_leq(val, irplib_wlcalib_lss(i - 0.5, slitw, fwhm));
331  cpl_test_leq(irplib_wlcalib_lss(i + 0.5, slitw, fwhm), val);
332  }
333 
334  /* The profile has a FWHM (sligthly) greater than slitw */
335  if ((double)i < 0.5 * slitw) {
336  /* Thus if x is less than half the slit width, then
337  the value has to be greater than half the maximum */
338  cpl_test_leq(0.5 * maxval, val);
339  } else if (val < 0.5 * maxval) {
340  /* On the other hand, if the value is less than the maximum,
341  then x must exceed half the slitw */
342  cpl_test_leq(0.5*slitw, (double)i);
343  }
344 
345  prev = val;
346  }
347 
348  /* Integral is supposed to be 1 */
349  cpl_test_abs(sum, 1.0, 1e-5); /* FIXME: Improve tolerance */
350 
351  if (cpl_msg_get_level() <= CPL_MSG_DEBUG) {
352  char * title = cpl_sprintf("t 'LSS profile, slitw=%g, fwhm=%g' "
353  "w linespoints", slitw, fwhm);
354  cpl_plot_vector("set grid;", title, "", kernel);
355  cpl_free(title);
356  }
357 
358  cpl_vector_delete(kernel);
359 }
360 
361 static void irplib_wlxcorr_convolve_create_kernel_test(void)
362 {
363 
364  irplib_wlxcorr_convolve_create_kernel_test_one(0.86, 2.0);
365  irplib_wlxcorr_convolve_create_kernel_test_one(1.72, 3.0);
366  irplib_wlxcorr_convolve_create_kernel_test_one(40.0, 2.0);
367  irplib_wlxcorr_convolve_create_kernel_test_one(3.0, 40.0);
368 
369 }
370 
371 
372 /*----------------------------------------------------------------------------*/
382 /*----------------------------------------------------------------------------*/
383 static double irplib_wlcalib_lss(double x, double slitw, double fwhm)
384 {
385  const double sigmasqrt2 = fwhm * CPL_MATH_SIG_FWHM * CPL_MATH_SQRT2;
386  const double result = 0.5 / slitw *
387  (erf((x+0.5*slitw)/sigmasqrt2) - erf((x-0.5*slitw)/sigmasqrt2));
388 
389  cpl_test_lt(0.0, slitw);
390  cpl_test_lt(0.0, sigmasqrt2);
391 
392  /* Protect against round-off (on SunOS 5.8) */
393  return result < 0.0 ? 0.0 : result;
394 
395 }
396 
397 
398 /*----------------------------------------------------------------------------*/
407 /*----------------------------------------------------------------------------*/
408 static void irplib_wavecal_profile_compare(int spec_size, double slitw,
409  double fwhm)
410 {
411 
412  cpl_vector * spectrum1 = cpl_vector_new(spec_size);
413  cpl_vector * spectrum2 = cpl_vector_new(spec_size);
414  cpl_bivector * catalog = cpl_bivector_new(2);
415  cpl_polynomial * dispersion = cpl_polynomial_new(1);
416  const double a = 1.0;
417  const double b = 100.0;
418  const double xtrunc = 0.5 * slitw + 2.0 * fwhm * CPL_MATH_SIG_FWHM;
419  double mean;
420  cpl_error_code error;
421  cpl_size pow_ind;
422 
423 
424  pow_ind = 1;
425  cpl_polynomial_set_coeff(dispersion, &pow_ind, a);
426  pow_ind = 0;
427  cpl_polynomial_set_coeff(dispersion, &pow_ind, b);
428 
429  cpl_vector_set(cpl_bivector_get_x(catalog), 0, b + spec_size / 3.0);
430  cpl_vector_set(cpl_bivector_get_y(catalog), 0, 100);
431 
432  cpl_vector_set(cpl_bivector_get_x(catalog), 1, b + spec_size / 1.5);
433  cpl_vector_set(cpl_bivector_get_y(catalog), 1, 100);
434 
435  cpl_test_error(CPL_ERROR_NONE);
436 
437  error = irplib_vector_fill_line_spectrum_model(spectrum1, NULL, NULL,
438  dispersion, catalog, slitw,
439  fwhm, xtrunc, 0, CPL_FALSE,
440  CPL_FALSE, NULL);
441  cpl_test_error(CPL_ERROR_NONE);
442  cpl_test_eq(error, CPL_ERROR_NONE);
443 
444 
445  error = irplib_vector_fill_line_spectrum_model(spectrum2, NULL, NULL,
446  dispersion, catalog, slitw,
447  fwhm, xtrunc, 0, CPL_TRUE,
448  CPL_FALSE, NULL);
449 
450  cpl_test_error(CPL_ERROR_NONE);
451  cpl_test_eq(error, CPL_ERROR_NONE);
452 
453  if (cpl_msg_get_level() <= CPL_MSG_DEBUG) {
454  error = cpl_plot_vector("set grid;", "t 'Spectrum' w lines", "",
455  spectrum1);
456  cpl_test_error(CPL_ERROR_NONE);
457  cpl_test_eq(error, CPL_ERROR_NONE);
458  error = cpl_plot_vector("set grid;", "t 'Spectrum' w lines", "",
459  spectrum2);
460  cpl_test_error(CPL_ERROR_NONE);
461  cpl_test_eq(error, CPL_ERROR_NONE);
462  }
463 
464  cpl_vector_subtract(spectrum1, spectrum2);
465  mean = cpl_vector_get_mean(spectrum1);
466  if (mean != 0.0) {
467  cpl_msg_info(cpl_func, "Error: %g", mean);
468  if (cpl_msg_get_level() <= CPL_MSG_DEBUG) {
469  error = cpl_plot_vector("set grid;", "t 'Spectrum error' w lines",
470  "", spectrum1);
471  cpl_test_error(CPL_ERROR_NONE);
472  cpl_test_eq(error, CPL_ERROR_NONE);
473  }
474  }
475 
476  cpl_polynomial_delete(dispersion);
477  cpl_vector_delete(spectrum1);
478  cpl_vector_delete(spectrum2);
479  cpl_bivector_delete(catalog);
480 
481  cpl_test_error(CPL_ERROR_NONE);
482 
483 }
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.
int main(void)
Find a plugin and submit it to some tests.
Definition: recipe_main.c:61