/*****************
void network_stats_wrapper
Wrapper for a call from R. Return the change in the statistics when
we go from an empty graph to the observed graph. If the empty graph
has true global values equal to zero for all statistics, then this
change gives the true global values for the observed graph.
*****************/
void wt_network_stats_wrapper(int *tails, int *heads, double *weights, int *timings, int *time, int *lasttoggle, int *dnedges,
int *dn, int *dflag, int *bipartite,
int *nterms, char **funnames,
char **sonames, double *inputs, double *stats)
{
int directed_flag;
Vertex n_nodes;
Edge n_edges;
WtNetwork nw[2];
WtModel *m;
Vertex bip;
/* Rprintf("prestart with setup\n"); */
n_nodes = (Vertex)*dn;
n_edges = (Edge)*dnedges;
directed_flag = *dflag;
bip = (Vertex)*bipartite;
m=WtModelInitialize(*funnames, *sonames, &inputs, *nterms);
nw[0]=WtNetworkInitialize(NULL, NULL, NULL, 0,
n_nodes, directed_flag, bip, *timings?1:0, *timings?*time:0, *timings?lasttoggle:NULL);
/* Compute the change statistics and copy them to stats for return
to R. Note that stats already has the statistics of an empty
network, so d_??? statistics will add on to them, while s_???
statistics will simply overwrite them.*/
WtSummStats(n_edges, tails, heads, weights, nw, m,stats);
WtModelDestroy(m);
WtNetworkDestroy(nw);
}
/*****************
void WtMCMC_wrapper
Wrapper for a call from R.
and don't forget that tail -> head
*****************/
void WtMCMC_wrapper(int *dnumnets, int *nedges,
int *tails, int *heads, double *weights,
int *dn, int *dflag, int *bipartite,
int *nterms, char **funnames,
char **sonames,
char **MHproposaltype, char **MHproposalpackage,
double *inputs, double *theta0, int *samplesize,
double *sample, int *burnin, int *interval,
int *newnetworktails,
int *newnetworkheads,
double *newnetworkweights,
int *fVerbose,
int *maxedges,
int *status){
int directed_flag;
Vertex n_nodes, nmax, bip;
/* Edge n_networks; */
WtNetwork nw[1];
WtModel *m;
WtMHproposal MH;
n_nodes = (Vertex)*dn;
/* n_networks = (Edge)*dnumnets; */
nmax = (Edge)abs(*maxedges);
bip = (Vertex)*bipartite;
GetRNGstate(); /* R function enabling uniform RNG */
directed_flag = *dflag;
m=WtModelInitialize(*funnames, *sonames, &inputs, *nterms);
/* Form the network */
nw[0]=WtNetworkInitialize(tails, heads, weights, nedges[0],
n_nodes, directed_flag, bip, 0, 0, NULL);
WtMH_init(&MH,
*MHproposaltype, *MHproposalpackage,
inputs,
*fVerbose,
nw);
*status = WtMCMCSample(&MH,
theta0, sample, *samplesize,
*burnin, *interval,
*fVerbose, nmax, nw, m);
WtMH_free(&MH);
/* Rprintf("Back! %d %d\n",nw[0].nedges, nmax); */
/* record new generated network to pass back to R */
if(*status == WtMCMC_OK && *maxedges>0 && newnetworktails && newnetworkheads)
newnetworktails[0]=newnetworkheads[0]=WtEdgeTree2EdgeList(newnetworktails+1,newnetworkheads+1,newnetworkweights+1,nw,nmax-1);
WtModelDestroy(m);
WtNetworkDestroy(nw);
PutRNGstate(); /* Disable RNG before returning */
}
/*****************
void WtCD_wrapper
Wrapper for a call from R.
and don't forget that tail -> head
*****************/
void WtCD_wrapper(int *dnumnets, int *nedges,
int *tails, int *heads, double *weights,
int *dn, int *dflag, int *bipartite,
int *nterms, char **funnames,
char **sonames,
char **MHproposaltype, char **MHproposalpackage,
double *inputs, double *theta0, int *samplesize, int *CDparams,
double *sample,
int *fVerbose,
int *status){
int directed_flag;
Vertex n_nodes, bip, *undotail, *undohead;
double *undoweight;
/* Edge n_networks; */
WtNetwork nw[1];
WtModel *m;
WtMHproposal MH;
n_nodes = (Vertex)*dn;
/* n_networks = (Edge)*dnumnets; */
bip = (Vertex)*bipartite;
GetRNGstate(); /* R function enabling uniform RNG */
directed_flag = *dflag;
m=WtModelInitialize(*funnames, *sonames, &inputs, *nterms);
/* Form the network */
nw[0]=WtNetworkInitialize(tails, heads, weights, nedges[0],
n_nodes, directed_flag, bip, 0, 0, NULL);
WtMH_init(&MH,
*MHproposaltype, *MHproposalpackage,
inputs,
*fVerbose,
nw);
undotail = calloc(MH.ntoggles * CDparams[0] * CDparams[1], sizeof(Vertex));
undohead = calloc(MH.ntoggles * CDparams[0] * CDparams[1], sizeof(Vertex));
undoweight = calloc(MH.ntoggles * CDparams[0] * CDparams[1], sizeof(double));
double *extraworkspace = calloc(m->n_stats, sizeof(double));
*status = WtCDSample(&MH,
theta0, sample, *samplesize, CDparams, undotail, undohead, undoweight,
*fVerbose, nw, m, extraworkspace);
free(undotail);
free(undohead);
free(undoweight);
free(extraworkspace);
WtMH_free(&MH);
/* Rprintf("Back! %d %d\n",nw[0].nedges, nmax); */
WtModelDestroy(m);
WtNetworkDestroy(nw);
PutRNGstate(); /* Disable RNG before returning */
}
