void MakeImmutableWPObj( Obj obj ) { UInt i; Obj elm; /* remove any weak dead bags */ for (i = 1; i <= STORED_LEN_WPOBJ(obj); i++) { elm = ELM_WPOBJ(obj,i); if (elm != 0 && IS_WEAK_DEAD_BAG(elm)) ELM_WPOBJ(obj,i) = 0; } /* Change the type */ RetypeBag( obj, T_PLIST+IMMUTABLE); }
Obj CopyObjWPObj ( Obj obj, Int mut ) { Obj copy; /* copy, result */ Obj tmp; /* temporary variable */ Obj elm; UInt i; /* loop variable */ /* make a copy */ if ( mut ) { copy = NewBag( T_WPOBJ, SIZE_OBJ(obj) ); ADDR_OBJ(copy)[0] = ADDR_OBJ(obj)[0]; } else { copy = NewBag( T_PLIST+IMMUTABLE, SIZE_OBJ(obj) ); SET_LEN_PLIST(copy,LengthWPObj(obj)); } /* leave a forwarding pointer */ tmp = NEW_PLIST( T_PLIST, 2 ); SET_LEN_PLIST( tmp, 2 ); SET_ELM_PLIST( tmp, 1, ADDR_OBJ(obj)[0] ); SET_ELM_PLIST( tmp, 2, copy ); ADDR_OBJ(obj)[0] = tmp; CHANGED_BAG(obj); /* now it is copied */ RetypeBag( obj, T_WPOBJ + COPYING ); /* copy the subvalues */ for ( i = SIZE_OBJ(obj)/sizeof(Obj)-1; i > 0; i-- ) { elm = ADDR_OBJ(obj)[i]; if ( elm != 0 && !IS_WEAK_DEAD_BAG(elm)) { tmp = COPY_OBJ( elm, mut ); ADDR_OBJ(copy)[i] = tmp; CHANGED_BAG( copy ); } } /* return the copy */ return copy; }
/**************************************************************************** ** *F CleanObjWPObjCopy( <obj> ) . . . . . . . . . . . . . . clean WPobj copy */ void CleanObjWPObjCopy ( Obj obj ) { UInt i; /* loop variable */ Obj elm; /* subobject */ /* remove the forwarding pointer */ ADDR_OBJ(obj)[0] = ELM_PLIST( ADDR_OBJ(obj)[0], 1 ); CHANGED_BAG(obj); /* now it is cleaned */ RetypeBag( obj, TNUM_OBJ(obj) - COPYING ); /* clean the subvalues */ for ( i = 1; i < SIZE_OBJ(obj)/sizeof(Obj); i++ ) { elm = ADDR_OBJ(obj)[i]; if ( elm != 0 && !IS_WEAK_DEAD_BAG(elm)) CLEAN_OBJ( elm ); } }
/**************************************************************************** ** *F FuncADD_SET( <self>, <set>, <obj> ) . . . . . . . add an element to a set ** ** 'FuncADD_SET' implements the internal function 'AddSet'. ** ** 'AddSet( <set>, <obj> )' ** ** 'AddSet' adds <obj>, which may be an object of an arbitrary type, to the ** set <set>, which must be a proper set. If <obj> is already an element of ** the set <set>, then <set> is not changed. Otherwise <obj> is inserted at ** the correct position such that <set> is again a set afterwards. ** ** 'AddSet' does not return anything, it is only called for the side effect ** of changing <set>. */ Obj FuncADD_SET ( Obj self, Obj set, Obj obj ) { UInt len; /* logical length of the list */ UInt pos; /* position */ UInt isCyc; /* True if the set being added to consists of kernel cyclotomics */ UInt notpos; /* position of an original element (not the new one) */ UInt wasHom; UInt wasNHom; UInt wasTab; /* check the arguments */ while ( ! IsSet(set) || ! IS_MUTABLE_OBJ(set) ) { set = ErrorReturnObj( "AddSet: <set> must be a mutable proper set (not a %s)", (Int)TNAM_OBJ(set), 0L, "you can replace <set> via 'return <set>;'" ); } len = LEN_LIST(set); /* perform the binary search to find the position */ pos = PositionSortedDensePlist( set, obj ); /* add the element to the set if it is not already there */ if ( len < pos || ! EQ( ELM_PLIST(set,pos), obj ) ) { GROW_PLIST( set, len+1 ); SET_LEN_PLIST( set, len+1 ); { Obj *ptr; ptr = PTR_BAG(set); memmove((void *)(ptr + pos+1),(void*)(ptr+pos),(size_t)(sizeof(Obj)*(len+1-pos))); #if 0 for ( i = len+1; pos < i; i-- ) { *ptr = *(ptr-1); ptr--; */ /* SET_ELM_PLIST( set, i, ELM_PLIST(set,i-1) ); */ } #endif } SET_ELM_PLIST( set, pos, obj ); CHANGED_BAG( set ); /* fix up the type of the result */ if ( HAS_FILT_LIST( set, FN_IS_SSORT ) ) { isCyc = (TNUM_OBJ(set) == T_PLIST_CYC_SSORT); wasHom = HAS_FILT_LIST(set, FN_IS_HOMOG); wasTab = HAS_FILT_LIST(set, FN_IS_TABLE); wasNHom = HAS_FILT_LIST(set, FN_IS_NHOMOG); CLEAR_FILTS_LIST(set); /* the result of addset is always dense */ SET_FILT_LIST( set, FN_IS_DENSE ); /* if the object we added was not mutable then we might be able to conclude more */ if ( ! IS_MUTABLE_OBJ(obj) ) { /* a one element list is automatically homogenous and ssorted */ if (len == 0 ) { if (TNUM_OBJ(obj) <= T_CYC) RetypeBag( set, T_PLIST_CYC_SSORT); else { SET_FILT_LIST( set, FN_IS_HOMOG ); SET_FILT_LIST( set, FN_IS_SSORT ); if (IS_HOMOG_LIST(obj)) /* it might be a table */ SET_FILT_LIST( set, FN_IS_TABLE ); } } else { /* Now determine homogeneity */ if (isCyc) if (TNUM_OBJ(obj) <= T_CYC) RetypeBag( set, T_PLIST_CYC_SSORT); else { RESET_FILT_LIST(set, FN_IS_HOMOG); SET_FILT_LIST(set, FN_IS_NHOMOG); } else if (wasHom) { if (!SyInitializing) { notpos = (pos == 1) ? 2 : 1; if (FAMILY_OBJ(ELM_PLIST(set,notpos)) == FAMILY_OBJ(obj)) { SET_FILT_LIST(set, FN_IS_HOMOG); if (wasTab) { if (IS_HOMOG_LIST( obj )) SET_FILT_LIST(set, FN_IS_TABLE); } } else SET_FILT_LIST(set, FN_IS_NHOMOG); } } else if (wasNHom) SET_FILT_LIST(set, FN_IS_NHOMOG); } } SET_FILT_LIST( set, FN_IS_SSORT ); } else { CLEAR_FILTS_LIST(set); SET_FILT_LIST( set, FN_IS_DENSE ); } }
void RetypeBagIfWritable(Obj obj, UInt new_type) { if (CheckWriteAccess(obj)) RetypeBag(obj, new_type); }
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; }