Exemplo n.º 1
0
Scheme_Object *scheme_complex_normalize(const Scheme_Object *o)
{
  Scheme_Complex *c = (Scheme_Complex *)o;

  if (c->i == zero)
    return c->r;
  if (c->r == zero) {
    /* No coercions */
    return (Scheme_Object *)c; 
  }

  /* Coercions: Exact -> float -> double
     If the complex contains a float and an exact, we coerce the exact
     to a float, etc. */

#ifdef MZ_USE_SINGLE_FLOATS
  if (SCHEME_FLTP(c->i)) {
    if (!SCHEME_FLTP(c->r)) {
      Scheme_Object *v;
      if (SCHEME_DBLP(c->r)) {
        v = scheme_make_double(SCHEME_FLT_VAL(c->i));
        c->i = v;
      } else {
        v = scheme_make_float(scheme_get_val_as_float(c->r));
	c->r = v;
      }
    }
  } else if (SCHEME_FLTP(c->r)) {
    Scheme_Object *v;
    /* Imag part can't be a float, or we'd be in the previous case */
    if (SCHEME_DBLP(c->i)) {
      v = scheme_make_double(SCHEME_FLT_VAL(c->r));
      c->r = v;
    } else {
      v = scheme_make_float(scheme_get_val_as_float(c->i));
      c->i = v;
    }
  } else
#endif

  if (SCHEME_DBLP(c->i)) {
    if (!SCHEME_DBLP(c->r)) {
      Scheme_Object *r;
      r = scheme_make_double(scheme_get_val_as_double(c->r));
      c->r = r;
    }
  } else if (SCHEME_DBLP(c->r)) {
    Scheme_Object *i;
    i = scheme_make_double(scheme_get_val_as_double(c->i));
    c->i = i;
  }

  return (Scheme_Object *)c;
}
Exemplo n.º 2
0
Scheme_Object *scheme_complex_power(const Scheme_Object *base, const Scheme_Object *exponent)
{
    Scheme_Complex *cb = (Scheme_Complex *)base;
    Scheme_Complex *ce = (Scheme_Complex *)exponent;
    double a, b, c, d, bm, ba, nm, na, r1, r2;
    int d_is_zero;

    if ((ce->i == zero) && !SCHEME_FLOATP(ce->r)) {
        if (SCHEME_INTP(ce->r) || SCHEME_BIGNUMP(ce->r))
            return scheme_generic_integer_power(base, ce->r);
    }

    a = scheme_get_val_as_double(cb->r);
    b = scheme_get_val_as_double(cb->i);
    c = scheme_get_val_as_double(ce->r);
    d = scheme_get_val_as_double(ce->i);
    d_is_zero = (ce->i == zero);

    bm = sqrt(a * a + b * b);
    ba = atan2(b, a);

    /* New mag & angle */
    nm = scheme_double_expt(bm, c) * exp(-(ba * d));
    if (d_is_zero) /* precision here can avoid NaNs */
        na = ba * c;
    else
        na = log(bm) * d + ba * c;

    r1 = nm * cos(na);
    r2 = nm * sin(na);

#ifdef MZ_USE_SINGLE_FLOATS
    /* Coerce to double or float? */
#ifdef USE_SINGLE_FLOATS_AS_DEFAULT
    if (!SCHEME_DBLP(cb->r) && !SCHEME_DBLP(cb->i)
            && !SCHEME_DBLP(ce->r) && !SCHEME_DBLP(ce->i))
#else
    if (SCHEME_FLTP(cb->r) && SCHEME_FLTP(cb->i)
            && SCHEME_FLTP(ce->r) && SCHEME_FLTP(ce->i))
#endif
        return scheme_make_complex(scheme_make_float((float)r1),
                                   scheme_make_float((float)r2));
#endif

    return scheme_make_complex(scheme_make_double(r1),
                               scheme_make_double(r2));
}