/* cumalative distribution function of -EPS_NDT-truncated N(mean, u) */
double randvar_normal_pos_cdf (double x, double mean, double u)
{
# define CUR_PROC "randvar_normal_pos_cdf"
#ifndef DO_WITH_GSL
double Fx, c;
#endif
if (x <= 0.0)
return (0.0);
if (u <= 0.0) {
mes_prot ("u <= 0.0 not allowed\n");
goto STOP;
}
#ifdef DO_WITH_GSL
/*
Function: int gsl_sf_erfc_e (double x, gsl_sf_result * result)
These routines compute the complementary error function
erfc(x) = 1 - erf(x) = 2/\sqrt(\pi) \int_x^\infty \exp(-t^2).
*/
return 1.0 + (gsl_sf_erf ((x - mean) / sqrt (u * 2)) -
1.0) / gsl_sf_erfc ((-mean) / sqrt (u * 2));
#else
/*The denominator is possibly < EPS??? Check that ? */
Fx = randvar_get_PHI ((x - mean) / sqrt (u));
c = randvar_get_1overa (-EPS_NDT, mean, u);
return (c * (Fx - 1) + 1);
#endif /* DO_WITH_GSL */
STOP:
return (-1.0);
# undef CUR_PROC
} /* double randvar_normal_cdf */
/* the GSL headers specify double x, not const double x */
double FC_FUNC_(oct_erfc, OCT_ERFC)
(const double *x)
{
/* avoid floating invalids in the asymptotic limit */
if(*x > 20.0) return 0.0;
if(*x < -20.0) return 2.0;
/* otherwise call gsl */
return gsl_sf_erfc(*x);
}
double gauss_exp_inv::get1_2(double x_){
x = x_;
vmax = -x/log(1.0-threashold);
vmin = vmax*vmin_factor;
v.resize(vnum);
f.resize(vnum);
v[0] = 0.0;
f[0] = 0.0;
for(size_t i=1; i<vnum; ++i){
v[i] = vmin*exp(log(vmax/vmin)/(vnum-2)*(i-1));
f[i] = exp(-x/v[i])*0.5*(0.5*sqrt(M_PI)*gsl_sf_erfc(v[i]) + v[i]*exp(-v[i]*v[i]));
}
interp.set(v, f, mygsl::interp::Cspline);
double val = interp.getinteg(0.0, vmax);
val += -sqrt(M_PI)*0.25*vmax*gsl_sf_erfc(vmax)
+ 0.5*(0.5*sqrt(M_PI)+1.0)*(0.5*exp(-vmax*vmax)+sqrt(M_PI)*0.25*gsl_sf_erfc(vmax));
return val;
}
scalar int_GLxprod_Area(sasfit_param *param)
{
scalar u;
if (SHAPE == 0.0) {
return WIDTH*sqrt(2.0*M_PI);
}
u = 0.5*(1.0-SHAPE)/SHAPE;
return WIDTH*M_PI/sqrt(SHAPE)*exp(u)*gsl_sf_erfc(sqrt(u));
}
double gauss_exp_inv::get0(double x_){
x = x_;
vmax = -x/log(1.0-threashold);
vmin = vmax*vmin_factor;
v.resize(vnum);
f.resize(vnum);
v[0] = 0.0;
f[0] = 0.0;
for(size_t i=1; i<vnum; ++i){
v[i] = vmin*exp(log(vmax/vmin)/(vnum-2)*(i-1));
f[i] = exp(-v[i]*v[i] - x/v[i]);
}
interp.set(v, f, mygsl::interp::Cspline);
return interp.getinteg(0.0, vmax) + 0.5*gsl_sf_erfc(vmax)*sqrt(M_PI);
}
double
gsl_ran_gaussian_tail_pdf (const double x, const double a, const double sigma)
{
if (x < a)
{
return 0;
}
else
{
double N, p;
double u = x / sigma ;
double f = gsl_sf_erfc (a / (sqrt (2.0) * sigma));
N = 0.5 * f;
p = (1 / (N * sqrt (2 * M_PI) * sigma)) * exp (-u * u / 2);
return p;
}
}
/*
* Calculate peak parameters for a peak at d (d-spacing value)
* Output will be written to parameter map too.
*/
void LeBailFunction::calPeakParametersForD(double dh, double& alpha, double& beta, double &Tof_h,
double &sigma_g2, double &gamma_l, std::map<std::string, double>& parmap) const
{
// 1. Get some parameters
double wcross = getParameter("Width");
double Tcross = getParameter("Tcross");
// 2. Start to calculate alpha, beta, sigma2, gamma,
double n = 0.5*gsl_sf_erfc(wcross*(Tcross-1/dh));
double alpha_e = Alph0 + Alph1*dh;
double alpha_t = Alph0t - Alph1t/dh;
alpha = 1/(n*alpha_e + (1-n)*alpha_t);
double beta_e = Beta0 + Beta1*dh;
double beta_t = Beta0t - Beta1t/dh;
beta = 1/(n*beta_e + (1-n)*beta_t);
double Th_e = Zero + Dtt1*dh;
double Th_t = Zerot + Dtt1t*dh - Dtt2t/dh;
Tof_h = n*Th_e + (1-n)*Th_t;
sigma_g2 = Sig0 + Sig1*std::pow(dh, 2) + Sig2*std::pow(dh, 4);
gamma_l = Gam0 + Gam1*dh + Gam2*std::pow(dh, 2);
// 3. Add to parameter map
parmap.insert(std::make_pair("Alpha", alpha));
parmap.insert(std::make_pair("Beta", beta));
parmap.insert(std::make_pair("Sigma2", sigma_g2));
parmap.insert(std::make_pair("Gamma", gamma_l));
parmap.insert(std::make_pair("TOF_h", Tof_h));
g_log.debug() << "DB1214 D = " << dh << ", TOF = " << Tof_h << std::endl;
return;
}
/* main program loop */
INT4 main(INT4 argc, CHAR *argv[])
{
/* status */
LALStatus status = blank_status;
/* LALgetopt flags */
static int text_flag;
static int cat_flag;
static int analyse_flag;
static int powerlaw_flag;
/* counters */
INT4 i, j;
/* combined statistics variables */
REAL8 numerator = 0;
REAL8 denominator = 0;
REAL8 yOpt = 0;
REAL8 sigmaOpt = 0;
REAL8 confidence = 0.95;
REAL8 zeta;
REAL8 upperlimit;
/* pdf */
REAL8 exponent;
REAL8 pdf[100];
REAL8 min_omega;
REAL8 max_omega;
REAL8 min_alpha = -1;
REAL8 max_alpha = 1;
REAL8 omega;
REAL8 alpha;
/* powerlaw pdf */
REAL8 pdf_powerlaw[100][100];
REAL8 freq;
REAL8 freq_ref = 100;
REAL8 omega_numerator;
REAL8 omega_denominator;
REAL8 sigma2_denominator;
REAL8 omega_hat[100];
REAL8 sigma2_omega_hat[100];
/* program option variables */
CHAR *outputFileName = NULL;
/* xml data structures */
LIGOLwXMLStream xmlStream;
INT4 numSegments = 0;
StochasticTable *stochHead = NULL;
StochasticTable *thisStoch = NULL;
MetadataTable outputTable;
StochasticTable **stochHandle = NULL;
/* text output file */
FILE *out;
FILE *pdf_out;
FILE *omega_out;
FILE *sigma_out;
/* parse command line arguments */
while (1)
{
/* LALgetopt arguments */
static struct LALoption long_options[] =
{
/* options that set a flag */
{"verbose", no_argument, &vrbflg, 1},
{"text", no_argument, &text_flag, 1},
{"cat-only", no_argument, &cat_flag, 1},
{"analyse-only", no_argument, &analyse_flag, 1},
{"powerlaw-pdf", no_argument, &powerlaw_flag, 1},
/* options that don't set a flag */
{"help", no_argument, 0, 'h'},
{"version", no_argument, 0, 'v'},
{"output", required_argument, 0, 'o'},
{"confidence", required_argument, 0, 'c'},
{0, 0, 0, 0}
};
int c;
/* LALgetopt_long stores the option index here. */
int option_index = 0;
size_t LALoptarg_len;
c = LALgetopt_long_only(argc, argv, "hvo:c:", long_options, &option_index);
/* detect the end of the options */
if (c == - 1)
{
/* end of options, break loop */
break;
}
switch (c)
{
case 0:
/* If this option set a flag, do nothing else now. */
if (long_options[option_index].flag != 0)
{
break;
}
else
{
fprintf(stderr, "error parseing option %s with argument %s\n", \
long_options[option_index].name, LALoptarg);
exit(1);
}
break;
case 'h':
fprintf(stdout, USAGE);
exit(0);
break;
case 'v':
/* display version info and exit */
fprintf(stdout, "Stochastic Post Processing: Bayesian\n");
XLALOutputVersionString(stderr,0);
exit(0);
break;
case 'o':
/* create storage for the output file name */
LALoptarg_len = strlen(LALoptarg) + 1;
outputFileName = (CHAR *)calloc(LALoptarg_len, sizeof(CHAR));
memcpy(outputFileName, LALoptarg, LALoptarg_len);
break;
case 'c':
/* confidence level */
confidence = atof(LALoptarg);
if ((confidence >= 1) || (confidence <= 0))
{
fprintf(stderr, "invalid argument to --%s\n" \
"confidence must be between 0 and 1, exclusive " \
"(%.2f specified)\n", long_options[option_index].name, \
confidence);
exit(1);
}
break;
case '?':
exit(1);
break;
default:
fprintf(stderr, "Unknown error while parsing options\n");
exit(1);
}
}
/* read in the input data from the rest of the arguments */
if (LALoptind < argc)
{
for (i = LALoptind; i < argc; ++i)
{
struct stat infileStatus;
/* if the named file does not exist, exit with an error */
if (stat(argv[i], &infileStatus) == -1)
{
fprintf(stderr, "Error opening input file \"%s\"\n", argv[i]);
exit(1);
}
if (!stochHead)
{
stochHandle = &stochHead;
}
else
{
stochHandle = &thisStoch->next;
}
/* read in the stochastic table */
numSegments = LALStochasticTableFromLIGOLw(stochHandle, argv[i]);
if (numSegments < 0)
{
fprintf(stderr, "Unable to read stochastic_table from \"%s\"\n", \
argv[i]);
exit(1);
}
else if (numSegments > 0)
{
if (vrbflg)
{
fprintf(stdout, "Read in %d segments from file \"%s\"\n", \
numSegments, argv[i]);
}
/* scroll to end of list */
thisStoch = *stochHandle;
while (thisStoch->next)
{
thisStoch = thisStoch->next;
}
}
}
}
if (!cat_flag)
{
/* combine statistics */
for (thisStoch = stochHead; thisStoch; thisStoch = thisStoch->next)
{
numerator += thisStoch->cc_stat / (thisStoch->cc_sigma * \
thisStoch->cc_sigma);
denominator += 1./(thisStoch->cc_sigma * thisStoch->cc_sigma);
}
yOpt = (1./stochHead->duration.gpsSeconds) * (numerator / denominator);
sigmaOpt = (1./stochHead->duration.gpsSeconds) * (1./sqrt(denominator));
/* report point estimate and sigma */
fprintf(stdout, "yOpt = %e\n", yOpt);
fprintf(stdout, "sigmaOpt = %e\n", sigmaOpt);
/* calculate upperlimit */
zeta = yOpt / (sqrt(2) * sigmaOpt);
upperlimit = yOpt + (sqrt(2) * sigmaOpt * \
stopp_erfcinv((1 - confidence) * gsl_sf_erfc(-zeta)));
fprintf(stdout, "upperlimit = %e\n", upperlimit);
}
/* calculate pdf */
if (!powerlaw_flag)
{
/* pdf for constant spectra */
min_omega = 0;
max_omega = yOpt + (3 * sigmaOpt);
for (i = 0; i < 100; i++)
{
omega = min_omega + (((i - 1)/99.) * (max_omega - min_omega));
exponent = ((omega - yOpt) / sigmaOpt) * ((omega - yOpt) / sigmaOpt);
pdf[i] = exp(-0.5 * exponent);
}
}
else
{
/* pdf for power law spectra */
min_omega = 0;
max_omega = 1; /*(10 * yOpt)/stochHead->duration.gpsSeconds;*/
min_alpha = -4;
max_alpha = 4;
/* loop for \Omega_R */
for (i = 0; i < 100; i++)
{
/* loop for \alpha */
for (j = 0; j < 100; j++)
{
omega = min_omega + ((i/99.) * (max_omega - min_omega));
alpha = min_alpha + ((j/99.) * (max_alpha - min_alpha));
/* initialise numerator */
omega_numerator = 0;
omega_denominator = 0;
sigma2_denominator = 0;
/* loop over segments */
for (thisStoch = stochHead; thisStoch; thisStoch = thisStoch->next)
{
/* get frequency of middle of the band */
freq = thisStoch->f_min + ((thisStoch->f_max - \
thisStoch->f_min) / 2.);
/* \hat{\Omega}_R */
omega_numerator += (thisStoch->cc_stat / (thisStoch->cc_sigma * \
thisStoch->cc_sigma)) * pow((freq/freq_ref), alpha);
omega_denominator += (1. / (thisStoch->cc_sigma * \
thisStoch->cc_sigma)) * pow((freq/freq_ref), 2 * alpha);
/* sigma^2_{\hat{\Omega}_R} */
sigma2_denominator += (1. / (thisStoch->cc_sigma * \
thisStoch->cc_sigma)) * pow((freq/freq_ref), 2 * alpha);
}
/* construct \hat{\Omega}_R */
omega_hat[j] = omega_numerator / (stochHead->duration.gpsSeconds * \
omega_denominator);
/* construct sigma^2_{\hat{\Omega}_R} */
sigma2_omega_hat[j] = 1. / (stochHead->duration.gpsSeconds * \
stochHead->duration.gpsSeconds * sigma2_denominator);
/* construct pdf */
pdf_powerlaw[i][j] = exp(-0.5 * ((omega - omega_hat[j]) / \
sqrt(sigma2_omega_hat[j])) * ((omega - omega_hat[j]) / \
sqrt(sigma2_omega_hat[j])));
}
}
}
if (!cat_flag)
{
if (powerlaw_flag)
{
/* open omega and sigma output files */
if ((omega_out = fopen("omega.dat", "w")) == NULL)
{
fprintf(stderr, "Can't open file for omega output...\n");
exit(1);
}
if ((sigma_out = fopen("sigma.dat", "w")) == NULL)
{
fprintf(stderr, "Can't open file for sigma output...\n");
exit(1);
}
/* save out omega and sigma */
for (j = 0; j < 100; j++)
{
alpha = min_alpha + ((j/99.) * (max_alpha - min_alpha));
fprintf(omega_out, "%e %e\n", alpha, omega_hat[j]);
fprintf(sigma_out, "%e %e\n", alpha, sqrt(sigma2_omega_hat[j]));
}
/* close files */
fclose(omega_out);
fclose(sigma_out);
}
/* save out pdf */
if ((pdf_out = fopen("pdf.dat", "w")) == NULL)
{
fprintf(stderr, "Can't open file for pdf output...\n");
exit(1);
}
if (powerlaw_flag)
{
for (i = 0; i < 100; i++)
{
for (j = 0; j < 100; j++)
{
omega = min_omega + ((i/99.) * (max_omega - min_omega));
alpha = min_alpha + ((j/99.) * (max_alpha - min_alpha));
fprintf(pdf_out, "%e %e %e\n", omega, alpha, pdf_powerlaw[i][j]);
}
/* gnuplot */
fprintf(pdf_out, "\n");
}
}
else
{
for (i = 0; i < 100; i++)
{
omega = min_omega + (((i - 1)/99.) * (max_omega - min_omega));
fprintf(pdf_out, "%e %e\n", omega, pdf[i]);
}
}
fclose(pdf_out);
}
if (!analyse_flag)
{
/* output as text file */
if (text_flag)
{
/* open output file */
if ((out = fopen(outputFileName, "w")) == NULL)
{
fprintf(stderr, "Can't open file \"%s\" for output...\n", \
outputFileName);
exit(1);
}
/* write details of events */
for (thisStoch = stochHead; thisStoch; thisStoch = thisStoch->next)
{
fprintf(out, "%d %e %e\n", thisStoch->start_time.gpsSeconds, \
thisStoch->cc_stat, thisStoch->cc_sigma);
}
/* close output file */
fclose(out);
}
/* output as xml file */
else
{
/* open xml file stream */
memset(&xmlStream, 0, sizeof(LIGOLwXMLStream));
LAL_CALL(LALOpenLIGOLwXMLFile(&status, &xmlStream, outputFileName), \
&status);
/* write stochastic table */
if (stochHead)
{
outputTable.stochasticTable = stochHead;
LAL_CALL(LALBeginLIGOLwXMLTable(&status, &xmlStream, \
stochastic_table), &status);
LAL_CALL(LALWriteLIGOLwXMLTable(&status, &xmlStream, outputTable, \
stochastic_table), &status);
LAL_CALL(LALEndLIGOLwXMLTable(&status, &xmlStream), &status);
}
/* close xml file */
LAL_CALL(LALCloseLIGOLwXMLFile(&status, &xmlStream), &status);
}
}
/* check for memory leaks and exit */
LALCheckMemoryLeaks();
exit(0);
}
static VALUE Error_erfc(VALUE self, VALUE x) {
return rb_float_new(gsl_sf_erfc(NUM2DBL(x)));
}
/*============================================================================*/
double randvar_get_1overa (double x, double mean, double u)
{
/* Calulates 1/a(x, mean, u), with a = the integral from x til \infty over
the Gauss density function */
# define CUR_PROC "randvar_get_1overa"
#ifdef DO_WITH_GSL
double erfc_value;
#else
int i;
double y, z, phi_z, a;
#endif
if (u <= 0.0) {
mes_prot ("u <= 0.0 not allowed\n");
goto STOP;
}
#ifdef DO_WITH_GSL
/* int gsl_sf_erfc (double x)
erfc(x) = 1 - erf(x) = 2/\sqrt(\pi) \int_x^\infty \exp(-t^2)
*/
erfc_value = gsl_sf_erfc ((x - mean) / sqrt (u * 2));
if (erfc_value <= DBL_MIN) {
mes (MES_WIN, "a ~= 0.0 critical! (mue = %.2f, u =%.2f)\n", mean, u);
return (erfc_value);
}
else
return (2.0 / erfc_value);
#else
if (randvar_init_PHI () == -1) {
mes_proc ();
goto STOP;
};
y = 1 / sqrt (u);
z = (x - mean) * y;
/* Linear interpolation (Alternative: Round off with i=m_int(fabs(z)*X_FAKT)) */
i = (int) (fabs (z) * X_FAKT_PHI);
if (i >= PHI_len - 1) {
i = PHI_len - 2;
/* Originally:
i = PHI_len-1; but then, the last value in the table is zero! */
phi_z = PHI[i];
}
else
phi_z =
PHI[i] + (fabs (z) - i * X_STEP_PHI) * (PHI[i + 1] -
PHI[i]) / X_STEP_PHI;
/* NOTA BENE: PHI is tabulated for negative values! */
if (z > 0.0) {
if (phi_z == 0) {
mes_proc ();
goto STOP;
}
else
a = 1 / phi_z; /* PHI between 0.5 and 1 */ /* ??? between 0.5 and 0 ! */
}
else {
a = 1 - phi_z;
if (a > DBL_MIN)
a = 1 / a;
else {
a = 0.0;
mes (MES_WIN, "a ~= 0.0 critical! (mue = %.2f, u =%.2f)\n", mean, u); /* goto STOP; */
}
}
return a;
#endif
STOP:
return (-1.0);
# undef CUR_PROC
} /* randvar_get_1overa */
double normcdf(double sq2,double x)
{
return gsl_sf_erfc(x/sq2)/2;
}
