Сумма новых событий за предыдущие пять лет

Question

У меня есть фрейм данных, похожий на этот игрушечный фрейм данных:

df <- data.frame(company=c("company_a","company_b","company_b", "company_a","company_b","company_a"), 
         fruit=c("peaches, apples; oranges","apples; oranges; bananas","oranges; pears","bananas; apples; oranges; pears","apples; oranges; pears","bananas; apples; oranges; pears; peaches"),
         year=c("2010","2011","2014","2014", "2016","2018"))    


> df
    company                                    fruit year
1 company_a                 peaches; apples; oranges 2010
2 company_b                 apples; oranges; bananas 2011
3 company_b                           oranges; pears 2014
4 company_a          bananas; apples; oranges; pears 2014
5 company_b                   apples; oranges; pears 2016
6 company_a bananas; apples; oranges; pears; peaches 2018

Желаемый результат

Мне нужен столбец (new_occurferences) с суммойфруктов, которые никогда не появлялись в предыдущие пять лет.

Например, строка 4: company_a = бананы и груши никогда не появлялись за последние 5 лет, поэтому new_fruit = 2.

Это будет выглядеть так:

> df
    company                                    fruit year new_occurrences 
1 company_a                 peaches; apples; oranges 2010 3
2 company_b                 apples; oranges; bananas 2011 3
3 company_b                           oranges; pears 2014 1
4 company_a          bananas; apples; oranges; pears 2014 2
5 company_b                   apples; oranges; pears 2016 0
6 company_a bananas; apples; oranges; pears; peaches 2018 1

Попытка

Я попробовал ответить на этот вопрос , для которого я создал функцию, противоположную «% в%», и использую ее в df3.

'%!in%' <- function(x,y)!('%in%'(x,y))

# clean up column classes
df[] <- lapply(df, as.character)
df$year <- as.numeric(df$year)

library(data.table)
setDT(df)

# create separate column for vector of fruits, and year + 5 column
df[, fruit2 := strsplit(gsub(' ', '', fruit), ',|;')]
df[, year2 := year + 5]

# Self join so for each row of df, this creates one row for each time another  
# row is within the year range 
df2 <- df[df, on = .(year <= year2, year > year, company = company)
      , .(company, fruit, fruit2, i.fruit2, year = x.year)]

# create a function which is the opposite of '%in%'
'%!in%' <- function(x,y)!('%in%'(x,y))

# For each row in the (company, fruit, year) group, check whether 
# the original fruits are  in the matching rows' fruits, and store the  result
# as a logical vector. Then sum the list of logical vectors (one for each row).
df3 <- df2[, .(new_occurrences = do.call(sum, Map(`%!in%`, fruit2, i.fruit2)))
       , by = .(company, fruit, year)]

# Add sum_occurrences to original df with join, and make NAs 0
df[df3, on = .(company, fruit, year), new_occurrences :=  i.new_occurrences]
df[is.na(new_occurrences), new_occurrences := 0]

#delete temp columns
df[, `:=`(fruit2 = NULL, year2 = NULL)]

К сожалению, эта попытка не дает мне желаемого результата.

Любая помощь будет высоко ценится, также приветствуются решения с dplyr!:)

Answer 1

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

char2vec <- function(x) scan(text = x, what = "", sep = ";", strip.white = TRUE, 
  quiet = TRUE)
vec2char <- function(x) paste(x, collapse = "; ")

df2 <- transform(df, new = sapply(1:nrow(df), function(i) {
  year0 <- df$year[i]; company0 <- df$company[i]; fruit0 <- df$fruit[i]
  prev_fruit <- char2vec(subset(df, 
    year < year0 & year >= year0 - 5 & company == company0)$fruit)
  vec2char(Filter(function(x) !x %in% prev_fruit, char2vec(fruit0)))
}), stringsAsFactors = FALSE)
transform(df2, num_new = lengths(lapply(new, char2vec)))

даёт:

    company                                    fruit year                      new num_new
1 company_a                 peaches; apples; oranges 2010 peaches; apples; oranges       3
2 company_b                 apples; oranges; bananas 2011 apples; oranges; bananas       3
3 company_b                           oranges; pears 2014                    pears       1
4 company_a          bananas; apples; oranges; pears 2014           bananas; pears       2
5 company_b                   apples; oranges; pears 2016                                0
6 company_a bananas; apples; oranges; pears; peaches 2018                  peaches       1

Примечание

Это взято из вопроса.Одна запятая заменяется точкой с запятой.

df <- data.frame(company=c("company_a","company_b","company_b", 
     "company_a","company_b","company_a"), 
   fruit=c("peaches; apples; oranges","apples; oranges; bananas",
     "oranges; pears", "bananas; apples; oranges; pears", 
     "apples; oranges; pears", "bananas; apples; oranges; pears; peaches"),
   year = c("2010","2011","2014","2014", "2016","2018"))    
df[] <- lapply(df, as.character)
df$year <- as.numeric(df$year)

Answer 2

A tidyverse попытка:

library(tidyverse)

years_window <- 5

df %>%
  separate_rows(fruit, sep = "; |, ") %>%
  mutate(tmp = 1, 
         year = as.integer(as.character(year))) %>%
  complete(company = unique(.$company),
           year = (min(year) - years_window):max(year), 
           fruit = unique(.$fruit)) %>%
  arrange(year) %>%
  group_by(company, fruit) %>%
  mutate(check = zoo::rollapply(tmp, 
                                FUN = function(x) sum(is.na(x)),
                                width = list(-(1:years_window)),
                                align = 'right',
                                fill = NA,
                                partial = TRUE)) %>% 
  group_by(company, year) %>% 
  mutate(new_occurrences = sum(check == years_window & !is.na(tmp))) %>%
  filter(!is.na(tmp)) %>%
  distinct(company, year, new_occurrences) %>% 
  arrange(year) %>%
  left_join(df %>% 
              mutate(year = as.integer(as.character(year))),
            by = c("company", "year")) %>%
  select(company, fruit, year, new_occurrences)

Вывод:

# A tibble: 6 x 4
# Groups:   company, year [6]
  company   fruit                                     year new_occurrences
  <fct>     <fct>                                    <int>           <int>
1 company_a peaches, apples; oranges                  2010               3
2 company_b apples; oranges; bananas                  2011               3
3 company_a bananas; apples; oranges; pears           2014               2
4 company_b oranges; pears                            2014               1
5 company_b apples; oranges; pears                    2016               0
6 company_a bananas; apples; oranges; pears; peaches  2018               1