**Instructions**

- Run the telcoChurn-main.R to drive the R demo

- Run the telcoChurn-modelComparison.R to compare different algorithms that we tried to build churn models

**Description**

- **telcoChurn-setUp.R** - Setting up relevant R packages

- **telcoChurn-evaluate.R** - Defining pre-functions for model evaluation

- **telcoChurn-dataExploration.R** - Creating a Shiny application to explore and visualize the data

- **telcoChurn-dataPreparation.R** - Defining functions to do data pre-processing and spliting in order to generate suitable training and testing data sets

- **telcoChurn-trainModel.R** - Defining a function to train the telco churn model with mxFastTree algorithm

- **telcoChurn-main.R** - Main R file driving the demo execution

- **telcoChurn-modelComparison.R** - R file to build and compare different tree-based classification models, including CRAN R algorithms - randomForest and xgboost, RevoScaleR algorithms – rxDForest and rxBTrees, as well as MicrosoftRML algorithms – mxFasttree and mxFastforest

library(shiny)

library(leaflet)

library(jsonlite)

library(dplyr)

library(ggplot2)

cdrFile <- file.path(wd, "Data", "edw_cdr.csv")

cdrDF <- read.csv(file = cdrFile, header = TRUE, sep = ",")

latlonFile <- file.path(wd, "Data", "state_latlon.csv")

latlonDF <- read.csv(file = latlonFile, header = TRUE, sep = ",")

data <- cdrDF %>%

group_by(state) %>%

summarise(complaintsbystate = sum(as.numeric(numberofcomplaints)),

churnbystate = sum(as.numeric(churn))) %>%

mutate(lab = paste0("<center>", "state,", state, ": ", "<br>",

"complaintsbystate,", complaintsbystate, "<br>",

"churnbystate,", churnbystate, "</center>")) %>%

left_join(cdrDF, by = "state") %>%

left_join(latlonDF, by = "state")

