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

Question

我尝试使用来自不同列（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)

Answer 1

问题的核心是价值观的扩展 Key列为i.

这是另一个data.table采用melt()但与大卫评论不同的解决方案：

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 要求更快/更有效的方式，因此目前对三种不同的方法进行了基准测试：

• 大卫的data.table解决方案加上修改，以确保结果与预期结果相同
• ycw的tidyverse解决方案
• 我的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变体将因子转换为级别数。

定时小样本数据集

对于KeyOP 提供的3 年 4列的小样本数据集，时间如下：

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

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

更大的基准案例

从 OP 的代码可以得出结论，他的生产数据集由 10 年和 24Key列组成。在示例数据集中，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方法仍然慢了几个数量级。