Fix #105

nutterb · May 11, 2018 · 19d7faf · 19d7faf
1 parent 5bb17f9
commit 19d7faf
Show file tree

Hide file tree

Showing 5 changed files with 22 additions and 21 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: HydeNet
 Type: Package
 Title: Hybrid Bayesian Networks Using R and JAGS
-Version: 0.10.8
+Version: 0.10.8-01
 Author: Jarrod E. Dalton <daltonj@ccf.org> and Benjamin Nutter
     <benjamin.nutter@gmail.com>
 Maintainer: Benjamin Nutter <benjamin.nutter@gmail.com>

diff --git a/R/HydeNetwork.R b/R/HydeNetwork.R
@@ -200,7 +200,7 @@ HydeNetwork.formula <- function(nodes, data=NULL, ...)
                                       FUN = is.factor, 
                                       FUN.VALUE = logical(1))]
     factorLevels[factor_vars] <- 
-      lapply(X = data[, factor_vars, drop = FALSE],
+      lapply(X = data[factor_vars],
              FUN = levels)
   }
 
@@ -354,7 +354,7 @@ HydeNetwork_nodeFormula <- function(x, parents, data, fromData)
 {
   if (is.null(parents[[x]]))
   {
-    if (fromData[[names(parents)[x]]] & !is.numeric(data[, names(parents)[x]]))
+    if (fromData[[names(parents)[x]]] & !is.numeric(data[[names(parents)[x]]]))
     {
       f <- paste("~ ", names(parents)[x])
     }
@@ -381,24 +381,24 @@ HydeNetwork_nodeFitter <- function(node_name, data, parents)
   {
     return(NULL)
   }
-  else if (is.numeric(data[, node_name])) 
+  else if (is.numeric(data[[node_name]])) 
   {
     return("lm")
   }
-  else if (is.factor(data[, node_name]) & is.null(parents[[node_name]]))
+  else if (is.factor(data[[node_name]]) & is.null(parents[[node_name]]))
   {
     return("xtabs")
   }
-  else if (is.factor(data[, node_name]) & 
-           all(vapply(parents[[node_name]], function(p) is.factor(data[, p]), logical(1))))
+  else if (is.factor(data[[node_name]]) & 
+           all(vapply(parents[[node_name]], function(p) is.factor(data[[p]]), logical(1))))
   {
     return("cpt")
   }
-  else if (is.factor(data[, node_name]) & nlevels(data[, node_name]) == 2)
+  else if (is.factor(data[[node_name]]) & nlevels(data[[node_name]]) == 2)
   {
     return("glm")
   }
-  else if (is.factor(data[, node_name]) & nlevels(data[, node_name]) > 2)
+  else if (is.factor(data[[node_name]]) & nlevels(data[[node_name]]) > 2)
   {
     return("multinom")
   }
@@ -417,10 +417,10 @@ HydeNetwork_nodeType <- function(node_name, data, parents, nodeFitter)
   if (node_name %in% names(data))
   {
     if ((is.null(parents[[node_name]]) && 
-         !is.numeric(data[, node_name])) || 
+         !is.numeric(data[[node_name]])) || 
         (!is.null(parents[[node_name]]) && 
-         !is.numeric(data[, node_name]) && 
-         nlevels(data[, node_name]) > 2))
+         !is.numeric(data[[node_name]]) && 
+         nlevels(data[[node_name]]) > 2))
     {
       return('dcat')
     }
@@ -429,10 +429,10 @@ HydeNetwork_nodeType <- function(node_name, data, parents, nodeFitter)
       return('dcat')
     }
     else if ((is.null(parents[[node_name]]) && 
-              !is.numeric(data[, node_name])) || 
+              !is.numeric(data[[node_name]])) || 
              (!is.null(parents[[node_name]]) && 
-              !is.numeric(data[, node_name]) && 
-              nlevels(data[, node_name]) == 2))
+              !is.numeric(data[[node_name]]) && 
+              nlevels(data[[node_name]]) == 2))
     {
       return('dbern')
     }

diff --git a/R/cpt.R b/R/cpt.R
@@ -165,7 +165,7 @@ cpt_workhorse <- function(variables, dependentVar, independentVars,
   checkmate::assertSubset(variables, 
                           choices = names(data))
 
-  lapply(data[, variables],
+  lapply(data[variables],
          checkmate::assertFactor,
          add = coll)
 
@@ -252,7 +252,7 @@ cpt_workhorse <- function(variables, dependentVar, independentVars,
 
   cpt[is.na(cpt)] <- 0
 
-  model <- data[, c(names(dimnames(cpt)), "wt")]
+  model <- data[c(names(dimnames(cpt)), "wt")]
 
   if ("wt" %in% names(model) && !is.null(wt_text)) 
   {

diff --git a/R/inputCPT.R b/R/inputCPT.R
@@ -169,7 +169,7 @@ inputCPT_workhorse <- function(variables, dependentVar, independentVars,
         "      as the complement of the inputted probabilities Pr(", dependentVar,
         " != ",factorLevels[[dependentVar]][1]," | ",
         paste(independentVars,collapse=", "), ").\n", hbar,sep="")
-    data <- data[data[,dependentVar] %in% levels(data[,dependentVar])[-1],]
+    data <- data[data[dependentVar] %in% levels(data[dependentVar])[-1],]
     cat("Enter the following conditional probabilities:\n")
   } 
   else 
@@ -180,7 +180,7 @@ inputCPT_workhorse <- function(variables, dependentVar, independentVars,
   cat("Use '<q>' to halt execution.\n",
       "To go back one step and re-enter, enter '<b>'.\n", hbar, sep="")
 
-  formattedDepVarLvls <- format(as.character(data[,dependentVar]),
+  formattedDepVarLvls <- format(as.character(data[dependentVar]),
                                 width = facValWidths[dependentVar])
 
   noNegativeProbs <- FALSE
@@ -251,7 +251,7 @@ inputCPT_workhorse <- function(variables, dependentVar, independentVars,
       complementProbs <- plyr::ddply(data, 
                                      independentVars,
                                      function(data) c("wt" = 1-sum(data[["wt"]])))
-      complementProbs[,dependentVar] <- levels(data[, dependentVar])[1]
+      complementProbs[,dependentVar] <- levels(data[dependentVar])[1]
       data <- rbind(data, complementProbs)
       if(min(data$wt)>=0)
       {

diff --git a/R/writeJagsFormula.R b/R/writeJagsFormula.R
@@ -69,7 +69,8 @@ writeJagsFormula.glm <- function(fit, nodes, bern = bern, ...)
 {
   if (fit[["family"]][["family"]] == "gaussian" & fit[["family"]][["link"]] == "identity")
   {
-    return(writeJagsFormula.lm(fit))
+    return(writeJagsFormula.lm(fit, 
+                               descriptors = c("term", "term_plain", "level")))
   }
 
   mdl <- suppressWarnings(