Separar Efectos y Análisis de Camada

En los negocios de suscripción (Diarios, Celular, Seguros, etc…) el negocio siempre es el mismo: captar a un cliente y luego recibir flujos de dinero asociados a un servicio provisto por la empresa, el día que el cliente corta el servicio se llama CHURN y el cliente pasa a estar inactivo, suspendiendo los ingresos y el servicio.

En general, hay un costo por captar a un nuevo cliente, por lo que el valor presente de la captación dependerá de cuanto tiempo el cliente demore en CHURNear. En la siguiente imagen, mostramos en rojo el valor presente de un cliente para cada numero de meses de supervivencia, mientras que en azul los flujos de dinero, donde el primer flujo es negativo, representando por ejemplo: comisiones del vendedor, instalación del servicio, subsidios de equipos, etc… Claramente se ve que si el cliente no dura al menos 15 meses, el negocio fue malo y representó una perdida para la empresa.

library(ggplot2)
periods = 36
discount_rate = 1.06
cashflows = data.frame(period = 0:periods, cashflow = c(-10,rep(1,periods) )) %>% 
  mutate(cashflow_present_value = cashflow/(discount_rate^period), 
         present_value = cumsum(cashflow_present_value))
ggplot(cashflows) + 
  geom_bar(aes(period,cashflow),stat = "identity",fill = "blue") + 
  geom_line(aes(period,present_value),color = "red", size = 1.5)

Para monitorear y proyectar el comportamiento de los clientes, se realiza lo que es llamado un análisis de camadas, el cual en grandes rasgos, consiste en agrupar todos los clientes adquiridos en una ventana de tiempo (generalmente mensual) y utilizarlo como representante estadísticamente significativo del comportamiento del grupo. De este modo, se puede comparar el comportamiento promedio de las adquisiciones de distintos meses y realizara algunos modelos de proyecciones o simplemente comparar el performance de un mes vs otros meses.

Los KPI monitoreados mes a mes largo de la vida de una camada son los siguientes:

  • Activaciones: Numero de nuevos clientes captados en el mes
  • Ingreso Promedio: Ingreso promedio generado por un cliente que aun está suscrito al servicio
  • Tasa de Supervivencia: Porcentaje de clientes que aun no CHURNean

Lo interesante es que al multiplicar los 3 indicadores anteriores, se obtienen los ingresos totales de la camada para un mes, por lo que de lograrse un buen modelo para estimarlos, se pueden estimar con exactitud los flujos futuros de una empresa o el valor presente de un nuevo cliente.

En este caso veremos un análisis de camadas realizado para los donantes del Techo para Chile en el que analizamos estos 3 KPI y los descompusimos en factores, en este caso, debido a que debo mantener el anonimato de los donantes y datos de la empresa, compartiré solo los códigos y los gráficos sin escala pero no el dataset.

Primero vamos a inicializar el ambiente de trabajo setenado ciertas variables, cargando librerias y creando funciones.

options(stringsAsFactors = FALSE)
options(dplyr.width = Inf) 
options(dplyr.print_max = 100) 
Sys.setenv(TZ='GMT')

library(compiler)
library(tidyverse)
library(lubridate)
library(broom)
library(plotly)

moda = function(x){
  names(which.max(table(x))) 
}


isnull = function(x,reemplazo,Nulos = c(NA,Inf,-Inf,NULL,NaN)){
  ifelse(x %in% Nulos,reemplazo,x)
}

datasetRaw = readRDS("../3. dataset/dataset_cohort.rds")

El dataset recibido es una tabla con los flujos de dinero de 2016 y 2017, el truco para hacer este análisis más fácil es hacer aparecer los meses en que los donantes no generan su aporte y rellenarlos con un 0, por otro lado, mantendremos solo los aportes de los primeros 36 meses de vida de los donantes.


