Merge pull request #45 from sailthru/add_recursive

Adds an option recursive in append_values and spread_values

NAMESPACE

@@ -1,4 +1,4 @@
-# Generated by roxygen2 (4.1.1): do not edit by hand
+# Generated by roxygen2 (4.1.0): do not edit by hand
 
 S3method("[",tbl_json)
 S3method(arrange_,tbl_json)

R/append_values.r

@@ -15,6 +15,9 @@
 #'   under
 #' @param force parameter that determines if the variable type should be computed or not
 #'        if force is FALSE, then the function may take more memory
+#' @param recursive logical indicating whether to extract a single value from a 
+#'        nested object.  Only used when force = TRUE.  If force = FALSE, and
+#'        recursive=TRUE, throws an error.
 #' @examples
 #' library(magrittr)  # for %>%
 #' '{"first": "bob", "last": "jones"}' %>% 
@@ -27,9 +30,11 @@ NULL
 #' @param as.value function to force coercion to numeric, string, or logical
 append_values_factory <- function(type, as.value) {
 
-  function(x, column.name = type, force=TRUE) {
+  function(x, column.name = type, force = TRUE, recursive = FALSE) {
 
     if (!is.tbl_json(x)) x <- as.tbl_json(x)
+
+    if (force == FALSE) assert_that(recursive == FALSE)
 
     # Extract json 
     json <- attr(x, "JSON")
@@ -46,7 +51,15 @@ append_values_factory <- function(type, as.value) {
     if (!force) { 
        x[column.name] <- append_values_type(json, type) %>% as.value
     } else {
-       new_val <- my_unlist(json) %>% as.value
+       new_val <- my_unlist(json, recursive)
+
+       # if new_val is a list and recursive = FALSE, then
+       # need to identify values with a name and change to NA
+       if (is.list(new_val) && !recursive) {
+          loc <- names(new_val) != ""
+          new_val[loc] <- NA
+       }
+       new_val <- new_val %>% as.value
        assert_that(length(new_val) == nrow(x))
        x[column.name] <- new_val
     }
@@ -59,10 +72,11 @@ append_values_factory <- function(type, as.value) {
 
 #' Unlists while preserving NULLs and only unlisting lists with one value
 #' @param l a list that we want to unlist
-my_unlist <- function(l) {
+#' @param recursive logical indicating whether to unlist nested lists
+my_unlist <- function(l, recursive = FALSE) {
   nulls <- vapply(l, length, 1L) != 1
   l[nulls] <- NA
-  unlist(l, recursive = FALSE)
+  unlist(l, recursive = recursive)
 }
 
 #' get list of values from json
@@ -88,12 +102,12 @@ append_values_type <- function(json, type) {
 
 #' @export
 #' @rdname append_values
-append_values_string <- append_values_factory("string", function(x) as.character(x))
+append_values_string <- append_values_factory("string", as.character)
 
 #' @export
 #' @rdname append_values
-append_values_number <- append_values_factory("number", function(x) as.numeric(x))
+append_values_number <- append_values_factory("number", as.numeric)
 
 #' @export
 #' @rdname append_values
-append_values_logical <- append_values_factory("logical", function(x) as.logical(x))
+append_values_logical <- append_values_factory("logical", as.logical)

R/path.r

@@ -45,4 +45,4 @@ replace_nulls <- function(l, replace) {
 
   l
 
-}
+}

R/spread_values.r

@@ -41,18 +41,23 @@ spread_values <- function(x, ...) {
 #' @param conversion.function function to convert vector to appropriate type
 jfactory <- function(na.value, conversion.function) {
 
-  function(...) {
+  function(..., recursive = FALSE) {
 
     # Prepare path
     path <- prep_path(...)
-  
+
     # Return a closure to deal with JSON lists
     function(json) {
       data <- list_path(json, path)
       data <- replace_nulls(data, na.value)
-      conversion.function(data)
+      if (!recursive) {
+         conversion.function(data)
+      } else {
+         vapply(data, function(d) conversion.function(unlist(d)),
+                FUN.VALUE=conversion.function(0))
+      }
     }
-    
+
   }
 
 }
@@ -62,6 +67,9 @@ jfactory <- function(na.value, conversion.function) {
 #' 
 #' @name jfunctions
 #' @param ... the path to follow
+#' @param recursive logical indicating whether second level and beyond objects
+#'        should be extracted.  Only works when there exists a single value in 
+#'        the nested json object
 #' @return a function that can operate on parsed JSON data
 NULL
 

man/allowed_json_types.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/json_types.r
 \docType{data}
 \name{allowed_json_types}

man/append_values.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/append_values.r
 \name{append_values}
 \alias{append_values}
@@ -7,11 +7,14 @@
 \alias{append_values_string}
 \title{Appends all values with a specified type as a new column}
 \usage{
-append_values_string(x, column.name = type, force = TRUE)
+append_values_string(x, column.name = type, force = TRUE,
+  recursive = FALSE)
 
-append_values_number(x, column.name = type, force = TRUE)
+append_values_number(x, column.name = type, force = TRUE,
+  recursive = FALSE)
 
-append_values_logical(x, column.name = type, force = TRUE)
+append_values_logical(x, column.name = type, force = TRUE,
+  recursive = FALSE)
 }
 \arguments{
 \item{x}{a tbl_json object}
@@ -21,6 +24,10 @@ under}
 
 \item{force}{parameter that determines if the variable type should be computed or not
 if force is FALSE, then the function may take more memory}
+
+\item{recursive}{logical indicating whether to extract a single value from a
+nested object.  Only used when force = TRUE.  If force = FALSE, and
+recursive=TRUE, throws an error.}
 }
 \description{
 The append_values_X functions let you take any remaining JSON and add it as

man/append_values_factory.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/append_values.r
 \name{append_values_factory}
 \alias{append_values_factory}

man/append_values_type.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/append_values.r
 \name{append_values_type}
 \alias{append_values_type}

man/commits.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/data-commits.r
 \docType{data}
 \name{commits}

man/companies.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/data-companies.r
 \docType{data}
 \name{companies}

man/determine_types.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/json_types.r
 \name{determine_types}
 \alias{determine_types}

man/enter_object.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/enter_object.r
 \name{enter_object}
 \alias{enter_object}

man/gather_array.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/gather_array.r
 \name{gather_array}
 \alias{gather_array}

man/gather_keys.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/gather_keys.r
 \name{gather_keys}
 \alias{gather_keys}

man/issues.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/data-issues.r
 \docType{data}
 \name{issues}

man/jfactory.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/spread_values.r
 \name{jfactory}
 \alias{jfactory}

man/jfunctions.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/spread_values.r
 \name{jfunctions}
 \alias{jfunctions}
@@ -8,14 +8,18 @@
 \title{Navigates nested objects to get at keys of a specific type, to be used as
 arguments to spread_values}
 \usage{
-jstring(...)
+jstring(..., recursive = FALSE)
 
-jnumber(...)
+jnumber(..., recursive = FALSE)
 
-jlogical(...)
+jlogical(..., recursive = FALSE)
 }
 \arguments{
 \item{...}{the path to follow}
+
+\item{recursive}{logical indicating whether second level and beyond objects
+should be extracted.  Only works when there exists a single value in
+the nested json object}
 }
 \value{
 a function that can operate on parsed JSON data

man/json_lengths.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/json_lengths.r
 \name{json_lengths}
 \alias{json_lengths}

man/json_types.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/json_types.r
 \name{json_types}
 \alias{json_types}

man/list_path.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/path.r
 \name{list_path}
 \alias{list_path}

man/my_unlist.Rd

@@ -1,13 +1,15 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/append_values.r
 \name{my_unlist}
 \alias{my_unlist}
 \title{Unlists while preserving NULLs and only unlisting lists with one value}
 \usage{
-my_unlist(l)
+my_unlist(l, recursive = FALSE)
 }
 \arguments{
 \item{l}{a list that we want to unlist}
+
+\item{recursive}{logical indicating whether to unlist nested lists}
 }
 \description{
 Unlists while preserving NULLs and only unlisting lists with one value

man/prep_path.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/path.r
 \name{prep_path}
 \alias{prep_path}

man/read_json.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/read_json.r
 \name{read_json}
 \alias{read_json}

man/replace_nulls.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/path.r
 \name{replace_nulls}
 \alias{replace_nulls}

man/spread_values.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/spread_values.r
 \name{spread_values}
 \alias{spread_values}

man/sub-.tbl_json.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/tbl_json.r
 \name{[.tbl_json}
 \alias{[.tbl_json}

man/tbl_json.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/tbl_json.r
 \name{tbl_json}
 \alias{as.tbl_json}

man/tidyjson.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/tidyjson-package.r
 \docType{package}
 \name{tidyjson}

man/worldbank.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/data-worldbank.r
 \docType{data}
 \name{worldbank}

man/wrap_dplyr_verb.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.1): do not edit by hand
+% Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/tbl_json.r
 \name{wrap_dplyr_verb}
 \alias{wrap_dplyr_verb}

tests/testthat/test-append_values.r

@@ -182,13 +182,57 @@ test_that("correctly handles append when trying to append an array", {
   }
 )
 
+test_that("recursive works as expected", {
+
+   data <- '{"item1": {"price" : 30}, "item2" : 40, "item3" : 30}' %>% gather_keys 
+   expected_na <- c(NA_real_, 40, 30)
+   expected_val <- c(30, 40, 30)
+
+   expect_identical(
+     (data %>% append_values_number(force=TRUE, recursive=FALSE))$number, 
+     expected_na)
+   expect_identical(
+     (data %>% append_values_number(force=TRUE, recursive=TRUE))$number, 
+     expected_val)
+   expect_identical(
+     (data %>% append_values_number(force=FALSE, recursive=FALSE))$number, 
+     expected_na)
+   expect_error(
+     (data %>% append_values_number(force=FALSE, recursive=TRUE))$number)
+
+   data <- '{"item1": {"price" : {"usd" : {"real" : 30}}}, "item2" : 40, "item3" : 30}' %>% 
+              gather_keys 
+
+   expect_identical(
+     (data %>% append_values_number(recursive=FALSE))$number, 
+     expected_na)
+   expect_identical(
+     (data %>% append_values_number(recursive=TRUE))$number, 
+     expected_val)
+
+   data <- '{"item1": {"price" : 30, "qty" : 1}, "item2" : 40, "item3" : 30}' %>% gather_keys 
+
+   expect_identical(
+     (data %>% append_values_number(recursive=FALSE))$number, 
+     expected_na)
+   expect_identical(
+     (data %>% append_values_number(recursive=TRUE))$number, 
+     expected_na)
+
+  }
+)
+
 context("my_unlist")
 test_that("my_unlist safely handles edge cases", {
 
     expect_identical(my_unlist(list(1, NA)), c(1, NA_integer_))
     expect_identical(my_unlist(list("a", NA_character_)), c("a", NA_character_))
     expect_identical(my_unlist(list(1, NULL)), c(1, NA_integer_))
     expect_identical(my_unlist(list(1, list(1, 1))), c(1, NA_integer_))
+    expect_identical(my_unlist(list(1, list(1))), list(1, 1))
+
+    expect_identical(my_unlist(list(1, NA), recursive=TRUE), c(1, NA_integer_))
+    expect_identical(my_unlist(list(1, list(1)), recursive=TRUE), c(1,1))
 
   }
 )