Áp dụng chức năng trên giá trị nhất định trong vector (R)

Question

Tôi muốn biết nếu có một số giải pháp thanh lịch cho vấn đề này:

Hãy nói rằng tôi có một vector của các giá trị

a <- c(1,2,3,3.1,3.2,5,6,7,7.1,7.2,9)

và Tôi muốn áp dụng một số hàm (ví dụ: trung bình) chỉ cho các giá trị thỏa mãn điều kiện nhất định, trong trường hợp này là có sự khác biệt giữa các giá trị nhỏ hơn 0,5.

Vì vậy, các giá trị cần được trung bình là (3,3.1,3.2) và (7,7.1,7.2) và chức năng nên trở vector

b <- c(1,2,3.1,5,6,7.1,9)

Edit: Một cách tiếp cận tôi đã cố gắng (không chắc chắn nếu phải) là binarize vector a (1 ý nghĩa sự khác biệt giữa các giá trị là < 0,5; 0 có nghĩa là diff là> 0,5), vì vậy tôi có vector

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

nhưng tôi không biết cách áp dụng trung bình cho các nhóm riêng biệt. Vì vậy, vấn đề chính đối với tôi là phân biệt các nhóm giá trị cần thiết và áp dụng giá trị trung bình cho riêng chúng. Bất kỳ ý tưởng?

Tôi mới ở đây nên nếu có gì không rõ ràng, vui lòng cho tôi biết. Cảm ơn bạn trước.

Answer 1

Điều này không đủ điều kiện thanh lịch, nhưng tôi nghĩ rằng nó hoạt động trong trường hợp bạn cung cấp. Tôi sử dụng rle (cơ sở R) để xác định các nơi có độ chênh lệch nhỏ hơn 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)) 

Sản lượng:

> 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 

Có lẽ ai đó có thể xây dựng một giải pháp sạch hơn từ này.

---

Cập nhật: OP chỉ ra rằng điều này không thành công trên một chuỗi như {3, 3.1, 3.2, 7, 7.1, 7.2} vì mã trên cục u này vào một lần chạy thử và trung bình trên toàn bộ chuỗi. Đây là một giải pháp mạnh mẽ hơn.

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))) 

Bây giờ bất cứ khi nào nó đi qua một sự khác biệt nhỏ chạy (ví dụ, val == TRUE) điều ấy tăng thêm từ một đến chiều dài của sự chênh lệch nhỏ chạy (tức là, len + val), nhưng điều đó yếu tố bổ sung đến từ chạy tới, nhưng nó không thể ăn cắp từ lần chạy cuối cùng nếu nó không phải là một sự khác biệt nhỏ chạy (tức là, last * !val).

Answer 2

Có lẽ tôi overcomplicated vấn đề:

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

Một khả năng khác dựa trên 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