/* handler for function 6 */
static Obj HdlrFunc6 (
Obj self )
{
Obj t_1 = 0;
Bag oldFrame;
/* allocate new stack frame */
SWITCH_TO_NEW_FRAME(self,0,0,oldFrame);
/* f1( 2 ); */
t_1 = GF_f1;
CALL_1ARGS( t_1, INTOBJ_INT(2) );
/* f2( 2, 3 ); */
t_1 = GF_f2;
CALL_2ARGS( t_1, INTOBJ_INT(2), INTOBJ_INT(3) );
/* f3( ); */
t_1 = GF_f3;
CALL_0ARGS( t_1 );
/* f3( 2 ); */
t_1 = GF_f3;
CALL_1ARGS( t_1, INTOBJ_INT(2) );
/* f3( 2, 3, 4 ); */
t_1 = GF_f3;
CALL_3ARGS( t_1, INTOBJ_INT(2), INTOBJ_INT(3), INTOBJ_INT(4) );
/* f4( 1 ); */
t_1 = GF_f4;
CALL_1ARGS( t_1, INTOBJ_INT(1) );
/* f4( 1, 2 ); */
t_1 = GF_f4;
CALL_2ARGS( t_1, INTOBJ_INT(1), INTOBJ_INT(2) );
/* f4( 1, 2, 3 ); */
t_1 = GF_f4;
CALL_3ARGS( t_1, INTOBJ_INT(1), INTOBJ_INT(2), INTOBJ_INT(3) );
/* return; */
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
/* return; */
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
}
/* handler for function 4 */
static Obj HdlrFunc4 (
Obj self,
Obj a_a )
{
Obj t_1 = 0;
Obj t_2 = 0;
Obj t_3 = 0;
Bag oldFrame;
/* allocate new stack frame */
SWITCH_TO_NEW_FRAME(self,0,0,oldFrame);
/* Print( "f3:", a, "\n" ); */
t_1 = GF_Print;
t_2 = MakeString( "f3:" );
t_3 = MakeString( "\n" );
CALL_3ARGS( t_1, t_2, a_a, t_3 );
/* return; */
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
/* return; */
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
}
Obj GAP_CallFuncArray(Obj func, UInt narg, Obj args[])
{
Obj result;
Obj list;
if (TNUM_OBJ(func) == T_FUNCTION) {
// call the function
switch (narg) {
case 0:
result = CALL_0ARGS(func);
break;
case 1:
result = CALL_1ARGS(func, args[0]);
break;
case 2:
result = CALL_2ARGS(func, args[0], args[1]);
break;
case 3:
result = CALL_3ARGS(func, args[0], args[1], args[2]);
break;
case 4:
result = CALL_4ARGS(func, args[0], args[1], args[2], args[3]);
break;
case 5:
result =
CALL_5ARGS(func, args[0], args[1], args[2], args[3], args[4]);
break;
case 6:
result = CALL_6ARGS(func, args[0], args[1], args[2], args[3],
args[4], args[5]);
break;
default:
list = NewPlistFromArray(args, narg);
result = CALL_XARGS(func, list);
}
}
else {
list = NewPlistFromArray(args, narg);
result = DoOperation2Args(CallFuncListOper, func, list);
}
return result;
}
Obj FuncAddRowVectorVecFFEsMult( Obj self, Obj vecL, Obj vecR, Obj mult )
{
Obj *ptrL;
Obj *ptrR;
FFV valM;
FFV valS;
FFV valL;
FFV valR;
FF fld;
FFV *succ;
UInt len;
UInt xtype;
UInt i;
if (TNUM_OBJ(mult) != T_FFE)
return TRY_NEXT_METHOD;
if (VAL_FFE(mult) == 0)
return (Obj) 0;
xtype = KTNumPlist(vecL, (Obj *) 0);
if (xtype != T_PLIST_FFE && xtype != T_PLIST_FFE + IMMUTABLE)
return TRY_NEXT_METHOD;
xtype = KTNumPlist(vecR, (Obj *) 0);
if (xtype != T_PLIST_FFE && xtype != T_PLIST_FFE + IMMUTABLE)
return TRY_NEXT_METHOD;
/* check the lengths */
len = LEN_PLIST(vecL);
if (len != LEN_PLIST(vecR)) {
vecR = ErrorReturnObj(
"AddRowVector: vector lengths differ <left> %d, <right> %d",
(Int)len, (Int)LEN_PLIST(vecR),
"you can replace vector <right> via 'return <right>;'");
return CALL_3ARGS(AddRowVectorOp, vecL, vecR, mult);
}
/* check the fields */
fld = FLD_FFE(ELM_PLIST(vecL, 1));
if (FLD_FFE(ELM_PLIST(vecR, 1)) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) == CHAR_FF(FLD_FFE(ELM_PLIST(vecR, 1))))
return TRY_NEXT_METHOD;
vecR = ErrorReturnObj(
"AddRowVector: vectors have different fields",
0L, 0L,
"you can replace vector <right> via 'return <right>;'");
return CALL_3ARGS(AddRowVectorOp, vecL, vecR, mult);
}
/* Now check the multiplier field */
if (FLD_FFE(mult) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) != CHAR_FF(FLD_FFE(mult))) {
mult = ErrorReturnObj(
"AddRowVector: <multiplier> has different field",
0L, 0L,
"you can replace <multiplier> via 'return <multiplier>;'");
return CALL_3ARGS(AddRowVectorOp, vecL, vecR, mult);
}
/* if the multiplier is over a non subfield then redispatch */
if ((DEGR_FF(fld) % DegreeFFE(mult)) != 0)
return TRY_NEXT_METHOD;
/* otherwise it's a subfield, so promote it */
valM = VAL_FFE(mult);
if (valM != 0)
valM = 1 + (valM - 1) * (SIZE_FF(fld) - 1) / (SIZE_FF(FLD_FFE(mult)) - 1);
} else
valM = VAL_FFE(mult);
succ = SUCC_FF(fld);
ptrL = ADDR_OBJ(vecL);
ptrR = ADDR_OBJ(vecR);
/* two versions of the loop to avoid multipling by 1 */
if (valM == 1)
for (i = 1; i <= len; i++) {
valL = VAL_FFE(ptrL[i]);
valR = VAL_FFE(ptrR[i]);
valS = SUM_FFV(valL, valR, succ);
ptrL[i] = NEW_FFE(fld, valS);
}
else
for (i = 1; i <= len; i++) {
valL = VAL_FFE(ptrL[i]);
valR = VAL_FFE(ptrR[i]);
valS = PROD_FFV(valR, valM, succ);
valS = SUM_FFV(valL, valS, succ);
ptrL[i] = NEW_FFE(fld, valS);
}
return (Obj) 0;
}
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;
}
