Заполнение пропущенных строк для данных временного ряда в R - PullRequest
0 голосов
/ 14 декабря 2018

Благодаря многим отличным публикациям в Stackoverflow у меня есть решение заполнить недостающие строки для данных временных рядов.Но меня больше всего беспокоит, есть ли способ сделать это более кратким и коротким.Я работаю с данными, как показано ниже:

df <- data.frame(
        id = c("A", "A", "A", "A", "A", "B", "B", "B", "C", "C", "C"),
        week = c(-13, -2, 4, 5, 6, 3, 4, 5, -8, -5, 3), 
        last_week = c(6, 6, 6, 6, 6, 5, 5, 5, 3, 3, 3),
        first_week = c(-20, -20, -20, -20, -20, 2, 2, 2, -3, -3, -3),
        dv = c(3, 2, 2, 1, 4, 5, 2, 3, 1, 1, 2)
      )

Моя цель состоит из трех частей:

1) Если first_week меньше -10, я должен иметь все строки, начиная с -10 доlast_week.т. е. идентификатор А должен иметь строки в течение недель от -10 до 6.

2) Если first_week больше 0, я должен иметь все строки, начиная с 1 до last_week.т. е. идентификатор B должен иметь строки в течение недель от 1 до 5.

3) Для всех остальных случаев у меня должны быть все строки, начиная с first_week до last_week.т. е. идентификатор C должен иметь строки в течение недель от -3 до 3.

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

loop_for_filling <- function(df){
    for(i in unique(df$id)){
      current_id_df <- filter(df, id == i)
      current_id_last_week <- unique(current_id_df$last_week)
      current_id_first_week <- unique(current_id_df$first_week)

      # Create a sequence of weeks to be filled
      if(current_id_first_week > 0){
        all_weeks = seq(1, current_id_last_week)
      } else if(current_id_first_week < -10){
          all_weeks = seq(-10, current_id_last_week)
      } else{
            all_weeks = seq(current_id_first_week, current_id_last_week)
            current_id_df = filter(current_id_df, week >= first_week)
      }

      # Create a dataframe with rows for every week btwn last_week and first_week
      current_id_all <- data.frame(list(week = all_weeks)) %>% mutate(id = i)

      # Merge two dataframes
      current_id_new_df <- merge(current_id_df, current_id_all, all = T) %>% 
        subset(., select = -c(last_week, first_week)) %>% 
        filter(week >= -10)

      # Bind current_person_new_dfs
      if(i == unique(df$id)[[1]]){all_file <- current_id_new_df}
      if(i != unique(df$id)[[1]]){all_file <- rbind(all_file, current_id_new_df)}
    }

    all_file

  }

  df2 <- loop_for_filling(df)
  df2

Это, безусловно, работает, но я работаю сбольшой набор данных (50 тыс. идентификаторов), и мне было интересно, будут ли какие-либо способы решить эту проблему более коротким и кратким способом, поэтому мне не нужно пялиться на мой цикл в течение трех часов:)

Спасибо!

1 Ответ

0 голосов
/ 14 декабря 2018

Полагаю, это будет намного быстрее.Сначала я устанавливаю диапазон недель, которые должны быть указаны для каждого id, применяя указанные корректировки.Затем я использую tidyr :: uncount (), чтобы создать строки для каждой из необходимых комбинаций id-недели.Наконец, я присоединяюсь к исходным данным.

library(tidyverse)
df_ranges <- df %>%
  distinct(id, first_week, last_week) %>% 
  mutate(first_week = case_when(first_week < -10 ~ -10,
                                first_week > 0   ~   1,
                                TRUE             ~ first_week)) %>%
  mutate(week_count = last_week - first_week + 1)

df2b <- df_ranges %>%
  uncount(week_count, .id = "week") %>%
  mutate(week = first_week + week - 1) %>%
  select(id, week) %>%
  left_join(df %>% select(id, week, dv))

identical(df2b, df2)
#[1] TRUE
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...