ui <- fluidPage(

tags$style(HTML("

")),

titlePanel("Telco Customer Churn"),

# Sidebar with a slider input for number of bins

sidebarLayout(

sidebarPanel(

sliderInput("sc", "Scale size of circles (also redraws map to show only the last added state)",

min = 0.5, max = 5, value = 1, step = 0.1),

p(),

selectInput("state", "Select a state to add to the map",

choices = c("", data$state), selected = "",

size = , selectize = FALSE),

actionButton("clear1", "Clear all states"),

p(),

p("Proportion of customer churn"),

plotOutput("MyPlot1", height = "200px"),

p(),

p("Impact of education on churn"),

plotOutput("MyPlot2", height = "200px"),

p(),

p("Impact of call failure rate on churn"),

plotOutput("MyPlot3", height = "200px"),

h2("About"),

HTML("<p>Created with R and Shiny leaflet. R users can download the

http://dev.maxmind.com/geoip/legacy/codes/state_latlon/</a>.")

),

mainPanel(

leafletOutput("MyMap", height = 1000)

)

)

)

server <- function(input, output, session) {

the_data_state <- reactive({

tmp <- data %>%

filter(state == input$state)

if (input$state != "") {

thecol <- data.frame(data)[data$state == input$state, "colour"]

} else {

tmp <- data[1,]

thecol <- NULL

}

return(list(df = tmp, thecol = thecol))

})

output$MyMap <- renderLeaflet({

leaflet() %>%

addProviderTiles("Stamen.Watercolor") %>%

addProviderTiles("Stamen.TonerLabels") %>%

fitBounds(-120, 30, -60, 50)

})

observe({

leafletProxy("MyMap", data = the_data_state()$df) %>%

addCircleMarkers( ~ longitude,

~ latitude,

color = the_data_state()$thecol,

radius = ~churnbystate * 0.1 * input$sc,

popup = ~lab)

})

observe({

x <- input$clear1

updateSelectInput(session, "state", selected = "")

leafletProxy("MyMap") %>% clearMarkers()

})

observe({

x <- input$sc

leafletProxy("MyMap") %>% clearMarkers()

})

output$MyPlot1 <- renderPlot({

cdrDF %>%

ggplot(aes(x = factor(1), fill = factor(churn))) +

geom_bar(width = 1) +

coord_polar(theta = "y") +

theme_minimal()

})

output$MyPlot2 <- renderPlot({

cdrDF %>%

group_by(month, education) %>%

summarize(countofchurn = sum(as.numeric(churn))) %>%

ggplot(aes(x = month, y = countofchurn,

group = education, fill = education)) +

geom_bar(stat = "identity", position = position_dodge()) +

labs(x = "month", y = "Counts of churn") +

theme_minimal()

})

output$MyPlot3 <- renderPlot({

data %>%

group_by(month, callfailurerate) %>%

summarize(countofchurn = sum(as.numeric(churn))) %>%

ggplot(aes(x = month, y = countofchurn,

group = factor(callfailurerate), fill = factor(callfailurerate))) +

geom_bar(stat = "identity", position = position_dodge()) +

labs(x = "month", y = "Counts of churn") +

theme_minimal()

})

}

dataPreparation <- function(sqlSettings, trainTable, testTable) {

sqlConnString <- sqlSettings$connString

## Query necessary columns from the call detail record table

dataVars <- rxGetVarNames(cdrSQL)

dataVars <- dataVars[!dataVars %in% c("year", "month")]

dataVars <- paste(dataVars, collapse = ", ")

dataQuery <- paste("select", dataVars, "from", inputTable)

## Create sql server data sources

inputDataSQL = RxSqlServerData(sqlQuery = dataQuery,

connectionString = sqlConnString,

colInfo = cdrColInfo)

trainDataSQL <- RxSqlServerData(connectionString = sqlConnString,

table = trainTable,

colInfo = cdrColInfo)

testDataSQL <- RxSqlServerData(connectionString = sqlConnString,

table = testTable,

colInfo = cdrColInfo)

## Data pre-processing: cleaning and splitting followed by SMOTE

rxExec(preProcess, inData = inputDataSQL, outData1 = trainDataSQL, outData2 = testDataSQL)

}

preProcess <- function(inData, outData1, outData2) {

## Clean missing data

## Remove duplicate rows

cdrDF <- rxDataStep(inData = inData,

removeMissings = TRUE,

overwrite = TRUE)

cdrDF <- cdrDF[!duplicated(cdrDF),]

## Split data

set.seed(1234)

splitFile <- rxSplit(inData = cdrDF,

outFilesBase = "trainTestData",

splitByFactor = "ind",

transforms = list(ind = factor(sample(0:1, size = .rxNumRows, replace = TRUE, prob = c(0.3, 0.7)),

levels = 0:1,

labels = c("Test", "Train"))),

overwrite = TRUE)

trainFile <- splitFile[[2]]

testFile <- splitFile[[1]]

## SMOTE on training data

trainDF <- rxDataStep(inData = trainFile, varsToDrop = c("ind"))

testDF <- rxDataStep(inData = testFile, varsToDrop = c("ind"))

library(unbalanced)

trainVars <- names(trainDF)

trainVarsInd <- trainVars %in% c("churn")

smotetrain <- ubSMOTE(X = trainDF[!trainVarsInd], Y = trainDF$churn,

perc.over = 200, perc.under = 500,

k = 3, verbose = TRUE)

smotetrainDF <- cbind(smotetrain$X, smotetrain$Y)

names(smotetrainDF)[names(smotetrainDF) == "smotetrain$Y"] <- "churn"

trainDF <- smotetrainDF

## Load final training data and testing data into SQL

rxDataStep(inData = trainDF, outFile = outData1, overwrite = TRUE)

rxDataStep(inData = testDF, outFile = outData2, overwrite = TRUE)

}

evaluateModel <- function(data, observed, predicted)

{

confusion <- table(data[[observed]], data[[predicted]])

print(confusion)

tp <- confusion[rownames(confusion) == 1, colnames(confusion) == 1]

fn <- confusion[rownames(confusion) == 1, colnames(confusion) == 0]

fp <- confusion[rownames(confusion) == 0, colnames(confusion) == 1]

tn <- confusion[rownames(confusion) == 0, colnames(confusion) == 0]

accuracy <- (tp + tn) / (tp + fn + fp + tn)

precision <- tp / (tp + fp)

recall <- tp / (tp + fn)

fscore <- 2 * (precision * recall) / (precision + recall)

metrics <- c("Accuracy" = accuracy,

"Precision" = precision,

"Recall" = recall,

"F-Score" = fscore)

return(metrics)

}

rxrocCurve <- function(data, observed, predicted)

{

data <- data[, c(observed, predicted)]

data[[observed]] <- as.numeric(as.character(data[[observed]]))

rxRocCurve(actualVarName = observed,

predVarNames = predicted,

data = data)

}