[R] sliding window over a large vector

[Veslot Jacques]

Hi,

I just wrote a function quicker than slide() function with the same output, but I don't know what to do with this function! 

> sl <- function(x,z) c(0,cumsum(diff(x)[1:(length(x)-z-1)])) + rep(sum(x[1:z]),length(x)-z)

> sl(c(0,0,1,1,0,1,1,1,1,0,0,0,1,0,1,0,1,1,0,1,1,0,1,0),3)
 [1] 1 1 2 2 1 2 2 2 2 1 1 1 2 1 2 1 2 2 1 2 2
 
> slide<-function(seq,window){
+    n<-length(seq)-window
+    tot<-c()
+    tot[1]<-sum(seq[1:window])   
+    for (i in 2:n) {
+       tot[i]<- tot[i-1]-seq[i-1]+seq[i]
+    }
+    return(tot)
+ }
  
> sl(c(0,0,1,1,0,1,1,1,1,0,0,0,1,0,1,0,1,1,0,1,1,0,1,0),3)
 [1] 1 1 2 2 1 2 2 2 2 1 1 1 2 1 2 1 2 2 1 2 2

> slide(c(0,0,1,1,0,1,1,1,1,0,0,0,1,0,1,0,1,1,0,1,1,0,1,0),3)
 [1] 1 1 2 2 1 2 2 2 2 1 1 1 2 1 2 1 2 2 1 2 2



> sl <- function(x,z) c(0,cumsum(diff(x)[1:(length(x)-z-1)])) +  rep(sum(x[1:z]),length(x)-z) 

> x <- rbinom(100000, 1, 0.5)

> system.time(xx1 <- slide(x,12))
utilisateur     système      écoulé 
      36.86        0.45       37.32 
> system.time(xx2 <- sl(x,12))
utilisateur     système      écoulé 
       0.01        0.00        0.02 
> all.equal(xx1,xx2)
[1] TRUE

Jacques VESLOT

CEMAGREF - UR Hydrobiologie

Route de Cézanne - CS 40061      
13182 AIX-EN-PROVENCE Cedex 5, France

Tél.   + 0033   04 42 66 99 76
fax    + 0033   04 42 66 99 34
email   jacques.veslot at cemagref.fr  


>-----Message d'origine-----
>De : markleeds at verizon.net [mailto:markleeds at verizon.net]
>Envoyé : mardi 16 décembre 2008 10:25
>À : Veslot Jacques
>Cc : Chris Oldmeadow; r-help at r-project.org
>Objet : Re: [R] sliding window over a large vector
>
>Hi: Veslot:  I'm too tired to even try to figure out why but I think
>that there is something wrong with your sl function. see below for an
>empirical
>proof of that statement.  OR maybe you're definition of sliding window
>is different than rollapply's definition but rollapply's answer makes
>more sense to me ?
>
>Output
>
>> set.seed(1)
>> x <- rbinom(24, 1, 0.5)
>> print(x)
>  [1] 0 0 1 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 0 1 1 0 1 0
>>
>> xx1 <- sl(x,3)
>> print(xx1)
>  [1] 1 1 2 2 1 2 2 2 2 1 1 1 2 1 2 1 2 2 1 2 2
>>
>> temp <- zoo(x)
>> ans<-rollapply(temp,3,sum)
>> print(ans)
>  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
>  1  2  2  2  2  3  3  2  1  0  1  1  2  1  2  2  2  2  2  2  2  1
>
>
>On Tue, Dec 16, 2008 at  3:47 AM, Veslot Jacques wrote:
>
>>> sl <- function(x,z) c(0,cumsum(diff(x)[1:(length(x)-z-1)])) +
>>> rep(sum(x[1:z]),length(x)-z)
>>> x <- rbinom(100000, 1, 0.5)
>>> system.time(xx1 <- slide(x,12))
>> utilisateur     système      écoulé       36.86        0.45
>> 37.32
>>> system.time(xx2 <- sl(x,12))
>> utilisateur     système      écoulé        0.01        0.00
>> 0.02
>>> all.equal(xx1,xx2)
>> [1] TRUE
>>
>> Jacques VESLOT
>>
>> CEMAGREF - UR Hydrobiologie
>>
>> Route de Cézanne - CS 40061      13182 AIX-EN-PROVENCE Cedex 5, France
>>
>> Tél.   + 0033   04 42 66 99 76
>> fax    + 0033   04 42 66 99 34
>> email   jacques.veslot at cemagref.fr
>>
>>> -----Message d'origine-----
>>> De : r-help-bounces at r-project.org
>>> [mailto:r-help-bounces at r-project.org] De la part
>>> de Chris Oldmeadow
>>> Envoyé : mardi 16 décembre 2008 05:20
>>> À : r-help at r-project.org
>>> Objet : [R] sliding window over a large vector
>>>
>>> Hi all,
>>>
>>> I have a very large binary vector, I wish to calculate the number of
>>> 1's  over sliding windows.
>>>
>>> this is my very slow function
>>>
>>> slide<-function(seq,window){
>>>   n<-length(seq)-window
>>>   tot<-c()
>>>   tot[1]<-sum(seq[1:window])
>>>   for (i in 2:n) {
>>>      tot[i]<- tot[i-1]-seq[i-1]+seq[i]
>>>   }
>>>   return(tot)
>>> }
>>>
>>> this works well for for reasonably sized vectors. Does anybody know a
>>> way for large vectors ( length=12 million), im trying to avoid using
>>> C.
>>>
>>> Thanks,
>>> Chris
>>>
>>> ______________________________________________
>>> R-help at r-project.org mailing list
>>> https://stat.ethz.ch/mailman/listinfo/r-help
>>> PLEASE do read the posting guide
>>> http://www.R-project.org/posting-guide.html
>>> and provide commented, minimal, self-contained, reproducible code.
>>
>> ______________________________________________
>> R-help at r-project.org mailing list
>> https://stat.ethz.ch/mailman/listinfo/r-help
>> PLEASE do read the posting guide
>> http://www.R-project.org/posting-guide.html
>> and provide commented, minimal, self-contained, reproducible code.