Условная накопленная сумма - PullRequest
2 голосов
/ 16 декабря 2011

У меня есть этот фрейм данных

t<-data.frame(v1=c(1,2,1,4,6,7,8,2,3,4,8,1,2), v2=c(2,3,6,1,-3,-2,1,2,-3,6,7,-2,1))

Сканируя data.frame сверху вниз, я хочу получить кумулятивную сумму v1 до тех пор, пока v2 положителен.Когда v2 становится отрицательным, он должен остановиться, записать значение (от суммы до тех пор), и накопленная сумма должна перезапуститься снова со следующего первого положительного значения v2 и так далее.Так что в конце для вышеупомянутого фрейма данных будет вектор

8, 10 , 12, 2

Есть идеи?

Ответы [ 3 ]

5 голосов
/ 16 декабря 2011

Я изменил имя data.frame, потому что t является функцией (транспонировать). Я не понимаю, почему вы хотите использовать cumsum, если вы хотите только сумму.

dtf<-data.frame(v1=c(1,2,1,4,6,7,8,2,3,4,8,1,2), v2=c(2,3,6,1,-3,-2,1,2,-3,6,7,-2,1))
groups  <- rle(dtf$v2 > 0)

dtf$groups<- rep(seq_along(groups$values), groups$lengths)
library(plyr)
daply(dtf, .(groups), function(x) sum(x$v1))[groups$values]
 1  3  5  7 
 8 10 12  2 
4 голосов
/ 16 декабря 2011

Вот один из способов:

t <- data.frame(v1=c(1,2,1,4,6,7,8,2,3,4,8,1,2), v2=c(2,3,6,1,-3,-2,1,2,-3,6,7,-2,1))

unname(with(t, tapply(v1[v2>0], cumsum(abs(diff(sign(c(0,v2)))))[v2>0], sum)))
[1]  8 10 12  2

Сначала это может показаться немного сложным :) cumsum(abs(diff(sign(c(0,v2))))) генерирует уникальный идентификатор группы для каждого прогона положительных или отрицательных значений. Использование diff и cumsum для этого является "распространенным" трюком, о котором полезно знать ... Загвоздка в том, что diff создает более короткий вектор - поэтому используется c(0, v2).

3 голосов
/ 16 декабря 2011

Вот другой способ.

> r <- rle(sign(t$v2))
> diff(c(0,cumsum(t$v1)[cumsum(r$lengths)]))[r$values==1]
[1]  8 10 12  2

Это легче понять, если разделить его; он работает, выбирая правильные элементы совокупной суммы и вычитая их.

> (s <- cumsum(t$v1))
 [1]  1  3  4  8 14 21 29 31 34 38 46 47 49
> (r <- rle(sign(t$v2)))
Run Length Encoding
  lengths: int [1:7] 4 2 2 1 2 1 1
  values : num [1:7] 1 -1 1 -1 1 -1 1
> (k <- cumsum(r$lengths))
[1]  4  6  8  9 11 12 13
> (a <- c(0,s[k]))
[    1]  0  8 21 31 34 46 47 49
> (d <- diff(a))
[1]  8 13 10  3 12  1  2
> d[r$values==1]
[1]  8 10 12  2

Аналогично, но без rle:

> k <- which(diff(c(sign(t$v2),0))!=0)
> diff(c(0,cumsum(t$v1)[k]))[t$v2[k]>0]
[1]  8 10 12  2
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...