// ======================================================================== // adaptive integration with known singular points // ======================================================================== double NumericalDefiniteIntegral::QAGP( _Function* F ) const { if( 0 == F ) { Exception("QAGP::invalid function") ; } // no known singular points ? if( points().empty() || 0 == m_pdata ) { return QAGS( F ) ; } const size_t npts = points().size(); // use GSL int ierror = gsl_integration_qagp ( F->fn , m_pdata , npts , m_epsabs , m_epsrel , size () , ws()->ws , &m_result , &m_error ) ; if( ierror ) { gsl_error( "NumericalDefiniteIntegral::QAGI " , __FILE__ , __LINE__ , ierror ) ; } // the sign if ( m_a > m_b ) { m_result *= -1 ; } return m_result ; }
static VALUE rb_gsl_integration_qagp(int argc, VALUE *argv, VALUE obj) { double epsabs, epsrel; double result, abserr; size_t limit; gsl_function *F = NULL; gsl_vector *v = NULL; gsl_integration_workspace *w = NULL; int status, intervals, flag = 0, flag2 = 0, itmp; switch (TYPE(obj)) { case T_MODULE: case T_CLASS: case T_OBJECT: CHECK_FUNCTION(argv[0]); Data_Get_Struct(argv[0], gsl_function, F); itmp = 1; break; default: Data_Get_Struct(obj, gsl_function, F); itmp = 0; break; } if (TYPE(argv[itmp]) == T_ARRAY) { v = make_cvector_from_rarray(argv[itmp]); flag2 = 1; } else { Data_Get_Vector(argv[itmp], v); flag2 = 0; } itmp += 1; flag = get_epsabs_epsrel_limit_workspace(argc, argv, itmp, &epsabs, &epsrel, &limit, &w); status = gsl_integration_qagp(F, v->data, v->size, epsabs, epsrel, limit, w, &result, &abserr); intervals = w->size; if (flag == 1) gsl_integration_workspace_free(w); if (flag2 == 1) gsl_vector_free(v); return rb_ary_new3(4, rb_float_new(result), rb_float_new(abserr), INT2FIX(intervals), INT2FIX(status)); }
double *bayestar_sky_map_toa_phoa_snr( long *npix, /* Input: number of HEALPix pixels. */ double gmst, /* Greenwich mean sidereal time in radians. */ int nifos, /* Input: number of detectors. */ const float (**responses)[3], /* Pointers to detector responses. */ const double **locations, /* Pointers to locations of detectors in Cartesian geographic coordinates. */ const double *toas, /* Input: array of times of arrival with arbitrary relative offset. (Make toas[0] == 0.) */ const double *phoas, /* Input: array of phases of arrival with arbitrary relative offset. (Make phoas[0] == 0.) */ const double *snrs, /* Input: array of SNRs. */ const double *w_toas, /* Input: sum-of-squares weights, (1/TOA variance)^2. */ const double *w1s, /* Input: first moments of angular frequency. */ const double *w2s, /* Input: second moments of angular frequency. */ const double *horizons, /* Distances at which a source would produce an SNR of 1 in each detector. */ double min_distance, double max_distance, int prior_distance_power) /* Use a prior of (distance)^(prior_distance_power) */ { long nside; long maxpix; long i; double d1[nifos]; double *P; gsl_permutation *pix_perm; double complex exp_i_phoas[nifos]; /* Hold GSL return values for any thread that fails. */ int gsl_errno = GSL_SUCCESS; /* Storage for old GSL error handler. */ gsl_error_handler_t *old_handler; /* Maximum number of subdivisions for adaptive integration. */ static const size_t subdivision_limit = 64; /* Subdivide radial integral where likelihood is this fraction of the maximum, * will be used in solving the quadratic to find the breakpoints */ static const double eta = 0.01; /* Use this many integration steps in 2*psi */ static const int ntwopsi = 16; /* Number of integration steps in cos(inclination) */ static const int nu = 16; /* Number of integration steps in arrival time */ static const int nt = 16; /* Rescale distances so that furthest horizon distance is 1. */ { double d1max; memcpy(d1, horizons, sizeof(d1)); for (d1max = d1[0], i = 1; i < nifos; i ++) if (d1[i] > d1max) d1max = d1[i]; for (i = 0; i < nifos; i ++) d1[i] /= d1max; min_distance /= d1max; max_distance /= d1max; } (void)w2s; /* FIXME: remove unused parameter */ for (i = 0; i < nifos; i ++) exp_i_phoas[i] = exp_i(phoas[i]); /* Evaluate posterior term only first. */ P = bayestar_sky_map_toa_adapt_resolution(&pix_perm, &maxpix, npix, gmst, nifos, locations, toas, w_toas, autoresolution_count_pix_toa_phoa_snr); if (!P) return NULL; /* Determine the lateral HEALPix resolution. */ nside = npix2nside(*npix); /* Zero all pixels that didn't meet the TDOA cut. */ for (i = maxpix; i < *npix; i ++) { long ipix = gsl_permutation_get(pix_perm, i); P[ipix] = -INFINITY; } /* Use our own error handler while in parallel section to avoid concurrent * calls to the GSL error handler, which if provided by the user may not * be threadsafe. */ old_handler = gsl_set_error_handler(my_gsl_error); /* Compute posterior factor for amplitude consistency. */ #pragma omp parallel for firstprivate(gsl_errno) lastprivate(gsl_errno) for (i = 0; i < maxpix; i ++) { /* Cancel further computation if a GSL error condition has occurred. * * Note: if one thread sets gsl_errno, not necessarily all thread will * get the updated value. That's OK, because most failure modes will * cause GSL error conditions on all threads. If we cared to have any * failure on any thread terminate all of the other threads as quickly * as possible, then we would want to insert the following pragma here: * * #pragma omp flush(gsl_errno) * * and likewise before any point where we set gsl_errno. */ if (gsl_errno != GSL_SUCCESS) goto skip; { long ipix = gsl_permutation_get(pix_perm, i); double complex F[nifos]; double theta, phi; int itwopsi, iu, it, iifo; double accum = -INFINITY; double complex exp_i_toaphoa[nifos]; double dtau[nifos], mean_dtau; /* Prepare workspace for adaptive integrator. */ gsl_integration_workspace *workspace = gsl_integration_workspace_alloc(subdivision_limit); /* If the workspace could not be allocated, then record the GSL * error value for later reporting when we leave the parallel * section. Then, skip to the next loop iteration. */ if (!workspace) { gsl_errno = GSL_ENOMEM; goto skip; } /* Look up polar coordinates of this pixel */ pix2ang_ring(nside, ipix, &theta, &phi); toa_errors(dtau, theta, phi, gmst, nifos, locations, toas); for (iifo = 0; iifo < nifos; iifo ++) exp_i_toaphoa[iifo] = exp_i_phoas[iifo] * exp_i(w1s[iifo] * dtau[iifo]); /* Find mean arrival time error */ mean_dtau = gsl_stats_wmean(w_toas, 1, dtau, 1, nifos); /* Look up antenna factors */ for (iifo = 0; iifo < nifos; iifo++) { XLALComputeDetAMResponse( (double *)&F[iifo], /* Type-punned real part */ 1 + (double *)&F[iifo], /* Type-punned imag part */ responses[iifo], phi, M_PI_2 - theta, 0, gmst); F[iifo] *= d1[iifo]; } /* Integrate over 2*psi */ for (itwopsi = 0; itwopsi < ntwopsi; itwopsi++) { const double twopsi = (2 * M_PI / ntwopsi) * itwopsi; const double complex exp_i_twopsi = exp_i(twopsi); /* Integrate over u from u=-1 to u=1. */ for (iu = -nu; iu <= nu; iu++) { const double u = (double)iu / nu; const double u2 = gsl_pow_2(u); double A = 0, B = 0; double breakpoints[5]; int num_breakpoints = 0; double log_offset = -INFINITY; /* The log-likelihood is quadratic in the estimated and true * values of the SNR, and in 1/r. It is of the form A/r^2 + B/r, * where A depends only on the true values of the SNR and is * strictly negative and B depends on both the true values and * the estimates and is strictly positive. * * The middle breakpoint is at the maximum of the log-likelihood, * occurring at 1/r=-B/2A. The lower and upper breakpoints occur * when the likelihood becomes eta times its maximum value. This * occurs when * * A/r^2 + B/r = log(eta) - B^2/4A. * */ /* Perform arrival time integral */ double accum1 = -INFINITY; for (it = -nt/2; it <= nt/2; it++) { const double t = mean_dtau + LAL_REARTH_SI / LAL_C_SI * it / nt; double complex i0arg_complex = 0; for (iifo = 0; iifo < nifos; iifo++) { const double complex tmp = F[iifo] * exp_i_twopsi; /* FIXME: could use - sign here to avoid conj below, but * this probably just sets our sign convention relative to * detection pipeline */ double complex phase_rhotimesr = 0.5 * (1 + u2) * creal(tmp) + I * u * cimag(tmp); const double abs_rhotimesr_2 = cabs2(phase_rhotimesr); const double abs_rhotimesr = sqrt(abs_rhotimesr_2); phase_rhotimesr /= abs_rhotimesr; i0arg_complex += exp_i_toaphoa[iifo] * exp_i(-w1s[iifo] * t) * phase_rhotimesr * gsl_pow_2(snrs[iifo]); } const double i0arg = cabs(i0arg_complex); accum1 = logaddexp(accum1, log(gsl_sf_bessel_I0_scaled(i0arg)) + i0arg - 0.5 * gsl_stats_wtss_m(w_toas, 1, dtau, 1, nifos, t)); } /* Loop over detectors */ for (iifo = 0; iifo < nifos; iifo++) { const double complex tmp = F[iifo] * exp_i_twopsi; /* FIXME: could use - sign here to avoid conj below, but * this probably just sets our sign convention relative to * detection pipeline */ double complex phase_rhotimesr = 0.5 * (1 + u2) * creal(tmp) + I * u * cimag(tmp); const double abs_rhotimesr_2 = cabs2(phase_rhotimesr); const double abs_rhotimesr = sqrt(abs_rhotimesr_2); A += abs_rhotimesr_2; B += abs_rhotimesr * snrs[iifo]; } A *= -0.5; { const double middle_breakpoint = -2 * A / B; const double lower_breakpoint = 1 / (1 / middle_breakpoint + sqrt(log(eta) / A)); const double upper_breakpoint = 1 / (1 / middle_breakpoint - sqrt(log(eta) / A)); breakpoints[num_breakpoints++] = min_distance; if(lower_breakpoint > breakpoints[num_breakpoints-1] && lower_breakpoint < max_distance) breakpoints[num_breakpoints++] = lower_breakpoint; if(middle_breakpoint > breakpoints[num_breakpoints-1] && middle_breakpoint < max_distance) breakpoints[num_breakpoints++] = middle_breakpoint; if(upper_breakpoint > breakpoints[num_breakpoints-1] && upper_breakpoint < max_distance) breakpoints[num_breakpoints++] = upper_breakpoint; breakpoints[num_breakpoints++] = max_distance; } { /* * Set log_offset to the maximum of the logarithm of the * radial integrand evaluated at all of the breakpoints. */ int ibreakpoint; for (ibreakpoint = 0; ibreakpoint < num_breakpoints; ibreakpoint++) { const double new_log_offset = log_radial_integrand( breakpoints[ibreakpoint], A, B, prior_distance_power); if (new_log_offset < INFINITY && new_log_offset > log_offset) log_offset = new_log_offset; } } { /* Perform adaptive integration. Stop when a relative * accuracy of 0.05 has been reached. */ inner_integrand_params integrand_params = {A, B, log_offset, prior_distance_power}; const gsl_function func = {radial_integrand, &integrand_params}; double result, abserr; int ret = gsl_integration_qagp(&func, &breakpoints[0], num_breakpoints, DBL_MIN, 0.05, subdivision_limit, workspace, &result, &abserr); /* If the integrator failed, then record the GSL error * value for later reporting when we leave the parallel * section. Then, break out of the loop. */ if (ret != GSL_SUCCESS) { gsl_errno = ret; gsl_integration_workspace_free(workspace); goto skip; } /* Take the logarithm and put the log-normalization back in. */ result = log(result) + integrand_params.log_offset + accum1; /* Accumulate result. */ accum = logaddexp(accum, result); } } } /* Discard workspace for adaptive integrator. */ gsl_integration_workspace_free(workspace); /* Store log posterior. */ P[ipix] = accum; } skip: /* this statement intentionally left blank */; } /* Restore old error handler. */ gsl_set_error_handler(old_handler); /* Free permutation. */ gsl_permutation_free(pix_perm); /* Check if there was an error in any thread evaluating any pixel. If there * was, raise the error and return. */ if (gsl_errno != GSL_SUCCESS) { free(P); GSL_ERROR_NULL(gsl_strerror(gsl_errno), gsl_errno); } /* Exponentiate and normalize posterior. */ pix_perm = get_pixel_ranks(*npix, P); if (!pix_perm) { free(P); return NULL; } exp_normalize(*npix, P, pix_perm); gsl_permutation_free(pix_perm); return P; }
double *bayestar_sky_map_toa_snr( long *npix, /* Input: number of HEALPix pixels. */ double gmst, /* Greenwich mean sidereal time in radians. */ int nifos, /* Input: number of detectors. */ const float (**responses)[3], /* Pointers to detector responses. */ const double **locations, /* Pointers to locations of detectors in Cartesian geographic coordinates. */ const double *toas, /* Input: array of times of arrival with arbitrary relative offset. (Make toas[0] == 0.) */ const double *snrs, /* Input: array of SNRs. */ const double *w_toas, /* Input: sum-of-squares weights, (1/TOA variance)^2. */ const double *horizons, /* Distances at which a source would produce an SNR of 1 in each detector. */ double min_distance, double max_distance, int prior_distance_power) /* Use a prior of (distance)^(prior_distance_power) */ { long nside; long maxpix; long i; double d1[nifos]; double *P; gsl_permutation *pix_perm; /* Hold GSL return values for any thread that fails. */ int gsl_errno = GSL_SUCCESS; /* Storage for old GSL error handler. */ gsl_error_handler_t *old_handler; /* Maximum number of subdivisions for adaptive integration. */ static const size_t subdivision_limit = 64; /* Subdivide radial integral where likelihood is this fraction of the maximum, * will be used in solving the quadratic to find the breakpoints */ static const double eta = 0.01; /* Use this many integration steps in 2*psi */ static const int ntwopsi = 16; /* Number of integration steps in cos(inclination) */ static const int nu = 16; /* Rescale distances so that furthest horizon distance is 1. */ { double d1max; memcpy(d1, horizons, sizeof(d1)); for (d1max = d1[0], i = 1; i < nifos; i ++) if (d1[i] > d1max) d1max = d1[i]; for (i = 0; i < nifos; i ++) d1[i] /= d1max; min_distance /= d1max; max_distance /= d1max; } /* Evaluate posterior term only first. */ P = bayestar_sky_map_toa_adapt_resolution(&pix_perm, &maxpix, npix, gmst, nifos, locations, toas, w_toas, autoresolution_count_pix_toa_snr); if (!P) return NULL; /* Determine the lateral HEALPix resolution. */ nside = npix2nside(*npix); /* Zero pixels that didn't meet the TDOA cut. */ for (i = 0; i < maxpix; i ++) { long ipix = gsl_permutation_get(pix_perm, i); P[ipix] = log(P[ipix]); } for (; i < *npix; i ++) { long ipix = gsl_permutation_get(pix_perm, i); P[ipix] = -INFINITY; } /* Use our own error handler while in parallel section to avoid concurrent * calls to the GSL error handler, which if provided by the user may not * be threadsafe. */ old_handler = gsl_set_error_handler(my_gsl_error); /* Compute posterior factor for amplitude consistency. */ #pragma omp parallel for firstprivate(gsl_errno) lastprivate(gsl_errno) for (i = 0; i < maxpix; i ++) { /* Cancel further computation if a GSL error condition has occurred. * * Note: if one thread sets gsl_errno, not necessarily all thread will * get the updated value. That's OK, because most failure modes will * cause GSL error conditions on all threads. If we cared to have any * failure on any thread terminate all of the other threads as quickly * as possible, then we would want to insert the following pragma here: * * #pragma omp flush(gsl_errno) * * and likewise before any point where we set gsl_errno. */ if (gsl_errno != GSL_SUCCESS) goto skip; { long ipix = gsl_permutation_get(pix_perm, i); double F[nifos][2]; double theta, phi; int itwopsi, iu, iifo; double accum = -INFINITY; /* Prepare workspace for adaptive integrator. */ gsl_integration_workspace *workspace = gsl_integration_workspace_alloc(subdivision_limit); /* If the workspace could not be allocated, then record the GSL * error value for later reporting when we leave the parallel * section. Then, skip to the next loop iteration. */ if (!workspace) { gsl_errno = GSL_ENOMEM; goto skip; } /* Look up polar coordinates of this pixel */ pix2ang_ring(nside, ipix, &theta, &phi); /* Look up antenna factors */ for (iifo = 0; iifo < nifos; iifo ++) { XLALComputeDetAMResponse(&F[iifo][0], &F[iifo][1], responses[iifo], phi, M_PI_2 - theta, 0, gmst); F[iifo][0] *= d1[iifo]; F[iifo][1] *= d1[iifo]; } /* Integrate over 2*psi */ for (itwopsi = 0; itwopsi < ntwopsi; itwopsi++) { const double twopsi = (2 * M_PI / ntwopsi) * itwopsi; const double costwopsi = cos(twopsi); const double sintwopsi = sin(twopsi); /* Integrate over u; since integrand only depends on u^2 we only * have to go from u=0 to u=1. We want to include u=1, so the upper * limit has to be <= */ for (iu = 0; iu <= nu; iu++) { const double u = (double)iu / nu; const double u2 = gsl_pow_2(u); const double u4 = gsl_pow_2(u2); double A = 0, B = 0; double breakpoints[5]; int num_breakpoints = 0; double log_offset = -INFINITY; /* The log-likelihood is quadratic in the estimated and true * values of the SNR, and in 1/r. It is of the form A/r^2 + B/r, * where A depends only on the true values of the SNR and is * strictly negative and B depends on both the true values and * the estimates and is strictly positive. * * The middle breakpoint is at the maximum of the log-likelihood, * occurring at 1/r=-B/2A. The lower and upper breakpoints occur * when the likelihood becomes eta times its maximum value. This * occurs when * * A/r^2 + B/r = log(eta) - B^2/4A. * */ /* Loop over detectors */ for (iifo = 0; iifo < nifos; iifo++) { const double Fp = F[iifo][0]; /* `plus' antenna factor times r */ const double Fx = F[iifo][1]; /* `cross' antenna factor times r */ const double FpFx = Fp * Fx; const double FpFp = gsl_pow_2(Fp); const double FxFx = gsl_pow_2(Fx); const double rhotimesr2 = 0.125 * ((FpFp + FxFx) * (1 + 6*u2 + u4) - gsl_pow_2(1 - u2) * ((FpFp - FxFx) * costwopsi + 2 * FpFx * sintwopsi)); const double rhotimesr = sqrt(rhotimesr2); /* FIXME: due to roundoff, rhotimesr2 can be very small and * negative rather than simply zero. If this happens, don't accumulate the log-likelihood terms for this detector. */ if (rhotimesr2 > 0) { A += rhotimesr2; B += rhotimesr * snrs[iifo]; } } A *= -0.5; { const double middle_breakpoint = -2 * A / B; const double lower_breakpoint = 1 / (1 / middle_breakpoint + sqrt(log(eta) / A)); const double upper_breakpoint = 1 / (1 / middle_breakpoint - sqrt(log(eta) / A)); breakpoints[num_breakpoints++] = min_distance; if(lower_breakpoint > breakpoints[num_breakpoints-1] && lower_breakpoint < max_distance) breakpoints[num_breakpoints++] = lower_breakpoint; if(middle_breakpoint > breakpoints[num_breakpoints-1] && middle_breakpoint < max_distance) breakpoints[num_breakpoints++] = middle_breakpoint; if(upper_breakpoint > breakpoints[num_breakpoints-1] && upper_breakpoint < max_distance) breakpoints[num_breakpoints++] = upper_breakpoint; breakpoints[num_breakpoints++] = max_distance; } { /* * Set log_offset to the maximum of the logarithm of the * radial integrand evaluated at all of the breakpoints. */ int ibreakpoint; for (ibreakpoint = 0; ibreakpoint < num_breakpoints; ibreakpoint++) { const double new_log_offset = log_radial_integrand( breakpoints[ibreakpoint], A, B, prior_distance_power); if (new_log_offset < INFINITY && new_log_offset > log_offset) log_offset = new_log_offset; } } { /* Perform adaptive integration. Stop when a relative * accuracy of 0.05 has been reached. */ inner_integrand_params integrand_params = {A, B, log_offset, prior_distance_power}; const gsl_function func = {radial_integrand, &integrand_params}; double result, abserr; int ret = gsl_integration_qagp(&func, &breakpoints[0], num_breakpoints, DBL_MIN, 0.05, subdivision_limit, workspace, &result, &abserr); /* If the integrator failed, then record the GSL error * value for later reporting when we leave the parallel * section. Then, break out of the loop. */ if (ret != GSL_SUCCESS) { gsl_errno = ret; gsl_integration_workspace_free(workspace); goto skip; } /* Take the logarithm and put the log-normalization back in. */ result = log(result) + integrand_params.log_offset; /* Accumulate result. */ accum = logaddexp(accum, result); } } } /* Discard workspace for adaptive integrator. */ gsl_integration_workspace_free(workspace); /* Accumulate (log) posterior terms for SNR and TDOA. */ P[ipix] += accum; } skip: /* this statement intentionally left blank */; } /* Restore old error handler. */ gsl_set_error_handler(old_handler); /* Free permutation. */ gsl_permutation_free(pix_perm); /* Check if there was an error in any thread evaluating any pixel. If there * was, raise the error and return. */ if (gsl_errno != GSL_SUCCESS) { free(P); GSL_ERROR_NULL(gsl_strerror(gsl_errno), gsl_errno); } /* Exponentiate and normalize posterior. */ pix_perm = get_pixel_ranks(*npix, P); if (!pix_perm) { free(P); return NULL; } exp_normalize(*npix, P, pix_perm); gsl_permutation_free(pix_perm); return P; }