Question

Я хотел бы добиться следующего:

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

Таблица s_orders содержит данные заказов дляразные люди (ключи аккаунта). Таблица s_catalogs содержит все каталоги, которые были отправлены каждому ключу учетной записи

Для каждого заказа я хочу знать:

, если и какие каталоги были отправлены из предыдущего заказа (илиначало) до дня до очагового приказа. В частности, потребители получили (бумажный) каталог по номеру s_catalogs$CATDATE. Я хочу знать для каждого заказа, какие каталоги были получены между предыдущим заказом (s_orders$PREVORDER) и последним заказом. Поскольку у некоторых потребителей нет предыдущего заказа, я устанавливаю дату предыдущего заказа startdate на дату ("1999-12-31"), которая является началом моего набора данных.
Тогда я хочусделать некоторые расчеты по данным каталога. (в этом примере: вычислите разницу между датой каталога и датой заказа)

Для этого я написал функцию getCatalogs , которая принимает ключ учетной записи и двадаты в качестве входных данных и выводит фрейм данных с результатами из другой таблицы. Было бы очень признательно, если у кого-то есть лучшее, более эффективное решение? может быть, с каким-то объединением?

Я думаю, что моя главная проблема заключается в том, как взаимозаменяемо использовать mutate, pmap, pipe, pluck для построения сложных запросов к нескольким таблицам. описан в разделах Желаемый результат и Проблема .

# packages needed
library("dplyr")
library("lubridate")
library("purrr")
#library("tidyverse")

Пример данных

(я выбрал некоторых пользователей из моих данных. s_ обозначает'sample')

# orders
s_orders <- structure(list(ACCNTKEY = c(2806, 2806, 2806, 3729, 3729, 3729, 
3729, 4607, 4607, 4607, 4607, 4742, 11040, 11040, 11040, 11040, 
11040, 17384), ORDDATE = structure(c(11325, 11703, 11709, 11330, 
11375, 11384, 12153, 11332, 11445, 11589, 11713, 11333, 11353, 
11429, 11662, 11868, 11960, 11382), class = "Date")), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -18L))

# # A tibble: 18 x 2
#    ACCNTKEY ORDDATE   
#       <dbl> <date>    
#  1     2806 2001-01-03
#  2     2806 2002-01-16
#  3     2806 2002-01-22
#  4     3729 2001-01-08
#  5     3729 2001-02-22
#  6     3729 2001-03-03
#  7     3729 2003-04-11
#  8     4607 2001-01-10
#  9     4607 2001-05-03
# 10     4607 2001-09-24
# 11     4607 2002-01-26
# 12     4742 2001-01-11
# 13    11040 2001-01-31
# 14    11040 2001-04-17
# 15    11040 2001-12-06
# 16    11040 2002-06-30
# 17    11040 2002-09-30
# 18    17384 2001-03-01


# catalogs
s_catalogs <- structure(list(ACCNTKEY = c("2806", "2806", "4607", "2806", "4607", 
"4607", "4607"), CATDATE = structure(c(11480, 11494, 11522, 11858, 
11886, 12264, 12250), class = "Date"), CODE = c("2806/07/2001", 
"2806/21/2001", "4607/19/2001", "2806/20/2002", "4607/18/2002", 
"4607/31/2003", "4607/17/2003")), row.names = c(NA, -7L), class = c("tbl_df", 
"tbl", "data.frame"))

# # A tibble: 7 x 3
#   ACCNTKEY CATDATE    CODE        
#   <chr>    <date>     <chr>       
# 1 2806     2001-06-07 2806/07/2001
# 2 2806     2001-06-21 2806/21/2001
# 3 4607     2001-07-19 4607/19/2001
# 4 2806     2002-06-20 2806/20/2002
# 5 4607     2002-07-18 4607/18/2002
# 6 4607     2003-07-31 4607/31/2003
# 7 4607     2003-07-17 4607/17/2003

рассчитать дату отложенного заказа

