double
lgamma_r (double x, int *signp)
{
*signp = +1;
if (gnm_isnan (x))
return gnm_nan;
if (x > 0) {
gnm_float f = 1;
while (x < 10) {
f *= x;
x++;
}
return (M_LN_SQRT_2PI + (x - 0.5) * gnm_log(x) -
x + lgammacor(x)) - gnm_log (f);
} else {
gnm_float axm2 = gnm_fmod (-x, 2.0);
gnm_float y = gnm_sinpi (axm2) / M_PIgnum;
*signp = axm2 > 1.0 ? +1 : -1;
return y == 0
? gnm_nan
: - gnm_log (gnm_abs (y)) - lgamma1p (-x);
}
}
void
complex_gamma (complex_t *dst, complex_t const *src)
{
if (complex_real_p (src)) {
complex_init (dst, gnm_gamma (src->re), 0);
} else if (src->re < 0) {
/* Gamma(z) = pi / (sin(pi*z) * Gamma(-z+1)) */
complex_t a, b, mz;
complex_init (&mz, -src->re, -src->im);
complex_fact (&a, &mz);
complex_init (&b,
M_PIgnum * gnm_fmod (src->re, 2),
M_PIgnum * src->im);
/* Hmm... sin overflows when b.im is large. */
complex_sin (&b, &b);
complex_mul (&a, &a, &b);
complex_init (&b, M_PIgnum, 0);
complex_div (dst, &b, &a);
} else {
complex_t zmh, zmhd2, zmhpg, f, f2, p, q, pq;
int i;
i = G_N_ELEMENTS(lanczos_num) - 1;
complex_init (&p, lanczos_num[i], 0);
complex_init (&q, lanczos_denom[i], 0);
while (--i >= 0) {
complex_mul (&p, &p, src);
p.re += lanczos_num[i];
complex_mul (&q, &q, src);
q.re += lanczos_denom[i];
}
complex_div (&pq, &p, &q);
complex_init (&zmh, src->re - 0.5, src->im);
complex_init (&zmhpg, zmh.re + lanczos_g, zmh.im);
complex_init (&zmhd2, zmh.re * 0.5, zmh.im * 0.5);
complex_pow (&f, &zmhpg, &zmhd2);
zmh.re = -zmh.re; zmh.im = -zmh.im;
complex_exp (&f2, &zmh);
complex_mul (&f2, &f, &f2);
complex_mul (&f2, &f2, &f);
complex_mul (dst, &f2, &pq);
}
}
gnm_float
pochhammer (gnm_float x, gnm_float n)
{
gnm_float rn, rx, lr;
GnmQuad m1, m2;
int e1, e2;
if (gnm_isnan (x) || gnm_isnan (n))
return gnm_nan;
if (n == 0)
return 1;
rx = gnm_floor (x);
rn = gnm_floor (n);
/*
* Use naive multiplication when n is a small integer.
* We don't want to use this if x is also an integer
* (but we might do so below if x is insanely large).
*/
if (n == rn && x != rx && n >= 0 && n < 40)
return pochhammer_naive (x, (int)n);
if (!qfactf (x + n - 1, &m1, &e1) &&
!qfactf (x - 1, &m2, &e2)) {
void *state = gnm_quad_start ();
int de = e1 - e2;
GnmQuad qr;
gnm_float r;
gnm_quad_div (&qr, &m1, &m2);
r = gnm_quad_value (&qr);
gnm_quad_end (state);
return gnm_ldexp (r, de);
}
if (x == rx && x <= 0) {
if (n != rn)
return 0;
if (x == 0)
return (n > 0)
? 0
: ((gnm_fmod (-n, 2) == 0 ? +1 : -1) /
gnm_fact (-n));
if (n > -x)
return gnm_nan;
}
/*
* We have left the common cases. One of x+n and x is
* insanely big, possibly both.
*/
if (gnm_abs (x) < 1)
return gnm_pinf;
if (n < 0)
return 1 / pochhammer (x + n, -n);
if (n == rn && n >= 0 && n < 100)
return pochhammer_naive (x, (int)n);
if (gnm_abs (n) < 1) {
/* x is big. */
void *state = gnm_quad_start ();
GnmQuad qr;
gnm_float r;
pochhammer_small_n (x, n, &qr);
r = gnm_quad_value (&qr);
gnm_quad_end (state);
return r;
}
/* Panic mode. */
g_printerr ("x=%.20g n=%.20g\n", x, n);
lr = ((x - 0.5) * gnm_log1p (n / x) +
n * gnm_log (x + n) -
n +
(lgammacor (x + n) - lgammacor (x)));
return gnm_exp (lr);
}
/**
* FIXME: In the long term this needs optimising.
**/
static GnmValue *
val_to_base (GnmFuncEvalInfo *ei,
GnmValue const *value,
GnmValue const *aplaces,
int src_base, int dest_base,
gnm_float min_value, gnm_float max_value,
Val2BaseFlags flags)
{
int digit, min, max, places;
gnm_float v;
GString *buffer;
GnmValue *vstring = NULL;
g_return_val_if_fail (src_base > 1 && src_base <= 36,
value_new_error_VALUE (ei->pos));
g_return_val_if_fail (dest_base > 1 && dest_base <= 36,
value_new_error_VALUE (ei->pos));
/* func.c ought to take care of this. */
if (VALUE_IS_BOOLEAN (value))
return value_new_error_VALUE (ei->pos);
if (aplaces && VALUE_IS_BOOLEAN (aplaces))
return value_new_error_VALUE (ei->pos);
switch (value->type) {
default:
return value_new_error_NUM (ei->pos);
case VALUE_STRING:
if (flags & V2B_STRINGS_GENERAL) {
vstring = format_match_number
(value_peek_string (value), NULL,
workbook_date_conv (ei->pos->sheet->workbook));
if (!vstring || !VALUE_IS_FLOAT (vstring)) {
value_release (vstring);
return value_new_error_VALUE (ei->pos);
}
} else {
char const *str = value_peek_string (value);
size_t len;
gboolean hsuffix = FALSE;
char *err;
if ((flags & V2B_STRINGS_BLANK_ZERO) && *str == 0)
str = "0";
/* This prevents leading spaces, signs, etc, and "". */
if (!g_ascii_isalnum (*str))
return value_new_error_NUM (ei->pos);
len = strlen (str);
/* We check length in bytes. Since we are going to
require nothing but digits, that is fine. */
if ((flags & V2B_STRINGS_MAXLEN) && len > 10)
return value_new_error_NUM (ei->pos);
if (flags & V2B_STRINGS_0XH) {
if (str[0] == '0' && (str[1] == 'x' || str[1] == 'X'))
str += 2;
else if (str[len - 1] == 'h' || str[len - 1] == 'H')
hsuffix = TRUE;
}
v = g_ascii_strtoll (str, &err, src_base);
if (err == str || err[hsuffix] != 0)
return value_new_error_NUM (ei->pos);
if (v < min_value || v > max_value)
return value_new_error_NUM (ei->pos);
break;
}
/* Fall through. */
case VALUE_FLOAT: {
gnm_float val = gnm_fake_trunc (value_get_as_float (vstring ? vstring : value));
char buf[GNM_MANT_DIG + 10];
char *err;
value_release (vstring);
if (val < min_value || val > max_value)
return value_new_error_NUM (ei->pos);
g_ascii_formatd (buf, sizeof (buf) - 1,
"%.0" GNM_FORMAT_f,
val);
v = g_ascii_strtoll (buf, &err, src_base);
if (*err != 0)
return value_new_error_NUM (ei->pos);
break;
}
}
if (src_base != 10) {
gnm_float b10 = gnm_pow (src_base, 10);
if (v >= b10 / 2) /* N's complement */
v = v - b10;
}
if (flags & V2B_NUMBER)
return value_new_float (v);
if (v < 0) {
min = 1;
max = 10;
v += gnm_pow (dest_base, max);
} else {
if (v == 0)
min = max = 1;
else
min = max = (int)(gnm_log (v + 0.5) /
gnm_log (dest_base)) + 1;
}
if (aplaces) {
gnm_float fplaces = value_get_as_float (aplaces);
if (fplaces < min || fplaces > 10)
return value_new_error_NUM (ei->pos);
places = (int)fplaces;
if (v >= 0 && places > max)
max = places;
} else
places = 1;
buffer = g_string_sized_new (max);
g_string_set_size (buffer, max);
for (digit = max - 1; digit >= 0; digit--) {
int thisdigit = gnm_fmod (v + 0.5, dest_base);
v = gnm_floor ((v + 0.5) / dest_base);
buffer->str[digit] =
thisdigit["0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"];
}
return value_new_string_nocopy (g_string_free (buffer, FALSE));
}