Поворот на data.table, аналогичный функции расплава rehape

Я прочитал некоторые ссылки на подобные проблемы здесь, на SO, но еще не смог найти решение и задался вопросом, есть ли способ сделать следующее, используя только data.table.

Я использую упрощенный пример, но на практике моя таблица данных содержит > 1000 столбцов, похожих на var1, var2,... var1000 и т.д.

dt <- data.table(uid=c("a","b"), var1=c(1,2), var2=c(100,200))

Я ищу решение, которое позволит мне получить результат, похожий на функцию изменения формы расплава -

> melt(dt, id=c("uid"))
uid variable value
1   a     var1     1
2   b     var1     2
3   a     var2   100
4   b     var2   200

То есть все столбцы, кроме uid, перечислены под одним столбцом с соответствующими значениями в соседнем столбце. Я пробовал это с помощью комбинации списка и т.д., Но может отсутствовать что-то, что очевидно.

Все uid в dt уникальны.

Спасибо заранее.

Ответ 1

Для изменения конфигурации data.table попробуйте следующее:

dt[, list(variable = names(.SD), value = unlist(.SD, use.names = F)), by = uid]

Стоимость синтаксиса стоит того; функция работает очень быстро!

Ответ 2

stack обычно превосходит melt.

Прямым подходом к этой проблеме с stack будет:

dt[, stack(.SD), by = "uid"]

Конечно, при необходимости вы можете указать .SDcols. И затем используйте setnames(), чтобы изменить имена на все, что вы хотите.

(Предупреждение о саморекламе)

Я написал некоторые функции и поместил их в пакет под названием "splitstackshape". Одна из функций называется Stacked() и в версии 1.2.0 пакета splitstackshape, должен работать очень быстро.

Это немного отличается от простого укладки всех оставшихся столбцов в data.table. Он более похож на основание R reshape(), чем melt(), из "reshape2". Вот пример Stacked() в действии.

Я создал прилично большой data.table для этого теста. Есть 50 числовых столбцов, которые мы хотим уложить, и 50 столбцов факторов, которые мы хотим сшить. Я также оптимизировал @Andreas ответ.

Данные

set.seed(1)
m1 <- matrix(rnorm(10000*50), ncol = 50)
m2 <- matrix(sample(LETTERS, 10000*50, replace = TRUE), ncol = 50)
colnames(m1) <- paste("varA", sprintf("%02d", 1:50), sep = "_")
colnames(m2) <- paste("varB", sprintf("%02d", 1:50), sep = "_")
dt <- data.table(uid = 1:10000, m1, m2)

Функции для бенчмаркинга

test1 <- function() Stacked(dt, "uid", c("varA", "varB"), "_")

## merged.stack
test2 <- function() merged.stack(dt, "uid", c("varA", "varB"), "_")

## unlist(..., use.names = TRUE) -- OPTIMIZED
test3 <- function() {
  list(cbind(dt[, "uid", with = FALSE], 
             dt[, list(variable = rep(names(.SD), each = nrow(dt)), 
                       value = unlist(.SD)), 
                .SDcols = 2:51]),
       cbind(dt[, "uid", with = FALSE], 
             dt[, list(variable = rep(names(.SD), each = nrow(dt)), 
                       value = unlist(.SD)), 
                .SDcols = 52:101]))
}

## unlist(..., use.names = FALSE) -- OPTIMIZED
test4 <- function() {
  list(cbind(dt[, "uid", with = FALSE], 
             dt[, list(variable = rep(names(.SD), each = nrow(dt)), 
                       value = unlist(.SD, use.names = FALSE)), 
                .SDcols = 2:51]),
       cbind(dt[, "uid", with = FALSE], 
             dt[, list(variable = rep(names(.SD), each = nrow(dt)), 
                       value = unlist(.SD, use.names = FALSE)), 
                .SDcols = 52:101]))
}

## Andreas current answer
test5 <- function() {
  list(dt[, list(variable = names(.SD), 
                 value = unlist(.SD, use.names = FALSE)),
          by = uid, .SDcols = 2:51],
       dt[, list(variable = names(.SD), 
                 value = unlist(.SD, use.names = FALSE)), 
          by = uid, .SDcols = 52:101])
}

Результаты

