在 R 中扩展数据集的快速有效方法答案

【问题标题】：Fast and efficient way to expand a dataset in R在 R 中扩展数据集的快速有效方法
【发布时间】：2017-06-25 13:49:12
【问题描述】：

我尝试使用来自不同列 (Key2 - KeyX) 的值在 R 中扩展数据集，然后使用公式中的列号计算一些值。

我要扩展的部分数据集示例

Year Key2 Key3 Key4 Key5 ...
2001  150  105  140  140
2002  130   70   55   80
2003  590  375  355  385
...

首选结果。

i = 索引号
col = 列号（Key2 = 1，Key3 = 2 等）
p = 随机数

value = 使用列号和 p 计算的值

year   i col         p     value
2001   1   1 0.7481282 4.0150810
2001   2   1 0.8449366 2.0735090
2001 ...   1 0.1906882 0.9534411
2001 150   1 0.8030162 3.7406410
2001   1   2 0.4147019 4.2246831
2001   2   2 0.3716995 1.8584977
2001 ...   2 0.5280272 2.6401361
2001 105   2 0.8030162 3.7406410
2001   1   3 0.7651376 3.8256881
2001   2   3 0.2298984 1.1494923
2001 ...   3 0.5607825 2.8039128
2001 140   3 0.7222644 3.6113222
etc.

2002   1   1 0.1796613 0.8983065
2002   2   1 0.6390833 3.1954165
2002 ...   1 0.5280272 2.6401367
2002 130   1 0.4238842 2.1194210
2002   1   2 0.7651376 3.8256889
2002   2   2 0.2298984 1.1494928
2002 ...   2 0.5607825 2.8039125
2002  70   2 0.7222644 3.6113227
2002   1   3 0.7512801 3.7564000
2002   2   3 0.4484248 2.2421240
2002 ...   3 0.5662704 2.8313520
2002  55   3 0.7685377 3.8426884
etc.

我在 R 中使用以下代码，但是对于大型数据集，它非常慢。我试图通过使用rep() 将循环的使用保持在最低限度，但我仍然需要在代码中进行循环。

R 有没有更快/更有效的方法来做到这一点？使用数据表？

val <- c(); i <- c(); cols <- c(); p <- c(); year <- c()
for (year in 1:10) {
  for (n in 2:25) {
      c <- n-1
      pu <- runif(dataset1[[year, n]])
      p <- c(p, pu )
      tmp <- (c-1)*5 + 5*pu
      val <- c(val, tmp)
      ##
      i <- c(i, 1:dataset1[[year, n]])
      cols <- c(cols, rep(c, dataset1[[year, n]]) )
      year <- c(year, rep(dataset1[[year,1]], dataset1[[year, n]]) )
  }
}
res.df <- data.frame(year=year, i=i, cols=cols, p=p, val=val)
res.df <- setDT(res.df)

【问题讨论】：

你真的需要向量化你的代码。您可以以矢量化方式轻松创建直到 p 和 value 阶段的所有内容。例如library(data.table) ; res <- setorder(melt(setDT(DT), id = "Year", value = "i", variable = "col")[rep(1:.N, i)], Year, col)[, i := seq_len(.N), by = .(Year, col)]。我不明白您是如何创建p 和value，但runif 已矢量化，不要使用循环 以运行矢量化操作。如果你能解释你到底在做什么，你可以在一次调用中创建这两个列。
感谢data.table 的建议。比循环快得多。一些更多的背景信息。初始数据集中的值表示某个年龄组的人数，范围为 5 岁。 Key2：年龄0-5岁； Key3：年龄5-10岁；等等。使用公式，我尝试模拟每个类别中个人的年龄。
我也想添加这个问题，作为参考：stackoverflow.com/questions/40175658/… 如果没有更多可用的空行，您可以通过仅扩展 data.table 来加快一些计算。
Add a row by reference at the end of a data.table object的可能重复
@hannes101 我不认为这是一个好的欺骗目标。问题不是关于在 data.table 末尾添加行，而是创建一个更大的数据集，即上述 3 行最终扩展为 2575 行的新数据集，即增加了 900 倍。但是，使用data.table 的快速set() 操作可能是其他答案的替代方法。如果您发布解决方案，我很乐意将其包含在我的基准测试中。

标签： r data.table dplyr

【解决方案1】：

问题的核心是将Key列中的值扩展为i。

这是另一个采用melt() 的data.table 解决方案，但在实现细节上与David's comment 不同：

library(data.table)
DT <- data.table(dataset1)
expanded <- melt(DT, id.vars = "Year", variable = "col")[, col := rleid(col)][
  , .(i = seq_len(value)), by = .(Year, col)]
expanded

      Year col   i
   1: 2001   1   1
   2: 2001   1   2
   3: 2001   1   3
   4: 2001   1   4
   5: 2001   1   5
  ---             
2571: 2003   4 381
2572: 2003   4 382
2573: 2003   4 383
2574: 2003   4 384
2575: 2003   4 385

剩余的计算可以这样完成（如果我理解 OP 的意图正确的话）

set.seed(123L) # make results reproducable
res.df <- expanded[, p := runif(.N)][, value := 5 * (col - 1L + p)][]
res.df

      Year col   i         p     value
   1: 2001   1   1 0.2875775  1.437888
   2: 2001   1   2 0.7883051  3.941526
   3: 2001   1   3 0.4089769  2.044885
   4: 2001   1   4 0.8830174  4.415087
   5: 2001   1   5 0.9404673  4.702336
  ---                                 
2571: 2003   4 381 0.4711072 17.355536
2572: 2003   4 382 0.5323359 17.661680
2573: 2003   4 383 0.3953954 16.976977
2574: 2003   4 384 0.4544372 17.272186
2575: 2003   4 385 0.1149009 15.574505

