dplyr :: завершить / заполнить временную последовательность, но только на ограниченный период времени - PullRequest
1 голос
/ 25 мая 2020

Я пытаюсь использовать dplyr :: complete и fill, чтобы заполнить пробелы во временной последовательности весов животных (большую часть времени взвешивался примерно еженедельно), НО я хочу делать это только в определенных пределах .

В следующем примере набора данных отсутствуют несколько дат: одно взвешивание от 29.01.2020 и серия из 4 недостающих недель в марте / апреле. Мы согласны с отсутствием взвешивания в течение 1 недели (например, 29 января) и нормально «заполняем» исходный вес в течение двух недель, но не хотим go больше. Второй набор недостающих данных должен быть заполнен только в течение еще 13 дней, а затем оставшаяся часть пробела должна быть NA для wt_g.

library(tidyverse)
library(lubridate)

animalwts <- tibble::tribble(
      ~Animal,     ~WtDate, ~Wt_g,
      "A",  "1/1/2020",   20L,
      "A",  "1/8/2020",   21L,
      "A", "1/15/2020",   21L,
      "A", "1/22/2020",   23L,
      "A",  "2/5/2020",   25L,
      "A", "2/12/2020",   23L,
      "A", "2/19/2020",   24L,
      "A", "2/26/2020",   23L,
      "A",  "3/4/2020",   22L,
      "A",  "4/8/2020",   24L
    ) %>%
        mutate(WtDate = mdy(WtDate))

Следующий код работает для завершения ряда дат и заполнения все недостающие данные

animalwts %>%
  group_by(Animal) %>%
  complete(WtDate = seq.Date(min(WtDate), max(WtDate), by = "day")) %>%
  fill(Wt_g) 

Но я пытаюсь выяснить, как complete все даты, но только fill в весах в течение максимум двух недель из любого заданного date и укажите NAs для всех недостающих данных.

Я бы хотел остаться «в трубе», если это возможно.

1 Ответ

1 голос
/ 25 мая 2020

Как это?

library(tidyverse)
library(lubridate)

animalwts %>%
  group_by(Animal) %>%
  mutate(NA_lag = WtDate - lag(WtDate),
         last_measurement_date = WtDate) %>% 
  complete(WtDate = seq.Date(min(WtDate), max(WtDate), by = "day")) %>%
  fill(Wt_g) %>% 
  fill(last_measurement_date) %>% 
  group_by(last_measurement_date, NA_lag) %>% 
  mutate(days_missing = row_number()) %>% 
  mutate(Wt_g = if_else(days_missing > 14, NA_integer_, Wt_g))

Данные

animalwts <- tibble::tribble(
  ~Animal,     ~WtDate, ~Wt_g,
  "A",  "1/1/2020",   20L,
  "A",  "1/8/2020",   21L,
  "A", "1/15/2020",   21L,
  "A", "1/22/2020",   23L,
  "A",  "2/5/2020",   25L,
  "A", "2/12/2020",   23L,
  "A", "2/19/2020",   24L,
  "A", "2/26/2020",   23L,
  "A",  "3/4/2020",   22L,
  "A",  "4/8/2020",   24L
) %>%
  mutate(WtDate = mdy(WtDate))
...