Back to index

plt-scheme  4.2.1
Defines | Functions | Variables
rational.c File Reference
#include "schpriv.h"
#include <ctype.h>
#include <math.h>
#include "ratfloat.inc"

Go to the source code of this file.

Defines

#define FP_TYPE   double
#define SCHEME_RATIONAL_TO_FLOAT   scheme_rational_to_double
#define SCHEME_RATIONAL_FROM_FLOAT   scheme_rational_from_double
#define SCHEME_BIGNUM_TO_FLOAT_INF_INFO   scheme_bignum_to_double_inf_info
#define SCHEME_CHECK_FLOAT   scheme_check_double
#define SCHEME_BIGNUM_FROM_FLOAT   scheme_bignum_from_double
#define DO_FLOAT_DIV   scheme__do_double_div
#define FLOAT_E_MIN   -1074
#define FLOAT_M_BITS   52

Functions

static Scheme_Objectmake_rational (const Scheme_Object *n, const Scheme_Object *d, int normalize)
Scheme_Objectscheme_make_rational (const Scheme_Object *n, const Scheme_Object *d)
Scheme_Objectscheme_integer_to_rational (const Scheme_Object *n)
Scheme_Objectscheme_make_small_rational (long n, Small_Rational *s)
Scheme_Objectscheme_make_small_bn_rational (Scheme_Object *n, Small_Rational *s)
int scheme_is_rational_positive (const Scheme_Object *o)
Scheme_Objectscheme_rational_normalize (const Scheme_Object *o)
Scheme_Objectscheme_rational_numerator (const Scheme_Object *n)
Scheme_Objectscheme_rational_denominator (const Scheme_Object *n)
Scheme_Objectscheme_make_fixnum_rational (long n, long d)
int scheme_rational_eq (const Scheme_Object *a, const Scheme_Object *b)
static int rational_lt (const Scheme_Object *a, const Scheme_Object *b, int or_eq)
int scheme_rational_lt (const Scheme_Object *a, const Scheme_Object *b)
int scheme_rational_gt (const Scheme_Object *a, const Scheme_Object *b)
int scheme_rational_le (const Scheme_Object *a, const Scheme_Object *b)
int scheme_rational_ge (const Scheme_Object *a, const Scheme_Object *b)
Scheme_Objectscheme_rational_negate (const Scheme_Object *o)
Scheme_Objectscheme_rational_add (const Scheme_Object *a, const Scheme_Object *b)
Scheme_Objectscheme_rational_subtract (const Scheme_Object *a, const Scheme_Object *b)
Scheme_Objectscheme_rational_add1 (const Scheme_Object *n)
Scheme_Objectscheme_rational_sub1 (const Scheme_Object *n)
Scheme_Objectscheme_rational_multiply (const Scheme_Object *a, const Scheme_Object *b)
Scheme_Objectscheme_rational_max (const Scheme_Object *a, const Scheme_Object *b)
Scheme_Objectscheme_rational_min (const Scheme_Object *a, const Scheme_Object *b)
static Scheme_Objectnegate_simple (Scheme_Object *v)
Scheme_Objectscheme_rational_divide (const Scheme_Object *n, const Scheme_Object *d)
Scheme_Objectscheme_rational_power (const Scheme_Object *o, const Scheme_Object *p)
Scheme_Objectscheme_rational_truncate (const Scheme_Object *o)
Scheme_Objectscheme_rational_floor (const Scheme_Object *o)
Scheme_Objectscheme_rational_ceiling (const Scheme_Object *o)
Scheme_Objectscheme_rational_round (const Scheme_Object *o)
Scheme_Objectscheme_rational_sqrt (const Scheme_Object *o)

Variables

static Scheme_Objectone = scheme_make_integer(1)

Define Documentation

#define DO_FLOAT_DIV   scheme__do_double_div

Definition at line 530 of file rational.c.

#define FLOAT_E_MIN   -1074

Definition at line 531 of file rational.c.

#define FLOAT_M_BITS   52

Definition at line 532 of file rational.c.

#define FP_TYPE   double

Definition at line 524 of file rational.c.

Definition at line 529 of file rational.c.

Definition at line 527 of file rational.c.

Definition at line 528 of file rational.c.

Definition at line 526 of file rational.c.

Definition at line 525 of file rational.c.


Function Documentation

static Scheme_Object* make_rational ( const Scheme_Object n,
const Scheme_Object d,
int  normalize 
) [static]

Definition at line 32 of file rational.c.

Here is the caller graph for this function:

static Scheme_Object* negate_simple ( Scheme_Object v) [static]

Definition at line 346 of file rational.c.

Here is the call graph for this function:

