1

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.

IInatas
  • 47
  • 5
  • Did you mean `s`liding window? :) – Arun Jul 22 '13 at 15:05
  • I can't understand your problem, but what you would like to do is exactly described by the function `rollapply` in the package `zoo`. – Simon O'Hanlon Jul 22 '13 at 15:18
  • @Arun: indeed; I meant a sliding window. I'm sorry about the confusion ;) – IInatas Jul 22 '13 at 18:07
  • @SimonO101: I was trying to get rollapply to work on my data, but I wasn't successfull in the end. I looked up the following questions here: [link](http://stackoverflow.com/questions/8370999/rollapply-time-series-in-r-zoo-on-backward-looking-data), [link](http://stackoverflow.com/questions/4529838/using-rollapply-on-two-columns) and [link](http://stackoverflow.com/questions/13771385/is-there-a-function-like-rollapply-for-data-frame) Somehow I don't understand what I should do with rollapply to receive a correct result, like the one I showed. Regards. – IInatas Jul 22 '13 at 18:33

1 Answers1

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)
Joshua Ulrich
  • 173,410
  • 32
  • 338
  • 418