fixed names for unnest_tsibble() #123

closes #123
tidyverts · Jun 7, 2019 · ff06fdd · ff06fdd
1 parent 5a79c89
commit ff06fdd
Show file tree

Hide file tree

Showing 3 changed files with 24 additions and 35 deletions.
diff --git a/R/tidyr-verbs.R b/R/tidyr-verbs.R
@@ -85,7 +85,7 @@ nest.tbl_ts <- function(.data, ...) {
     build_tsibble(tbl_nest, index = !! index(.data), validate = FALSE)
   } else {
     new_lst <- nest_names[map_lgl(tbl_nest, is_list)]
-    old_lst <- data_names[map_lgl(data_names, is_list)]
+    old_lst <- data_names[map_lgl(.data, is_list)]
     lst_vars <- setdiff(new_lst, old_lst)
     .data <- select_tsibble(ungroup(.data), !!! nest_vars, validate = FALSE)
     tbl_nest[[lst_vars]] <- lapply(tbl_nest[[lst_vars]],
@@ -167,26 +167,15 @@ unnest_check_tsibble <- function(data, key, index) {
   data
 }
 
-#' @param data A tsibble or a data frame contains tsibble in the list-columns.
+#' @param data A data frame contains homogenous tsibbles in the list-columns.
 #' @param cols Names of columns to unnest.
 #' @inheritParams as_tsibble
-#' @rdname tsibble-tidyverse
+#' @keywords internal
 #' @examples
 #' nested_stock %>% 
 #'   unnest_tsibble(cols = data, key = stock)
-#' stock_qtl <- stocksm %>% 
-#'   group_by(stock) %>% 
-#'   index_by(day3 = lubridate::floor_date(time, unit = "3 day")) %>% 
-#'   summarise(
-#'     value = list(quantile(price)), 
-#'     qtl = list(c("0%", "25%", "50%", "75%", "100%"))
-#'   )
-#' unnest_tsibble(stock_qtl, cols = c(value, qtl), key = c(stock, qtl))
 #' @export
 unnest_tsibble <- function(data, cols, key = NULL, validate = TRUE) {
-  if (is_false(inherits(data, "lst_ts") || is_tsibble(data))) {
-    abort("`data` contains no tsibble object.")
-  }
   if (missing(cols)) {
     abort("Argument `cols` for columns to unnest is required.")
   }
@@ -201,7 +190,11 @@ unnest_tsibble <- function(data, cols, key = NULL, validate = TRUE) {
     idx <- index(data)
     tsbl <- data
   } else {
-    lst_cols <- setdiff(names(data), names(unnested_data))
+    data_names <- names(data)
+    unnested_names <- names(unnested_data)
+    new_lst <- unnested_names[map_lgl(unnested_data, is_list)]
+    old_lst <- data_names[map_lgl(data, is_list)]
+    lst_cols <- setdiff(old_lst, new_lst)
     # checking if the nested columns has `tbl_ts` class (only for the first row)
     first_nested <- data[lst_cols][1L, ]
     eval_col <- purrr::imap(first_nested, dplyr::first)
@@ -223,6 +216,10 @@ unnest_tsibble <- function(data, cols, key = NULL, validate = TRUE) {
   )
 }
 
+validate_list_of_tsibble <- function(x) {
+  all(vapply(x, function(x) is_tsibble(x), logical(1)))
+}
+
 fill.tbl_ts <- function(data, ..., .direction = c("down", "up")) {
   res <- NextMethod()
   update_meta2(res, data, ordered = is_ordered(data), interval = interval(data))

diff --git a/man/tsibble-tidyverse.Rd b/man/tsibble-tidyverse.Rd
diff --git a/tests/testthat/test-tidyr.R b/tests/testthat/test-tidyr.R
@@ -84,6 +84,7 @@ test_that("nest() under tidyr 0.8.3", {
 test_that("nest()", {
   skip_if(packageVersion("tidyr") <= "0.8.3")
   expect_is(pedestrian %>% nest(data = -Date_Time), "tbl_ts")
+  expect_named(tourism %>% nest(Trips = -Purpose), c("Purpose", "Trips"))
   expect_named(pedestrian %>% nest(data = -Date_Time), c("Date_Time", "data"))
   expect_is(pedestrian %>% nest(data = c(Date, Count)), "tbl_ts")
   expect_named(pedestrian %>% nest(), "data")
@@ -167,6 +168,16 @@ test_that("unnest_tsibble()", {
   )
 })
 
+test_that("unnest_tsibble() #123 for names", {
+  skip_if(packageVersion("tidyr") > "0.8.3")
+  nested_t <- tourism %>% nest(-Purpose, .key = "Trips")
+  expect_equal(
+    nested_t %>% 
+      unnest_tsibble(Trips, key = c(Purpose, Region, Trips)),
+    tourism
+  )
+})
+
 test_that("dplyr verbs for lst_ts", {
   if (packageVersion("tidyr") > "0.8.3") {
     nest_t <- tourism %>%