void *
cx_deriv(void *data, short int type, int length, int *newlength, short int *newtype, struct plot *pl, struct plot *newpl, int grouping)
{
double *scratch;
double *spare;
double x;
int i, j, k;
int degree;
int n, base;
if (grouping == 0)
grouping = length;
/* First do some sanity checks. */
if (!pl || !pl->pl_scale || !newpl || !newpl->pl_scale) {
fprintf(cp_err, "Internal error: cx_deriv: bad scale\n");
return (NULL);
}
if (!cp_getvar("dpolydegree", VT_NUM, (void *) °ree))
degree = 2; /* default quadratic */
n = degree + 1;
spare = alloc_d(n);
scratch = alloc_d(n * (n + 1));
*newlength = length;
*newtype = type;
if (type == VF_COMPLEX) {
complex *c_outdata, *c_indata;
double *r_coefs, *i_coefs;
double *scale;
r_coefs = alloc_d(n);
i_coefs = alloc_d(n);
c_indata = (complex *) data;
c_outdata = alloc_c(length);
scale = alloc_d(length); /* XXX */
if (pl->pl_scale->v_type == VF_COMPLEX)
/* Not ideal */
for (i = 0; i < length; i++)
scale[i] = realpart(&pl->pl_scale->v_compdata[i]);
else
for (i = 0; i < length; i++)
scale[i] = pl->pl_scale->v_realdata[i];
for (base = 0; base < length; base += grouping) {
k = 0;
for (i = degree; i < grouping; i += 1) {
/* real */
for (j = 0; j < n; j++)
spare[j] = c_indata[j + i + base].cx_real;
if (!ft_polyfit(scale + i + base - degree,
spare, r_coefs, degree, scratch))
{
fprintf(stderr, "ft_polyfit @ %d failed\n", i);
}
ft_polyderiv(r_coefs, degree);
/* for loop gets the beginning part */
for (j = k; j <= i - degree / 2; j++) {
x = scale[j + base];
c_outdata[j + base].cx_real =
ft_peval(x, r_coefs, degree - 1);
}
/* imag */
for (j = 0; j < n; j++)
spare[j] = c_indata[j + i + base].cx_imag;
if (!ft_polyfit(scale + i - degree + base,
spare, i_coefs, degree, scratch))
{
fprintf(stderr, "ft_polyfit @ %d failed\n", i);
}
ft_polyderiv(i_coefs, degree);
/* for loop gets the beginning part */
for (j = k; j <= i - degree / 2; j++) {
x = scale[j + base];
c_outdata[j + base].cx_imag =
ft_peval(x, i_coefs, degree - 1);
}
k = j;
}
/* get the tail */
for (j = k; j < length; j++) {
x = scale[j + base];
/* real */
c_outdata[j + base].cx_real = ft_peval(x, r_coefs, degree - 1);
/* imag */
c_outdata[j + base].cx_imag = ft_peval(x, i_coefs, degree - 1);
}
}
tfree(r_coefs);
tfree(i_coefs);
tfree(scale);
return (void *) c_outdata;
} else {
/* all-real case */
double *coefs;
double *outdata, *indata;
double *scale;
coefs = alloc_d(n);
indata = (double *) data;
outdata = alloc_d(length);
scale = alloc_d(length); /* XXX */
for (i = 0; i < length; i++)
scale[i] = pl->pl_scale->v_realdata[i];
for (base = 0; base < length; base += grouping) {
k = 0;
for (i = degree; i < grouping; i += 1) {
if (!ft_polyfit(scale + i - degree + base,
indata + i - degree + base, coefs, degree, scratch))
{
fprintf(stderr, "ft_polyfit @ %d failed\n", i + base);
}
ft_polyderiv(coefs, degree);
/* for loop gets the beginning part */
for (j = k; j <= i - degree / 2; j++) {
x = pl->pl_scale->v_realdata[j + base];
outdata[j + base] = ft_peval(x, coefs, degree - 1);
}
k = j;
}
for (j = k; j < length; j++) {
x = pl->pl_scale->v_realdata[j + base];
outdata[j + base] = ft_peval(x, coefs, degree - 1);
}
}
tfree(coefs);
tfree(scale); /* XXX */
return (void *) outdata;
}
}
/* Interpolate data from oscale to nscale. data is assumed to be olen long,
* ndata will be nlen long. Returns FALSE if the scales are too strange
* to deal with. Note that we are guaranteed that either both scales are
* strictly increasing or both are strictly decreasing.
*/
bool
ft_interpolate(double *data, double *ndata, double *oscale, int olen,
double *nscale, int nlen, int degree)
{
double *result, *scratch, *xdata, *ydata;
int sign, lastone, i, l;
if ((olen < 2) || (nlen < 2)) {
fprintf(cp_err, "Error: lengths too small to interpolate.\n");
return (FALSE);
}
if ((degree < 1) || (degree > olen)) {
fprintf(cp_err, "Error: degree is %d, can't interpolate.\n",
degree);
return (FALSE);
}
if (oscale[1] < oscale[0])
sign = -1;
else
sign = 1;
scratch = (double *) tmalloc((degree + 1) * (degree + 2) *
sizeof (double));
result = (double *) tmalloc((degree + 1) * sizeof (double));
xdata = (double *) tmalloc((degree + 1) * sizeof (double));
ydata = (double *) tmalloc((degree + 1) * sizeof (double));
/* Deal with the first degree pieces. */
bcopy((char *) data, (char *) ydata, (degree + 1) * sizeof (double));
bcopy((char *) oscale, (char *) xdata, (degree + 1) * sizeof (double));
while (!ft_polyfit(xdata, ydata, result, degree, scratch)) {
/* If it doesn't work this time, bump the interpolation
* degree down by one.
*/
if (--degree == 0) {
fprintf(cp_err, "ft_interpolate: Internal Error.\n");
return (FALSE);
}
}
/* Add this part of the curve. What we do is evaluate the polynomial
* at those points between the last one and the one that is greatest,
* without being greater than the leftmost old scale point, or least
* if the scale is decreasing at the end of the interval we are looking
* at.
*/
lastone = -1;
for (i = 0; i < degree; i++) {
lastone = putinterval(result, degree, ndata, lastone,
nscale, nlen, xdata[i], sign);
}
/* Now plot the rest, piece by piece. l is the
* last element under consideration.
*/
for (l = degree + 1; l < olen; l++) {
/* Shift the old stuff by one and get another value. */
for (i = 0; i < degree; i++) {
xdata[i] = xdata[i + 1];
ydata[i] = ydata[i + 1];
}
ydata[i] = data[l];
xdata[i] = oscale[l];
while (!ft_polyfit(xdata, ydata, result, degree, scratch)) {
if (--degree == 0) {
fprintf(cp_err,
"interpolate: Internal Error.\n");
return (FALSE);
}
}
lastone = putinterval(result, degree, ndata, lastone,
nscale, nlen, xdata[i], sign);
}
if (lastone < nlen - 1) /* ??? */
ndata[nlen - 1] = data[olen - 1];
tfree(scratch);
tfree(xdata);
tfree(ydata);
tfree(result);
return (TRUE);
}
void *
cx_deriv(void *data, short int type, int length, int *newlength, short int *newtype, struct plot *pl, struct plot *newpl, int grouping)
{
double *scratch;
double *spare;
double x;
int i, j, k;
int degree;
int n, base;
if (grouping == 0)
grouping = length;
/* First do some sanity checks. */
if (!pl || !pl->pl_scale || !newpl || !newpl->pl_scale) {
fprintf(cp_err, "Internal error: cx_deriv: bad scale\n");
return (NULL);
}
if (!cp_getvar("dpolydegree", CP_NUM, (void *) °ree))
degree = 2; /* default quadratic */
n = degree + 1;
spare = alloc_d(n);
scratch = alloc_d(n * (n + 1));
*newlength = length;
*newtype = type;
if (type == VF_COMPLEX) {
complex *c_outdata, *c_indata;
double *r_coefs, *i_coefs;
double *scale;
r_coefs = alloc_d(n);
i_coefs = alloc_d(n);
c_indata = (complex *) data;
c_outdata = alloc_c(length);
scale = alloc_d(length); /* XXX */
if (pl->pl_scale->v_type == VF_COMPLEX)
/* Not ideal */
for (i = 0; i < length; i++)
scale[i] = realpart(&pl->pl_scale->v_compdata[i]);
else
for (i = 0; i < length; i++)
scale[i] = pl->pl_scale->v_realdata[i];
for (base = 0; base < length; base += grouping)
{
k = 0;
for (i = degree; i < grouping; i += 1)
{
/* real */
for (j = 0; j < n; j++)
spare[j] = c_indata[j + i + base].cx_real;
if (!ft_polyfit(scale + i + base - degree,
spare, r_coefs, degree, scratch))
{
fprintf(stderr, "ft_polyfit @ %d failed\n", i);
}
ft_polyderiv(r_coefs, degree);
/* for loop gets the beginning part */
for (j = k; j <= i + degree / 2; j++)
{
x = scale[j + base];
c_outdata[j + base].cx_real =
ft_peval(x, r_coefs, degree - 1);
}
/* imag */
for (j = 0; j < n; j++)
spare[j] = c_indata[j + i + base].cx_imag;
if (!ft_polyfit(scale + i - degree + base,
spare, i_coefs, degree, scratch))
{
fprintf(stderr, "ft_polyfit @ %d failed\n", i);
}
ft_polyderiv(i_coefs, degree);
/* for loop gets the beginning part */
for (j = k; j <= i - degree / 2; j++)
{
x = scale[j + base];
c_outdata[j + base].cx_imag =
ft_peval(x, i_coefs, degree - 1);
}
k = j;
}
/* get the tail */
for (j = k; j < length; j++)
{
x = scale[j + base];
/* real */
c_outdata[j + base].cx_real = ft_peval(x, r_coefs, degree - 1);
/* imag */
c_outdata[j + base].cx_imag = ft_peval(x, i_coefs, degree - 1);
}
}
tfree(r_coefs);
tfree(i_coefs);
tfree(scale);
return (void *) c_outdata;
}
else
{
/* all-real case */
double *coefs;
double *outdata, *indata;
double *scale;
coefs = alloc_d(n);
indata = (double *) data;
outdata = alloc_d(length);
scale = alloc_d(length); /* XXX */
/* Here I encountered a problem because when we issue an instruction like this:
* plot -deriv(vp(3)) to calculate something similar to the group delay, the code
* detects that vector vp(3) is real and it is believed that the frequency is also
* real. The frequency is COMPLEX and the program aborts so I'm going to put the
* check that the frequency is complex vector not to abort.
*/
/* Original problematic code
* for (i = 0; i < length; i++)
* scale[i] = pl->pl_scale->v_realdata[i];
*/
/* Modified to deal with complex frequency vector */
if (pl->pl_scale->v_type == VF_COMPLEX)
for (i = 0; i < length; i++)
scale[i] = realpart(&pl->pl_scale->v_compdata[i]);
else
for (i = 0; i < length; i++)
scale[i] = pl->pl_scale->v_realdata[i];
for (base = 0; base < length; base += grouping)
{
k = 0;
for (i = degree; i < grouping; i += 1)
{
if (!ft_polyfit(scale + i - degree + base,
indata + i - degree + base, coefs, degree, scratch))
{
fprintf(stderr, "ft_polyfit @ %d failed\n", i + base);
}
ft_polyderiv(coefs, degree);
/* for loop gets the beginning part */
for (j = k; j <= i - degree / 2; j++)
{
/* Seems the same problem because the frequency vector is complex
* and the real part of the complex should be accessed because if we
* run x = pl-> pl_scale-> v_realdata [base + j]; the execution will
* abort.
*/
if (pl->pl_scale->v_type == VF_COMPLEX)
x = realpart(&pl->pl_scale->v_compdata[j+base]); /* For complex scale vector */
else
x = pl->pl_scale->v_realdata[j + base]; /* For real scale vector */
outdata[j + base] = ft_peval(x, coefs, degree - 1);
}
k = j;
}
for (j = k; j < length; j++)
{
/* Again the same error */
/* x = pl->pl_scale->v_realdata[j + base]; */
if (pl->pl_scale->v_type == VF_COMPLEX)
x = realpart(&pl->pl_scale->v_compdata[j+base]); /* For complex scale vector */
else
x = pl->pl_scale->v_realdata[j + base]; /* For real scale vector */
outdata[j + base] = ft_peval(x, coefs, degree - 1);
}
}
tfree(coefs);
tfree(scale); /* XXX */
return (char *) outdata;
}
}
