使用日期取决于R中的其他因素

时间:2018-01-09 00:51:30

标签: r date dplyr tidyverse

我无法找到解决此问题的最佳方法。我担心这可能是由于对分析的基本误解(后面会详细介绍)。问题是这样:在大约25,000笔交易中,我需要找到哪些客户在订购后的两个月内打电话。

id = unique customer ID

call = 1 signifies the observation is a call

lapse = 1 signifies the observation is a lapse

请注意,如果任何客户在同一天同时有电话和失误,那么该客户在该日期将有两个条目;客户可以在一个日期进行多次调用(每个日期都有自己的观察和df中自己的行);但任何客户每个日期只能有一次失效。

mini-df没有解决方案:

library(lubridate)
df <- data.frame(id = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4),
             date = dmy(c("01-01-2014", "07-02-2014",   "05-03-2014",   "14-02-2014",   "15-04-2014",   "17-04-2014",   "11-05-2014",   "19-08-2014",   "07-10-2014",   "21-12-2014",   "04-06-2010",   "06-03-2012",   "12-07-2012",   "13-07-2012",   "14-01-2014",   "05-05-2014",   "19-08-2014",   "19-08-2014",   "13-02-2013",   "11-11-2013",   "04-03-2014",   "10-12-2014",   "02-03-2017",   "03-03-2017")), 
             call = c(1,    0,  0,  1,  1,  1,  0,  1,  1,  0,  0,  0,  0,  0,  1,  0,  1,  0,  0,  1,  1,  1,  1,  0),
             lapse = c(0,   1,  1,  0,  0,  0,  1,  0,  0,  1,  1,  1,  1,  1,  0,  1,  0,  1,  1,  0,  0,  0,  0,  1))

...和解决方案载体:

df$call_2months_or_less_before_lapse <- c(1,    0,  0,  0,  1,  1,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  0,  0,  1,  0)

所以,当我说这个时,我很畏缩,但我可以在Excel中解决这个问题。但是,我拒绝放弃 - 我永远不会回去!

所以我想指出一个解决方案代码的正确方向,特别是如果该方向在tidyverse的某个地方。但是,我担心我可能会对整洁的数据产生根本性的误解。自从我开始学习R以来,这是我无法通过的第一个问题。

3 个答案:

答案 0 :(得分:2)

我只使用基本R代码编写了一个函数来查找每个失效日期和紧接其之前的最近通话日期之间的时间间隔(以天为单位)。然后,您可以使用dplyr按客户ID对数据框进行分组,并将该功能应用于每个客户。 dplyr部分也可以使用split()lapply()使用基本R代码完成。

# Function that finds time to most recent call before a lapse.
time_to_most_recent_call <- function(x) {
  # Extract vector of dates when the subscription lapsed, and vector of dates when customer called.
  lapse_dates <- x$date[x$lapse == 1]
  call_dates <- x$date[x$call == 1]
  # Get all pairwise time intervals in days between lapse and call.
  time_intervals <- sapply(lapse_dates, function(z) z - call_dates)
  # Find most recent call before each lapse (only look at positive time intervals)
  shortest_intervals <- apply(time_intervals, 2, function(z) min(z[z >= 0]))  
  # Return result (also include flag if it's between 0 and 60)
  return(data.frame(lapse_date = lapse_dates, 
                    interval = shortest_intervals, 
                    within2months = shortest_intervals >= 0 & shortest_intervals <= 60))
}

library(dplyr)

df %>%
  group_by(id) %>%
  do(time_to_most_recent_call(.))

对于每个客户和每个失效日期,这将返回从最近一次呼叫到该失效的间隔时间。如果间隔小于60天(2个月),它也会标记它。如果客户在失效之前从未调用过,它会返回警告消息,因为在这种情况下,最小间隔是无限的。

答案 1 :(得分:2)

OP要求在失效前的两个月内为每位客户标记所有电话。

这可以通过使用data.table在非等连接中聚合来解决:

