我想知道这个问题是否有一些优雅的解决方案：
假设我有一个值向量
a <- c(1,2,3,3.1,3.2,5,6,7,7.1,7.2,9)
我只想将某些函数（例如均值）应用于满足特定条件的值，在这种情况下，值之间的差异小于 0.5 。
所以应该平均的值是(3,3.1,3.2)和(7,7.1,7.2)，函数应该返回向量
b <- c(1,2,3.1,5,6,7.1,9)
编辑：我尝试过的一种方法（不确定是否正确）是二值化向量a（1 表示值之间的差异0.5），所以我得到了向量
bin <– c(0,0,1,1,0,0,0,1,1,0)
但我不知道如何将均值应用于不同的组。所以对我来说主要问题是区分所需值的组并将平均值分别应用于它们。有什么想法吗？
我是新来的，如果有什么不清楚的地方，请告诉我。提前谢谢你。
【问题讨论】：
这不符合优雅的条件，但我认为它适用于您提供的情况。我使用rle (base R) 来识别差异小于 0.5 的运行。
a <- c(1, 2, 3, 3.1, 3.2, 5, 6, 7, 7.1, 7.2, 9)
crit <- diff(a) < 0.5
crit <- c(head(crit, 1), crit) | c(crit, tail(crit, 1))
run <- rle(crit)
aa <- split(a, rep(seq(length(run$lengths)), times=run$lengths))
myFun <- function(crit, val) {
if (crit) {
mean(val)
}
else {
val
}
}
unlist(mapply(FUN=myFun, crit=run$values, val=aa, USE.NAMES=FALSE))
产量：
> unlist(mapply(FUN=myFun, crit=run$values, val=aa, USE.NAMES=FALSE))
[1] 1.0 2.0 3.1 5.0 6.0 7.1 9.0
也许有人可以从中构建更清洁的解决方案。
更新：OP 指出这在 {3, 3.1, 3.2, 7, 7.1, 7.2} 之类的序列上失败，因为上面的代码将其集中在一次运行中并在整个序列中取平均值。这是一个更强大的解决方案。
a <- c(1, 2, 3, 3.1, 3.2, 7, 7.1, 7.2, 10)
run <- unclass(rle(diff(a) < 0.5))
len <- run$lengths
val <- run$values
pos <- seq_along(len)
last <- pos == max(pos)
len <- len + val - c(0, head(val, -1)) + (last * !val)
prevLen <- c(0, head(cumsum(len), -1))
myFun <- function(l, v, pl, x) {
if (l == 0) {
NULL
} else {
seg <- seq(l) + pl
if (v == TRUE) {
mean(x[seg])
} else {
x[seg]
}
}
}
unlist(mapply(FUN=myFun, l=len, v=val, pl=prevLen, MoreArgs=list(x=a)))
现在，每当遇到小差异运行（即val == TRUE）时，它都会在该小差异运行的长度上增加一个（即len + val），但该附加元素来自下一次运行，但是如果它不是一个小的差异运行（即last * !val），它不能从上次运行中窃取。
【讨论】：
crit <- c(head(crit, 1), crit) | c(crit, tail(crit, 1))。它比我的d <- diff(a); d <- c(d[1], d); rd <- abs(diff(rev(a))); rd <- c(rd[1], rd); dc <- d < thr | rd < thr 干净得多。
c(2,2.1,2.2,3,3.1,3.2) 中？有两组数字满足条件，所以结果应该是c(2.1,3.1)。但是，我无法区分使用您的解决方案的组，可能是因为它基于 TRUE 和 FALSE 值之间的变化，并且由于只有 TRUE 值，我不知道如何继续。
outerFun() 中，并将 a 作为唯一的输入。
也许我把问题复杂化了：
a <- c(1,2,3,3.1,3.2,5,6,7,7.1,7.2,9)
thr <- 0.5
## create a correct binary vector
d <- diff(a)
d <- c(d[1], d)
rd <- abs(diff(rev(a)))
rd <- c(rd[1], rd)
dc <- d < thr | rd < thr
# [1] FALSE FALSE TRUE TRUE TRUE FALSE FALSE TRUE TRUE TRUE FALSE
## use rle to count continous values
r <- rle(dc)
r
# Run Length Encoding
# lengths: int [1:5] 2 3 2 3 1
# values : logi [1:5] FALSE TRUE FALSE TRUE FALSE
## create grouping vector
groups <- double(length(a))
groups[!dc] <- seq(sum(!dc))
groups[dc] <- sum(!dc)+rep(seq(sum(r$values)), r$lengths[r$values])
groups
# [1] 1 2 6 6 6 3 4 7 7 7 5
## create mean for each group
m <- tapply(a, groups, FUN=mean)
m
# 1 2 3 4 5 6 7
# 1.0 2.0 5.0 6.0 9.0 3.1 7.1
## recreate origin order
m[order(unique(groups))] <- m
m
# 1 2 3 4 5 6 7
# 1.0 2.0 3.1 5.0 6.0 7.1 9.0
【讨论】：
基于ave的另一种可能性
# find id on which mean should be calculated
id1 <- which(diff(a) < 0.5)
id2 <- sort(union(id1, id1 + 1))
id2
# [1] 3 4 5 8 9 10
# group the id
grp <- cumsum(c(1, diff(id2)) - 1)
grp
# [1] 0 0 0 2 2 2
# calulate mean per group and insert into original vector
a[id2] <- ave(a[id2], grp)
a
# [1] 1.0 2.0 3.1 3.1 3.1 5.0 6.0 7.1 7.1 7.1 9.0
# remove duplicated means, i.e. remove index of duplicated values of grp
a[-id2[as.logical(ave(grp, grp, FUN = function(x) duplicated(x)))]]
# [1] 1.0 2.0 3.1 5.0 6.0 7.1 9.0
【讨论】：