library(microbenchmark)
microbenchmark(Stacked = test1(), merged.stack = test2(),
               unlist.namesT = test3(), unlist.namesF = test4(),
               AndreasAns = test5(), times = 3)
# Unit: milliseconds
#           expr        min         lq     median         uq        max neval
#        Stacked   391.3251   393.0976   394.8702   421.4185   447.9668     3
#   merged.stack   764.3071   769.6935   775.0799   867.2638   959.4477     3
#  unlist.namesT  1680.0610  1761.9701  1843.8791  1881.9722  1920.0653     3
#  unlist.namesF   215.0827   242.7748   270.4669   270.6944   270.9218     3
#     AndreasAns 16193.5084 16249.5797 16305.6510 16793.3832 17281.1154     3

^^ Я не знаю, почему сейчас настало время для ответа Андреаса. "Оптимизация", которую я делал, была в основном unlist без использования by, что сильно повлияло на столбцы "varB" (factor).

Ручной подход все еще быстрее, чем функции из "splitstackshape", но это миллисекунды, о которых мы говорим, и некоторые довольно компактные однострочные коды!

Пример вывода

Для справки, вот что выглядит вывод Stacked(). Это a list "stacked" data.table s, один элемент списка для каждой сложной переменной.

test1()
# $varA
#           uid .time_1       varA
#      1:     1      01 -0.6264538
#      2:     1      02 -0.8043316
#      3:     1      03  0.2353485
#      4:     1      04  0.6179223
#      5:     1      05 -0.2212571
#     ---                         
# 499996: 10000      46 -0.6859073
# 499997: 10000      47 -0.9763478
# 499998: 10000      48  0.6579464
# 499999: 10000      49  0.7741840
# 500000: 10000      50  0.5195232
# 
# $varB
#           uid .time_1 varB
#      1:     1      01    D
#      2:     1      02    A
#      3:     1      03    S
#      4:     1      04    L
#      5:     1      05    T
#     ---                   
# 499996: 10000      46    A
# 499997: 10000      47    W
# 499998: 10000      48    H
# 499999: 10000      49    U
# 500000: 10000      50    W

И вот, как выглядит вывод merged.stack. Это похоже на то, что вы получите, когда используете reshape(..., direction = "long") из базы R.

test2()
#           uid .time_1       varA varB
#      1:     1      01 -0.6264538    D
#      2:     1      02 -0.8043316    A
#      3:     1      03  0.2353485    S
#      4:     1      04  0.6179223    L
#      5:     1      05 -0.2212571    T
#     ---                              
# 499996: 10000      46 -0.6859073    A
# 499997: 10000      47 -0.9763478    W
# 499998: 10000      48  0.6579464    H
# 499999: 10000      49  0.7741840    U
# 500000: 10000      50  0.5195232    W

Ответ 3

Бесстыдная самореклама

Возможно, вы захотите попробовать melt_ из моего пакета Kmisc. melt_ - это, по сути, переписывание reshape2:::melt.data.frame с большей частью работы grunt, выполненной на C, и позволяет избежать как можно большего количества копий и типов принуждения для быстрой реализации.

Пример:

## devtools::install_github("Kmisc", "kevinushey")
library(Kmisc)
library(reshape2)
library(microbenchmark)
n <- 1E6
big_df <- data.frame( stringsAsFactors=FALSE,
  x=sample(letters, n, TRUE),
  y=sample(LETTERS, n, TRUE),
  za=rnorm(n),
  zb=rnorm(n),
  zc=rnorm(n)
)
all.equal(
  melt <- melt(big_df, id.vars=c('x', 'y')),
  melt_ <- melt_(big_df, id.vars=c('x', 'y'))
)
## we don't convert the 'variable' column to factor by default
## if we do, we see they're identical
melt_$variable <- factor(melt_$variable)
stopifnot( identical(melt, melt_) )
microbenchmark( times=5,
  melt=melt(big_df, id.vars=c('x', 'y')),
  melt_=melt_(big_df, id.vars=c('x', 'y'))
)

дает мне

Unit: milliseconds
  expr       min        lq    median         uq       max neval
  melt 916.40436 931.60031 999.03877 1102.31090 1160.3598     5
 melt_  61.59921  78.08768  90.90615   94.52041  182.0879     5

В любом случае это будет достаточно быстро для ваших данных.