高效地计算一个数据框中另一个数据框的比例。

Question

我有这个 data.frame：

set.seed(1)
df <- cbind(matrix(rnorm(26,100),26,100),data.frame(id=LETTERS,parent.id=sample(letters[1:5],26,replace = T),stringsAsFactors = F))

每一行都是来自某个主题（由id指定）的100个测量值，该主题与父ID（由parent.id指定）相关联。 parent.id和id之间的关系是一对多的。

我正在寻找一种快速的方式，以获取每个df$id的分数（针对其100个测量值中的每一个），其中包括其parent.id的测量值。也就是说，对于df$id中的每个id，我希望将其100个测量值除以所有与其df$parent.id对应的df$id的测量值之和。

我的尝试如下：

sum.df <- dplyr::select(df,-id) %>% dplyr::group_by(parent.id) %>% dplyr::summarise_all(sum)

fraction.df <- do.call(rbind,lapply(df$id,function(i){
  pid <- dplyr::filter(df,id == i)$parent.id
  (dplyr::filter(df,id == i) %>% dplyr::select(-id,-parent.id))/
    (dplyr::filter(sum.df,parent.id == pid) %>% dplyr::select(-parent.id))
}))

然而，对于我的数据的真实维度：length(df$id) = 10,000，每个数据点有1,024个测量值，这个速度已经不够快了。

您有什么想法可以改进它，最好使用dplyr函数？

- user1701545

---

“我正在寻找一种快速的方法，以获取每个df$id（对于它的100个测量值中的每一个）相对于其parent.id测量值的分数。” 我不理解这句话。您能提供一个例子来说明您要计算什么吗？ - Maurits Evers

修改了我的帖子以使其更清晰。 - user1701545

你的数据框有多少维度？ - De Novo

10,000乘以1,024 - 请查看编辑后的帖子 - user1701545

如果您关心速度，那么转换为长格式可能会有所帮助。对于数据表 res = melt(DT, id=c("id", "parent.id"))[, v := value/sum(value), by=.(variable, parent.id)][] ，要回到宽格式，使用 dcast(res, id + parent.id ~ variable, value.var = "v") 即可。 - Frank

Answer 1

让我们使用 @Sathish 的答案中的新数据集定义，使用 microbenchmark 来比较这些选项：

原始方法：

Units: seconds
      min      lq     mean   median       uq      max neval
 1.423583 1.48449 1.602001 1.581978 1.670041 2.275105   100

@Sathish的方法可以将其加速约5倍，这确实很有价值。

Units: milliseconds
      min      lq     mean   median       uq      max neval
 299.3581 334.787 388.5283 363.0363 398.6714 951.4654   100 

以下是一种可能的基于R语言的实现，使用高效的R代码原则，将性能提升了约65倍（24毫秒，而不是1,582毫秒）：

Units: milliseconds
     min       lq     mean   median       uq      max neval
21.49046 22.59205 24.97197 23.81264 26.36277 34.72929   100

这是基于R语言的实现。与OP实现类似，结果结构中不包括parent.id和id列（在这里是fractions）。fractions是一个矩阵，其行按照sort(interaction(df$id, df$parent.id, drop = TRUE))排序。

values <- df[1:100]
parents <- split(values, df$parent.id)
sums <- vapply(parents, colSums, numeric(100), USE.NAMES = FALSE)
fractions <- matrix(0, 26, 100)
f_count <- 0
for (p_count in seq_along(parents)){
  parent <- as.matrix(parents[[p_count]])
  dimnames(parent) <- NULL
  n <- nrow(parent)
  for (p_row in seq_len(nrow(parent))){
    fractions[(f_count + p_row),] <- parent[p_row,] / sums[,p_count]
  }
  f_count <- f_count + p_row
}

注意：仍有改进的空间。`split()`不是特别高效。

注2：使用了哪些“高效R代码原则”？

1. 尽可能摆脱名称
2. 在矩阵中查找比在数据框中更快
3. 不要害怕使用for循环进行优化，只要你没有增加对象
4. 优先使用`vapply`而不是其他apply家族函数。

- De Novo

Answer 2

你的数据存在问题，所有行都是相同的副本，因此我稍微更改了它以反映数据集中的不同值。 数据：

set.seed(1L)
df <- cbind(matrix(rnorm(2600), nrow = 26, ncol = 100),data.frame(id=LETTERS,parent.id=sample(letters[1:5],26,replace = T),stringsAsFactors = F))

代码：

library('data.table')
setDT(df)  # assign data.table class by reference

# compute sum for each `parent.id` for each column (100 columns)
sum_df <- df[, .SD, .SDcols = which(colnames(df) != 'id' )][, lapply(.SD, sum ), by = .(parent.id ) ] 

# get column names for sum_df and df which are sorted for consistency
no_pid_id_df  <- gtools::mixedsort( colnames(df)[ ! ( colnames(df) %in% c( 'id', 'parent.id' ) ) ] )
no_pid_sum_df <-  gtools::mixedsort( colnames(sum_df)[ colnames(sum_df) != 'parent.id' ] )

# match the `parent.id` for each `id` and then divide its value by the value of `sum_df`.
df[, .( props = { 
  pid <- parent.id
  unlist( .SD[, .SD, .SDcols = no_pid_id_df ] ) /
    unlist( sum_df[ parent.id == pid, ][, .SD, .SDcols = no_pid_sum_df ] )
  }, parent.id ), by = .(id)]

输出：

#       id       props parent.id
#    1:  A -0.95157186         e
#    2:  A  0.06105359         e
#    3:  A -0.42267771         e
#    4:  A -0.03376174         e
#    5:  A -0.16639600         e
# ---                         
# 2596:  Z  2.34696158         e
# 2597:  Z  0.23762369         e
# 2598:  Z  0.60068440         e
# 2599:  Z  0.14192337         e
# 2600:  Z  0.01292592         e

基准测试：

library('microbenchmark')
microbenchmark( sathish(), frank(), dan())
# Unit: milliseconds
#     expr         min         lq       mean    median         uq       max neval cld
# sathish() 404.450219 413.456675 433.656279 420.46044 429.876085 593.44202   100   c
# frank()     2.035302   2.304547   2.707019   2.47257   2.622025  18.31409   100   a  
# dan()      17.396981  18.230982  19.316653  18.59737  19.700394  27.13146   100   b 

- Sathish

---

这并不是特别快。 - De Novo

这是比原始帖子提高了5倍的改进。点赞 :) - De Novo

我不确定是否认为这样会更快。如果你想加快速度，可以将其转换为矩阵，而在这种情况下，行与列或宽与长并不相关。 - De Novo

你是如何实现Frank的方法的？ - De Novo

不错！如果你想的话，可以加上我的内容进行比较。 - De Novo

frank <- function(){ melt(setDT(df), id=c("id", "parent.id"))[, v := value/sum(value), by=.(variable, parent.id)][]} - Sathish