Merge pull request #107 from nutterb/current-devel

Release 0.10.8

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: HydeNet
 Type: Package
 Title: Hybrid Bayesian Networks Using R and JAGS
-Version: 0.10.8-01
+Version: 0.10.8
 Author: Jarrod E. Dalton <[email protected]> and Benjamin Nutter
     <[email protected]>
 Maintainer: Benjamin Nutter <[email protected]>
@@ -27,8 +27,6 @@ Imports:
     DiagrammeR (>= 0.9.0),
     plyr,
     dplyr,
-    graph,
-    gRbase,
     magrittr,
     pixiedust (>= 0.6.1),
     rjags,

NAMESPACE

@@ -56,9 +56,6 @@ import(nnet)
 importFrom(dplyr,bind_rows)
 importFrom(dplyr,group_by_)
 importFrom(dplyr,summarise)
-importFrom(gRbase,dag)
-importFrom(gRbase,graphNEL2adjMAT)
-importFrom(graph,nodes)
 importFrom(magrittr,"%$%")
 importFrom(magrittr,"%>%")
 importFrom(plyr,is.formula)

R/HydeNetwork.R

@@ -1,19 +1,16 @@
 #' @name HydeNetwork
 #' @export HydeNetwork
-#' @importFrom graph nodes
-#' @importFrom gRbase dag
-#' @importFrom gRbase graphNEL2adjMAT
 #' @importFrom stats as.formula
 #' 
 #' @title Define a Probablistic Graphical Network
 #' @description Using either a directed acyclic graph (DAG) or a list of models, 
 #'   define a probabilistic
 #'   graphical network to serve as the basis of building a model.  
 #'   
-#' @param nodes Either a formula that defines the network as passed to 
-#'   \code{gRbase::dag} or a list of model objects.
+#' @param nodes Either a formula that defines the network or a list of 
+#'   model objects.
 #' @param data A data frame with the data for estimating node parameters.
-#' @param ... additional arguments to \code{gRbase::dag}.
+#' @param ... additional arguments to other methods.  Not currently used.
 #' 
 #' @details The DAG becomes only one element of the object returned by 
 #'   \code{HydeNetwork}. The dag object is used to extract the node names
@@ -62,11 +59,11 @@
 #'       a decision node or not.
 #'   \item \code{nodeUtility} A named list of logical flags for whether the node is
 #'       a utility node or not.
-#'   \item \code{dag} The dag object returned by \code{gRbase}.  Most of the plotting
+#'   \item \code{dag} The adjacency matrix defining the network.  Most of the plotting
 #'       utilities will be based on this element.
 #'   \item \code{data} A common data frame for nodes that do not have their own unique
 #'       data source.
-#'   \item \code{network_formula} The original formula passed to \code{gRbase::dag}
+#'   \item \code{network_formula} The original formula passed 
 #'       to construct the model.
 #'  }
 #'  
@@ -115,14 +112,14 @@ HydeNetwork <- function(nodes, ...)
 
 HydeNetwork.formula <- function(nodes, data=NULL, ...)
 {
-  #* Build the DAG object
-  network <- gRbase::dag(nodes) 
+  #* Build the DAG object 
+  network <- formula_to_adjacency_matrix(nodes)
 
   #* Node names
-  node_names <- graph::nodes(network)
+  node_names <- colnames(network)
 
   #* Parents
-  parents <- HydeNetwork_parents(network)
+  parents <- HydeNetwork_parents(nodes)
   names(parents) <- node_names
 
   #* fromData
@@ -306,9 +303,56 @@ HydeNetwork.list <- function(nodes, ...)
 }
 
 #** Utility Functions ***************************
