Маркировка оттока клиентов в R

У меня есть данные транзакции в формате ниже.

transaction <- data.frame(account_id=c('ID001','ID001','ID002','ID002','ID001','ID002'), transaction_date=c('2017-01-02','2017-01-03','2017-01-03','2017-01-05','2017-01-06','2017-01-08'))

введите здесь описание изображения

Я хочу отметить, какая учетная запись неактивна в течение трех месяцев подряд с 1 января 2017 г. по 31 декабря 2017 г. Это мой код R.

library(dplyr)

list_account_id <- transaction %>% distinct(account_id)
list_account_id <- list_account_id$account_id

churn_label <- data.frame("account_id" = c('ID000'), "churn_date" = c(as.Date('9999/99/99')), "label"=c(0))

for (int_account_id in list_account_id){
    start_date <- as.Date('2017-01-01')
    break_while <- FALSE
    while(!break_while){
        end_date <- start_date+90
        int_transaction <- transaction %>% filter(account_id == int_account_id)
        int_transaction %>% filter(as.Date(transaction_date) <= end_date, as.Date(transaction_date) >= start_date) %>% summarise(n=n())

        sum_ntransaction <- int_transaction %>% filter(as.Date(transaction_date) <= end_date, as.Date(transaction_date) >= start_date) %>% summarise(n=n())
        if(sum_ntransaction$n == 0){
            churn_label_temp <- data.frame("account_id" = c(int_account_id), "churn_date" = c(start_date), "label"=c(1))
            churn_label <- rbind(churn_label, churn_label_temp)
            break_while <- TRUE
        }
        if(end_date == as.Date('2017-12-31')){
            churn_label_temp <- data.frame("account_id" = c(int_account_id), "churn_date" = c('9999/99/99'), "label"=c(0))
            churn_label <- rbind(churn_label, churn_label_temp)
            break_while <- TRUE
        }
    start_date <- start_date+1
    }
}

Вывод моего кода

введите здесь описание изображения

Однако мой код такой медленный. Есть ли другой способ сделать это?


r
person Community    schedule 29.08.2018    source источник
comment
Ваш ожидаемый результат не соответствует вашим демонстрационным данным. Откуда берется запись account_id = "ID000"?   -  person Maurits Evers    schedule 29.08.2018
comment
@MauritsEvers Это начальная строка для кадра данных churn_label и пример клиента без оттока. Я назначал вручную. Извините за путаницу.   -  person    schedule 29.08.2018
comment
Сколько различных учетных записей будет в вашем реальном приложении?   -  person Martin Seehafer    schedule 29.08.2018
comment
@MartinSeehafer Около 100 000 аккаунтов   -  person    schedule 29.08.2018
comment
Что делать, если у клиента есть транзакция 03.01.2017 и 06.01.2017? Это более 3 месяцев, поэтому вы считаете клиента оттоком с данными оттока 2017-01-03?   -  person Arno    schedule 29.08.2018
comment
@Arno Я буду идентифицировать их как «отток» (метка = 1). Я хочу определить клиентов, которые неактивны в течение трех месяцев подряд в течение заданного периода. Использование слова «отток» может ввести вас в замешательство. Прости за это.   -  person    schedule 29.08.2018


Ответы (2)


аккуратное решение

также с учетом того, что 90 дней != 3 месяца !! Для расчета с месяцами я предпочитаю % оператор m+% из пакета lubridate.

transaction <- data.frame(account_id=c('ID001','ID001','ID002','ID002','ID001','ID002'), transaction_date=c('2017-01-02','2017-01-03','2017-01-03','2017-01-05','2017-01-06','2017-01-08'))

library(tidyverse)
library(lubridate)

transaction %>%
  #set transaction date as dates
  mutate( transaction_date = as.Date( transaction_date ) ) %>%
  #group by account id
  group_by( account_id ) %>%
  #arrange on date 
  arrange( transaction_date ) %>%
  #inactive more than 3 months? Check if the next transaction date is larger than the currect transaction date + 3 months
  mutate( inactive_label = ifelse( transaction_date %m+% months(3) > lead( transaction_date ), 0, 1 ) ) %>%
  #also check the first and last row of each group (first not after 2017-01-01 + 3 months, last not before 31-12-2017 - 3 months)
  mutate( inactive_label = ifelse( row_number() == 1 & transaction_date > as.Date("2017-01-01") %m+% months(3), 1, inactive_label ) ) %>%
  mutate( inactive_label = ifelse( row_number() == n() & transaction_date %m+% months(3) < as.Date("2017-12-31") , 1, inactive_label ) )

# # A tibble: 6 x 3
# # Groups:   account_id [2]
# account_id transaction_date inactive_label
#   <fct>      <date>                    <dbl>
# 1 ID001      2017-01-02                    0
# 2 ID001      2017-01-03                    0
# 3 ID002      2017-01-03                    0
# 4 ID002      2017-01-05                    0
# 5 ID001      2017-01-06                    1
# 6 ID002      2017-01-08                    1
person Wimpel    schedule 29.08.2018
comment
Это намного быстрее, чем мой код. Ценю вашу помощь! - person ; 01.09.2018

Основываясь на том, что именно является вашим определением оттока, вас может интересовать только максимальная дата транзакции и проверить, не прошло ли эта транзакция более 3 месяцев с конца вашего зависимого периода. В качестве примера можно использовать следующее:

#Set up you timeline
end_dependent <- as.Date("2017-31-12", format= "%Y-%d-%m")
library(lubridate)
churndate <- end_dependent %m-% months(3)

# transaction date in date format
transaction$transaction_date <- as.Date(transaction$transaction_date,format= "%Y-%d-%m")

# Aggregate per account taking the maximum transaction date
transaction_per_account <- aggregate(list(max_transaction_date = transaction$transaction_date), by=list(account_id =transaction$account_id), max)
# Calculate a binary dependent variable for churn and churn date
transaction_per_account$churn <- ifelse(transaction_per_account$max_transaction_date <= churndate, 1, 0 )
ifelse(transaction_per_account$churn == 1, transaction_per_account$churn_date <- transaction_per_account$max_transaction_date, transaction_per_account$churn_date <- as.Date("9999-01-01", format= "%Y-%d-%m") )

Это дает в качестве вывода:

> transaction_per_account
account_id max_transaction_date churn churn_date
1      ID001           2017-06-01     1 2017-06-01
2      ID002           2017-08-01     1 2017-08-01
person Arno    schedule 29.08.2018