void
check_one (mpq_srcptr q, int base, const char *want)
{
char *str, *ret;
size_t str_alloc;
MPQ_CHECK_FORMAT (q);
mp_trace_base = base;
str_alloc =
mpz_sizeinbase (mpq_numref(q), ABS(base)) +
mpz_sizeinbase (mpq_denref(q), ABS(base)) + 3;
str = mpq_get_str (NULL, base, q);
if (strlen(str)+1 > str_alloc)
{
printf ("mpq_get_str size bigger than should be (passing NULL)\n");
printf (" base %d\n", base);
printf (" got size %lu \"%s\"\n", (unsigned long) strlen(str)+1, str);
printf (" want size %lu\n", (unsigned long) str_alloc);
abort ();
}
if (strcmp (str, want) != 0)
{
printf ("mpq_get_str wrong (passing NULL)\n");
printf (" base %d\n", base);
printf (" got \"%s\"\n", str);
printf (" want \"%s\"\n", want);
mpq_trace (" q", q);
abort ();
}
(*__gmp_free_func) (str, strlen (str) + 1);
str = (char *) (*__gmp_allocate_func) (str_alloc);
ret = mpq_get_str (str, base, q);
if (str != ret)
{
printf ("mpq_get_str wrong return value (passing non-NULL)\n");
printf (" base %d\n", base);
printf (" got %p\n", ret);
printf (" want %p\n", want);
abort ();
}
if (strcmp (str, want) != 0)
{
printf ("mpq_get_str wrong (passing non-NULL)\n");
printf (" base %d\n", base);
printf (" got \"%s\"\n", str);
printf (" want \"%s\"\n", want);
abort ();
}
(*__gmp_free_func) (str, str_alloc);
}
void test_unmatch_q(FILE *stream, const char *where, mpq_srcptr a, mpq_srcptr b)
{
char buf[MAX_INFO_SIZE+1];
char stra[MAX_INFO_SIZE+1],strb[MAX_INFO_SIZE+1];
mpq_get_str(stra,10,a);
mpq_get_str(strb,10,b);
strcpy(buf,"Expected is ");
strncat(buf,stra,MAX_INFO_SIZE-strlen(buf));
strcat(buf,", but got ");
strncat(buf,strb,MAX_INFO_SIZE-strlen(buf));
test_error(stream,where,buf);
}
SEXP d2q(SEXP foo)
{
if (! isReal(foo))
error("argument must be real");
int n = LENGTH(foo);
int i;
for (i = 0; i < n; i++)
if (! R_finite(REAL(foo)[i]))
error("argument not finite-valued");
SEXP bar, bark;
PROTECT(bar = allocVector(STRSXP, n));
PROTECT(bark = ATTRIB(foo));
if (bark != R_NilValue)
SET_ATTRIB(bar, duplicate(bark));
UNPROTECT(1);
mpq_t value;
mpq_init(value);
int k;
for (k = 0; k < n; k++) {
double z = REAL(foo)[k];
mpq_set_d(value, z);
char *zstr = NULL;
zstr = mpq_get_str(zstr, 10, value);
SET_STRING_ELT(bar, k, mkChar(zstr));
free(zstr);
}
mpq_clear(value);
UNPROTECT(1);
return(bar);
}
void QQ::elem_text_out(buffer &o,
const ring_elem ap,
bool p_one,
bool p_plus,
bool p_parens) const
{
gmp_QQ a = MPQ_VAL(ap);
char s[1000];
char *str;
bool is_neg = (mpq_sgn(a) == -1);
bool is_one = (mask_mpq_cmp_si(a, 1, 1) == 0 || mask_mpq_cmp_si(a, -1, 1) == 0);
int size = static_cast<int>(mpz_sizeinbase (mpq_numref(a), 10)
+ mpz_sizeinbase (mpq_denref(a), 10) + 3);
char *allocstr = (size > 1000 ? newarray_atomic(char,size) : s);
if (!is_neg && p_plus) o << '+';
if (is_one)
{
if (is_neg) o << '-';
if (p_one) o << '1';
}
else
{
str = mpq_get_str(allocstr, 10, a);
o << str;
}
if (size > 1000) deletearray(allocstr);
}
void test_evaluate(char * in, int numa, int numb, char * out)
{
int ans, pole;
fmpz_poly_q_t op;
mpq_t rop, a;
char *res = NULL;
fmpz_poly_q_init(op);
fmpz_poly_q_set_str(op, in);
mpq_init(a);
flint_mpq_set_si(a, numa, numb);
mpq_init(rop);
pole = fmpz_poly_q_evaluate(rop, op, a);
if (pole && strcmp(out, "P"))
{
flint_printf("test_evaluate: failed\n");
flint_printf(" Expected \"%s\", got a pole\n", out);
abort();
}
if (!pole && !strcmp(out, "P"))
{
res = mpq_get_str(NULL, 10, rop);
flint_printf("test_evaluate: failed\n");
flint_printf(" Expected a pole, got \"%s\"\n", res);
abort();
}
if (!pole)
{
res = mpq_get_str(NULL, 10, rop);
ans = (strcmp(out, res) == 0);
if (!ans)
{
flint_printf("test_evaluate: failed\n");
flint_printf(" Expected \"%s\", got \"%s\"\n", out, res);
abort();
}
}
fmpz_poly_q_clear(op);
mpq_clear(rop);
mpq_clear(a);
flint_free(res);
}
std::string Rational::toString() const
{
// assure the buffer is big enough to store the result
assert( mpz_sizeinbase(mpq_numref(number), 10 ) + mpz_sizeinbase(mpq_denref(number), 10) + 3 < 1024 );
mpq_get_str(buffer, 10, number);
return std::string(buffer);
}
string Rational::ToString() const
{
char* tmp = (char*)malloc(mpz_sizeinbase(mpq_numref(number), 10) +
mpz_sizeinbase(mpq_denref(number), 10) + 3);
char* str = mpq_get_str(tmp, 10, number);
string res(str);
free(str);
return res;
}
ostream&
//operator<< (ostream &o, mpq_srcptr q)
io_write (ostream &o, mpq_srcptr q)
{
// size according to GMP documentation
char *str = new char [mpz_sizeinbase(mpq_numref(q), 10) +
mpz_sizeinbase (mpq_denref(q), 10) + 3];
str = mpq_get_str(str, 10, q);
o << str ;
delete[] str;
return o;
}
static inline void numberToString_impl_conv(sptrObject obj, int radix, std::ostringstream& os){
switch (obj->getType()){
case ObjectDef::ObjectType::INT:{
mpz_class x(static_cast<ObjectDef::Int*>(obj.get())->getVal());
char* ret = mpz_get_str(0, radix, x.get_mpz_t());
os << ret;
free(ret);
}
break;
case ObjectDef::ObjectType::BIGINT:{
char* ret = mpz_get_str(0, radix, static_cast<ObjectDef::BigInt*>(obj.get())->getVal().get_mpz_t());
os << ret;
free(ret);
}
break;
case ObjectDef::ObjectType::RATIONAL:{
char* ret = mpq_get_str(0, radix, static_cast<ObjectDef::Rational*>(obj.get())->getVal().get_mpq_t());
os << ret;
free(ret);
}
break;
case ObjectDef::ObjectType::REAL:{
assert(radix == 10);
mp_exp_t expt;
char* ret = mpf_get_str(0, &expt, 10, 0, static_cast<ObjectDef::Real*>(obj.get())->getVal().get_mpf_t());
if (ret[0] == '\0'){
os << "0e0";
}
else {
unsigned i = 0;
if (ret[0] == '-' || ret[0] == '+') {
os << ret[0];
++i;
}
os << ret[i];
++i;
os << '.' << ret + i << 'e' << expt-1;
}
free(ret);
}
break;
default:
assert(false); //should never be here
}
}
char* rat_gmp_swritee(const mpq_t z, int w)
{
char *n, *s;
int l;
if (w<1)w=1;
s=malloc(w+1);
n=mpq_get_str(NULL, 10, z);
l=strlen(n);
if (l>w){
strncpy(s,n,w);
s[w-1]='*';
s[w]='\0';
}else{
memset(s,' ',w-l);
strncpy(&s[w-l],n,l);
s[w]='\0';
}
free(n);
return s;
}
char *RATIONAL_to_string(mpq_t n, int base)
{
char *str;
int len;
len = mpz_sizeinbase (mpq_numref(n), base) + mpz_sizeinbase(mpq_denref(n), base) + 2;
if (mpq_sgn(n) < 0)
len++;
str = GB.NewString(NULL, len);
memset(str, 0, len);
mpq_get_str(str, -base, n);
while (len > 0 && str[len - 1] == 0)
{
str = GB.ExtendString(str, len - 1);
len--;
}
return str;
}
void Rational::print(wostream& o) const {
char* gbuf = mpq_get_str(0, 10, mpq);
o << gbuf;
(*__gmp_free_func)(gbuf, strlen(gbuf) + 1);
}
SEXP redundant(SEXP m, SEXP h)
{
GetRNGstate();
if (! isString(m))
error("'m' must be character");
if (! isMatrix(m))
error("'m' must be matrix");
if (! isLogical(h))
error("'h' must be logical");
if (LENGTH(h) != 1)
error("'h' must be scalar");
SEXP m_dim;
PROTECT(m_dim = getAttrib(m, R_DimSymbol));
int nrow = INTEGER(m_dim)[0];
int ncol = INTEGER(m_dim)[1];
UNPROTECT(1);
#ifdef WOOF
printf("nrow = %d\n", nrow);
printf("ncol = %d\n", ncol);
#endif /* WOOF */
if (nrow < 2)
error("less than 2 rows, cannot be redundant");
if (ncol <= 2)
error("no cols in m[ , - c(1, 2)]");
for (int i = 0; i < nrow; i++) {
const char *foo = CHAR(STRING_ELT(m, i));
if (strlen(foo) != 1)
error("column one of 'm' not zero-or-one valued");
if (! (foo[0] == '0' || foo[0] == '1'))
error("column one of 'm' not zero-or-one valued");
}
if (! LOGICAL(h)[0])
for (int i = nrow; i < 2 * nrow; i++) {
const char *foo = CHAR(STRING_ELT(m, i));
if (strlen(foo) != 1)
error("column two of 'm' not zero-or-one valued");
if (! (foo[0] == '0' || foo[0] == '1'))
error("column two of 'm' not zero-or-one valued");
}
dd_set_global_constants();
/* note actual type of "value" is mpq_t (defined in cddmp.h) */
mytype value;
dd_init(value);
dd_MatrixPtr mf = dd_CreateMatrix(nrow, ncol - 1);
/* note our matrix has one more column than Fukuda's */
/* representation */
if(LOGICAL(h)[0])
mf->representation = dd_Inequality;
else
mf->representation = dd_Generator;
mf->numbtype = dd_Rational;
/* linearity */
for (int i = 0; i < nrow; i++) {
const char *foo = CHAR(STRING_ELT(m, i));
if (foo[0] == '1')
set_addelem(mf->linset, i + 1);
/* note conversion from zero-origin to one-origin indexing */
}
/* matrix */
for (int j = 1, k = nrow; j < ncol; j++)
for (int i = 0; i < nrow; i++, k++) {
const char *rat_str = CHAR(STRING_ELT(m, k));
if (mpq_set_str(value, rat_str, 10) == -1)
ERROR_WITH_CLEANUP_3("error converting string to GMP rational");
mpq_canonicalize(value);
dd_set(mf->matrix[i][j - 1], value);
/* note our matrix has one more column than Fukuda's */
}
dd_rowset impl_linset, redset;
dd_rowindex newpos;
dd_ErrorType err = dd_NoError;
dd_MatrixCanonicalize(&mf, &impl_linset, &redset, &newpos, &err);
if (err != dd_NoError) {
rr_WriteErrorMessages(err);
ERROR_WITH_CLEANUP_6("failed");
}
int mrow = mf->rowsize;
int mcol = mf->colsize;
if (mcol + 1 != ncol)
ERROR_WITH_CLEANUP_6("Cannot happen! computed matrix has"
" wrong number of columns");
#ifdef WOOF
printf("mrow = %d\n", mrow);
printf("mcol = %d\n", mcol);
#endif /* WOOF */
SEXP bar;
PROTECT(bar = allocMatrix(STRSXP, mrow, ncol));
/* linearity output */
for (int i = 0; i < mrow; i++)
if (set_member(i + 1, mf->linset))
SET_STRING_ELT(bar, i, mkChar("1"));
else
SET_STRING_ELT(bar, i, mkChar("0"));
/* note conversion from zero-origin to one-origin indexing */
/* matrix output */
for (int j = 1, k = mrow; j < ncol; j++)
for (int i = 0; i < mrow; i++, k++) {
dd_set(value, mf->matrix[i][j - 1]);
/* note our matrix has one more column than Fukuda's */
char *zstr = NULL;
zstr = mpq_get_str(zstr, 10, value);
SET_STRING_ELT(bar, k, mkChar(zstr));
free(zstr);
}
if (mf->representation == dd_Inequality) {
SEXP attr_name, attr_value;
PROTECT(attr_name = ScalarString(mkChar("representation")));
PROTECT(attr_value = ScalarString(mkChar("H")));
setAttrib(bar, attr_name, attr_value);
UNPROTECT(2);
}
if (mf->representation == dd_Generator) {
SEXP attr_name, attr_value;
PROTECT(attr_name = ScalarString(mkChar("representation")));
PROTECT(attr_value = ScalarString(mkChar("V")));
setAttrib(bar, attr_name, attr_value);
UNPROTECT(2);
}
int impl_size = set_card(impl_linset);
int red_size = set_card(redset);
int nresult = 1;
int iresult = 1;
SEXP baz = NULL;
if (impl_size > 0) {
PROTECT(baz = rr_set_fwrite(impl_linset));
nresult++;
}
SEXP qux = NULL;
if (red_size > 0) {
PROTECT(qux = rr_set_fwrite(redset));
nresult++;
}
SEXP fred = NULL;
{
PROTECT(fred = allocVector(INTSXP, nrow));
for (int i = 1; i <= nrow; i++)
INTEGER(fred)[i - 1] = newpos[i];
nresult++;
}
#ifdef WOOF
fprintf(stderr, "impl_size = %d\n", impl_size);
fprintf(stderr, "red_size = %d\n", red_size);
fprintf(stderr, "nresult = %d\n", nresult);
if (baz)
fprintf(stderr, "LENGTH(baz) = %d\n", LENGTH(baz));
if (qux)
fprintf(stderr, "LENGTH(qux) = %d\n", LENGTH(qux));
#endif /* WOOF */
SEXP result, resultnames;
PROTECT(result = allocVector(VECSXP, nresult));
PROTECT(resultnames = allocVector(STRSXP, nresult));
SET_STRING_ELT(resultnames, 0, mkChar("output"));
SET_VECTOR_ELT(result, 0, bar);
if (baz) {
SET_STRING_ELT(resultnames, iresult, mkChar("implied.linearity"));
SET_VECTOR_ELT(result, iresult, baz);
iresult++;
}
if (qux) {
SET_STRING_ELT(resultnames, iresult, mkChar("redundant"));
SET_VECTOR_ELT(result, iresult, qux);
iresult++;
}
{
SET_STRING_ELT(resultnames, iresult, mkChar("new.position"));
SET_VECTOR_ELT(result, iresult, fred);
iresult++;
}
namesgets(result, resultnames);
set_free(redset);
set_free(impl_linset);
free(newpos);
dd_FreeMatrix(mf);
dd_clear(value);
dd_free_global_constants();
PutRNGstate();
UNPROTECT(nresult + 2);
return result;
}
static dd_ErrorType FaceEnumHelper(dd_MatrixPtr M, dd_rowset R, dd_rowset S)
{
dd_ErrorType err;
dd_rowset LL, ImL, RR, SS, Lbasis;
dd_rowrange iprev = 0;
dd_colrange dim;
dd_LPSolutionPtr lps = NULL;
set_initialize(&LL, M->rowsize);
set_initialize(&RR, M->rowsize);
set_initialize(&SS, M->rowsize);
set_copy(LL, M->linset);
set_copy(RR, R);
set_copy(SS, S);
/* note actual type of "value" is mpq_t (defined in cddmp.h) */
mytype value;
dd_init(value);
err = dd_NoError;
dd_boolean foo = dd_ExistsRestrictedFace(M, R, S, &err);
if (err != dd_NoError) {
#ifdef MOO
fprintf(stderr, "err from dd_ExistsRestrictedFace\n");
fprintf(stderr, "err = %d\n", err);
#endif /* MOO */
set_free(LL);
set_free(RR);
set_free(SS);
dd_clear(value);
return err;
}
if (foo) {
set_uni(M->linset, M->linset, R);
err = dd_NoError;
dd_FindRelativeInterior(M, &ImL, &Lbasis, &lps, &err);
if (err != dd_NoError) {
#ifdef MOO
fprintf(stderr, "err from dd_FindRelativeInterior\n");
fprintf(stderr, "err = %d\n", err);
#endif /* MOO */
dd_FreeLPSolution(lps);
set_free(ImL);
set_free(Lbasis);
set_free(LL);
set_free(RR);
set_free(SS);
dd_clear(value);
return err;
}
dim = M->colsize - set_card(Lbasis) - 1;
set_uni(M->linset, M->linset, ImL);
SEXP mydim, myactive, myrip;
PROTECT(mydim = ScalarInteger(dim));
PROTECT(myactive = rr_set_fwrite(M->linset));
int myd = (lps->d) - 2;
PROTECT(myrip = allocVector(STRSXP, myd));
for (int j = 1; j <= myd; j++) {
dd_set(value, lps->sol[j]);
char *zstr = NULL;
zstr = mpq_get_str(zstr, 10, value);
SET_STRING_ELT(myrip, j - 1, mkChar(zstr));
free(zstr);
}
REPROTECT(dimlist = CONS(mydim, dimlist), dimidx);
REPROTECT(riplist = CONS(myrip, riplist), ripidx);
REPROTECT(activelist = CONS(myactive, activelist), activeidx);
UNPROTECT(3);
dd_FreeLPSolution(lps);
set_free(ImL);
set_free(Lbasis);
if (dim > 0) {
for (int i = 1; i <= M->rowsize; i++) {
if ((! set_member(i, M->linset)) && (! set_member(i, S))) {
set_addelem(RR, i);
if (iprev) {
set_delelem(RR, iprev);
set_delelem(M->linset, iprev);
set_addelem(SS, iprev);
}
iprev = i;
err = FaceEnumHelper(M, RR, SS);
if (err != dd_NoError) {
#ifdef MOO
fprintf(stderr, "err from FaceEnumHelper\n");
fprintf(stderr, "err = %d\n", err);
#endif /* MOO */
set_copy(M->linset, LL);
set_free(LL);
set_free(RR);
set_free(SS);
dd_clear(value);
return err;
}
}
}
}
}
set_copy(M->linset, LL);
set_free(LL);
set_free(RR);
set_free(SS);
dd_clear(value);
return dd_NoError;
}
SEXP qmatmult(SEXP foo, SEXP bar)
{
if ((! isString(foo)) || (! isString(bar)))
error("arguments must be character");
if ((! isMatrix(foo)) || (! isMatrix(bar)))
error("arguments must be matrices");
SEXP dim;
PROTECT(dim = getAttrib(foo, R_DimSymbol));
int nrow_foo = INTEGER(dim)[0];
int ncol_foo = INTEGER(dim)[1];
UNPROTECT(1);
PROTECT(dim = getAttrib(bar, R_DimSymbol));
int nrow_bar = INTEGER(dim)[0];
int ncol_bar = INTEGER(dim)[1];
UNPROTECT(1);
if (nrow_foo <= 0)
error("row dimension of 1st arg must be positive");
if (ncol_foo <= 0)
error("col dimension of 1st arg must be positive");
if (nrow_bar <= 0)
error("row dimension of 2nd arg must be positive");
if (ncol_bar <= 0)
error("col dimension of 2nd arg must be positive");
if (ncol_foo != nrow_bar)
error("col dimension of 1st arg must match row dimension of 2nd arg");
SEXP baz;
PROTECT(baz = allocMatrix(STRSXP, nrow_foo, ncol_bar));
mpq_t value1, value2, value3;
mpq_init(value1);
mpq_init(value2);
mpq_init(value3);
for (int i = 0; i < nrow_foo; ++i) {
for (int j = 0; j < ncol_bar; ++j) {
mpq_set_si(value3, 0, 1);
for (int k = 0; k < ncol_foo; ++k) {
const char *foo_ik = CHAR(STRING_ELT(foo, i + nrow_foo * k));
const char *bar_kj = CHAR(STRING_ELT(bar, k + nrow_bar * j));
if (mpq_set_str(value1, foo_ik, 10) == -1) {
mpq_clear(value1);
mpq_clear(value2);
mpq_clear(value3);
error("error converting string to GMP rational");
}
mpq_canonicalize(value1);
if (mpq_set_str(value2, bar_kj, 10) == -1) {
mpq_clear(value1);
mpq_clear(value2);
mpq_clear(value3);
error("error converting string to GMP rational");
}
mpq_canonicalize(value2);
mpq_mul(value2, value1, value2);
mpq_add(value3, value3, value2);
}
char *baz_ij = mpq_get_str(NULL, 10, value3);
SET_STRING_ELT(baz, i + nrow_foo * j, mkChar(baz_ij));
free(baz_ij);
}
}
mpq_clear(value1);
mpq_clear(value2);
mpq_clear(value3);
UNPROTECT(1);
return(baz);
}
char * Lib_Mpq_Get_Str(char * str , int32_t b, MpqPtr x)
{
return mpq_get_str(str ,b, (mpq_ptr) x);
}
