/****************************************************************************
**
*F SCTableProduct( <table>, <list1>, <list2> ) . product wrt structure table
**
** 'SCTableProduct' returns the product of the two elements <list1> and
** <list2> with respect to the structure constants table <table>.
*/
void SCTableProdAdd (
Obj res,
Obj coeff,
Obj basis_coeffs,
Int dim )
{
Obj basis;
Obj coeffs;
Int len;
Obj k;
Obj c1, c2;
Int l;
basis = ELM_LIST( basis_coeffs, 1 );
coeffs = ELM_LIST( basis_coeffs, 2 );
len = LEN_LIST( basis );
if ( LEN_LIST( coeffs ) != len ) {
ErrorQuit("SCTableProduct: corrupted <table>",0L,0L);
}
for ( l = 1; l <= len; l++ ) {
k = ELM_LIST( basis, l );
if ( ! IS_INTOBJ(k) || INT_INTOBJ(k) <= 0 || dim < INT_INTOBJ(k) ) {
ErrorQuit("SCTableProduct: corrupted <table>",0L,0L);
}
c1 = ELM_LIST( coeffs, l );
c1 = PROD( coeff, c1 );
c2 = ELM_PLIST( res, INT_INTOBJ(k) );
c2 = SUM( c2, c1 );
SET_ELM_PLIST( res, INT_INTOBJ(k), c2 );
CHANGED_BAG( res );
}
}
Obj FuncMACFLOAT_INT( Obj self, Obj i )
{
if (!IS_INTOBJ(i))
return Fail;
else
return NEW_MACFLOAT((Double)INT_INTOBJ(i));
}
MPI_Datatype MPIdatatype_infer(Obj object)
{ if ( IS_STRING(object) ) return MPI_CHAR;
/* Maybe any other kind of GAP list should assume a list of int's coming */
if ( IS_HOMOG_LIST(object) && IS_INTOBJ(ELM_LIST(object, 1) ) ) return MPI_INT;
ErrorQuit("bad vector passed for message handling; must be string or gen. vec.",
0L,0L);
return 0;
}
Int GAP_SizeInt(Obj obj)
{
RequireInt("GAP_SizeInt", obj);
if (obj == INTOBJ_INT(0))
return 0;
Int size = (IS_INTOBJ(obj) ? 1 : SIZE_INT(obj));
return IS_POS_INT(obj) ? size : -size;
}
static Obj FPLLL (Obj self, Obj gapmat, Obj intType, Obj lllargs, Obj svpargs)
{
if (intType == Fail) intType = INTOBJ_INT(0);
if (!IS_INTOBJ(intType)) return INTOBJ_INT(-2);
switch (INT_INTOBJ(intType)) {
case 0: return dofplll<mpz_t>(gapmat, lllargs, svpargs);
case 1: return dofplll<long>(gapmat, lllargs, svpargs);
case 2: return dofplll<double>(gapmat, lllargs, svpargs);
default: return INTOBJ_INT(-2);
}
}
static Obj MPD_INT(Obj self, Obj i)
{
Obj g;
if (IS_INTOBJ(i)) {
g = NEW_MPD(8*sizeof(long));
mpd_set_si(MPD_OBJ(g), INT_INTOBJ(i), MPD_RNDNN);
} else {
Obj f = MPZ_LONGINT(i);
g = NEW_MPD(8*sizeof(mp_limb_t)*SIZE_INT(i));
mpfr_set_z(MPD_OBJ(g)->re, mpz_MPZ(f), GMP_RNDN);
mpfr_set_ui(MPD_OBJ(g)->im, 0, GMP_RNDN);
}
return g;
}
template<> void SET_INTOBJ(Z_NR<mpz_t> &v, Obj z) {
if (IS_INTOBJ(z))
v = INT_INTOBJ(z);
else
#ifdef FPLLL_VERSION
{
mpz_t zz;
mpz_init(zz);
mpz_set(zz, mpz_MPZ(MPZ_LONGINT(z)));
v = zz;
mpz_clear(zz);
}
#else
mpz_set(v.getData(), mpz_MPZ(MPZ_LONGINT(z)));
#endif
}
static Obj MPD_INTPREC(Obj self, Obj i, Obj prec)
{
Obj g;
TEST_IS_INTOBJ("MPD_INTPREC",prec);
if (IS_INTOBJ(i)) {
g = NEW_MPD(INT_INTOBJ(prec));
mpd_set_si(MPD_OBJ(g), INT_INTOBJ(i), MPD_RNDNN);
} else {
Obj f = MPZ_LONGINT(i);
g = NEW_MPD(INT_INTOBJ(prec));
mpfr_set_z(MPD_OBJ(g)->re, mpz_MPZ(f), GMP_RNDN);
mpfr_set_ui(MPD_OBJ(g)->im, 0, GMP_RNDN);
}
return g;
}
/****************************************************************************
**
*F FuncNameRNam(<self>,<rnam>) . . . . convert a record name to a string
**
** 'FuncNameRNam' implements the internal function 'NameRName'.
**
** 'NameRName( <rnam> )'
**
** 'NameRName' returns the string corresponding to the record name <rnam>.
*/
static Obj FuncNameRNam(Obj self, Obj rnam)
{
Obj name;
Obj oname;
const UInt countRNam = LEN_PLIST(NamesRNam);
while ( ! IS_INTOBJ(rnam)
|| INT_INTOBJ(rnam) <= 0
|| countRNam < INT_INTOBJ(rnam) ) {
rnam = ErrorReturnObj(
"NameRName: <rnam> must be a record name (not a %s)",
(Int)TNAM_OBJ(rnam), 0L,
"you can replace <rnam> via 'return <rnam>;'" );
}
oname = NAME_RNAM( INT_INTOBJ(rnam) );
name = CopyToStringRep(oname);
return name;
}
Obj NameRNamHandler (
Obj self,
Obj rnam )
{
Obj name;
Char *cname;
while ( ! IS_INTOBJ(rnam)
|| INT_INTOBJ(rnam) <= 0
|| CountRNam < INT_INTOBJ(rnam) ) {
rnam = ErrorReturnObj(
"NameRName: <rnam> must be a record name (not a %s)",
(Int)TNAM_OBJ(rnam), 0L,
"you can replace <rnam> via 'return <rnam>;'" );
}
cname = NAME_RNAM( INT_INTOBJ(rnam) );
C_NEW_STRING_DYN( name, cname);
return name;
}
/****************************************************************************
**
*F RNamObj(<obj>) . . . . . . . . . . . convert an object to a record name
**
** 'RNamObj' returns the record name corresponding to the object <obj>,
** which currently must be a string or an integer.
*/
UInt RNamObj (
Obj obj )
{
/* convert integer object */
if ( IS_INTOBJ(obj) ) {
return RNamIntg( INT_INTOBJ(obj) );
}
/* convert string object (empty string may have type T_PLIST) */
else if ( IsStringConv(obj) && IS_STRING_REP(obj) ) {
return RNamName( CSTR_STRING(obj) );
}
/* otherwise fail */
else {
obj = ErrorReturnObj(
"Record: '<rec>.(<obj>)' <obj> must be a string or an integer",
0L, 0L,
"you can replace <obj> via 'return <obj>;'" );
return RNamObj( obj );
}
}
Obj SCTableEntryHandler (
Obj self,
Obj table,
Obj i,
Obj j,
Obj k )
{
Obj tmp; /* temporary */
Obj basis; /* basis list */
Obj coeffs; /* coeffs list */
Int dim; /* dimension */
Int len; /* length of basis/coeffs lists */
Int l; /* loop variable */
/* check the table */
if ( ! IS_SMALL_LIST(table) ) {
table = ErrorReturnObj(
"SCTableEntry: <table> must be a small list (not a %s)",
(Int)TNAM_OBJ(table), 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
dim = LEN_LIST(table) - 2;
if ( dim <= 0 ) {
table = ErrorReturnObj(
"SCTableEntry: <table> must be a list with at least 3 elements",
0L, 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* check <i> */
if ( ! IS_INTOBJ(i) || INT_INTOBJ(i) <= 0 || dim < INT_INTOBJ(i) ) {
i = ErrorReturnObj(
"SCTableEntry: <i> must be an integer between 0 and %d",
dim, 0L,
"you can replace <i> via 'return <i>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* get and check the relevant row */
tmp = ELM_LIST( table, INT_INTOBJ(i) );
if ( ! IS_SMALL_LIST(tmp) || LEN_LIST(tmp) != dim ) {
table = ErrorReturnObj(
"SCTableEntry: <table>[%d] must be a list with %d elements",
INT_INTOBJ(i), dim,
"you can replace <table> via 'return <table>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* check <j> */
if ( ! IS_INTOBJ(j) || INT_INTOBJ(j) <= 0 || dim < INT_INTOBJ(j) ) {
j = ErrorReturnObj(
"SCTableEntry: <j> must be an integer between 0 and %d",
dim, 0L,
"you can replace <j> via 'return <j>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* get and check the basis and coefficients list */
tmp = ELM_LIST( tmp, INT_INTOBJ(j) );
if ( ! IS_SMALL_LIST(tmp) || LEN_LIST(tmp) != 2 ) {
table = ErrorReturnObj(
"SCTableEntry: <table>[%d][%d] must be a basis/coeffs list",
0L, 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* get and check the basis list */
basis = ELM_LIST( tmp, 1 );
if ( ! IS_SMALL_LIST(basis) ) {
table = ErrorReturnObj(
"SCTableEntry: <table>[%d][%d][1] must be a basis list",
0L, 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* get and check the coeffs list */
coeffs = ELM_LIST( tmp, 2 );
if ( ! IS_SMALL_LIST(coeffs) ) {
table = ErrorReturnObj(
"SCTableEntry: <table>[%d][%d][2] must be a coeffs list",
0L, 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* check that they have the same length */
len = LEN_LIST(basis);
if ( LEN_LIST(coeffs) != len ) {
table = ErrorReturnObj(
"SCTableEntry: <table>[%d][%d][1], ~[2] must have equal length",
0L, 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* check <k> */
if ( ! IS_INTOBJ(k) || INT_INTOBJ(k) <= 0 || dim < INT_INTOBJ(k) ) {
k = ErrorReturnObj(
"SCTableEntry: <k> must be an integer between 0 and %d",
dim, 0L,
"you can replace <k> via 'return <k>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* look for the (i,j,k) entry */
for ( l = 1; l <= len; l++ ) {
if ( EQ( ELM_LIST( basis, l ), k ) )
break;
}
/* return the coefficient of zero */
if ( l <= len ) {
return ELM_LIST( coeffs, l );
}
else {
return ELM_LIST( table, dim+2 );
}
}
template<class Z> Obj dofplll(Obj gapmat, Obj lllargs, Obj svpargs)
{
if (!IS_PLIST(gapmat)) return INTOBJ_INT(-1);
Int numrows = LEN_PLIST(gapmat), numcols = -1;
for (int i = 1; i <= numrows; i++) {
Obj row = ELM_PLIST(gapmat,i);
if (numcols == -1)
numcols = LEN_PLIST(row);
if (numcols != LEN_PLIST(row))
return INTOBJ_INT(-1);
}
if (numcols <= 0)
return INTOBJ_INT(-1);
ZZ_mat<Z> mat(numrows, numcols);
for (int i = 1; i <= numrows; i++)
for (int j = 1; j <= numcols; j++)
SET_INTOBJ(mat[i-1][j-1], ELM_PLIST(ELM_PLIST(gapmat,i),j));
if (lllargs != Fail) {
double delta = 0.99;
double eta = 0.51;
LLLMethod method = LM_WRAPPER;
FloatType floatType = FT_DEFAULT;
int precision = 0;
int flags = LLL_DEFAULT;
if (lllargs != True) {
if (!IS_PLIST(lllargs) || LEN_PLIST(lllargs) != 6) return INTOBJ_INT(-20);
Obj v = ELM_PLIST(lllargs,1);
if (IS_MACFLOAT(v)) delta = VAL_MACFLOAT(v);
else if (v != Fail) return INTOBJ_INT(-21);
v = ELM_PLIST(lllargs,2);
if (IS_MACFLOAT(v)) eta = VAL_MACFLOAT(v);
else if (v != Fail) return INTOBJ_INT(-22);
v = ELM_PLIST(lllargs,3);
if (v == INTOBJ_INT(0)) method = LM_WRAPPER;
else if (v == INTOBJ_INT(1)) method = LM_PROVED;
else if (v == INTOBJ_INT(2)) method = LM_HEURISTIC;
else if (v == INTOBJ_INT(3)) method = LM_FAST;
else if (v != Fail) return INTOBJ_INT(-23);
v = ELM_PLIST(lllargs,4);
if (v == INTOBJ_INT(0)) floatType = FT_DEFAULT;
else if (v == INTOBJ_INT(1)) floatType = FT_DOUBLE;
else if (v == INTOBJ_INT(2)) floatType = FT_DPE;
else if (v == INTOBJ_INT(3)) floatType = FT_MPFR;
else if (v != Fail) return INTOBJ_INT(-24);
v = ELM_PLIST(lllargs,5);
if (IS_INTOBJ(v)) precision = INT_INTOBJ(v);
else if (v != Fail) return INTOBJ_INT(-25);
v = ELM_PLIST(lllargs,6);
if (IS_INTOBJ(v)) flags = INT_INTOBJ(v);
else if (v != Fail) return INTOBJ_INT(-26);
}
int result = lllReduction(mat, delta, eta, method, floatType, precision, flags);
if (result != RED_SUCCESS)
return INTOBJ_INT(10*result+1);
}
if (svpargs != Fail) {
SVPMethod method = SVPM_PROVED;
int flags = SVP_DEFAULT;
// __asm__ ("int3");
if (svpargs != True) {
if (!IS_PLIST(svpargs) || LEN_PLIST(svpargs) != 2) return INTOBJ_INT(-30);
Obj v = ELM_PLIST(svpargs,1);
if (v == INTOBJ_INT(0)) method = SVPM_PROVED;
else if (v == INTOBJ_INT(1)) method = SVPM_FAST;
else if (v != Fail) return INTOBJ_INT(-31);
v = ELM_PLIST(svpargs,2);
if (IS_INTOBJ(v)) flags = INT_INTOBJ(v);
else if (v != Fail) return INTOBJ_INT(-32);
}
vector<Integer> sol(numrows);
IntMatrix svpmat(numrows,numcols);
for (int i = 0; i < numrows; i++)
for (int j = 0; j < numcols; j++)
SET_Z(svpmat[i][j],mat[i][j]);
int result = shortestVector(svpmat, sol, method, flags);
if (result != RED_SUCCESS)
return INTOBJ_INT(10*result+2);
Obj gapvec;
if (lllargs == Fail) { // return coordinates of shortest vector in mat
gapvec = NEW_PLIST(T_PLIST,numrows);
SET_LEN_PLIST(gapvec,numrows);
for (int i = 1; i <= numrows; i++) {
Obj v = GET_INTOBJ(sol[i-1]);
SET_ELM_PLIST(gapvec,i,v);
}
} else { // return shortest vector
gapvec = NEW_PLIST(T_PLIST,numcols);
SET_LEN_PLIST(gapvec,numcols);
for (int i = 1; i <= numcols; i++) {
Integer s;
s = 0;
for (int j = 0; j < numrows; j++)
s.addmul(sol[j],svpmat[j][i-1]);
Obj v = GET_INTOBJ(s);
SET_ELM_PLIST(gapvec,i,v);
}
}
return gapvec;
}
gapmat = NEW_PLIST(T_PLIST,numrows);
SET_LEN_PLIST(gapmat,numrows);
for (int i = 1; i <= numrows; i++) {
Obj gaprow = NEW_PLIST(T_PLIST,numcols);
SET_LEN_PLIST(gaprow,numcols);
SET_ELM_PLIST(gapmat,i,gaprow);
for (int j = 1; j <= numcols; j++) {
Obj v = GET_INTOBJ(mat[i-1][j-1]);
SET_ELM_PLIST(gaprow,j,v);
}
}
return gapmat;
}
template<> void SET_INTOBJ(Z_NR<double> &v, Obj z) {
if (IS_INTOBJ(z))
v = INT_INTOBJ(z);
else
v = mpz_get_d(mpz_MPZ(MPZ_LONGINT(z)));
}
template<> void SET_INTOBJ(Z_NR<mpz_t> &v, Obj z) {
if (IS_INTOBJ(z))
v = INT_INTOBJ(z);
else
mpz_set(v.getData(), mpz_MPZ(MPZ_LONGINT(z)));
}
bool isa(Obj recval) const
{ return IS_INTOBJ(recval); }
int GAP_IsSmallInt(Obj obj)
{
return obj && IS_INTOBJ(obj);
}