Подсчет активных наблюдений по неделям - PullRequest
Новая
       7

Подсчет активных наблюдений по неделям

1 голос
/ 04 апреля 2020

У меня есть фрейм данных наблюдений с начальной и конечной датой для каждого наблюдения с указанием периода, когда оно было активным. Продолжительность активности варьируется в зависимости от наблюдения и может распространяться на несколько недель. Некоторые наблюдения все еще активны и не имеют конечной даты.

Для данного диапазона дат, как я могу подсчитать количество наблюдений, которые были активными в течение недели в этом диапазоне дат, включая те, которые все еще активны?

У меня есть грубый метод, который работает, но довольно медленный. Кажется, должен быть более эффективный и простой способ сделать это.

РЕДАКТИРОВАТЬ: Мой первый подход был похож на решение Ронак, которое определенно лучше, чем мое для небольших наборов данных, но мой реальный набор данных имеет больше наблюдений и более длинные диапазоны дат, поэтому я сталкиваюсь с ограничениями памяти. 

#I'm primarily using tidyverse/lubridate, but definitely open to other solutions.
library(tidyverse)
library(lubridate)

# sample data frame of observations with start and end dates:
df_obs <- tibble(
  observation = c(1:10),
  date_start = as_date(c("2020-03-17", "2020-01-20", "2020-02-06", "2020-01-04", "2020-01-06", "2020-01-24", "2020-01-09", "2020-02-11", "2020-03-13", "2020-02-07")),
  date_end = as_date(c("2020-03-27", "2020-03-20", NA, "2020-03-04", "2020-01-16", "2020-02-24", NA, "2020-02-19", NA, "2020-02-27"))
  ) 

# to account for observations that are still active, NAs are converted to today's date:
df_obs <- mutate(df_obs, date_end = if_else(is.na(date_end), Sys.Date(), date_end)) 

# create a data frame of weeks by start and end date to count the active observations in a given week 
# for this example I'm just using date ranges from the sample data: 
df_weeks <- 
  seq(min(df_obs$date_start), max(df_obs$date_start), by = 'day') %>% 
  enframe(NULL, 'week_start') %>% 
  mutate(week_start = as_date(cut(week_start, "week"))) %>% 
  mutate(week_end = week_start + 6) %>% 
  distinct()

# create a function that filters the observations data frame based on start and end dates:   
check_active <- function(d, s, e){
  d %>% 
    filter(date_start <= e) %>% 
    filter(date_end >= s) %>% 
    nrow()
}

# applying that function to each week in the date range data frame gives the expected results:
df_weeks %>% 
  rowwise() %>% 
  mutate(total_active = check_active(df_obs, week_start, week_end)) %>%
  select(-week_end) %>% 
  ungroup()
# A tibble: 12 x 2
   week_start total_active
  <date>            <int>
 1 2019-12-30            1
 2 2020-01-06            3
 3 2020-01-13            3
 4 2020-01-20            4
 5 2020-01-27            4
 6 2020-02-03            6
 7 2020-02-10            7
 8 2020-02-17            7
 9 2020-02-24            6
10 2020-03-02            4
11 2020-03-09            4
12 2020-03-16            5

1 Ответ

1 голос
/ 04 апреля 2020

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

library(tidyverse)

df_obs %>%
  #Replace NA with today's date
  #Create sequence between start and end date
  mutate(date_end = replace(date_end, is.na(date_end), Sys.Date()),
         date = map2(date_start, date_end, seq, "day")) %>%
  #Get data in long format
  unnest(date) %>%
  #Unselect start an end date
  select(-date_start, -date_end) %>%
  #Cut data by week
  mutate(date = cut(date, "week")) %>%
  #Get unique rows for observation and date
  distinct(observation, date) %>%
  #Count number of observation in each week
  count(date)

, который возвращает: 

# A tibble: 14 x 2
#   value          n
#   <fct>      <int>
# 1 2019-12-30     1
# 2 2020-01-06     3
# 3 2020-01-13     3
# 4 2020-01-20     4
# 5 2020-01-27     4
# 6 2020-02-03     6
# 7 2020-02-10     7
# 8 2020-02-17     7
# 9 2020-02-24     6
#10 2020-03-02     4
#11 2020-03-09     4
#12 2020-03-16     5
#13 2020-03-23     4
#14 2020-03-30     3
...