Отслеживание атрибута с задержкой в ​​R

Question

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

Transactions <- data.table(Customer=c("A01","A01","A01","A01","A01","A01"), 
                           PurchaseDate=c("1/1/2018","1/2/2018","1/3/2018","1/4/2018","1/5/2018","1/6/2018"),
                           Purchase=c("DrillA, Bit10", "Bit11","Bit20","Bit21","DrillZ, Bit4", "Bit6"))

Становится:

Transactions <- data.table(Customer=c("A01","A01","A01","A01","A01","A01"), 
                           PurchaseDate=c("1/1/2018","1/2/2018","1/3/2018","1/4/2018","1/5/2018","1/6/2018"),
                           Purchase=c("DrillA, Bit10", "Bit11","Bit20","Bit21","DrillZ, Bit4", "Bit6"), 
                           LastDrill=c("DrillA","DrillA","DrillA", "DrillA", "DrillZ", "DrillZ"))

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

Transactions %>% 
  arrange(Customer, PurchaseDate) %>%
  group_by(Customer) %>%
  mutate(LastDrill = "") %>%
  mutate(LastDrill = case_when(grepl("DrillA", Purchase) ~ "DrillA",
                               grepl("DrillZ", Purchase) ~ "DrillZ",
                               TRUE ~ lag(LastDrill, 1, order_by=PurchaseDate)))

Это похоже на работутранзакция, следующая сразу за транзакцией, содержащей «DrillA / DrillZ», но не поддерживающая «флаг».

Есть ли лучший способ структурировать это?Любая помощь с благодарностью!

Answer 1

Данные

Transactions <- data.frame(Customer=c("A01","A01","A01","A01","A01","A01"), 
                           PurchaseDate=c("1/1/2018","1/2/2018","1/3/2018","1/4/2018","1/5/2018","1/6/2018"),
                           Purchase=c("DrillA, Bit10", "Bit11","Bit20","Bit21","DrillZ, Bit4", "Bit6"))

Опция 1 (приращение и изменение формы)

library(tidyverse)

Transactions %>% 
  arrange(Customer, PurchaseDate) %>%
  group_by(Customer) %>%
  separate_rows(Purchase) %>%                          # separate column into multiple rows (i.e. one event per row)
  mutate(flag = cumsum(grepl("Drill", Purchase))) %>%  # group rows based on when drills occur
  group_by(flag, add = T) %>%                          
  mutate(LastDrill = first(Purchase)) %>%              # get the first value in a new column (should always be a drill)
  ungroup() %>%
  select(-flag) %>%
  group_by(Customer, PurchaseDate, LastDrill) %>%
  summarise(Purchase = paste0(Purchase, collapse = ", ")) %>% # go back to your original shape
  ungroup()

#   Customer PurchaseDate      Purchase LastDrill
# 1      A01     1/1/2018 DrillA, Bit10    DrillA
# 2      A01     1/2/2018         Bit11    DrillA
# 3      A01     1/3/2018         Bit20    DrillA
# 4      A01     1/4/2018         Bit21    DrillA
# 5      A01     1/5/2018  DrillZ, Bit4    DrillZ
# 6      A01     1/6/2018          Bit6    DrillZ

Опция 2 (dplyr и функция для извлечения сверла)

library(dplyr)
library(zoo)

# vectorised function to extract the drill value from a string
# (uses comma to split the string)
GetDrill = function(x) { y = unlist(strsplit(x, split = ","))
                         ifelse(sum(grepl("Drill", y)), y[grepl("Drill", y)], NA) }
GetDrill = Vectorize(GetDrill)


Transactions %>% 
  arrange(Customer, PurchaseDate) %>%
  group_by(Customer) %>%
  mutate(LastDrill =  na.locf(GetDrill(as.character(Purchase)))) %>%
  ungroup()

# # A tibble: 6 x 4
#   Customer PurchaseDate Purchase      LastDrill
#   <fct>    <fct>        <fct>         <chr>    
# 1 A01      1/1/2018     DrillA, Bit10 DrillA   
# 2 A01      1/2/2018     Bit11         DrillA   
# 3 A01      1/3/2018     Bit20         DrillA   
# 4 A01      1/4/2018     Bit21         DrillA   
# 5 A01      1/5/2018     DrillZ, Bit4  DrillZ   
# 6 A01      1/6/2018     Bit6          DrillZ