SEXP R_mpc_div(SEXP e1, SEXP e2) {
/* N.B. We always use signed integers for e2 given R's type system. */
mpc_t *z = (mpc_t *)malloc(sizeof(mpc_t));
if (Rf_inherits(e1, "mpc")) {
mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1);
if (Rf_inherits(e2, "mpc")) {
mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2);
mpc_init2(*z, max(mpc_get_prec(*z1),
mpc_get_prec(*z2)));
mpc_div(*z, *z1, *z2, Rmpc_get_rounding());
} else if (Rf_isInteger(e2)) {
mpc_init2(*z, mpc_get_prec(*z1));
mpc_div_ui(*z, *z1, INTEGER(e2)[0],
Rmpc_get_rounding());
} else if (Rf_isNumeric(e2)) {
mpc_init2(*z, mpc_get_prec(*z1));
mpfr_t x;
mpfr_init2(x, 53);
mpfr_set_d(x, REAL(e2)[0], GMP_RNDN);
mpc_div_fr(*z, *z1, x, Rmpc_get_rounding());
} else {
Rf_error("Invalid second operand for mpc division.");
}
} else if (Rf_isInteger(e1)) {
if (Rf_inherits(e2, "mpc")) {
/* TODO: sign issue here. mpc_ui_div is
* unsigned, mult -1 if needed by asnwer? */
mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2);
mpc_init2(*z, mpc_get_prec(*z2));
mpc_ui_div(*z, INTEGER(e1)[0], *z2,
Rmpc_get_rounding());
} else {
Rf_error("Invalid second operand for mpc division.");
}
} else if (Rf_isNumeric(e1)) {
if (Rf_inherits(e2, "mpc")) {
mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2);
mpfr_t x;
mpfr_init2(x, 53);
mpfr_set_d(x, REAL(e2)[0], GMP_RNDN);
mpc_fr_div(*z, x, *z2, Rmpc_get_rounding());
} else {
Rf_error("Invalid second operand for mpc division.");
}
} else {
Rf_error("Invalid operands for mpc division.");
}
SEXP retVal = PROTECT(R_MakeExternalPtr((void *)z,
Rf_install("mpc ptr"), R_NilValue));
Rf_setAttrib(retVal, R_ClassSymbol, Rf_mkString("mpc"));
R_RegisterCFinalizerEx(retVal, mpcFinalizer, TRUE);
UNPROTECT(1);
return retVal;
}
int
main (void)
{
mpc_t z, x;
mp_prec_t prec;
test_start ();
mpc_init2 (z, 1000);
mpc_init2 (x, 1000);
check_file ("inp_str.dat");
for (prec = 2; prec <= 1000; prec+=7)
{
mpc_set_prec (z, prec);
mpc_set_prec (x, prec);
mpc_set_si_si (x, 1, 1, MPC_RNDNN);
check_io_str (z, x);
mpc_set_si_si (x, -1, 1, MPC_RNDNN);
check_io_str (z, x);
mpfr_set_inf (MPC_RE(x), -1);
mpfr_set_inf (MPC_IM(x), +1);
check_io_str (z, x);
test_default_random (x, -1024, 1024, 128, 25);
check_io_str (z, x);
}
#ifndef NO_STREAM_REDIRECTION
mpc_set_si_si (x, 1, -4, MPC_RNDNN);
mpc_div_ui (x, x, 3, MPC_RNDDU);
check_stdout(z, x);
#endif
mpc_clear (z);
mpc_clear (x);
test_end ();
return 0;
}
mpcomplex operator/(const mpcomplex& a, const long int& b) {
mpc_t value;
mpc_init3( value , a.mpc_prec, a.mpc_prec );
mpc_div_ui(value, a.mpc_val, b, a.default_rnd);
return mpcomplex(value);
}
void Lib_Mpcr_Div_Ui(MpcrPtr f, MpcrPtr g, unsigned int x, long rnd)
{
mpc_div_ui( (mpc_ptr) f, (mpc_ptr) g, x, (mpc_rnd_t) rnd);
}
