From db3ebaa75ac085da454e3410b9f2e77a5cb8a9bc Mon Sep 17 00:00:00 2001 From: Pierre Formont Date: Fri, 2 Sep 2016 11:22:00 +0200 Subject: [PATCH 1/2] Allow the possibility to keep only some fields when converting to list --- DESCRIPTION | 10 +++++----- R/node_conversion_list.R | 30 +++++++++++++++++------------- man/as.list.Node.Rd | 11 +++++++---- 3 files changed, 29 insertions(+), 22 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 2dd4bed..c450f92 100644 --- a/DESCRIPTION +++ b/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 diff --git a/R/node_conversion_list.R b/R/node_conversion_list.R index 65d0f5f..bd9fb99 100644 --- a/R/node_conversion_list.R +++ b/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,37 +204,39 @@ 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) } @@ -240,8 +244,8 @@ as.list.Node <- function(x, #' @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, ...) } @@ -249,6 +253,6 @@ ToListSimple <- function(x, nameName = "name") { #' #' #' @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, ...) } diff --git a/man/as.list.Node.Rd b/man/as.list.Node.Rd index 7baa58f..a509bde 100644 --- a/man/as.list.Node.Rd +++ b/man/as.list.Node.Rd @@ -8,12 +8,12 @@ \usage{ \method{as.list}{Node}(x, mode = c("simple", "explicit"), unname = FALSE, nameName = ifelse(unname, "name", ""), childrenName = "children", - rootName = "", ...) + rootName = "", keepOnly = NULL, ...) -ToListSimple(x, nameName = "name") +ToListSimple(x, nameName = "name", ...) ToListExplicit(x, unname = FALSE, nameName = ifelse(unname, "name", ""), - childrenName = "children") + childrenName = "children", ...) } \arguments{ \item{x}{The Node to convert} @@ -31,7 +31,9 @@ an array rather than named objects.} \item{rootName}{The name of the node. If provided, this overrides \code{Node$name}} -\item{...}{Additional parameters (ignored)} +\item{keepOnly}{A character vector of fields to include in the result. If \code{NULL} (the default), all fields are kept.} + +\item{...}{Additional parameters passed to \code{as.list.Node}} } \description{ Convert a \code{data.tree} structure to a list-of-list structure @@ -40,6 +42,7 @@ Convert a \code{data.tree} structure to a list-of-list structure data(acme) str(ToListSimple(acme)) +str(ToListSimple(acme, keepOnly = "cost")) str(ToListExplicit(acme)) str(ToListExplicit(acme, unname = TRUE)) From b8e82eaf8515db77a69e309411cdce974bde9877 Mon Sep 17 00:00:00 2001 From: Pierre Formont Date: Fri, 2 Sep 2016 11:33:20 +0200 Subject: [PATCH 2/2] Add tests for keepOnly --- tests/testthat/test-treeConversion.R | 18 ++++++++++++++++-- tests/testthat/test-treeConversionDataFrame.R | 6 +++--- 2 files changed, 19 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-treeConversion.R b/tests/testthat/test-treeConversion.R index e743dfe..3e866dd 100644 --- a/tests/testthat/test-treeConversion.R +++ b/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()) diff --git a/tests/testthat/test-treeConversionDataFrame.R b/tests/testthat/test-treeConversionDataFrame.R index 8b4b6fc..fca5bc2 100644 --- a/tests/testthat/test-treeConversionDataFrame.R +++ b/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"))