2015-04-15 6 views
3

Я пытаюсь вычислить кумулятивные суммы вектора с элементами 0,1, NA, основываясь на следующих условиях:Условный cumsum на основе следующего значения вектора

1) Просто вычислить cumsums в между НС значения

2) Если 0 приходит после 1, то я хочу cumsum + 1

Out оригинальный вектор:

out[1:100] 
    [1] NA NA NA NA 0 1 1 NA NA NA 1 NA 0 NA 0 1 NA NA 0 NA 0 1 0 0 0 NA 0 1 0 1 0 0 1 0 1 1 0 0 0 0 
[41] 1 0 NA 0 0 NA 1 NA 0 1 NA 0 NA 0 1 1 NA 1 NA 0 0 0 1 1 NA NA NA 0 0 NA 0 0 0 1 0 NA 1 0 NA 0 
[81] 1 1 0 1 1 0 1 0 NA 0 1 0 1 0 NA 0 1 0 0 1 

Я использовал этот код Calculat е cumsums Inbetween значений NA:

g <- cumsum(is.na(head(c(0, out), -1))) 
out1 <- ave(out, g, FUN = cumsum) 

Я получаю

out1[1:100] 
    [1] NA NA NA NA 0 1 2 NA NA NA 1 NA 0 NA 0 1 NA NA 0 NA 0 1 1 1 1 NA 0 1 1 2 2 2 3 3 4 5 5 5 5 5 
[41] 6 6 NA 0 0 NA 1 NA 0 1 NA 0 NA 0 1 2 NA 1 NA 0 0 0 1 2 NA NA NA 0 0 NA 0 0 0 1 1 NA 1 1 NA 0 
[81] 1 2 2 3 4 4 5 5 NA 0 1 1 2 2 NA 0 1 1 1 2 

Теперь я просто есть проблема, что я хочу, чтобы получить cumsum + 1, если 1 следует ноль (и здесь только первые ноль)

eg

0 1 1 0 0 0 1 0 1 1 NA

с функцией у меня сейчас я хотел бы получить

0 1 2 2 2 2 3 3 4 5 NA, но то, что я хочу:

0 1 2 3 3 3 4 5 6 7 Н.

Может кто-нибудь помочь? Спасибо.

ответ

1

Попробуйте

out <- c(NA, NA, NA, NA, 0, 1, 1, NA, NA, NA, 1, NA, 0, NA, 0, 1, NA, 
    NA, 0, NA, 0, 1, 0, 0, 0, NA, 0, 1, 0, 1, 0, 0, 1, 0, 1, 1, 0, 
    0, 0, 0, 1, 0, NA, 0, 0, NA, 1, NA, 0, 1, NA, 0, NA, 0, 1, 1, 
    NA, 1, NA, 0, 0, 0, 1, 1, NA, NA, NA, 0, 0, NA, 0, 0, 0, 1, 0, 
    NA, 1, 0, NA, 0, 1, 1, 0, 1, 1, 0, 1, 0, NA, 0, 1, 0, 1, 0, NA, 
    0, 1, 0, 0, 1, NA, 0, 1, 1, 0, 0, 0, 1, 0, 1, 1, NA) 

as.numeric(unlist(lapply(split(out, cumsum(is.na(out))), 
    function(x) { 
     if (length(x) == 1) return(x) 
     idx <- which(x[-length(x)] == 1 & x[-1] == 0) 
     res <- cumsum(x[-1]) 
     for (i in seq_along(idx)) { 
      if (i == length(idx)) 
       res[seq(idx[i], length(res))] <- res[seq(idx[i], length(res))] + i 
      else 
       res[seq(idx[i], idx[i + 1] - 1)] <- res[seq(idx[i], idx[i + 1] - 1)] + i 
     } 
     c(NA, res) 
    } 
))) 
# [1] NA NA NA NA 0 1 2 NA NA NA 1 NA 0 NA 0 1 NA NA 0 NA 0 1 2 2 2 
# [26] NA 0 1 2 3 4 4 5 6 7 8 9 9 9 9 10 11 NA 0 0 NA 1 NA 0 1 
# [51] NA 0 NA 0 1 2 NA 1 NA 0 0 0 1 2 NA NA NA 0 0 NA 0 0 0 1 2 
# [76] NA 1 2 NA 0 1 2 3 4 5 6 7 8 NA 0 1 2 3 4 NA 0 1 2 2 3 
#[101] NA 0 1 2 3 3 3 4 5 6 7 NA 

В качестве альтернативы, вы можете рассчитать out1 сохраняя существующий метод (с использованием ave), а затем " добавьте "недостающие биты к нему путем идентификации последовательностей, которые необходимо добавить

na.pos <- which(is.na(out)) 
idx <- which(out[-length(out)] == 1 & out[-1] == 0) 
idx2 <- which(is.na(out[-1]) | (out[-length(out)] == 1 & out[-1] == 0)) 

beg <- idx + 1 
end <- idx2[findInterval(idx, idx2) + 1] 
to.add <- as.numeric(unlist(sapply(rle(findInterval(idx, na.pos))$lengths, seq, from = 1))) 

for(i in seq_along(beg)) 
    out1[seq(beg[i], end[i])] <- out1[seq(beg[i], end[i])] + to.add[i] 
+0

Большое вам спасибо, это работает отлично !!! – Pat

+0

У меня есть другой вопрос: я хочу подмножить фрейм данных на основе вектора out1 (который имеет такую ​​же длину, что и мой df), но только если у меня есть последовательность min 0-4. Я думал, что у меня уже есть код для этого, но я не понимаю. – Pat

+0

@Pat Счастлив, что он работает и помогает дальше, но я не понимаю, что именно вы хотите выполнить (в основном, «последовательность min 0-4»). Могли бы вы изменить OP с примером/предполагаемым выходом? – konvas

0

Там должно быть проще, но вы можете попробовать это:

temp1 <- out 
temp1[is.na(temp1)] <- 0 

temp2 <- (temp1[2:length(temp1)] == 0) * (temp1[1:length(temp1)-1]==1) 
temp2 <- c(0, temp2) 

out1 <- cumsum(temp1+temp2)- cummax(cumsum((temp1+temp2))*is.na(out)) 
out1[is.na(out)] <- NA 

rm(temp1, temp2) 

out1 
+0

Я просто получаю нормальную cumsum между NA с этой функцией, она не добавляет +1 для нулей после них. Но спасибо за ваши усилия. – Pat

+0

Возникла проблема с 'lag'. Теперь он должен работать. –

 Смежные вопросы

  • Нет связанных вопросов^_^