void
gsl_complex_cosh (complex_t const *a, complex_t *res)
{ /* z = cosh(a) */
gnm_float R = GSL_REAL (a), I = GSL_IMAG (a);
complex_init (res, cosh (R) * gnm_cos (I), gnm_sinh (R) * gnm_sin (I));
}
void
gsl_complex_tanh (complex_t const *a, complex_t *res)
{ /* z = tanh(a) */
gnm_float R = GSL_REAL (a), I = GSL_IMAG (a);
if (gnm_abs (R) < 1.0) {
gnm_float D =
gnm_pow (gnm_cos (I), 2.0) +
gnm_pow (gnm_sinh (R), 2.0);
complex_init (res, gnm_sinh (R) * cosh (R) / D,
0.5 * gnm_sin (2 * I) / D);
} else {
gnm_float D =
gnm_pow (gnm_cos (I), 2.0) +
gnm_pow (gnm_sinh (R), 2.0);
gnm_float F = 1 + gnm_pow (gnm_cos (I) / gnm_sinh (R), 2.0);
complex_init (res, 1.0 / (gnm_tanh (R) * F),
0.5 * gnm_sin (2 * I) / D);
}
}
static GnmValue *
gnumeric_periodogram (GnmFuncEvalInfo *ei, GnmValue const * const *argv)
{
gnm_float *ord, *absc;
int filter, interp;
int n0, n1, nb;
GnmValue *error = NULL;
GnmValue *res;
CollectFlags flags;
GnmEvalPos const * const ep = ei->pos;
GnmValue const * const Pt = argv[0];
int i;
GSList *missing0 = NULL, *missing1 = NULL;
gnm_complex *in, *out = NULL;
int const cols = value_area_get_width (Pt, ep);
int const rows = value_area_get_height (Pt, ep);
if (cols == 1)
nb=rows;
else {
if (rows == 1)
nb=cols;
else
nb=0;
}
if (nb == 0) {
res = value_new_error_std (ei->pos, GNM_ERROR_VALUE);
return res;
}
flags=COLLECT_IGNORE_BLANKS | COLLECT_IGNORE_STRINGS | COLLECT_IGNORE_BOOLS;
ord = collect_floats_value_with_info (argv[0], ei->pos, flags,
&n0, &missing0, &error);
if (error) {
g_slist_free (missing0);
return error;
}
if (n0 == 0) {
res = value_new_error_std (ei->pos, GNM_ERROR_VALUE);
return res;
}
if (argv[1]) {
filter = (int) gnm_floor (value_get_as_float (argv[1]));
if (filter < 0 || filter > FILTER_WELCH) {
g_slist_free (missing0);
g_free (ord);
res = value_new_error_std (ei->pos, GNM_ERROR_VALUE);
return res;
}
} else
filter = FILTER_NONE;
if (argv[2]) {
gnm_float *interpolated, *new_ord, start, incr;
int n2;
INTERPPROC(interpproc) = NULL;
absc = collect_floats_value_with_info (argv[2], ei->pos, flags,
&n1, &missing1, &error);
if (n1 == 1) {
g_slist_free (missing1);
g_free (absc);
goto no_absc;
}
if (error) {
g_slist_free (missing0);
g_slist_free (missing1);
g_free (absc);
return error;
}
if (n1 == 0) {
g_slist_free (missing0);
g_slist_free (missing1);
g_free (absc);
g_free (ord);
return value_new_error_std (ei->pos, GNM_ERROR_VALUE);
}
if (argv[3]) {
interp = (int) gnm_floor (value_get_as_float (argv[3]));
if (interp < 0 || interp > INTERPOLATION_SPLINE_AVG) {
g_slist_free (missing0);
g_slist_free (missing1);
g_free (absc);
g_free (ord);
return error;
}
} else
interp = INTERPOLATION_LINEAR;
if (missing0 || missing1) {
GSList *missing = gnm_slist_sort_merge (missing0, missing1);
gnm_strip_missing (ord, &n0, missing);
gnm_strip_missing (absc, &n1, missing);
g_slist_free (missing);
if (n0 != n1)
g_warning ("This should not happen. n0=%d n1=%d\n",
n0, n1);
}
n0 = n1 = MIN (n0, n1);
/* here we test if there is abscissas are always increasing, if not,
an error is returned */
if (n0 < 2 || !gnm_range_increasing (absc, n0) || n0 == 0) {
g_free (absc);
g_free (ord);
return value_new_error_std (ei->pos, GNM_ERROR_VALUE);
}
if (argv[4]) {
n1 = (int) gnm_floor (value_get_as_float (argv[4]));
if (n1 < n0) {
g_free (absc);
g_free (ord);
return value_new_error_std (ei->pos, GNM_ERROR_VALUE);
}
nb = 1;
while (nb < n1)
nb *= 2;
} else {
n1 = 1;
while (n1 < n0)
n1 *= 2;
nb = n1;
}
incr = (absc[n0 - 1] - absc[0]) / n1;
switch (interp) {
case INTERPOLATION_LINEAR:
interpproc = linear_interpolation;
start = absc[0];
n2 = n1;
break;
case INTERPOLATION_LINEAR_AVG:
interpproc = linear_averaging;
start = absc[0] - incr / 2.;
n2 = n1 + 1;
break;
case INTERPOLATION_STAIRCASE:
interpproc = staircase_interpolation;
start = absc[0];
n2 = n1;
break;
case INTERPOLATION_STAIRCASE_AVG:
interpproc = staircase_averaging;
start = absc[0] - incr / 2.;
n2 = n1 + 1;
break;
case INTERPOLATION_SPLINE:
interpproc = spline_interpolation;
start = absc[0];
n2 = n1;
break;
case INTERPOLATION_SPLINE_AVG:
interpproc = spline_averaging;
start = absc[0] - incr / 2.;
n2 = n1 + 1;
break;
default:
g_free (absc);
g_free (ord);
return value_new_error_std (ei->pos, GNM_ERROR_NA);
}
interpolated = g_new (gnm_float, n1);
for (i = 0; i < n2; i++)
interpolated[i] = start + i * incr;
new_ord = interpproc (absc, ord, n0, interpolated, n1);
g_free (ord);
ord = new_ord;
if (ord == NULL) {
g_free (absc);
g_free (interpolated);
return value_new_error_std (ei->pos, GNM_ERROR_NA);
}
n0 = n1;
} else {
no_absc:
/* we have no interpolation to apply, so just take the values */
if (missing0) {
gnm_strip_missing (ord, &n0, missing0);
g_slist_free (missing0);
}
nb = 1;
while (nb < n0)
nb *= 2;
}
/* Now apply the filter if any */
if (filter != FILTER_NONE) {
gnm_float factor;
switch (filter) {
case FILTER_BARTLETT:
factor = n0 / 2.;
for (i = 0; i < n0; i++)
ord[i] *= 1. - gnm_abs ((i / factor - 1));
break;
case FILTER_HANN:
factor = 2. * M_PIgnum / n0;
for (i = 0; i < n0; i++)
ord[i] *= 0.5 * (1 - gnm_cos (factor * i));
break;
case FILTER_WELCH:
factor = n0 / 2.;
for (i = 0; i < n0; i++)
ord[i] *= 1. - (i / factor - 1.) * (i / factor - 1.);
break;
}
}
/* Transform and return the result */
in = g_new0 (gnm_complex, nb);
for (i = 0; i < n0; i++){
in[i].re = ord[i];
}
g_free (ord);
gnm_fourier_fft (in, nb, 1, &out, FALSE);
g_free (in);
nb /= 2;
if (out && nb > 0) {
res = value_new_array_non_init (1 , nb);
res->v_array.vals[0] = g_new (GnmValue *, nb);
for (i = 0; i < nb; i++)
res->v_array.vals[0][i] =
value_new_float (gnm_sqrt (
out[i].re * out[i].re +
out[i].im * out[i].im));
g_free (out);
} else