library(lubridate)
library(data.table)
setDT(df)[, answer := 
            df[.(id = id, date1 = date, date2 = date %m+% months(2)), 
               on = .(id, date >= date1, date <= date2),
               as.integer(any(lapse == 1)), by = .EACHI]$V1][
                 call == 0, answer := 0][]
    id       date call lapse call_2months_or_less_before_lapse answer
 1:  1 2014-01-01    1     0                                 1      1
 2:  1 2014-02-07    0     1                                 0      0
 3:  1 2014-03-05    0     1                                 0      0
 4:  1 2014-03-14    1     0                                 0      1
 5:  1 2014-04-15    1     0                                 1      1
 6:  1 2014-04-17    1     0                                 1      1
 7:  1 2014-05-11    0     1                                 0      0
 8:  1 2014-08-19    1     0                                 0      0
 9:  1 2014-10-07    1     0                                 0      0
10:  1 2014-12-21    0     1                                 0      0
11:  3 2010-06-04    0     1                                 0      0
12:  3 2012-03-06    0     1                                 0      0
13:  3 2012-07-12    0     1                                 0      0
14:  3 2012-07-13    0     1                                 0      0
15:  3 2014-01-14    1     0                                 0      0
16:  3 2014-05-05    0     1                                 0      0
17:  3 2014-08-19    1     0                                 1      1
18:  3 2014-08-19    0     1                                 0      0
19:  4 2013-02-13    0     1                                 0      0
20:  4 2013-11-11    1     0                                 0      0
21:  4 2014-03-04    1     0                                 0      0
22:  4 2014-12-10    1     0                                 0      0
23:  4 2017-03-02    1     0                                 1      1
24:  4 2017-03-03    0     1                                 0      0
    id       date call lapse call_2months_or_less_before_lapse answer

请注意,第4行在OP的样本数据集中存在缺陷,将在下面的 Data 部分中讨论。

解释

如果在实际日期和实际日期加2个月内该客户有任何失效,我们的想法是寻找每一行(为简单起见,我们同时接听电话失效)。所以,我们展望未来 - 而不是落后。如果是,则此行的答案为1,否则为0

关键部分是非等连接中的聚合

df[.(id = id, date1 = date, date2 = date %m+% months(2)), 
   on = .(id, date >= date1, date <= date2), 
   as.integer(any(lapse == 1)), by = .EACHI]

df与使用data.table .()id和{{1}的date即时创建的date %m+% months(2)合并}}。在这里,我们使用lubridate的月算术来满足OP 2个月期间(不是60天)的要求。

通过on参数中的连接条件,选择满足条件的所有行,即具有相同的id且日期在日期范围内。使用by = .EACHI作为聚合函数,连接条件(any())会立即聚合这些匹配的行。

现在,此结果作为新列df附加到answer:=运算符更新了df ,即无需复制整个数据对象。

最后,针对包含 no 调用的行更正了answer

在开始时,setDT(df)用于强制df加入data.table课。

数据

本答案中使用了以下数据集:

library(lubridate)
df <- data.frame(
  id    = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4),
  date  = dmy(c("01-01-2014", "07-02-2014", "05-03-2014", "14-03-2014", "15-04-2014", "17-04-2014", 
                "11-05-2014", "19-08-2014", "07-10-2014", "21-12-2014", "04-06-2010", "06-03-2012", 
                "12-07-2012", "13-07-2012", "14-01-2014", "05-05-2014", "19-08-2014", "19-08-2014",
                "13-02-2013", "11-11-2013", "04-03-2014", "10-12-2014", "02-03-2017", "03-03-2017")), 
  call  = c(1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 1, 1, 1, 0),
  lapse = c(0, 1, 1, 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 0, 0, 0, 0, 1))

请注意,第4行与OP的原始数据集不同。对于第4行,OP已给出日期"14-02-2014",该日期不是按日期递增的顺序。我假设这是一个拼写错误,应该阅读"14-03-2014"以符合所有其他日期的增加顺序。

不幸的是,这个假定的拼写错误也对OP call_2months_or_less_before_lapse0中的预期结果产生了影响。但是,在任何情况下都应该是1。对于"14-02-2014",第3行中的两个月内会有失效。对于"14-03-2014",第7行会在两个月内失效。