grilla = group_by(datasetRaw,nro_contrato,mes_activacion,monto_inicial,banco_t0,region,banco_t0, origen_pago_t0, hombre) %>% 
  summarise() %>% 
  crossing(meses = 1:36) %>%
  mutate(periodo = months(meses-1) + mes_activacion) %>% 
  filter(periodo >= as.Date("2016-01-01") &  periodo <= as.Date("2017-12-01"))
 
dataset = grilla %>%  
  left_join(datasetRaw) %>% 
  mutate(hombre = as.numeric(hombre),
         monto = replace_na(monto,0)) %>% 
  group_by(nro_contrato) %>% 
  arrange(meses) %>% 
  mutate(meses_activo = meses - min(c(meses[monto>0],9999))[1],
         meses_activo = replace(meses_activo,meses_activo <= 1,NA))

KPI Activaciones

Las activaciones o capturas de donantes no son muy constantes, se pueden ver por región y banco respectivamente:


tmp = filter(dataset, meses == 1)
gr = ggplot(tmp,aes(mes_activacion,fill = region)) + geom_bar()
ggplotly(gr,width = 800)


tmp = filter(dataset, meses == 1)
gr = ggplot(tmp,aes(mes_activacion,fill = banco_t0)) + geom_bar()
ggplotly(gr,width = 800)

KPI Ingreso Promedio

Lo natural es ver un histograma de la donación inicial para la ventana de tiempo y sacar algunos estadísticos como media ($4.569) y mediana ($5.000)


dataset_t0 = dataset  %>% 
    group_by(nro_contrato,mes_activacion,region,hombre, banco_t0) %>%  
    summarise(monto_inicial = mean(monto_inicial)) %>% 
    filter(dataset_t0, monto_inicial <= 20000) # Eliminar algunos outlayer
gr = ggplot(dataset_t0,aes(monto_inicial)) + geom_histogram(bins = 30)
ggplotly(gr,width = 800)

Lo que realmente es interesante es entender por que las donaciones son distintas y separar los factores, de modo de apuntar a mejores donantes en el futuro, en este caso analizaremos con los atributos que tenemos: genero, región y banco.

La descomposición la haremos con una regresión lineal con variables dummy, donde los betas representarán el aporte de cada atributo al aporte promedio.
Debido a la correlación, para cada una de las dimensiones o atributos desaparecerá la primera categoría, lo que se interpreta como que los pesos son relativos al valor del atributo faltante, por otro lado, omitiremos el análisis de significancia.

Podemos ver que los que aportan usando el banco BICE tienen un aporte promedio $1500 pesos más alto que el nivel de referencia, por lo que debe ser priorizado contra Movistar y Presto que están $3.000 bajo el nivel de referencia, por otro lado conviene hacer campañas de recaudación en la 2da y 11va región donde los donantes donan más.


tmp = dataset %>% filter(monto>0 & monto <=20000)
fit_monto_t0 = lm(monto_inicial ~ region + hombre + origen_pago_t0, tmp)
gr_data = tidy(fit_monto_t0)[-1,]
gr = ggplot(gr_data,aes(term,estimate)) + 
  geom_bar(stat="identity")+  
  theme(axis.text.x = element_text(angle = 45,hjust = 1))
ggplotly(gr,width = 800)

KPI Tasa de Supervivencia

Este es el KPI más complejo debido a que evolucione en al tiempo.

El equivalente al histograma de aporte promedio, es el gráfico de tasa de supervivencia promedio, el cual se ve del siguiente modo para los primeros 15 meses:


tmp = dataset %>% 
  filter(mes_activacion >= as.Date("2016-01-01") & meses < 15) %>%
  filter(!is.na(meses_activo)) %>%
  group_by(meses) %>% 
  summarise(supervivencia = mean(monto >0))

gr = ggplot(tmp,aes(meses,supervivencia)) +geom_line()
ggplotly(gr,wifth=800)

El gráfico anterior habla por si solo, hasta el mes numero 15, la perdida de clientes es mas o menos lineal, pero nos gustaría separar ese gráfico en factores: en este caso, estacionales y número de meses.

Para lograr la descomposición, haremos una regresión con variables dummy para cada mes y periodo, de este modo, no asumiremos ninguna forma para la curva. Los betas asociados al periodo, representarán las estacionalidad.

