Commit c75a94c4 authored by antoine lucas's avatar antoine lucas
Browse files

version 0.5-13.5

parent ac08a0e2
......@@ -201,7 +201,10 @@ namespace bigintegerR
if(v.nrow >= 0) {
SEXP nrowAttr = Rf_mkString("nrow");
SEXP nrowValue = Rf_ScalarInteger((int) v.nrow);
PROTECT(nrowAttr);
PROTECT(nrowValue);
Rf_setAttrib(ans, nrowAttr,nrowValue);
UNPROTECT(2);
}
// set the mod attribute
if(v.modulus.size() > 0) {
......@@ -348,9 +351,13 @@ SEXP biginteger_pow (SEXP a, SEXP b) {
if (use_rat) { // a ^ b with some b negative --> rational result
// 1) a := as.bigq(a, 1)
SEXP one = Rf_ScalarInteger(1);
PROTECT(one);
SEXP aq = bigrational_as(a, one);
PROTECT(aq);
// 2) result = <bigq a> ^ b:
return bigrational_pow(aq, b);
SEXP ans = bigrational_pow(aq, b);
UNPROTECT(2);
return ans;
}
}
// else, either, a has a modulus, or (no modulus *and* exp >= 0) :
......@@ -375,7 +382,7 @@ SEXP biginteger_as_character(SEXP a, SEXP b)
{
bigvec v = bigintegerR::create_bignum(a);
SEXP ans;
int base = INTEGER(AS_INTEGER(b))[0];
int base = Rf_asInteger(b);
if (base < 2 || base > 36)
error(_("select a base between 2 and 36"));
......@@ -486,7 +493,7 @@ bigvec bigintegerR::biginteger_get_at_C(bigvec va, SEXP ind)
result.push_back(va[(*it)-1]);
}
else
result.push_back(bigmod()); // NA for out of range's
result.push_back(DefaultBigMod()); // NA for out of range's
}
}
}
......@@ -563,7 +570,7 @@ SEXP biginteger_setlength(SEXP vec, SEXP value)
case LGLSXP:
if (LENGTH(value) != 1)
error(_("invalid second argument"));
len = *INTEGER(value);
len = Rf_asInteger(value);
if (len < 0)
error(_("vector size cannot be negative"));
else if (len == NA_INTEGER)
......@@ -595,7 +602,7 @@ SEXP biginteger_is_na(SEXP a)
bigvec v = bigintegerR::create_bignum(a);
SEXP ans = PROTECT(Rf_allocVector(LGLSXP, v.size()));
for (unsigned int i = 0; i < v.size(); ++i)
LOGICAL(ans)[i] = v[i].value.isNA();
LOGICAL(ans)[i] = v[i].getValue().isNA();
UNPROTECT(1);
return ans;
}
......@@ -607,7 +614,7 @@ SEXP biginteger_sgn(SEXP a)
SEXP ans = PROTECT(Rf_allocVector(INTSXP, v.size()));
int *r = INTEGER(ans);
for (unsigned int i = 0; i < v.size(); ++i)
r[i] = mpz_sgn(v[i].value.getValueTemp());
r[i] = mpz_sgn(v[i].getValue().getValueTemp());
UNPROTECT(1);
return ans;
}
......@@ -647,7 +654,7 @@ SEXP biginteger_rep(SEXP x, SEXP times)
{
bigvec v = bigintegerR::create_bignum(x),
result;
int rep = INTEGER(AS_INTEGER(times))[0];
int rep = Rf_asInteger(times);
result.value.reserve(v.size()*rep);
for(int i = 0 ; i < rep ; i++)
......@@ -667,10 +674,10 @@ SEXP biginteger_is_prime(SEXP a, SEXP reps)
int *r = INTEGER(ans);
if(v.size() == vb.size())
for (i = 0; i < v.size(); ++i)
r[i] = v[i].value.isprime(vb[i]);
r[i] = v[i].getValue().isprime(vb[i]);
else
for (i = 0; i < v.size(); ++i)
r[i] = v[i].value.isprime(vb[0]);
r[i] = v[i].getValue().isprime(vb[0]);
UNPROTECT(1);
return ans;
}
......@@ -687,8 +694,8 @@ SEXP biginteger_nextprime(SEXP a)
mpz_t_sentry val_s(val);
for (unsigned int i = 0; i < v.size(); ++i) {
mpz_nextprime(val,v[i].value.getValueTemp());
result.push_back(bigmod(val));
mpz_nextprime(val,v[i].getValue().getValueTemp());
result.push_back(DefaultBigMod(val));
}
return bigintegerR::create_SEXP(result);
}
......@@ -705,8 +712,8 @@ SEXP biginteger_abs(SEXP a)
for (unsigned int i = 0; i < v.size(); ++i)
{
mpz_abs(val,v[i].value.getValueTemp());
result.push_back(bigmod(val));
mpz_abs(val,v[i].getValue().getValueTemp());
result.push_back(DefaultBigMod(val));
// TODO: understand why following lines don't work.
//result.push_back(bigmod());
......@@ -746,7 +753,7 @@ SEXP biginteger_gcdex(SEXP a, SEXP b)
for(unsigned int i=0; i < va.size(); i++)
{
mpz_gcdext (g,s,t,va[i].value.getValueTemp(),vb[i].value.getValueTemp());
mpz_gcdext (g,s,t,va[i].getValue().getValueTemp(),vb[i].getValue().getValueTemp());
result.value.push_back(biginteger(g)); // Hem... not very elegant !
result.value.push_back(biginteger(s));
result.value.push_back(biginteger(t));
......@@ -780,9 +787,9 @@ SEXP biginteger_rand_u (SEXP nb, SEXP length, SEXP newseed, SEXP ok)
PROTECT (ok = AS_INTEGER(ok));
PROTECT (length = AS_INTEGER(length));
PROTECT (nb = AS_INTEGER(nb));
flag = INTEGER(ok)[0];
len = INTEGER(length)[0];
size = INTEGER(nb)[0];
flag = Rf_asInteger(ok);
len = Rf_asInteger(length);
size = Rf_asInteger(nb);
UNPROTECT(3);
result.value.reserve(size);
......@@ -796,7 +803,7 @@ SEXP biginteger_rand_u (SEXP nb, SEXP length, SEXP newseed, SEXP ok)
}
if(flag == 1)
{
gmp_randseed(seed_state,va[0].value.getValueTemp());
gmp_randseed(seed_state,va[0].getValue().getValueTemp());
Rprintf("Seed initialisation\n");
}
......@@ -809,7 +816,7 @@ SEXP biginteger_rand_u (SEXP nb, SEXP length, SEXP newseed, SEXP ok)
{
/* Random number generation */
mpz_urandomb(bz,seed_state,len);
result.push_back(bigmod(bz));
result.push_back(DefaultBigMod(bz));
}
return bigintegerR::create_SEXP(result);
}
......@@ -822,11 +829,11 @@ SEXP biginteger_rand_u (SEXP nb, SEXP length, SEXP newseed, SEXP ok)
SEXP biginteger_sizeinbase(SEXP x, SEXP base)
{
bigvec vx = bigintegerR::create_bignum(x);
int basesize= INTEGER(AS_INTEGER(base))[0];
int basesize= Rf_asInteger(base);
SEXP ans = PROTECT(Rf_allocVector(INTSXP,vx.size()));
int *r = INTEGER(ans);
for(unsigned int i=0; i < vx.size(); i++)
r[i] = mpz_sizeinbase(vx[i].value.getValueTemp(), basesize);
r[i] = mpz_sizeinbase(vx[i].getValue().getValueTemp(), basesize);
UNPROTECT(1);
return ans;
}
......@@ -838,7 +845,7 @@ SEXP biginteger_sizeinbase(SEXP x, SEXP base)
SEXP bigI_factorial(SEXP n)
{
bigvec result;
int *nn = INTEGER(AS_INTEGER(n)), size = Length(n);
int *nn = INTEGER(AS_INTEGER(n)), size = Rf_length(n);
result.value.resize(size);
for (int i = 0; i < size; ++i) {
result.value[i].NA(false);
......@@ -856,7 +863,7 @@ SEXP bigI_factorial(SEXP n)
SEXP bigI_choose(SEXP n, SEXP k)
{
bigvec result, n_ = bigintegerR::create_bignum(n);
int *kk = INTEGER(AS_INTEGER(k)), n_k = Length(k);
int *kk = INTEGER(AS_INTEGER(k)), n_k = Rf_length(k);
int size = (n_.value.empty() || n_k == 0) ? 0 :
// else: max(n_.value.size(), n_k)
(((int)n_.value.size() <= n_k) ? n_k : n_.value.size());
......@@ -882,9 +889,9 @@ SEXP bigI_choose(SEXP n, SEXP k)
SEXP bigI_fibnum(SEXP n)
{
bigvec result;
if(Length(n) > 0)
if(Rf_length(n) > 0)
{
int nn = INTEGER(AS_INTEGER(n))[0];
int nn = Rf_asInteger(n);
unsigned long int num = nn;
if(nn < 0 || nn == NA_INTEGER)
error(_("argument must be non-negative"));
......@@ -893,7 +900,7 @@ SEXP bigI_fibnum(SEXP n)
mpz_t_sentry val_s(val);
mpz_fib_ui(val,num);
result.push_back(bigmod(val));
result.push_back(DefaultBigMod(val));
// result[0].value.setValue(val);
}
// else
......@@ -909,9 +916,9 @@ SEXP bigI_fibnum(SEXP n)
SEXP bigI_fibnum2(SEXP n)
{
bigvec result;
if(Length(n) > 0)
if(Rf_length(n) > 0)
{
int nn = INTEGER(AS_INTEGER(n))[0];
int nn = Rf_asInteger(n);
unsigned long int num = nn;
if(nn < 0 || nn == NA_INTEGER)
error(_("argument must be non-negative"));
......@@ -924,8 +931,8 @@ SEXP bigI_fibnum2(SEXP n)
mpz_t_sentry val_s2(val2);
mpz_fib2_ui(val,val2, num);
result.push_back(bigmod(val2));
result.push_back(bigmod(val));
result.push_back(DefaultBigMod(val2));
result.push_back(DefaultBigMod(val));
}
else
error(_("argument must not be an empty list"));
......@@ -940,9 +947,9 @@ SEXP bigI_fibnum2(SEXP n)
SEXP bigI_lucnum(SEXP n)
{
bigvec result;
if(Length(n) > 0)
if(Rf_length(n) > 0)
{
int nn = INTEGER(AS_INTEGER(n))[0];
int nn = Rf_asInteger(n);
unsigned long int num = nn;
if(nn < 0 || nn == NA_INTEGER)
error(_("argument must be non-negative"));
......@@ -952,7 +959,7 @@ SEXP bigI_lucnum(SEXP n)
mpz_t_sentry val_s(val);
mpz_lucnum_ui(val,num);
result.push_back(bigmod(val));
result.push_back(DefaultBigMod(val));
}
// else
// error(_("argument must not be an empty list"));
......@@ -968,8 +975,8 @@ SEXP bigI_lucnum2(SEXP n)
{
bigvec result;
if(Length(n) > 0) {
int nn = INTEGER(AS_INTEGER(n))[0];
if(Rf_length(n) > 0) {
int nn = Rf_asInteger(n);
unsigned long int num = nn;
if(nn < 0 || nn == NA_INTEGER)
error(_("argument must be non-negative"));
......@@ -981,8 +988,8 @@ SEXP bigI_lucnum2(SEXP n)
mpz_t_sentry val_s2(val2);
mpz_lucnum2_ui(val,val2,num);
result.push_back(bigmod(val2));
result.push_back(bigmod(val));
result.push_back(DefaultBigMod(val2));
result.push_back(DefaultBigMod(val));
}
else
error(_("argument must not be an empty list"));
......
......@@ -36,57 +36,65 @@ bigmod & bigmod::operator= (const bigmod& rhs)
{
if(this != &rhs)
{
modulus.setValue( rhs.modulus );
modulus.setValue( rhs.getModulus() );
value.setValue(rhs.value );
}
return(*this);
}
bigmod bigmod::inv () const
bigmod & bigmod::inv ()
{
if(value.isNA() || modulus.isNA())
return(bigmod());
if (inverse != NULL){
inverse = NULL;
delete inverse;
}
if(value.isNA() || modulus.isNA()) {
inverse = new DefaultBigMod();
return *inverse;
}
mpz_t val;
mpz_init(val);
mpz_t_sentry val_s(val);
if (mpz_invert(val, value.getValueTemp(), modulus.getValueTemp()) == 0) {
if (mpz_invert(val, getValue().getValueTemp(), getModulus().getValueTemp()) == 0) {
SEXP wOpt = Rf_GetOption1(Rf_install("gmp:warnNoInv"));
if(wOpt != R_NilValue && Rf_asInteger(wOpt))
warning(_("inv(x) returning NA as x has no inverse"));
return(bigmod()); // return NA; was
inverse = new DefaultBigMod();
return *inverse; // return NA; was
}
return bigmod(val, modulus );
inverse = new DefaultBigMod(val, modulus );
return *inverse;
}
bool operator!=(const bigmod& rhs, const bigmod& lhs)
{
if(rhs.value != lhs.value)
if(rhs.getValue() != lhs.getValue())
return(true);
return(rhs.modulus != lhs.modulus);
return(rhs.getModulus() != lhs.getModulus());
}
bool operator==(const bigmod& rhs, const bigmod& lhs)
{
if(rhs.value != lhs.value)
if(rhs.getValue() != lhs.getValue())
return(false);
return(!(rhs.modulus != lhs.modulus));
return(!(rhs.getModulus() != lhs.getModulus()));
}
bigmod operator+(const bigmod& lhs, const bigmod& rhs)
DefaultBigMod operator+(const bigmod& lhs, const bigmod& rhs)
{
return create_bigmod(lhs, rhs, mpz_add);
}
bigmod operator-(const bigmod& lhs, const bigmod& rhs)
DefaultBigMod operator-(const bigmod& lhs, const bigmod& rhs)
{
return create_bigmod(lhs, rhs, mpz_sub);
}
bigmod operator*(const bigmod& lhs, const bigmod& rhs)
DefaultBigMod operator*(const bigmod& lhs, const bigmod& rhs)
{
return create_bigmod(lhs, rhs, mpz_mul);
}
......@@ -96,9 +104,9 @@ bigmod operator*(const bigmod& lhs, const bigmod& rhs)
* ~~~~~~~~~~~~~~
* itself called from "/.bigz" = div.bigz()
*/
bigmod div_via_inv(const bigmod& a, const bigmod& b) {
DefaultBigMod div_via_inv(const bigmod& a, const bigmod& b) {
// compute a/b as a * b^(-1)
return operator*(a, pow(b, bigmod(-1)));
return operator*(a, pow(b, DefaultBigMod(-1)));
}
......@@ -123,123 +131,123 @@ void integer_div(mpz_t result,const mpz_t a, const mpz_t b) {
/* called via biginteger_binary_operation(.) from R's
* .Call(biginteger_divq, a, b) , itself called from '%/%.bigz' = divq.bigz()
*/
bigmod operator/(const bigmod& lhs, const bigmod& rhs) {
DefaultBigMod operator/(const bigmod& lhs, const bigmod& rhs) {
return create_bigmod(lhs, rhs, integer_div, false);
}
bigmod operator%(const bigmod& lhs, const bigmod& rhs)
DefaultBigMod operator%(const bigmod& lhs, const bigmod& rhs)
{
if (lhs.value.isNA() || rhs.value.isNA())
return bigmod();
if (mpz_sgn(rhs.value.getValueTemp()) == 0) {
if (lhs.getValue().isNA() || rhs.getValue().isNA())
return DefaultBigMod();
if (mpz_sgn(rhs.getValue().getValueTemp()) == 0) {
warning(_("biginteger division by zero: returning NA"));
return bigmod();
return DefaultBigMod();
}
biginteger mod;
if (!lhs.modulus.isNA() || !rhs.modulus.isNA())
mod = rhs.value;
if (!lhs.getModulus().isNA() || !rhs.getModulus().isNA())
mod = rhs.getValue();
mpz_t val;
mpz_init(val);
mpz_t_sentry val_s(val);
mpz_mod(val, lhs.value.getValueTemp(), rhs.value.getValueTemp());
return bigmod(val, mod);
mpz_mod(val, lhs.getValue().getValueTemp(), rhs.getValue().getValueTemp());
return DefaultBigMod(val, mod);
}
// Either 'base' has a modulus, or it has not *and* exp >= 0 :
bigmod pow(const bigmod& base, const bigmod& exp)
DefaultBigMod pow(const bigmod& base, const bigmod& exp)
{
biginteger mod = get_modulus(base, exp);
#ifdef DEBUG_bigmod
if(mod.isNA() && !mpz_cmp_si(base.value.getValueTemp(), 1))
Rprintf("bigmod pow(1, exp=%d)\n", mpz_get_si(exp.value.getValueTemp()));
else if(mod.isNA() && !mpz_cmp_si(exp.value.getValueTemp(), 0))
Rprintf("bigmod pow(base=%d, 0)\n", mpz_get_si(base.value.getValueTemp()));
if(mod.isNA() && !mpz_cmp_si(base.getValue().getValueTemp(), 1))
Rprintf("bigmod pow(1, exp=%d)\n", mpz_get_si(exp.getValue().getValueTemp()));
else if(mod.isNA() && !mpz_cmp_si(exp.getValue().getValueTemp(), 0))
Rprintf("bigmod pow(base=%d, 0)\n", mpz_get_si(base.getValue().getValueTemp()));
#endif
// if (base == 1 or exp == 0) return 1
if(mod.isNA() &&
((!base.value.isNA() && !mpz_cmp_si(base.value.getValueTemp(), 1)) ||
(! exp.value.isNA() && !mpz_cmp_si( exp.value.getValueTemp(), 0))))
return bigmod(biginteger(1));
if (base.value.isNA() || exp.value.isNA())
return bigmod();
int sgn_exp = mpz_sgn(exp.value.getValueTemp());
((!base.getValue().isNA() && !mpz_cmp_si(base.getValue().getValueTemp(), 1)) ||
(! exp.getValue().isNA() && !mpz_cmp_si( exp.getValue().getValueTemp(), 0))))
return DefaultBigMod(biginteger(1));
if (base.getValue().isNA() || exp.getValue().isNA())
return DefaultBigMod();
int sgn_exp = mpz_sgn(exp.getValue().getValueTemp());
bool neg_exp = (sgn_exp < 0); // b ^ -|e| = 1 / b^|e|
mpz_t val; mpz_init(val); mpz_t_sentry val_s(val);
#ifdef DEBUG_bigmod
Rprintf("bigmod pow(base=%3s, exp=%3s [mod=%3s]) ..\n",
base.value.str(10).c_str(), exp.value.str(10).c_str(),
base.getValue().str(10).c_str(), exp.getValue().str(10).c_str(),
mod.str(10).c_str());
#endif
if (mod.isNA()) { // <==> (both have no mod || both have mod. but differing)
if(neg_exp) error(_("** internal error (negative powers for Z/nZ), please report!"));
if (!mpz_fits_ulong_p(exp.value.getValueTemp()))
if (!mpz_fits_ulong_p(exp.getValue().getValueTemp()))
error(_("exponent e too large for pow(z,e) = z^e"));// FIXME? return( "Inf" )
// else :
mpz_pow_ui(val, base.value.getValueTemp(),
mpz_get_ui(exp.value.getValueTemp()));
mpz_pow_ui(val, base.getValue().getValueTemp(),
mpz_get_ui(exp.getValue().getValueTemp()));
}
else if( mpz_sgn(mod.getValueTemp()) != 0) { // check modulus non-zero
if(neg_exp) { // negative exponent -- only ok if inverse exists
if (mpz_invert(val, base.value.getValueTemp(), mod.getValueTemp()) == 0) {
if (mpz_invert(val, base.getValue().getValueTemp(), mod.getValueTemp()) == 0) {
SEXP wOpt = Rf_GetOption1(Rf_install("gmp:warnNoInv"));
if(wOpt != R_NilValue && Rf_asInteger(wOpt))
warning(_("pow(x, -|n|) returning NA as x has no inverse wrt modulus"));
return(bigmod()); // return NA; was
return(DefaultBigMod()); // return NA; was
} // else: val = x^(-1) already: ==> result = val ^ |exp| = val ^ (-exp) :
// nExp := - exp
mpz_t nExp; mpz_init(nExp); mpz_neg(nExp, exp.value.getValueTemp());
mpz_t nExp; mpz_init(nExp); mpz_neg(nExp, exp.getValue().getValueTemp());
mpz_powm(val, val, nExp, mod.getValueTemp());
} else { // non-negative exponent
mpz_powm(val, base.value.getValueTemp(), exp.value.getValueTemp(), mod.getValueTemp());
mpz_powm(val, base.getValue().getValueTemp(), exp.getValue().getValueTemp(), mod.getValueTemp());
}
}
return bigmod(val, mod);
return DefaultBigMod(val, mod);
}
bigmod inv(const bigmod& x, const bigmod& m)
DefaultBigMod inv(const bigmod& x, const bigmod& m)
{
if (x.value.isNA() || m.value.isNA())
return bigmod();
if (x.getValue().isNA() || m.getValue().isNA())
return DefaultBigMod();
SEXP wOpt = Rf_GetOption1(Rf_install("gmp:warnNoInv"));
bool warnI = (wOpt != R_NilValue && Rf_asInteger(wOpt));
if (mpz_sgn(m.value.getValueTemp()) == 0) {
if (mpz_sgn(m.getValue().getValueTemp()) == 0) {
if(warnI) warning(_("inv(0) returning NA"));
return bigmod();
return DefaultBigMod();
}
biginteger mod = get_modulus(x, m);
mpz_t val;
mpz_init(val);
mpz_t_sentry val_s(val);
if (mpz_invert(val, x.value.getValueTemp(), m.value.getValueTemp()) == 0) {
if (mpz_invert(val, x.getValue().getValueTemp(), m.getValue().getValueTemp()) == 0) {
if(warnI) warning(_("inv(x,m) returning NA as x has no inverse modulo m"));
return(bigmod()); // return NA; was
return(DefaultBigMod()); // return NA; was
}
return bigmod(val, mod);
return DefaultBigMod(val, mod);
}
// R as.bigz() :
bigmod set_modulus(const bigmod& x, const bigmod& m)
DefaultBigMod set_modulus(const bigmod& x, const bigmod& m)
{
if (!m.value.isNA() && mpz_sgn(m.value.getValueTemp()) == 0)
if (!m.getValue().isNA() && mpz_sgn(m.getValue().getValueTemp()) == 0)
error(_("modulus 0 is invalid"));
// if (!m.value.isNA() && mpz_cmp(x.value.getValueTemp(),m.value.getValueTemp())>=0) {
if (!m.value.isNA() ) {
bigmod t(x%m);
return bigmod(t.value, m.value);
// if (!m.getValue().isNA() && mpz_cmp(x.getValue().getValueTemp(),m.getValue().getValueTemp())>=0) {
if (!m.getValue().isNA() ) {
DefaultBigMod t(x%m);
return DefaultBigMod(t.getValue(), m.getValue());
} else
return bigmod(x.value, m.value);
return DefaultBigMod(x.getValue(), m.getValue());
}
bigmod gcd(const bigmod& lhs, const bigmod& rhs)
DefaultBigMod gcd(const bigmod& lhs, const bigmod& rhs)
{
return create_bigmod(lhs, rhs, mpz_gcd);
}
bigmod lcm(const bigmod& lhs, const bigmod& rhs)
DefaultBigMod lcm(const bigmod& lhs, const bigmod& rhs)
{
return create_bigmod(lhs, rhs, mpz_lcm);
}
......@@ -249,17 +257,17 @@ bigmod lcm(const bigmod& lhs, const bigmod& rhs)
// NA if incompatible.
biginteger get_modulus(const bigmod& b1, const bigmod& b2)
{
if (b1.modulus.isNA()) // NA: means "no modulus" <==> R's is.null(modulus(.))
return b2.modulus; // if b2 is NA too, the return is correct: NA
else if (b2.modulus.isNA())
return b1.modulus;
else if (mpz_cmp(b1.modulus.getValueTemp(), b2.modulus.getValueTemp())) {
if (b1.getModulus().isNA()) // NA: means "no modulus" <==> R's is.null(modulus(.))
return b2.getModulus(); // if b2 is NA too, the return is correct: NA
else if (b2.getModulus().isNA())
return b1.getModulus();
else if (mpz_cmp(b1.getModulus().getValueTemp(), b2.getModulus().getValueTemp())) {
SEXP wOpt = Rf_GetOption1(Rf_install("gmp:warnModMismatch"));
if(wOpt != R_NilValue && Rf_asInteger(wOpt))
warning(_("modulus mismatch in bigz.* arithmetic"));
return biginteger(); // i.e. NA
} else // equal
return b1.modulus;
return b1.getModulus();
}
......@@ -269,19 +277,19 @@ biginteger get_modulus(const bigmod& b1, const bigmod& b2)
// Create a bigmod from a binary combination of two other bigmods
bigmod create_bigmod(const bigmod& lhs, const bigmod& rhs, gmp_binary f,
DefaultBigMod create_bigmod(const bigmod& lhs, const bigmod& rhs, gmp_binary f,
bool zeroRhsAllowed) {
if (lhs.value.isNA() || rhs.value.isNA())
return bigmod();
if (!zeroRhsAllowed && mpz_sgn(rhs.value.getValueTemp()) == 0) {
if (lhs.getValue().isNA() || rhs.getValue().isNA())
return DefaultBigMod();
if (!zeroRhsAllowed && mpz_sgn(rhs.getValue().getValueTemp()) == 0) {
warning(_("returning NA for (modulus) 0 in RHS"));
return bigmod();
return DefaultBigMod();
}
biginteger mod = get_modulus(lhs, rhs);
mpz_t val;
mpz_init(val);
mpz_t_sentry val_s(val);
f(val, lhs.value.getValueTemp(), rhs.value.getValueTemp());
f(val, lhs.getValue().getValueTemp(), rhs.getValue().getValueTemp());
//--- val := f(lhs, rhs)
#ifdef DEBUG_bigmod
bool iNA = biginteger(val).isNA();
......@@ -294,8 +302,8 @@ bigmod create_bigmod(const bigmod& lhs, const bigmod& rhs, gmp_binary f,
mpz_get_str(buf, 10, val);
}
Rprintf("create_bigmod(lhs=%3s, rhs=%3s [mod=%3s]) = %s%s",
lhs.value.str(10).c_str(),
rhs.value.str(10).c_str(),
lhs.getValue().str(10).c_str(),
rhs.getValue().str(10).c_str(),
mod.str(10).c_str(),
(iNA)? "NA" : buf,
(mod.isNA())? "\n" : " {before 'mod'}");
......@@ -311,5 +319,5 @@ bigmod create_bigmod(const bigmod& lhs, const bigmod& rhs, gmp_binary f,
}
#endif
}
return bigmod(val, mod);
return DefaultBigMod(val, mod);
}
......@@ -106,13 +106,17 @@ namespace bigrationalR
if( CHAR(STRING_ELT(param,0)) == "bigz")
return(bigvec_q(bigintegerR::create_bignum(param)) );
*/
lockSexp lock (param);
PROTECT (param);