R Script to Create a Survival Plot and to Generate a Sample Data Set

generate.r

# preliminaires
library("ggplot2")
library("zoo")
set.seed(111)

# generate plot of survival curve
x <- sort(dexp(seq(0, 1, 0.01)), decreasing = TRUE)
ggplot(data.frame(x = c(0, 5)), aes(x)) + stat_function(fun = dexp, args = list(rate = 1)) + scale_x_continuous(labels=c(expression(t["0"], t["1"], t["2"], t["3"], t["4"], t["5"]))) + labs(x = "Time", y = expression(y = P(T > t["i"])), title = "Survival Function")

# simulate subscription data

# preliminaries
n_users = 10000
start_date = "2014-06-01"

# helper functions
generate_users <- function(users = NULL) {
	return(seq(1, users))
}

generate_signup_dates <- function(number_of_dates = NULL, start_date = NULL, end_date = Sys.Date()) {
	all_dates <- seq(as.Date(start_date), as.Date(end_date), by = "days")
	signup_dates <- c()
	for (i in 1:number_of_dates){
		signup_dates[i] <- sample(all_dates, 1, replace = TRUE, prob = sort(1/1:length(all_dates)))
	}
	return(as.Date(signup_dates, origin = "1970-01-01"))
}

generate_effective_lifetime <- function(signup = NULL) {
	potential_lifetime <- (as.yearmon(Sys.Date()) - as.yearmon(signup)) * 12
	return(sample(0:potential_lifetime, 1))
}

generate_lifetime <- function(signup = NULL) {
	potential_lifetime <- (as.yearmon(Sys.Date()) - as.yearmon(signup)) * 12
	return(potential_lifetime)
}

generate_order_amounts <- function(tenure = NULL) {
	monthly_fee <- rep(sample(c(25, 30, 50), 1, prob = c(0.75, 0.125, 0.125)), tenure)
	return(monthly_fee)
}
	
generate_order_months <- function(signup_dates = NULL, tenures = NULL) {
	order_months <- list()
	for (i in 1:length(signup_date)) {
		if(tenure[i] > 0) {
			order_months[[i]] <- seq(as.Date(signup_date[i]), by = "month", length = tenure[i])
		} else {
			order_months[[i]] <- NULL
		}
	}
	return(order_months)
}

# create users table
user_id <- generate_users(n_users)
signup_channel <- sample(c("google", "facebook", "bing"), size = n_users, replace = TRUE, prob = c(0.3, 0.5, 0.2))
signup_date <- sort(generate_signup_dates(number_of_dates = length(generate_users(n_users)), start_date = start_date))

# useful for other things
months_since_signup <- sapply(signup_date, generate_lifetime)
tenure <- sapply(signup_date, generate_effective_lifetime)

# create orders table
orders.subscription_amount <- unlist(lapply(tenure, generate_order_amounts))
orders.user_id <- rep(user_id, tenure)
orders.created_month <- as.Date(unlist(generate_order_months(signup_dates = signup_date, tenures = tenure)))

users <- data.frame(user_id, signup_date, signup_channel)
orders <- data.frame(orders.user_id, orders.created_month, orders.subscription_amount)