# calculate previous order date for each order in s_orders
s_orders<-s_orders %>%
  group_by(ACCNTKEY) %>%
  arrange(ORDDATE) %>%
  mutate(PREVORDER=as_date(lag(ORDDATE)))

Итак, теперь мы знаем предыдущий заказ (если есть)

Функция getCatalogs (улучшение приветствуется)

Таким образом, приведенная ниже функция getCatalogs возвращает фрейм данных с каталогами, которые были получены этим ключом счета перед заказом (или фактически между последними заказами / каталогами, которые были получены между startdate и enddate ).

# in case _startdate_ is missing then I set it to some starting value

getCatalogs<-function(key,startdate,enddate){

  if(is.na(startdate)){
    startdate<-as_date(date("1999-12-31")) 
  }
  tmp <- s_catalogs[s_catalogs$ACCNTKEY==key &
                    s_catalogs$CATDATE<enddate &
                    s_catalogs$CATDATE>=startdate,]

  if (NROW(tmp)>0){
    return(tmp)
  }else{return(NA)}
}

Используйте функцию

давайте для каждого заказа получим все каталоги в listcolumn

# For each row in s_orders search in dataframe s_catalogs all catalogs that were received for that account key before the order date but after the previous order. 

s_orders <- s_orders %>% as_tibble() %>% 
  mutate(catalogs = 
pmap(c(list(ACCNTKEY),list(PREVORDER),list(ORDDATE)),.f= function(x,y,z){getCatalogs(x,y,z)}))

Эта строка, например, гдата последнего каталога, , что мне нужно :

s_orders %>% pluck("catalogs") %>% pluck(13) %>% pluck("CATDATE") %>% max()

# [1] "2001-06-21"

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

Теперь я хотел бы получить количество дней междувышеуказанная дата и дата заказа (ORDDATE). Следующий код делает это точно, но он корректен только в строке 13.

# get amount of days since last catalog
s_orders3 <- s_orders %>% 
mutate(diff = ORDDATE - s_orders %>% 
              pluck("catalogs") %>% pluck(13) %>% pluck("CATDATE") %>% max())

# # A tibble: 18 x 5
#    ACCNTKEY ORDDATE    PREVORDER  catalogs         diff     
#       <dbl> <date>     <date>     <list>           <time>   
#  1     2806 2001-01-03 NA         <lgl [1]>        -169 days
#  2     3729 2001-01-08 NA         <lgl [1]>        -164 days
#  3     4607 2001-01-10 NA         <lgl [1]>        -162 days
#  4     4742 2001-01-11 NA         <lgl [1]>        -161 days
#  5    11040 2001-01-31 NA         <lgl [1]>        -141 days
#  6     3729 2001-02-22 2001-01-08 <lgl [1]>        -119 days
#  7    17384 2001-03-01 NA         <lgl [1]>        -112 days
#  8     3729 2001-03-03 2001-02-22 <lgl [1]>        -110 days
#  9    11040 2001-04-17 2001-01-31 <lgl [1]>         -65 days
# 10     4607 2001-05-03 2001-01-10 <lgl [1]>         -49 days
# 11     4607 2001-09-24 2001-05-03 <tibble [1 × 3]>   95 days
# 12    11040 2001-12-06 2001-04-17 <lgl [1]>         168 days
# 13     2806 2002-01-16 2001-01-03 <tibble [2 × 3]>  209 days
# 14     2806 2002-01-22 2002-01-16 <lgl [1]>         215 days
# 15     4607 2002-01-26 2001-09-24 <lgl [1]>         219 days
# 16    11040 2002-06-30 2001-12-06 <lgl [1]>         374 days
# 17    11040 2002-09-30 2002-06-30 <lgl [1]>         466 days
# 18     3729 2003-04-11 2001-03-03 <lgl [1]>         659 days

Проверьте вручную:

date("2002-01-16")-date("2001-06-21")
# Time difference of 209 days

