double lchoose(double n, double k)
{
double k0 = k;
k = floor(k + 0.5);
#ifdef IEEE_754
/* NaNs propagated correctly */
if(ISNAN(n) || ISNAN(k)) return n + k;
#endif
if (fabs(k - k0) > 1e-7)
MATHLIB_WARNING2(_("'k' (%.2f) must be integer, rounded to %.0f"), k0, k);
if (k < 2) {
if (k < 0) return ML_NEGINF;
if (k == 0) return 0.;
/* else: k == 1 */
return log(fabs(n));
}
/* else: k >= 2 */
if (n < 0) {
return lchoose(-n+ k-1, k);
}
else if (R_IS_INT(n)) {
if(n < k) return ML_NEGINF;
/* k <= n :*/
if(n - k < 2) return lchoose(n, n-k); /* <- Symmetry */
/* else: n >= k+2 */
return lfastchoose(n, k);
}
/* else non-integer n >= 0 : */
if (n < k-1) {
int s;
return lfastchoose2(n, k, &s);
}
return lfastchoose(n, k);
}
double lchoose(double n, double k)
{
k = floor(k + 0.5);
#ifdef IEEE_754
/* NaNs propagated correctly */
if(ISNAN(n) || ISNAN(k)) return n + k;
#endif
if (k < 2) {
if (k < 0) return ML_NEGINF;
if (k == 0) return 0.;
/* else: k == 1 */
return log(n);
}
/* else: k >= 2 */
if (n < 0) {
if (ODD(k)) return ML_NAN;/* log( <negative> ) */
return lchoose(-n+ k-1, k);
}
else if (R_IS_INT(n)) {
if(n < k) return ML_NEGINF;
if(n - k < 2) return lchoose(n, n-k); /* <- Symmetry */
return lfastchoose(n, k);
}
/* else non-integer n >= 0 : */
if (n < k-1) {
int s;
if (fmod(floor(n-k+1), 2.) == 0) /* choose() < 0 */
return ML_NAN;
return lfastchoose2(n, k, &s);
}
return lfastchoose(n, k);
}
/* 30 is somewhat arbitrary: it is on the *safe* side:
* both speed and precision are clearly improved for k < 30.
*/
double choose(double n, double k)
{
double r, k0 = k;
k = R_forceint(k);
#ifdef IEEE_754
/* NaNs propagated correctly */
if(ISNAN(n) || ISNAN(k)) return n + k;
#endif
#ifndef MATHLIB_STANDALONE
R_CheckStack();
#endif
if (fabs(k - k0) > 1e-7)
MATHLIB_WARNING2(_("'k' (%.2f) must be integer, rounded to %.0f"), k0, k);
if (k < k_small_max) {
int j;
if(n-k < k && n >= 0 && R_IS_INT(n)) k = n-k; /* <- Symmetry */
if (k < 0) return 0.;
if (k == 0) return 1.;
/* else: k >= 1 */
r = n;
for(j = 2; j <= k; j++)
r *= (n-j+1)/j;
return R_IS_INT(n) ? R_forceint(r) : r;
/* might have got rounding errors */
}
/* else: k >= k_small_max */
if (n < 0) {
r = choose(-n+ k-1, k);
if (ODD(k)) r = -r;
return r;
}
else if (R_IS_INT(n)) {
n = R_forceint(n);
if(n < k) return 0.;
if(n - k < k_small_max) return choose(n, n-k); /* <- Symmetry */
return R_forceint(exp(lfastchoose(n, k)));
}
/* else non-integer n >= 0 : */
if (n < k-1) {
int s_choose;
r = lfastchoose2(n, k, /* -> */ &s_choose);
return s_choose * exp(r);
}
return exp(lfastchoose(n, k));
}
/* 30 is somewhat arbitrary: it is on the *safe* side:
* both speed and precision are clearly improved for k < 30.
*/
double choose(double n, double k)
{
double r;
k = floor(k + 0.5);
#ifdef IEEE_754
/* NaNs propagated correctly */
if(ISNAN(n) || ISNAN(k)) return n + k;
#endif
if (k < k_small_max) {
int j;
if(R_IS_INT(n) && n-k < k) k = n-k; /* <- Symmetry */
if (k < 0) return 0.;
if (k == 0) return 1.;
/* else: k >= 1 */
r = n;
for(j=2; j <= k; j++)
r *= (n-j+1)/j;
return r;
}
/* else: k >= k_small_max */
if (n < 0) {
r = choose(-n+ k-1, k);
if (ODD(k)) r = -r;
return r;
}
else if (R_IS_INT(n)) {
if(n < k) return 0.;
if(n - k < k_small_max) return choose(n, n-k); /* <- Symmetry */
return floor(exp(lfastchoose(n, k)) + 0.5);
}
/* else non-integer n >= 0 : */
if (n < k-1) {
int s_choose;
r = lfastchoose2(n, k, /* -> */ &s_choose);
return s_choose * exp(r);
}
return exp(lfastchoose(n, k));
}
