Вложение и завершение tidyR: избегайте group_by (или эквивалент таблицы данных)

Question

У меня есть набор данных предметов, для каждого из которых я хочу дополнить данные.Найдите ниже то, что я пытался

x = structure(list(item = c("i1", "i1", "i1", "i1", "i2", "i2", "i2", 
"i2"), origin = c("A", "A", "B", "B", "C", "C", "D", "D"), destination = c("a", 
"a", "b", "b", "c", "c", "d", "d"), date = c("Q1", "Q2", "Q2", 
"Q3", "Q2", "Q3", "Q3", "Q4"), ton = 1:8), .Names = c("item", 
"origin", "destination", "date", "ton"), class = "data.frame", row.names = c(NA, 
-8L))   

ТЕСТ1: Результат этого именно то, что я хочу (но group_by серьезно замедляется, когда applyig на реальном наборе данных со многими элементами):

x %>% 
  group_by(item ) %>%
  tidyr::complete(tidyr::nesting(origin, destination), date) %>%
  ungroup()

TEST2: это создает даты для некоторого элемента: слишком много строк:

x %>% tidyr::complete(tidyr::nesting(item , origin, destination), date)

есть ли способ завершить этот набор данных, чтобы получить тот же результат, что и TEST1, но без group_by, чтобы сделать его быстрее?Или, может быть, дата-эквивалент?

Спасибо

Answer 1

Мы можем использовать стратегию «разбить-применить-объединить» с group_split из dplyr и map_dfr из purrr.

library(dplyr)
library(tidyr)
library(purrr)

x %>% 
  group_split(item) %>%
  map_dfr(~complete(.x, nesting(item, origin, destination), date))
# # A tibble: 12 x 5
#    item  origin destination date    ton
#    <chr> <chr>  <chr>       <chr> <int>
#  1 i1    A      a           Q1        1
#  2 i1    A      a           Q2        2
#  3 i1    A      a           Q3       NA
#  4 i1    B      b           Q1       NA
#  5 i1    B      b           Q2        3
#  6 i1    B      b           Q3        4
#  7 i2    C      c           Q2        5
#  8 i2    C      c           Q3        6
#  9 i2    C      c           Q4       NA
# 10 i2    D      d           Q2       NA
# 11 i2    D      d           Q3        7
# 12 i2    D      d           Q4        8

Вот результат microbenchmark.group_split и map_dfr быстрее, чем один group_by.

library(microbenchmark)

microbenchmark(m1 = {
  x %>% 
    group_split(item) %>%
    map_dfr(~complete(.x, nesting(item, origin, destination), date))
},
m2 = {
  x %>% 
    group_by(item ) %>%
    complete(nesting(origin, destination), date) %>%
    ungroup()
}, times = 1000L)
# Unit: milliseconds
# expr      min       lq     mean   median       uq      max neval cld
#   m1 5.955854 6.406424 6.897692 6.617444 6.872159 18.86277  1000  a 
#   m2 7.612657 8.204849 8.882617 8.498890 8.875950 25.33114  1000   b

Answer 2

У меня немного нет опыта ограничений оперативной памяти, но вот попытка разбить процесс на более мелкие этапы и сохранить минимальный объем данных на каждом шаге:

setDT(x)
gcols <- c("origin", "destination")
x[, g := .GRP, by = gcols]
setkey(x, g, date)
# Create a lookup table to refer to later so we can drop these columns
lut_g_od <- x[, .SD[1], by = g, .SDcols = gcols]
x[, (gcols) := NULL]
# Split by items... so we can work in stepwise fashion
x <- split(x, by = "item", keep.by = FALSE)
for (i in seq_along(x)) {
  x[[i]] <- x[[i]][CJ(g=g, date=date, unique=TRUE)]
}
x <- rbindlist(x, idcol = "item")
# Now if you want to get back in the original origin+destination
setkey(x, g)
x <- x[lut_g_od][, g := NULL]
x[]
#     item date ton origin destination
#  1:   i1   Q1   1      A           a
#  2:   i1   Q2   2      A           a
#  3:   i1   Q3  NA      A           a
#  4:   i1   Q1  NA      B           b
#  5:   i1   Q2   3      B           b
#  6:   i1   Q3   4      B           b
#  7:   i2   Q2   5      C           c
#  8:   i2   Q3   6      C           c
#  9:   i2   Q4  NA      C           c
# 10:   i2   Q2  NA      D           d
# 11:   i2   Q3   7      D           d
# 12:   i2   Q4   8      D           d

Answer 3

Использование data.table и генерация перестановок {дат} и {индексов групп товаров, происхождения и назначения}.Надеюсь, это будет быстрее.

library(data.table)
setDT(x)

#create a group index for each combination of item, origin, destination
x[, g := .GRP, by=.(item, origin, destination)]

gcols <- c("origin","destination")
vcols <- c("ton")
#create the permutations of date and group
x[, CJ(g=g, date=date, unique=TRUE), by=.(item)][
    #lookup the original group values
    x, (gcols) := mget(paste0("i.", gcols)), on=.(item, g)][
        #lookup the other values
        x, (vcols) := mget(paste0("i.", vcols)), on=.(item, g, date)]

вывод:

    item g date origin destination ton
 1:   i1 1   Q1      A           a   1
 2:   i1 1   Q2      A           a   2
 3:   i1 1   Q3      A           a  NA
 4:   i1 2   Q1      B           b  NA
 5:   i1 2   Q2      B           b   3
 6:   i1 2   Q3      B           b   4
 7:   i2 3   Q2      C           c   5
 8:   i2 3   Q3      C           c   6
 9:   i2 3   Q4      C           c  NA
10:   i2 4   Q2      D           d  NA
11:   i2 4   Q3      D           d   7
12:   i2 4   Q4      D           d   8

---

edit: адрес комментария OP об ошибке: невозможно выделить вектор размером 3.3Gb

Я запускаю код со следующим образцом набора данных, и объем используемой оперативной памяти составлял около 700 КБ на протяжении всех вычислений.

library(data.table)
set.seed(0L)
sz <- 2e6
x <- data.table(item=rep(seq_len(sz/4), each=4L),
    origin=sample(LETTERS, sz, TRUE),
    destination=sample(letters, sz, TRUE),
    date=paste0("Q",sample(1:4, sz, TRUE)),
    ton=seq_len(sz))
setorder(x, item, origin, destination, date)