Question

我有Trip length:<br/> <input type="radio" name="length" value="1 week" onClick="radioClick()"> 1 week<br> <input type="radio" name="length" value="2 weeks" onClick="radioClick()"> 2 weeks<br> <input type="radio" name="length" onClick="radioClick()" id="rb">Other <br/> <textarea name="length" id="other" value=""></textarea>：

data.frame

每行是来自特定主题的100次测量（由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（由id指定）相关联。 parent.id和parent.id之间的关系是一对多的。

我正在寻找一种快速的方法来获得id的每个df$id（对于100次测量中的每次测量）的分数。这意味着对于parent.id中的每个id，我想将其100个测量值中的每一个除以其对应于其df$id的所有df$id的测量值之和。 }。

我尝试的是：

df$parent.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)) })) = 10,000，测量1,024次，这还不够快。

任何想法如何改进，理想情况下使用length(df$id)函数？

Answer 1

让我们将这些选项与microbenchmark进行比较，全部使用@ Sathish答案中数据集的新定义：

OP方法：

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代码＆＃34;原则＆＃34;原则用过吗？

随时删除姓名
在矩阵中查找比数据框更快的内容
如果您没有成长对象，请不要害怕效率循环
首选vapply适用于其他家庭功能。

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

有效地计算一个数据帧与另一个数据帧的比例

2 个答案: