Calculating Life Time Value for Subscription Products

survival_rurve_fit.R

library(survival)
library(data.table)
library(ggplot2)

data = fread('https://raw.githubusercontent.com/IBM/invoke-wml-using-cognos-custom-control/master/data/Telco-Customer-Churn.csv')

churn_data <- data[, .(churn_flag = ifelse(Churn == 'Yes', 1, 0), tenure)]
km_curve <- survfit(Surv(tenure, churn_flag) ~ 1, data=churn_data)

# Calculate Survival and Churn Rate
km_curve_df = summary(km_curve)
curve = data.table(time = km_curve_df$time,
                   survival_rate = km_curve_df$surv,
                   churn_rate = km_curve_df$n.event / km_curve_df$n.risk)

# Fit Weibull model
km_curve_fit <- survreg(Surv(tenure, churn_flag) ~ 1, data=churn_data[tenure > 0],
                    dist = 'weibull')
churn_percentage = (1:980) / 1000
survival_tenure <- predict(km_curve_fit, newdata = data.table(x = 1),  
                           p = churn_percentage, type='quantile')

survival_fit <- data.table(survival_tenure = survival_tenure,
                           churn_percentage = churn_percentage)
survival_fit <- survival_fit[survival_tenure >= 1]

# Plot raw survival rate and fitted survival curve
ggplot() + 
  geom_line(aes(x = curve$time,
                y = curve$survival_rate,
                col = 'raw')) + 
  geom_line(aes(x = survival_fit$survival_tenure,
                y = 1 - survival_fit$churn_percentage,
                col = 'fit')) + 
  scale_x_continuous(name = 'cycle', limits = c(0, 500)) + 
  scale_y_continuous(labels = scales::percent, name = 'survival_rate') + 
  theme_minimal()