unnest.() fails if list col of data.tables has different column order about tidytable HOT 5 CLOSED

Here's a new implementation that fixes the issues you found. It's slower, but still much faster than the tidyverse version.

Please note this requires the dev version of tidytable to be installed since I updated bind_rows.() to use use.names = TRUE and fill = TRUE.

unnest_col <- function(.data, col = NULL) {
  # col <- enexpr(col)
  
  # Check if nested data is a data.frame, data.table, or vector
  nested_data <- pull.(.data, !!col)[[1]]
  is_datatable <- is.data.table(nested_data)
  is_dataframe <- is.data.frame(nested_data)
  
  if (is_dataframe) {
    if (!is_datatable) {
      .data <- shallow(.data)
      
      tidytable:::eval_expr(.data[, !!col := map.(!!col, as_tidytable)])
    }
    
    .data <- bind_rows.(pull.(.data, !!col))

  } else {
    # Unnests a vector
    .data <- tidytable:::eval_expr(
      .data[, list(.new_col = unlist(!!col, recursive = FALSE))]
    ) %>%
      rename.(!!col := .new_col)
  }
  .data
}

new_unnest. <- function(.data, ...) {

  dots <- enexprs(...)

  data_names <- names(.data)

  list_flag <- map_lgl.(.data, is.list)

  if (length(dots) == 0) dots <- syms(data_names[list_flag])
  else dots <- tidytable:::dots_selector(.data, ...)

  unnest_data <- map.(dots, ~ unnest_col(.data, .x))

  unnest_nrow <- map_dbl.(unnest_data, nrow)

  if (!length(unique(unnest_nrow)) == 1)
    abort("unnested data contains different row counts")

  # Get cols to keep
  keep_cols <- data_names[!list_flag]

  # Get number of repeats for keep cols
  rep_vec <- map_dbl.(pull.(.data, !!dots[[1]]),
                      ~ fifelse(is.data.frame(.x), nrow(.x) %||% 1, length(.x)))
  keep_df <- .data[, ..keep_cols][rep(1:.N, rep_vec)]

  results_df <- bind_cols.(keep_df, unnest_data)

  results_df
}

pacman::p_load(tidytable, tidyverse, data.table)

data_size <- 300000
list_df <- tidytable(x = sample(1:20, data_size, TRUE))

unnest_dt <- tidytable(id1 = 1:5,
                       id2 = 1:5,
                       list_column = list(list_df, list_df, list_df, list_df, list_df))

bench::mark(
  tidyverse = unnest_legacy(unnest_dt, list_column),
  tidytable = unnest.(unnest_dt, list_column),
  new = new_unnest.(unnest_dt, list_column),
  check = FALSE,
  iterations = 50)
#> # A tibble: 3 x 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 tidyverse  684.69ms  687.7ms      1.45   113.1MB     48.7
#> 2 tidytable    6.21ms    7.8ms    125.      58.5MB    236. 
#> 3 new         13.92ms   15.8ms     62.3     26.8MB     32.1

I personally think it's worth it. It's still really fast.

Thoughts? Is the functionality improvement worth the extra time?

from tidytable.

Here's a new implementation that fixes the issues you found. It's slower, but still much faster than the tidyverse version.

Please note this requires the dev version of tidytable to be installed since I updated bind_rows.() to use use.names = TRUE and fill = TRUE.

unnest_col <- function(.data, col = NULL) {
  # col <- enexpr(col)
  
  # Check if nested data is a data.frame, data.table, or vector
  nested_data <- pull.(.data, !!col)[[1]]
  is_datatable <- is.data.table(nested_data)
  is_dataframe <- is.data.frame(nested_data)
  
  if (is_dataframe) {
    if (!is_datatable) {
      .data <- shallow(.data)
      
      tidytable:::eval_expr(.data[, !!col := map.(!!col, as_tidytable)])
    }
    
    .data <- bind_rows.(pull.(.data, !!col))

  } else {
    # Unnests a vector
    .data <- tidytable:::eval_expr(
      .data[, list(.new_col = unlist(!!col, recursive = FALSE))]
    ) %>%
      rename.(!!col := .new_col)
  }
  .data
}

new_unnest. <- function(.data, ...) {

  dots <- enexprs(...)

  data_names <- names(.data)

  list_flag <- map_lgl.(.data, is.list)

  if (length(dots) == 0) dots <- syms(data_names[list_flag])
  else dots <- tidytable:::dots_selector(.data, ...)

  unnest_data <- map.(dots, ~ unnest_col(.data, .x))

  unnest_nrow <- map_dbl.(unnest_data, nrow)

  if (!length(unique(unnest_nrow)) == 1)
    abort("unnested data contains different row counts")

  # Get cols to keep
  keep_cols <- data_names[!list_flag]

  # Get number of repeats for keep cols
  rep_vec <- map_dbl.(pull.(.data, !!dots[[1]]),
                      ~ fifelse(is.data.frame(.x), nrow(.x) %||% 1, length(.x)))
  keep_df <- .data[, ..keep_cols][rep(1:.N, rep_vec)]

  results_df <- bind_cols.(keep_df, unnest_data)

  results_df
}

pacman::p_load(tidytable, tidyverse, data.table)

data_size <- 300000
list_df <- tidytable(x = sample(1:20, data_size, TRUE))

unnest_dt <- tidytable(id1 = 1:5,
                       id2 = 1:5,
                       list_column = list(list_df, list_df, list_df, list_df, list_df))

bench::mark(
  tidyverse = unnest_legacy(unnest_dt, list_column),
  tidytable = unnest.(unnest_dt, list_column),
  new = new_unnest.(unnest_dt, list_column),
  check = FALSE,
  iterations = 50)
#> # A tibble: 3 x 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 tidyverse  684.69ms  687.7ms      1.45   113.1MB     48.7
#> 2 tidytable    6.21ms    7.8ms    125.      58.5MB    236. 
#> 3 new         13.92ms   15.8ms     62.3     26.8MB     32.1

I personally think it's worth it. It's still really fast.

Thoughts? Is the functionality improvement worth the extra time?

Apologies for delayed reply.

I believe you already squeezed as much you can with data.table 👍

> bench::mark(
+   tidyverse = tidyr::unnest_legacy(unnest_dt, list_column),
+   tidytable = unnest.(unnest_dt, list_column),
+   tidyfast = tidyfast::dt_unnest(unnest_dt, list_column),
+   check = FALSE,
+   iterations = 50)
# A tibble: 3 x 13
  expression     min  median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time
  <bch:expr> <bch:t> <bch:t>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm>
1 tidyverse  997.4ms   1.13s     0.884      95MB    0.901    50    51     56.59s
2 tidytable   16.8ms 19.95ms    34.5        23MB    8.28     50    12      1.45s
3 tidyfast    17.4ms  34.3ms    26.5      45.9MB   15.9      50    30      1.89s

from tidytable.

Thanks for heads up.

from tidytable.

Related #51

from tidytable.

Also this new implementation can unnest multiple columns at the same time, so this works:

df1 <- data.table(a = "a", b = 1)
df2 <- data.table(b = 1:3, a = rep("a", 3), c = 1:3)

nested_df <- data.table(id = 1:2,
                        list_col1 = list(df1, df2),
                        list_col2 = list(df1, df2))

nested_df %>%
  new_unnest.(list_col1, list_col2)

from tidytable.