static int
my_main (int argc, char **argv)
{
setlocale (LC_ALL, "");
int rows = atoi (argv[1]);
int cols = atoi (argv[2]);
mpq_t A[rows][cols];
mpq_t B[rows][cols];
mpq_matrix_init (rows, cols, A);
mpq_matrix_init (rows, cols, B);
unsigned int i_argv = 3;
for (unsigned int i = 0; i < rows; i++)
for (unsigned int j = 0; j < cols; j++)
{
mpq_set_str (A[i][j], argv[i_argv], 0);
mpq_canonicalize (A[i][j]);
i_argv++;
}
for (unsigned int i = 0; i < rows; i++)
for (unsigned int j = 0; j < cols; j++)
{
mpq_set_str (B[i][j], argv[i_argv], 0);
mpq_canonicalize (B[i][j]);
i_argv++;
}
mpq_matrix_div_elements (rows, cols, A, B);
for (unsigned int i = 0; i < rows; i++)
{
for (unsigned int j = 0; j < cols; j++)
gmp_printf (" %Qd", A[i][j]);
printf (" |");
}
printf (" *** |");
for (unsigned int i = 0; i < rows; i++)
{
for (unsigned int j = 0; j < cols; j++)
gmp_printf (" %Qd", B[i][j]);
printf (" |");
}
mpq_matrix_clear (rows, cols, A);
mpq_matrix_clear (rows, cols, B);
return 0;
}
inline Mtbdd
readMPQAttribute(const TiXmlNode* node, const char* att)
{
const std::string numberString = readStringAttribute(node, att);
mpq_t gmp_value;
mpq_init(gmp_value);
try {
size_t pos = 0;
if ((pos = numberString.find('.')) != std::string::npos) {
mpf_t f_value;
mpf_init(f_value);
mpf_set_str(f_value, numberString.c_str(), 10);
mpq_set_f(gmp_value, f_value);
mpf_clear(f_value);
} else {
mpq_set_str(gmp_value, numberString.c_str(), 10);
}
if (mpq_sgn(gmp_value) == 0) {
mpq_clear(gmp_value);
return mtbdd_false;
}
MTBDD res = mtbdd_gmp(gmp_value);
mpq_clear(gmp_value);
return res;
} catch(boost::bad_lexical_cast&) {
throw ParseError("[ERROR] String " + numberString + " is not a number");
}
}
SEXP qsign(SEXP foo)
{
if (! isString(foo))
error("argument must be character");
int n = LENGTH(foo);
SEXP bar, bark;
PROTECT(bar = allocVector(INTSXP, n));
PROTECT(bark = ATTRIB(foo));
if (bark != R_NilValue)
SET_ATTRIB(bar, duplicate(bark));
UNPROTECT(1);
mpq_t value;
mpq_init(value);
for (int k = 0; k < n; k++) {
const char *zstr = CHAR(STRING_ELT(foo, k));
if (mpq_set_str(value, zstr, 10) == -1) {
mpq_clear(value);
error("error converting string to GMP rational");
}
mpq_canonicalize(value);
INTEGER(bar)[k] = mpq_sgn(value);
}
mpq_clear(value);
UNPROTECT(1);
return(bar);
}
/* if it does not fit here, it doesn't fit in a double either */
void gmp_str2mpq(mpq_t value, const char* num)
{
char tmp[1024];
int i;
int k = 0;
int exponent = 0;
int fraction = 0;
assert(num != NULL);
assert(strlen(num) < 32);
/* printf("%s ", num); */
/* Skip initial whitespace
*/
while(isspace(*num))
num++;
/* Skip initial +/-
*/
if (*num == '+')
num++;
else if (*num == '-')
tmp[k++] = *num++;
for(i = 0; num[i] != '\0'; i++)
{
if (isdigit(num[i]))
{
tmp[k++] = num[i];
exponent -= fraction;
}
else if (num[i] == '.')
fraction = 1;
else if (tolower(num[i]) == 'e')
{
exponent += atoi(&num[i + 1]);
break;
}
}
while(exponent > 0)
{
tmp[k++] = '0';
exponent--;
}
tmp[k++] = '/';
tmp[k++] = '1';
while(exponent < 0)
{
tmp[k++] = '0';
exponent++;
}
tmp[k] = '\0';
/* printf("%s\n", tmp);*/
mpq_set_str(value, tmp, 10);
mpq_canonicalize(value);
}
void
check_one (mpq_srcptr want, int base, const char *str)
{
mpq_t got;
MPQ_CHECK_FORMAT (want);
mp_trace_base = base;
mpq_init (got);
if (mpq_set_str (got, str, base) != 0)
{
printf ("mpq_set_str unexpectedly failed\n");
printf (" base %d\n", base);
printf (" str \"%s\"\n", str);
abort ();
}
MPQ_CHECK_FORMAT (got);
if (! mpq_equal (got, want))
{
printf ("mpq_set_str wrong\n");
printf (" base %d\n", base);
printf (" str \"%s\"\n", str);
mpq_trace ("got ", got);
mpq_trace ("want", want);
abort ();
}
mpq_clear (got);
}
Rational::Rational(const string& num)
{
mpq_init(number);
mpq_set_str(number, num.c_str(), 10);
#ifdef TRACE_OUTPUT
UpdateNumberStr();
#endif
}
void
mpq_set_str_or_abort (mpq_ptr q, const char *str, int base)
{
if (mpq_set_str (q, str, base) != 0)
{
fprintf (stderr, "ERROR: mpq_set_str failed\n");
fprintf (stderr, " str = \"%s\"\n", str);
fprintf (stderr, " base = %d\n", base);
abort();
}
}
void Rational::fromString(const char* num)
{
char* tmp = &buffer[0];
int k = 0;
int exponent = 0;
int fraction = 0;
assert(num != NULL);
assert(strlen(num) < 32);
// Skip initial whitespace
while(isspace(*num))
num++;
// Skip initial +/-
if (*num == '+')
num++;
else if (*num == '-')
tmp[k++] = *num++;
for(int i = 0; num[i] != '\0'; i++)
{
if (isdigit(num[i]))
{
tmp[k++] = num[i];
exponent -= fraction;
}
else if (num[i] == '.')
fraction = 1;
else if (tolower(num[i]) == 'e')
{
exponent += atoi(&num[i + 1]);
break;
}
}
while(exponent > 0)
{
tmp[k++] = '0';
exponent--;
}
tmp[k++] = '/';
tmp[k++] = '1';
while(exponent < 0)
{
tmp[k++] = '0';
exponent++;
}
tmp[k] = '\0';
mpq_set_str(number, tmp, 10);
mpq_canonicalize(number);
}
FastRational::FastRational( const char * s, const int base )
{
mpq_init(mpq);
mpq_set_str(mpq, s, base);
mpq_canonicalize( mpq );
has_mpq = true;
make_word( );
if ( has_word )
kill_mpq( );
assert( isWellFormed( ) );
}
/**
* lisp_create_type for rational, using the string parser
* (to be able to represent arbitrary precision). This
* is the preferred interface
*/
lv_t *lisp_create_rational_str(char *value) {
double v = 0;
int flag;
lv_t *new_value = lisp_create_type(NULL, l_rational);
/* now parse the string */
flag = mpq_set_str(L_RAT(new_value), value, 10);
assert(!flag);
mpq_canonicalize(L_RAT(new_value));
return new_value;
}
CRATIONAL *RATIONAL_from_string(char *str, int base)
{
mpq_t n;
mpq_init(n);
if (mpq_set_str(n, str, base))
{
mpq_clear(n);
return NULL;
}
else
{
mpq_canonicalize(n);
return RATIONAL_create(n);
}
}
void generate_random_rational(rational_complex_number x)
/***************************************************************\
* USAGE: generate a random rational number of unit modulus *
\***************************************************************/
{
int base = 10;
char *str = NULL;
mpq_t t, t_sqr;
mpq_init(t);
mpq_init(t_sqr);
// generate a random number
create_random_number_str(&str);
mpq_set_str(t, str, base);
mpq_canonicalize(t);
// compute t_sqr = t^2
mpq_mul(t_sqr, t, t);
// compute denominator
mpq_set_ui(x->im, 1, 1);
mpq_add(x->im, x->im, t_sqr); // 1 + t^2
// compute numerator
mpq_set_ui(x->re, 1, 1);
mpq_sub(x->re, x->re, t_sqr); // 1 - t^2
// divide to compute real part
mpq_div(x->re, x->re, x->im);
// compute imaginary part
mpq_set_ui(x->im, 1, 1);
mpq_add(x->im, x->re, x->im); // 1 + x->re
mpq_mul(x->im, x->im, t); // t*(1+x->re)
// clear memory
mpq_clear(t);
mpq_clear(t_sqr);
free(str);
return;
}
Rational& Rational::operator=(const string& source)
{
if (source.find(L'.') != -1)
{
string intPart, fractPart;
int i = 0;
while (i < (int)source.length() && source[i] != '.')
{
intPart += source[i];
++i;
}
++i;
while (i < (int)source.length())
{
fractPart += source[i];
++i;
}
if (fractPart != "")
{
int n = fractPart.length();
string t("1");
for (int j = 0; j < n; ++j)
t += '0';
*this = Rational(fractPart) / Rational(t) + Rational(intPart);
return *this;
}
}
mpq_set_str(number, source.c_str(), DEFAULT_BASE);
#ifdef TRACE_OUTPUT
UpdateNumberStr();
#endif
return *this;
}
int mpq_inp_wstr10(mpq_t rop, FILE* in) {
char* buf = malloc(sizeof(char));
size_t len = 1;
wint_t c;
for(;;) {
c = fgetwc(in);
if(!(iswdigit(c) || (len == 1 && c == L'-') || (c == L'/')))
break;
len++;
buf = realloc(buf, sizeof(char) * len);
buf[len - 2] = wctob(c);
}
buf[len - 1] = '\0';
ungetwc(c, in);
int n = mpq_set_str(rop, buf, 10);
free(buf);
return n;
}
static int
my_main (int argc, char **argv)
{
setlocale (LC_ALL, "");
int rows = atoi (argv[1]);
int cols = atoi (argv[2]);
int j1 = atoi (argv[3]);
int j2 = atoi (argv[4]);
mpq_t A[rows][cols];
mpq_matrix_init (rows, cols, A);
unsigned int i_argv = 5;
for (unsigned int i = 0; i < rows; i++)
for (unsigned int j = 0; j < cols; j++)
{
mpq_set_str (A[i][j], argv[i_argv], 0);
mpq_canonicalize (A[i][j]);
i_argv++;
}
mpq_matrix_swap_columns (rows, cols, A, j1, j2);
for (unsigned int i = 0; i < rows; i++)
{
for (unsigned int j = 0; j < cols; j++)
gmp_printf (" %Qd", A[i][j]);
printf (" |");
}
mpq_matrix_clear (rows, cols, A);
return 0;
}
int square_newton_real_map_test(polynomial_system *F)
/***************************************************************\
* USAGE: determine if N_F is a real map where F is square *
\***************************************************************/
{
int i, retVal, isReal = 1, numVars = F->numVariables, base = 10, *rowswaps = NULL;
char *str = NULL;
mpq_t scale;
rational_complex_number r;
rational_complex_vector x, y;
rational_complex_matrix LU;
if (F->numVariables != F->numPolynomials)
{
printf("\nERROR: The polynomial must be square!\n");
errExit(ERROR_INVALID_SIZE);
}
mpq_init(scale);
initialize_rational_number(r);
initialize_rational_vector(x, numVars);
initialize_rational_vector(y, numVars);
initialize_rational_matrix(LU, numVars, numVars);
// generate a random rational real vector x
generate_random_real_rational_vector(x, numVars);
// generate a random rational number in [-1,1]
create_random_number_str(&str);
mpq_set_str(scale, str, base);
mpq_canonicalize(scale);
// scale x
for (i = 0; i < numVars; i++)
multiply_rational_number(x->coord[i], x->coord[i], scale);
// compute a newton iteration for x
retVal = newton_iteration_rational(y, r, LU, &rowswaps, F, x);
if (retVal)
{ // Jacobian is rank deficient for random point
printf("\nERROR: The Jacobian is rank deficient at a random point!\n");
errExit(ERROR_INPUT_SYSTEM);
}
// determine the imaginary parts are zero
mpq_set_ui(scale, 0, 1);
for (i = 0; i < numVars && isReal; i++)
{
if (!mpq_equal(y->coord[i]->im, scale))
isReal = 0;
}
// clear memory
free(str);
str = NULL;
free(rowswaps);
rowswaps = NULL;
mpq_clear(scale);
clear_rational_number(r);
clear_rational_vector(x);
clear_rational_vector(y);
clear_rational_matrix(LU);
return isReal;
}
SEXP impliedLinearity(SEXP m, SEXP h)
{
GetRNGstate();
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");
if (! isString(m))
error("'m' must be character");
SEXP m_dim;
PROTECT(m_dim = getAttrib(m, R_DimSymbol));
int nrow = INTEGER(m_dim)[0];
int ncol = INTEGER(m_dim)[1];
UNPROTECT(1);
if (nrow <= 1)
error("no use if only one row");
if (ncol <= 3)
error("no use if only one col");
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) {
dd_FreeMatrix(mf);
dd_clear(value);
dd_free_global_constants();
error("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_ErrorType err = dd_NoError;
dd_rowset out = dd_ImplicitLinearityRows(mf, &err);
if (err != dd_NoError) {
rr_WriteErrorMessages(err);
set_free(out);
dd_FreeMatrix(mf);
dd_clear(value);
dd_free_global_constants();
error("failed");
}
SEXP foo;
PROTECT(foo = rr_set_fwrite(out));
set_free(out);
dd_FreeMatrix(mf);
dd_clear(value);
dd_free_global_constants();
PutRNGstate();
UNPROTECT(1);
return foo;
}
/*!
* Test most of the functions that can be applied to the \c chv_t.
*
* Illustrates how the concept is used.
*/
int
test_chv(int little_endian_flag)
{
chv_t chv;
int8_t c = +123;
uint8_t uc = -123;
int16_t s = +12345;
uint16_t us = -12345;
int i = +1234567890;
uint ui = -1234567890;
int64_t ll = 0x0011223344556677LL;
uint64_t ull = 0x7766554433221100ULL;
size_t sz = UINT32_MAX;
float f = 1/3.0f;
double d = 1/3.0;
const char *cstr = "pelle";
char *cstr1 = NULL;
#ifdef HAVE_GMP_H
mpz_t mpz; mpz_init_set_str(mpz, "012345657890123456578901234565789012345657890123456578901234565789", 10);
mpq_t mpq; mpq_init(mpq); mpq_set_str(mpq, "3/5", 10);
#endif
printf("%d %u %d %u %d %u %lld %llu %zu %g %g ",
c, uc, s, us, i, ui, ll, ull, sz, f, d);
printf("%s ", cstr);
mpz_out_str (stdout, 10, mpz); printf(" ");
mpq_out_str (stdout, 10, mpq); printf(" ");
endline();
chv_init(&chv);
if (little_endian_flag) {
chv_enc_s8(&chv, &c); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_u8(&chv, &uc); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_s16le(&chv, &s); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_u16le(&chv, &us); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_s32le(&chv, &i); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_u32le(&chv, &ui); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_s64le(&chv, &ll); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_u64le(&chv, &ull); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_sizele(&chv, &sz); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_f32le(&chv, &f); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_f64le(&chv, &d); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_cstr_lengthU32le(&chv, cstr); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
} else {
chv_enc_s8(&chv, &c); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_u8(&chv, &uc); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_s16be(&chv, &s); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_u16be(&chv, &us); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_s32be(&chv, &i); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_u32be(&chv, &ui); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_s64be(&chv, &ll); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_u64be(&chv, &ull); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_sizebe(&chv, &sz); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_f32be(&chv, &f); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_f64be(&chv, &d); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_enc_cstr_lengthU32be(&chv, cstr); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
}
#ifdef HAVE_GMP_H
chv_enc_mpz(&chv, mpz, little_endian_flag);
chv_enc_mpq(&chv, mpq, little_endian_flag);
#endif
chv_save(&chv, "chv_test.bin"); // save to file
// reset variables
c = 0; uc = 0;
s = 0; us = 0;
i = 0; ui = 0;
ll = 0; ull = 0;
f = 0; d = 0;
cstr = NULL;
cstr1 = NULL;
mpz_clear(mpz);
mpq_clear(mpq);
// allocate variables
mpz_init(mpz);
mpq_init(mpq);
chv_load(&chv, "chv_test.bin"); // load from file
if (little_endian_flag) {
chv_dec_s8(&chv, &c); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_u8(&chv, &uc); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_s16le(&chv, &s); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_u16le(&chv, &us); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_s32le(&chv, &i); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_u32le(&chv, &ui); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_s64le(&chv, &ll); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_u64le(&chv, &ull); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_sizele(&chv, &sz); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_f32le(&chv, &f); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_f64le(&chv, &d); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_cstr_lengthU32le(&chv, &cstr1); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
} else {
chv_dec_s8(&chv, &c); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_u8(&chv, &uc); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_s16be(&chv, &s); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_u16be(&chv, &us); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_s32be(&chv, &i); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_u32be(&chv, &ui); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_s64be(&chv, &ll); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_u64be(&chv, &ull); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_sizebe(&chv, &sz); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_f32be(&chv, &f); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_f64be(&chv, &d); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
chv_dec_cstr_lengthU32be(&chv, &cstr1); chv_fprint_x_quoted_chars(stdout, &chv); printf("\n");
}
#ifdef HAVE_GMP_H
chv_dec_mpz(&chv, mpz, little_endian_flag);
chv_dec_mpq(&chv, mpq, little_endian_flag);
#endif
printf("%d %u %d %u %d %u %lld %llu %zu %g %g ",
c, uc, s, us, i, ui, ll, ull, sz, f, d);
printf("%s ", cstr1);
mpz_out_str(stdout, 10, mpz); printf(" ");
mpq_out_str(stdout, 10, mpq); printf(" ");
endline();
free(cstr1);
mpz_clear(mpz);
mpq_clear(mpq);
chv_clear(&chv);
printf("\n");
return 0;
}
void rat_gmp_string_2_rat(mpq_t z, const char* s)
{
mpq_set_str(z,s,10);
mpq_canonicalize(z);
}
void _ston(struct ls_object *obj, const char *num, int defradix)
{
char *dup = strdup(num), *ptr = dup;
char *end;
char saved;
int exactness = -1, radix = -1;
int flag, flag2, type, allowre = 1, allowim = 1;
struct ls_real re = { 0, { 0 } };
/* prefix */
while (*ptr == '#') {
ptr++;
switch (*ptr) {
case 'i':
case 'e':
if (exactness == -1)
exactness = ((*ptr == 'i')? 0: 1);
else
goto err;
ptr++;
break;
case 'b':
case 'o':
case 'd':
case 'x':
if (radix == -1)
radix = ((*ptr == 'b')? 2:
(*ptr == 'o')? 8:
(*ptr == 'd')? 10: 16);
else
goto err;
ptr++;
break;
default:
goto err;
}
}
if (radix == -1)
radix = defradix;
restart:
/* default to big integer */
type = 1;
/* parsing */
flag = _ston_parse_real(ptr, &end, radix);
if (!(flag & stonf_valid))
goto err;
if (*end == '/') {
type = 2;
flag2 = _ston_parse_real(end + 1, &end, radix);
/* sanity for rational */
if (!(flag2 & stonf_valid))
goto err;
if ((flag & stonf_decimal) ||
(flag2 & stonf_signed) ||
(flag2 & stonf_decimal))
goto err;
}
if (flag & stonf_decimal)
type = 3;
if ((*end == 'i' && allowim == 0) ||
(*end != 'i' && allowre == 0))
goto err;
/* generating initial result */
if ((*end == 'i' && (flag & stonf_iunit))) {
type = 0;
if (!(flag & stonf_signed))
goto err;
if (*ptr == '+')
re.v = 1;
else
re.v = -1;
}
saved = *end;
*end = '\0';
/* no _re_clear can be called from now until the content is fully set up */
re.type = type;
if (*ptr == '+') /* tackle around strange behavior of mpx_set_str */
ptr++;
switch (re.type) {
case 1:
re.z = (mpz_t *) ls_malloc(sizeof *re.z);
mpz_init(*re.z);
mpz_set_str(*re.z, ptr, radix);
break;
case 2:
re.q = (mpq_t *) ls_malloc(sizeof *re.q);
mpq_init(*re.q);
mpq_set_str(*re.q, ptr, radix);
break;
case 3:
if (exactness == 1) {
/*
* unfortunately, #e<decimal> has to be handled here manually,
* the result inexact->exact is normally not acceptable
*/
re.type = 2;
re.q = (mpq_t *) ls_malloc(sizeof *re.q);
mpq_init(*re.q);
_lsrt_mpq_set_decimal(*re.q, ptr, radix);
} else {
re.f = (mpf_t *) ls_malloc(sizeof *re.f);
/*
* TODO: gmp only guarantees that result prec is no lower
* than specified, check R5RS requirement
*/
if (flag & stonf_prec_mask)
mpf_init2(*re.f, flag & stonf_prec_mask);
else
mpf_init(*re.f);
mpf_set_str(*re.f, ptr, radix);
}
break;
}
*end = saved;
/* canonicalize and transform */
if (exactness == 0 ||
((flag & stonf_pound) && exactness != 1))
_re_promote(&re, 3, 0);
_re_canonicalize(&re);
/* store */
if (*end == 'i') {
if (!(flag & stonf_signed)) /* imaginary must be signed */
goto err;
allowim = 0;
_re_update_lso_im(obj, &re);
end++;
} else {
allowre = 0;
_re_update_lso_re(obj, &re);
}
if (*end) {
ptr = end;
goto restart;
}
free(dup);
return;
err:
free(dup);
_re_clear(&re);
lso_set_type(obj, ls_t_boolean);
obj->u1.val = 0;
}
int main() {
int32_t x, y;
uint32_t a, b, n;
char c;
string_buffer_t *s;
s = &buffer;
init_string_buffer(s, 0);
show_test("empty buffer", s);
string_buffer_reset(s);
for (c = 'a'; c <= 'z'; c++) {
string_buffer_append_char(s, c);
}
show_test("alphabet", s);
string_buffer_reset(s);
for (c = 'a'; c <= 'z'; c++) {
string_buffer_append_char(s, c);
}
string_buffer_append_string(s, "au898ue2bcc90219");
show_test("alphabet+au898ue2bcc90219", s);
x = INT32_MIN;
for (;;){
sprintf(aux, "signed number: %" PRId32, x);
string_buffer_reset(s);
string_buffer_append_int32(s, x);
show_test(aux, s);
y = x >> 1;
if (y == x) break;
x = y;
}
x = INT32_MAX;
for (;;) {
sprintf(aux, "signed number: %" PRId32, x);
string_buffer_reset(s);
string_buffer_append_int32(s, x);
show_test(aux, s);
y = x>>1;
if (y == x) break;
x = y;
}
a = UINT32_MAX;
for (;;){
sprintf(aux, "unsigned number: %" PRIu32, a);
string_buffer_reset(s);
string_buffer_append_uint32(s, a);
show_test(aux, s);
b = a >> 1;
if (b == a) break;
a = b;
}
mpz_init(z0);
mpz_init(z1);
mpq_init(q0);
mpz_set_str(z0, "111102222033330123456789", 10);
string_buffer_reset(s);
string_buffer_append_mpz(s, z0);
show_test("mpz: 111102222033330123456789", s);
mpz_set_str(z0, "-111102222033330123456789", 10);
string_buffer_reset(s);
string_buffer_append_mpz(s, z0);
show_test("mpz: -111102222033330123456789", s);
string_buffer_reset(s);
string_buffer_append_mpz(s, z1);
show_test("mpz: 0", s);
mpq_set_str(q0, "-98765432109876543210", 10);
string_buffer_reset(s);
string_buffer_append_mpq(s, q0);
show_test("mpq: -98765432109876543210", s);
mpq_set_str(q0, "-98765432109876543210/38192839777", 10);
string_buffer_reset(s);
string_buffer_append_mpq(s, q0);
show_test("mpq: -98765432109876543210/38192839777", s);
init_rationals();
rational_t r0;
q_init(&r0);
string_buffer_reset(s);
string_buffer_append_rational(s, &r0);
show_test("rational: 0", s);
q_set_int32(&r0, -12, 73);
string_buffer_reset(s);
string_buffer_append_rational(s, &r0);
show_test("rational: -12/73", s);
q_set_mpq(&r0, q0);
string_buffer_reset(s);
string_buffer_append_rational(s, &r0);
show_test("rational: -98765432109876543210/38192839777", s);
q_set_mpz(&r0, z0);
string_buffer_reset(s);
string_buffer_append_rational(s, &r0);
show_test("rational: -111102222033330123456789", s);
printf("\nBit Vectors\n");
init_bvconstants();
bv0 = bvconst_alloc(1);
bvconst_clear(bv0, 1);
for (n=1; n<= 32; n++) {
string_buffer_reset(s);
string_buffer_append_bvconst(s, bv0, n);
sprintf(aux, "bv[%" PRIu32"]: 0b000...", n);
show_test(aux, s);
}
for (n=1; n <= 32; n++) {
bvconst_clear(bv0, 1);
bvconst_set_bit(bv0, n-1);
string_buffer_reset(s);
string_buffer_append_bvconst(s, bv0, n);
sprintf(aux, "bv[%" PRIu32"]: 0b100...", n);
show_test(aux, s);
}
bvconst_free(bv0, 1);
cleanup_bvconstants();
cleanup_rationals();
mpz_clear(z0);
mpz_clear(z1);
mpq_clear(q0);
delete_string_buffer(s);
return 0;
}
int square_conj_map_test(polynomial_system *F)
/***************************************************************\
* USAGE: determine if F is invariant under conjugation *
\***************************************************************/
{
int i, j, found = 0, isReal = 1, numVars = F->numVariables, base = 10;
char *str = NULL;
mpq_t scale;
rational_complex_vector x, func1, func2;
if (F->numVariables != F->numPolynomials)
{
printf("\nERROR: The polynomial must be square!\n");
errExit(ERROR_INVALID_SIZE);
}
mpq_init(scale);
initialize_rational_vector(x, numVars);
initialize_rational_vector(func1, numVars);
initialize_rational_vector(func2, numVars);
// generate a random rational real vector x
generate_random_real_rational_vector(x, numVars);
// generate a random rational number in [-1,1]
create_random_number_str(&str);
mpq_set_str(scale, str, base);
mpq_canonicalize(scale);
// scale x
for (i = 0; i < numVars; i++)
multiply_rational_number(x->coord[i], x->coord[i], scale);
// evaluate F at x
eval_polynomial_system_only_rational(func1, F, x);
// conjugate func1
conjugate_rational_vector(func2, func1);
// determine if, as sets, func1 == func2
isReal = 1;
for (i = 0; i < numVars && isReal; i++)
{ // determine if func1[i] is in func2
found = 0;
for (j = 0; j < numVars && !found; j++)
if (mpq_equal(func1->coord[i]->re, func2->coord[j]->re) && mpq_equal(func1->coord[i]->im, func2->coord[j]->im))
found = 1;
if (!found)
isReal = 0;
}
free(str);
str = NULL;
mpq_clear(scale);
clear_rational_vector(x);
clear_rational_vector(func1);
clear_rational_vector(func2);
return isReal;
}
static int
my_main (int argc, char **argv)
{
setlocale (LC_ALL, "");
scm_dynwind_begin (0);
CBLAS_SIDE_t Side = side_func (argv[1]);
CBLAS_UPLO_t Uplo = uplo_func (argv[2]);
CBLAS_TRANSPOSE_t TransA = trans_func (argv[3]);
CBLAS_DIAG_t Diag = diag_func (argv[4]);
int m = atoi (argv[5]);
int n = atoi (argv[6]);
mpq_t alpha;
mpq_init (alpha);
scm_dynwind_mpq_clear (alpha);
mpq_set_str (alpha, argv[7], 0);
mpq_canonicalize (alpha);
int k = (Side == CblasLeft) ? m : n;
mpq_t A[k][k];
mpq_matrix_init (k, k, A);
scm_dynwind_mpq_matrix_clear (k, k, A);
mpq_t B[m][n];
mpq_matrix_init (m, n, B);
scm_dynwind_mpq_matrix_clear (m, n, B);
double A1[k][k];
double B1[m][n];
gsl_matrix_view mA1 = gsl_matrix_view_array (&A1[0][0], k, k);
gsl_matrix_view mB1 = gsl_matrix_view_array (&B1[0][0], m, n);
unsigned int i_argv = 8;
for (unsigned int i = 0; i < k; i++)
for (unsigned int j = 0; j < k; j++)
{
mpq_set_str (A[i][j], argv[i_argv], 0);
mpq_canonicalize (A[i][j]);
A1[i][j] = mpq_get_d (A[i][j]);
i_argv++;
}
for (unsigned int i = 0; i < m; i++)
for (unsigned int j = 0; j < n; j++)
{
mpq_set_str (B[i][j], argv[i_argv], 0);
mpq_canonicalize (B[i][j]);
B1[i][j] = mpq_get_d (B[i][j]);
i_argv++;
}
mpq_matrix_trmm (Side, Uplo, TransA, Diag, m, n, alpha, A, B);
gsl_blas_dtrmm (Side, Uplo, TransA, Diag, mpq_get_d (alpha), &mA1.matrix,
&mB1.matrix);
int exit_status = 0;
// Check that we get the same results as gsl_blas_dtrmm.
for (unsigned int i = 0; i < m; i++)
for (unsigned int j = 0; j < n; j++)
{
gmp_printf ("B[%u][%u] = %lf\t%Qd\n", i, j, B1[i][j], B[i][j]);
if (10000 * DBL_EPSILON < fabs (mpq_get_d (B[i][j]) - B1[i][j]))
exit_status = 1;
}
scm_dynwind_end ();
return exit_status;
}
void generate_random_real_rational_vector(rational_complex_vector x, int size)
/***************************************************************\
* USAGE: generate a random real rational vector of unit length *
\***************************************************************/
{
// set x to the correct size & set to zero
change_size_rational_vector(x, size);
set_zero_rational_vector(x);
if (size == 1)
{ // setup x to either 1 or -1
mpq_set_si(x->coord[0]->re, rand() % 2 ? 1 : -1, 1);
}
else if (size > 1)
{ // setup x to real unit vector
int i, base = 10;
char *str = NULL;
mpq_t sum_sqr, *t = (mpq_t *)errMalloc((size - 1) * sizeof(mpq_t)), *t_sqr = (mpq_t *)errMalloc((size - 1) * sizeof(mpq_t));
// initialize and set to random numbers
mpq_init(sum_sqr);
mpq_set_ui(sum_sqr, 0, 1);
for (i = 0; i < size - 1; i++)
{
mpq_init(t[i]);
mpq_init(t_sqr[i]);
create_random_number_str(&str);
mpq_set_str(t[i], str, base);
mpq_canonicalize(t[i]);
mpq_mul(t_sqr[i], t[i], t[i]);
mpq_add(sum_sqr, sum_sqr, t_sqr[i]);
}
// setup the first entry
mpq_set_ui(x->coord[0]->re, 1, 1);
mpq_add(x->coord[0]->im, x->coord[0]->re, sum_sqr); // 1 + sum(t^2)
mpq_sub(sum_sqr, x->coord[0]->re, sum_sqr); // 1 - sum(t^2)
mpq_div(x->coord[0]->re, sum_sqr, x->coord[0]->im); // (1 - sum(t^2)) / (1 + sum(t^2))
mpq_set_ui(x->coord[0]->im, 0, 1);
// compute x[0] + 1
mpq_set_ui(sum_sqr, 1, 1);
mpq_add(sum_sqr, sum_sqr, x->coord[0]->re);
// setup other entries: t[i] * (x[0] + 1)
for (i = 1; i < size; i++)
mpq_mul(x->coord[i]->re, t[i-1], sum_sqr);
// clear memory
mpq_clear(sum_sqr);
for (i = 0; i < size - 1; i++)
{
mpq_clear(t[i]);
mpq_clear(t_sqr[i]);
}
free(t);
free(t_sqr);
free(str);
}
return;
}
void test_rat_approx()
{
const char *list[][7] = {
{"3","8/3","2","3","8/3"},
{"3","11/4","2","3","11/4"},
{"4","4999/10000","0","1/2","2499/4999","4999/10000"},
{"4","4999/9997","0","1","1/2","4999/9997"},
{"5","523/311","1","2","5/3","37/22","523/311"}
};
int n = sizeof(list)/sizeof(list[0]);
int correct = 0;
test_info(stderr,"Start testing rat_approx.");
for(int i = 0; i < n; i++)
{
mpq_t *l, *res, c;
unsigned int t = atoi(list[i][0]), tt;
l = (mpq_t *)malloc(sizeof(mpq_t)*t);
res = (mpq_t *)malloc(sizeof(mpq_t)*t);
for(int j = 0; j < t; j++)
{
mpq_init(l[j]);
mpq_set_str(l[j],list[i][j+2],10);
mpq_init(res[j]);
}
mpq_init(c);
mpq_set_str(c,list[i][1],10);
tt = t;
cpt_rat_approx(res,c,&tt);
if(t != tt)
{
test_error(stderr,"test_rat_approx","number different");
test_unmatch_ui(stderr,"test_rat_approx",t,tt);
}
else
{
int nerr = 0;
for(int j = 0; j < t; j++)
{
if(!mpq_equal(l[j],res[j]))
{
test_error(stderr,"test_rat_approx","result different");
test_unmatch_q(stderr,"test_rat_approx",l[j],res[j]);
nerr++;
}
}
if(!nerr)
{
correct++;
}
}
for(int j = 0; j < t; j++)
{
mpq_clear(l[j]);
mpq_clear(res[j]);
}
mpq_clear(c);
free(l);
free(res);
}
if(correct == n)
test_info(stderr,"test_rat_approx success.");
else
test_info(stderr,"test_rat_approx failed.");
}
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;
}
istream &
//operator>> (istream &i, mpq_ptr q)
io_read (istream &i, mpq_ptr q)
{
int base;
char c = 0;
string s;
bool ok = false, zero, showbase;
i.get(c); // start reading
if (i.flags() & ios::skipws) // skip initial whitespace
while (isspace(c) && i.get(c))
;
if (c == '-' || c == '+') // sign
{
if (c == '-')
s = "-";
i.get(c);
}
while (isspace(c) && i.get(c)) // skip whitespace
;
base = __gmp_istream_set_base(i, c, zero, showbase); // select the base
__gmp_istream_set_digits(s, i, c, ok, base); // read the numerator
if (! ok && zero) // the only digit read was "0"
{
base = 10;
s += '0';
ok = true;
}
if (i.flags() & ios::skipws)
while (isspace(c) && i.get(c)) // skip whitespace
;
if (c == '/') // there's a denominator
{
bool zero2 = false;
int base2 = base;
s += '/';
ok = false; // denominator is mandatory
i.get(c);
while (isspace(c) && i.get(c)) // skip whitespace
;
if (showbase) // check base of denominator
base2 = __gmp_istream_set_base(i, c, zero2, showbase);
if (base2 == base || base2 == 10) // read the denominator
__gmp_istream_set_digits(s, i, c, ok, base);
if (! ok && zero2) // the only digit read was "0"
{ // denominator is 0, but that's your business
s += '0';
ok = true;
}
}
if (i.good()) // last character read was non-numeric
i.putback(c);
else if (i.eof() && ok) // stopped just before eof
i.clear();
if (ok)
mpq_set_str(q, s.c_str(), base); // extract the number
else
i.setstate(ios::failbit); // read failed
return i;
}
SEXP allfaces(SEXP hrep)
{
GetRNGstate();
if (! isMatrix(hrep))
error("'hrep' must be matrix");
if (! isString(hrep))
error("'hrep' must be character");
SEXP hrep_dim;
PROTECT(hrep_dim = getAttrib(hrep, R_DimSymbol));
int nrow = INTEGER(hrep_dim)[0];
int ncol = INTEGER(hrep_dim)[1];
UNPROTECT(1);
if (nrow <= 0)
error("no rows in 'hrep'");
if (ncol <= 3)
error("three or fewer cols in hrep");
for (int i = 0; i < nrow; ++i) {
const char *foo = CHAR(STRING_ELT(hrep, i));
if (strlen(foo) != 1)
error("column one of 'hrep' not zero-or-one valued");
if (! (foo[0] == '0' || foo[0] == '1'))
error("column one of 'hrep' 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 */
mf->representation = dd_Inequality;
mf->numbtype = dd_Rational;
/* linearity */
for (int i = 0; i < nrow; ++i) {
const char *foo = CHAR(STRING_ELT(hrep, 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(hrep, k));
if (mpq_set_str(value, rat_str, 10) == -1) {
dd_FreeMatrix(mf);
dd_clear(value);
dd_free_global_constants();
error("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 */
}
SEXP result;
PROTECT(result = FaceEnum(mf));
dd_FreeMatrix(mf);
dd_clear(value);
dd_free_global_constants();
if (result == R_NilValue)
error("failed");
PutRNGstate();
UNPROTECT(1);
return result;
}
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);
}
int
_fmpq_poly_set_str(fmpz * poly, fmpz_t den, const char * str)
{
char * w;
long i, len;
mpq_t * a;
len = atol(str);
if (len < 0)
return -1;
if (len == 0)
{
fmpz_set_ui(den, 1);
return 0;
}
a = (mpq_t *) malloc(len * sizeof(mpq_t));
while (*str++ != ' ') ;
/* Find maximal gap between spaces and allocate w */
{
const char * s = str;
long max;
for (max = 0; *s != '\0';)
{
long cur;
for (s++, cur = 1; *s != ' ' && *s != '\0'; s++, cur++) ;
if (max < cur)
max = cur;
}
w = (char *) malloc((max + 1) * sizeof(char));
}
for (i = 0; i < len; i++)
{
char * v;
int ans;
for (str++, v = w; *str != ' ' && *str != '\0';)
*v++ = *str++;
*v = '\0';
mpq_init(a[i]);
ans = mpq_set_str(a[i], w, 10);
/* If the format is not correct, clear up and return -1 */
if (ans)
{
int j;
for (j = 0; j <= i; j++)
mpq_clear(a[j]);
free(a);
free(w);
return -1;
}
}
_fmpq_poly_set_array_mpq(poly, den, (const mpq_t *) a, len);
for (i = 0; i < len; i++)
mpq_clear(a[i]);
free(a);
free(w);
return 0;
}
