QString MatrixModel::saveToString()
{
QString s = "<data>\n";
int cols = d_cols - 1;
for(int i = 0; i < d_rows; i++){
int aux = d_cols*i;
bool emptyRow = true;
for(int j = 0; j < d_cols; j++){
if (gsl_finite(d_data[aux + j])){
emptyRow = false;
break;
}
}
if (emptyRow)
continue;
s += QString::number(i) + "\t";
for(int j = 0; j < cols; j++){
double val = d_data[aux + j];
if (gsl_finite(val))
s += QString::number(val, 'e', 16);
s += "\t";
}
double val = d_data[aux + cols];
if (gsl_finite(val))
s += QString::number(val, 'e', 16);
s += "\n";
}
return s + "</data>\n";
}
void Testmcar_model(CuTest* tc) {
gsl_matrix* W = gsl_matrix_alloc(N, N);
gsl_matrix_set_zero(W);
for(size_t i=0; i<(N-1); i++)
DECL_AD(i, i+1);
mcmclib_mcar_tilde_lpdf* llik = mcmclib_mcar_tilde_lpdf_alloc(P, W);
gsl_vector* e = gsl_vector_alloc(N * P);
gsl_vector_set_all(e, 2.0);
p = mcmclib_mcar_model_alloc(llik, e);
double l1 = lpdf_alpha12sigma(-2.0);
double l2 = lpdf_alpha12sigma(-5.0);
CuAssertTrue(tc, gsl_finite(l1));
CuAssertTrue(tc, gsl_finite(l2));
CuAssertTrue(tc, l1 > l2);
CuAssertTrue(tc, l1 == lpdf_alpha12sigma(-2.0));
gsl_vector* alphasigma = gsl_vector_alloc(P * (P-1) / 2 + P);
gsl_vector_set_all(llik->alpha12sigma, -1.0);
gsl_vector_set_all(alphasigma, 0.0);
l1 = mcmclib_mcar_model_alphasigma_lpdf(p, alphasigma);
CuAssertTrue(tc, gsl_finite(l1));
gsl_vector_set(alphasigma, P+1, 1.0);
CuAssertTrue(tc, !gsl_finite(mcmclib_mcar_model_alphasigma_lpdf(p, alphasigma)));
gsl_vector_free(alphasigma);
mcmclib_mcar_model_free(p);
gsl_vector_free(e);
mcmclib_mcar_tilde_lpdf_free(llik);
gsl_matrix_free(W);
}
std::string MatrixModel::saveToProject() {
MantidQt::API::TSVSerialiser tsv;
for (int row = 0; row < d_rows; ++row) {
// Index to the first element of each row
const int rowStart = d_cols * row;
// If the row is empty, we can skip it
bool emptyRow = true;
for (int col = 0; col < d_cols; ++col)
if (gsl_finite(d_data[rowStart + col])) {
emptyRow = false;
break;
}
if (emptyRow)
continue;
// Write out the values for the row
tsv.writeLine(Mantid::Kernel::Strings::toString<int>(row));
for (int col = 0; col < d_cols; ++col) {
double val = d_data[rowStart + col];
if (gsl_finite(val))
tsv << QString::number(val, 'e', 16);
else if (col + 1 < d_cols)
tsv << ""; // If we're not the last element, put in an empty spacer
}
}
return tsv.outputLines();
}
void get_min_max (Image::Position& ima, float& min, float& max)
{
min = GSL_POSINF;
max = GSL_NEGINF;
ProgressBar::init (ima.voxel_count(), "finding min/max...");
do {
float val = ima.re();
if (gsl_finite (val)) {
if (min > val) min = val;
if (max < val) max = val;
}
if (ima.is_complex()) {
val = ima.im();
if (gsl_finite (val)) {
if (min > val) min = val;
if (max < val) max = val;
}
}
ProgressBar::inc();
} while (ima++);
ProgressBar::done();
}
static int
steffenson_iterate (void * vstate, gsl_function_fdf * fdf, double * root)
{
steffenson_state_t * state = (steffenson_state_t *) vstate;
double x_new, f_new, df_new;
double x_1 = state->x_1 ;
double x = state->x ;
if (state->df == 0.0)
{
GSL_ERROR("derivative is zero", GSL_EZERODIV);
}
x_new = x - (state->f / state->df);
GSL_FN_FDF_EVAL_F_DF(fdf, x_new, &f_new, &df_new);
state->x_2 = x_1 ;
state->x_1 = x ;
state->x = x_new;
state->f = f_new ;
state->df = df_new ;
if (!gsl_finite (f_new))
{
GSL_ERROR ("function value is not finite", GSL_EBADFUNC);
}
if (state->count < 3)
{
*root = x_new ;
state->count++ ;
}
else
{
double u = (x - x_1) ;
double v = (x_new - 2 * x + x_1);
if (v == 0)
*root = x_new; /* avoid division by zero */
else
*root = x_1 - u * u / v ; /* accelerated value */
}
if (!gsl_finite (df_new))
{
GSL_ERROR ("derivative value is not finite", GSL_EBADFUNC);
}
return GSL_SUCCESS;
}
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);
}
/* Calculates the normalisation constant of the likelihood function:
* 1/sqrt(2*pi*sigma²)^beta for all data points (product).
* This is done in log-space
*/
int /*error flag*/
pdf_normalisation_constant(ode_model_parameters *omp)/*pre-allocated storage for simulation results, used in LogLikelihood calculations*/{
assert(omp && omp->size);
int c,C=get_number_of_experimental_conditions(omp);
int i,F=get_number_of_model_outputs(omp);
int t,T;
double E_lN,lN=0; // log normalisation constant;
double stdv;
for (c=0;c<C;c++){
T=omp->E[c]->t->size;
E_lN=-0.5*(M_LN2+M_LNPI);
for (t=0;t<T;t++){
for (i=0;i<F;i++){
stdv=gsl_vector_get(omp->E[c]->sd_data[t],i);
if (gsl_finite(stdv)){
E_lN-=gsl_sf_log(stdv);
}
}
}
omp->E[c]->pdf_lognorm=E_lN;
lN+=E_lN;
}
omp->pdf_lognorm=lN;
return EXIT_SUCCESS;
}
double
wrapper_function (double x, void *params)
{
pdf_func * pdf = (pdf_func *)params;
double P = pdf(x);
if (!gsl_finite(P)) {
pdf_errors++;
pdf_errval = P;
P = 0; /* skip invalid value now, but return pdf_errval at the end */
}
return P;
}
int
gsl_linalg_balance_columns (gsl_matrix * A, gsl_vector * D)
{
const size_t N = A->size2;
size_t j;
if (D->size != A->size2)
{
GSL_ERROR("length of D must match second dimension of A", GSL_EINVAL);
}
gsl_vector_set_all (D, 1.0);
for (j = 0; j < N; j++)
{
gsl_vector_view A_j = gsl_matrix_column (A, j);
double s = gsl_blas_dasum(&A_j.vector);
double f = 1.0;
if (s == 0.0 || !gsl_finite(s))
{
gsl_vector_set (D, j, f);
continue;
}
/* FIXME: we could use frexp() here */
while (s > 1.0)
{
s /= 2.0;
f *= 2.0;
}
while (s < 0.5)
{
s *= 2.0;
f /= 2.0;
}
gsl_vector_set (D, j, f);
if (f != 1.0)
{
gsl_blas_dscal(1.0/f, &A_j.vector);
}
}
return GSL_SUCCESS;
}
static int
secant_iterate (void * vstate, gsl_function_fdf * fdf, double * root)
{
secant_state_t * state = (secant_state_t *) vstate;
const double x = *root ;
const double f = state->f;
const double df = state->df;
double x_new, f_new, df_new;
if (state->df == 0.0)
{
GSL_ERROR("derivative is zero", GSL_EZERODIV);
}
x_new = x - (f / df);
f_new = GSL_FN_FDF_EVAL_F(fdf, x_new) ;
df_new = (f_new - f) / (x_new - x) ;
*root = x_new ;
state->f = f_new ;
state->df = df_new ;
if (!gsl_finite (f_new))
{
GSL_ERROR ("function value is not finite", GSL_EBADFUNC);
}
if (!gsl_finite (df_new))
{
GSL_ERROR ("derivative value is not finite", GSL_EBADFUNC);
}
return GSL_SUCCESS;
}
int
compare(const void *a, const void *b)
{
const double *x = a;
const double *y = b;
int r1 = cmp(y[0], x[0]);
int r2 = cmp(y[1], x[1]);
if (!gsl_finite(x[0]))
return 1;
if (!gsl_finite(y[0]))
return -1;
if (fabs(x[0] - y[0]) < 1.0e-8)
{
/* real parts are very close to each other */
return r2;
}
else
{
return r1 ? r1 : r2;
}
} /* compare() */
double mcmclib_mcar_model_alpha12sigma_lpdf(void* in_p, gsl_vector* alpha12sigma) {
mcmclib_mcar_model* p = (mcmclib_mcar_model*) in_p;
const size_t n = p->lpdf->p;
gsl_vector_view s_v = gsl_vector_subvector(alpha12sigma, n*(n-1), n);
if(!mcmclib_vector_is_sorted_desc(&s_v.vector))
return log(0.0);
double prior = alpha12sigma_logderiv(n, alpha12sigma);
if(!gsl_finite(prior))
return prior;
gsl_vector* tmp = gsl_vector_alloc(alpha12sigma->size);
gsl_vector_memcpy(tmp, p->lpdf->alpha12sigma);
gsl_vector_memcpy(p->lpdf->alpha12sigma, alpha12sigma);
double ans = mcmclib_mcar_tilde_lpdf_compute(p->lpdf, p->e);
gsl_vector_memcpy(p->lpdf->alpha12sigma, tmp);
gsl_vector_free(tmp);
return ans + prior;
}
static void
kowalik_checksol(const double x[], const double sumsq,
const double epsrel, const char *sname,
const char *pname)
{
size_t i;
gsl_vector_const_view v = gsl_vector_const_view_array(x, kowalik_P);
const double norm = gsl_blas_dnrm2(&v.vector);
const double sumsq_exact1 = 3.075056038492370e-04;
const double kowalik_x1[kowalik_P] = { 1.928069345723978e-01,
1.912823290344599e-01,
1.230565070690708e-01,
1.360623308065148e-01 };
const double sumsq_exact2 = 0.00102734304869549252;
const double kowalik_x2[kowalik_P] = { GSL_NAN, /* inf */
-14.0758834005984603,
GSL_NAN, /* -inf */
GSL_NAN }; /* -inf */
const double *kowalik_x;
double sumsq_exact;
if (norm < 10.0)
{
kowalik_x = kowalik_x1;
sumsq_exact = sumsq_exact1;
}
else
{
kowalik_x = kowalik_x2;
sumsq_exact = sumsq_exact2;
}
gsl_test_rel(sumsq, sumsq_exact, epsrel, "%s/%s sumsq",
sname, pname);
for (i = 0; i < kowalik_P; ++i)
{
if (!gsl_finite(kowalik_x[i]))
continue;
gsl_test_rel(x[i], kowalik_x[i], epsrel, "%s/%s i="F_ZU,
sname, pname, i);
}
}
bool FunctionCurve::loadData(int points, bool xLog10Scale)
{
if (!points)
points = dataSize();
double *X = (double *)malloc(points*sizeof(double));
if (!X){
QMessageBox::critical(0, QObject::tr("QtiPlot - Memory Allocation Error"),
QObject::tr("Not enough memory, operation aborted!"));
return false;
}
double *Y = (double *)malloc(points*sizeof(double));
if (!Y){
QMessageBox::critical(0, QObject::tr("QtiPlot - Memory Allocation Error"),
QObject::tr("Not enough memory, operation aborted!"));
free(X);
return false;
}
double step = (d_to - d_from)/(double)(points - 1.0);
if (d_function_type == Normal){
MyParser parser;
double x = d_from;
try {
parser.DefineVar(d_variable.ascii(), &x);
QMapIterator<QString, double> i(d_constants);
while (i.hasNext()){
i.next();
parser.DefineConst(i.key().ascii(), i.value());
}
parser.SetExpr(d_formulas[0].ascii());
int lastButOne = points - 1;
try {
double xl = x, xr;
double y = parser.EvalRemoveSingularity(&x, false);
bool wellDefinedFunction = true;
if (!gsl_finite(y)){// try to find a first well defined point (might help for some not really bad functions)
wellDefinedFunction = false;
for (int i = 0; i < lastButOne; i++){
xl = x;
x += step;
xr = x;
y = parser.Eval();
if (gsl_finite(y)){
wellDefinedFunction = true;
int iter = 0;
double x0 = x, y0 = y;
while(fabs(xr - xl)/step > 1e-15 && iter < points){
x = 0.5*(xl + xr);
y = parser.Eval();
if (gsl_finite(y)){
xr = x;
x0 = x;
y0 = y;
} else
xl = x;
iter++;
}
d_from = x0;
X[0] = x0;
Y[0] = y0;
step = (d_to - d_from)/(double)(lastButOne);
break;
}
}
if (!wellDefinedFunction){
QMessageBox::critical(0, QObject::tr("QtiPlot"),
QObject::tr("The function %1 is not defined in the specified interval!").arg(d_formulas[0]));
free(X); free(Y);
return false;
}
} else {
X[0] = d_from;
Y[0] = y;
}
} catch (MyParser::Pole) {}
ScaleEngine *sc_engine = 0;
if (plot())
sc_engine = (ScaleEngine *)plot()->axisScaleEngine(xAxis());
if (xLog10Scale || (d_from > 0 && d_to > 0 && sc_engine &&
sc_engine->type() == ScaleTransformation::Log10)){
step = log10(d_to/d_from)/(double)(points - 1);
for (int i = 1; i < lastButOne; i++ ){
x = d_from*pow(10, i*step);
X[i] = x;
try {
Y[i] = parser.EvalRemoveSingularity(&x, false);
} catch (MyParser::Pole){}
}
} else {
for (int i = 1; i < lastButOne; i++ ){
x += step;
X[i] = x;
try {
Y[i] = parser.EvalRemoveSingularity(&x, false);
} catch (MyParser::Pole){}
}
}
//the last point might be outside the interval, therefore we calculate it separately at its precise value
x = d_to;
X[lastButOne] = x;
try {
Y[lastButOne] = parser.EvalRemoveSingularity(&x, false);
} catch (MyParser::Pole){}
} catch(mu::ParserError &e) {}
} else if (d_function_type == Parametric || d_function_type == Polar) {
QStringList aux = d_formulas;
MyParser xparser;
MyParser yparser;
double par;
if (d_function_type == Polar) {
QString swap=aux[0];
aux[0]="("+swap+")*cos("+aux[1]+")";
aux[1]="("+swap+")*sin("+aux[1]+")";
}
try {
QMapIterator<QString, double> i(d_constants);
while (i.hasNext()){
i.next();
xparser.DefineConst(i.key().ascii(), i.value());
yparser.DefineConst(i.key().ascii(), i.value());
}
xparser.DefineVar(d_variable.ascii(), &par);
yparser.DefineVar(d_variable.ascii(), &par);
xparser.SetExpr(aux[0].ascii());
yparser.SetExpr(aux[1].ascii());
par = d_from;
for (int i = 0; i<points; i++ ){
X[i] = xparser.Eval();
Y[i] = yparser.Eval();
par += step;
}
} catch(mu::ParserError &) {}
}
if (curveType() == QwtPlotCurve::Yfx)
setData(X, Y, points);
else
setData(Y, X, points);
free(X); free(Y);
return true;
}
int
main (void)
{
double y, y_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 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_n(-3.14,%d)", n);
}
}
/* 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(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(nan);
gsl_test_int (s, 0, "gsl_finite(nan)");
}
{
double x = gsl_fdiv (2.0, 3.0);
gsl_test_rel (x, 2.0/3.0, 4*GSL_DBL_EPSILON, "gsl_fdiv(2,3)");
}
exit (gsl_test_summary ());
}
int
gsl_isinf (const double x)
{
return (! gsl_finite(x)) && (! gsl_isnan(x));
}
void Linear::exec()
{
// Get the input workspace
MatrixWorkspace_const_sptr inputWorkspace = getProperty("InputWorkspace");
// Get the spectrum to fit
const int histNumber = getProperty("WorkspaceIndex");
// Check validity
if ( histNumber >= static_cast<int>(inputWorkspace->getNumberHistograms()) )
{
g_log.error() << "WorkspaceIndex set to an invalid value of " << histNumber << std::endl;
throw Exception::IndexError(histNumber,inputWorkspace->getNumberHistograms(),"Linear WorkspaceIndex property");
}
// Get references to the data in the chosen spectrum
const MantidVec& X = inputWorkspace->dataX(histNumber);
const MantidVec& Y = inputWorkspace->dataY(histNumber);
const MantidVec& E = inputWorkspace->dataE(histNumber);
// Check if this spectrum has errors
double errorsCount = 0.0;
// Retrieve the Start/EndX properties, if set
this->setRange(X,Y);
const bool isHistogram = inputWorkspace->isHistogramData();
// If the spectrum to be fitted has masked bins, we want to exclude them (even if only partially masked)
const MatrixWorkspace::MaskList * const maskedBins =
( inputWorkspace->hasMaskedBins(histNumber) ? &(inputWorkspace->maskedBins(histNumber)) : NULL );
// Put indices of masked bins into a set for easy searching later
std::set<size_t> maskedIndices;
if (maskedBins)
{
MatrixWorkspace::MaskList::const_iterator it;
for (it = maskedBins->begin(); it != maskedBins->end(); ++it)
maskedIndices.insert(it->first);
}
progress(0);
// Declare temporary vectors and reserve enough space if they're going to be used
std::vector<double> XCen, unmaskedY, weights;
int numPoints = m_maxX - m_minX;
if (isHistogram) XCen.reserve(numPoints);
if (maskedBins) unmaskedY.reserve(numPoints);
weights.reserve(numPoints);
for (int i = 0; i < numPoints; ++i)
{
// If the current bin is masked, skip it
if ( maskedBins && maskedIndices.count(m_minX+i) ) continue;
// Need to adjust X to centre of bin, if a histogram
if (isHistogram) XCen.push_back( 0.5*(X[m_minX+i]+X[m_minX+i+1]) );
// If there are masked bins present, we need to copy the unmasked Y values
if (maskedBins) unmaskedY.push_back(Y[m_minX+i]);
// GSL wants the errors as weights, i.e. 1/sigma^2
// We need to be careful if E is zero because that would naively lead to an infinite weight on the point.
// Solution taken here is to zero weight if error is zero, which typically means Y is zero
// (so it is effectively excluded from the fit).
const double& currentE = E[m_minX+i];
weights.push_back( currentE ? 1.0/(currentE*currentE) : 0.0 );
// However, if the spectrum given has all errors of zero, then we should use the gsl function that
// doesn't take account of the errors.
if ( currentE ) ++errorsCount;
}
progress(0.3);
// If masked bins present, need to recalculate numPoints here
if (maskedBins) numPoints = static_cast<int>(unmaskedY.size());
// If no points left for any reason, bail out
if (numPoints == 0)
{
g_log.error("No points in this range to fit");
throw std::runtime_error("No points in this range to fit");
}
// Set up pointer variables to pass to gsl, pointing them to the right place
const double * const xVals = ( isHistogram ? &XCen[0] : &X[m_minX] );
const double * const yVals = ( maskedBins ? &unmaskedY[0] : &Y[m_minX] );
// Call the gsl fitting function
// The stride value of 1 reflects that fact that we want every element of our input vectors
const int stride = 1;
double *c0(new double),*c1(new double),*cov00(new double),*cov01(new double),*cov11(new double),*chisq(new double);
int status;
// Unless our spectrum has error values for vast majority of points,
// call the gsl function that doesn't use errors
if ( errorsCount/numPoints < 0.9 )
{
g_log.debug("Calling gsl_fit_linear (doesn't use errors in fit)");
status = gsl_fit_linear(xVals,stride,yVals,stride,numPoints,c0,c1,cov00,cov01,cov11,chisq);
}
// Otherwise, call the one that does account for errors on the data points
else
{
g_log.debug("Calling gsl_fit_wlinear (uses errors in fit)");
status = gsl_fit_wlinear(xVals,stride,&weights[0],stride,yVals,stride,numPoints,c0,c1,cov00,cov01,cov11,chisq);
}
progress(0.8);
// Check that the fit succeeded
std::string fitStatus = gsl_strerror(status);
// For some reason, a fit where c0,c1 & chisq are all infinity doesn't report as a
// failure, so check explicitly.
if ( !gsl_finite(*chisq) || !gsl_finite(*c0) || !gsl_finite(*c1) )
fitStatus = "Fit gives infinities";
if (fitStatus != "success") g_log.error() << "The fit failed: " << fitStatus << "\n";
else
g_log.information() << "The fit succeeded, giving y = " << *c0 << " + " << *c1 << "*x, with a Chi^2 of " << *chisq << "\n";
// Set the fit result output properties
setProperty("FitStatus",fitStatus);
setProperty("FitIntercept",*c0);
setProperty("FitSlope",*c1);
setProperty("Cov00",*cov00);
setProperty("Cov11",*cov11);
setProperty("Cov01",*cov01);
setProperty("Chi2",*chisq);
// Create and fill a workspace2D with the same bins as the fitted spectrum and the value of the fit for the centre of each bin
const size_t YSize = Y.size();
MatrixWorkspace_sptr outputWorkspace = WorkspaceFactory::Instance().create(inputWorkspace,1,X.size(),YSize);
// Copy over the X bins
outputWorkspace->dataX(0).assign(X.begin(),X.end());
// Now loop over the spectrum and use gsl function to calculate the Y & E values for the function
for (size_t i = 0; i < YSize; ++i)
{
const double x = ( isHistogram ? 0.5*(X[i]+X[i+1]) : X[i] );
const int err = gsl_fit_linear_est(x,*c0,*c1,*cov00,*cov01,*cov11,&(outputWorkspace->dataY(0)[i]),&(outputWorkspace->dataE(0)[i]));
if (err) g_log.warning() << "Problem in filling the output workspace: " << gsl_strerror(err) << std::endl;
}
setProperty("OutputWorkspace",outputWorkspace);
progress(1);
// Clean up
delete c0;
delete c1;
delete cov00;
delete cov01;
delete cov11;
delete chisq;
}
int
lls_complex_fold(const gsl_matrix_complex *A, const gsl_vector_complex *b,
lls_complex_workspace *w)
{
const size_t n = A->size1;
if (A->size2 != w->p)
{
fprintf(stderr, "lls_complex_fold: A has wrong size2\n");
return GSL_EBADLEN;
}
else if (n != b->size)
{
fprintf(stderr, "lls_complex_fold: b has wrong size\n");
return GSL_EBADLEN;
}
else
{
int s = 0;
double bnorm;
#if 0
size_t i;
gsl_vector_view wv = gsl_vector_subvector(w->w_robust, 0, n);
if (w->niter > 0)
{
gsl_vector_complex_view rc = gsl_vector_complex_subvector(w->r_complex, 0, n);
gsl_vector_view rv = gsl_vector_subvector(w->r, 0, n);
/* calculate residuals with previously computed coefficients: r = b - A c */
gsl_vector_complex_memcpy(&rc.vector, b);
gsl_blas_zgemv(CblasNoTrans, GSL_COMPLEX_NEGONE, A, w->c, GSL_COMPLEX_ONE, &rc.vector);
/* compute Re(r) */
for (i = 0; i < n; ++i)
{
gsl_complex ri = gsl_vector_complex_get(&rc.vector, i);
gsl_vector_set(&rv.vector, i, GSL_REAL(ri));
}
/* calculate weights with robust weighting function */
gsl_multifit_robust_weights(&rv.vector, &wv.vector, w->robust_workspace_p);
}
else
gsl_vector_set_all(&wv.vector, 1.0);
/* compute final weights as product of input and robust weights */
gsl_vector_mul(wts, &wv.vector);
#endif
/* AHA += A^H A, using only the upper half of the matrix */
s = gsl_blas_zherk(CblasUpper, CblasConjTrans, 1.0, A, 1.0, w->AHA);
if (s)
return s;
/* AHb += A^H b */
s = gsl_blas_zgemv(CblasConjTrans, GSL_COMPLEX_ONE, A, b, GSL_COMPLEX_ONE, w->AHb);
if (s)
return s;
/* bHb += b^H b */
bnorm = gsl_blas_dznrm2(b);
w->bHb += bnorm * bnorm;
fprintf(stderr, "norm(AHb) = %.12e, bHb = %.12e\n",
gsl_blas_dznrm2(w->AHb), w->bHb);
if (!gsl_finite(w->bHb))
{
fprintf(stderr, "bHb is NAN\n");
exit(1);
}
return s;
}
} /* lls_complex_fold() */
// Display a value with units
char *ppl_unitsNumericDisplay(ppl_context *c, pplObj *in, int N, int typeable, int NSigFigs)
{
double numberOutReal, numberOutImag, OoM;
char *output, *unitstr;
int i=0;
if (N==0) output = c->udNumDispA;
else output = c->udNumDispB;
if (NSigFigs <= 0) NSigFigs = c->set->term_current.SignificantFigures; // If number of significant figures not specified, use user-selected number
if ((c->set->term_current.ComplexNumbers == SW_ONOFF_OFF) && (in->flagComplex!=0)) return ppl_numericDisplay(GSL_NAN, c->numdispBuff[N], NSigFigs, (typeable==SW_DISPLAY_L));
if (typeable==0) typeable = c->set->term_current.NumDisplay;
unitstr = ppl_printUnit(c, in, &numberOutReal, &numberOutImag, N, 1, typeable);
if (((c->set->term_current.ComplexNumbers == SW_ONOFF_OFF) && (in->flagComplex!=0)) || (!gsl_finite(numberOutReal)) || (!gsl_finite(numberOutImag)))
{
if (typeable == SW_DISPLAY_L) output[i++] = '$';
strcpy(output+i, ppl_numericDisplay(GSL_NAN, c->numdispBuff[N], NSigFigs, (typeable==SW_DISPLAY_L)));
i+=strlen(output+i);
}
else
{
OoM = hypot(numberOutReal , numberOutImag) * pow(10 , -NSigFigs);
if (typeable == SW_DISPLAY_L) output[i++] = '$';
if ((fabs(numberOutReal) >= OoM) && (fabs(numberOutImag) > OoM)) output[i++] = '('; // open brackets on complex number
if (fabs(numberOutReal) >= OoM) { strcpy(output+i, ppl_numericDisplay(numberOutReal, c->numdispBuff[N], NSigFigs, (typeable==SW_DISPLAY_L))); i+=strlen(output+i); }
if ((fabs(numberOutReal) >= OoM) && (fabs(numberOutImag) > OoM) && (numberOutImag > 0)) output[i++] = '+';
if (fabs(numberOutImag) > OoM)
{
if (fabs(numberOutImag-1.0)>=OoM) // If this is false, imaginary part is 1, so print +i, not +1i
{
if (fabs(numberOutImag+1.0)>=OoM)
{
strcpy(output+i, ppl_numericDisplay(numberOutImag, c->numdispBuff[N], NSigFigs, (typeable==SW_DISPLAY_L)));
i+=strlen(output+i);
}
else
{ output[i++]='-'; } // Just print -i, not -1i
}
if (typeable != SW_DISPLAY_T) { output[i++] = 'i'; }
else if ((fabs(numberOutImag-1.0)>=OoM)&&(fabs(numberOutImag+1.0)>=OoM)) { strcpy(output+i, "*sqrt(-1)"); i+=strlen(output+i); }
else { strcpy(output+i, "sqrt(-1)"); i+=strlen(output+i); } // We've not printed 1 or -1, so nothing to multiply with
}
if ((fabs(numberOutReal) >= OoM) && (fabs(numberOutImag) > OoM)) output[i++] = ')'; // close brackets on complex number
}
if (unitstr[0]!='\0')
{
if (typeable == SW_DISPLAY_N) output[i++] = ' ';
else if (typeable == SW_DISPLAY_L) { output[i++] = '\\'; output[i++] = ','; }
sprintf(output+i, "%s", unitstr);
i+=strlen(output+i); // Add unit string as required
}
if (typeable == SW_DISPLAY_L) output[i++] = '$';
output[i++] = '\0'; // null terminate string
return output;
}
// Display a value with units and format string
char *ppl_unitsNumericDisplayWithFormat(ppl_context *c, pplObj *in, int N, char *formatString, char formatChar, int maxLen, int requiredArgs, int arg1i, int arg2i)
{
double numberOutReal, numberOutImag;
char *output, *unitstr;
int i=0, done=0, intArg=0;
if (N==0) output = c->udNumDispA;
else output = c->udNumDispB;
if ((c->set->term_current.ComplexNumbers == SW_ONOFF_OFF) && (in->flagComplex!=0))
{
strcpy(output, "nan");
return output;
}
unitstr = ppl_printUnit(c, in, &numberOutReal, &numberOutImag, N, 1, 0);
if ((formatChar=='d') || (formatChar=='i') || (formatChar=='o'))
{
if ((numberOutReal>INT_MAX)||(numberOutImag>INT_MAX)) { strcpy(output+i, "inf"); done=1; }
else if ((numberOutReal<INT_MIN)||(numberOutImag<INT_MIN)) { strcpy(output+i, "-inf"); done=1; }
intArg=1;
}
else if ((formatChar=='x') || (formatChar=='X'))
{
if ((numberOutReal>UINT_MAX)||(numberOutImag>UINT_MAX)) { strcpy(output+i, "inf"); done=1; }
else if ((numberOutReal<0 )||(numberOutImag<0 )) { strcpy(output+i, "-inf"); done=1; }
intArg=2;
}
if (done)
{
i+=strlen(output+i);
}
else if (((c->set->term_current.ComplexNumbers == SW_ONOFF_OFF) && (in->flagComplex!=0)) || (!gsl_finite(numberOutReal)) || (!gsl_finite(numberOutImag)))
{
strcpy(output+i, "nan");
i+=strlen(output+i);
}
else
{
if (in->flagComplex) output[i++] = '('; // open brackets on complex number
#define PRINTFORM(X) \
{ \
if (intArg==0) \
{ \
if (requiredArgs==1) snprintf(output+i, maxLen-i-4, formatString, X); /* Print a double (real part) */ \
if (requiredArgs==2) snprintf(output+i, maxLen-i-4, formatString, arg1i, X); \
if (requiredArgs==3) snprintf(output+i, maxLen-i-4, formatString, arg1i, arg2i, X); \
} \
else if (intArg==1) \
{ \
int xi = (int)X; \
if (requiredArgs==1) snprintf(output+i, maxLen-i-4, formatString, xi); /* Print an integer */ \
if (requiredArgs==2) snprintf(output+i, maxLen-i-4, formatString, arg1i, xi); \
if (requiredArgs==3) snprintf(output+i, maxLen-i-4, formatString, arg1i, arg2i, xi); \
} \
else if (intArg==2) \
{ \
unsigned int xi = (unsigned int)X; \
if (requiredArgs==1) snprintf(output+i, maxLen-i-4, formatString, xi); /* Print an unsigned integer */ \
if (requiredArgs==2) snprintf(output+i, maxLen-i-4, formatString, arg1i, xi); \
if (requiredArgs==3) snprintf(output+i, maxLen-i-4, formatString, arg1i, arg2i, xi); \
} \
}
PRINTFORM(numberOutReal);
i+=strlen(output+i);
if (in->flagComplex)
{
output[i++] = '+';
PRINTFORM(numberOutImag);
i+=strlen(output+i);
output[i++] = 'i';
output[i++] = ')'; // close brackets on complex number
}
}
if (unitstr[0]!='\0')
{
snprintf(output+i, maxLen-i, " %s", unitstr);
i+=strlen(output+i); // Add unit string as required
}
output[i++] = '\0'; // null terminate string
return output;
}
void ppl_expIntegrate(ppl_context *c, pplExpr *inExpr, int inExprCharPos, char *expr, int exprPos, char *dummy, pplObj *min, pplObj *max, pplObj *out, int dollarAllowed, int iterDepth)
{
calculusComm commlink;
pplObj *dummyVar;
pplObj dummyTemp;
gsl_integration_workspace *ws;
gsl_function fn;
pplExpr *expr2;
int explen;
double resultReal=0, resultImag=0, error;
if (!ppl_unitsDimEqual(min,max))
{
strcpy(c->errStat.errBuff, "The minimum and maximum limits of this integration operation are not dimensionally compatible.");
ppl_tbAdd(c,inExpr->srcLineN,inExpr->srcId,inExpr->srcFname,0,ERR_UNIT,inExprCharPos,inExpr->ascii,"int_d?() function");
return;
}
if (min->flagComplex || max->flagComplex)
{
strcpy(c->errStat.errBuff, "The minimum and maximum limits of this integration operation must be real numbers; supplied values are complex.");
ppl_tbAdd(c,inExpr->srcLineN,inExpr->srcId,inExpr->srcFname,0,ERR_NUMERICAL,inExprCharPos,inExpr->ascii,"int_d?() function");
return;
}
{
int errPos=-1, errType=-1;
ppl_expCompile(c,inExpr->srcLineN,inExpr->srcId,inExpr->srcFname,expr,&explen,dollarAllowed,1,1,&expr2,&errPos,&errType,c->errStat.errBuff);
if (errPos>=0) { pplExpr_free(expr2); ppl_tbAdd(c,inExpr->srcLineN,inExpr->srcId,inExpr->srcFname,0,errType,errPos+exprPos,inExpr->ascii,"int_d?() function"); return; }
if (explen<strlen(expr)) { strcpy(c->errStat.errBuff, "Unexpected trailing matter at the end of integrand."); ppl_tbAdd(c,inExpr->srcLineN,inExpr->srcId,inExpr->srcFname,0,ERR_SYNTAX,explen+exprPos,inExpr->ascii,"int_d?() function"); pplExpr_free(expr2); return; }
}
commlink.context = c;
commlink.integrate = 1;
commlink.expr = expr2;
commlink.isFirst = 1;
commlink.testingReal = 1;
commlink.varyingReal = 1;
commlink.dollarAllowed = dollarAllowed;
commlink.iterDepth = iterDepth;
pplObjNum(&commlink.first,0,0,0);
ppl_contextGetVarPointer(c, dummy, &dummyVar, &dummyTemp);
dummyVar->objType = min->objType;
dummyVar->real = min->real;
dummyVar->imag = min->imag;
dummyVar->flagComplex = min->flagComplex;
ppl_unitsDimCpy(dummyVar, min); // Get units of dummyVar right
commlink.dummy = dummyVar;
commlink.dummyReal = dummyVar->real;
commlink.dummyImag = dummyVar->imag;
ws = gsl_integration_workspace_alloc(1000);
fn.function = &ppl_expEvalCalculusSlave;
fn.params = &commlink;
gsl_integration_qags (&fn, min->real, max->real, 0, 1e-7, 1000, ws, &resultReal, &error);
if ((!c->errStat.status) && (c->set->term_current.ComplexNumbers == SW_ONOFF_ON))
{
commlink.testingReal = 0;
gsl_integration_qags (&fn, min->real, max->real, 0, 1e-7, 1000, ws, &resultImag, &error);
}
gsl_integration_workspace_free(ws);
pplExpr_free(expr2);
ppl_contextRestoreVarPointer(c, dummy, &dummyTemp); // Restore old value of the dummy variable we've been using
if (!c->errStat.status)
{
int status=0, errType=-1;
ppl_uaMul( c, &commlink.first , min , out , &status, &errType, c->errStat.errBuff ); // Get units of output right
if (status) { ppl_tbAdd(c,inExpr->srcLineN,inExpr->srcId,inExpr->srcFname,0,errType,inExprCharPos,inExpr->ascii,"int_d?() function"); return; }
out->real = resultReal;
out->imag = resultImag;
out->flagComplex = !ppl_dblEqual(resultImag, 0);
if (!out->flagComplex) out->imag=0.0; // Enforce that real numbers have positive zero imaginary components
if ((!gsl_finite(out->real)) || (!gsl_finite(out->imag)) || ((out->flagComplex) && (c->set->term_current.ComplexNumbers == SW_ONOFF_OFF)))
{
if (c->set->term_current.ExplicitErrors == SW_ONOFF_ON) { sprintf(c->errStat.errBuff, "Integral does not evaluate to a finite value."); ppl_tbAdd(c,inExpr->srcLineN,inExpr->srcId,inExpr->srcFname,0,ERR_NUMERICAL,exprPos,inExpr->ascii,"int_d?() function"); return; }
else { out->real = GSL_NAN; out->imag = 0; out->flagComplex=0; }
}
}
else
{
strcpy(c->errStat.errBuff, "");
ppl_tbAdd(c,inExpr->srcLineN,inExpr->srcId,inExpr->srcFname,0,ERR_GENERIC,inExprCharPos,inExpr->ascii,"int_d?() function");
}
return;
}
int mcmclib_vector_is_finite(const gsl_vector* x) {
for(size_t i=0; i < x->size; i++)
if(!gsl_finite(gsl_vector_get(x, i)))
return 0;
return 1;
}
void ppl_expDifferentiate(ppl_context *c, pplExpr *inExpr, int inExprCharPos, char *expr, int exprPos, char *dummy, pplObj *point, pplObj *step, pplObj *out, int dollarAllowed, int iterDepth)
{
calculusComm commlink;
pplObj *dummyVar;
pplObj dummyTemp;
gsl_function fn;
pplExpr *expr2;
int explen;
double resultReal=0, resultImag=0, dIdI, dRdI;
double resultReal_error, resultImag_error, dIdI_error, dRdI_error;
if (!ppl_unitsDimEqual(point, step))
{
strcpy(c->errStat.errBuff, "The arguments x and step to this differentiation operation are not dimensionally compatible.");
ppl_tbAdd(c,inExpr->srcLineN,inExpr->srcId,inExpr->srcFname,0,ERR_NUMERICAL,inExprCharPos,inExpr->ascii,"diff_d?() function");
return;
}
if (step->flagComplex)
{
strcpy(c->errStat.errBuff, "The argument 'step' to this differentiation operation must be a real number; supplied value is complex.");
ppl_tbAdd(c,inExpr->srcLineN,inExpr->srcId,inExpr->srcFname,0,ERR_NUMERICAL,inExprCharPos,inExpr->ascii,"diff_d?() function");
return;
}
{
int errPos=-1, errType=-1;
ppl_expCompile(c,inExpr->srcLineN,inExpr->srcId,inExpr->srcFname,expr,&explen,dollarAllowed,1,1,&expr2,&errPos,&errType,c->errStat.errBuff);
if (errPos>=0) { pplExpr_free(expr2); ppl_tbAdd(c,inExpr->srcLineN,inExpr->srcId,inExpr->srcFname,0,errType,errPos+exprPos,inExpr->ascii,"diff_d?() function"); return; }
if (explen<strlen(expr)) { strcpy(c->errStat.errBuff, "Unexpected trailing matter at the end of differentiated expression."); ppl_tbAdd(c,inExpr->srcLineN,inExpr->srcId,inExpr->srcFname,0,ERR_SYNTAX,explen,inExpr->ascii,"diff_d?() function"); pplExpr_free(expr2); return; }
}
commlink.context = c;
commlink.integrate = 0;
commlink.expr = expr2;
commlink.isFirst = 1;
commlink.testingReal = 1;
commlink.varyingReal = 1;
commlink.dollarAllowed = dollarAllowed;
commlink.iterDepth = iterDepth;
pplObjNum(&commlink.first,0,0,0);
ppl_contextGetVarPointer(c, dummy, &dummyVar, &dummyTemp);
dummyVar->objType = point->objType;
dummyVar->real = point->real;
dummyVar->imag = point->imag;
dummyVar->flagComplex = point->flagComplex;
ppl_unitsDimCpy(dummyVar, point); // Get units of dummyVar right
commlink.dummy = dummyVar;
commlink.dummyReal = dummyVar->real;
commlink.dummyImag = dummyVar->imag;
fn.function = &ppl_expEvalCalculusSlave;
fn.params = &commlink;
gsl_deriv_central(&fn, point->real, step->real, &resultReal, &resultReal_error);
pplExpr_free(expr2);
if ((!c->errStat.status) && (c->set->term_current.ComplexNumbers == SW_ONOFF_ON))
{
commlink.testingReal = 0;
gsl_deriv_central(&fn, point->real, step->real, &resultImag, &resultImag_error);
commlink.varyingReal = 0;
gsl_deriv_central(&fn, point->imag, step->real, &dIdI , &dIdI_error);
commlink.testingReal = 1;
gsl_deriv_central(&fn, point->imag, step->real, &dRdI , &dRdI_error);
if ((!ppl_dblApprox(resultReal, dIdI, 2*(resultReal_error+dIdI_error))) || (!ppl_dblApprox(resultImag, -dRdI, 2*(resultImag_error+dRdI_error))))
{ sprintf(c->errStat.errBuff, "The Cauchy-Riemann equations are not satisfied at this point in the complex plane. It does not therefore appear possible to perform complex differentiation. In the notation f(x+iy)=u+iv, the offending derivatives were: du/dx=%e, dv/dy=%e, du/dy=%e and dv/dx=%e.", resultReal, dIdI, dRdI, resultImag); ppl_tbAdd(c,inExpr->srcLineN,inExpr->srcId,inExpr->srcFname,0,ERR_NUMERICAL,exprPos,inExpr->ascii,"diff_d?() function"); return; }
}
ppl_contextRestoreVarPointer(c, dummy, &dummyTemp); // Restore old value of the dummy variable we've been using
if (!c->errStat.status)
{
int status=0, errType=-1;
point->real = 1.0; point->imag = 0.0; point->flagComplex = 0;
ppl_uaDiv( c , &commlink.first , point , out , &status, &errType, c->errStat.errBuff ); // Get units of output right
if (status) { ppl_tbAdd(c,inExpr->srcLineN,inExpr->srcId,inExpr->srcFname,0,errType,inExprCharPos,inExpr->ascii,"diff_d?() function"); return; }
out->real = resultReal;
out->imag = resultImag;
out->flagComplex = !ppl_dblEqual(resultImag, 0);
if (!out->flagComplex) out->imag=0.0; // Enforce that real numbers have positive zero imaginary components
}
if ((!gsl_finite(out->real)) || (!gsl_finite(out->imag)) || ((out->flagComplex) && (c->set->term_current.ComplexNumbers == SW_ONOFF_OFF)))
{
if (c->set->term_current.ExplicitErrors == SW_ONOFF_ON) { sprintf(c->errStat.errBuff, "Differentiated expression does not evaluate to a finite value."); ppl_tbAdd(c,inExpr->srcLineN,inExpr->srcId,inExpr->srcFname,0,ERR_NUMERICAL,exprPos,inExpr->ascii,"diff_d?() function"); return; }
else { out->real = GSL_NAN; out->imag = 0; out->flagComplex=0; }
}
return;
}
static VALUE rb_gsl_finite(VALUE obj, VALUE x)
{
Need_Float(x);
return INT2FIX(gsl_finite(NUM2DBL(x)));
}
static VALUE rb_gsl_finite2(VALUE obj, VALUE x)
{
Need_Float(x);
if (gsl_finite(NUM2DBL(x))) return Qtrue;
else return Qfalse;
}
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 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_n(-3.14,%d)", 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)");
/* Test for frexp */
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");
/* 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 (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 (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)");
}
exit (gsl_test_summary ());
}
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 ());
}
void Matrix::save(const QString &fn, const QString &info, bool saveAsTemplate)
{
QFile f(fn);
if (!f.isOpen()){
if (!f.open(QIODevice::Append))
return;
}
bool notTemplate = !saveAsTemplate;
QTextStream t( &f );
t.setEncoding(QTextStream::UnicodeUTF8);
t << "<matrix>\n";
if (notTemplate)
t << QString(objectName()) + "\t";
t << QString::number(numRows())+"\t";
t << QString::number(numCols())+"\t";
if (notTemplate)
t << birthDate() + "\n";
t << info;
t << "ColWidth\t" + QString::number(d_column_width)+"\n";
t << "<formula>\n" + formula_str + "\n</formula>\n";
t << "TextFormat\t" + QString(txt_format) + "\t" + QString::number(num_precision) + "\n";
if (notTemplate)
t << "WindowLabel\t" + windowLabel() + "\t" + QString::number(captionPolicy()) + "\n";
t << "Coordinates\t" + QString::number(x_start,'g',15) + "\t" +QString::number(x_end,'g',15) + "\t";
t << QString::number(y_start,'g',15) + "\t" + QString::number(y_end,'g',15) + "\n";
t << "ViewType\t" + QString::number((int)d_view_type) + "\n";
t << "HeaderViewType\t" + QString::number((int)d_header_view_type) + "\n";
if (d_color_map_type != Custom)
t << "ColorPolicy\t" + QString::number(d_color_map_type) + "\n";
else
t << ColorMapEditor::saveToXmlString(d_color_map);
if (notTemplate){//save data
t << "<data>\n";
double* d_data = d_matrix_model->dataVector();
int d_rows = numRows();
int d_cols = numCols();
int cols = d_cols - 1;
for(int i = 0; i < d_rows; i++){
int aux = d_cols*i;
bool emptyRow = true;
for(int j = 0; j < d_cols; j++){
if (gsl_finite(d_data[aux + j])){
emptyRow = false;
break;
}
}
if (emptyRow)
continue;
t << QString::number(i) + "\t";
for(int j = 0; j < cols; j++){
double val = d_data[aux + j];
if (gsl_finite(val))
t << QString::number(val, 'e', 16);
t << "\t";
}
double val = d_data[aux + cols];
if (gsl_finite(val))
t << QString::number(val, 'e', 16);
t << "\n";
}
t << "</data>\n";
}
t << "</matrix>\n";
}
/**
* C++ version of gsl_finite().
* @param x A double.
* @return 1 for finite; 0 otherwise.
*/
inline int finite( double const x ){ return gsl_finite( x ); }
int
gsl_multifit_linear_lcorner2(const gsl_vector *reg_param,
const gsl_vector *eta,
size_t *idx)
{
const size_t n = reg_param->size;
if (n < 3)
{
GSL_ERROR ("at least 3 points are needed for L-curve analysis",
GSL_EBADLEN);
}
else if (n != eta->size)
{
GSL_ERROR ("size of reg_param and eta vectors do not match",
GSL_EBADLEN);
}
else
{
int s = GSL_SUCCESS;
size_t i;
double x1, y1; /* first point of triangle on L-curve */
double x2, y2; /* second point of triangle on L-curve */
double rmin = -1.0; /* minimum radius of curvature */
/* initial values */
x1 = gsl_vector_get(reg_param, 0);
x1 *= x1;
y1 = gsl_vector_get(eta, 0);
y1 *= y1;
x2 = gsl_vector_get(reg_param, 1);
x2 *= x2;
y2 = gsl_vector_get(eta, 1);
y2 *= y2;
for (i = 1; i < n - 1; ++i)
{
/*
* The points (x1,y1), (x2,y2), (x3,y3) are the previous,
* current, and next point on the L-curve. We will find
* the circle which fits these 3 points and take its radius
* as an estimate of the curvature at this point.
*/
double lamip1 = gsl_vector_get(reg_param, i + 1);
double etaip1 = gsl_vector_get(eta, i + 1);
double x3 = lamip1 * lamip1;
double y3 = etaip1 * etaip1;
double x21 = x2 - x1;
double y21 = y2 - y1;
double x31 = x3 - x1;
double y31 = y3 - y1;
double h21 = x21*x21 + y21*y21;
double h31 = x31*x31 + y31*y31;
double d = fabs(2.0 * (x21*y31 - x31*y21));
double r = sqrt(h21*h31*((x3-x2)*(x3-x2)+(y3-y2)*(y3-y2))) / d;
/* if d =~ 0 then there are nearly colinear points */
if (gsl_finite(r))
{
/* check for smallest radius of curvature */
if (r < rmin || rmin < 0.0)
{
rmin = r;
*idx = i;
}
}
/* update previous/current L-curve values */
x1 = x2;
y1 = y2;
x2 = x3;
y2 = y3;
}
/* check if a minimum radius was found */
if (rmin < 0.0)
{
/* possibly co-linear points */
GSL_ERROR("failed to find minimum radius", GSL_EINVAL);
}
return s;
}
} /* gsl_multifit_linear_lcorner2() */