static complex *
c_tan(complex *cc, int length)
{
complex *c;
int i;
c = alloc_c(length);
for (i = 0; i < length; i++) {
double u, v;
rcheck(cos(degtorad(realpart(&cc[i]))) *
cosh(degtorad(imagpart(&cc[i]))), "tan");
rcheck(sin(degtorad(realpart(&cc[i]))) *
sinh(degtorad(imagpart(&cc[i]))), "tan");
u = degtorad(realpart(&cc[i]));
v = degtorad(imagpart(&cc[i]));
/* The Lattice C compiler won't take multi-line macros, and
* CMS won't take >80 column lines....
*/
#define xx1 sin(u) * cosh(v)
#define xx2 cos(u) * sinh(v)
#define xx3 cos(u) * cosh(v)
#define xx4 sin(u) * sinh(v)
cdiv(xx1, xx2, xx3, xx4, realpart(&c[i]), imagpart(&c[i]));
}
return c;
}
void *
cx_uminus(void *data, short int type, int length, int *newlength, short int *newtype, ...)
{
*newlength = length;
if (type == VF_COMPLEX) {
complex *c;
complex *cc = (complex *) data;
int i;
c = alloc_c(length);
*newtype = VF_COMPLEX;
for (i = 0; i < length; i++) {
realpart(&c[i]) = - realpart(&cc[i]);
imagpart(&c[i]) = - imagpart(&cc[i]);
}
return ((void *) c);
} else {
double *d;
double *dd = (double *) data;
int i;
d = alloc_d(length);
*newtype = VF_REAL;
for (i = 0; i < length; i++)
d[i] = - dd[i];
return ((void *) d);
}
}
void *
cx_mean(void *data, short int type, int length, int *newlength, short int *newtype, ...)
{
*newlength = 1;
rcheck(length > 0, "mean");
if (type == VF_REAL) {
double *d;
double *dd = (double *) data;
int i;
d = alloc_d(1);
*newtype = VF_REAL;
for (i = 0; i < length; i++)
*d += dd[i];
*d /= length;
return ((void *) d);
} else {
complex *c;
complex *cc = (complex *) data;
int i;
c = alloc_c(1);
*newtype = VF_COMPLEX;
for (i = 0; i < length; i++) {
realpart(c) += realpart(cc + i);
imagpart(c) += imagpart(cc + i);
}
realpart(c) /= length;
imagpart(c) /= length;
return ((void *) c);
}
}
void *
cx_mod(void *data1, void *data2, short int datatype1, short int datatype2, int length, ...)
{
double *dd1 = (double *) data1;
double *dd2 = (double *) data2;
double *d;
complex *cc1 = (complex *) data1;
complex *cc2 = (complex *) data2;
complex *c, c1, c2;
int i, r1, r2, i1, i2, r3, i3;
if ((datatype1 == VF_REAL) && (datatype2 == VF_REAL)) {
d = alloc_d(length);
for (i = 0; i < length; i++) {
r1 = floor(FTEcabs(dd1[i]));
rcheck(r1 > 0, "mod");
r2 = floor(FTEcabs(dd2[i]));
rcheck(r2 > 0, "mod");
r3 = r1 % r2;
d[i] = (double) r3;
}
return ((void *) d);
} else {
c = alloc_c(length);
for (i = 0; i < length; i++) {
if (datatype1 == VF_REAL) {
realpart(&c1) = dd1[i];
imagpart(&c1) = 0.0;
} else {
realpart(&c1) = realpart(&cc1[i]);
imagpart(&c1) = imagpart(&cc1[i]);
}
if (datatype2 == VF_REAL) {
realpart(&c2) = dd2[i];
imagpart(&c2) = 0.0;
} else {
realpart(&c2) = realpart(&cc2[i]);
imagpart(&c2) = imagpart(&cc2[i]);
}
r1 = floor(FTEcabs(realpart(&c1)));
rcheck(r1 > 0, "mod");
r2 = floor(FTEcabs(realpart(&c2)));
rcheck(r2 > 0, "mod");
i1 = floor(FTEcabs(imagpart(&c1)));
rcheck(i1 > 0, "mod");
i2 = floor(FTEcabs(imagpart(&c2)));
rcheck(i2 > 0, "mod");
r3 = r1 % r2;
i3 = i1 % i2;
realpart(&c[i]) = (double) r3;
imagpart(&c[i]) = (double) i3;
}
return ((void *) c);
}
}
int
main(void)
{
ngcomplex_t *c = NULL;
double *d = NULL;
short int t1;
short int t2;
int n1, n2;
double eps = DBL_EPSILON;
cp_err = stderr;
n1 = 9;
t1 = VF_COMPLEX;
c = alloc_c(n1);
realpart(c[0]) = 0.0;
imagpart(c[0]) = +1.0; /* i^1 */
realpart(c[1]) = -1.0;
imagpart(c[1]) = 0.0; /* i^2 */
realpart(c[2]) = 0.0;
imagpart(c[2]) = -1.0; /* i^3 */
realpart(c[3]) = +1.0;
imagpart(c[3]) = 0.0; /* i^4 */
realpart(c[4]) = 0.0;
imagpart(c[4]) = +1.0; /* i^5 */
realpart(c[5]) = +1.0;
imagpart(c[5]) = 0.0; /* i^4 */
realpart(c[6]) = 0.0;
imagpart(c[6]) = -1.0; /* i^3 */
realpart(c[7]) = -1.0;
imagpart(c[7]) = 0.0; /* i^2 */
realpart(c[8]) = 0.0;
imagpart(c[8]) = +1.0; /* i^1 */
d = (double *) cx_cph((void *) c, t1, n1, &n2, &t2);
if ( eq_p(1*M_PI/2, d[0], eps) &&
eq_p(2*M_PI/2, d[1], eps) &&
eq_p(3*M_PI/2, d[2], eps) &&
eq_p(4*M_PI/2, d[3], eps) &&
eq_p(5*M_PI/2, d[4], eps) &&
eq_p(4*M_PI/2, d[5], eps) &&
eq_p(3*M_PI/2, d[6], eps) &&
eq_p(2*M_PI/2, d[7], eps) &&
eq_p(1*M_PI/2, d[8], eps) )
return 0;
else
return 1;
}
void *
cx_d(void *data, short int type, int length, int *newlength, short int *newtype, ...)
{
*newlength = length;
/* test if length >0 et affiche un message d'erreur */
rcheck(length > 0, "deriv");
if (type == VF_REAL) {
double *d;
double *dd = (double *) data;
int i;
d = alloc_d(length);
*newtype = VF_REAL;
d[0]=dd[1]-dd[0];
d[length-1]=dd[length-1]-dd[length-2];
for (i = 1; i < length-1; i++)
d[i]=dd[i+1]-dd[i-1];
return ((void *) d);
} else {
complex *c;
complex *cc = (complex *) data;
int i;
c = alloc_c(length);
*newtype = VF_COMPLEX;
realpart(c)=realpart(cc+1)-realpart(cc);
imagpart(c)=imagpart(cc+1)-imagpart(cc);
realpart(c+length-1)=realpart(cc+length-1)-realpart(cc+length-2);
imagpart(c+length-1)=imagpart(cc+length-1)-imagpart(cc+length-2);
for (i = 1; i < (length-1); i++) {
realpart(c+i)=realpart(cc+i+1)-realpart(cc+i-1);
imagpart(c+i)=imagpart(cc+i+1)-imagpart(cc+i-1);
}
return ((void *) c);
}
}
void *
cx_times(void *data1, void *data2, short int datatype1, short int datatype2, int length, ...)
{
double *dd1 = (double *) data1;
double *dd2 = (double *) data2;
double *d;
complex *cc1 = (complex *) data1;
complex *cc2 = (complex *) data2;
complex *c, c1, c2;
int i;
if ((datatype1 == VF_REAL) && (datatype2 == VF_REAL)) {
d = alloc_d(length);
for (i = 0; i < length; i++)
d[i] = dd1[i] * dd2[i];
return ((void *) d);
} else {
c = alloc_c(length);
for (i = 0; i < length; i++) {
if (datatype1 == VF_REAL) {
realpart(&c1) = dd1[i];
imagpart(&c1) = 0.0;
} else {
realpart(&c1) = realpart(&cc1[i]);
imagpart(&c1) = imagpart(&cc1[i]);
}
if (datatype2 == VF_REAL) {
realpart(&c2) = dd2[i];
imagpart(&c2) = 0.0;
} else {
realpart(&c2) = realpart(&cc2[i]);
imagpart(&c2) = imagpart(&cc2[i]);
}
realpart(&c[i]) = realpart(&c1) * realpart(&c2)
- imagpart(&c1) * imagpart(&c2);
imagpart(&c[i]) = imagpart(&c1) * realpart(&c2)
+ realpart(&c1) * imagpart(&c2);
}
return ((void *) c);
}
}
void *
cx_min(void *data, short int type, int length, int *newlength, short int *newtype, ...)
{
*newlength = 1;
/* test if length >0 et affiche un message d'erreur */
rcheck(length > 0, "mean");
if (type == VF_REAL) {
double smallest;
double *d;
double *dd = (double *) data;
int i;
d = alloc_d(1);
*newtype = VF_REAL;
smallest=dd[0];
for (i = 1; i < length; i++)
if (dd[i]<smallest) smallest=dd[i];
*d=smallest;
return ((void *) d);
} else {
double smallest_real;
double smallest_complex;
complex *c;
complex *cc = (complex *) data;
int i;
c = alloc_c(1);
*newtype = VF_COMPLEX;
smallest_real=realpart(cc);
smallest_complex=imagpart(cc);
for (i = 1; i < length; i++) {
if (realpart(cc + i)<smallest_real) smallest_real=realpart(cc + i);
if (imagpart(cc + i)<smallest_complex) smallest_complex=imagpart(cc + i);
}
realpart(c) = smallest_real;
imagpart(c) = smallest_complex;
return ((void *) c);
}
}
void *
cx_norm(void *data, short int type, int length, int *newlength, short int *newtype, ...)
{
double largest = 0.0;
largest = cx_max_local(data, type, length);
if (largest == 0.0) {
fprintf(cp_err, "Error: can't normalize a 0 vector\n");
return (NULL);
}
*newlength = length;
if (type == VF_COMPLEX) {
complex *c;
complex *cc = (complex *) data;
int i;
c = alloc_c(length);
*newtype = VF_COMPLEX;
for (i = 0; i < length; i++) {
realpart(&c[i]) = realpart(&cc[i]) / largest;
imagpart(&c[i]) = imagpart(&cc[i]) / largest;
}
return ((void *) c);
} else {
double *d;
double *dd = (double *) data;
int i;
d = alloc_d(length);
*newtype = VF_REAL;
for (i = 0; i < length; i++)
d[i] = dd[i] / largest;
return ((void *) d);
}
}
int
main(void)
{
complex *c = NULL;
double *d = NULL;
short int t1;
short int t2;
int n1;
int n2;
double eps = DBL_EPSILON;
cp_err = stderr;
n1 = 1;
t1 = VF_COMPLEX;
c = alloc_c(n1);
realpart(&c[0]) = .0;
imagpart(&c[0]) = 1.0;
d = (double *) cx_ph((void *) c, t1, n1, &n2, &t2);
if (M_PI/2 - eps < d[0] && d[0] < M_PI/2 + eps)
return 0;
else
return 1;
}
void *
cx_rnd(void *data, short int type, int length, int *newlength, short int *newtype, ...)
{
*newlength = length;
if (type == VF_COMPLEX) {
complex *c;
complex *cc = (complex *) data;
int i;
c = alloc_c(length);
*newtype = VF_COMPLEX;
for (i = 0; i < length; i++) {
int j, k;
j = floor(realpart(&cc[i]));
k = floor(imagpart(&cc[i]));
realpart(&c[i]) = j ? random() % j : 0;
imagpart(&c[i]) = k ? random() % k : 0;
}
return ((void *) c);
} else {
double *d;
double *dd = (double *) data;
int i;
d = alloc_d(length);
*newtype = VF_REAL;
for (i = 0; i < length; i++) {
int j;
j = floor(dd[i]);
d[i] = j ? random() % j : 0;
}
return ((void *) d);
}
}
void *read() {
char *s = alloc_c(200);
fgets(s, 200, stdin);
return s;
}
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;
}
}
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;
}
}
