/** * Node.c --- This file contains functions for creating, * destroying, and modifying states of nodes. */ #include #include #include #include /*************************************************************************** * Low Level Node Utilities ***************************************************************************/ /** * This is a small utility function meant to be used from within * toString to determine if the pointer is live or not. */ SEXP RN_isNodeActive(SEXP node) { SEXP nodePtr, result; PROTECT(result=allocVector(LGLSXP,1)); LOGICAL(result)[0]=FALSE; PROTECT(nodePtr = getAttrib(node,nodeatt)); if (nodePtr && R_ExternalPtrAddr(nodePtr)) { LOGICAL(result)[0] = TRUE; } UNPROTECT(2); return result; } /** * This function allocates a back pointer R object * for a newly created net. */ SEXP MakeNode_RRef(node_bn* node, const char* name, int isDiscrete) { SEXP nd, ndhandle; nd = allocVector(STRSXP,1); R_PreserveObject(nd); /* Return the network name */ SET_STRING_ELT(nd,0,mkChar(name)); /* Set the handle as an attribute. */ PROTECT(ndhandle = R_MakeExternalPtr(node,nodeatt, R_NilValue)); setAttrib(nd,nodeatt,ndhandle); setAttrib(nd,nodediscatt,isDiscrete ? TRUEV : FALSEV); SET_CLASS(nd,nodeclass); /* Set a back pointer to the R object in the Netica Object */ SetNode_RRef(node,nd); UNPROTECT(1); return nd; } /** * This function allows for the lazy creation of node objects * associated with a network. */ SEXP GetNode_RRef(node_bn *node) { SEXP nd = FastGetNode_RRef(node); if (nd) return nd; /* Already got one */ const char *name = GetNodeName_bn(node); int isDiscrete = (int) (GetNodeType_bn(node) == DISCRETE_TYPE); return MakeNode_RRef(node,name,isDiscrete); } /** * This function removes the R handles from a node so it can be safely * deleted. */ void RN_Free_Node(node_bn* node_handle) { SEXP node, nodehandle; if (!node_handle) return; //Void pointer, nothing to do. node = GetNodeUserData_bn(node_handle,0); if (!node) return; //No R object, created nothing to do. PROTECT(node); PROTECT(nodehandle = getAttrib(node,nodeatt)); /* Clear the handle */ R_ClearExternalPtr(nodehandle); setAttrib(node,nodeatt,nodehandle); //Probably not needed. R_ReleaseObject(node); //Let R garbage collect it when all //references are gone. UNPROTECT(2); return; } void RN_Free_Nodes(const nodelist_bn* nodelist) { //Rprintf("Freeing nodes.\n"); int k, kk=LengthNodeList_bn(nodelist); for (k=0; k 0) nn--; SetNodeLevels_bn(node_handle, nn, levels); } return(nd); }