int Predictor::addPrediction(double predStart, double predEnd, double predStartSd,
double predEndSd, double postIO, int pos, int verbose)
{
// Only add if proper prediction (non-nan)
if (!gsl_isnan(predStart) && !gsl_isnan(predEnd) && !gsl_isnan(postIO))
{
// Empty multimap: just add prediction
if (starts.empty())
{
starts.insert(createMapPair(predStart, predEnd, postIO, predStartSd, predEndSd, (double)scnt));
ends.insert(createMapPair(predEnd, predStart, postIO, predStartSd, predEndSd, (double)ecnt));
scnt++;
ecnt++;
}
// Non-empty multimap
else
{
multimap<double,Info*,comp>::reverse_iterator end = ends.rbegin();
// New prediction sufficiently far away from the old ones?
if (pos - end->first >= min(ws,maxD))
{
this->flush(verbose);
}
starts.insert(createMapPair(predStart, predEnd, postIO, predStartSd, predEndSd, (double)scnt));
ends.insert(createMapPair(predEnd, predStart, postIO, predStartSd, predEndSd, (double)ecnt));
scnt++;
ecnt++;
}
}
return(0);
}
//cut/pasted from Apophenia/model/apop_pmf.c. It should be an apop_data_rowcmp function.
static int are_equal(apop_data const *left, apop_data const *right){
if (left->vector){
if (!right->vector ||
(*left->vector->data != *right->vector->data
&& !(gsl_isnan(*left->vector->data) && gsl_isnan(*right->vector->data))))
return 0;
} else if (right->vector) return 0;
if (left->matrix){
if (!right->matrix ||
left->matrix->size2 != right->matrix->size2) return 0;
for (int i=0; i< left->matrix->size2; i++){
double L = gsl_matrix_get(left->matrix, 0, i);
double R = gsl_matrix_get(right->matrix, 0, i);
if (L != R && !(gsl_isnan(L) && gsl_isnan(R))) return 0;
}
}
else if (right->matrix) return 0;
if (left->textsize[1]){
if (left->textsize[1] != right->textsize[1]) return 0;
for (int i=0; i< left->textsize[1]; i++)
if (strcmp(left->text[0][i], right->text[0][i])) return 0;
}
else if (right->textsize[1]) return 0;
return 1;
}
void pix_bound(int resolution, unsigned long pixnum,
double *lammin, double *lammax, double *etamin, double *etamax)
{
extern unsigned long nx0, ny0;
extern double deg2Rad, rad2Deg, strad2Deg;
unsigned long nx, ny, i, j;
/* Returns ETA-LAMBDA boundaries for a given pixel index.
Also in IDL: pix_bound.pro
*/
nx = nx0*resolution;
ny = ny0*resolution;
j = pixnum/nx;
i = pixnum - nx*j;
*lammin = 90.0 - rad2Deg*acos(1.0 - 2.0*(j+1)/ny);
*lammax = 90.0 - rad2Deg*acos(1.0 - 2.0*j/ny);
*etamin = rad2Deg*2.0*M_PI*(i+0.0)/nx + etaOffSet;
if (*etamin >= 180.0) *etamin = *etamin - 360.0;
*etamax = rad2Deg*2.0*M_PI*(i+1.0)/nx + etaOffSet;
if (*etamax >= 180.0) *etamax = *etamax - 360.0;
if (gsl_isnan(*etamin))
printf("NaN error on eta minimum: %lu %i %li %li %li %lf\n",
pixnum,resolution,i,j,nx,1.0*(i+0.0)/nx);
if (gsl_isnan(*etamax))
printf("NaN error on eta maximum: %lu %i %li %li %li %lf\n",
pixnum,resolution,i,j,nx,1.0*(i+1.0)/nx);
}
double MyParser::EvalRemoveSingularity(double *xvar)
{
try {
double result = Eval();
if ( gsl_isinf(result) || gsl_isnan(result) )
throw Singularity();
return result;
} catch (Singularity) {
try {
if (isinf(Eval()))
throw Pole();
int n;
frexp (*xvar, &n);
double xp = *xvar + ldexp(DBL_EPSILON,n);
double xm = *xvar - ldexp(DBL_EPSILON,n);
*xvar = xp;
double yp = Eval();
if (gsl_isinf(yp) || gsl_isnan(yp))
throw Pole();
*xvar = xm;
double ym = Eval();
if (gsl_isinf(ym) || gsl_isnan(ym))
throw Pole();
return (yp + ym)/2;
} catch (Pole) {
SingularityErrorMessage(*xvar);
return GSL_ESING;
}
}
}
bool Matrix::isEmpty()
{
double min, max;
range(&min, &max);
if (gsl_isnan(min) && gsl_isnan(max))
return true;
return false;
}
/** *************************************************************************************
*****************************************************************************************
*****************************************************************************************/
void rv_dg_pois_outer_marg_R (int Rn, double *betashortDBL, double *dgvalueshortDBL, void *params)/* void rv_dg_outer_marg_R(int n, double *betaDBL, double *dgvaluesDBL,void *params);*/
{
struct fnparams *gparams = ((struct fnparams *) params);
gsl_vector *betaincTau = ((struct fnparams *) params)->betafull;/** will hold "full beta vector" inc precision **/
double betafixed = ((struct fnparams *) params)->betafixed;/** the fixed beta value passed through**/
int betaindex = ((struct fnparams *) params)->betaindex;
gsl_function F;int i,j;
int haveTau=0;
double result, abserr;
double h=((struct fnparams *) gparams)->finitestepsize;
gparams->betaincTau=betaincTau;/** copy memory location */
/** copy betashort - which is marginal and therefore lacks one entry - and copy it into a complex beta */
if(betaindex==0){gsl_vector_set(betaincTau,0,betafixed);
for(i=1;i<betaincTau->size;i++){gsl_vector_set(betaincTau,i,betashortDBL[i-1]);}}
if(betaindex==(betaincTau->size-1)){gsl_vector_set(betaincTau,betaincTau->size-1,betafixed);
for(i=0;i<betaincTau->size-1;i++){gsl_vector_set(betaincTau,i,betashortDBL[i]);}}
if(betaindex>0 && betaindex<(betaincTau->size-1)){
for(i=0;i<betaindex;i++){gsl_vector_set(betaincTau,i,betashortDBL[i]);}
gsl_vector_set(betaincTau,betaindex,betafixed);
for(i=betaindex+1;i<betaincTau->size;i++){gsl_vector_set(betaincTau,i,betashortDBL[i-1]);}
}
if(gsl_vector_get(betaincTau,betaincTau->size-1)<0.0){error("negative tau in rv_dg_outer_marg_R\n");}
F.function = &g_outer_pois_single;
F.params = gparams;
j=0;
for(i=0;i<Rn+1;i++){ /** each of the partial derivatives for the full non-marginal vector*/
if(i!=betaindex){/** ignore the marginal variable here - it is fixed globally outside the partial derivs*/
gparams->fixed_index=i;
if(i== Rn){haveTau=1;} else {haveTau=0;}
/** readme - evaluating f() at a negative value e.g. tau-h **/
if(!haveTau){gsl_deriv_central (&F, gsl_vector_get(betaincTau,i), h, &result, &abserr);/*Rprintf("fixed=%d val=%f\n",i,result);*/
} else { /** first try central and if this goes into negative tau area then revert to forwards **/
gsl_deriv_central(&F, gsl_vector_get(betaincTau,i), h, &result, &abserr);
if(gsl_isnan(abserr)){gsl_deriv_forward(&F, gsl_vector_get(betaincTau,i), h, &result, &abserr);}
}
dgvalueshortDBL[j++]=result;
}
}
for(i=0;i<Rn;i++){if(gsl_isnan(dgvalueshortDBL[i])){error("nan is rv_dg_pois_outer_marg\n");}}
/*}*/
/*if(betafixed>2.34){Rprintf("betaincTau=");for(i=0;i<betaincTau->size;i++){Rprintf("%f ",i,gsl_vector_get(betaincTau,i));}Rprintf("\n");
for(i=0;i<dgvalueshort->size;i++){Rprintf("deriv=%d %f\n",i,gsl_vector_get(dgvalueshort,i));}
Rprintf("error=%f\n",abserr);}*/
/*Rprintf("rv_dg_outer_marg end\n");*/
/*Rprintf("dgvals\n");
for(i=0;i<Rn;i++){Rprintf(" %10.10f ",dgvalueshortDBL[i]);}Rprintf("\n");*/
}
/** If there is an NaN anywhere in the row of data (including the matrix, the vector, the weights, and the text) then delete the row from the data set.
\li If every row has an NaN, then this returns \c NULL.
\li If \c apop_opts.db_nan is not \c NULL, then I will use that as a regular expression to check the text elements for bad data as well.
\li If \c inplace = 'y', then I'll free each element of the input data
set and refill it with the pruned elements. I'll still take up (up to)
twice the size of the data set in memory during the function. If
every row has an NaN, then your \c apop_data set will end up with
\c NULL vector, matrix, \dots. if \c inplace = 'n', then the original data set is left unmolested.
\li I only look at the first page of data (i.e. the \c more element is ignored).
\li This function uses the \ref designated syntax for inputs.
\param d The data, with NaNs
\param inplace If \c 'y', clear out the pointer-to-\ref apop_data that
you sent in and refill with the pruned data. If \c 'n', leave the
set alone and return a new data set.
\return A (potentially shorter) copy of the data set, without
NaNs. If <tt>inplace=='y'</tt>, redundant with the input. If the entire data set is
cleared out, then this will be \c NULL.
*/
APOP_VAR_HEAD apop_data * apop_data_listwise_delete(apop_data *d, char inplace){
apop_data * apop_varad_var(d, NULL);
if (!d) return NULL;
char apop_varad_var(inplace, 'n');
APOP_VAR_ENDHEAD
Get_vmsizes(d) //defines firstcol, vsize, wsize, msize1, msize2.
apop_assert_c(msize1 || vsize || d->textsize[0], NULL, 0,
"You sent to apop_data_listwise_delete a data set with NULL matrix, NULL vector, and no text. "
"Confused, it is returning NULL.");
//find out where the NaNs are
int len = GSL_MAX(vsize ? vsize : msize1, d->textsize[0]); //still some size assumptions here.
int not_empty = 0;
int *marked = calloc(len, sizeof(int));
for (int i=0; i< (vsize ? vsize: msize1); i++)
for (int j=firstcol; j <msize2; j++){
if (gsl_isnan(apop_data_get(d, i, j))){
marked[i] = 1;
break;
}
}
for (int i=0; i< wsize; i++)
if (gsl_isnan(gsl_vector_get(d->weights, i)))
marked[i] = 1;
if (d->textsize[0] && apop_opts.db_nan){
regex_t rex;
int compiled_ok = !regcomp(&rex, apop_opts.db_nan, REG_EXTENDED + REG_ICASE + REG_NOSUB);
apop_assert(compiled_ok, "apop_opts.db_nan needs to be a regular expression that "
"I can use to check the text element of your data set for "
"NaNs, But compiling %s into a regex failed. Or, set "
"apop_opts.db_nan=NULL to bypass text checking.", apop_opts.db_nan);
for(int i=0; i< d->textsize[0]; i++)
if (!marked[i])
for(int j=0; j< d->textsize[1]; j++)
if (!regexec(&rex, d->text[i][j], 0, 0, 0)){
marked[i] ++;
break;
}
regfree(&rex);
}
//check that at least something isn't NULL.
for (int i=0; i< len; i++)
if (!marked[i]){
not_empty ++;
break;
}
if (!not_empty){
free(marked);
return NULL;
}
apop_data *out = (inplace=='y'|| inplace=='Y') ? d : apop_data_copy(d);
apop_data_rm_rows(out, marked);
free(marked);
return out;
}
static void find_nearest_point(gsl_vector *V, double k, gsl_vector *B, gsl_vector *out){
/* Find X such that BX =K and there is an S such that X + SB=V. */
double S=0; //S = (BV-K)/B'B.
gsl_blas_ddot(B, V, &S);
S -= k;
assert(!gsl_isnan(S));
S /= magnitude(B);
assert(!gsl_isnan(S));
gsl_vector_memcpy(out, B); //X = -SB +V
gsl_vector_scale(out, -S);
gsl_vector_add(out, V);
assert(!gsl_isnan(gsl_vector_get(out,0)));
}
bool SDProb::init_direction (const Point& seed_dir)
{
float values [source.dim(3)];
if (get_source_data (pos, values)) return (true);
if (!seed_dir) {
for (int n = 0; n < max_trials; n++) {
dir.set (rng.normal(), rng.normal(), rng.normal());
dir.normalise();
float val = precomputed ?
SH::value_precomputed (values, dir) :
SH::value (values, dir, lmax);
if (!gsl_isnan (val)) if (val > init_threshold) return (false);
}
}
else {
dir = seed_dir;
float val = precomputed ?
SH::value_precomputed (values, dir) :
SH::value (values, dir, lmax);
if (gsl_finite (val)) if (val > init_threshold) return (false);
}
return (true);
}
/*!
Returns true if the matrix has >0 NaN element.
*/
bool HasNaN(const gsl_matrix_complex *const M)
{
gsl_complex z;
for(int i = 0; i < M->size1; ++i)
{
for(int j = 0; j < M->size2; ++j)
{
z = gsl_matrix_complex_get(M, i, j);
if(gsl_isnan(GSL_REAL(z)) || gsl_isnan(GSL_IMAG(z)))
return true;
}
}
return false;
}
double MatrixModel::cell(int row, int col) const {
int i = d_cols * row + col;
double val = d_data[i];
if (i < 0 || i >= d_rows * d_cols || gsl_isnan(val))
return 0.0;
return val;
}
/** **************************************************************************************************************/
int rv_g_inner_gaus (const gsl_vector *epsilonvec, void *params, double *gvalue)
{
double epsilon=gsl_vector_get(epsilonvec,0);
const gsl_vector *Y = ((struct fnparams *) params)->Y;/** response variable **/
const gsl_matrix *X = ((struct fnparams *) params)->X;/** design matrix INC epsilon col **/
const gsl_vector *beta = ((struct fnparams *) params)->beta;/** fixed covariate and precision terms **/
gsl_vector *vectmp1 = ((struct fnparams *) params)->vectmp1;
gsl_vector *vectmp1long = ((struct fnparams *) params)->vectmp1long;
gsl_vector *vectmp2long = ((struct fnparams *) params)->vectmp2long;
double tau_rv = gsl_vector_get(beta,beta->size-2);/** inc the precision terms - second last entries */
double tau_resid = gsl_vector_get(beta,beta->size-1);/** last entry - residual precision */
double n = (double)(Y->size);/** number of observations */
int i;
double term1,term2;
/** easy terms collected together - no Y,X, or betas **/
term1 = (n/2.0)*log(tau_resid/(2.0*M_PI)) - (tau_rv/2.0)*epsilon*epsilon + 0.5*log(tau_rv/(2.0*M_PI));
/** now for the more complex term */
/** the design matrix does not include precisions but does include epsilon, beta includes precisions but not epsilon. To use matrix operations
we make a copy of beta and replace one precision value with value for epsilon - copy into vectmp1 */
for(i=0;i<beta->size-2;i++){gsl_vector_set(vectmp1,i,gsl_vector_get(beta,i));} /** copy **/
gsl_vector_set(vectmp1,beta->size-2,epsilon); /** last entry in vectmp1 is not precision but epsilon **/
/*for(i=0;i<vectmp1->size;i++){Rprintf("=>%f\n",gsl_vector_get(vectmp1,i));} */
/** get X%*%beta where beta = (b0,b1,...,epsilon) and so we get a vector of b0*1+b1*x1i+b2*x2i+epsilon*1 for each obs i */
gsl_blas_dgemv (CblasNoTrans, 1.0, X, vectmp1, 0.0, vectmp1long);/** vectmp1long hold X%*%vectmp1 = X%*%mybeta **/
/*for(i=0;i<vectmp1long->size;i++){Rprintf("=%f\n",gsl_vector_get(vectmp1long,i));}*/
/*Rprintf("---\n");for(i=0;i<X->size1;i++){for(j=0;j<X->size2;j++){Rprintf("%f ",gsl_matrix_get(X,i,j));}Rprintf("\n");}Rprintf("---\n");*/
/*for(i=0;i<vectmp2long->size;i++){Rprintf(">%f\n",gsl_vector_get(vectmp2long,i));}*/
gsl_vector_scale(vectmp1long,-1.0);/** multiple each entry by -1 **/
gsl_vector_memcpy(vectmp2long,Y);/** vectmp2long becomes Y **/
gsl_vector_add(vectmp2long,vectmp1long);/** vectmp2long becomes Y-XB **/
/*for(i=0;i<vectmp2long->size;i++){Rprintf("> %f\n",gsl_vector_get(vectmp2long,i));}*/
/** need sum of (Y-XB)^2 so just do a dot product **/
gsl_vector_memcpy(vectmp1long,vectmp2long);/** copy vectmp2long into vectmp1long */
gsl_blas_ddot (vectmp2long, vectmp1long, &term2);/** just to get the sum of (Y-XB)^2 */
term2 *= -(tau_resid/2.0);
/*Rprintf("term2=%f epsilon=%f tau_resid=%f\n",term2,epsilon,tau_resid);*/
*gvalue = (-1.0/n)*(term1 + term2);
/*Rprintf("\n----value of term1 %f %f %f----\n",((storedbl1+storedbl2)*(-1/n)),term2,term3); */
if(gsl_isnan(*gvalue)){error("\n oops - got an NAN! in g_rv_g_inner_gaus-----\n");}
return GSL_SUCCESS;
}
apop_data * apop_bootstrap_cov_base(apop_data * data, apop_model *model, gsl_rng *rng, int iterations, char keep_boots, char ignore_nans, apop_data **boot_store){
#endif
Get_vmsizes(data); //vsize, msize1, msize2
apop_model *e = apop_model_copy(model);
apop_data *subset = apop_data_copy(data);
apop_data *array_of_boots = NULL,
*summary;
//prevent and infinite regression of covariance calculation.
Apop_model_add_group(e, apop_parts_wanted); //default wants for nothing.
size_t i, nan_draws=0;
apop_name *tmpnames = (data && data->names) ? data->names : NULL; //save on some copying below.
if (data && data->names) data->names = NULL;
int height = GSL_MAX(msize1, GSL_MAX(vsize, (data?(*data->textsize):0)));
for (i=0; i<iterations && nan_draws < iterations; i++){
for (size_t j=0; j< height; j++){ //create the data set
size_t randrow = gsl_rng_uniform_int(rng, height);
apop_data_memcpy(Apop_r(subset, j), Apop_r(data, randrow));
}
//get the parameter estimates.
apop_model *est = apop_estimate(subset, e);
gsl_vector *estp = apop_data_pack(est->parameters);
if (!gsl_isnan(apop_sum(estp))){
if (i==0){
array_of_boots = apop_data_alloc(iterations, estp->size);
apop_name_stack(array_of_boots->names, est->parameters->names, 'c', 'v');
apop_name_stack(array_of_boots->names, est->parameters->names, 'c', 'c');
apop_name_stack(array_of_boots->names, est->parameters->names, 'c', 'r');
}
gsl_matrix_set_row(array_of_boots->matrix, i, estp);
} else if (ignore_nans=='y'){
i--;
nan_draws++;
}
apop_model_free(est);
gsl_vector_free(estp);
}
if(data) data->names = tmpnames;
apop_data_free(subset);
apop_model_free(e);
int set_error=0;
Apop_stopif(i == 0 && nan_draws == iterations, apop_return_data_error(N),
1, "I ran into %i NaNs and no not-NaN estimations, and so stopped. "
, iterations);
Apop_stopif(nan_draws == iterations, set_error++;
apop_matrix_realloc(array_of_boots->matrix, i, array_of_boots->matrix->size2),
1, "I ran into %i NaNs, and so stopped. Returning results based "
"on %zu bootstrap iterations.", iterations, i);
summary = apop_data_covariance(array_of_boots);
if (boot_store) *boot_store = array_of_boots;
else apop_data_free(array_of_boots);
if (set_error) summary->error = 'N';
return summary;
}
bool Matrix::canCalculate(bool useMuParser)
{
if (formula_str.isEmpty())
return false;
if (useMuParser){
muParserScript *mup = new muParserScript(scriptEnv, formula_str, this, QString("<%1>").arg(objectName()), false);
connect(mup, SIGNAL(error(const QString&,const QString&,int)), scriptEnv, SIGNAL(error(const QString&, const QString&,int)));
double *ri = mup->defineVariable("i");
double *rr = mup->defineVariable("row");
double *cj = mup->defineVariable("j");
double *cc = mup->defineVariable("col");
double *x = mup->defineVariable("x");
double *y = mup->defineVariable("y");
if (!mup->compile())
return false;
double r = 1.0;
*ri = r; *rr = r; *y = r;
double c = 1.0; *cj = c; *cc = c; *x = c;
int codeLines = mup->codeLines();
if (codeLines == 1 && gsl_isnan(mup->evalSingleLine()))
return false;
else if (codeLines > 1){
QVariant res = mup->eval();
if (!res.canConvert(QVariant::Double))
return false;
}
} else {
Script *script = scriptEnv->newScript(formula_str, this, QString("<%1>").arg(objectName()));
connect(script, SIGNAL(error(const QString&,const QString&,int)), scriptEnv, SIGNAL(error(const QString&,const QString&,int)));
connect(script, SIGNAL(print(const QString&)), scriptEnv, SIGNAL(print(const QString&)));
if (!script->compile())
return false;
double r = 1.0;
script->setDouble(r, "i");
script->setDouble(r, "row");
double c = 1.0;
script->setDouble(c, "j");
script->setDouble(c, "col");
double x = 1.0;
script->setDouble(x, "x");
double y = 1.0;
script->setDouble(y, "y");
QVariant res = script->eval();
if (!res.canConvert(QVariant::Double))
return false;
}
return true;
}
QString MatrixModel::text(int row, int col)
{
int i = d_cols*row + col;
double val = d_data[i];
if (i < 0 || i>= d_rows*d_cols || gsl_isnan(val))
return "";
if (d_matrix){
QLocale locale = d_matrix->locale();
return locale.toString(val, d_matrix->textFormat().toAscii(), d_matrix->precision());
}
return d_locale.toString(val, d_txt_format, d_num_precision);
}
double check_one_row(apop_data *row, void *colnames_in){
char **colnames= colnames_in;
int record_count = 0;
for ( ; colnames[record_count][0]!='\0'; record_count++)
;
char *values[record_count];
for (int i=0; colnames[i][0]!='\0'; i++){
int datacol = apop_name_find(row->names, colnames[i], 'c');
if (datacol > -2){
double val = apop_data_get(row, .row=0, datacol);
if (gsl_isnan(val))
asprintf(&values[i], "%s", apop_opts.nan_string);
else
asprintf(&values[i], "%g", val);
} else {
/**
* Function: nlin_corr_beam
*
* Parameters:
* @param nlincorr - the interpolator with the correction factor
* @param SPC - the full spectrum to correct
*
* Returns:
* @return -
*/
void
nlin_corr_beam(interpolator *nlincorr, double adcgain, full_spectr *SPC)
{
int index=0;
// int for_grism=1;
double cfactor;
double cps;
double lambda;
for (index=0; index < SPC->nelems; index++)
{
// get the independent spectral values,
// the wavelenth and the cps value
lambda = SPC->obj_spec->spec[index].lambda_mean;
cps = SPC->obj_spec->spec[index].count;
// check whether the spectral element
// is not corrupt
if (!gsl_isnan (lambda) && lambda)
{
if (cps > 0.0)
// compute the correction factor
cfactor = get_nlin_corr(nlincorr, lambda, cps/adcgain);
else
// make a dummy factor
cfactor = 1.0;
// correct what should be corrected
SPC->fgr_spec->spec[index].count = SPC->fgr_spec->spec[index].count / cfactor;
SPC->fgr_spec->spec[index].error = SPC->fgr_spec->spec[index].error / cfactor;
SPC->fgr_spec->spec[index].flux = SPC->fgr_spec->spec[index].flux / cfactor;
SPC->fgr_spec->spec[index].ferror = SPC->fgr_spec->spec[index].ferror / cfactor;
SPC->bck_spec->spec[index].count = SPC->bck_spec->spec[index].count / cfactor;
SPC->bck_spec->spec[index].error = SPC->bck_spec->spec[index].error / cfactor;
SPC->bck_spec->spec[index].flux = SPC->bck_spec->spec[index].flux / cfactor;
SPC->bck_spec->spec[index].ferror = SPC->bck_spec->spec[index].ferror / cfactor;
SPC->obj_spec->spec[index].count = SPC->obj_spec->spec[index].count / cfactor;
SPC->obj_spec->spec[index].error = SPC->obj_spec->spec[index].error / cfactor;
SPC->obj_spec->spec[index].flux = SPC->obj_spec->spec[index].flux / cfactor;
SPC->obj_spec->spec[index].ferror = SPC->obj_spec->spec[index].ferror / cfactor;
}
}
}
static PyObject *cs_gamma_finddRdz(PyObject *self, PyObject *args)
{
PyArrayObject *Numpy_zofA;
PyObject *Numpy_dRdz;
double Gmu, alpha, f, Gamma, *zofA, *dRdz;
long int Namp;
cs_cosmo_functions_t cosmofns;
int j;
(void)self; /* silence unused parameter warning */
if (!PyArg_ParseTuple(args, "ddddO!", &Gmu, &alpha, &f, &Gamma, &PyArray_Type, &Numpy_zofA))
return NULL;
Numpy_zofA = PyArray_GETCONTIGUOUS(Numpy_zofA);
if(!Numpy_zofA)
return NULL;
Namp = PyArray_DIM(Numpy_zofA, 0);
zofA = PyArray_DATA(Numpy_zofA);
{
npy_intp dims[1] = {Namp};
Numpy_dRdz = PyArray_SimpleNew(1, dims, NPY_DOUBLE);
}
dRdz = PyArray_DATA((PyArrayObject *) Numpy_dRdz);
cosmofns = XLALCSCosmoFunctions( zofA, Namp);
for ( j = 0; j < Namp; j++ )
{
/*double theta = pow((1+cosmofns.z[j]) * f * alpha * cosmofns.phit[j] / H0, -1.0/3.0);
if (theta > 1.0)
dRdz[j] = 0.0;
else*/
dRdz[j] = 0.5 * H0 * pow(f/H0,-2.0/3.0) * pow(alpha, -5.0/3.0) / (Gamma*Gmu) * pow(cosmofns.phit[j],-14.0/3.0) * cosmofns.phiV[j] * pow(1+cosmofns.z[j],-5.0/3.0);
if(gsl_isnan(dRdz[j])) {
Py_DECREF(Numpy_dRdz);
Numpy_dRdz = NULL;
break;
}
}
XLALCSCosmoFunctionsFree( cosmofns );
Py_DECREF(Numpy_zofA);
return Numpy_dRdz;
}
/** *************************************************************************************************************************/
double compute_mlik_pois_marg_brent(double finitestepsize, void *params)
{
struct fnparams *gparams = ((struct fnparams *) params);
gsl_vector *myBeta=gparams->betastatic;
int n=gparams->nDim;
int m=gparams->mDim;
gsl_permutation *perm=gparams->perm;
gsl_matrix *hessgvalues=gparams->mattmp2;
gsl_matrix *hessgvalues3pt=gparams->mattmp3;
double gvalue=gparams->gvalue;
int status,sss;
double mydet;
double logscore,logscore3pt;
double error_val=0.0;
/** ***/
/*double finitestepsize=gsl_vector_get(finitestepsize_vec,0);*/
/** ***/
/*Rprintf("got h=%e n=%d m=%d gvalue=%e\n",finitestepsize,n,m,gvalue);*/
/*for(i=0;i<myBeta->size;i++){Rprintf("beta= %f ",gsl_vector_get(myBeta,i));}Rprintf("\n");*/
rv_hessg_pois_outer_marg(myBeta,gparams, hessgvalues,finitestepsize,hessgvalues3pt);/** start with LARGEST STEPSIZE **/
/*for(i=0;i<hessgvalues3pt->size1;i++){for(j=0;j<hessgvalues3pt->size2;j++){Rprintf("%e ",gsl_matrix_get(hessgvalues3pt,i,j));}Rprintf("\n");}*/
status=gsl_linalg_LU_decomp(hessgvalues,perm,&sss);
mydet=gsl_linalg_LU_lndet(hessgvalues);/** compute determinant but this might be a nan - overflow? gsl_linalg_LU_lndet*/
logscore= -n*gvalue-0.5*mydet+(m/2.0)*log((2.0*M_PI)/n);/** this is the final value */
status=gsl_linalg_LU_decomp(hessgvalues3pt,perm,&sss);
mydet=gsl_linalg_LU_lndet(hessgvalues3pt);/** compute determinant but this might be a nan - overflow? gsl_linalg_LU_lndet*/
logscore3pt= -n*gvalue-0.5*mydet+(m/2.0)*log((2.0*M_PI)/n);/** this is the final value */
error_val=fabs(logscore-logscore3pt);
/*Rprintf("error_val=%e\n",error_val);*/
/*gparams->logscore=logscore;
gparams->logscore3pt=logscore3pt;*/
/*Rprintf("logscore=%e logscore3pt=%e\n",logscore,logscore3pt);*/
if(gsl_isnan(error_val) || gsl_isinf(error_val)){return(DBL_MAX);/*error("Non-finite value in mlik error estimation");*/}
return(error_val);
}
QVariant MatrixModel::data(const QModelIndex &index, int role) const {
if (!index.isValid())
return QVariant();
int i = d_cols * index.row() + index.column();
double val = d_data[i];
if (gsl_isnan(val))
return QVariant();
if (role == Qt::DisplayRole || role == Qt::EditRole) {
if (d_matrix)
return QVariant(d_matrix->locale().toString(
val, d_matrix->textFormat().toAscii(), d_matrix->precision()));
else
return QVariant(d_locale.toString(val, d_txt_format, d_num_precision));
} else
return QVariant();
}
// Calculate the 'normalized' Frobenius norm (i.e., divide
// by the square root of the number of elements in matrix).
// Instead of doing element-wise computation, use the GSL
// BLAS interface to compute the L2 norm of the columns
// and get the Frobenius norm as the sum of the squares of
// L2 norms of the column vectors
double shapeAlign::normFrobenius(const gsl_matrix *M)
{
double L2n, Fn = 0;
double val = 0;
for (size_t i = 0; i < M->size2; i++){
if (! gsl_isnan(gsl_matrix_get(M,0,i))){
gsl_vector_const_view column = gsl_matrix_const_column(M,i);
L2n = gsl_blas_dnrm2(&column.vector);
Fn += L2n*L2n;
val+=1.0;
}
}
if (val >= 4*thresh){
return sqrt(Fn/val);
}
return GSL_NAN;
}
/** *************************************************************************************
*****************************************************************************************
*****************************************************************************************/
int rv_hessg_inner_gaus (const gsl_vector *epsilonvec, void *params,gsl_matrix *hessgvalues)
{
/*double epsilon=0.3;*/
/*double epsilon=gsl_vector_get(epsilonvec,0);*/
const gsl_vector *Y = ((struct fnparams *) params)->Y;/** response variable **/
const gsl_vector *beta = ((struct fnparams *) params)->beta;/** fixed covariate and precision terms **/
double tau_rv = gsl_vector_get(beta,beta->size-2);/** inc the precision terms - second last entries */
double tau_resid = gsl_vector_get(beta,beta->size-1);/** last entry - residual precision */
double n = (double)(Y->size);/** number of observations */
gsl_matrix_set(hessgvalues,0,0,(tau_rv/n)+tau_resid);
if(gsl_isnan(gsl_matrix_get(hessgvalues,0,0))){error("rv_hess_inner_gaus is nan\n");}
return GSL_SUCCESS;
}
QImage MatrixModel::renderImage() {
QApplication::setOverrideCursor(QCursor(Qt::WaitCursor));
QImage image(QSize(d_cols, d_rows), QImage::Format_RGB32);
QwtLinearColorMap color_map = d_matrix->colorMap();
double minValue = 0.0, maxValue = 0.0;
d_matrix->range(&minValue, &maxValue);
const QwtDoubleInterval intensityRange =
QwtDoubleInterval(minValue, maxValue);
for (int i = 0; i < d_rows; i++) {
QRgb *line = reinterpret_cast<QRgb *>(image.scanLine(i));
for (int j = 0; j < d_cols; j++) {
double val = cell(i, j); // d_data[i*d_cols + j];
if (gsl_isnan(val))
*line++ = color_map.rgb(intensityRange, 0.0);
else if (fabs(val) < HUGE_VAL)
*line++ = color_map.rgb(intensityRange, val);
}
}
QApplication::restoreOverrideCursor();
return image;
}
/** *************************************************************************************
*****************************************************************************************
*****************************************************************************************/
void rv_dg_outer_R (int n, double *betaDBL, double *dgvaluesDBL,void *params)
{
struct fnparams *gparams = ((struct fnparams *) params);
/** fixed covariate and precision terms **/
gsl_function F;int i;int haveTau=0;
double result, abserr;
double h=((struct fnparams *) gparams)->finitestepsize;
/*double h_adj=0.0;*//** a new h is existing h is too small **/
gsl_vector *betaincTau=((struct fnparams *) gparams)->betaincTau;/** scratch space to copy betaincTauDBL into **/
for(i=0;i<betaincTau->size;i++){gsl_vector_set(betaincTau,i,betaDBL[i]);} /** copy into gsl_vector **/
if(betaDBL[n-1]<0.0){error("negative tau in rv_dg_outer_R\n");}
/** if get tau which is negative */
F.function = &g_outer_single;
F.params = gparams;
for(i=0;i<n;i++){ /** each of the partial derivatives */
gparams->fixed_index=i;
if(i== n-1){haveTau=1;} else {haveTau=0;}
/** readme - evaluating f() at a negative value e.g. tau-h **/
if(!haveTau){gsl_deriv_central (&F, betaDBL[i], h, &result, &abserr);/*Rprintf("fixed=%d val=%f\n",i,result);*/
} else { /** first try central and if this goes into negative tau area then revert to forwards **/
gsl_deriv_central(&F, betaDBL[i], h, &result, &abserr);
if(gsl_isnan(abserr)){gsl_deriv_forward(&F, betaDBL[i], h, &result, &abserr);}
}
dgvaluesDBL[i]=result;
}
}
bool SDProb::next_point ()
{
float values [source.dim(3)];
if (get_source_data (pos, values)) return (true);
float max_val = 0.0;
for (int n = 0; n < 12; n++) {
Point new_dir = new_rand_dir();
float val = precomputed ?
SH::value_precomputed (values, new_dir) :
SH::value (values, new_dir, lmax);
if (val > max_val) max_val = val;
}
if (gsl_isnan (max_val)) return (true);
if (max_val < threshold) return (true);
max_val *= 1.5;
for (int n = 0; n < max_trials; n++) {
Point new_dir = new_rand_dir();
float val = precomputed ?
SH::value_precomputed (values, new_dir) :
SH::value (values, new_dir, lmax);
if (val > threshold) {
if (val > max_val) info ("max_val exceeded!!! (val = " + str(val) + ", max_val = " + str (max_val) + ")");
if (rng.uniform() < val/max_val) {
dir = new_dir;
return (false);
}
}
}
return (true);
}
int
gsl_linalg_SV_decomp (gsl_matrix * A, gsl_matrix * V, gsl_vector * S,
gsl_vector * work)
{
size_t a, b, i, j, iter;
const size_t M=A->size1;
const size_t N=A->size2;
size_t K;
if (M<N) K=M;
else K=N;
if (M < N)
{
GSL_ERROR ("svd of MxN matrix, M<N, is not implemented", GSL_EUNIMPL);
}
else if (V->size1 != N)
{
GSL_ERROR ("square matrix V must match second dimension of matrix A",
GSL_EBADLEN);
}
else if (V->size1 != V->size2)
{
GSL_ERROR ("matrix V must be square", GSL_ENOTSQR);
}
else if (S->size != N)
{
GSL_ERROR ("length of vector S must match second dimension of matrix A",
GSL_EBADLEN);
}
else if (work->size != N)
{
GSL_ERROR ("length of workspace must match second dimension of matrix A",
GSL_EBADLEN);
}
/* Handle the case of N=1 (SVD of a column vector) */
if (N == 1)
{
gsl_vector_view column=gsl_matrix_column (A, 0);
double norm=gsl_blas_dnrm2 (&column.vector);
gsl_vector_set (S, 0, norm);
gsl_matrix_set (V, 0, 0, 1.0);
if (norm != 0.0)
{
gsl_blas_dscal (1.0/norm, &column.vector);
}
return GSL_SUCCESS;
}
{
gsl_vector_view f=gsl_vector_subvector (work, 0, K - 1);
/* bidiagonalize matrix A, unpack A into U S V */
gsl_linalg_bidiag_decomp (A, S, &f.vector);
//std::cout << "A: " << gsl_matrix_get(A,0,0) << " "
//<< gsl_matrix_get(A,M-1,N-1) << std::endl;
//std::cout << "S: " << S->data[0] << " "
//<< S->data[S->size-1]
//<< std::endl;
gsl_linalg_bidiag_unpack2 (A, S, &f.vector, V);
//std::cout << "S2: " << S->data[0] << " "
//<< S->data[S->size-1]
//<< std::endl;
/* apply reduction steps to B=(S,Sd) */
chop_small_elements (S, &f.vector);
//std::cout << "S3: " << S->data[0] << " "
//<< S->data[S->size-1]
//<< std::endl;
/* Progressively reduce the matrix until it is diagonal */
b=N - 1;
iter=0;
while (b > 0)
{
double fbm1=gsl_vector_get (&f.vector, b - 1);
if (fbm1 == 0.0 || gsl_isnan (fbm1))
{
b--;
continue;
}
//std::cout << "b,fbm1: " << b << " " << fbm1 << std::endl;
/* Find the largest unreduced block (a,b) starting from b
and working backwards */
a=b - 1;
while (a > 0)
{
double fam1=gsl_vector_get (&f.vector, a - 1);
if (fam1 == 0.0 || gsl_isnan (fam1))
{
break;
}
a--;
//std::cout << "a,fam1: " << a << " " << fam1 << std::endl;
}
iter++;
if (iter > 100 * N)
{
GSL_ERROR("SVD decomposition failed to converge", GSL_EMAXITER);
}
{
const size_t n_block=b - a + 1;
gsl_vector_view S_block=gsl_vector_subvector (S, a, n_block);
gsl_vector_view f_block=gsl_vector_subvector
(&f.vector, a, n_block - 1);
gsl_matrix_view U_block =
gsl_matrix_submatrix (A, 0, a, A->size1, n_block);
gsl_matrix_view V_block =
gsl_matrix_submatrix (V, 0, a, V->size1, n_block);
int rescale=0;
double scale=1;
double norm=0;
/* Find the maximum absolute values of the diagonal and subdiagonal */
for (i=0; i < n_block; i++)
{
double s_i=gsl_vector_get (&S_block.vector, i);
double a=fabs(s_i);
if (a > norm) norm=a;
//std::cout << "aa: " << a << std::endl;
}
for (i=0; i < n_block - 1; i++)
{
double f_i=gsl_vector_get (&f_block.vector, i);
double a=fabs(f_i);
if (a > norm) norm=a;
//std::cout << "aa2: " << a << std::endl;
}
/* Temporarily scale the submatrix if necessary */
if (norm > GSL_SQRT_DBL_MAX)
{
scale=(norm / GSL_SQRT_DBL_MAX);
rescale=1;
}
else if (norm < GSL_SQRT_DBL_MIN && norm > 0)
{
scale=(norm / GSL_SQRT_DBL_MIN);
rescale=1;
}
//std::cout << "rescale: " << rescale << std::endl;
if (rescale)
{
gsl_blas_dscal(1.0 / scale, &S_block.vector);
gsl_blas_dscal(1.0 / scale, &f_block.vector);
}
/* Perform the implicit QR step */
/*
for(size_t ii=0;ii<M;ii++) {
for(size_t jj=0;jj<N;jj++) {
std::cout << ii << "." << jj << "."
<< gsl_matrix_get(A,ii,jj) << std::endl;
}
}
for(size_t ii=0;ii<N;ii++) {
for(size_t jj=0;jj<N;jj++) {
std::cout << "V: " << ii << "." << jj << "."
<< gsl_matrix_get(V,ii,jj) << std::endl;
}
}
*/
qrstep (&S_block.vector, &f_block.vector, &U_block.matrix,
&V_block.matrix);
/*
for(size_t ii=0;ii<M;ii++) {
for(size_t jj=0;jj<N;jj++) {
std::cout << ii << " " << jj << " "
<< gsl_matrix_get(A,ii,jj) << std::endl;
}
}
for(size_t ii=0;ii<N;ii++) {
for(size_t jj=0;jj<N;jj++) {
std::cout << "V: " << ii << " " << jj << " "
<< gsl_matrix_get(V,ii,jj) << std::endl;
}
}
*/
/* remove any small off-diagonal elements */
chop_small_elements (&S_block.vector, &f_block.vector);
/* Undo the scaling if needed */
if (rescale)
{
gsl_blas_dscal(scale, &S_block.vector);
gsl_blas_dscal(scale, &f_block.vector);
}
}
}
}
/* Make singular values positive by reflections if necessary */
for (j=0; j < K; j++)
{
double Sj=gsl_vector_get (S, j);
if (Sj < 0.0)
{
for (i=0; i < N; i++)
{
double Vij=gsl_matrix_get (V, i, j);
gsl_matrix_set (V, i, j, -Vij);
}
gsl_vector_set (S, j, -Sj);
}
}
/* Sort singular values into decreasing order */
for (i=0; i < K; i++)
{
double S_max=gsl_vector_get (S, i);
size_t i_max=i;
for (j=i + 1; j < K; j++)
{
double Sj=gsl_vector_get (S, j);
if (Sj > S_max)
{
S_max=Sj;
i_max=j;
}
}
if (i_max != i)
{
/* swap eigenvalues */
gsl_vector_swap_elements (S, i, i_max);
/* swap eigenvectors */
gsl_matrix_swap_columns (A, i, i_max);
gsl_matrix_swap_columns (V, i, i_max);
}
}
return GSL_SUCCESS;
}
/**
* Function: intpix_corr_beam
* The functio corrects a full spectrum for the intrapixel sensitivity
* variations.
* For every spectral element its fractional y-value is determined,
* and then the correction factor for this y-value is computed
* and applied to the appropriate elements of the spectral bin.
*
* Parameters:
* @param actbeam - the beam to examine
* @param conf_file_path - the full pathname too the configuration file
* @param ipcorr - the interpolator with the correction factor
* @param SPC - the full spectrum to correct
*
* Returns:
* @return -
*/
void
intpix_corr_beam(beam actbeam, char conf_file_path[], interpolator *ipcorr,
full_spectr *SPC)
{
int index=0;
int for_grism=1;
double cfactor;
double lambda;
gsl_vector *cdisp;
d_point pixel;
dispstruct *beam_disp;
aperture_conf *conf;
// load the configuration file
conf = get_aperture_descriptor(conf_file_path);
// check whether it is grism (for_grism=1)
// or prism (for_grism=0) data
// give an error if there is a prism solution
for_grism = check_for_grism (conf_file_path, actbeam.ID);
if (!for_grism)
aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
"intpix_corr_beam: Only grism dispersion solution can be corrected.\n");
// get the wavelength dispersion relation at
// position "refpoint". conf->refx and conf->refy
// are used at this point to allow for a non (0,0) centered
// 2D field dependence.
pixel.x = actbeam.refpoint.x - conf->refx;
pixel.y = actbeam.refpoint.y - conf->refy;
// derive the dispersion at the object position
beam_disp = get_dispstruct_at_pos(conf_file_path, for_grism,
actbeam.ID, pixel);
// skipp high order zeroes in the dispersion solution
cdisp = condense_dispersion(beam_disp->pol);
for (index=0; index < SPC->nelems; index++)
{
lambda = SPC->fgr_spec->spec[index].lambda_mean;
if (!gsl_isnan (lambda) && lambda)
{
cfactor = get_intpix_corr(&actbeam, cdisp, ipcorr, lambda);
fprintf(stdout, "lambda: %e, factor: %e\n", lambda, cfactor);
/*
SPC->fgr_spec->spec[index].count = SPC->fgr_spec->spec[index].count / cfactor;
SPC->fgr_spec->spec[index].error = SPC->fgr_spec->spec[index].error / cfactor;
SPC->fgr_spec->spec[index].flux = SPC->fgr_spec->spec[index].flux / cfactor;
SPC->fgr_spec->spec[index].ferror = SPC->fgr_spec->spec[index].ferror / cfactor;
SPC->bck_spec->spec[index].count = SPC->bck_spec->spec[index].count / cfactor;
SPC->bck_spec->spec[index].error = SPC->bck_spec->spec[index].error / cfactor;
SPC->bck_spec->spec[index].flux = SPC->bck_spec->spec[index].flux / cfactor;
SPC->bck_spec->spec[index].ferror = SPC->bck_spec->spec[index].ferror / cfactor;
SPC->obj_spec->spec[index].count = SPC->obj_spec->spec[index].count / cfactor;
SPC->obj_spec->spec[index].error = SPC->obj_spec->spec[index].error / cfactor;
SPC->obj_spec->spec[index].flux = SPC->obj_spec->spec[index].flux / cfactor;
SPC->obj_spec->spec[index].ferror = SPC->obj_spec->spec[index].ferror / cfactor;
/* this is the wqrong version!!
SPC->fgr_spec->spec[index].count = SPC->fgr_spec->spec[index].count * cfactor;
SPC->fgr_spec->spec[index].error = SPC->fgr_spec->spec[index].error * cfactor;
SPC->fgr_spec->spec[index].flux = SPC->fgr_spec->spec[index].flux * cfactor;
SPC->fgr_spec->spec[index].ferror = SPC->fgr_spec->spec[index].ferror * cfactor;
SPC->bck_spec->spec[index].count = SPC->bck_spec->spec[index].count * cfactor;
SPC->bck_spec->spec[index].error = SPC->bck_spec->spec[index].error * cfactor;
SPC->bck_spec->spec[index].flux = SPC->bck_spec->spec[index].flux * cfactor;
SPC->bck_spec->spec[index].ferror = SPC->bck_spec->spec[index].ferror * cfactor;
SPC->obj_spec->spec[index].count = SPC->obj_spec->spec[index].count * cfactor;
SPC->obj_spec->spec[index].error = SPC->obj_spec->spec[index].error * cfactor;
SPC->obj_spec->spec[index].flux = SPC->obj_spec->spec[index].flux * cfactor;
SPC->obj_spec->spec[index].ferror = SPC->obj_spec->spec[index].ferror * cfactor;
*/
}
}
// free the configuration structure
free_aperture_conf(conf);
// free the dispersion struct
free_dispstruct(beam_disp);
// free the memory for the dispersion
gsl_vector_free(cdisp);
}
static int find_val(double findme, mnode_t *nodecol){
for (int i=0; nodecol[i].val <= findme || gsl_isnan(findme); i++)
if (nodecol[i].val == findme || (gsl_isnan(findme) && gsl_isnan(nodecol[i].val)))
return i;
return -1;
}
int
main (void)
{
double y, y_expected;
int e, e_expected;
gsl_ieee_env_setup ();
/* Test for expm1 */
y = gsl_expm1 (0.0);
y_expected = 0.0;
gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(0.0)");
y = gsl_expm1 (1e-10);
y_expected = 1.000000000050000000002e-10;
gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(1e-10)");
y = gsl_expm1 (-1e-10);
y_expected = -9.999999999500000000017e-11;
gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-1e-10)");
y = gsl_expm1 (0.1);
y_expected = 0.1051709180756476248117078264902;
gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(0.1)");
y = gsl_expm1 (-0.1);
y_expected = -0.09516258196404042683575094055356;
gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-0.1)");
y = gsl_expm1 (10.0);
y_expected = 22025.465794806716516957900645284;
gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(10.0)");
y = gsl_expm1 (-10.0);
y_expected = -0.99995460007023751514846440848444;
gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-10.0)");
/* Test for log1p */
y = gsl_log1p (0.0);
y_expected = 0.0;
gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(0.0)");
y = gsl_log1p (1e-10);
y_expected = 9.9999999995000000000333333333308e-11;
gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(1e-10)");
y = gsl_log1p (0.1);
y_expected = 0.095310179804324860043952123280765;
gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(0.1)");
y = gsl_log1p (10.0);
y_expected = 2.3978952727983705440619435779651;
gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(10.0)");
/* Test for gsl_hypot */
y = gsl_hypot (0.0, 0.0);
y_expected = 0.0;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(0.0, 0.0)");
y = gsl_hypot (1e-10, 1e-10);
y_expected = 1.414213562373095048801688e-10;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-10, 1e-10)");
y = gsl_hypot (1e-38, 1e-38);
y_expected = 1.414213562373095048801688e-38;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-38, 1e-38)");
y = gsl_hypot (1e-10, -1.0);
y_expected = 1.000000000000000000005;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-10, -1)");
y = gsl_hypot (-1.0, 1e-10);
y_expected = 1.000000000000000000005;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(-1, 1e-10)");
y = gsl_hypot (1e307, 1e301);
y_expected = 1.000000000000499999999999e307;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e307, 1e301)");
y = gsl_hypot (1e301, 1e307);
y_expected = 1.000000000000499999999999e307;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e301, 1e307)");
y = gsl_hypot (1e307, 1e307);
y_expected = 1.414213562373095048801688e307;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e307, 1e307)");
/* Test +-Inf, finite */
y = gsl_hypot (GSL_POSINF, 1.2);
y_expected = GSL_POSINF;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_POSINF, 1.2)");
y = gsl_hypot (GSL_NEGINF, 1.2);
y_expected = GSL_POSINF;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NEGINF, 1.2)");
y = gsl_hypot (1.2, GSL_POSINF);
y_expected = GSL_POSINF;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1.2, GSL_POSINF)");
y = gsl_hypot (1.2, GSL_NEGINF);
y_expected = GSL_POSINF;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1.2, GSL_NEGINF)");
/* Test NaN, finite */
y = gsl_hypot (GSL_NAN, 1.2);
y_expected = GSL_NAN;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NAN, 1.2)");
y = gsl_hypot (1.2, GSL_NAN);
y_expected = GSL_NAN;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1.2, GSL_NAN)");
/* Test NaN, NaN */
y = gsl_hypot (GSL_NAN, GSL_NAN);
y_expected = GSL_NAN;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NAN, GSL_NAN)");
/* Test +Inf, NaN */
y = gsl_hypot (GSL_POSINF, GSL_NAN);
y_expected = GSL_POSINF;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_POSINF, GSL_NAN)");
/* Test -Inf, NaN */
y = gsl_hypot (GSL_NEGINF, GSL_NAN);
y_expected = GSL_POSINF;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NEGINF, GSL_NAN)");
/* Test NaN, +Inf */
y = gsl_hypot (GSL_NAN, GSL_POSINF);
y_expected = GSL_POSINF;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NAN, GSL_POSINF)");
/* Test NaN, -Inf */
y = gsl_hypot (GSL_NAN, GSL_NEGINF);
y_expected = GSL_POSINF;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NAN, GSL_NEGINF)");
/* Test for gsl_hypot3 */
y = gsl_hypot3 (0.0, 0.0, 0.0);
y_expected = 0.0;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(0.0, 0.0, 0.0)");
y = gsl_hypot3 (1e-10, 1e-10, 1e-10);
y_expected = 1.732050807568877293527446e-10;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e-10, 1e-10, 1e-10)");
y = gsl_hypot3 (1e-38, 1e-38, 1e-38);
y_expected = 1.732050807568877293527446e-38;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e-38, 1e-38, 1e-38)");
y = gsl_hypot3 (1e-10, 1e-10, -1.0);
y_expected = 1.000000000000000000099;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e-10, 1e-10, -1)");
y = gsl_hypot3 (1e-10, -1.0, 1e-10);
y_expected = 1.000000000000000000099;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e-10, -1, 1e-10)");
y = gsl_hypot3 (-1.0, 1e-10, 1e-10);
y_expected = 1.000000000000000000099;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(-1, 1e-10, 1e-10)");
y = gsl_hypot3 (1e307, 1e301, 1e301);
y_expected = 1.0000000000009999999999995e307;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e307, 1e301, 1e301)");
y = gsl_hypot3 (1e307, 1e307, 1e307);
y_expected = 1.732050807568877293527446e307;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e307, 1e307, 1e307)");
y = gsl_hypot3 (1e307, 1e-307, 1e-307);
y_expected = 1.0e307;
gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e307, 1e-307, 1e-307)");
/* Test for acosh */
y = gsl_acosh (1.0);
y_expected = 0.0;
gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1.0)");
y = gsl_acosh (1.1);
y_expected = 4.435682543851151891329110663525e-1;
gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1.1)");
y = gsl_acosh (10.0);
y_expected = 2.9932228461263808979126677137742e0;
gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(10.0)");
y = gsl_acosh (1e10);
y_expected = 2.3718998110500402149594646668302e1;
gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1e10)");
/* Test for asinh */
y = gsl_asinh (0.0);
y_expected = 0.0;
gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(0.0)");
y = gsl_asinh (1e-10);
y_expected = 9.9999999999999999999833333333346e-11;
gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e-10)");
y = gsl_asinh (-1e-10);
y_expected = -9.9999999999999999999833333333346e-11;
gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e-10)");
y = gsl_asinh (0.1);
y_expected = 9.983407889920756332730312470477e-2;
gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(0.1)");
y = gsl_asinh (-0.1);
y_expected = -9.983407889920756332730312470477e-2;
gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-0.1)");
y = gsl_asinh (1.0);
y_expected = 8.8137358701954302523260932497979e-1;
gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1.0)");
y = gsl_asinh (-1.0);
y_expected = -8.8137358701954302523260932497979e-1;
gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-1.0)");
y = gsl_asinh (10.0);
y_expected = 2.9982229502979697388465955375965e0;
gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(10)");
y = gsl_asinh (-10.0);
y_expected = -2.9982229502979697388465955375965e0;
gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-10)");
y = gsl_asinh (1e10);
y_expected = 2.3718998110500402149599646668302e1;
gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e10)");
y = gsl_asinh (-1e10);
y_expected = -2.3718998110500402149599646668302e1;
gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-1e10)");
/* Test for atanh */
y = gsl_atanh (0.0);
y_expected = 0.0;
gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.0)");
y = gsl_atanh (1e-20);
y_expected = 1e-20;
gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(1e-20)");
y = gsl_atanh (-1e-20);
y_expected = -1e-20;
gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(-1e-20)");
y = gsl_atanh (0.1);
y_expected = 1.0033534773107558063572655206004e-1;
gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.1)");
y = gsl_atanh (-0.1);
y_expected = -1.0033534773107558063572655206004e-1;
gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(-0.1)");
y = gsl_atanh (0.9);
y_expected = 1.4722194895832202300045137159439e0;
gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.9)");
y = gsl_atanh (-0.9);
y_expected = -1.4722194895832202300045137159439e0;
gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.9)");
/* Test for pow_int */
y = gsl_pow_2 (-3.14);
y_expected = pow (-3.14, 2.0);
gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_2(-3.14)");
y = gsl_pow_3 (-3.14);
y_expected = pow (-3.14, 3.0);
gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_3(-3.14)");
y = gsl_pow_4 (-3.14);
y_expected = pow (-3.14, 4.0);
gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_4(-3.14)");
y = gsl_pow_5 (-3.14);
y_expected = pow (-3.14, 5.0);
gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_5(-3.14)");
y = gsl_pow_6 (-3.14);
y_expected = pow (-3.14, 6.0);
gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_6(-3.14)");
y = gsl_pow_7 (-3.14);
y_expected = pow (-3.14, 7.0);
gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_7(-3.14)");
y = gsl_pow_8 (-3.14);
y_expected = pow (-3.14, 8.0);
gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_8(-3.14)");
y = gsl_pow_9 (-3.14);
y_expected = pow (-3.14, 9.0);
gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_9(-3.14)");
{
int n;
for (n = -9; n < 10; n++)
{
y = gsl_pow_int (-3.14, n);
y_expected = pow (-3.14, n);
gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_int(-3.14,%d)", n);
}
}
{
unsigned int n;
for (n = 0; n < 10; n++)
{
y = gsl_pow_uint (-3.14, n);
y_expected = pow (-3.14, n);
gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_uint(-3.14,%d)", n);
}
}
/* Test case for n at INT_MAX, INT_MIN */
{
double u = 1.0000001;
int n = INT_MAX;
y = gsl_pow_int (u, n);
y_expected = pow (u, n);
gsl_test_rel (y, y_expected, 1e-6, "gsl_pow_int(%.7f,%d)", u, n);
n = INT_MIN;
y = gsl_pow_int (u, n);
y_expected = pow (u, n);
gsl_test_rel (y, y_expected, 1e-6, "gsl_pow_int(%.7f,%d)", u, n);
}
/* Test for ldexp */
y = gsl_ldexp (M_PI, -2);
y_expected = M_PI_4;
gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(pi,-2)");
y = gsl_ldexp (1.0, 2);
y_expected = 4.000000;
gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(1.0,2)");
y = gsl_ldexp (0.0, 2);
y_expected = 0.0;
gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(0.0,2)");
y = gsl_ldexp (9.999999999999998890e-01, 1024);
y_expected = GSL_DBL_MAX;
gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp DBL_MAX");
y = gsl_ldexp (1e308, -2000);
y_expected = 8.7098098162172166755761e-295;
gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(1e308,-2000)");
y = gsl_ldexp (GSL_DBL_MIN, 2000);
y_expected = 2.554675596204441378334779940e294;
gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(DBL_MIN,2000)");
/* Test subnormals */
{
int i = 0;
volatile double x = GSL_DBL_MIN;
y_expected = 2.554675596204441378334779940e294;
x /= 2;
while (x > 0)
{
i++ ;
y = gsl_ldexp (x, 2000 + i);
gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(DBL_MIN/2**%d,%d)",i,2000+i);
x /= 2;
}
}
/* Test for frexp */
y = gsl_frexp (0.0, &e);
y_expected = 0;
e_expected = 0;
gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(0) fraction");
gsl_test_int (e, e_expected, "gsl_frexp(0) exponent");
y = gsl_frexp (M_PI, &e);
y_expected = M_PI_4;
e_expected = 2;
gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(pi) fraction");
gsl_test_int (e, e_expected, "gsl_frexp(pi) exponent");
y = gsl_frexp (2.0, &e);
y_expected = 0.5;
e_expected = 2;
gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(2.0) fraction");
gsl_test_int (e, e_expected, "gsl_frexp(2.0) exponent");
y = gsl_frexp (1.0 / 4.0, &e);
y_expected = 0.5;
e_expected = -1;
gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(0.25) fraction");
gsl_test_int (e, e_expected, "gsl_frexp(0.25) exponent");
y = gsl_frexp (1.0 / 4.0 - 4.0 * GSL_DBL_EPSILON, &e);
y_expected = 0.999999999999996447;
e_expected = -2;
gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(0.25-eps) fraction");
gsl_test_int (e, e_expected, "gsl_frexp(0.25-eps) exponent");
y = gsl_frexp (GSL_DBL_MAX, &e);
y_expected = 9.999999999999998890e-01;
e_expected = 1024;
gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(DBL_MAX) fraction");
gsl_test_int (e, e_expected, "gsl_frexp(DBL_MAX) exponent");
y = gsl_frexp (-GSL_DBL_MAX, &e);
y_expected = -9.999999999999998890e-01;
e_expected = 1024;
gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(-DBL_MAX) fraction");
gsl_test_int (e, e_expected, "gsl_frexp(-DBL_MAX) exponent");
y = gsl_frexp (GSL_DBL_MIN, &e);
y_expected = 0.5;
e_expected = -1021;
gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(DBL_MIN) fraction");
gsl_test_int (e, e_expected, "gsl_frexp(DBL_MIN) exponent");
y = gsl_frexp (-GSL_DBL_MIN, &e);
y_expected = -0.5;
e_expected = -1021;
gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(-DBL_MIN) fraction");
gsl_test_int (e, e_expected, "gsl_frexp(-DBL_MIN) exponent");
/* Test subnormals */
{
int i = 0;
volatile double x = GSL_DBL_MIN;
y_expected = 0.5;
e_expected = -1021;
x /= 2;
while (x > 0)
{
e_expected--;
i++ ;
y = gsl_frexp (x, &e);
gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(DBL_MIN/2**%d) fraction",i);
gsl_test_int (e, e_expected, "gsl_frexp(DBL_MIN/2**%d) exponent", i);
x /= 2;
}
}
/* Test for approximate floating point comparison */
{
double x, y;
int i;
x = M_PI;
y = 22.0 / 7.0;
/* test the basic function */
for (i = 0; i < 10; i++)
{
double tol = pow (10, -i);
int res = gsl_fcmp (x, y, tol);
gsl_test_int (res, -(i >= 4), "gsl_fcmp(%.5f,%.5f,%g)", x, y, tol);
}
for (i = 0; i < 10; i++)
{
double tol = pow (10, -i);
int res = gsl_fcmp (y, x, tol);
gsl_test_int (res, (i >= 4), "gsl_fcmp(%.5f,%.5f,%g)", y, x, tol);
}
}
#if HAVE_IEEE_COMPARISONS
/* Test for isinf, isnan, finite */
{
double zero, one, inf, nan;
int s;
zero = 0.0;
one = 1.0;
inf = exp (1.0e10);
nan = inf / inf;
s = gsl_isinf (zero);
gsl_test_int (s, 0, "gsl_isinf(0)");
s = gsl_isinf (one);
gsl_test_int (s, 0, "gsl_isinf(1)");
s = gsl_isinf (inf);
gsl_test_int (s, 1, "gsl_isinf(inf)");
s = gsl_isinf (-inf);
gsl_test_int (s, -1, "gsl_isinf(-inf)");
s = gsl_isinf (nan);
gsl_test_int (s, 0, "gsl_isinf(nan)");
s = gsl_isnan (zero);
gsl_test_int (s, 0, "gsl_isnan(0)");
s = gsl_isnan (one);
gsl_test_int (s, 0, "gsl_isnan(1)");
s = gsl_isnan (inf);
gsl_test_int (s, 0, "gsl_isnan(inf)");
s = gsl_isnan (-inf);
gsl_test_int (s, 0, "gsl_isnan(-inf)");
s = gsl_isnan (nan);
gsl_test_int (s, 1, "gsl_isnan(nan)");
s = gsl_finite (zero);
gsl_test_int (s, 1, "gsl_finite(0)");
s = gsl_finite (one);
gsl_test_int (s, 1, "gsl_finite(1)");
s = gsl_finite (inf);
gsl_test_int (s, 0, "gsl_finite(inf)");
s = gsl_finite (-inf);
gsl_test_int (s, 0, "gsl_finite(-inf)");
s = gsl_finite (nan);
gsl_test_int (s, 0, "gsl_finite(nan)");
}
#endif
{
double x = gsl_fdiv (2.0, 3.0);
gsl_test_rel (x, 2.0 / 3.0, 4 * GSL_DBL_EPSILON, "gsl_fdiv(2,3)");
}
/* Test constants in gsl_math.h */
{
double x = log(M_E);
gsl_test_rel (x, 1.0, 4 * GSL_DBL_EPSILON, "ln(M_E)");
}
{
double x=pow(2.0,M_LOG2E);
gsl_test_rel (x, exp(1.0), 4 * GSL_DBL_EPSILON, "2^M_LOG2E");
}
{
double x=pow(10.0,M_LOG10E);
gsl_test_rel (x, exp(1.0), 4 * GSL_DBL_EPSILON, "10^M_LOG10E");
}
{
double x=pow(M_SQRT2, 2.0);
gsl_test_rel (x, 2.0, 4 * GSL_DBL_EPSILON, "M_SQRT2^2");
}
{
double x=pow(M_SQRT1_2, 2.0);
gsl_test_rel (x, 1.0/2.0, 4 * GSL_DBL_EPSILON, "M_SQRT1_2");
}
{
double x=pow(M_SQRT3, 2.0);
gsl_test_rel (x, 3.0, 4 * GSL_DBL_EPSILON, "M_SQRT3^2");
}
{
double x = M_PI;
gsl_test_rel (x, 3.1415926535897932384626433832795, 4 * GSL_DBL_EPSILON, "M_PI");
}
{
double x = 2 * M_PI_2;
gsl_test_rel (x, M_PI, 4 * GSL_DBL_EPSILON, "2*M_PI_2");
}
{
double x = 4 * M_PI_4;
gsl_test_rel (x, M_PI, 4 * GSL_DBL_EPSILON, "4*M_PI_4");
}
{
double x = pow(M_SQRTPI, 2.0);
gsl_test_rel (x, M_PI, 4 * GSL_DBL_EPSILON, "M_SQRTPI^2");
}
{
double x = pow(M_2_SQRTPI, 2.0);
gsl_test_rel (x, 4/M_PI, 4 * GSL_DBL_EPSILON, "M_SQRTPI^2");
}
{
double x = M_1_PI;
gsl_test_rel (x, 1/M_PI, 4 * GSL_DBL_EPSILON, "M_1_SQRTPI");
}
{
double x = M_2_PI;
gsl_test_rel (x, 2.0/M_PI, 4 * GSL_DBL_EPSILON, "M_2_PI");
}
{
double x = exp(M_LN10);
gsl_test_rel (x, 10, 4 * GSL_DBL_EPSILON, "exp(M_LN10)");
}
{
double x = exp(M_LN2);
gsl_test_rel (x, 2, 4 * GSL_DBL_EPSILON, "exp(M_LN2)");
}
{
double x = exp(M_LNPI);
gsl_test_rel (x, M_PI, 4 * GSL_DBL_EPSILON, "exp(M_LNPI)");
}
{
double x = M_EULER;
gsl_test_rel (x, 0.5772156649015328606065120900824, 4 * GSL_DBL_EPSILON, "M_EULER");
}
exit (gsl_test_summary ());
}
static VALUE rb_gsl_isnan2(VALUE obj, VALUE x)
{
Need_Float(x);
if (gsl_isnan(NUM2DBL(x))) return Qtrue;
else return Qfalse;
}