Проблема

Однакокод вычитает одну и ту же дату из даты заказа в каждой строке. Я хочу, чтобы он использовал дату, которая принадлежит каждой конкретной строке.

Так что проблема в том, как заменить %>% pluck(13) %>% какой-либо командой, которая добавляет этот трюк к каждой строке и помещает его в столбец diff.

Я действительно ищу решение, которое использует purrr или dplyr, или какой-то другой пакет, столь же эффективный и понятный.

Ronak Shah · Answer 1 · 01 октября 2019

Надеясь, что я ясно понял вопрос, вот моя попытка решить проблему. Я изменил функцию getCatalogs, чтобы она возвращала только max CATDATE в случае ее наличия.

library(dplyr)
library(purrr)

getCatalogs<-function(key,startdate,enddate){
    if(is.na(startdate))  startdate<- as.Date("1999-12-31")
    tmp <- s_catalogs$CATDATE[s_catalogs$ACCNTKEY==key &
                              s_catalogs$CATDATE<enddate &
                              s_catalogs$CATDATE>=startdate]

    if (length(tmp) > 0) max(tmp) else NA
}


s1_orders<- s_orders %>%
               group_by(ACCNTKEY) %>%
               arrange(ORDDATE) %>%
               mutate(PREVORDER=lag(ORDDATE))

, а затем использую pmap как:

s1_orders %>% 
  mutate(catalogs = pmap_dbl(list(ACCNTKEY,PREVORDER,ORDDATE), getCatalogs), 
         catalogs = as.Date(catalogs, origin = "1970-01-01"), 
         diff = ORDDATE - catalogs)

#   ACCNTKEY ORDDATE    PREVORDER  catalogs   diff    
#      <dbl> <date>     <date>     <date>     <drtn>  
# 1     2806 2001-01-03 NA         NA          NA days
# 2     3729 2001-01-08 NA         NA          NA days
# 3     4607 2001-01-10 NA         NA          NA days
# 4     4742 2001-01-11 NA         NA          NA days
# 5    11040 2001-01-31 NA         NA          NA days
# 6     3729 2001-02-22 2001-01-08 NA          NA days
# 7    17384 2001-03-01 NA         NA          NA days
# 8     3729 2001-03-03 2001-02-22 NA          NA days
# 9    11040 2001-04-17 2001-01-31 NA          NA days
#10     4607 2001-05-03 2001-01-10 NA          NA days
#11     4607 2001-09-24 2001-05-03 2001-07-19  67 days
#12    11040 2001-12-06 2001-04-17 NA          NA days
#13     2806 2002-01-16 2001-01-03 2001-06-21 209 days
#14     2806 2002-01-22 2002-01-16 NA          NA days
#15     4607 2002-01-26 2001-09-24 NA          NA days
#16    11040 2002-06-30 2001-12-06 NA          NA days
#17    11040 2002-09-30 2002-06-30 NA          NA days
#18     3729 2003-04-11 2001-03-03 NA          NA days

Обновление

Не изменяя текущую функцию getCatalogs, мы можем проверить length из catalogs

s1_orders %>% 
  mutate(catalogs = pmap(list(ACCNTKEY,PREVORDER,ORDDATE), getCatalogs),
         temp =  map_dbl(catalogs, ~if (length(.x) > 1)
                   .x %>% pluck("CATDATE") %>% max else NA), 
         temp = as.Date(temp, origin = "1970-01-01"),
         diff = ORDDATE - temp)

Мутировать при доступе к значению в столбце списка в трубе с картой и срывом

Пример данных

рассчитать дату отложенного заказа

Функция getCatalogs (улучшение приветствуется)

Используйте функцию

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

Проблема

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Мутировать при доступе к значению в столбце списка в трубе с картой и срывом

Пример данных

рассчитать дату отложенного заказа

Функция getCatalogs (улучшение приветствуется)

Используйте функцию

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

Проблема

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Похожие темы