R - расчеты последовательности как в прямом, так и в обратном направлении

У меня есть следующий фрейм данных:

id = c("A","A","A","A","A","A","B","B","B","B","B","B","C","C","C","C","C","C")
month = c(1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,5,6)
amount = c(0,0,10,0,0,0,0,10,0,10,0,0,0,0,0,10,10,0)

df <- data.frame(id, month, amount)

Что мне нужно сделать (по идентификатору): вычислить (посредством отрицательного числа) разницу в месяцах между нулевыми и ненулевыми строками «сумма» до тех пор, пока «сумма» не станет равной 0. Когда это произойдет, время = 0. ТОГДА, как только «сумма» превысит ноль в последовательности, расчет (путем положительного числа) будет оглядываться назад и вычислять разницу в месяцах между ненулевой и исторической нулевой строкой «сумма».

Решение будет выглядеть так:

solution = c(-2,-1,0,1,2,3,-1,0,1,0,1,2,-3,-2,-1,0,0,1)

Как вы, наверное, заметили, довольно сложно искать эту многоуровневую проблему. В идеале ответом будет использование data.table, так как я имею дело с миллионами строк, но dplyr также подойдет для моих нужд.

Любая помощь приветствуется.

S.


r data.table seq
person Scott Hunter    schedule 18.08.2016    source источник
comment
ваши векторы имеют разную длину, как вы можете ожидать от этого прямоугольных данных, таких как DF?   -  person Cyrus Mohammadian    schedule 18.08.2016
comment
У вас могут возникнуть проблемы с помещением его в data.frame, потому что у вас есть только 5 A, B и C. Должно быть 6.   -  person emehex    schedule 18.08.2016

Ответы (2)


arrow_upward
2
arrow_downward 

library(data.table)
setDT(DT)

DT[, g := rleid(id, amount != 0)]
DT[, g_id := g - g[1L], by=id]
DT[, v :=  
  if (g_id == 0L) 
    -(.N:1)
  else if (g_id %% 2 == 0)
    1:.N
  else 
    0L
, by=.(id, g_id)]

all.equal(DT$v, solution) # TRUE

Чтобы увидеть, как это работает:

    id month amount  g g_id  v
 1:  A     1      0  1    0 -2
 2:  A     2      0  1    0 -1
 3:  A     3     10  2    1  0
 4:  A     4      0  3    2  1
 5:  A     5      0  3    2  2
 6:  A     6      0  3    2  3
 7:  B     1      0  4    0 -1
 8:  B     2     10  5    1  0
 9:  B     3      0  6    2  1
10:  B     4     10  7    3  0
11:  B     5      0  8    4  1
12:  B     6      0  8    4  2
13:  C     1      0  9    0 -3
14:  C     2      0  9    0 -2
15:  C     3      0  9    0 -1
16:  C     4     10 10    1  0
17:  C     5     10 10    1  0
18:  C     6      0 11    2  1

Вы можете удалить дополнительные столбцы с помощью DT[, c("g", "g_id") := NULL].

person Frank    schedule 18.08.2016
comment
Это отлично работает до тех пор, пока это не появится: Структура (список (Diamond_id = C (10001123L, 10001123L, 10001123L, 10001123L, 10001123L, 10001123L, 10001123L, 10001123L, 10001123L, 10001123L, 10001123L), Premium_Month = 201301: 2013111123L, 10001123L), Premium_Month = 201331: 201311111123L, 10001123L), Premium_MonTh1301: 2013111111123L, 10001123L), Premium_Month1301: 201311111123L, 10001123L). ,0, 0, 38,4, 0, 38,4, 276, 80,8, 34,4, 0, 30,4), g = c(14L, 14L, 14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L), g_id = c(0L, 0L,0L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L), v = c(-3L, -2L, -1L, 0L,1L, 0L, 1L, 0L, 1L , 0L, 1L)), .Names = c(DIAMOND_ID, PREMIUM_MONTH,CLAIMS_PAID, g, g_id, v), class = c(data.table, data.frame), row.names = c(NA, -11L)) - person Scott Hunter; 31.08.2016
comment
Результаты должны быть: -3,-2,-1,0,1,0,0,0,0,1,0 - person Scott Hunter; 31.08.2016
comment
@ScottHunter Хорошо. Я изменил его на rleid(id, amount != 0), возможно, это исправит. Однако я не переводил ваши разные имена столбцов и не проверял их. Надеюсь, шаги достаточно прозрачны, чтобы вы могли расширить их, если проблема усложнится. Если нет, возможно, обновите свой вопрос (если изменение достаточно незначительное, чтобы оно не сделало недействительным другой ответ) или опубликуйте новый. - person Frank; 31.08.2016

arrow_upward
1
arrow_downward

С tidyr и dplyr

library(dplyr)
library(tidyr)

df_new <- df %>% 
    group_by(id) %>% 
    # identify non-zero instances
    mutate(temp = ifelse(amount != 0, month, NA)) %>% 
    # fill down first
    fill(temp, .direction = "down") %>% 
    # fill up after
    fill(temp, .direction = "up") %>% 
    # calculate difference
    mutate(solution = month - temp) %>% 
    # remove temp
    select(-temp)

Результат

#        id month amount solution
#     <fctr> <dbl>  <dbl>    <dbl>
# 1       A     1      0       -2
# 2       A     2      0       -1
# 3       A     3     10        0
# 4       A     4      0        1
# 5       A     5      0        2
# 6       A     6      0        3
# 7       B     1      0       -1
# 8       B     2     10        0
# 9       B     3      0        1
# 10      B     4     10        0
# 11      B     5      0        1
# 12      B     6      0        2
# 13      C     1      0       -3
# 14      C     2      0       -2
# 15      C     3      0       -1
# 16      C     4     10        0
# 17      C     5     10        0
# 18      C     6      0        1
person emehex    schedule 18.08.2016