double graph_prior_prob(SEXP prior, SEXP target, SEXP cache, SEXP beta, int debuglevel) { double *b = NULL, prob = 0; const char *pr = NULL; SEXP parents, children; /* check which prior should be computed, and use the uniform one * if none is specified.*/ if (prior == R_NilValue) return 0; else pr = CHAR(STRING_ELT(prior, 0)); /* match the label of the prior. */ if (strcmp(pr, "uniform") == 0) { /* constant prior, log(1) = 0 for backward compatibility. */ prob = 0; }/*THEN*/ else if (strcmp(pr, "vsp") == 0) { parents = getListElement(cache, "parents"); /* variable selection prior, each arc has independent beta probability * fo inclusion. */ b = REAL(beta); prob = length(parents) * log(*b / (1 - *b)); }/*THEN*/ else if (strcmp(pr, "cs") == 0) { parents = getListElement(cache, "parents"); children = getListElement(cache, "children"); /* completed prior from Castelo and Siebes. */ if (beta == R_NilValue) prob = 0; else prob = castelo_prior(beta, target, parents, children, debuglevel); }/*THEN*/ return prob; }/*GRAPH_PRIOR_PROB*/
SEXP graph_prior_prob(SEXP prior, SEXP target, SEXP cache, SEXP beta, SEXP debug) { double *b = NULL; const char *pr = CHAR(STRING_ELT(prior, 0)); SEXP prob, parents, children; /* allocate the return value. */ PROTECT(prob = allocVector(REALSXP, 1)); /* match the label of the prior. */ if (strcmp(pr, "uniform") == 0) { /* constant prior, log(1) = 0 for backward compatibility. */ NUM(prob) = 0; }/*THEN*/ else if (strcmp(pr, "vsp") == 0) { parents = getListElement(cache, "parents"); /* variable selection prior, each arc has independent beta probability * fo inclusion. */ b = REAL(beta); NUM(prob) = LENGTH(parents) * log(*b / (1 - *b)); }/*THEN*/ else if (strcmp(pr, "cs") == 0) { parents = getListElement(cache, "parents"); children = getListElement(cache, "children"); /* completed prior from Castelo and Siebes. */ if (beta == R_NilValue) NUM(prob) = 0; else NUM(prob) = castelo_prior(beta, target, parents, children, debug); }/*THEN*/ UNPROTECT(1); return prob; }/*GRAPH_PRIOR_PROB*/