对不同方法进行基准测试

由于 OP 要求更快/更有效的方法，目前提出的三种不同方法正在被基准测试：

David's data.table solution 加上确保结果与预期结果相同的修改
ycw's tidyverse solution
我的data.table 解决方案

基准代码

对于基准测试，使用了microbenchmark 包。

library(magrittr)
bm <- microbenchmark::microbenchmark(
  david1 = {
    expanded_david1 <-
      setorder(
        melt(DT, id = "Year", value = "i", variable = "col")[rep(1:.N, i)], Year, col
      )[, i := seq_len(.N), by = .(Year, col)]
  },
  david2 = {
    expanded_david2 <-
      setorder(
        melt(DT, id = "Year", value = "i", variable = "col")[, col := as.integer(col)][
          rep(1:.N, i)], Year, col)[, i := seq_len(.N), by = .(Year, col)]
  },
  uwe = {
    expanded_uwe <- 
      melt(DT, id.vars = "Year", variable = "col")[, col := rleid(col)][
        , .(i = seq_len(value)), by = .(Year, col)]
  },
  ycw = {
    expanded_ycw <- DT %>%
      tidyr::gather(col, i, - Year) %>%
      dplyr::mutate(col = as.integer(sub("Key", "", col)) - 1L) %>%
      dplyr::rowwise() %>%
      dplyr::do(tibble::data_frame(Year = .$Year, col = .$col, i = seq(1L, .$i, 1L))) %>%
      dplyr::select(Year, i, col) %>%
      dplyr::arrange(Year, col, i)
  },
  times = 100L
)
bm

请注意，对tidyverse 函数的引用是明确的，以避免由于名称空间混乱而导致名称冲突。修改后的david2 变体将因子转换为水平数。

定时小样本数据集

使用 OP 提供的 3 年和 4 个Key 列的小样本数据集，时间安排如下：

Unit: microseconds
   expr       min         lq        mean    median         uq        max neval
 david1   993.418  1161.4415   1260.4053  1244.320   1350.987   2000.805   100
 david2  1261.500  1393.2760   1624.5298  1568.097   1703.837   5233.280   100
    uwe   825.772   865.4175    979.2129   911.860   1084.226   1409.890   100
    ycw 93063.262 97798.7005 100423.5148 99226.525 100599.600 205695.817   100

即使对于这个小问题，data.table 的解决方案也比tidyverse 方法快很多，但uwe 的解决方案略有优势。

检查结果是否相等：

all.equal(expanded_david1[, col := as.integer(col)][order(col, Year)], expanded_uwe)
#[1] TRUE
all.equal(expanded_david2[order(col, Year)], expanded_uwe)
#[1] TRUE
all.equal(expanded_ycw, expanded_uwe)
#[1] TRUE

除了 david1 返回因子而不是整数和不同的顺序之外，所有四个结果都是相同的。

更大的基准案例

从 OP 的代码可以得出结论，他的生产数据集由 10 年和 24 个Key 列组成。在样本数据集中，Key 值的总体平均值为 215。使用这些参数，正在创建一个更大的数据集：

n_yr <- 10L
n_col <- 24L
avg_key <- 215L
col_names <- sprintf("Key%02i", 1L + seq_len(n_col))
DT <- data.table(Year = seq(2001L, by = 1L, length.out = n_yr))
DT[, (col_names) := avg_key]

较大的数据集返回 51600 行，大小仍然相当适中，但比小样本大 20 倍。时间安排如下：

Unit: milliseconds
   expr         min          lq        mean      median          uq         max neval
 david1    2.512805    2.648735    2.726743    2.697065    2.698576    3.076535     5
 david2    2.791838    2.816758    2.998828    3.068605    3.075780    3.241160     5
    uwe    1.329088    1.453312    1.585390    1.514857    1.634551    1.995142     5
    ycw 1641.527166 1643.979936 1646.004905 1645.091158 1646.599219 1652.827047     5

对于这个问题规模，uwe 的速度几乎是其他 data.table 实现的两倍。 tidyverse 方法仍然慢很多。

【讨论】：

很好的答案和比较。
感谢您的出色回答和清晰的解释。这段代码比我原来的代码运行得快很多。
嗨@UweBlock，我有来自tidyverse 的另一种方法，使用map2 和unnest。请在我的回答中查看我的更新。你介意你是否也为此做基准测试吗？没有人说data.table 更快，但我认为如果可能的话，最好知道避免rowwise 和do 是否是一个好规则。
@ycw 是的，不客气。我的想法是通过改变影响问题大小的 3 个参数来为更大的问题案例添加基准测试。

【解决方案2】：

这是一个想法。 df2 包含扩展的 Year、col 和 i。您可以进一步为df2 创建p 和value。

# Load package
library(tidyverse)

# Create example data frame
dt <- read.table(text = "Year Key2 Key3 Key4 Key5
2001  150  105  140  140
                 2002  130   70   55   80
                 2003  590  375  355  385",
                 header = TRUE, stringsAsFactors = FALSE) 


# Expand the data frame
dt2 <- dt %>%
  gather(col, i, - Year) %>%
  mutate(col = as.numeric(sub("Key", "", col)) - 1) %>%
  rowwise() %>%
  do(data_frame(Year = .$Year, col = .$col, i = seq(1, .$i, 1))) %>%
  select(Year, i, col) %>%
  arrange(Year, col, i)

更新

tidyverse 的另一种方法。

# Expand the data frame
dt2 <- dt %>%
  gather(col, i, - Year) %>%
  mutate(col = as.numeric(sub("Key", "", col)) - 1) %>%
  mutate(i = map2(1L, i, seq, by = 1)) %>%
  unnest() %>%
  select(Year, i, col) %>%
  arrange(Year, col, i)

【讨论】：