Exemplo n.º 1
0
double psignrank(double x, double n, int lower_tail, int log_p)
{
    int i;
    double f, p;

#ifdef IEEE_754
    if (ISNAN(x) || ISNAN(n))
    return(x + n);
#endif
    if (!R_FINITE(n)) ML_ERR_return_NAN;
    n = floor(n + 0.5);
    if (n <= 0) ML_ERR_return_NAN;

    x = floor(x + 1e-7);
    if (x < 0.0)
	return(R_DT_0);
    if (x >= n * (n + 1) / 2)
	return(R_DT_1);

    w_init_maybe(n);
    f = exp(- n * M_LN2);
    p = 0;
    if (x <= (n * (n + 1) / 4)) {
	for (i = 0; i <= x; i++)
	    p += csignrank(i, n) * f;
    }
    else {
	x = n * (n + 1) / 2 - x;
	for (i = 0; i < x; i++)
	    p += csignrank(i, n) * f;
	lower_tail = !lower_tail; /* p = 1 - p; */
    }

    return(R_DT_val(p));
} /* psignrank() */
Exemplo n.º 2
0
double pnchisq(double x, double f, double theta, int lower_tail, int log_p)
{
#ifdef IEEE_754
    if (ISNAN(x) || ISNAN(f) || ISNAN(theta))
	return x + f + theta;
    if (!R_FINITE(f) || !R_FINITE(theta))
	ML_ERR_return_NAN;
#endif

    if (f < 0. || theta < 0.) ML_ERR_return_NAN;

    return (R_DT_val(pnchisq_raw(x, f, theta, 1e-12, 8*DBL_EPSILON, 1000000)));
}
Exemplo n.º 3
0
Arquivo: punif.cpp Projeto: Hkey1/boom
double punif(double x, double a, double b, int lower_tail, int log_p)
{
#ifdef IEEE_754
    if (ISNAN(x) || ISNAN(a) || ISNAN(b))
	return x + a + b;
#endif
    if (b <= a) ML_ERR_return_NAN;

    if (x <= a)
	return R_DT_0;
    if (x >= b)
	return R_DT_1;
    return R_DT_val((x - a) / (b - a));
}
Exemplo n.º 4
0
double pcauchy(double x, double location, double scale,
               int lower_tail, int log_p)
{
#ifdef IEEE_754
    if (ISNAN(x) || ISNAN(location) || ISNAN(scale))
        return x + location + scale;
#endif
    if (scale <= 0) ML_ERR_return_NAN;

    x = (x - location) / scale;
    if (ISNAN(x)) ML_ERR_return_NAN;
#ifdef IEEE_754
    if(!R_FINITE(x)) {
        if(x < 0) return R_DT_0;
        else return R_DT_1;
    }
#endif
    return R_DT_val(0.5 + atan(x) / M_PI);
}
Exemplo n.º 5
0
/* args have the same meaning as R function pwilcox */
double pwilcox(double q, double m, double n, int lower_tail, int log_p)
{
    int i;
    double c, p;

#ifdef IEEE_754
    if (ISNAN(q) || ISNAN(m) || ISNAN(n))
	return(q + m + n);
#endif
    if (!R_FINITE(m) || !R_FINITE(n))
	ML_ERR_return_NAN;
    m = R_forceint(m);
    n = R_forceint(n);
    if (m <= 0 || n <= 0)
	ML_ERR_return_NAN;

    q = floor(q + 1e-7);

    if (q < 0.0)
	return(R_DT_0);
    if (q >= m * n)
	return(R_DT_1);

    int mm = (int) m, nn = (int) n;
    w_init_maybe(mm, nn);
    c = choose(m + n, n);
    p = 0;
    /* Use summation of probs over the shorter range */
    if (q <= (m * n / 2)) {
	for (i = 0; i <= q; i++)
	    p += cwilcox(i, mm, nn) / c;
    }
    else {
	q = m * n - q;
	for (i = 0; i < q; i++)
	    p += cwilcox(i, mm, nn) / c;
	lower_tail = !lower_tail; /* p = 1 - p; */
    }

    return(R_DT_val(p));
} /* pwilcox */
Exemplo n.º 6
0
double ptukey(double q, double rr, double cc, double df,
	      int lower_tail, int log_p)
{
/*  function ptukey() [was qprob() ]:

	q = value of studentized range
	rr = no. of rows or groups
	cc = no. of columns or treatments
	df = degrees of freedom of error term
	ir[0] = error flag = 1 if wprob probability > 1
	ir[1] = error flag = 1 if qprob probability > 1

	qprob = returned probability integral over [0, q]

	The program will not terminate if ir[0] or ir[1] are raised.

	All references in wprob to Abramowitz and Stegun
	are from the following reference:

	Abramowitz, Milton and Stegun, Irene A.
	Handbook of Mathematical Functions.
	New York:  Dover publications, Inc. (1970).

	All constants taken from this text are
	given to 25 significant digits.

	nlegq = order of legendre quadrature
	ihalfq = int ((nlegq + 1) / 2)
	eps = max. allowable value of integral
	eps1 & eps2 = values below which there is
		      no contribution to integral.

	d.f. <= dhaf:	integral is divided into ulen1 length intervals.  else
	d.f. <= dquar:	integral is divided into ulen2 length intervals.  else
	d.f. <= deigh:	integral is divided into ulen3 length intervals.  else
	d.f. <= dlarg:	integral is divided into ulen4 length intervals.

	d.f. > dlarg:	the range is used to calculate integral.

	M_LN2 = log(2)

	xlegq = legendre 16-point nodes
	alegq = legendre 16-point coefficients

	The coefficients and nodes for the legendre quadrature used in
	qprob and wprob were calculated using the algorithms found in:

	Stroud, A. H. and Secrest, D.
	Gaussian Quadrature Formulas.
	Englewood Cliffs,
	New Jersey:  Prentice-Hall, Inc, 1966.

	All values matched the tables (provided in same reference)
	to 30 significant digits.

	f(x) = .5 + erf(x / sqrt(2)) / 2      for x > 0

	f(x) = erfc( -x / sqrt(2)) / 2	      for x < 0

	where f(x) is standard normal c. d. f.

	if degrees of freedom large, approximate integral
	with range distribution.
 */
#define nlegq	16
#define ihalfq	8

/*  const double eps = 1.0; not used if = 1 */
    const static double eps1 = -30.0;
    const static double eps2 = 1.0e-14;
    const static double dhaf  = 100.0;
    const static double dquar = 800.0;
    const static double deigh = 5000.0;
    const static double dlarg = 25000.0;
    const static double ulen1 = 1.0;
    const static double ulen2 = 0.5;
    const static double ulen3 = 0.25;
    const static double ulen4 = 0.125;
    const static double xlegq[ihalfq] = {
	0.989400934991649932596154173450,
	0.944575023073232576077988415535,
	0.865631202387831743880467897712,
	0.755404408355003033895101194847,
	0.617876244402643748446671764049,
	0.458016777657227386342419442984,
	0.281603550779258913230460501460,
	0.950125098376374401853193354250e-1
    };
    const static double alegq[ihalfq] = {
	0.271524594117540948517805724560e-1,
	0.622535239386478928628438369944e-1,
	0.951585116824927848099251076022e-1,
	0.124628971255533872052476282192,
	0.149595988816576732081501730547,
	0.169156519395002538189312079030,
	0.182603415044923588866763667969,
	0.189450610455068496285396723208
    };
    double ans, f2, f21, f2lf, ff4, otsum, qsqz, rotsum, t1, twa1, ulen, wprb;
    int i, j, jj;

#ifdef IEEE_754
    if (ISNAN(q) || ISNAN(rr) || ISNAN(cc) || ISNAN(df))
	ML_ERR_return_NAN;
#endif

    if (q <= 0)
	return R_DT_0;

    /* df must be > 1 */
    /* there must be at least two values */

    if (df < 2 || rr < 1 || cc < 2) ML_ERR_return_NAN;

    if(!R_FINITE(q))
	return R_DT_1;

    if (df > dlarg)
	return R_DT_val(wprob(q, rr, cc));

    /* calculate leading constant */

    f2 = df * 0.5;
    /* lgammafn(u) = log(gamma(u)) */
    f2lf = ((f2 * log(df)) - (df * M_LN2)) - lgammafn(f2);
    f21 = f2 - 1.0;

    /* integral is divided into unit, half-unit, quarter-unit, or */
    /* eighth-unit length intervals depending on the value of the */
    /* degrees of freedom. */

    ff4 = df * 0.25;
    if	    (df <= dhaf)	ulen = ulen1;
    else if (df <= dquar)	ulen = ulen2;
    else if (df <= deigh)	ulen = ulen3;
    else			ulen = ulen4;

    f2lf += log(ulen);

    /* integrate over each subinterval */

    ans = 0.0;

    for (i = 1; i <= 50; i++) {
	otsum = 0.0;

	/* legendre quadrature with order = nlegq */
	/* nodes (stored in xlegq) are symmetric around zero. */

	twa1 = (2 * i - 1) * ulen;

	for (jj = 1; jj <= nlegq; jj++) {
	    if (ihalfq < jj) {
		j = jj - ihalfq - 1;
		t1 = (f2lf + (f21 * log(twa1 + (xlegq[j] * ulen))))
		    - (((xlegq[j] * ulen) + twa1) * ff4);
	    } else {
		j = jj - 1;
		t1 = (f2lf + (f21 * log(twa1 - (xlegq[j] * ulen))))
		    + (((xlegq[j] * ulen) - twa1) * ff4);

	    }

	    /* if exp(t1) < 9e-14, then doesn't contribute to integral */
	    if (t1 >= eps1) {
		if (ihalfq < jj) {
		    qsqz = q * sqrt(((xlegq[j] * ulen) + twa1) * 0.5);
		} else {
		    qsqz = q * sqrt(((-(xlegq[j] * ulen)) + twa1) * 0.5);
		}

		/* call wprob to find integral of range portion */

		wprb = wprob(qsqz, rr, cc);
		rotsum = (wprb * alegq[j]) * exp(t1);
		otsum += rotsum;
	    }
	    /* end legendre integral for interval i */
	    /* L200: */
	}

	/* if integral for interval i < 1e-14, then stop.
	 * However, in order to avoid small area under left tail,
	 * at least  1 / ulen  intervals are calculated.
	 */
	if (i * ulen >= 1.0 && otsum <= eps2)
	    break;

	/* end of interval i */
	/* L330: */

	ans += otsum;
    }

    if(otsum > eps2) { /* not converged */
	ML_ERROR(ME_PRECISION, "ptukey");
    }
    if (ans > 1.)
	ans = 1.;
    return R_DT_val(ans);
}
Exemplo n.º 7
0
double pnt(double t, double df, double delta, int lower_tail, int log_p)
{
    double a, albeta, b, del, errbd, geven, godd,
        lambda, p, q, rxb, s, tnc, tt, x, xeven, xodd;
    int it, negdel;

    /* note - itrmax and errmax may be changed to suit one's needs. */

    const int itrmax = 1000;
    const double errmax = 1.e-12;

    if (df <= 0.) ML_ERR_return_NAN;

    if(!R_FINITE(t))
        return (t < 0) ? R_DT_0 : R_DT_1;
    if (t >= 0.) {
        negdel = false; tt = t;         del = delta;
    }
    else {
        negdel = true;          tt = -t;        del = -delta;
    }

    if (df > 4e5 || del*del > 2*M_LN2*(-(numeric_limits<double>::min_exponent))) {
        /*-- 2nd part: if del > 37.62, then p=0 below
          FIXME: test should depend on `df', `tt' AND `del' ! */
        /* Approx. from  Abramowitz & Stegun 26.7.10 (p.949) */
        s = 1./(4.*df);

        return pnorm(tt*(1. - s), del, sqrt(1. + tt*tt*2.*s),
                     lower_tail != negdel, log_p);
    }

    /* initialize twin series */
    /* Guenther, J. (1978). Statist. Computn. Simuln. vol.6, 199. */

    x = t * t;
    x = x / (x + df);/* in [0,1) */
    if (x > 0.) {/* <==>  t != 0 */
        lambda = del * del;
        p = .5 * exp(-.5 * lambda);
        if(p == 0.) { /* underflow! */
            /*========== really use an other algorithm for this case !!! */
            ML_ERROR(ME_UNDERFLOW);
            report_error("|delta| too large."); /* |delta| too large */
        }
        q = M_SQRT_2dPI * p * del;
        s = .5 - p;
        a = .5;
        b = .5 * df;
        rxb = pow(1. - x, b);
        albeta = M_LN_SQRT_PI + lgammafn(b) - lgammafn(.5 + b);
        xodd = pbeta(x, a, b, /*lower*/true, /*log_p*/false);
        godd = 2. * rxb * exp(a * log(x) - albeta);
        xeven = 1. - rxb;
        geven = b * x * rxb;
        tnc = p * xodd + q * xeven;

        /* repeat until convergence or iteration limit */
        for(it = 1; it <= itrmax; it++) {
            a += 1.;
            xodd  -= godd;
            xeven -= geven;
            godd  *= x * (a + b - 1.) / a;
            geven *= x * (a + b - .5) / (a + .5);
            p *= lambda / (2 * it);
            q *= lambda / (2 * it + 1);
            tnc += p * xodd + q * xeven;
            s -= p;
            if(s <= 0.) { /* happens e.g. for (t,df,delta)=(40,10,38.5), after 799 it.*/
                ML_ERROR(ME_PRECISION);
                goto finis;
            }
            errbd = 2. * s * (xodd - godd);
            if(errbd < errmax) goto finis;/*convergence*/
        }
        /* non-convergence:*/
        ML_ERROR(ME_PRECISION);
    }
    else { /* x = t = 0 */
        tnc = 0.;
    }
 finis:
    tnc += pnorm(- del, 0., 1., /*lower*/true, /*log_p*/false);

    lower_tail = lower_tail != negdel; /* xor */
    return R_DT_val(tnc);
}
Exemplo n.º 8
0
double attribute_hidden
pnchisq_raw(double x, double f, double theta /* = ncp */,
	    double errmax, double reltol, int itrmax,
	    Rboolean lower_tail, Rboolean log_p)
{
    double lam, x2, f2, term, bound, f_x_2n, f_2n;
    double l_lam = -1., l_x = -1.; /* initialized for -Wall */
    int n;
    Rboolean lamSml, tSml, is_r, is_b, is_it;
    LDOUBLE ans, u, v, t, lt, lu =-1;

    if (x <= 0.) {
	if(x == 0. && f == 0.) {
#define _L  (-0.5 * theta) // = -lambda
	    return lower_tail ? R_D_exp(_L) : (log_p ? R_Log1_Exp(_L) : -expm1(_L));
	}
	/* x < 0  or {x==0, f > 0} */
	return R_DT_0;
    }
    if(!R_FINITE(x))	return R_DT_1;

    /* This is principally for use from qnchisq */
#ifndef MATHLIB_STANDALONE
    R_CheckUserInterrupt();
#endif

    if(theta < 80) { /* use 110 for Inf, as ppois(110, 80/2, lower.tail=FALSE) is 2e-20 */
	LDOUBLE ans;
	int i;
	// Have  pgamma(x,s) < x^s / Gamma(s+1) (< and ~= for small x)
	// ==> pchisq(x, f) = pgamma(x, f/2, 2) = pgamma(x/2, f/2)
	//                  <  (x/2)^(f/2) / Gamma(f/2+1) < eps
	// <==>  f/2 * log(x/2) - log(Gamma(f/2+1)) < log(eps) ( ~= -708.3964 )
	// <==>        log(x/2) < 2/f*(log(Gamma(f/2+1)) + log(eps))
	// <==> log(x) < log(2) + 2/f*(log(Gamma(f/2+1)) + log(eps))
	if(lower_tail && f > 0. &&
	   log(x) < M_LN2 + 2/f*(lgamma(f/2. + 1) + _dbl_min_exp)) {
	    // all  pchisq(x, f+2*i, lower_tail, FALSE), i=0,...,110 would underflow to 0.
	    // ==> work in log scale
	    double lambda = 0.5 * theta;
	    double sum, sum2, pr = -lambda;
	    sum = sum2 = ML_NEGINF;
	    /* we need to renormalize here: the result could be very close to 1 */
	    for(i = 0; i < 110;  pr += log(lambda) - log(++i)) {
		sum2 = logspace_add(sum2, pr);
		sum = logspace_add(sum, pr + pchisq(x, f+2*i, lower_tail, TRUE));
		if (sum2 >= -1e-15) /*<=> EXP(sum2) >= 1-1e-15 */ break;
	    }
	    ans = sum - sum2;
#ifdef DEBUG_pnch
	    REprintf("pnchisq(x=%g, f=%g, th.=%g); th. < 80, logspace: i=%d, ans=(sum=%g)-(sum2=%g)\n",
		     x,f,theta, i, (double)sum, (double)sum2);
#endif
	    return (double) (log_p ? ans : EXP(ans));
	}
	else {
	    LDOUBLE lambda = 0.5 * theta;
	    LDOUBLE sum = 0, sum2 = 0, pr = EXP(-lambda); // does this need a feature test?
	    /* we need to renormalize here: the result could be very close to 1 */
	    for(i = 0; i < 110;  pr *= lambda/++i) {
		// pr == exp(-lambda) lambda^i / i!  ==  dpois(i, lambda)
		sum2 += pr;
		// pchisq(*, i, *) is  strictly decreasing to 0 for lower_tail=TRUE
		//                 and strictly increasing to 1 for lower_tail=FALSE
		sum += pr * pchisq(x, f+2*i, lower_tail, FALSE);
		if (sum2 >= 1-1e-15) break;
	    }
	    ans = sum/sum2;
#ifdef DEBUG_pnch
	    REprintf("pnchisq(x=%g, f=%g, theta=%g); theta < 80: i=%d, sum=%g, sum2=%g\n",
		     x,f,theta, i, (double)sum, (double)sum2);
#endif
	    return (double) (log_p ? LOG(ans) : ans);
	}
    } // if(theta < 80)

    // else: theta == ncp >= 80 --------------------------------------------
#ifdef DEBUG_pnch
    REprintf("pnchisq(x=%g, f=%g, theta=%g >= 80): ",x,f,theta);
#endif
    // Series expansion ------- FIXME: log_p=TRUE, lower_tail=FALSE only applied at end

    lam = .5 * theta;
    lamSml = (-lam < _dbl_min_exp);
    if(lamSml) {
	/* MATHLIB_ERROR(
	   "non centrality parameter (= %g) too large for current algorithm",
	   theta) */
        u = 0;
        lu = -lam;/* == ln(u) */
        l_lam = log(lam);
    } else {
	u = exp(-lam);
    }

    /* evaluate the first term */
    v = u;
    x2 = .5 * x;
    f2 = .5 * f;
    f_x_2n = f - x;

#ifdef DEBUG_pnch
    REprintf("-- v=exp(-th/2)=%g, x/2= %g, f/2= %g\n",v,x2,f2);
#endif

    if(f2 * DBL_EPSILON > 0.125 && /* very large f and x ~= f: probably needs */
       FABS(t = x2 - f2) <         /* another algorithm anyway */
       sqrt(DBL_EPSILON) * f2) {
	/* evade cancellation error */
	/* t = exp((1 - t)*(2 - t/(f2 + 1))) / sqrt(2*M_PI*(f2 + 1));*/
        lt = (1 - t)*(2 - t/(f2 + 1)) - M_LN_SQRT_2PI - 0.5 * log(f2 + 1);
#ifdef DEBUG_pnch
	REprintf(" (case I) ==> ");
#endif
    }
    else {
	/* Usual case 2: careful not to overflow .. : */
	lt = f2*log(x2) -x2 - lgammafn(f2 + 1);
    }
#ifdef DEBUG_pnch
    REprintf(" lt= %g", lt);
#endif

    tSml = (lt < _dbl_min_exp);
    if(tSml) {
#ifdef DEBUG_pnch
	REprintf(" is very small\n");
#endif
	if (x > f + theta +  5* sqrt( 2*(f + 2*theta))) {
	    /* x > E[X] + 5* sigma(X) */
	    return R_DT_1; /* FIXME: could be more accurate than 0. */
	} /* else */
	l_x = log(x);
	ans = term = 0.; t = 0;
    }
    else {
	t = EXP(lt);
#ifdef DEBUG_pnch
 	REprintf(", t=exp(lt)= %g\n", t);
#endif
	ans = term = (double) (v * t);
    }

    for (n = 1, f_2n = f + 2., f_x_2n += 2.;  ; n++, f_2n += 2, f_x_2n += 2) {
#ifdef DEBUG_pnch_n
	REprintf("\n _OL_: n=%d",n);
#endif
#ifndef MATHLIB_STANDALONE
	if(n % 1000) R_CheckUserInterrupt();
#endif
	/* f_2n    === f + 2*n
	 * f_x_2n  === f - x + 2*n   > 0  <==> (f+2n)  >   x */
	if (f_x_2n > 0) {
	    /* find the error bound and check for convergence */

	    bound = (double) (t * x / f_x_2n);
#ifdef DEBUG_pnch_n
	    REprintf("\n L10: n=%d; term= %g; bound= %g",n,term,bound);
#endif
	    is_r = is_it = FALSE;
	    /* convergence only if BOTH absolute and relative error < 'bnd' */
	    if (((is_b = (bound <= errmax)) &&
                 (is_r = (term <= reltol * ans))) || (is_it = (n > itrmax)))
            {
#ifdef DEBUG_pnch
                REprintf("BREAK n=%d %s; bound= %g %s, rel.err= %g %s\n",
			 n, (is_it ? "> itrmax" : ""),
			 bound, (is_b ? "<= errmax" : ""),
			 term/ans, (is_r ? "<= reltol" : ""));
#endif
		break; /* out completely */
            }

	}

	/* evaluate the next term of the */
	/* expansion and then the partial sum */

        if(lamSml) {
            lu += l_lam - log(n); /* u = u* lam / n */
            if(lu >= _dbl_min_exp) {
		/* no underflow anymore ==> change regime */
#ifdef DEBUG_pnch_n
                REprintf(" n=%d; nomore underflow in u = exp(lu) ==> change\n",
			 n);
#endif
                v = u = EXP(lu); /* the first non-0 'u' */
                lamSml = FALSE;
            }
        } else {
	    u *= lam / n;
	    v += u;
	}
	if(tSml) {
            lt += l_x - log(f_2n);/* t <- t * (x / f2n) */
            if(lt >= _dbl_min_exp) {
		/* no underflow anymore ==> change regime */
#ifdef DEBUG_pnch
                REprintf("  n=%d; nomore underflow in t = exp(lt) ==> change\n", n);
#endif
                t = EXP(lt); /* the first non-0 't' */
                tSml = FALSE;
            }
        } else {
	    t *= x / f_2n;
	}
        if(!lamSml && !tSml) {
	    term = (double) (v * t);
	    ans += term;
	}

    } /* for(n ...) */

    if (is_it) {
	MATHLIB_WARNING2(_("pnchisq(x=%g, ..): not converged in %d iter."),
			 x, itrmax);
    }
#ifdef DEBUG_pnch
    REprintf("\n == L_End: n=%d; term= %g; bound=%g\n",n,term,bound);
#endif
    double dans = (double) ans;
    return R_DT_val(dans);
}
Exemplo n.º 9
0
/* args have the same meaning as R function pwilcox */
double PWilcox::pwilcox(double q, double m, double n, bool lower_tail) {
    try {
        int i;
        double c, p;
        bool log_p = false;
        double*** w;


        if (isnan(m) || isnan(n))
        {
            return 0;
        }
        m = floor(m + 0.5);
        n = floor(n + 0.5);
        if (m <= 0 || n <= 0) {
            return 0;
        }

        q = floor(q + 1e-7);

        if (q < 0.0)
            return(R_DT_0);
        if (q >= m * n)
            return(R_DT_1);

        int mm = (int) m, nn = (int) n;

        if (mout->control_pressed) {
            return 0;
        }
        //w_init_maybe(mm, nn);
        /********************************************/
        int thisi;
        if (mm > nn) {
            thisi = nn;
            nn = mm;
            mm = thisi;
        }

        mm = max(mm, 50);
        nn = max(nn, 50);
        w = (double ***) calloc((size_t) mm + 1, sizeof(double **));

        for (thisi = 0; thisi <= mm; thisi++) {
            w[thisi] = (double **) calloc((size_t) nn + 1, sizeof(double *));
        }
        allocated_m = m;
        allocated_n = n;
        /********************************************/

        c = choose(m + n, n);
        p = 0;
        /* Use summation of probs over the shorter range */
        if (q <= (m * n / 2)) {
            for (i = 0; i <= q; i++)
                p += cwilcox(i, m, n, w) / c;
        }
        else {
            q = m * n - q;
            for (i = 0; i < q; i++) {
                p += cwilcox(i, m, n, w) / c;
            }
            lower_tail = !lower_tail; /* p = 1 - p; */
        }

        //free w
        /********************************************/
        for (int i = allocated_m; i >= 0; i--) {
            for (int j = allocated_n; j >= 0; j--) {
                if (w[i][j] != 0)
                    free((void *) w[i][j]);
            }
            free((void *) w[i]);
        }
        free((void *) w);
        w = 0;
        allocated_m = allocated_n = 0;
        /********************************************/

        return(R_DT_val(p));
    }
    catch(exception& e) {
        mout->errorOut(e, "PWilcox", "pwilcox");
        exit(1);
    }
} /* pwilcox */