[R] blockwise sums

[Pfaff, Bernhard]

> 
> Liaw, Andy wrote:
> > If you insist, here's one way:
> > 
> > my.blockwisesum <- function(x, n, ...) {
> >     tapply(x, seq(1, length(x), by=n), sum, ...)
> > }
> > 
> 
>   Did you test that? I get:
> 
>  > my.blockwisesum(1:10, 3)
> Error in tapply(x, seq(1, length(x), by = n), sum, ...) :
>          arguments must have same length
> 
> 
>   Here's my solution with tapply and rep() to generate a vector like 
> c(1,1,1,2,2,2,3,3,3,4):
> 
> baz.blockwisesum=
>   
> function(v,n){tapply(v,rep(1:(1+length(v)/n),each=n)[1:length(
> v)],sum)}
> 
>  > baz.blockwisesum(1:10,3)
>   1  2  3  4
>   6 15 24 10
> 
>   - just ignore the 1 to 4 names, they cant hurt you.
> 
> Baz

To complete the picture: here is another one:

my.blockwisesum <- function(vec, n){
  vec <- as.vector(vec)
  n <- as.integer(n)
  total <- length(vec)
  if(total <= n){
    stop("\nn should be smaller than length of vector.\n")
  }
  start <- seq(1, total, n)
  end <- start + n - 1
  end[end > total] <- max(start)
  index <- 1 : length(start)
  return(sapply(index, function(x)sum(test[start[x]:end[x]])))
}

> test <- 1:150
> ptn <- proc.time()
> baz.blockwisesum(test,3)
  1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19
20 
  6  15  24  33  42  51  60  69  78  87  96 105 114 123 132 141 150 159 168
177 
 21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36  37  38  39
40 
186 195 204 213 222 231 240 249 258 267 276 285 294 303 312 321 330 339 348
357 
 41  42  43  44  45  46  47  48  49  50 
366 375 384 393 402 411 420 429 438 447 
> proc.time()-ptn
[1] 0.00 0.00 0.22   NA   NA
> 
> ptn <- proc.time()
> my.blockwisesum(test,3)
 [1]   6  15  24  33  42  51  60  69  78  87  96 105 114 123 132 141 150 159
168
[20] 177 186 195 204 213 222 231 240 249 258 267 276 285 294 303 312 321 330
339
[39] 348 357 366 375 384 393 402 411 420 429 438 447
> proc.time()-ptn
[1] 0.00 0.00 0.19   NA   NA
> 

HTH,
Bernhard


--------------------------------------------------------------------------------
The information contained herein is confidential and is inte...{{dropped}}