Multinet

DESCRIPTION

@@ -31,6 +31,6 @@ Suggests:
 License: GPL (>= 2)
 Maintainer: Mihaljevic Bojan <boki.mihaljevic@gmail.com>
 VignetteBuilder: knitr
-RoxygenNote: 7.0.2
+RoxygenNote: 7.1.0
 LinkingTo: Rcpp, BH
 SystemRequirements: C++11

NAMESPACE

@@ -11,6 +11,7 @@ S3method(logLik,bnc_bn)
 S3method(lp_implement,bnc_aode)
 S3method(lp_implement,bnc_dag)
 S3method(lp_implement,bnc_multinet)
+S3method(plot,bnc_base)
 S3method(plot,bnc_dag)
 S3method(predict,bnc_fit)
 S3method(print,bnc_base)
@@ -40,7 +41,7 @@ export(lp)
 export(makeRLearner.bnc)
 export(manb_arc_posterior)
 export(modelstring)
-export(multinet_tan)
+export(multinet_cl)
 export(narcs)
 export(nb)
 export(nparams)

R/0bnclassify-doc.R

@@ -16,6 +16,7 @@
 #' \item \code{\link{tan_hc}}: Hill-climbing tree augmented naive Bayes (TAN-HC)  (Keogh and Pazzani, 2002)
 #' \item \code{\link{tan_hcsp}}: Hill-climbing super-parent tree augmented naive Bayes (TAN-HCSP) (Keogh and Pazzani, 2002)
 #' \item \code{\link{aode}}: Averaged one-dependence estimators (AODE) (Webb et al., 2005)
+#' \item \code {\link{multinet_tan}}: create a multinet using a Chow-Liu's algorithm (multinet_tan) (Friedman et al., 1997)
 #' }
 #' 
 #' Parameter learning methods (\code{\link{lp}}):
@@ -218,6 +219,32 @@ NULL
 #' bic <- tan_cl('class', car, score = 'bic')   
 NULL
 
+#' Create an ensemble of Bayesian network using a Chow-Liu's algorithm.
+#' 
+#' create an ensemble of Bayesian network  using a Chow-Liu's algorithm, by 
+#' maximizing either log-likelihood, the AIC or BIC scores; maximizing 
+#' log-likelihood corresponds to the well-known tree augmented naive Bayes 
+#' (Friedman et al., 1997).
+#' 
+#' @name multinet_cl
+#'   
+#' @inheritParams nb
+#' @param root the  class column of the dataset. The class column will 
+#' divide in diferents class levels  to be used as root of 
+#' the diferent augmenting  trees
+#' @return A \code{\link{bnc_dag}} object.
+#'   
+#' @references Friedman N, Geiger D and Goldszmidt M (1997). Bayesian network 
+#'   classifiers. \emph{Machine Learning}, \bold{29}, pp. 131--163.
+#' @examples 
+#' data(car)
+#' ll <- multinet_cl('class', car)
+#' ll <- multinet_cl('class', car, score = 'loglik')      
+#' \dontrun{plot(ll)}
+#' aic <- multinet_cl('class', car, score = 'aic')   
+#' bic <- multinet_cl('class', car, score = 'bic')   
+NULL
+
 #' Learn the parameters of a Bayesian network structure.
 #' 
 #' Learn parameters with maximum likelihood or Bayesian estimation, the 

R/bnc-dag-operate.R

@@ -42,6 +42,20 @@ plot.bnc_dag <- function(x, y, layoutType='dot', fontsize = NULL, ...) {
   l <- Rgraphviz::layoutGraph(g, layoutType = layoutType)
   Rgraphviz::renderGraph(l, graph.pars = list(nodes = node_pars))
 }
+
+#' plot a network 
+#' @export
+#' @keywords internal
+plot.bnc_base <- function(x, y, layoutType='dot', fontsize = NULL, ...) {
+  is_bnc_dag <- inherits(x, "bnc_dag")
+  if(is_bnc_dag){
+    plot.bnc_dag(x,y)
+  }
+  else{
+    print("An ensemble of Bayesian network classifiers cannot be plotted") 
+  }
+}
+
 #' Print basic information about a classifier.
 #' @export
 #' @keywords internal
