/*
* call-seq:
* -cmp -> complex
*
* Returns negation of the value.
*
* -Complex(1, 2) #=> (-1-2i)
*/
static VALUE
nucomp_negate(VALUE self)
{
get_dat1(self);
return f_complex_new2(CLASS_OF(self),
f_negate(dat->real), f_negate(dat->imag));
}
inline static VALUE
f_gcd(VALUE x, VALUE y)
{
VALUE z;
if (FIXNUM_P(x) && FIXNUM_P(y))
return LONG2NUM(i_gcd(FIX2LONG(x), FIX2LONG(y)));
if (f_negative_p(x))
x = f_negate(x);
if (f_negative_p(y))
y = f_negate(y);
if (f_zero_p(x))
return y;
if (f_zero_p(y))
return x;
for (;;) {
if (FIXNUM_P(x)) {
if (FIX2LONG(x) == 0)
return y;
if (FIXNUM_P(y))
return LONG2NUM(i_gcd(FIX2LONG(x), FIX2LONG(y)));
}
z = x;
x = f_mod(y, x);
y = z;
}
/* NOTREACHED */
}
static VALUE
nurat_s_new_bang(int argc, VALUE *argv, VALUE klass)
{
VALUE num, den;
switch (rb_scan_args(argc, argv, "11", &num, &den)) {
case 1:
if (!k_integer_p(num))
num = f_to_i(num);
den = ONE;
break;
default:
if (!k_integer_p(num))
num = f_to_i(num);
if (!k_integer_p(den))
den = f_to_i(den);
switch (FIX2INT(f_cmp(den, ZERO))) {
case -1:
num = f_negate(num);
den = f_negate(den);
break;
case 0:
rb_raise_zerodiv();
break;
}
break;
}
return nurat_s_new_internal(klass, num, den);
}
inline static VALUE
nurat_s_canonicalize_internal(VALUE klass, VALUE num, VALUE den)
{
VALUE gcd;
switch (FIX2INT(f_cmp(den, ZERO))) {
case -1:
num = f_negate(num);
den = f_negate(den);
break;
case 0:
rb_raise_zerodiv();
break;
}
gcd = f_gcd(num, den);
num = f_idiv(num, gcd);
den = f_idiv(den, gcd);
#ifdef CANON
if (f_one_p(den) && canonicalization)
return num;
#endif
return nurat_s_new_internal(klass, num, den);
}
/*
* call-seq:
* rat.to_i -> integer
*
* Returns the truncated value as an integer.
*
* Equivalent to
* rat.truncate.
*
* For example:
*
* Rational(2, 3).to_i #=> 0
* Rational(3).to_i #=> 3
* Rational(300.6).to_i #=> 300
* Rational(98,71).to_i #=> 1
* Rational(-30,2).to_i #=> -15
*/
static VALUE
nurat_truncate(VALUE self, SEL sel)
{
get_dat1(self);
if (f_negative_p(dat->num))
return f_negate(f_idiv(f_negate(dat->num), dat->den));
return f_idiv(dat->num, dat->den);
}
inline static VALUE
f_divide(VALUE self, VALUE other,
VALUE (*func)(VALUE, VALUE), ID id)
{
if (k_complex_p(other)) {
int flo;
get_dat2(self, other);
flo = (k_float_p(adat->real) || k_float_p(adat->imag) ||
k_float_p(bdat->real) || k_float_p(bdat->imag));
if (f_gt_p(f_abs(bdat->real), f_abs(bdat->imag))) {
VALUE r, n;
r = (*func)(bdat->imag, bdat->real);
n = f_mul(bdat->real, f_add(ONE, f_mul(r, r)));
if (flo)
return f_complex_new2(CLASS_OF(self),
(*func)(self, n),
(*func)(f_negate(f_mul(self, r)), n));
return f_complex_new2(CLASS_OF(self),
(*func)(f_add(adat->real,
f_mul(adat->imag, r)), n),
(*func)(f_sub(adat->imag,
f_mul(adat->real, r)), n));
}
else {
VALUE r, n;
r = (*func)(bdat->real, bdat->imag);
n = f_mul(bdat->imag, f_add(ONE, f_mul(r, r)));
if (flo)
return f_complex_new2(CLASS_OF(self),
(*func)(f_mul(self, r), n),
(*func)(f_negate(self), n));
return f_complex_new2(CLASS_OF(self),
(*func)(f_add(f_mul(adat->real, r),
adat->imag), n),
(*func)(f_sub(f_mul(adat->imag, r),
adat->real), n));
}
}
if (k_numeric_p(other) && f_real_p(other)) {
get_dat1(self);
return f_complex_new2(CLASS_OF(self),
(*func)(dat->real, other),
(*func)(dat->imag, other));
}
return rb_num_coerce_bin(self, other, id);
}
static VALUE
nurat_abs(VALUE self)
{
if (f_positive_p(self))
return self;
return f_negate(self);
}
static VALUE
nurat_abs(VALUE self)
{
if (!f_negative_p(self))
return self;
else
return f_negate(self);
}
/*
* call-seq:
* rat ** numeric -> numeric_result
*
* Performs exponentiation.
*
* For example:
*
* Rational(2) ** Rational(3) #=> (8/1)
* Rational(10) ** -2 #=> (1/100)
* Rational(10) ** -2.0 #=> 0.01
* Rational(-4) ** Rational(1,2) #=> (1.2246063538223773e-16+2.0i)
* Rational(1, 2) ** 0 #=> (1/1)
* Rational(1, 2) ** 0.0 #=> 1.0
*/
static VALUE
nurat_expt(VALUE self, SEL sel, VALUE other)
{
if (k_exact_zero_p(other))
return f_rational_new_bang1(CLASS_OF(self), ONE);
if (k_rational_p(other)) {
get_dat1(other);
if (f_one_p(dat->den))
other = dat->num; /* c14n */
}
switch (TYPE(other)) {
case T_FIXNUM:
{
VALUE num, den;
get_dat1(self);
switch (FIX2INT(f_cmp(other, ZERO))) {
case 1:
num = f_expt(dat->num, other);
den = f_expt(dat->den, other);
break;
case -1:
num = f_expt(dat->den, f_negate(other));
den = f_expt(dat->num, f_negate(other));
break;
default:
num = ONE;
den = ONE;
break;
}
return f_rational_new2(CLASS_OF(self), num, den);
}
case T_BIGNUM:
rb_warn("in a**b, b may be too big");
/* fall through */
case T_FLOAT:
case T_RATIONAL:
return f_expt(f_to_f(self), other);
default:
return rb_num_coerce_bin(self, other, id_expt);
}
}
static VALUE
nurat_to_f(VALUE self)
{
VALUE num, den;
int minus = 0;
long nl, dl, ml, ne, de;
int e;
double f;
{
get_dat1(self);
if (f_zero_p(dat->num))
return rb_float_new(0.0);
num = dat->num;
den = dat->den;
}
if (f_negative_p(num)) {
num = f_negate(num);
minus = 1;
}
nl = i_ilog2(num);
dl = i_ilog2(den);
ml = (long)(log(DBL_MAX) / log(2.0) - 1); /* should be a static */
ne = 0;
if (nl > ml) {
ne = nl - ml;
num = f_rshift(num, LONG2NUM(ne));
}
de = 0;
if (dl > ml) {
de = dl - ml;
den = f_rshift(den, LONG2NUM(de));
}
e = (int)(ne - de);
if ((e > DBL_MAX_EXP) || (e < DBL_MIN_EXP)) {
rb_warning("%s out of Float range", rb_obj_classname(self));
return rb_float_new(e > 0 ? HUGE_VAL : 0.0);
}
f = NUM2DBL(num) / NUM2DBL(den);
if (minus)
f = -f;
f = ldexp(f, e);
if (isinf(f) || isnan(f))
rb_warning("%s out of Float range", rb_obj_classname(self));
return rb_float_new(f);
}
inline static VALUE
nurat_s_canonicalize_internal_no_reduce(VALUE klass, VALUE num, VALUE den)
{
switch (FIX2INT(f_cmp(den, ZERO))) {
case -1:
num = f_negate(num);
den = f_negate(den);
break;
case 0:
rb_raise(rb_eZeroDivError, "devided by zero");
break;
}
if (f_equal_p(den, ONE) && f_unify_p(klass))
return num;
else
return nurat_s_new_internal(klass, num, den);
}
static VALUE
nurat_round(VALUE self)
{
get_dat1(self);
if (f_negative_p(dat->num)) {
VALUE num, den;
num = f_negate(dat->num);
num = f_add(f_mul(num, TWO), dat->den);
den = f_mul(dat->den, TWO);
return f_negate(f_idiv(num, den));
}
else {
VALUE num = f_add(f_mul(dat->num, TWO), dat->den);
VALUE den = f_mul(dat->den, TWO);
return f_idiv(num, den);
}
}
static VALUE
f_complex_polar(VALUE klass, VALUE x, VALUE y)
{
assert(!k_complex_p(x));
assert(!k_complex_p(y));
if (f_zero_p(x) || f_zero_p(y)) {
if (canonicalization) return x;
return nucomp_s_new_internal(klass, x, RFLOAT_0);
}
if (RB_FLOAT_TYPE_P(y)) {
const double arg = RFLOAT_VALUE(y);
if (arg == M_PI) {
x = f_negate(x);
if (canonicalization) return x;
y = RFLOAT_0;
}
else if (arg == M_PI_2) {
y = x;
x = RFLOAT_0;
}
else if (arg == M_PI_2+M_PI) {
y = f_negate(x);
x = RFLOAT_0;
}
else if (RB_FLOAT_TYPE_P(x)) {
const double abs = RFLOAT_VALUE(x);
const double real = abs * cos(arg), imag = abs * sin(arg);
x = DBL2NUM(real);
if (canonicalization && imag == 0.0) return x;
y = DBL2NUM(imag);
}
else {
x = f_mul(x, DBL2NUM(cos(arg)));
y = f_mul(y, DBL2NUM(sin(arg)));
if (canonicalization && f_zero_p(y)) return x;
}
return nucomp_s_new_internal(klass, x, y);
}
return nucomp_s_canonicalize_internal(klass,
f_mul(x, m_cos(y)),
f_mul(x, m_sin(y)));
}
inline static VALUE
f_muldiv(VALUE self, VALUE anum, VALUE aden, VALUE bnum, VALUE bden, int k)
{
VALUE num, den;
if (k == '/') {
VALUE t;
if (f_negative_p(bnum)) {
anum = f_negate(anum);
bnum = f_negate(bnum);
}
t = bnum;
bnum = bden;
bden = t;
}
if (FIXNUM_P(anum) && FIXNUM_P(aden) &&
FIXNUM_P(bnum) && FIXNUM_P(bden)) {
long an = FIX2LONG(anum);
long ad = FIX2LONG(aden);
long bn = FIX2LONG(bnum);
long bd = FIX2LONG(bden);
long g1 = i_gcd(an, bd);
long g2 = i_gcd(ad, bn);
num = f_imul(an / g1, bn / g2);
den = f_imul(ad / g2, bd / g1);
}
else {
VALUE g1 = f_gcd(anum, bden);
VALUE g2 = f_gcd(aden, bnum);
num = f_mul(f_idiv(anum, g1), f_idiv(bnum, g2));
den = f_mul(f_idiv(aden, g2), f_idiv(bden, g1));
}
return f_rational_new_no_reduce2(CLASS_OF(self), num, den);
}
static VALUE
m_cos(VALUE x)
{
if (f_real_p(x))
return m_cos_bang(x);
{
get_dat1(x);
return f_complex_new2(rb_cComplex,
f_mul(m_cos_bang(dat->real),
m_cosh_bang(dat->imag)),
f_mul(f_negate(m_sin_bang(dat->real)),
m_sinh_bang(dat->imag)));
}
}
static VALUE
nurat_round(VALUE self, SEL sel)
{
VALUE num, den, neg;
get_dat1(self);
num = dat->num;
den = dat->den;
neg = f_negative_p(num);
if (neg)
num = f_negate(num);
num = f_add(f_mul(num, TWO), den);
den = f_mul(den, TWO);
num = f_idiv(num, den);
if (neg)
num = f_negate(num);
return num;
}
inline static VALUE
nurat_s_canonicalize_internal(VALUE klass, VALUE num, VALUE den)
{
VALUE gcd;
switch (FIX2INT(f_cmp(den, ZERO))) {
case -1:
num = f_negate(num);
den = f_negate(den);
break;
case 0:
rb_raise(rb_eZeroDivError, "devided by zero");
break;
}
gcd = f_gcd(num, den);
num = f_idiv(num, gcd);
den = f_idiv(den, gcd);
if (f_one_p(den) && f_unify_p(klass))
return num;
else
return nurat_s_new_internal(klass, num, den);
}
static VALUE
m_sqrt(VALUE x)
{
if (f_real_p(x)) {
if (f_positive_p(x))
return m_sqrt_bang(x);
return f_complex_new2(rb_cComplex, ZERO, m_sqrt_bang(f_negate(x)));
}
else {
get_dat1(x);
if (f_negative_p(dat->imag))
return f_conj(m_sqrt(f_conj(x)));
else {
VALUE a = f_abs(x);
return f_complex_new2(rb_cComplex,
m_sqrt_bang(f_div(f_add(a, dat->real), TWO)),
m_sqrt_bang(f_div(f_sub(a, dat->real), TWO)));
}
}
}
static VALUE
string_to_r_internal(VALUE self)
{
VALUE s, m;
s = self;
if (RSTRING_LEN(s) == 0)
return rb_assoc_new(Qnil, self);
m = f_match(rat_pat, s);
if (!NIL_P(m)) {
VALUE v, ifp, exp, ip, fp;
VALUE si = f_aref(m, INT2FIX(1));
VALUE nu = f_aref(m, INT2FIX(2));
VALUE de = f_aref(m, INT2FIX(3));
VALUE re = f_post_match(m);
{
VALUE a;
a = f_split(nu, an_e_pat);
ifp = RARRAY_PTR(a)[0];
if (RARRAY_LEN(a) != 2)
exp = Qnil;
else
exp = RARRAY_PTR(a)[1];
a = f_split(ifp, a_dot_pat);
ip = RARRAY_PTR(a)[0];
if (RARRAY_LEN(a) != 2)
fp = Qnil;
else
fp = RARRAY_PTR(a)[1];
}
v = rb_rational_new1(f_to_i(ip));
if (!NIL_P(fp)) {
char *p = StringValuePtr(fp);
long count = 0;
VALUE l;
while (*p) {
if (rb_isdigit(*p))
count++;
p++;
}
l = f_expt(INT2FIX(10), LONG2NUM(count));
v = f_mul(v, l);
v = f_add(v, f_to_i(fp));
v = f_div(v, l);
}
if (!NIL_P(si) && *StringValuePtr(si) == '-')
v = f_negate(v);
if (!NIL_P(exp))
v = f_mul(v, f_expt(INT2FIX(10), f_to_i(exp)));
#if 0
if (!NIL_P(de) && (!NIL_P(fp) || !NIL_P(exp)))
return rb_assoc_new(v, rb_usascii_str_new2("dummy"));
#endif
if (!NIL_P(de))
v = f_div(v, f_to_i(de));
return rb_assoc_new(v, re);
}
return rb_assoc_new(Qnil, self);
}
void s_gridNDIM::negate()
{
FortranRegion Fthis(this->region());
f_negate(FORTRAN_DATA(*this),FORTRAN_REGIONNDIM(Fthis));
};
static VALUE
nurat_ceil(VALUE self, SEL sel)
{
get_dat1(self);
return f_negate(f_idiv(f_negate(dat->num), dat->den));
}
/*
* call-seq:
* cmp ** numeric -> complex
*
* Performs exponentiation.
*
* Complex('i') ** 2 #=> (-1+0i)
* Complex(-8) ** Rational(1, 3) #=> (1.0000000000000002+1.7320508075688772i)
*/
static VALUE
nucomp_expt(VALUE self, VALUE other)
{
if (k_numeric_p(other) && k_exact_zero_p(other))
return f_complex_new_bang1(CLASS_OF(self), ONE);
if (k_rational_p(other) && f_one_p(f_denominator(other)))
other = f_numerator(other); /* c14n */
if (k_complex_p(other)) {
get_dat1(other);
if (k_exact_zero_p(dat->imag))
other = dat->real; /* c14n */
}
if (k_complex_p(other)) {
VALUE r, theta, nr, ntheta;
get_dat1(other);
r = f_abs(self);
theta = f_arg(self);
nr = m_exp_bang(f_sub(f_mul(dat->real, m_log_bang(r)),
f_mul(dat->imag, theta)));
ntheta = f_add(f_mul(theta, dat->real),
f_mul(dat->imag, m_log_bang(r)));
return f_complex_polar(CLASS_OF(self), nr, ntheta);
}
if (k_fixnum_p(other)) {
if (f_gt_p(other, ZERO)) {
VALUE x, z;
long n;
x = self;
z = x;
n = FIX2LONG(other) - 1;
while (n) {
long q, r;
while (1) {
get_dat1(x);
q = n / 2;
r = n % 2;
if (r)
break;
x = nucomp_s_new_internal(CLASS_OF(self),
f_sub(f_mul(dat->real, dat->real),
f_mul(dat->imag, dat->imag)),
f_mul(f_mul(TWO, dat->real), dat->imag));
n = q;
}
z = f_mul(z, x);
n--;
}
return z;
}
return f_expt(f_reciprocal(self), f_negate(other));
}
if (k_numeric_p(other) && f_real_p(other)) {
VALUE r, theta;
if (k_bignum_p(other))
rb_warn("in a**b, b may be too big");
r = f_abs(self);
theta = f_arg(self);
return f_complex_polar(CLASS_OF(self), f_expt(r, other),
f_mul(theta, other));
}
return rb_num_coerce_bin(self, other, id_expt);
}
static VALUE
nucomp_expt(VALUE self, VALUE other)
{
if (k_exact_p(other) && f_zero_p(other))
return f_complex_new_bang1(CLASS_OF(self), ONE);
if (k_rational_p(other) && f_one_p(f_denominator(other)))
other = f_numerator(other); /* good? */
if (k_complex_p(other)) {
VALUE a, r, theta, ore, oim, nr, ntheta;
get_dat1(other);
a = f_polar(self);
r = RARRAY_PTR(a)[0];
theta = RARRAY_PTR(a)[1];
ore = dat->real;
oim = dat->imag;
nr = m_exp_bang(f_sub(f_mul(ore, m_log_bang(r)),
f_mul(oim, theta)));
ntheta = f_add(f_mul(theta, ore), f_mul(oim, m_log_bang(r)));
return f_complex_polar(CLASS_OF(self), nr, ntheta);
}
if (k_integer_p(other)) {
if (f_gt_p(other, ZERO)) {
VALUE x, z, n;
x = self;
z = x;
n = f_sub(other, ONE);
while (f_nonzero_p(n)) {
VALUE a;
while (a = f_divmod(n, TWO),
f_zero_p(RARRAY_PTR(a)[1])) {
get_dat1(x);
x = f_complex_new2(CLASS_OF(self),
f_sub(f_mul(dat->real, dat->real),
f_mul(dat->imag, dat->imag)),
f_mul(f_mul(TWO, dat->real), dat->imag));
n = RARRAY_PTR(a)[0];
}
z = f_mul(z, x);
n = f_sub(n, ONE);
}
return z;
}
return f_expt(f_div(f_to_r(ONE), self), f_negate(other));
}
if (k_numeric_p(other) && f_real_p(other)) {
VALUE a, r, theta;
a = f_polar(self);
r = RARRAY_PTR(a)[0];
theta = RARRAY_PTR(a)[1];
return f_complex_polar(CLASS_OF(self), f_expt(r, other),
f_mul(theta, other));
}
return rb_num_coerce_bin(self, other, id_expt);
}