Here is the caller graph for this function:

static int rational_lt ( const Scheme_Object a,
const Scheme_Object b,
int  or_eq 
) [static]

Definition at line 199 of file rational.c.

{
  Scheme_Rational *ra = (Scheme_Rational *)a;
  Scheme_Rational *rb = (Scheme_Rational *)b;
  Scheme_Object *ma, *mb;

  ma = scheme_bin_mult(ra->num, rb->denom);
  mb = scheme_bin_mult(rb->num, ra->denom);

  if (SCHEME_INTP(ma) && SCHEME_INTP(mb)) {
    if (or_eq)
      return (SCHEME_INT_VAL(ma) <= SCHEME_INT_VAL(mb));
    else
      return (SCHEME_INT_VAL(ma) < SCHEME_INT_VAL(mb));
  } else if (SCHEME_BIGNUMP(ma) && SCHEME_BIGNUMP(mb)) {
    if (or_eq)
      return scheme_bignum_le(ma, mb);
    else
      return scheme_bignum_lt(ma, mb);
  } else if (SCHEME_BIGNUMP(mb)) {
    return SCHEME_BIGPOS(mb);
  } else
    return !SCHEME_BIGPOS(ma);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 54 of file rational.c.

{
  return make_rational(n, one, 0);
}

Here is the call graph for this function:

Definition at line 85 of file rational.c.

{
  Scheme_Rational *r = (Scheme_Rational *)o;

  if (SCHEME_INTP(r->num))
    return (SCHEME_INT_VAL(r->num) > 0);
  else 
    return SCHEME_BIGPOS(r->num);
}

Here is the caller graph for this function:

Scheme_Object* scheme_make_fixnum_rational ( long  n,
long  d 
)

Definition at line 155 of file rational.c.

{
  /* This function is called to implement division on small integers,
     so don't allocate unless necessary. */
  Small_Rational s;
  Scheme_Object *o;
  
  s.so.type = scheme_rational_type;
  s.num = scheme_make_integer(n);
  s.denom = scheme_make_integer(d);

  o = scheme_rational_normalize((Scheme_Object *)&s);
  if (o == (Scheme_Object *)&s)
    return make_rational(s.num, s.denom, 0);
  else
    return o;
}

Here is the call graph for this function:

Definition at line 48 of file rational.c.

Here is the call graph for this function:

Definition at line 72 of file rational.c.

{
  s->so.type = scheme_rational_type;
  s->num = n;
  s->denom = one;

  return (Scheme_Object *)s;
}

Here is the caller graph for this function:

Definition at line 63 of file rational.c.

{
  s->so.type = scheme_rational_type;
  s->num = scheme_make_integer(n);
  s->denom = one;

  return (Scheme_Object *)s;
}

Here is the caller graph for this function:

Definition at line 253 of file rational.c.

{
  Scheme_Rational *ra = (Scheme_Rational *)a;
  Scheme_Rational *rb = (Scheme_Rational *)b;
  Scheme_Object *ac, *bd, *sum, *cd;
  int no_normalize = 0;

  if (SCHEME_INTP(ra->denom) && (SCHEME_INT_VAL(ra->denom) == 1)) {
    /* Swap, to take advantage of the next optimization */
    Scheme_Rational *rx = ra;
    ra = rb;
    rb = rx;
  }
  if (SCHEME_INTP(rb->denom) && (SCHEME_INT_VAL(rb->denom) == 1)) {
    /* From Brad Lucier: */
    /*    (+ p/q n) = (make-rational (+ p (* n q)) q), no normalize */
    ac = ra->num;
    cd = ra->denom;
    no_normalize = 1;
  } else {
    ac = scheme_bin_mult(ra->num, rb->denom);
    cd = scheme_bin_mult(ra->denom, rb->denom);
  }

  bd = scheme_bin_mult(ra->denom, rb->num);
  sum = scheme_bin_plus(ac, bd);

  if (no_normalize)
    return make_rational(sum, cd, 0);
  else
    return scheme_make_rational(sum, cd);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 291 of file rational.c.

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 447 of file rational.c.

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 150 of file rational.c.

{
  return ((Scheme_Rational *)n)->denom;
}

Definition at line 354 of file rational.c.

{ 
  Scheme_Rational *rd = (Scheme_Rational *)d, *rn = (Scheme_Rational *)n;
  Scheme_Rational d_inv;

  /* Check for [negative] inverse, which is easy */
  if ((SCHEME_INTP(rn->num) && ((SCHEME_INT_VAL(rn->num) == 1)
                            || (SCHEME_INT_VAL(rn->num) == -1)))
      && (SCHEME_INTP(rn->denom) && SCHEME_INT_VAL(rn->denom) == 1)) {
    int negate = (SCHEME_INT_VAL(rn->num) == -1);
    if (SCHEME_INTP(rd->num)) {
      if ((SCHEME_INT_VAL(rd->num) == 1)) {
       if (negate)
         return negate_simple(rd->denom);
       else
         return rd->denom;
      }
      if (SCHEME_INT_VAL(rd->num) == -1) {
       if (negate)
         return rd->denom;
       else
         return negate_simple(rd->denom);
      }
    }
    if (((SCHEME_INTP(rd->num))
        && (SCHEME_INT_VAL(rd->num) < 0))
       || (!SCHEME_INTP(rd->num)
           && !SCHEME_BIGPOS(rd->num))) {
      Scheme_Object *v;
      v = negate ? rd->denom : negate_simple(rd->denom);
      return make_rational(v, negate_simple(rd->num), 0);
    } else {
      Scheme_Object *v;
      v = negate ? negate_simple(rd->denom) : rd->denom;
      return make_rational(v, rd->num, 0);
    }
  }
  
  d_inv.so.type = scheme_rational_type;
  d_inv.denom = rd->num;
  d_inv.num = rd->denom;

  return scheme_rational_multiply(n, (Scheme_Object *)&d_inv);
}

Here is the call graph for this function:

Definition at line 173 of file rational.c.

{
  Scheme_Rational *ra = (Scheme_Rational *)a;
  Scheme_Rational *rb = (Scheme_Rational *)b;

  if (SCHEME_INTP(ra->num) && SCHEME_INTP(rb->num)) {
    if (ra->num != rb->num)
      return 0;
  } else if (SCHEME_BIGNUMP(ra->num) && SCHEME_BIGNUMP(rb->num)) {
    if (!scheme_bignum_eq(ra->num, rb->num))
      return 0;
  } else
    return 0;

  if (SCHEME_INTP(ra->denom) && SCHEME_INTP(rb->denom)) {
    if (ra->denom != rb->denom)
      return 0;
  } else if (SCHEME_BIGNUMP(ra->denom) && SCHEME_BIGNUMP(rb->denom)) {
    if (!scheme_bignum_eq(ra->denom, rb->denom))
      return 0;
  } else
    return 0;

  return 1;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 436 of file rational.c.

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 239 of file rational.c.

{
  return !rational_lt(a, b, 0);
}

Here is the call graph for this function:

Definition at line 229 of file rational.c.

{
  return !rational_lt(a, b, 1);
}

Here is the call graph for this function:

Definition at line 234 of file rational.c.

{
  return rational_lt(a, b, 1);
}

Here is the call graph for this function:

Definition at line 224 of file rational.c.

{
  return rational_lt(a, b, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 332 of file rational.c.

{
  int lt;
  lt = scheme_rational_lt(a, b);
  return scheme_rational_normalize(lt ? b : a);
}

Here is the call graph for this function:

Definition at line 339 of file rational.c.

{
  int lt;
  lt = scheme_rational_lt(a, b);
  return scheme_rational_normalize(lt ? a : b);
}

Here is the call graph for this function:

Definition at line 305 of file rational.c.

{
  Scheme_Rational *ra = (Scheme_Rational *)a;
  Scheme_Rational *rb = (Scheme_Rational *)b;
  Scheme_Object *gcd_ps, *gcd_rq, *p_, *r_, *q_, *s_;

  /* From Brad Lucier: */
  /* (* p/q r/s) => (make-rational (* (quotient p (gcd p s))
                                      (quotient r (gcd r q)))
                                   (* (quotient q (gcd r q))
                                      (quotient s (gcd p s)))) */
  
  gcd_ps = scheme_bin_gcd(ra->num, rb->denom);
  gcd_rq = scheme_bin_gcd(rb->num, ra->denom);

  p_ = scheme_bin_quotient(ra->num, gcd_ps);
  r_ = scheme_bin_quotient(rb->num, gcd_rq);

  q_ = scheme_bin_quotient(ra->denom, gcd_rq);
  s_ = scheme_bin_quotient(rb->denom, gcd_ps);

  p_ = scheme_bin_mult(p_, r_);
  q_ = scheme_bin_mult(q_, s_);

  return scheme_make_rational(p_, q_);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 244 of file rational.c.

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 95 of file rational.c.

{
  Scheme_Rational *r = (Scheme_Rational *)o;
  Scheme_Object *gcd, *tmpn;
  int negate = 0;

  if (r->num == scheme_exact_zero)
    return scheme_make_integer(0);

  if (SCHEME_INTP(r->denom)) {
    if (SCHEME_INT_VAL(r->denom) < 0) {
      tmpn = scheme_make_integer_value(-SCHEME_INT_VAL(r->denom));
      r->denom = tmpn;
      negate = 1;
    }
  } else if (!SCHEME_BIGPOS(r->denom)) {
    tmpn = scheme_bignum_negate(r->denom);
    r->denom = tmpn;
    negate = 1;
  }

  if (negate) {
    if (SCHEME_INTP(r->num)) {
      tmpn = scheme_make_integer_value(-SCHEME_INT_VAL(r->num));
      r->num = tmpn;
    } else {
      tmpn = scheme_bignum_negate(r->num);
      r->num = tmpn;
    }
  }
  
  if (r->denom == one)
    return r->num;

  gcd = scheme_bin_gcd(r->num, r->denom);

  if (gcd == one)
    return (Scheme_Object *)o;

  tmpn = scheme_bin_quotient(r->num, gcd);
  r->num = tmpn;
  tmpn = scheme_bin_quotient(r->denom, gcd);
  r->denom = tmpn;

  if (r->denom == one)
    return r->num;

  return (Scheme_Object *)r;
}

Here is the call graph for this function:

Definition at line 145 of file rational.c.

{
  return ((Scheme_Rational *)n)->num;
}

Definition at line 399 of file rational.c.

{
  double b, e, v;

  if (((Scheme_Rational *)p)->denom == one) {
    Scheme_Object *a[2], *n;
    a[0] = ((Scheme_Rational *)o)->num;
    a[1] = ((Scheme_Rational *)p)->num;
    n = scheme_expt(2, a);
    a[0] = ((Scheme_Rational *)o)->denom;
    return make_rational(n, scheme_expt(2, a), 0);
  }

  if (scheme_is_rational_positive(o)) {
    b = scheme_rational_to_double(o);
    e = scheme_rational_to_double(p);

    v = pow(b, e);

#ifdef USE_SINGLE_FLOATS_AS_DEFAULT
    return scheme_make_float(v);
#else
    return scheme_make_double(v);
#endif
  } else {
    return scheme_complex_power(scheme_real_to_complex(o),
                            scheme_real_to_complex(p));
  }
}

Here is the call graph for this function:

Definition at line 458 of file rational.c.

{
  Scheme_Rational *r = (Scheme_Rational *)o;
  Scheme_Object *q, *qd, *delta, *half;
  int more = 0, can_eq_half, negative;

  negative = !scheme_is_rational_positive(o);
  
  q = scheme_bin_quotient(r->num, r->denom);

  /* Get remainder absolute value: */
  qd = scheme_bin_mult(q, r->denom);
  if (negative)
    delta = scheme_bin_minus(qd, r->num);
  else
    delta = scheme_bin_minus(r->num, qd);

  half = scheme_bin_quotient(r->denom, scheme_make_integer(2));
  can_eq_half = SCHEME_FALSEP(scheme_odd_p(1, &r->denom));

  if (SCHEME_INTP(half) && SCHEME_INTP(delta)) {
    if (can_eq_half && (SCHEME_INT_VAL(delta) == SCHEME_INT_VAL(half)))
      more = SCHEME_TRUEP(scheme_odd_p(1, &q));
    else
      more = (SCHEME_INT_VAL(delta) > SCHEME_INT_VAL(half));
  } else if (SCHEME_BIGNUMP(delta) && SCHEME_BIGNUMP(half)) {
    if (can_eq_half && (scheme_bignum_eq(delta, half)))
      more = SCHEME_TRUEP(scheme_odd_p(1, &q));      
    else
      more = !scheme_bignum_lt(delta, half);
  } else
    more = SCHEME_BIGNUMP(delta);

  if (more) {
    if (negative)
      q = scheme_sub1(1, &q);
    else
      q = scheme_add1(1, &q);      
  }

  return q;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 502 of file rational.c.

{
  Scheme_Rational *r = (Scheme_Rational *)o;
  Scheme_Object *n, *d;
  double v;

  n = scheme_integer_sqrt(r->num);
  if (!SCHEME_DBLP(n)) {
    d = scheme_integer_sqrt(r->denom);
    if (!SCHEME_DBLP(d))
      return make_rational(n, d, 0);
  }

  v = sqrt(scheme_rational_to_double(o));

#ifdef USE_SINGLE_FLOATS_AS_DEFAULT
  return scheme_make_float(v);
#else
  return scheme_make_double(v);
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 298 of file rational.c.

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 286 of file rational.c.

Here is the call graph for this function:

Definition at line 429 of file rational.c.

Here is the call graph for this function:

Here is the caller graph for this function:


Variable Documentation

Definition at line 30 of file rational.c.