+formula_to_adjacency_matrix <- function(nodes){
+  fm_char <- paste0(deparse(nodes), collapse = " ")
+  fm_char <- gsub(" ", "", fm_char)
+  fm_char <- sub("~", "", fm_char, fixed = TRUE)
+
+  fm_char <- unlist(strsplit(fm_char, "[+]"))
+
+  distinct_nodes <- 
+    unlist(strsplit(fm_char, "([|]|[*]|[-])"))
+  distinct_nodes <- sub("^ +", "", distinct_nodes)
+  distinct_nodes <- sub(" +$", "", distinct_nodes)
+  distinct_nodes <- unique(distinct_nodes)
+
+  adj_mat <- matrix(0, 
+                    nrow = length(distinct_nodes),
+                    ncol = length(distinct_nodes),
+                    dimnames = list(distinct_nodes,
+                                    distinct_nodes))
+
+  fm_char <- strsplit(fm_char, "[|]")
+
+  root_node <- vapply(X = fm_char,
+                      FUN = `[`, 
+                      FUN.VALUE = character(1), 
+                      1)
+  root_node <- gsub("(^ +| +$)", "", root_node)
+
+  root_parent <- vapply(X = fm_char,
+                        FUN = `[`,
+                        FUN.VALUE = character(1),
+                        2)
+  root_parent <- gsub(" ", "", root_parent)
+  root_parent <- strsplit(root_parent, "[*]")
+
+  names(root_parent) <- root_node
+
+  for (i in seq_along(root_parent)){
+    if (!all(is.na(root_parent[[i]]))){
+      adj_mat[root_parent[[i]],
+              names(root_parent)[i]] <- 1
+    }
+  }
+
+  adj_mat
+}
+
+
 HydeNetwork_parents <- function(network)
 {
-  adjMat <- gRbase::graphNEL2adjMAT(network)  
+  adjMat <- formula_to_adjacency_matrix(network)  
   parents <- 
     lapply(X = 1:ncol(adjMat), 
            FUN = 

R/compileDecisionModel.R

@@ -70,7 +70,10 @@
 #'                               angio = c("Negative", "Positive"))
 #' decision3 <- compileDecisionModel(Net, custom_policy) 
 #' 
-compileDecisionModel <- function(network, policyMatrix = NULL, ..., data = NULL)
+compileDecisionModel <- function(network, 
+                                 policyMatrix = NULL, 
+                                 ..., 
+                                 data = NULL)
 {
   coll <- checkmate::makeAssertCollection()
 

R/compileJagsModel.R

@@ -62,9 +62,10 @@ compileJagsModel <- function(network, data=NULL, ...)
   cpt_arrays <- makeCptArrays(network) #* The utilty function is in the 
                                        #* file for compileDecisionModel
 
+  con <- textConnection(writeNetworkModel(network))
   jags <- 
     rjags::jags.model(
-      file = textConnection(writeNetworkModel(network)), 
+      file = con, 
       data = 
         if (is.null(data) & length(cpt_arrays) == 0) 
         {
@@ -78,6 +79,8 @@ compileJagsModel <- function(network, data=NULL, ...)
       ...
     )
 
+  close(con)
+
   #* cHN for compiled Hyde Network
   cHN <- list(jags=jags, 
               observed=data, 

R/data.R

@@ -224,7 +224,7 @@
 #'   \item{Rsupport}{Logical value, indicating if an R equivalent is 
 #'     supported by \code{HydeNet}}
 #' }
-#' @source \url{http://people.math.aau.dk/~kkb/Undervisning/Bayes14/sorenh/docs/jags_user_manual.pdf}
+#' @source \url{http://people.stat.sc.edu/hansont/stat740/jags_user_manual.pdf}
 "jagsDists"
 
 #' JAGS Functions Compatible with R.
@@ -237,7 +237,7 @@
 #'   \item{r_function}{R function Name}
 #'   \item{r_package}{R package where the function is found.}
 #' }
-#' @source \url{http://people.math.aau.dk/~kkb/Undervisning/Bayes14/sorenh/docs/jags_user_manual.pdf}
+#' @source \url{http://people.stat.sc.edu/hansont/stat740/jags_user_manual.pdf}
 "jagsFunctions"
 
 #' Pulmonary Embolism Dataset

R/rToJags.R

@@ -19,7 +19,7 @@
 #'   review).
 #'   
 #' @author Jarrod Dalton and Benjamin Nutter
-#' @references \url{http://people.math.aau.dk/~kkb/Undervisning/Bayes14/sorenh/docs/jags_user_manual.pdf}
+#' @references \url{http://people.stat.sc.edu/hansont/stat740/jags_user_manual.pdf}
 
 rToJags <- function(f)
 {

cran-comments.md

@@ -1,9 +1,11 @@
-This update provides fixes to design features that failed to meet the specification design. It permits the user to define distribution parameters using either the R distribution function argument, or the JAGS distribution function argument.
+This update removes dependencies on `gRbase` and `graph`.  
+It also ensures all opened textConnection objects are explicitly closed.
 
 ## Test environments
 * win-builder (devel 2017-09-12 r73242)
-* Local Linux install R 3.4.3 (Ubuntu 16.05.3 LTS)
-* Travis CI Linux install R 3.4.2 (Ubuntu 14.04.5 LTS)
+* win-builder (R 3.5.1)
+* Local Linux install R 3.4.4 (Ubuntu 16.05.3 LTS)
+* Travis CI Linux install R 3.5.0 (Ubuntu 14.04.5 LTS)
 
 ## R CMD check results