R: подсчитать количество вхождений определенного события в определенное время в будущем

Question

моего упрощена данные выглядят следующим образом:

set.seed(1453); x = sample(0:1, 10, TRUE) 
date = c('2016-01-01', '2016-01-05', '2016-01-07', '2016-01-12', '2016-01-16', '2016-01-20', 
      '2016-01-20', '2016-01-25', '2016-01-26', '2016-01-31') 


df = data.frame(x, date = as.Date(date)) 


df 
x  date 
1 2016-01-01 
0 2016-01-05 
1 2016-01-07 
0 2016-01-12 
0 2016-01-16 
1 2016-01-20 
1 2016-01-20 
0 2016-01-25 
0 2016-01-26 
1 2016-01-31 

Я хотел бы подсчитать количество вхождений для x == 1 в течение определенного периода времени , например 14 и 30 дней от текущей даты (но исключая текущую запись, если она x == 1 Нужный результат будет выглядеть следующим образом:.

solution 
x  date x_plus14 x_plus30 
1 2016-01-01  1  3 
0 2016-01-05  1  4 
1 2016-01-07  2  3 
0 2016-01-12  2  3 
0 2016-01-16  2  3 
1 2016-01-20  2  2 
1 2016-01-20  1  1 
0 2016-01-25  1  1 
0 2016-01-26  1  1 
1 2016-01-31  0  0 

В идеале я хотел бы, чтобы это было в dplyr, но это не обязательно. Любые идеи, как достичь этого? большое спасибо за вашу помощь!

Answer 1

Добавление другого подхода, основанного на findInterval:

cs = cumsum(df$x) # cumulative number of occurences 
data.frame(df, 
      plus14 = cs[findInterval(df$date + 14, df$date, left.open = TRUE)] - cs, 
      plus30 = cs[findInterval(df$date + 30, df$date, left.open = TRUE)] - cs) 
# x  date plus14 plus30 
#1 1 2016-01-01  1  3 
#2 0 2016-01-05  1  4 
#3 1 2016-01-07  2  3 
#4 0 2016-01-12  2  3 
#5 0 2016-01-16  2  3 
#6 1 2016-01-20  2  2 
#7 1 2016-01-20  1  1 
#8 0 2016-01-25  1  1 
#9 0 2016-01-26  1  1 
#10 1 2016-01-31  0  0 

Answer 2

Раньше я не включая текущую дату и поэтому цифры не совпадают.

library(data.table) 
setDT(df)[, `:=`(x14 = sum(df$x[between(df$date, date, date + 14, incbounds = FALSE)]), 
       x30 = sum(df$x[between(df$date, date, date + 30, incbounds = FALSE)])), 
       by = date] 

#  x  date x14 x30 
# 1: 1 2016-01-01 1 3 
# 2: 0 2016-01-05 1 4 
# 3: 1 2016-01-07 2 3 
# 4: 0 2016-01-12 2 3 
# 5: 0 2016-01-16 2 3 
# 6: 1 2016-01-20 1 1 
# 7: 1 2016-01-20 1 1 
# 8: 0 2016-01-25 1 1 
# 9: 0 2016-01-26 1 1 
# 10: 1 2016-01-31 0 0 

Или общее решение который будет работать для любого желаемого диапазона

vec <- c(14, 30) # Specify desired ranges 
setDT(df)[, paste0("x", vec) := 
      lapply(vec, function(i) sum(df$x[between(df$date, 
                date, 
                date + i, 
                incbounds = FALSE)])), 
      by = date] 

Answer 3

Как уже упоминалось, странно, что вы не считаете день, и вам следует избегать присвоения имен именам функций (образцов). Тем не менее, код пыльник воспроизводить нужный вывод:

set.seed(1453); 
x = sample(0:1, 10, TRUE) 
date = c('2016-01-01', '2016-01-05', '2016-01-07', '2016-01-12', '2016-01-16', '2016-01-20', 
      '2016-01-20', '2016-01-25', '2016-01-26', '2016-01-31') 


sample = data.frame(x = x, date = as.Date(sample$date)) 

getOccurences <- function(one_row, sample_data, date_range){ 
    one_date <- as.Date(one_row[2]) 
    sum(sample$x[sample_data$date > one_date & 
       sample_data$date < one_date + date_range]) 
} 

sample$x_plus14 <- apply(sample,1,getOccurences, sample, 14) 
sample$x_plus30 <- apply(sample,1,getOccurences, sample, 30) 

sample 

    x  date x_plus14 x_plus30 
1 1 2016-01-01  1  3 
2 0 2016-01-05  1  4 
3 1 2016-01-07  2  3 
4 0 2016-01-12  2  3 
5 0 2016-01-16  2  3 
6 1 2016-01-20  1  1 
7 1 2016-01-20  1  1 
8 0 2016-01-25  1  1 
9 0 2016-01-26  1  1 
10 1 2016-01-31  0  0 

Answer 4

Вот мой удар у него с какой-то dplyr + purrr помощь. Я получил несколько разные счета из-за <= и >= в вспомогательной функции x_next(), если вы их правильно настроите, я думаю, вы сможете получить то, что хотите. НТН.

library("tidyverse") 
library("lubridate") 
set.seed(1453) 

x = sample(0:1, 10, TRUE) 
dates = c('2016-01-01', '2016-01-05', '2016-01-07', '2016-01-12', '2016-01-16', '2016-01-20', 
     '2016-01-20', '2016-01-25', '2016-01-26', '2016-01-31') 

df = data_frame(x = x, dates = lubridate::as_date(dates)) 

# helper function to calculate the sum of xs in the next days_in_future 
x_next <- function(d, days_in_future) { 

    df %>% 
    # subset on days of interest 
    filter(dates > d & dates <= d + days(days_in_future)) %>% 
    # sum up xs 
    summarise(sum = sum(x)) %>% 
    # have to unlist them so that the (following) call to mutate works 
    unlist(use.names=F) 
    } 

# mutate your df 
df %>% 
    mutate(xplus14 = map(dates, x_next, 14), 
     xplus30 = map(dates, x_next, 30)) 

Answer 5

Сжатое dplyr и purrr решение:

library(tidyverse) 

sample %>% 
    mutate(x_plus14 = map(date, ~sum(x == 1 & between(date, . + 1, . + 14))), 
     x_plus30 = map(date, ~sum(x == 1 & between(date, . + 1, . + 30)))) 

x  date x_plus14 x_plus30 
1 1 2016-01-01  1  4 
2 0 2016-01-05  1  4 
3 1 2016-01-07  2  3 
4 0 2016-01-12  2  3 
5 0 2016-01-16  2  3 
6 1 2016-01-20  1  1 
7 1 2016-01-20  1  1 
8 0 2016-01-25  1  1 
9 0 2016-01-26  1  1 
10 1 2016-01-31  0  0