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*/