El gráfico por numero de mes des-estacionalizado queda casi idéntico al caso anterior, solo cambia el nivel, pero no puedo mostrarlo:


tmp = dataset %>% 
  filter(mes_activacion >= as.Date("2016-01-01") & meses < 15) %>%
  filter(!is.na(meses_activo)) %>%
  mutate(periodo = as.character(periodo),
         meses = as.character(meses), 
         supervivencia = monto>0, 
         meses_activo = as.character(meses_activo))

fit = lm(supervivencia ~ meses + periodo - 1, tmp)
fit_tidy = tidy(fit)
fit_meses = fit_tidy %>% 
  filter(!grepl("periodo",term)) %>% 
  # mutate(estimate = estimate+estimate[1]) %>% 
  filter(grepl("meses",term)) %>% 
  mutate(meses = as.numeric(str_remove(term,"meses")))

gr = ggplot(fit_meses,aes(meses, estimate)) + geom_line()
ggplotly(gr,wifth=800)

Por otro lado, el gráfico de estacionalidad muestra que hay meses más buenos que otros, en particular fines del 2016 e inicios del 2017 fueron muy malos, después hubo una recuperación que en 2017/10 se perdió.


fit_periodo = fit_tidy %>% 
  filter(grepl("periodo",term)) %>% 
  mutate(periodo = as.Date(str_remove(term,"periodo")))

gr = ggplot(fit_periodo,aes(periodo, estimate)) + geom_line()
ggplotly(gr,wifth=800)

Para terminar, al igual que en la descomposición de aporte promedio, realizaremos una descomposición de la supervivencia, para ellos debemos asumir una forma para la curva de supervivencia, la cual en este caso será una linea recta.
Vamos a estimar el aporte a la pendiente de la curva de supervivencia de cada uno de los factores que tenemos para analizar, el truco es reflejar la forma de la curva en las variables dummy del modelo, en este caso, como es lineal, pondremos el número de mes.

Los bancos Security, Itau y BICE son los con mejor tasa de supervivencia, mientras que Estado, Falabella y Tarjetas Retail son los clientes que menos duran, por otro lado las regines 11 y 15 son en las que los donantes más duran.


tmp = dataset %>% 
  filter(mes_activacion >= as.Date("2016-01-01") & meses < 15) %>%
  filter(!is.na(meses_activo)) %>% 
  # group_by(meses,periodo,region,hombre,banco_t0) %>% 
  # summarise(tasa_supervivencia = mean(monto>0), casos = n()) %>% 
  # filter(casos > 25) %>% 
  ungroup() %>% 
  mutate(periodo = as.character(periodo), 
         supervivencia  = (monto > 0)*1) 

mat = model.matrix(~supervivencia+  meses + periodo + region + hombre + banco_t0-1,tmp) %>% data.frame()
mat[,!grepl("periodo|supervivencia",colnames(mat))] = mat[,!grepl("periodo|supervivencia",colnames(mat))] *mat$meses
mat = select(mat,-meses)

fit = lm(supervivencia ~ . -1, as.data.frame(mat))
data_fit = tidy(fit) %>% 
  filter(!str_detect(term,"periodo"))

gr = ggplot(data_fit,aes(term,estimate)) + 
  geom_bar(stat="identity") + 
  theme(axis.text.x = element_text(angle = 45,hjust = 1))+
  ylab("aporte a tasa de supervivencia")+
  xlab("dimencion")
ggplotly(gr,width = 800)

Conclusiones

Más que una conclusión, ahora lo que hay que hacer es un modelo que utilice los parámetros calculados y valorizar la captación promedio para el producto cruz de cada uno de los atributos modelados, esto permitirá optimizar la locación de las personas que buscan donantes. Por ejemplo, lo clientes del banco BICE parecen ser de los buenos, por lo que puede ser buena idea poner un voluntario en la entrada del banco BICE.

Saludos!

Print Friendly, PDF & Email