/*
* R rile
* dpois.c
*/
public static double DPoisson(double x, double lambda, bool giveLog)
{
if (double.IsNaN(x) || double.IsNaN(lambda))
{
return(x + lambda);
}
if (lambda < 0)
{
return(double.NaN); // ML_ERR_return_NAN;
}
if ((Math.Abs((x) - Math.Floor(x)) > 1e-7 * RVaria.fmax2(1.0, Math.Abs(x))))
{
//MATHLIB_WARNING("non-integer x = %f", x);
return(giveLog ? double.NegativeInfinity : 0.0);
}
if (x < 0 || !x.IsFinite())
{
return(giveLog ? double.NegativeInfinity : 0.0);
}
x = Math.Round(x);
return(dpois_raw(x, lambda, giveLog));
}
/* R file: integrate.c
*/
private static void rdqelg(ref int n, double[] epstab, out double result, out double abserr, double[] res3la, ref int nres)
{
/* Local variables */
int i__, indx, ib, ib2, ie, k1, k2, k3, num, newelm, limexp;
double delta1, delta2, delta3, e0, e1, e1abs, e2, e3, epmach, epsinf;
double oflow, ss, res;
double errA, err1, err2, err3, tol1, tol2, tol3;
#region prologue
/* ***begin prologue dqelg
***refer to dqagie,dqagoe,dqagpe,dqagse
***revision date 830518 (yymmdd)
***keywords epsilon algorithm, convergence acceleration,
* extrapolation
***author piessens,robert,appl. math. & progr. div. - k.u.leuven
* de doncker,elise,appl. math & progr. div. - k.u.leuven
***purpose the routine determines the limit of a given sequence of
* approximations, by means of the epsilon algorithm of
* p.wynn. an estimate of the absolute error is also given.
* the condensed epsilon table is computed. only those
* elements needed for the computation of the next diagonal
* are preserved.
***description
*
* epsilon algorithm
* standard fortran subroutine
* double precision version
*
* parameters
* n - int
* epstab(n) contains the new element in the
* first column of the epsilon table.
*
* epstab - double precision
* vector of dimension 52 containing the elements
* of the two lower diagonals of the triangular
* epsilon table. the elements are numbered
* starting at the right-hand corner of the
* triangle.
*
* result - double precision
* resulting approximation to the integral
*
* abserr - double precision
* estimate of the absolute error computed from
* result and the 3 previous results
*
* res3la - double precision
* vector of dimension 3 containing the last 3
* results
*
* nres - int
* number of calls to the routine
* (should be zero at first call)
*
***end prologue dqelg
*
*
* list of major variables
* -----------------------
*
* e0 - the 4 elements on which the computation of a new
* e1 element in the epsilon table is based
* e2
* e3 e0
* e3 e1 new
* e2
*
* newelm - number of elements to be computed in the new diagonal
* errA - errA = abs(e1-e0)+abs(e2-e1)+abs(new-e2)
* result - the element in the new diagonal with least value of errA
*
* machine dependent constants
* ---------------------------
*
* epmach is the largest relative spacing.
* oflow is the largest positive magnitude.
* limexp is the maximum number of elements the epsilon
* table can contain. if this number is reached, the upper
* diagonal of the epsilon table is deleted. */
#endregion
// -res3la;
//--epstab;
/* Function Body */
epmach = RVaria.DBL_EPSILON;
oflow = RVaria.DBL_MAX;
++nres;
abserr = oflow;
result = epstab[n - 1]; // modifié
if (n < 3)
{
goto L100;
}
limexp = 50;
epstab[n + 2 - 1] = epstab[n - 1]; // modifiés
newelm = (n - 1) / 2;
epstab[n - 1] = oflow; // modifié
num = n;
k1 = n;
for (i__ = 1; i__ <= newelm; ++i__)
{
k2 = k1 - 1;
k3 = k1 - 2;
res = epstab[k1 + 2 - 1]; // modifié
e0 = epstab[k3 - 1]; // modifié
e1 = epstab[k2 - 1]; // modifié
e2 = res;
e1abs = Math.Abs(e1);
delta2 = e2 - e1;
err2 = Math.Abs(delta2);
tol2 = RVaria.fmax2(Math.Abs(e2), e1abs) * epmach;
delta3 = e1 - e0;
err3 = Math.Abs(delta3);
tol3 = RVaria.fmax2(e1abs, Math.Abs(e0)) * epmach;
if (err2 <= tol2 && err3 <= tol3)
{
/* if e0, e1 and e2 are equal to within machine
* accuracy, convergence is assumed. */
result = res; /* result = e2 */
abserr = err2 + err3; /* abserr = fabs(e1-e0)+fabs(e2-e1) */
goto L100; /* ***jump out of do-loop */
}
e3 = epstab[k1 - 1]; // modifié
epstab[k1 - 1] = e1; // modifié
delta1 = e1 - e3;
err1 = Math.Abs(delta1);
tol1 = RVaria.fmax2(e1abs, Math.Abs(e3)) * epmach;
/* if two elements are very close to each other, omit
* a part of the table by adjusting the value of n */
if (err1 > tol1 && err2 > tol2 && err3 > tol3)
{
ss = 1.0 / delta1 + 1.0 / delta2 - 1.0 / delta3;
epsinf = Math.Abs(ss * e1);
/*
* test to detect irregular behaviour in the table, and
* eventually omit a part of the table adjusting the value of n.
*/
if (epsinf > 1e-4)
{
goto L30;
}
}
n = i__ + i__ - 1;
goto L50;
/* ***jump out of do-loop */
L30: /* compute a new element and eventually adjust the value of result. */
res = e1 + 1.0 / ss;
epstab[k1 - 1] = res; // modifié
k1 += -2;
errA = err2 + Math.Abs(res - e2) + err3;
if (errA <= abserr)
{
abserr = errA;
result = res;
}
}
/* shift the table. */
L50:
if (n == limexp)
{
n = (limexp / 2 << 1) - 1;
}
if (num / 2 << 1 == num)
{
ib = 2;
}
else
{
ib = 1;
}
ie = newelm + 1;
for (i__ = 1; i__ <= ie; ++i__)
{
ib2 = ib + 2;
epstab[ib - 1] = epstab[ib2 - 1];// modifiés
ib = ib2;
}
if (num != n)
{
indx = num - n + 1;
for (i__ = 1; i__ <= n; ++i__)
{
epstab[i__ - 1] = epstab[indx - 1]; // modifiés
++indx;
}
}
/*L80:*/
if (nres >= 4)
{
/* L90: */
abserr = Math.Abs(result - res3la[3 - 1]) +
Math.Abs(result - res3la[2 - 1]) +
Math.Abs(result - res3la[1 - 1]); //modifiés 3x
res3la[1 - 1] = res3la[2 - 1];
res3la[2 - 1] = res3la[3 - 1];
res3la[3 - 1] = result;//modifiés 3x
}
else
{
res3la[nres - 1] = result;
abserr = oflow;
}
L100: /* compute error estimate */
abserr = RVaria.fmax2(abserr, epmach * 5.0 * Math.Abs(result));
return;
}
/* R file: integrate.c
*/
private static void rdqagse(Parameters parameters, Workspace ws, Results results)
{
/* Local variables */
bool noext, extrap;
bool goto140 = false;
int k, ksgn, nres;
int ierro;
int ktmin, nrmax;
int iroff1, iroff2, iroff3;
int id;
int numrl2;
int jupbnd;
int maxerr;
int last;
int ier;
int neval;
int rdqk21_count = 0;
double[] res3la = new double[4];
double[] rlist2 = new double[53];
double
result = 0.0,
abserr = 0.0,
abseps,
area,
area1,
area2,
area12,
dres,
epmach;
double
a1,
a2,
b1,
b2,
defabs,
defab1,
defab2,
oflow,
uflow,
resabs,
reseps;
double
error1,
error2,
erro12,
errbnd,
erlast,
errmax,
errsum;
double
correc = 0.0,
erlarg = 0.0,
ertest = 0.0,
small = 0.0;
//Let's go
epmach = RVaria.DBL_EPSILON;
ier = 0;
neval = 0;
last = 0;
setArray(ws.alist);
setArray(ws.blist);
setArray(ws.rlist);
setArray(ws.elist);
setArray(ws.iord);
ws.alist[1] = parameters.a;
ws.blist[1] = parameters.b;
ws.rlist[1] = 0.0;
ws.elist[1] = 0.0;
//TODO déplacer(?) dans compute
if ((parameters.epsabs <= 0.0) && (parameters.epsrel < RVaria.fmax2(epmach * 50.0, 5e-29)))
{
ier = 6;
return;
}
/* first approximation to the integral */
/* ----------------------------------- */
uflow = RVaria.DBL_MIN;
oflow = RVaria.DBL_MAX;
ierro = 0;
rdqk21(parameters.f, parameters.a, parameters.b, out result, out abserr, out defabs, out resabs, ref rdqk21_count);
/* test on accuracy. */
dres = Math.Abs(result);
errbnd = RVaria.fmax2(parameters.epsabs, parameters.epsrel * dres);
last = 1;
ws.rlist[1] = result;
ws.elist[1] = abserr;
ws.iord[1] = 1;
if ((abserr <= (epmach * 100.0 * defabs)) && (abserr > errbnd))
{
ier = 2;
}
if (ws.limit == 1)
{
ier = 1;
}
if ((ier != 0) || (abserr <= errbnd && abserr != resabs) ||
(abserr == 0.0))
{
goto140 = true;
goto L139;
}
/* initialization */
/* -------------- */
rlist2[0] = result;
errmax = abserr;
maxerr = 1;
area = result;
errsum = abserr;
abserr = oflow;
nrmax = 1;
nres = 0;
numrl2 = 2;
ktmin = 0;
extrap = false;
noext = false;
iroff1 = 0;
iroff2 = 0;
iroff3 = 0;
ksgn = -1;
if (dres >= (1.0 - epmach * 50.0) * defabs)
{
ksgn = 1;
}
/*------------------------*/
for (last = 2; last <= parameters.limit; ++(last))
{
/* bisect the subinterval with the nrmax-th largest error estimate. */
a1 = ws.alist[maxerr];
b1 = (ws.alist[maxerr] + ws.blist[maxerr]) * .5;
a2 = b1;
b2 = ws.blist[maxerr];
erlast = errmax;
rdqk21(parameters.f, a1, b1, out area1, out error1, out resabs, out defab1, ref rdqk21_count);
rdqk21(parameters.f, a2, b2, out area2, out error2, out resabs, out defab2, ref rdqk21_count);
/* improve previous approximations to integral
* and error and test for accuracy. */
area12 = area1 + area2;
erro12 = error1 + error2;
errsum = errsum + erro12 - errmax;
area = area + area12 - ws.rlist[maxerr];
if (!(defab1 == error1 || defab2 == error2))
{
if (Math.Abs(ws.rlist[maxerr] - area12) <= Math.Abs(area12) * 1e-5 &&
erro12 >= errmax * .99)
{
if (extrap)
{
++iroff2;
}
else /* if(! extrap) */
{
++iroff1;
}
}
if (last > 10 && erro12 > errmax)
{
++iroff3;
}
}
ws.rlist[maxerr] = area1;
ws.rlist[last] = area2;
errbnd = RVaria.fmax2(parameters.epsabs, parameters.epsrel * Math.Abs(area));
/* test for roundoff error and eventually set error flag. */
if (iroff1 + iroff2 >= 10 || iroff3 >= 20)
{
ier = 2;
}
if (iroff2 >= 5)
{
ierro = 3;
}
/* set error flag in the case that the number of subintervals equals limit. */
if (last == ws.limit)
{
ier = 1;
}
/* set error flag in the case of bad integrand behaviour
* at a point of the integration range. */
if (RVaria.fmax2(Math.Abs(a1), Math.Abs(b2)) <=
(epmach * 100.0 + 1.0) * (Math.Abs(a2) + uflow * 1e3))
{
ier = 4;
}
/* append the newly-created intervals to the list. */
if (error2 > error1)
{
ws.alist[maxerr] = a2;
ws.alist[last] = a1;
ws.blist[last] = b1;
ws.rlist[maxerr] = area2;
ws.rlist[last] = area1;
ws.elist[maxerr] = error2;
ws.elist[last] = error1;
}
else
{
ws.alist[last] = a2;
ws.blist[maxerr] = b1;
ws.blist[last] = b2;
ws.elist[maxerr] = error1;
ws.elist[last] = error2;
}
/* call subroutine dqpsrt to maintain the descending ordering
* in the list of error estimates and select the subinterval
* with nrmax-th largest error estimate (to be bisected next). */
/*L30:*/
rdqpsrt(ws.limit, last, ref maxerr, out errmax, ws.elist, ws.iord, ref nrmax);
if (errsum <= errbnd)
{
goto L115;/* ***jump out of do-loop */
}
if (ier != 0)
{
break;
}
if (last == 2)
{ /* L80: */
small = Math.Abs(parameters.b - parameters.a) * .375;
erlarg = errsum;
ertest = errbnd;
rlist2[1] = area; continue;
}
if (noext)
{
continue;
}
erlarg -= erlast;
if (Math.Abs(b1 - a1) > small)
{
erlarg += erro12;
}
if (!extrap)
{
/* test whether the interval to be bisected next is the
* smallest interval. */
if (Math.Abs(ws.blist[maxerr] - ws.alist[maxerr]) > small)
{
continue;
}
extrap = true;
nrmax = 2;
}
if (ierro != 3 && erlarg > ertest)
{
/* the smallest interval has the largest error.
* before bisecting decrease the sum of the errors over the
* larger intervals (erlarg) and perform extrapolation. */
id = nrmax;
jupbnd = last;
if (last > parameters.limit / 2 + 2)
{
jupbnd = parameters.limit + 3 - last;
}
for (k = id; k <= jupbnd; ++k)
{
maxerr = ws.iord[nrmax];
errmax = ws.elist[maxerr];
if (Math.Abs(ws.blist[maxerr] - ws.alist[maxerr]) > small)
{
goto L90;
}
++nrmax;
/* L50: */
}
}
/* perform extrapolation. L60: */
++numrl2;
rlist2[numrl2 - 1] = area;
rdqelg(ref numrl2, rlist2, out reseps, out abseps, res3la, ref nres);
++ktmin;
if (ktmin > 5 && abserr < errsum * .001)
{
ier = 5;
}
if (abseps < abserr)
{
ktmin = 0;
abserr = abseps;
result = reseps;
correc = erlarg;
ertest = RVaria.fmax2(parameters.epsabs, parameters.epsrel * Math.Abs(reseps));
if (abserr <= ertest)
{
break;
}
}
/* prepare bisection of the smallest interval. L70: */
if (numrl2 == 1)
{
noext = true;
}
if (ier == 5)
{
break;
}
maxerr = ws.iord[1];
errmax = ws.elist[maxerr];
nrmax = 1;
extrap = false;
small *= 0.5;
erlarg = errsum;
L90:
;
}
/* L100: set final result and error estimate. */
/* ------------------------------------ */
if (abserr == oflow)
{
goto L115;
}
if (ier + ierro == 0)
{
goto L110;
}
if (ierro == 3)
{
abserr += correc;
}
if (ier == 0)
{
ier = 3;
}
if (result == 0.0 || area == 0.0)
{
if (abserr > errsum)
{
goto L115;
}
if (area == 0.0)
{
goto L130;
}
}
else
{ /* L105:*/
if (abserr / Math.Abs(result) > errsum / Math.Abs(area))
{
goto L115;
}
}
L110: /* test on divergence. */
if (ksgn == -1 && RVaria.fmax2(Math.Abs(result), Math.Abs(area)) <= defabs * .01)
{
goto L130;
}
if (.01 > result / area || result / area > 100.0 || errsum > Math.Abs(area))
{
ier = 5;
}
goto L130;
L115: /* compute global integral sum. */
result = 0.0;
for (k = 1; k <= last; ++k)
{
result += ws.rlist[k];
}
abserr = errsum;
L130:
L139:
if ((ier > 2) || goto140)
{
/*L140:*/
neval = last * 42 - 21;
}
results.AbsErr = abserr;
results.IEr = ier;
results.Last = last;
results.NEval = neval;
results.Value = result;
return;
// ---------------------------*/
}
/* R file: integrate.c
*/
private static void rdqk21(Func <double[], double[]> f, double a, double b, out double result, out double abserr, out double resabs, out double resasc, ref int rdqk21_count)
{
//static void rdqk21(integr_fn f, void *ex, double *a, double *b, double *result,
// double *abserr, double *resabs, double *resasc)
double[]
fv1 = new double[10],
fv2 = new double[10],
vec = new double[21];
double absc, resg, resk, fsum, fval1, fval2;
double hlgth, centr, reskh, uflow;
double fc, epmach, dhlgth;
int j, jtw, jtwm1;
rdqk21_count++;
epmach = RVaria.DBL_EPSILON;
uflow = RVaria.DBL_MIN;
centr = (a + b) * 0.5;
hlgth = (b - a) * 0.5;
dhlgth = Math.Abs(hlgth);
/* compute the 21-point kronrod approximation to
* the integral, and estimate the absolute error. */
resg = 0.0;
vec[0] = centr;
for (j = 1; j <= 5; ++j)
{
jtw = j << 1;
absc = hlgth * xgk[jtw - 1];
vec[(j << 1) - 1] = centr - absc;
/*L5:*/
vec[j * 2] = centr + absc;
}
for (j = 1; j <= 5; ++j)
{
jtwm1 = (j << 1) - 1;
absc = hlgth * xgk[jtwm1 - 1];
vec[(j << 1) + 9] = centr - absc;
vec[(j << 1) + 10] = centr + absc;
}
double[] vec_y = f(vec);//, 21);
fc = vec_y[0];
resk = wgk[10] * fc;
resabs = Math.Abs(resk);
for (j = 1; j <= 5; ++j)
{
jtw = j << 1;
absc = hlgth * xgk[jtw - 1];
fval1 = vec_y[(j << 1) - 1];
fval2 = vec_y[j * 2];
fv1[jtw - 1] = fval1;
fv2[jtw - 1] = fval2;
fsum = fval1 + fval2;
resg += wg[j - 1] * fsum;
resk += wgk[jtw - 1] * fsum;
resabs += wgk[jtw - 1] * (Math.Abs(fval1) + Math.Abs(fval2));
//L10:
}
for (j = 1; j <= 5; ++j)
{
jtwm1 = (j << 1) - 1;
absc = hlgth * xgk[jtwm1 - 1];
fval1 = vec_y[(j << 1) + 9];
fval2 = vec_y[(j << 1) + 10];
fv1[jtwm1 - 1] = fval1;
fv2[jtwm1 - 1] = fval2;
fsum = fval1 + fval2;
resk += wgk[jtwm1 - 1] * fsum;
resabs += wgk[jtwm1 - 1] * (Math.Abs(fval1) + Math.Abs(fval2));
// L15:
}
reskh = resk * .5;
resasc = wgk[10] * Math.Abs(fc - reskh);
for (j = 1; j <= 10; ++j)
{
resasc += wgk[j - 1] * (Math.Abs(fv1[j - 1] - reskh) +
Math.Abs(fv2[j - 1] - reskh));
/* L20: */
}
//vec[0] = 0;
result = resk * hlgth;
resabs *= dhlgth;
resasc *= dhlgth;
abserr = Math.Abs((resk - resg) * hlgth);
if ((resasc != 0.0) && (abserr != 0.0))
{
abserr = resasc * RVaria.fmin2(1.0, Math.Pow(abserr * 200.0 / resasc, 1.5));
}
if (resabs > uflow / (epmach * 50.0))
{
abserr = RVaria.fmax2(epmach * 50.0 * resabs, abserr);
}
return;
// throw new System.NotImplementedException();
}