improved error handling for NAs in tree

O-mics · Jun 18, 2017 · 41d5d21 · 41d5d21
1 parent 671d27c
commit 41d5d21
Show file tree

Hide file tree

Showing 2 changed files with 50 additions and 44 deletions.
diff --git a/R/as_treenetdf.R b/R/as_treenetdf.R
@@ -31,8 +31,8 @@ as_treenetdf.hclust <- function(data, ...) {
     clustparents <-
         unlist(sapply(seq_along(data$height), function(i) {
             parent <- which(i == data$merge)
-            parent <- ifelse(parent > nrow(data$merge), parent - nrow(data$merge),
-                       parent)
+            parent <- ifelse(parent > nrow(data$merge), 
+                             parent - nrow(data$merge), parent)
             as.integer(ifelse(length(parent) == 0, NA_integer_, parent))
         }))
 
@@ -241,65 +241,71 @@ as_treenetdf.data.frame <- function(data,
                                     cols = setNames(names(data), names(data)),
                                     df_type = 'treenetdf', subset = names(data),
                                     root, ...) {
-  if (df_type == 'treenetdf') {
-    # convert custom column names to native names
-    cols <- cols[cols %in% names(data)]  # only use custom names that exist in data
-    namestoswitch <- names(data) %in% cols
-    names(data)[namestoswitch] <- names(cols)[match(names(data)[namestoswitch], cols)]
-
-    if (pkg_installed('tibble')) { return(tibble::as.tibble(data)) }
-    return(data)
-
-  } else if (df_type == 'leafpathdf') {
-    # get root name from name of passed data.frame, even if it was subset in the
-    # argument, unless explicitly set
-    if (missing(root)) {
-      root <- all.names(substitute(data))
-      if (length(root) > 1) {
-        root <- root[2]
-      }
+    if (df_type == 'treenetdf') {
+      # convert custom column names to native names
+      cols <- cols[cols %in% names(data)]  # only use custom names that exist in data
+      namestoswitch <- names(data) %in% cols
+      names(data)[namestoswitch] <- names(cols)[match(names(data)[namestoswitch], 
+                                                    cols)]
+
+    if (nrow(na.omit(data[-1, ])) < nrow(data[-1, ])) # assumes root is in first row
+        warning("Missing values found in data. May cause graph to fail.", 
+                call. = FALSE)
+
+      if (pkg_installed('tibble')) return(tibble::as.tibble(data))
+      return(data)
+
+    } else if (df_type == 'leafpathdf') {
+        # get root name from name of passed data.frame, even if it was subset in the
+        # argument, unless explicitly set
+        if (missing(root)) {
+            root <- all.names(substitute(data))
+        if (length(root) > 1) {
+            root <- root[2]
+        }
     }
 
     # subset the data by cols (default, same as it is)
     data <- data[, subset]
 
     # add a root col if necessary, otherwise reset root from the data
     if (length(unique(data[[1]])) != 1) {
-      data <- data.frame(root, data, stringsAsFactors = F)
+        data <- data.frame(root, data, stringsAsFactors = F)
     } else {
-      root <- unique(data[[1]])
+        root <- unique(data[[1]])
     }
 
     nodelist <-
-      c(setNames(root, root),
-        unlist(
-          sapply(2:ncol(data), function(i) {
-            subdf <- unique(data[, 1:i])
-            sapply(1:nrow(subdf), function(i)
-              setNames(paste(subdf[i, ], collapse = '::'), rev(subdf[i, ])[1]))
-          })
+        c(setNames(root, root),
+            unlist(
+                sapply(2:ncol(data), function(i) {
+                    subdf <- unique(data[, 1:i])
+                    sapply(1:nrow(subdf), function(i)
+                    setNames(paste(subdf[i, ], collapse = '::'), 
+                             rev(subdf[i, ])[1]))
+                })
+            )
         )
-      )
 
     nodeId <- seq_along(nodelist)
     name <- names(nodelist)
     parentId <-
-      c(NA_integer_,
-        match(
-          sapply(nodelist[-1], function(x) {
-            elms <- strsplit(x, '::')[[1]]
-            paste(elms[1:max(length(elms) - 1)], collapse = '::')
-          }),
-          nodelist
-        )
-      )
-
-    if (pkg_installed('tibble')) {
-      return(tibble::tibble(nodeId = nodeId, parentId = parentId, name = name))
-    }
+        c(NA_integer_,
+            match(
+                sapply(nodelist[-1], function(x) {
+                    elms <- strsplit(x, '::')[[1]]
+                    paste(elms[1:max(length(elms) - 1)], collapse = '::')
+                }),
+              nodelist
+          )
+    )
+
+    if (pkg_installed('tibble'))
+        return(tibble::tibble(nodeId = nodeId, parentId = parentId, 
+                              name = name))
     return(data.frame(nodeId = nodeId, parentId = parentId, name = name,
                       stringsAsFactors = F))
-  }
+    }
 }
 
 

diff --git a/README.md b/README.md
@@ -1,7 +1,7 @@
 D3 JavaScript Network Graphs from R
 ===================================
 
-Development version: 0.4 [![CRAN
+Development version: 0.4.9000 [![CRAN
 Version](http://www.r-pkg.org/badges/version/networkD3)](https://CRAN.R-project.org/package=networkD3)
 [![Build
 Status](https://travis-ci.org/christophergandrud/networkD3.svg?branch=master)](https://travis-ci.org/christophergandrud/networkD3)