Question

我想知道这个问题是否有一些优雅的解决方案：

假设我有一个值向量

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; 0意味着差异> 0.5），所以我有矢量

bin <– c(0,0,1,1,0,0,0,1,1,0)

但我不知道如何将平均值应用于不同的组。所以我的主要问题是区分所需的值组并分别对它们应用均值。有什么想法吗？

我是新来的，如果有什么不清楚的地方，请告诉我。提前谢谢。

Answer 1

这不符合优雅，但我认为它适用于您提供的情况。我使用rle（基数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），它就不能从最后一次运行中偷走。

Answer 2

也许我过分复杂化了问题：

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

Answer 3

基于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

在向量（R）中的某些值上应用函数

3 个答案: