/* Dirichlet posterior probabilities (covers BDe and K2 scores). */ double dirichlet_node(SEXP target, SEXP x, SEXP data, SEXP iss, SEXP prior, SEXP beta, SEXP experimental, int sparse, int debuglevel) { char *t = (char *)CHAR(STRING_ELT(target, 0)); double prob = 0, prior_prob = 0; SEXP nodes, node_t, data_t, exp_data, parents, parent_vars, config; /* get the node cached information. */ nodes = getListElement(x, "nodes"); node_t = getListElement(nodes, t); /* get the parents of the node. */ parents = getListElement(node_t, "parents"); /* extract the node's column from the data frame. */ data_t = c_dataframe_column(data, target, TRUE, FALSE); /* extract the list of eperimental data. */ exp_data = c_dataframe_column(experimental, target, TRUE, FALSE); /* compute the prior probability component for the node. */ prior_prob = graph_prior_prob(prior, target, node_t, beta, debuglevel); if (length(parents) == 0) { prob = dpost(data_t, iss, exp_data); }/*THEN*/ else { /* generate the configurations of the parents. */ PROTECT(parent_vars = c_dataframe_column(data, parents, FALSE, FALSE)); PROTECT(config = c_configurations(parent_vars, TRUE, !sparse)); /* compute the marginal likelihood. */ prob = cdpost(data_t, config, iss, exp_data); UNPROTECT(2); }/*ELSE*/ if (debuglevel > 0) { Rprintf(" > (log)prior probability is %lf.\n", prior_prob); Rprintf(" > (log)posterior density is %lf.\n", prob); }/*THEN*/ /* add the (log)prior to the marginal (log)likelihood to get the (log)posterior. */ prob += prior_prob; return prob; }/*DIRICHLET_NODE*/
double loglik_dnode(SEXP target, SEXP x, SEXP data, double *nparams, int debuglevel) { double loglik = 0; char *t = (char *)CHAR(STRING_ELT(target, 0)); SEXP nodes, node_t, parents, data_t, parent_vars, config; /* get the node cached information. */ nodes = getListElement(x, "nodes"); node_t = getListElement(nodes, t); /* get the parents of the node. */ parents = getListElement(node_t, "parents"); /* extract the node's column from the data frame. */ PROTECT(data_t = c_dataframe_column(data, target, TRUE, FALSE)); if (length(parents) == 0) { loglik = dlik(data_t, nparams); }/*THEN*/ else { /* generate the configurations of the parents. */ PROTECT(parent_vars = c_dataframe_column(data, parents, FALSE, FALSE)); PROTECT(config = c_configurations(parent_vars, TRUE, TRUE)); /* compute the log-likelihood. */ loglik = cdlik(data_t, config, nparams); UNPROTECT(2); }/*ELSE*/ if (debuglevel > 0) Rprintf(" > loglikelihood is %lf.\n", loglik); UNPROTECT(1); return loglik; }/*LOGLIK_DNODE*/