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

我尝试使用不同列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=随机数 值=使用列号和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将循环的使用控制在最低限度，但我仍然必须在代码中使用for循环

有没有更快/更有效的方法来实现这一点？使用data.table

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)

这里有一个想法。df2包含扩展的年份、col和i。您可以进一步为df2创建p和值

---

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

下面是另一个data.table解决方案，该解决方案使用melt，但在实施细节上与以下解决方案不同：

如果我正确理解OP的意图，剩下的计算可以这样做

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

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

加上确保结果与预期结果一致的修改 我的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

即使对于这样小的问题规模，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个关键列组成。在样本数据集中，关键值的总体平均值为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]

---

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

您确实需要对代码进行矢量化。您可以以矢量化的方式轻松创建直到p和value阶段的所有内容。例如librarydata.table；res谢谢你的数据表建议。比循环快得多。更多的背景资料。初始数据集中的值表示某个年龄组（范围为5岁）的人数。关键词2：年龄0-5岁；关键词3：年龄5-10岁；等。通过这个公式，我试图模拟每个类别中个体的年龄。我也想添加这个问题，作为参考：也许你可以加快一些计算，如果没有更多的空行可用，只扩展data.table。可能重复@hannes101，我认为这不是一个好的重复目标。问题不是在data.table的末尾添加行，而是创建一个更大的数据集，即，上述3行最终扩展为2575行的新数据集，增加了900倍。但是，使用data.table的快速设置操作可能是其他答案的替代方法。如果你发布了一个解决方案，我很乐意将其包含在我的基准测试中。非常好的答案和比较。谢谢你的回答和清晰的解释。这段代码比我的原始代码运行得快得多。嗨@UweBlock，我有另一种来自tidyverse的方法，使用map2和unnest。请在我的回答中查看我的更新。你介意你也为这个做基准测试吗？没有理由认为data.table速度更快，但我认为最好知道避免按行操作是否是一个好规则，如果可能的话就这样做。@ycw是的，不客气。我的想法是通过改变影响问题大小的3个参数，为更大的问题案例添加基准运行。

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

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

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

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

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]

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