Allow the possibility to keep only some fields when converting to list

DESCRIPTION

@@ -27,13 +27,13 @@ Suggests:
     partykit,
     foreach
 Enhances: 
-Description: Create tree structures from hierarchical data, and traverse
-    the tree in various orders. Aggregate, cumulate, print, plot, convert to and from
-    data.frame and more. Useful for decision trees, machine learning,
-    finance, conversion from and to JSON, and many other applications.
+Description: Create tree structures from hierarchical data, and traverse the
+    tree in various orders. Aggregate, cumulate, print, plot, convert to and from
+    data.frame and more. Useful for decision trees, machine learning, finance,
+    conversion from and to JSON, and many other applications.
 License: GPL (>= 2)
 URL: http://github.com/gluc/data.tree
 BugReports: http://github.com/gluc/data.tree/issues
 Depends:
     R (>= 3.0)
-RoxygenNote: 5.0.1
+RoxygenNote: 5.0.1.9000

R/node_conversion_list.R

@@ -183,12 +183,14 @@ FromListSimple <- function(simpleList, nameName = "name", nodeName = NULL, check
 #' @param nameName The name that should be given to the name element
 #' @param childrenName The name that should be given to the children nested list
 #' @param rootName The name of the node. If provided, this overrides \code{Node$name}
-#' @param ... Additional parameters (ignored)
+#' @param keepOnly A character vector of fields to include in the result. If \code{NULL} (the default), all fields are kept.
+#' @param ... Additional parameters passed to \code{as.list.Node}
 #' 
 #' @examples
 #' data(acme)
 #' 
 #' str(ToListSimple(acme))
+#' str(ToListSimple(acme, keepOnly = "cost"))
 #' 
 #' str(ToListExplicit(acme))
 #' str(ToListExplicit(acme, unname = TRUE))
@@ -202,53 +204,55 @@ as.list.Node <- function(x,
                          nameName = ifelse(unname, "name", ""), 
                          childrenName = 'children',
                          rootName = '',
+                         keepOnly = NULL,
                          ...) {
   mode <- mode[1]
   self <- x
   res <- list()
 
-  if (nchar(rootName) != 0) myname <- rootName
-  else myname <- x$name
+  myname <- if (nchar(rootName) != 0) rootName else x$name
 
   if (nchar(nameName) != 0 || nchar(rootName) != 0 || isRoot(x)) {
     l_nameName <- nameName
-    if(nchar(nameName) == 0) l_nameName <- "name"
+    if (nchar(nameName) == 0) l_nameName <- "name"
     res[l_nameName] <- myname
   }
 
   fields <- self$fields
   fields <- fields[!is.function(fields) && !is.environment(fields)]
 
+  if (!is.null(keepOnly) & !all(is.na(fields))) fields <- fields[fields %in% keepOnly]
+
   for (fieldName in fields) res[[fieldName]] <- self[[fieldName]]
 
-  if(!self$isLeaf) {
-    kids <- lapply(self$children, FUN = function(x) as.list.Node(x, mode, unname, nameName, childrenName, ...))
-    if(mode == "explicit") {
+  if (!self$isLeaf) {
+    kids <- lapply(self$children, FUN = function(x) as.list.Node(x, mode, unname, nameName, childrenName, keepOnly = keepOnly, ...))
+    if (mode == "explicit") {
       res[[childrenName]] <- kids
       if (unname) res[[childrenName]] <- unname(res[[childrenName]])
-    } else if(mode == "simple") {
+    } else if (mode == "simple") {
       res <- c(res, kids)
     } else {
       stop(paste0("Mode ", mode, " unknown"))
     }
   }
-  return (res)
+  return(res)
 
 }
 
 
 #' @rdname as.list.Node
 #' 
 #' @export
-ToListSimple <- function(x, nameName = "name") {
-  as.list.Node(x, mode = "simple", nameName = nameName)
+ToListSimple <- function(x, nameName = "name", ...) {
+  as.list.Node(x, mode = "simple", nameName = nameName, ...)
 }
 
 
 #' @rdname as.list.Node
 #'  
 #'
 #' @export 
-ToListExplicit <- function(x, unname = FALSE, nameName = ifelse(unname, "name", ""), childrenName = 'children') {
-  as.list.Node(x, mode = "explicit", unname = unname, nameName = nameName, childrenName = childrenName) 
+ToListExplicit <- function(x, unname = FALSE, nameName = ifelse(unname, "name", ""), childrenName = 'children', ...) {
+  as.list.Node(x, mode = "explicit", unname = unname, nameName = nameName, childrenName = childrenName, ...) 
 }

tests/testthat/test-treeConversion.R

@@ -83,6 +83,20 @@ test_that("as.list.Node simple nameName=name", {
 
 })
 
+test_that("as.list.Node simple keepOnly=p", {
+
+  data(acme)
+  l <- as.list(acme, keepOnly = 'p')
+
+  expect_equal("list", class(l))
+  expect_equal(length(l), 4)
+  expect_equal(names(l), c('name', "Accounting", "Research", "IT"))
+  expect_equal(names(l$Research), c("New Product Line", "New Labs" ))
+  expect_equal(0.9, l$Research$`New Labs`$p)
+  expect_null(l$Research$`New Labs`$cost)
+
+})
+
 test_that("as.list.Node explicit nameName=id", {
 
 
@@ -151,7 +165,7 @@ test_that("as.Node.list warning", {
   lol <- list(type = "Root", list(type = "Rule", count = 1), list(type = "Rule", count = 2))
   #tree <- FromListSimple(lol, nameName = NULL, nodeName = 1)
   tree <- NULL
-  expect_that(FromListSimple(lol, nameName = NULL, nodeName = 1, check = "no-warn"), not(gives_warning()))
+  expect_warning(FromListSimple(lol, nameName = NULL, nodeName = 1, check = "no-warn"), NA)
   expect_that(tree <- FromListSimple(lol, nameName = NULL, nodeName = 1), gives_warning())
 
   expect_equal(tree$totalCount, 3)
@@ -160,7 +174,7 @@ test_that("as.Node.list warning", {
   expect_equal(unname(tree$Get("count")), c(2,0,0))
   expect_equal(unname(tree$Get("count2")), c(NA, 1, 2))
 
-  expect_that(FromListSimple(lol, nameName = NULL, nodeName = 1, check = "no-check"), not(gives_warning()))
+  expect_warning(FromListSimple(lol, nameName = NULL, nodeName = 1, check = "no-check"), NA)
   expect_that(tree <- FromListSimple(lol, nameName = NULL, nodeName = 1), gives_warning())
 
 

tests/testthat/test-treeConversionDataFrame.R

@@ -28,10 +28,10 @@ test_that("FromDataFrameTable reserved words", {
   df <- data.frame(pathString, value, stringsAsFactors = FALSE)
 
   #no warn
-  expect_that(tree <- FromDataFrameTable(df, na.rm = TRUE), not(gives_warning()))
+  expect_warning(tree <- FromDataFrameTable(df, na.rm = TRUE), NA)
   expect_equal(Get(tree$leaves, "value"), c(d = "d", e = "e", f = "f"))
 
-  expect_that(tree <- FromDataFrameTable(df, na.rm = TRUE, check = "no-warn"), not(gives_warning()))
+  expect_warning(tree <- FromDataFrameTable(df, na.rm = TRUE, check = "no-warn"), NA)
   expect_equal(Get(tree$leaves, "value"), c(d = "d", e = "e", f = "f"))
 
   #reserved words
@@ -42,7 +42,7 @@ test_that("FromDataFrameTable reserved words", {
   expect_equal(Get(tree$leaves, "value"), c(count2 = "d", e = "e", leaves2 = "f"))
 
   df <- data.frame(pathString, value, stringsAsFactors = FALSE)
-  expect_that(tree <- FromDataFrameTable(df, na.rm = TRUE, check = "no-warn"), not(gives_warning()))
+  expect_warning(tree <- FromDataFrameTable(df, na.rm = TRUE, check = "no-warn"), NA)
   expect_equal(Get(tree$leaves, "value"), c(count2 = "d", e = "e", leaves2 = "f"))