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)); }