Anwenden Funktion über bestimmte Werte im Vektor (R)

Question

Ich würde gerne wissen, ob es eine elegante Lösung für dieses Problem ist:

Sagen wir, ich habe einen Vektor von Werten

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

und Ich möchte eine Funktion (zB Mittelwert) nur auf Werte anwenden, die eine bestimmte Bedingung erfüllen, die in diesem Fall den Unterschied zwischen Werten kleiner als 0,5 haben soll.

So sind die Werte, die gemittelt werden sollten, sind (3,3.1,3.2) und (7,7.1,7.2) und die Funktion zurückkehren sollte Vektor

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

Edit: Ein Ansatz Ich habe versucht (nicht sicher, ob rechts) ist der Vektor zu digitalisieren, a (1 Bedeutung der Differenz zwischen den Werten ist < 0,5; 0 die diff bedeutet> 0,5), so dass ich Vektor

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

aber ich weiß nicht, wie man sich auf die einzelnen Gruppen von Einsen bezieht. Das Hauptproblem für mich besteht also darin, die Gruppen der benötigten Werte zu unterscheiden und den Mittelwert für sie separat anzuwenden. Irgendwelche Ideen?

Ich bin neu hier also wenn etwas unklar ist, lass es mich wissen. Vielen Dank im Voraus.

Answer 1

Dies gilt nicht als elegant, aber ich denke, dass es in dem Fall funktioniert, den Sie bereitstellen. Ich verwende rle (Basis R), um Läufe zu identifizieren, bei denen Diffs kleiner als 0,5 sind.

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

Ausbeuten:

> 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 

Vielleicht aus dieser jemand kann eine sauberere Lösung bauen.

---

Update: OP weist darauf hin, dass diese auf einer Sequenz nicht wie {3, 3.1, 3.2, 7, 7.1, 7.2}, da der Code über Klumpen dieses in einen Lauf und mittelt über die gesamte Sequenz. Hier ist eine robustere Lösung.

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

Nun, wenn es über einen kleinen Unterschied kommt laufen (dh val == TRUE) es eine auf die Länge dieser kleinen Differenz Lauf addiert (dh len + val), aber das zusätzliche Element stammt aus dem nächsten Lauf, aber Es kann nicht vom letzten Lauf stehlen, wenn es kein kleiner Unterschied ist (zB last * !val).

Answer 2

Vielleicht zu kompliziert ich das Problem:

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

Eine andere Möglichkeit basiert auf 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