tl.dr。我有一个我之前在文档中看不到的聚合问题。我设法完成它，但它对于预期的应用程序来说太慢了。我通常使用的数据有大约500行（我的直觉告诉我这对于dplyr来说并不多）并且根据system.time它运行大约4秒。我的困境是我想反复进行优化运行，目前我正在考虑运行时间。
你看到我可以在一段时间内刮胡子了吗？
如果需要，我也可以发送一些我使用的数据。
算法 我有一个数据集：
sample_dataset <- data_frame( starts = c(1000, 1008, 1017, 2000, 2020, 3000),
ends = c(1009, 1015, 1020, 2015, 2030, 3010),
v = list(rep(1,10), rep(2,8),rep(3,4),
rep(4,16), rep(5,11), rep(6,11)) )
所以每一行都编码一个信号和一个开始和结束索引。我希望将距离小于closeness（例如10）的所有行聚合成一行。如果有问题starts已订购。
输出应为：
structure(list(inds = 1:3, starts = c(1000, 2000, 3000), ends = c(1020,
2030, 3010), v = list(c(1, 1, 1, 1, 1, 1, 1, 1, 3, 3, 2, 2, 2,
2, 2, 2, 0, 3, 3, 3, 3), c(4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
4, 4, 4, 4, 0, 0, 0, 0, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5), c(6,
6, 6, 6, 6, 6, 6, 6, 6, 6, 6))), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -3L), .Names = c("inds", "starts", "ends",
"v"))
因此，原始数据集中的前三行是聚合的，第4行和第5行是聚合的，6是未更改的。对于重叠，应该添加数字，填充空白零。更新的开始值是第一次开始，更新的结束应该是最后的结束（假设我应该将其修复到最大值）。但顺便说一下这些生成结束也应该排序。不应发生一个块完全被另一个块包围的情况。
我通过以下代码实现了这个目标：
代码
library(dplyr)
join_lines <- function(dfi) {
if (nrow(dfi)==1) return(select(dfi,starts,ends, v))
else
with(dfi,{
start <- starts[[1]]
end <- ends[[length(ends)]]
vals <- numeric(end-start+1)
add_val <- function(ddf)
with(ddf,{
vals[(starts-start+1) : (ends-start+1)] <<-
vals[(starts-start+1) : (ends-start+1)] + v })
dfi %>% rowwise() %>% do(tmp=add_val(.))
data_frame(starts=start, ends=end, v=list(vals))})
}
simplify_semisparse <- function(aframe, closeness = 10){
aframe %>%
mutate( join_pre = lag(ends, default=0)+closeness >= (starts),
inds = cumsum(!join_pre)
) %>%
group_by(inds) %>% do(join_lines(.)) %>% ungroup()
}
res <- simplify_semisparse(sample_dataset)
dput(res) # see above
背景
我正在处理的数据来自质谱。非常特殊的是，矢量具有大约500,000个条目，并且其中不到10％不是零，典型的光谱具有大约500个这样的密集块。我确实需要在这样的频谱中快速插值 - 我的想法是在密集的＆＃34;中使用approx。区域。
建议比较
我有机会比较你的建议。
@ matt-jewett解决方案产生的结果与我的预期结果不一致，所以我确实排除了它。
@jeremycgs解决方案最接近我原来的方法，但也没有产生完全相同的结果。
最重要的是我的运行时，我正在使用生产数据进行比较。我的原始解决方案需要2.165秒。 @tjeremy的建议耗时0.532秒，@ uwe-block 0.012秒。
哇 - 我需要学习data.table。
答案 0 :(得分：5)
这是我怎么做的。您在v中使用列表不是最佳做法（在我看来），因此我使用tidyr来取消更长的数据帧。我还遗漏了你的0 - 你可以将它们添加回来，就像左边的连接或索引上的东西一样：
library(tidyr)
sample_dataset %>%
mutate(grouper = cumsum(c(0, na.omit(starts - lag(starts)))>20), id = row_number()) %>% #add a 'grouping' based on your closeness (20 here) and an id for later
unnest(v) %>% #unnest v into lines - each v now has a line
group_by(id) %>% #group by line
mutate(count = row_number()+starts) %>% #get a 'location' per line
group_by(grouper, count) %>% #group by the 'location' and group
summarise(starts = starts[1], ends = ends[n()], v = sum(v)) #sum the v
给出：
Source: local data frame [58 x 5]
Groups: grouper [?]
grouper count starts ends v
<int> <dbl> <dbl> <dbl> <dbl>
1 0 1001 1000 1009 1
2 0 1002 1000 1009 1
3 0 1003 1000 1009 1
4 0 1004 1000 1009 1
5 0 1005 1000 1009 1
6 0 1006 1000 1009 1
7 0 1007 1000 1009 1
8 0 1008 1000 1009 1
9 0 1009 1000 1015 3
10 0 1010 1000 1015 3
# ... with 48 more rows
然后，如果你真的想要，你可以用0填充缺失值（out这里是上面的输出）：
filled = out %>% group_by(grouper) %>% do(data.frame(count = seq(from = .$starts[1], to = tail(.$ends,1))))
filled = filled %>% left_join(out, by = c('grouper', 'count'))
filled$v[is.na(filled$v)] = 0
Source: local data frame [63 x 5]
Groups: grouper [?]
grouper count starts ends v
<int> <dbl> <dbl> <dbl> <dbl>
1 0 1000 NA NA 0
2 0 1001 1000 1009 1
3 0 1002 1000 1009 1
4 0 1003 1000 1009 1
5 0 1004 1000 1009 1
6 0 1005 1000 1009 1
7 0 1006 1000 1009 1
8 0 1007 1000 1009 1
9 0 1008 1000 1009 1
10 0 1009 1000 1015 3
# ... with 53 more rows
答案 1 :(得分：4)
虽然OP已请求加速dplyr代码，但出于性能原因，我建议使用data.table解决方案。此外，到目前为止发布的其他答案中没有完全满足OP的要求，即
sample_data的结构与starts，ends以及v值列表保持一致以下代码尝试符合所有要求：
library(data.table) # CRAN versio 1.10.4 used
# define threshold: closeness as defined by OP, max_gap used in code
closeness <- 10L
max_gap <- closeness - 1L
# coerce to data.table, and key, i.e., sort by starts and ends
DT <- data.table(sample_dataset, key = c("starts", "ends"))
# compute gaps between ends and starts of next row
# identify rows which belong together: inds is advanced if gap is greater threshhold
DT[, gap := starts - shift(ends, fill = -Inf)][, inds := cumsum(gap > max_gap)][]
# close gaps but only within groups
DT0 <- DT[between(gap, 2L, max_gap), .(starts = starts - (gap - 1L), ends = starts - 1L,
v = Vectorize(rep.int)(0L, gap - 1L), gap, inds)]
# bind rowwise (union in SQL), setkey on result to maintain sort order,
# remove column gap as no longer needed
DT2 <- setkey(rbind(DT, DT0), starts, ends)[, gap := NULL][]
# aggregate groupwise, pick min/max, combine lists
result <- DT2[, .(starts = min(starts), ends = max(ends), v = list(Reduce(c, v))), by = inds]
# alternative code: pick first/last
result <- DT2[, .(starts = first(starts), ends = last(ends), v = list(Reduce(c, v))), by = inds]
result
产生
inds starts ends v 1: 1 1000 1020 1,1,1,1,1,1, 2: 2 2000 2030 4,4,4,4,4,4, 3: 3 3000 3010 6,6,6,6,6,6,
带
result$v
[[1]] [1] 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 0 3 3 3 3 [[2]] [1] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 0 0 0 0 5 5 5 5 5 5 5 5 5 5 5 [[3]] [1] 6 6 6 6 6 6 6 6 6 6 6
可以验证v向量中的元素数量是相同的，除了为组内间隙添加的额外零：
# test that all v values are included
# original
sum(lengths(sample_dataset$v))
#[1] 60
# result with additional zeros removed
sum(sapply(result$v, function(x) sum(x > 0)))
#[1] 60
我还没有提供基准测试，因为样本数据集太小了。
sample_dataset <- dplyr::data_frame( starts = c(1000, 1008, 1017, 2000, 2020, 3000),
ends = c(1009, 1015, 1020, 2015, 2030, 3010),
v = list(rep(1,10), rep(2,8),rep(3,4),
rep(4,16), rep(5,11), rep(6,11)) )