答案 2 :(得分:1)

确实,有可能在R. Morever中解决你和类似问题的问题,你可以用R的基础知识轻松地做到(qite)。

首先,让我们更准确地阐述问题。不幸的是,并非所有细节都从您的帖子中清楚。我将尝试猜测并假设以下问题表达作为初始点:

对于每位客户每次失误,我们需要找到所有发生的电话 2个月或更少的时间,而不是失效日期并标记所有找到的事件(比如标记列中的1)。此外,我们可以从您的示例中猜测,如果许多事件对应于单个日期,则应仅标记仅呼叫事件

我建议通过以下步骤解决您的问题:

<强> 1。编写函数以查找之前2个月期间的所有日期     整个df的每次失效。

# @df_to_proceed is the data frame to be looked up
# @current_df_i is the row index of the precessed lapse
    Find2MonthsEarlier <- function(df_to_proceed, current_df_i) {
    # the customer ID for the given lapse
    given_id <- df_to_proceed$id[current_df_i] 
    # select the entries of the df corresponding 
    # to the 2-month period before the given lapse
    current_date <- df_to_proceed$date[current_df_i]
    # assume 2 month as simply 60 days
    date_2month_earlier <- as_date(current_date - 60)
    period_2month_earlier <- interval(date_2month_earlier, current_date)
    # select a subset for the certain customer and the 2-month period 
    # before the given lapse
    subset_2month_earlier <- df_to_proceed[with(df_to_proceed, 
        (date %within% period_2month_earlier & id == given_id)), ]
    subset_2month_earlier_reordrd <- subset_2month_earlier[order(subset_2month_earlier$date), ]
    # finds the row with the latest call within 2-month period before the given lapse
    i_of_latest_call_within2months <- nrow(subset_2month_earlier_reordrd) - 
        match(table = rev(subset_2month_earlier_reordrd$call), x = 1) +
        1
    date_of_latest_call_within2months <- subset_2month_earlier_reordrd[i_of_latest_call_within2months,
        "date"]
    # extract all the dates between the latest call within 2-month period 
    # before the given lapse (for the certain customer!)
    dates_to_flag <- subset_2month_earlier$date[subset_2month_earlier$date <=
        date_of_latest_call_within2months]  
    return(list(Subset = subset_2month_earlier, 
        LatestDate = as_date(date_of_latest_call_within2months),
        ID = given_id, FlaggedDates = dates_to_flag))
}

<强> 2。查找df中所有失误的行索引

i_of_lapse <- which(df$lapse == 1)

第3。在所有失误中应用该功能,同时处理同一日期的多重事件案例

for (i in i_of_lapse) {
    test_list <- Find2MonthsEarlier(df_to_proceed = df, 
        current_df_i = i)
    # duplicated dates are processed differently
    dates_with_dupl <- unique(test_list[["FlaggedDates"]][duplicated(test_list[["FlaggedDates"]])])
    # check length(dates_with_dupl) to prevent loss of the data
    if (length(dates_with_dupl) > 0) {
        dates_without_dupl <- test_list[["FlaggedDates"]][!(test_list$date %in% dates_with_dupl)]
    } else {
        dates_without_dupl <- test_list[["FlaggedDates"]]
        }
    # entries with duplicated dates are flagged only if corresponding call = 1
    df[(df$date %in% dates_with_dupl & 
            df$id == test_list[["ID"]] & df$call == 1),
        "flag_calls_2month_earlier_inR"] <- 1
    df[(df$date %in% dates_without_dupl & 
        df$id == test_list[["ID"]]),
        "flag_calls_2month_earlier_inR"] <- 1   
    }

我唯一不确定的是df$call_2months_or_less_before_lapse[c(3, 4)]对应于日期"07-02-2014""14-02-2014"的值。 call == 1"14-02-2014"lapse == 1"05-03-2014"。看起来,对于flag == 1"07-02-2014",它应该仍为"14-02-2014",但实际上它们是0。因此,问题公式或示例值都有问题。如果你可以请检查并评论这个问题,那就太好了。