private static void CentralDeriv(PZMath_f f, double x, double h, out double result, out double abserr_round, out double abserr_trunc)
{
/* Compute the derivative using the 5-point rule (x-h, x-h/2, x,
x+h/2, x+h). Note that the central point is not used.
Compute the error using the difference between the 5-point and
the 3-point rule (x-h,x,x+h). Again the central point is not
used. */
double fm1 = f.FN_EVAL(x - h);
double fp1 = f.FN_EVAL(x + h);
double fmh = f.FN_EVAL (x - h / 2);
double fph = f.FN_EVAL (x + h / 2);
double r3 = 0.5 * (fp1 - fm1);
double r5 = (4.0 / 3.0) * (fph - fmh) - (1.0 / 3.0) * r3;
double e3 = (System.Math.Abs(fp1) + System.Math.Abs(fm1)) * PZMath_machine.PZMath_DBL_EPSILON;
double e5 = 2.0 * (System.Math.Abs(fph) + System.Math.Abs(fmh)) * PZMath_machine.PZMath_DBL_EPSILON + e3;
double dy = System.Math.Max(System.Math.Abs(r3), System.Math.Abs(r5)) * System.Math.Abs(x) * PZMath_machine.PZMath_DBL_EPSILON;
/* The truncation error in the r5 approximation itself is O(h^4).
However, for safety, we estimate the error from r5-r3, which is
O(h^2). By scaling h we will minimise this estimated error, not
the actual truncation error in r5. */
result = r5 / h;
abserr_trunc = System.Math.Abs((r5 - r3) / h); /* Estimated truncation error O(h^2) */
abserr_round = System.Math.Abs(e5 / h) + dy; /* Rounding error (cancellations) */
}
public int Central(PZMath_f f, double x, double h, out double result, out double abserr)
{
double r_0, round, trunc, error;
CentralDeriv (f, x, h, out r_0, out round, out trunc);
error = round + trunc;
if (round < trunc && (round > 0 && trunc > 0))
{
double r_opt, round_opt, trunc_opt, error_opt;
/* Compute an optimised stepsize to minimize the total error,
using the scaling of the truncation error (O(h^2)) and
rounding error (O(1/h)). */
double h_opt = h * System.Math.Pow (round / (2.0 * trunc), 1.0 / 3.0);
CentralDeriv (f, x, h_opt, out r_opt, out round_opt, out trunc_opt);
error_opt = round_opt + trunc_opt;
/* Check that the new error is smaller, and that the new derivative
is consistent with the error bounds of the original estimate. */
if (error_opt < error && System.Math.Abs(r_opt - r_0) < 4.0 * error)
{
r_0 = r_opt;
error = error_opt;
}
}
result = r_0;
abserr = error;
return PZMath_errno.PZMath_SUCCESS; // 1 means sucess;
}
public static void TestIntegration()
{
PZMath_integration_workspace w = new PZMath_integration_workspace();
w.Alloc(1000);
double result = 0, error = 0;
double expected = -4.0;
double alpha = 1.0;
TestIntegrationParms parms = new TestIntegrationParms(alpha);
PZMath_f F = new PZMath_f();
F.f = new PZMath_delegate_f(f);
F.Parms = parms;
PZMath_integration.Qags(F, 0, 1, 0, 1e-7, 1000, w, ref result, ref error);
System.Console.WriteLine ("result = " + result);
System.Console.WriteLine ("exact result = " + expected);
System.Console.WriteLine ("estimated error = " + error);
System.Console.WriteLine ("actual error = " + (result - expected));
System.Console.WriteLine ("intervals = " + w.size);
System.Console.ReadLine();
return;
}
public static void TestDeriv()
{
// the way to use PZMath_
// prepare parms
TestDerivParms x = new TestDerivParms();
x.x = 2;
// prepare PZMath_f
PZMath_f F = new PZMath_f();
F.f = new PZMath_delegate_f(f);
F.Parms = x;
// use PZMath_deriv
PZMath_deriv deriv = new PZMath_deriv();
double result;
double abserr;
deriv.Central(F, 2.0d, 0.1d, out result, out abserr);
System.Console.WriteLine("output " + result);
System.Console.WriteLine("cos " + 2 * System.Math.Cos(2 * 2));
System.Console.ReadLine();
}
static void QK(int n, double [] xgk, double [] wg, double [] wgk,
double [] fv1, double [] fv2,
PZMath_f f, double a, double b,
ref double result, ref double abserr, ref double resabs, ref double resasc)
{
double center = 0.5 * (a + b);
double half_length = 0.5 * (b - a);
double abs_half_length = System.Math.Abs (half_length);
double f_center = f.FN_EVAL(center);
double result_gauss = 0;
double result_kronrod = f_center * wgk[n - 1];
double result_abs = System.Math.Abs (result_kronrod);
double result_asc = 0;
double mean = 0, err = 0;
int j;
if (n % 2 == 0)
result_gauss = f_center * wg[n / 2 - 1];
for (j = 0; j < (n - 1) / 2; j++)
{
int jtw = j * 2 + 1; /* j=1,2,3 jtw=2,4,6 */
double abscissa = half_length * xgk[jtw];
double fval1 = f.FN_EVAL (center - abscissa);
double fval2 = f.FN_EVAL (center + abscissa);
double fsum = fval1 + fval2;
fv1[jtw] = fval1;
fv2[jtw] = fval2;
result_gauss += wg[j] * fsum;
result_kronrod += wgk[jtw] * fsum;
result_abs += wgk[jtw] * (System.Math.Abs (fval1) + System.Math.Abs (fval2));
}
for (j = 0; j < n / 2; j++)
{
int jtwm1 = j * 2;
double abscissa = half_length * xgk[jtwm1];
double fval1 = f.FN_EVAL (center - abscissa);
double fval2 = f.FN_EVAL (center + abscissa);
fv1[jtwm1] = fval1;
fv2[jtwm1] = fval2;
result_kronrod += wgk[jtwm1] * (fval1 + fval2);
result_abs += wgk[jtwm1] * (System.Math.Abs (fval1) + System.Math.Abs (fval2));
}
mean = result_kronrod * 0.5;
result_asc = wgk[n - 1] * System.Math.Abs (f_center - mean);
for (j = 0; j < n - 1; j++)
result_asc += wgk[j] * (System.Math.Abs (fv1[j] - mean) + System.Math.Abs (fv2[j] - mean));
/* scale by the width of the integration region */
err = (result_kronrod - result_gauss) * half_length;
result_kronrod *= half_length;
result_abs *= abs_half_length;
result_asc *= abs_half_length;
result = result_kronrod;
resabs = result_abs;
resasc = result_asc;
abserr = RescaleError (err, result_abs, result_asc);
}
public static void QK21(PZMath_f f, double a, double b,
ref double result, ref double abserr, ref double resabs, ref double resasc)
{
double [] xgk = /* abscissae of the 21-point kronrod rule */
{
0.995657163025808080735527280689003,
0.973906528517171720077964012084452,
0.930157491355708226001207180059508,
0.865063366688984510732096688423493,
0.780817726586416897063717578345042,
0.679409568299024406234327365114874,
0.562757134668604683339000099272694,
0.433395394129247190799265943165784,
0.294392862701460198131126603103866,
0.148874338981631210884826001129720,
0.000000000000000000000000000000000
};
/* xgk[1], xgk[3], ... abscissae of the 10-point gauss rule.
xgk[0], xgk[2], ... abscissae to optimally extend the 10-point gauss rule */
double [] wg = /* weights of the 10-point gauss rule */
{
0.066671344308688137593568809893332,
0.149451349150580593145776339657697,
0.219086362515982043995534934228163,
0.269266719309996355091226921569469,
0.295524224714752870173892994651338
};
double [] wgk = /* weights of the 21-point kronrod rule */
{
0.011694638867371874278064396062192,
0.032558162307964727478818972459390,
0.054755896574351996031381300244580,
0.075039674810919952767043140916190,
0.093125454583697605535065465083366,
0.109387158802297641899210590325805,
0.123491976262065851077958109831074,
0.134709217311473325928054001771707,
0.142775938577060080797094273138717,
0.147739104901338491374841515972068,
0.149445554002916905664936468389821
};
double [] fv1 = new double [11];
double [] fv2 = new double [11];
QK (11, xgk, wg, wgk, fv1, fv2, f, a, b, ref result, ref abserr, ref resabs, ref resasc);
}
public static int Qags(PZMath_f f, double a, double b,
double epsabs, double epsrel, int limit,PZMath_integration_workspace workspace,
ref double result, ref double abserr)
{
PZMath_integration_rules q = new PZMath_integration_rules(PZMath_integration.QK21);
double area, errsum;
double res_ext, err_ext;
double result0 = 0.0, abserr0 = 0.0, resabs0 = 0.0, resasc0 = 0.0;
double tolerance;
double ertest = 0;
double error_over_large_intervals = 0;
double reseps = 0, abseps = 0, correc = 0;
int ktmin = 0;
int roundoff_type1 = 0, roundoff_type2 = 0, roundoff_type3 = 0;
int error_type = 0, error_type2 = 0;
int iteration = 0;
int positive_integrand = 0;
int extrapolate = 0;
int disallow_extrapolation = 0;
ExtrapolationTable table = new ExtrapolationTable();
/* Initialize results */
workspace.Initialise(a, b);
result = 0;
abserr = 0;
if (limit > workspace.limit)
{
//PZMath_errno.ERROR ("iteration limit exceeds available workspace", PZMath_errno.PZMath_EINVAL) ;
//return 0;
return PZMath_errno.PZMath_EINVAL;
}
/* Test on accuracy */
if (epsabs <= 0 && (epsrel < 50 * PZMath_machine.PZMath_DBL_EPSILON || epsrel < 0.5e-28))
{
//PZMath_errno.ERROR ("tolerance cannot be acheived with given epsabs and epsrel",
// PZMath_errno.PZMath_EBADTOL);
//return 0;
return PZMath_errno.PZMath_EBADTOL;
}
/* Perform the first integration */
q (f, a, b, ref result0, ref abserr0, ref resabs0, ref resasc0);
workspace.SetInitialResult (result0, abserr0);
tolerance = System.Math.Max (epsabs, epsrel * System.Math.Abs (result0));
if (abserr0 <= 100 * PZMath_machine.PZMath_DBL_EPSILON * resabs0 && abserr0 > tolerance)
{
result = result0;
abserr = abserr0;
//PZMath_errno.ERROR ("cannot reach tolerance because of roundoff error on first attempt", PZMath_errno.PZMath_EROUND);
//return 0;
return PZMath_errno.PZMath_EROUND;
}
else if ((abserr0 <= tolerance && abserr0 != resasc0) || abserr0 == 0.0)
{
result = result0;
abserr = abserr0;
return PZMath_errno.PZMath_SUCCESS;
}
else if (limit == 1)
{
result = result0;
abserr = abserr0;
//PZMath_errno.ERROR ("a maximum of one iteration was insufficient", PZMath_errno.PZMath_EMAXITER);
//return 0;
return PZMath_errno.PZMath_EMAXITER;
}
/* Initialization */
table.InitialiseTable();
table.AppendTable(result0);
area = result0;
errsum = abserr0;
res_ext = result0;
err_ext = PZMath_machine.PZMath_DBL_MAX;
positive_integrand = TestPositivity (result0, resabs0);
iteration = 1;
do
{
int current_level;
double a1, b1, a2, b2;
double a_i = 0.0, b_i = 0.0, r_i = 0.0, e_i = 0.0;
double area1 = 0, area2 = 0, area12 = 0;
double error1 = 0, error2 = 0, error12 = 0;
double resasc1 = 0.0, resasc2 = 0.0;
double resabs1 = 0.0, resabs2 = 0.0;
double last_e_i;
/* Bisect the subinterval with the largest error estimate */
workspace.Retrieve (ref a_i, ref b_i, ref r_i, ref e_i);
current_level = workspace.level[workspace.i] + 1;
a1 = a_i;
b1 = 0.5 * (a_i + b_i);
a2 = b1;
b2 = b_i;
iteration ++;
q (f, a1, b1, ref area1, ref error1, ref resabs1, ref resasc1);
q (f, a2, b2, ref area2, ref error2, ref resabs2, ref resasc2);
area12 = area1 + area2;
error12 = error1 + error2;
last_e_i = e_i;
/* Improve previous approximations to the integral and test for
accuracy.
We write these expressions in the same way as the original
QUADPACK code so that the rounding errors are the same, which
makes testing easier. */
errsum = errsum + error12 - e_i;
area = area + area12 - r_i;
tolerance = System.Math.Max (epsabs, epsrel * System.Math.Abs (area));
if (resasc1 != error1 && resasc2 != error2)
{
double delta = r_i - area12;
if (System.Math.Abs (delta) <= 1.0e-5 * System.Math.Abs (area12) && error12 >= 0.99 * e_i)
{
if (extrapolate == 0)
roundoff_type1++;
else
roundoff_type2++;
}
if (iteration > 10 && error12 > e_i)
roundoff_type3++;
}
/* Test for roundoff and eventually set error flag */
if (roundoff_type1 + roundoff_type2 >= 10 || roundoff_type3 >= 20)
error_type = 2; /* round off error */
if (roundoff_type2 >= 5)
error_type2 = 1;
/* set error flag in the case of bad integrand behaviour at
a point of the integration range */
if (SubintervalTooSmall (a1, a2, b2))
error_type = 4;
/* append the newly-created intervals to the list */
workspace.Update (a1, b1, area1, error1, a2, b2, area2, error2);
if (errsum <= tolerance)
goto compute_result;
if (error_type >= 1)
break;
if (iteration >= limit - 1)
{
error_type = 1;
break;
}
if (iteration == 2) /* set up variables on first iteration */
{
error_over_large_intervals = errsum;
ertest = tolerance;
table.AppendTable (area);
continue;
}
if (disallow_extrapolation >= 1)
continue;
error_over_large_intervals += -last_e_i;
if (current_level < workspace.maximum_level)
error_over_large_intervals += error12;
if (extrapolate == 0)
{
/* test whether the interval to be bisected next is the
smallest interval. */
if (workspace.LargeInterval ())
continue;
extrapolate = 1;
workspace.nrmax = 1;
}
if (error_type2 == 0 && error_over_large_intervals > ertest)
{
if (workspace.IncreaseNrmax())
continue;
}
/* Perform extrapolation */
table.AppendTable (area);
table.Qelg(ref reseps, ref abseps);
ktmin ++;
if (ktmin > 5 && err_ext < 0.001 * errsum)
error_type = 5;
if (abseps < err_ext)
{
ktmin = 0;
err_ext = abseps;
res_ext = reseps;
correc = error_over_large_intervals;
ertest = System.Math.Max (epsabs, epsrel * System.Math.Abs (reseps));
if (err_ext <= ertest)
break;
}
/* Prepare bisection of the smallest interval. */
if (table.n == 1)
disallow_extrapolation = 1;
if (error_type == 5)
break;
/* work on interval with largest error */
workspace.ResetNrmax();
extrapolate = 0;
error_over_large_intervals = errsum;
}
while (iteration < limit);
result = res_ext;
abserr = err_ext;
if (err_ext == PZMath_machine.PZMath_DBL_MAX)
goto compute_result;
if (error_type >=1 || error_type2 >= 1)
{
if (error_type2 >= 1)
err_ext += correc;
if (error_type == 0)
error_type = 3;
if (res_ext != 0.0 && area != 0.0)
{
if (err_ext / System.Math.Abs (res_ext) > errsum / System.Math.Abs (area))
goto compute_result;
}
else if (err_ext > errsum)
goto compute_result;
else if (area == 0.0)
goto return_error;
}
/* Test on divergence. */
{
double max_area = System.Math.Max (System.Math.Abs (res_ext), System.Math.Abs (area));
if (positive_integrand == 0 && max_area < 0.01 * resabs0)
goto return_error;
}
{
double ratio = res_ext / area;
if (ratio < 0.01 || ratio > 100.0 || errsum > System.Math.Abs (area))
error_type = 6;
}
goto return_error;
compute_result:
result = workspace.SumResults();
abserr = errsum;
return_error:
if (error_type > 2)
error_type--;
if (error_type == 0)
return PZMath_errno.PZMath_SUCCESS;
else if (error_type == 1)
{
//PZMath_errno.ERROR("number of iterations was insufficient", PZMath_errno.PZMath_EMAXITER);
//return 0;
return PZMath_errno.PZMath_EMAXITER;
}
else if (error_type == 2)
{
//PZMath_errno.ERROR ("cannot reach tolerance because of roundoff error",
// PZMath_errno.PZMath_EROUND);
//return 0;
return PZMath_errno.PZMath_EROUND;
}
else if (error_type == 3)
{
//PZMath_errno.ERROR ("bad integrand behavior found in the integration interval",
// PZMath_errno.PZMath_ESING);
//return 0;
return PZMath_errno.PZMath_ESING;
}
else if (error_type == 4)
{
//PZMath_errno.ERROR ("roundoff error detected in the extrapolation table",
// PZMath_errno.PZMath_EROUND);
//return 0;
return PZMath_errno.PZMath_EROUND;
}
else if (error_type == 5)
{
//PZMath_errno.ERROR ("integral is divergent, or slowly convergent",
// PZMath_errno.PZMath_EDIVERGE);
//return 0;
return PZMath_errno.PZMath_EDIVERGE;
}
else
{
//PZMath_errno.ERROR ("could not integrate function", PZMath_errno.PZMath_EFAILED);
//return 0;
return PZMath_errno.PZMath_EFAILED;
}
}