@@ -69,6 +83,8 @@ print.bnc_base <- function(x, ...) {
     cat("  learning algorithm:   ", as.character(x$.call_struct[[1]]), "\n")
   }
 }
+
+
 #' @export 
 #' @describeIn inspect_bnc_dag Returns TRUE if \code{x} is a semi-naive Bayes.
 is_semi_naive <- function(x) {

R/bncs.R

@@ -18,7 +18,7 @@ bnc_aode_bns <- function(x, fit_models) {
 }
 #' Returns a \code{c("bnc_multinet", "bnc")} object.
 #' @keywords internal
-bnc_multinet_tan <- function(class, dataset, features) {
+bnc_multinet_tan <- function(class, dataset, features,scores) {
   if (!is.null(dataset)) {
     features <- get_features(class = class, dataset = dataset)
   }
@@ -29,7 +29,7 @@ bnc_multinet_tan <- function(class, dataset, features) {
   datasets <- split(dataset, dataset[[class]])
   models <- vector("list")
   for (i in levels(dataset[[class]])){
-    models[[i]]<-tan_cl("class", datasets[[i]])}
+    models[[i]]<-tan_cl("class", datasets[[i]],scores)}
   stopifnot(length(models) > 0)
   stopifnot(all(vapply(models, is_ode, FUN.VALUE = logical(1))))
   bnc <- bnc_base(class = class, features = features)

R/infer.R

@@ -83,7 +83,6 @@ compute_log_joint_complete.bnc_multinet<-function(x, dataset){
   for (i in classes){
     m[, i]<-compute_log_joint_complete(models(x)[[i]], dataset)[,i]
   } 
-  browser()
   prior <- rep(multinet_apriori(x), each = nrow(m))
   m * prior
 }

R/learn-params.R

@@ -52,9 +52,10 @@ lp_implement.bnc_aode <- function(x, dataset, smooth, awnb_trees = NULL,
 lp_implement.bnc_multinet <- function(x, dataset, smooth, awnb_trees = NULL, 
                                       awnb_bootstrap = NULL, manb_prior = NULL, wanbia = NULL, .mem_cpts=NULL, ...) {
   # TODO: we need to specify the class as parameter of the function 
-  datasets <- split(dataset, dataset[["class"]]) 
+  class=class_var(x)
+  datasets <- split(dataset, dataset[[class]]) 
   models <- vector("list")
-  for (i in levels(dataset[["class"]])){
+  for (i in levels(dataset[[class]])){
     models[[i]]<-lp_implement(models(x)[[i]], datasets[[i]], smooth)}
   apriori <- extract_cpt(class_var(x), dataset = dataset, smooth = smooth)
   bnc_multinet_bns(x, models, apriori) 

R/learn-struct.R

@@ -115,9 +115,9 @@ aode <- function(class, dataset, features = NULL) {
 #' 
 #' @export
 #' @inheritParams nb
-#' @return A \code{bnc_multinet_tan} or a \code{bnc_dag} (if returning a naive Bayes)
-multinet_tan <- function(class, dataset, features=NULL) {       
-  x <- bnc_multinet_tan(class=class, dataset=dataset, features=features) 
-  add_dag_call_arg(x, fun_name = 'bnc_multinet_tan', call = match.call(), 
+#' @return A \code{multinet_cl} or a \code{bnc_dag} (if returning a naive Bayes)
+multinet_cl <- function(class, dataset, features=NULL, score='loglik') {       
+  x <- bnc_multinet_tan(class=class, dataset=dataset, features=features, score=score) 
+  add_dag_call_arg(x, fun_name = 'multinet_cl', call = match.call(), 
                    env = parent.frame(), force = TRUE)
 }

tests/testthat/test-multinet.R

@@ -1,18 +1,18 @@
 context("inference")   
 
 test_that("plot", {
-  bn <- multinet_tan(class = 'class', dataset = car)
+  bn <- multinet_cl(class = 'class', dataset = car)
   # Should be a message instead of an error
   plot(bn) 
 }) 
 
 test_that("Predict", { 
-  bn <- multinet_tan(class = 'class', dataset = car)
+  bn <- multinet_cl(class = 'class', dataset = car)
   bn <- lp(bn, car, smooth = 0.1)
   a <- compute_cp(x = bn, car)
 })  
 
 test_that("bnc function", { 
   nb <- bnc()
   plot(nb)
-})
+})