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