counting values within a certain range within a sliding window - r

Question

The problem that I like to solve is a sliding window going over the measurement data with a defined window width and a controllable stepwidth (there 1).
Within the window I need to detect a number of values within a certain range of the
first value expl. 2.2 +- 0.3 and count the number of such values in a row
expl. 2.2, 2.3, 2.1 , 1.8, 2.2, 2.5, 2.1 --> 3,1,3
d <- read.table(text="Number Time.s Potential.V Current.A
1 0.0000 0.075 -0.7653
2 0.0285 0.074 -0.7597
3 0.0855 0.076 -0.7549
17 0.8835 0.074 -0.7045
18 0.9405 0.073 -0.5983
19 0.9975 0.071 -0.1370
19 1.0175 0.070 -0.1370
20 1.0545 0.072 0.1295
21 1.1115 0.073 0.2680
8013 1.6555 0.076 -1.1070
8014 1.7125 0.075 -1.1850
8015 1.7695 0.073 -1.2610
8016 1.8265 0.072 -1.3460
8017 1.8835 0.071 -1.4380
8018 1.9405 0.070 -1.4350
8019 1.9975 0.061 -1.0720
8020 2.1045 0.062 -0.8823
8021 2.1115 0.058 -0.7917
8022 2.1685 0.060 -0.7481", header=TRUE)
rle(round(diff(d$Time.s[d$Time.s>1 & d$Time.s<2]),digits=2))
I can't use rle, because there is no acceptance interval one could define. Working with
a for loop is possible, but seams very un'R'ish.
width=4
bound.low <- 0.00
bound.high <- 0.03
Ergebnis <- data.frame(
Potential.V=seq(1,(nrow(d)-width),by=1),count=seq(1,(nrow(d)-width),by=1))
for (a in 1:(nrow(d)-width)) {
temp <- d[a:(a+width),c("Time.s","Potential.V")]
counter=0
for (b in 1:nrow(temp)){
if (temp$Potential.V[1] >= (temp$Potential.V[b] - bound.low ) &
temp$Potential.V[1] <= (temp$Potential.V[b] + bound.high) ){
(counter=counter+1)
} else { break() }
}
Ergebnis$Potential.V[a] <- temp$Potential.V[1]
Ergebnis$count[a] <- counter
}
print(Ergebnis)
Result
Potential.V count
1 0.075 2
2 0.074 1
3 0.076 5
4 0.074 5
5 0.073 5
6 0.071 2
7 0.070 1
8 0.072 1
9 0.073 1
10 0.076 5
11 0.075 5
12 0.073 5
13 0.072 5
14 0.071 5
15 0.070 5
rle(Ergebnis$count)
Run Length Encoding
lengths: int [1:6] 1 1 3 1 3 6
values : num [1:6] 2 1 5 2 1 5
So I find the needed counts in the lengths vector.
Is there a more elegant way of solving such problems ? My experiments with xts and zoo didn't worked out like I thought
best regards,
IInatas
P.S.
The reason for this data analysis is log data from an experiment which has a degrading problem with an increasing severity in relation to certain voltages. In the end there is a lifetime account and I try to calculate the rest that is left, based on this log data.

Answer 1

Here's a solution using zoo::rollapply to calculate Ergebnis, but you still need to run rle on the result.
# the function we're going to apply to each window
f <- function(x, upper=0.03, lower=0.00) {
# logical test
l <- x[1] >= (x-lower) & x[1] <= (x+upper)
# first FALSE value
m <- if(any(!l)) which.min(l) else length(l)
c(Potential.V=x[1],count=sum(l[1:m]))
}
Ergebnis <- data.frame(rollapply(d$Potential.V, 5, f, align='left'))
rle(Ergebnis$count)