Obj MPIrecv( Obj self, Obj args )
{ volatile Obj buf, source, tag; /* volatile to satisfy gcc compiler */
MPIARGCHK( 1, 3, MPI_Recv( <string buf>, <opt int source = MPI_ANY_SOURCE>[, <opt int tag = MPI_ANY_TAG> ] ) );
buf = ELM_LIST( args, 1 );
source = ( LEN_LIST(args) > 1 ? ELM_LIST( args, 2 ) :
INTOBJ_INT(MPI_ANY_SOURCE) );
tag = ( LEN_LIST(args) > 2 ? ELM_LIST( args, 3 ) :
INTOBJ_INT(MPI_ANY_TAG) );
if ( ! IS_STRING( buf ) )
ErrorQuit("MPI_Recv(): received a buffer that is not a string", 0L, 0L);
ConvString( buf );
/* Note GET_LEN_STRING() returns GAP string length
and strlen(CSTR_STRING()) returns C string length (up to '\0') */
if ( ! MPI_READ_ERROR() )
MPI_Recv( CSTR_STRING(buf), GET_LEN_STRING(buf),
last_datatype=MPIdatatype_infer(buf),
INT_INTOBJ(source), INT_INTOBJ(tag), MPI_COMM_WORLD, &last_status);
MPI_READ_DONE();
if ( ! IS_STRING( buf ) )
{ /* CLEAN THIS UP LATER */
ErrorQuit("ParGAP: panic: MPI_Recv(): result buffer is not a string", 0L, 0L);
exit(1);
}
/* if (last_datatype != MPI_CHAR) {
MPI_Get_count(&last_status, last_datatype, &count); etc. } */
return buf;
}
/****************************************************************************
**
*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 );
}
}
std::pair<T,U> operator()(Obj rec) const
{
if(!isa(rec))
throw GAPException("Invalid attempt to read pair");
GAP_getter<T> get_T;
GAP_getter<U> get_U;
std::pair<T,U> p(get_T(ELM_LIST(rec, 1)), get_U(ELM_LIST(rec, 2)));
return p;
}
Obj MPIprobe( Obj self, Obj args )
{ volatile Obj source, tag; /* volatile to satisfy gcc compiler */
MPIARGCHK( 0, 2, MPI_Probe( <opt int source = MPI_ANY_SOURCE>[, <opt int tag = MPI_ANY_TAG> ] ) );
source = ( LEN_LIST(args) > 0 ? ELM_LIST( args, 1 ) :
INTOBJ_INT(MPI_ANY_SOURCE) );
tag = ( LEN_LIST(args) > 1 ? ELM_LIST( args, 2 ) :
INTOBJ_INT(MPI_ANY_TAG) );
if ( ! MPI_READ_ERROR() )
MPI_Probe(INT_INTOBJ(source), INT_INTOBJ(tag), MPI_COMM_WORLD, &last_status);
MPI_READ_DONE();
return True;
}
Obj MPIsend( Obj self, Obj args )
{ Obj buf, dest, tag;
MPIARGCHK(2, 3, MPI_Send( <string buf>, <int dest>[, <opt int tag = 0> ] ));
buf = ELM_LIST( args, 1 );
dest = ELM_LIST( args, 2 );
tag = ( LEN_LIST(args) > 2 ? ELM_LIST( args, 3 ) : 0 );
ConvString( buf );
MPI_Send( ((char*)CSTR_STRING(buf)),
strlen((const Char*)CSTR_STRING(buf)), /* don't incl. \0 */
MPIdatatype_infer(buf), INT_INTOBJ(dest), INT_INTOBJ(tag),
MPI_COMM_WORLD);
return 0;
}
Obj MPIbinsend( Obj self, Obj args )
{ Obj buf, dest, tag, size;
int s,i;
MPIARGCHK(3, 4, MPI_Binsend( <string buf>, <int dest>, <int size>, [, <opt int tag = 0> ] ));
buf = ELM_LIST( args, 1 );
dest = ELM_LIST( args, 2 );
size = ELM_LIST (args, 3);
tag = ( LEN_LIST(args) > 3 ? ELM_LIST( args, 4 ) : 0 );
s = MPI_Send( ((char*)CSTR_STRING(buf)),
INT_INTOBJ(size), /* don't incl. \0 */
MPI_CHAR, INT_INTOBJ(dest), INT_INTOBJ(tag),
MPI_COMM_WORLD);
return 0;
}
Obj FuncCREATE_PTY_IOSTREAM( Obj self, Obj dir, Obj prog, Obj args )
{
Obj allargs[MAX_ARGS+1];
Char *argv[MAX_ARGS+2];
UInt i,len;
Int pty;
len = LEN_LIST(args);
if (len > MAX_ARGS)
ErrorQuit("Too many arguments",0,0);
ConvString(dir);
ConvString(prog);
for (i = 1; i <=len; i++)
{
allargs[i] = ELM_LIST(args,i);
ConvString(allargs[i]);
}
/* From here we cannot afford to have a garbage collection */
argv[0] = CSTR_STRING(prog);
for (i = 1; i <=len; i++)
{
argv[i] = CSTR_STRING(allargs[i]);
}
argv[i] = (Char *)0;
pty = StartChildProcess( CSTR_STRING(dir) , CSTR_STRING(prog), argv );
if (pty < 0)
return Fail;
else
return INTOBJ_INT(pty);
}
int getOrbitStart() const
{
// printf("getOrbitStart.");
Obj o = ELM_REC(sc, RName_orbit);
// ELM_REC(sc, RName_orbit); printf("!\n");
return GAP_get<int>(ELM_LIST(o, 1));
}
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;
}
Obj MPIrecv2( Obj self, Obj args )
{ volatile Obj buf, source, tag; /* volatile to satisfy gcc compiler */
int count, sranje;
MPI_Comm_rank(MPI_COMM_WORLD, &sranje);
MPIARGCHK( 0, 2, MPI_Recv( <opt int source = MPI_ANY_SOURCE>[, <opt int tag = MPI_ANY_TAG> ] ) );
source = ( LEN_LIST(args) > 0 ? ELM_LIST( args, 1 ) :
INTOBJ_INT(MPI_ANY_SOURCE) );
tag = ( LEN_LIST(args) > 1 ? ELM_LIST( args, 2 ) :
INTOBJ_INT(MPI_ANY_TAG) );
MPI_Probe(INT_INTOBJ(source), INT_INTOBJ(tag), MPI_COMM_WORLD, &last_status);
MPI_Get_count(&last_status, MPI_CHAR, &count);
buf = NEW_STRING( count);
ConvString( buf );
/* Note GET_LEN_STRING() returns GAP string length
and strlen(CSTR_STRING()) returns C string length (up to '\0') */
MPI_Recv( CSTR_STRING(buf), GET_LEN_STRING(buf),
MPI_CHAR,
INT_INTOBJ(source), INT_INTOBJ(tag), MPI_COMM_WORLD, &last_status);
MPI_READ_DONE();
/* if (last_datatype != MPI_CHAR) {
MPI_Get_count(&last_status, last_datatype, &count); etc. } */
return buf;
}
Con fill_container(Obj rec)
{
if(!(IS_SMALL_LIST(rec)))
throw GAPException("Invalid attempt to read list");
int len = LEN_LIST(rec);
Con v;
typedef typename Con::value_type T;
GAP_getter<T> getter;
for(int i = 1; i <= len; ++i)
{
v.push_back(getter(ELM_LIST(rec, i)));
}
return v;
}
Con fill_optional_container(Obj rec)
{
if(!(IS_SMALL_LIST(rec)))
throw GAPException("Invalid attempt to read list");
int len = LEN_LIST(rec);
Con v;
GAP_getter<T> getter;
for(int i = 1; i <= len; ++i)
{
if(ISB_LIST(rec, i))
{ v.push_back(getter(ELM_LIST(rec, i))); }
else
{ v.push_back(optional<T>()); }
}
return v;
}
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 );
}
}
Obj SCTableProductHandler (
Obj self,
Obj table,
Obj list1,
Obj list2 )
{
Obj res; /* result list */
Obj row; /* one row of sc table */
Obj zero; /* zero from sc table */
Obj ai, aj; /* elements from list1 */
Obj bi, bj; /* elements from list2 */
Obj c, c1, c2; /* products of above */
Int dim; /* dimension of vectorspace */
Int i, j; /* loop variables */
/* check the arguments a bit */
if ( ! IS_SMALL_LIST(table) ) {
table = ErrorReturnObj(
"SCTableProduct: <table> must be a list (not a %s)",
(Int)TNAM_OBJ(table), 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableProductHandler( self, table, list1, list2 );
}
dim = LEN_LIST(table) - 2;
if ( dim <= 0 ) {
table = ErrorReturnObj(
"SCTableProduct: <table> must be a list with at least 3 elements",
0L, 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableProductHandler( self, table, list1, list2 );
}
zero = ELM_LIST( table, dim+2 );
if ( ! IS_SMALL_LIST(list1) || LEN_LIST(list1) != dim ) {
list1 = ErrorReturnObj(
"SCTableProduct: <list1> must be a list with %d elements",
dim, 0L,
"you can replace <list1> via 'return <list1>;'" );
return SCTableProductHandler( self, table, list1, list2 );
}
if ( ! IS_SMALL_LIST(list2) || LEN_LIST(list2) != dim ) {
list2 = ErrorReturnObj(
"SCTableProduct: <list2> must be a list with %d elements",
dim, 0L,
"you can replace <list2> via 'return <list2>;'" );
return SCTableProductHandler( self, table, list1, list2 );
}
/* make the result list */
res = NEW_PLIST( T_PLIST, dim );
SET_LEN_PLIST( res, dim );
for ( i = 1; i <= dim; i++ ) {
SET_ELM_PLIST( res, i, zero );
}
CHANGED_BAG( res );
/* general case */
if ( EQ( ELM_LIST( table, dim+1 ), INTOBJ_INT(0) ) ) {
for ( i = 1; i <= dim; i++ ) {
ai = ELM_LIST( list1, i );
if ( EQ( ai, zero ) ) continue;
row = ELM_LIST( table, i );
for ( j = 1; j <= dim; j++ ) {
bj = ELM_LIST( list2, j );
if ( EQ( bj, zero ) ) continue;
c = PROD( ai, bj );
if ( ! EQ( c, zero ) ) {
SCTableProdAdd( res, c, ELM_LIST( row, j ), dim );
}
}
}
}
/* commutative case */
else if ( EQ( ELM_LIST( table, dim+1 ), INTOBJ_INT(1) ) ) {
for ( i = 1; i <= dim; i++ ) {
ai = ELM_LIST( list1, i );
bi = ELM_LIST( list2, i );
if ( EQ( ai, zero ) && EQ( bi, zero ) ) continue;
row = ELM_LIST( table, i );
c = PROD( ai, bi );
if ( ! EQ( c, zero ) ) {
SCTableProdAdd( res, c, ELM_LIST( row, i ), dim );
}
for ( j = i+1; j <= dim; j++ ) {
bj = ELM_LIST( list2, j );
aj = ELM_LIST( list1, j );
if ( EQ( aj, zero ) && EQ( bj, zero ) ) continue;
c1 = PROD( ai, bj );
c2 = PROD( aj, bi );
c = SUM( c1, c2 );
if ( ! EQ( c, zero ) ) {
SCTableProdAdd( res, c, ELM_LIST( row, j ), dim );
}
}
}
}
/* anticommutative case */
else if ( EQ( ELM_LIST( table, dim+1 ), INTOBJ_INT(-1) ) ) {
for ( i = 1; i <= dim; i++ ) {
ai = ELM_LIST( list1, i );
bi = ELM_LIST( list2, i );
if ( EQ( ai, zero ) && EQ( bi, zero ) ) continue;
row = ELM_LIST( table, i );
for ( j = i+1; j <= dim; j++ ) {
bj = ELM_LIST( list2, j );
aj = ELM_LIST( list1, j );
if ( EQ( aj, zero ) && EQ( bj, zero ) ) continue;
c1 = PROD( ai, bj );
c2 = PROD( aj, bi );
c = DIFF( c1, c2 );
if ( ! EQ( c, zero ) ) {
SCTableProdAdd( res, c, ELM_LIST( row, j ), dim );
}
}
}
}
/* return the result */
return res;
}
Obj boyers_planarity_check(Obj digraph, int flags, bool krtwsk) {
DIGRAPHS_ASSERT(flags == EMBEDFLAGS_PLANAR || flags == EMBEDFLAGS_OUTERPLANAR
|| flags == EMBEDFLAGS_SEARCHFORK23
|| flags == EMBEDFLAGS_SEARCHFORK4
|| flags == EMBEDFLAGS_SEARCHFORK33);
if (CALL_1ARGS(IsDigraph, digraph) != True) {
ErrorQuit("Digraphs: boyers_planarity_check (C): the 1st argument must be "
"a digraph, not %s",
(Int) TNAM_OBJ(digraph),
0L);
}
Obj const out = FuncOutNeighbours(0L, digraph);
if (FuncIS_ANTISYMMETRIC_DIGRAPH(0L, out) != True) {
ErrorQuit("Digraphs: boyers_planarity_check (C): the 1st argument must be "
"an antisymmetric digraph",
0L,
0L);
}
Int V = DigraphNrVertices(digraph);
Int E = DigraphNrEdges(digraph);
if (V > INT_MAX) {
// Cannot currently test this, it might always be true, depending on the
// definition of Int.
ErrorQuit("Digraphs: boyers_planarity_check (C): the maximum number of "
"nodes is %d, found %d",
INT_MAX,
V);
return 0L;
} else if (2 * E > INT_MAX) {
// Cannot currently test this
ErrorQuit("Digraphs: boyers_planarity_check (C): the maximum number of "
"edges is %d, found %d",
INT_MAX / 2,
E);
return 0L;
}
graphP theGraph = gp_New();
switch (flags) {
case EMBEDFLAGS_SEARCHFORK33:
gp_AttachK33Search(theGraph);
break;
case EMBEDFLAGS_SEARCHFORK23:
gp_AttachK23Search(theGraph);
break;
case EMBEDFLAGS_SEARCHFORK4:
gp_AttachK4Search(theGraph);
break;
}
if (gp_InitGraph(theGraph, V) != OK) {
gp_Free(&theGraph);
ErrorQuit("Digraphs: boyers_planarity_check (C): invalid number of nodes!",
0L,
0L);
return 0L;
} else if (gp_EnsureArcCapacity(theGraph, 2 * E) != OK) {
gp_Free(&theGraph);
ErrorQuit("Digraphs: boyers_planarity_check (C): invalid number of edges!",
0L,
0L);
return 0L;
}
int status;
for (Int v = 1; v <= LEN_LIST(out); ++v) {
DIGRAPHS_ASSERT(gp_VertexInRange(theGraph, v));
gp_SetVertexIndex(theGraph, v, v);
Obj const out_v = ELM_LIST(out, v);
for (Int w = 1; w <= LEN_LIST(out_v); ++w) {
DIGRAPHS_ASSERT(gp_VertexInRange(theGraph, w));
int u = INT_INTOBJ(ELM_LIST(out_v, w));
if (v != u) {
status = gp_AddEdge(theGraph, v, 0, u, 0);
if (status != OK) {
// Cannot currently test this, i.e. it shouldn't happen (and
// currently there is no example where it does happen)
gp_Free(&theGraph);
ErrorQuit("Digraphs: boyers_planarity_check (C): internal error, "
"can't add edge from %d to %d",
(Int) v,
(Int) u);
return 0L;
}
}
}
}
status = gp_Embed(theGraph, flags);
if (status == NOTOK) {
// Cannot currently test this, i.e. it shouldn't happen (and
// currently there is no example where it does happen)
gp_Free(&theGraph);
ErrorQuit("Digraphs: boyers_planarity_check (C): status is not ok", 0L, 0L);
}
Obj res;
if (krtwsk) {
// Kuratowski subgraph isolator
gp_SortVertices(theGraph);
Obj subgraph = NEW_PLIST_IMM(T_PLIST, theGraph->N);
SET_LEN_PLIST(subgraph, theGraph->N);
for (int i = 1; i <= theGraph->N; ++i) {
int nr = 0;
Obj list = NEW_PLIST_IMM(T_PLIST, 0);
int j = theGraph->V[i].link[1];
while (j) {
if (CALL_3ARGS(IsDigraphEdge,
digraph,
INTOBJ_INT((Int) i),
INTOBJ_INT((Int) theGraph->E[j].neighbor))
== True) {
AssPlist(list, ++nr, INTOBJ_INT(theGraph->E[j].neighbor));
}
j = theGraph->E[j].link[1];
}
if (nr == 0) {
RetypeBag(list, T_PLIST_EMPTY);
}
SET_ELM_PLIST(subgraph, i, list);
CHANGED_BAG(subgraph);
}
res = NEW_PLIST_IMM(T_PLIST, 2);
SET_LEN_PLIST(res, 2);
SET_ELM_PLIST(res, 1, (status == NONEMBEDDABLE ? False : True));
SET_ELM_PLIST(res, 2, subgraph);
CHANGED_BAG(res);
} else if (status == NONEMBEDDABLE) {
res = False;
} else {
res = True;
}
gp_Free(&theGraph);
return res;
}
