Подсчет количества наблюдений в наборе данных с использованием R? (с несколькими критериями)

Question

Итак, у меня есть этот набор данных из примерно 2800 наблюдений. Заголовки выглядят примерно так:

ItemName ItemNumber PromotedDate
ItemA    14321      12/31/2018
ItemB    14335      11/18/2018
ItemC    14542      10/05/2018

Я хочу иметь возможность добавить в этот набор данных новый столбец Number.Times.Promoted.Last.3.Months, который бы подсчитывал, сколько раз каждый элемент существует в наборе данных за последние три месяца переменной PromotedDate.

Я пытался создать некоторый код (ниже), но он возвращает 0 для каждой строки. Когда я просто пробую это с номером элемента, я получаю количество наблюдений во всем наборе данных.

df$Number.Times.Promoted.Last.Three.Months <- sum(df$ItemNumber == df$ItemNumber & 
                                                    df$PromotedDate < df$PromotedDate & 
                                                    df$PromotedDate > (as.Date(df$PromotedDate - 100)),
                                                  na.rm=TRUE)))

Я бы хотел, чтобы код возвращал фактическое число раз, которое каждый элемент в наборе данных был продвинут за последние 3 месяца с момента переменной PromotedDate, и чтобы он был присоединен к каждой строке данных (df). Хотелось бы помочь выяснить, что я делаю не так. Спасибо!

Answer 1

Вот, возможно, более простое решение, основанное на dplyr и fuzzyjoin.

Сначала я определяю день на 90 дней раньше **, а затем присоединяюсь к списку с самим собой, вводя в каждом элементе совпадения дату промоушена, которая составляет «с 90 дней до» и «до текущей даты». Количество строк для каждой Item-Date - это количество рекламных акций в течение 90 дней. Вычитая строку, представляющую себя, мы получаем количество предыдущих повышений.

** «На 90 дней раньше» проще, чем «на 3 месяца раньше», который варьируется по длине и спорен для некоторых дат: что за 3 месяца до 30 мая?

Prep

library(dplyr); library(fuzzyjoin); library(lubridate)
df <- readxl::read_excel(
  "~/Downloads/example_20190519.xlsx", 
  col_types = c("text", "numeric", "date", "numeric"))
df_clean <- df %>% select(-Times.Promoted.Last.3.Months)

Решение

df_clean %>%
  mutate(PromotedDate_less90 = PromotedDate - days(90)) %>%

  # Pull in all matches (including current row) with matching Item and Promoted Date 
  #   that is between Promoted Date and 90 days prior.
  fuzzy_left_join(df_clean, 
                  by = c("ItemName" = "ItemName",
                         "ItemNumber" = "ItemNumber",
                         "PromotedDate_less90" = "PromotedDate",
                         "PromotedDate" = "PromotedDate"),
                  match_fun = list(`==`, `==`, `<=`, `>=`)
                  ) %>%
  group_by(ItemName     = ItemName.x, 
           ItemNumber   = ItemNumber.x, 
           PromotedDate = PromotedDate.x) %>%
  summarize(promotions_in_prior_90d = n() - 1) %>%
  ungroup()

Вывод (в другом порядке, но соответствует цели)

# A tibble: 12 x 4
   ItemName ItemNumber PromotedDate        promotions_in_prior_90d
   <chr>         <dbl> <dttm>                                <dbl>
 1 ItemA         10021 2018-09-19 00:00:00                       0
 2 ItemA         10021 2018-10-15 00:00:00                       1
 3 ItemA         10021 2018-11-30 00:00:00                       2
 4 ItemA         10021 2018-12-31 00:00:00                       2
 5 itemB         10024 2018-12-15 00:00:00                       0
 6 ItemB         10024 2018-04-02 00:00:00                       0
 7 ItemB         10024 2018-06-05 00:00:00                       1
 8 ItemB         10024 2018-12-01 00:00:00                       0
 9 ItemC         19542 2018-07-20 00:00:00                       0
10 ItemC         19542 2018-11-17 00:00:00                       0
11 ItemC         19542 2018-12-01 00:00:00                       1
12 ItemC         19542 2018-12-14 00:00:00                       2

Answer 2

Примечание: В файле, связанном с опечаткой, первый ItemB начинается со строчной буквы i.Приведенный ниже код работает, даже если это не исправлено.

Я считаю следующее решение слишком сложным, но оно выполняет то, о чем просит вопрос.

library(lubridate)

fun <- function(x){
  ifelse(month(x) == 12 & day(x) == 31,
         x - days(31 + 30 + 31),
         x - months(3)
  )
}

df <- readxl::read_xlsx("example_20190519.xlsx")
df$PromotedDate <- as.Date(df$PromotedDate)

sp <- split(df, tolower(df$ItemName))
res <- lapply(sp, function(DF){
  tmp <- as.Date(fun(DF$PromotedDate), origin = "1970-01-01")
  sapply(seq_len(nrow(DF)), function(i){
    sum(DF$PromotedDate[i] > DF$PromotedDate & DF$PromotedDate > tmp[i])
  })
})

df$New.3.Months <- NA
for(nm in names(res)) {
  df$New.3.Months[tolower(df$ItemName) == nm] <- res[[nm]]
}

Теперь проверьте, чтобы убедиться, чторезультат такой же, как в примере файла .xlsx.

all.equal(df$Times.Promoted.Last.3.Months, df$New.3.Months)
#[1] TRUE

И окончательная очистка.

rm(sp)