void mzeros1 (header *hd) { header *st=hd,*hd1,*result; int r,c; double *m,xr,xi; hd1=nextof(hd); hd=getvalue(hd); if (error) return; if (hd->type==s_matrix) { make_complex(st); if (error) return; hd=getvalue(st); if (error) return; } hd1=getvalue(hd1); if (error) return; if (hd1->type==s_real) { xr=*realof(hd1); xi=0; } else if (hd1->type==s_complex) { xr=*realof(hd1); xi=*(realof(hd1)+1); } else { output("Need a starting value!\n"); error=300; return; } if (hd->type!=s_cmatrix || dimsof(hd)->r!=1 || dimsof(hd)->c<2) { output("Need a complex polynomial\n"); error=300; return; } getmatrix(hd,&r,&c,&m); result=new_complex(0,0,""); if (error) return; bauhuber(m,c-1,realof(result),0,xr,xi); moveresult(st,result); }
static Lisp_Object Lcomplex_2(Lisp_Object nil, Lisp_Object a, Lisp_Object b) { /* /* Need to coerce a and b to the same type here... */ a = make_complex(a, b); errexit(); return onevalue(a); }
static void make_filter(T *result_b, T *result_a, const complex4c *alpha, const complex4c *beta, int K, T sigma) { const double denom = sigma * M_SQRT2PI; complex4c b[DERICHE_MAX_K], a[DERICHE_MAX_K + 1]; int k, j; b[0] = alpha[0]; /* Initialize b/a = alpha[0] / (1 + beta[0] z^-1) */ a[0] = make_complex(1, 0); a[1] = beta[0]; for (k = 1; k < K; ++k) { /* Add kth term, b/a += alpha[k] / (1 + beta[k] z^-1) */ b[k] = c_mul(beta[k], b[k-1]); for (j = k - 1; j > 0; --j) b[j] = c_add(b[j], c_mul(beta[k], b[j - 1])); for (j = 0; j <= k; ++j) b[j] = c_add(b[j], c_mul(alpha[k], a[j])); a[k + 1] = c_mul(beta[k], a[k]); for (j = k; j > 0; --j) a[j] = c_add(a[j], c_mul(beta[k], a[j - 1])); } for (k = 0; k < K; ++k) { result_b[k] = (T)(b[k].real / denom); result_a[k + 1] = (T)a[k + 1].real; } return; }
static Lisp_Object Lcomplex_1(Lisp_Object nil, Lisp_Object a) { /* /* Need to make zero of same type as a */ a = make_complex(a, fixnum_of_int(0)); errexit(); return onevalue(a); }
/** * \brief Expand pole product * \param c resulting filter coefficients * \param poles pole locations * \param K number of poles * \ingroup vyv_gaussian * * This routine expands the product to obtain the filter coefficients: * \f[ \prod_{k=0}^{K-1}\frac{\mathrm{poles}[k]-1}{\mathrm{poles}[k]-z^{-1}} = \frac{c[0]}{1+\sum_{k=1}^K c[k] z^{-k}}. \f] */ static void expand_pole_product(double *c, const complex4c *poles, int K) { complex4c denom[VYV_MAX_K + 1]; int k, j; assert(K <= VYV_MAX_K); denom[0] = poles[0]; denom[1] = make_complex(-1, 0); for (k = 1; k < K; ++k) { denom[k + 1] = c_neg(denom[k]); for (j = k; j > 0; --j) denom[j] = c_sub(c_mul(denom[j], poles[k]), denom[j - 1]); denom[0] = c_mul(denom[0], poles[k]); } for (k = 1; k <= K; ++k) c[k] = c_div(denom[k], denom[0]).real; for (c[0] = 1, k = 1; k <= K; ++k) c[0] += c[k]; return; }
Complex* add(Complex* a, Complex* b) { int real = a->real + b->real, imaginary = a->imaginary + b->imaginary; Complex* result = make_complex(real, imaginary); return result; }
Scheme_Object *scheme_complex_negate(const Scheme_Object *o) { Scheme_Complex *c = (Scheme_Complex *)o; return make_complex(scheme_bin_minus(scheme_make_integer(0), c->r), scheme_bin_minus(scheme_make_integer(0), c->i), 0); }
Complex* divide(Complex* a, Complex* b) { x = a->real; y = a->imaginary; xi = b->real; yi = b->imaginary; int real = (x * xi + y * yi) / (xi * xi + yi * yi), imaginary = (x * yi - y * xi) / (xi * xi + yi * yi); Complex* result = make_complex(real, imaginary); return result; }
Complex* product(Complex* a, Complex* b) { x = a->real; y = a->imaginary; xi = b->real; yi = b->imaginary; int real = (x * xi) - (y * yi), imaginary = (x * yi) - (y * xi); Complex* result = make_complex(real, imaginary); return result; }
static Lisp_Object pluscc(Lisp_Object a, Lisp_Object b) /* * Add complex values. */ { Lisp_Object c, nil; push2(a, b); c = plus2(imag_part(a), imag_part(b)); pop2(b, a); errexit(); a = plus2(real_part(a), real_part(b)); errexit(); return make_complex(a, c); }
static Lisp_Object plusic(Lisp_Object a, Lisp_Object b) /* * real of any sort plus complex. */ { Lisp_Object nil; push(b); a = plus2(a, real_part(b)); pop(b); errexit(); /* * make_complex() takes responsibility for mapping #C(n 0) onto n */ return make_complex(a, imag_part(b)); }
static Lisp_Object Lconjugate(Lisp_Object nil, Lisp_Object a) { if (!is_number(a)) return aerror1("conjugate", a); if (is_numbers(a) && is_complex(a)) { Lisp_Object r = real_part(a), i = imag_part(a); push(r); i = negate(i); pop(r); errexit(); a = make_complex(r, i); errexit(); return onevalue(a); } else return onevalue(a); }
void mzeros (header *hd) { header *st=hd,*result; int r,c; double *m; hd=getvalue(hd); if (error) return; if (hd->type==s_matrix) { make_complex(st); if (error) return; hd=getvalue(st); if (error) return; } if (hd->type!=s_cmatrix || dimsof(hd)->r!=1 || dimsof(hd)->c<2) { output("Need a complex polynomial\n"); error=300; return; } getmatrix(hd,&r,&c,&m); result=new_cmatrix(1,c-1,""); if (error) return; bauhuber(m,c-1,matrixof(result),1,0,0); moveresult(st,result); }
main () { // main function int finished = 0; char command [100]; double re, im, angle,x,y; MY_COMPLEX * z; while (!finished) { scanf ("%s",command); if (strncmp(command, "make",6) == 0) { scanf("%lf",&re); scanf("%lf",&im); z = make_complex(re,im); printf("make "); print_complex(z); } else if (strncmp(command,"translate",8) == 0) { check_complex(z); scanf ("%lf", &x); scanf ("%lf", &y); printf("translate (%g,%g) ",x,y); z = translate(z,x,y); print_complex(z); } else if (strncmp(command, "rotate",6) == 0) { check_complex(z); scanf("%lf", &angle); printf("rotate %g degrees ",angle); z = rotate(z,angle); printf("result "); print_complex(z); } else if (strncmp(command,"print",5) == 0) { check_complex(z); printf("print "); print_complex(z); } else if (strncmp(command,"quit",4) == 0) finished = 1; else printf ("unrecognised command\n"); } printf("Quitting\n"); }
Complex add_complex(const Complex c1, const Complex c2){ return make_complex(c1.real + c2.real, c1.imag + c2.imag); }
Complex mul_complex(const Complex c1, const Complex c2){ return make_complex(c1.real * c2.real - c1.imag * c2.imag, c1.real * c2.imag + c1.imag * c2.real); }
Scheme_Object *scheme_real_to_complex(const Scheme_Object *n) { return make_complex(n, zero, 0); }
Scheme_Object *scheme_make_complex(const Scheme_Object *r, const Scheme_Object *i) { return make_complex(r, i, 1); }
Lisp_Object negate(Lisp_Object a) { #ifdef COMMON Lisp_Object nil; /* needed for errexit() */ #endif switch ((int)a & TAG_BITS) { case TAG_FIXNUM: { int32_t aa = -int_of_fixnum(a); /* * negating the number -#x8000000 (which is a fixnum) yields a value * which just fails to be a fixnum. */ if (aa != 0x08000000) return fixnum_of_int(aa); else return make_one_word_bignum(aa); } #ifdef COMMON case TAG_SFLOAT: { Float_union aa; aa.i = a - TAG_SFLOAT; aa.f = (float) (-aa.f); return (aa.i & ~(int32_t)0xf) + TAG_SFLOAT; } #endif case TAG_NUMBERS: { int32_t ha = type_of_header(numhdr(a)); switch (ha) { case TYPE_BIGNUM: return negateb(a); #ifdef COMMON case TYPE_RATNUM: { Lisp_Object n = numerator(a), d = denominator(a); push(d); n = negate(n); pop(d); errexit(); return make_ratio(n, d); } case TYPE_COMPLEX_NUM: { Lisp_Object r = real_part(a), i = imag_part(a); push(i); r = negate(r); pop(i); errexit(); push(r); i = negate(i); pop(r); errexit(); return make_complex(r, i); } #endif default: return aerror1("bad arg for minus", a); } } case TAG_BOXFLOAT: { double d = float_of_number(a); return make_boxfloat(-d, type_of_header(flthdr(a))); } default: return aerror1("bad arg for minus", a); } }
void deriche_precomp_(deriche_coeffs<T> *c, T sigma, int K, T tol) { /* Deriche's optimized filter parameters. */ static const complex4c alpha[DERICHE_MAX_K - DERICHE_MIN_K + 1][4] = { {{0.48145, 0.971}, {0.48145, -0.971}}, {{-0.44645, 0.5105}, {-0.44645, -0.5105}, {1.898, 0}}, {{0.84, 1.8675}, {0.84, -1.8675}, {-0.34015, -0.1299}, {-0.34015, 0.1299}} }; static const complex4c lambda[DERICHE_MAX_K - DERICHE_MIN_K + 1][4] = { {{1.26, 0.8448}, {1.26, -0.8448}}, {{1.512, 1.475}, {1.512, -1.475}, {1.556, 0}}, {{1.783, 0.6318}, {1.783, -0.6318}, {1.723, 1.997}, {1.723, -1.997}} }; complex4c beta[DERICHE_MAX_K]; int k; double accum, accum_denom = 1.0; assert(c && sigma > 0 && DERICHE_VALID_K(K) && 0 < tol && tol < 1); for (k = 0; k < K; ++k) { double temp = exp(-lambda[K - DERICHE_MIN_K][k].real / sigma); beta[k] = make_complex( -temp * cos(lambda[K - DERICHE_MIN_K][k].imag / sigma), temp * sin(lambda[K - DERICHE_MIN_K][k].imag / sigma)); } /* Compute the causal filter coefficients */ make_filter<T>(c->b_causal, c->a, alpha[K - DERICHE_MIN_K], beta, K, sigma); /* Numerator coefficients of the anticausal filter */ c->b_anticausal[0] = (T)(0.0); for (k = 1; k < K; ++k) c->b_anticausal[k] = c->b_causal[k] - c->a[k] * c->b_causal[0]; c->b_anticausal[K] = -c->a[K] * c->b_causal[0]; /* Impulse response sums */ for (k = 1; k <= K; ++k) accum_denom += c->a[k]; for (k = 0, accum = 0.0; k < K; ++k) accum += c->b_causal[k]; c->sum_causal = (T)(accum / accum_denom); for (k = 1, accum = 0.0; k <= K; ++k) accum += c->b_anticausal[k]; c->sum_anticausal = (T)(accum / accum_denom); c->sigma = (T)sigma; c->K = K; c->tol = tol; c->max_iter = (int)ceil(10.0 * sigma); return; }
Complex add_complex(Complex c1, Complex c2){ return make_complex(c1.real + c2.real, c1.img + c2.img); }
Complex add_complex_by_reference(Complex *c1, Complex *c2){ return make_complex(c1->real + c2->real, c1->img + c2->img); // return make_complex((*c1).real + (*c2).real, (*c1).img + (*c2).img); }
Complex add_complex_by_const_reference(const Complex *c1, const Complex *c2){ return make_complex(c1->real + c2->real, c1->img + c2->img); }