Delete revised demo

This commit is contained in:
Zhou Fang
2016-08-25 18:04:45 +08:00
parent de82dc7178
commit ac619cb04b
16 changed files with 0 additions and 22327 deletions
File diff suppressed because it is too large Load Diff
@@ -1,56 +0,0 @@
"state","latitude","longitude"
AK,61.3850,-152.2683
AL,32.7990,-86.8073
AR,34.9513,-92.3809
AS,14.2417,-170.7197
AZ,33.7712,-111.3877
CA,36.1700,-119.7462
CO,39.0646,-105.3272
CT,41.5834,-72.7622
DC,38.8964,-77.0262
DE,39.3498,-75.5148
FL,27.8333,-81.7170
GA,32.9866,-83.6487
HI,21.1098,-157.5311
IA,42.0046,-93.2140
ID,44.2394,-114.5103
IL,40.3363,-89.0022
IN,39.8647,-86.2604
KS,38.5111,-96.8005
KY,37.6690,-84.6514
LA,31.1801,-91.8749
MA,42.2373,-71.5314
MD,39.0724,-76.7902
ME,44.6074,-69.3977
MI,43.3504,-84.5603
MN,45.7326,-93.9196
MO,38.4623,-92.3020
MP,14.8058,145.5505
MS,32.7673,-89.6812
MT,46.9048,-110.3261
NC,35.6411,-79.8431
ND,47.5362,-99.7930
NE,41.1289,-98.2883
NH,43.4108,-71.5653
NJ,40.3140,-74.5089
NM,34.8375,-106.2371
NV,38.4199,-117.1219
NY,42.1497,-74.9384
OH,40.3736,-82.7755
OK,35.5376,-96.9247
OR,44.5672,-122.1269
PA,40.5773,-77.2640
PR,18.2766,-66.3350
RI,41.6772,-71.5101
SC,33.8191,-80.9066
SD,44.2853,-99.4632
TN,35.7449,-86.7489
TX,31.1060,-97.6475
UT,40.1135,-111.8535
VA,37.7680,-78.2057
VI,18.0001,-64.8199
VT,44.0407,-72.7093
WA,47.3917,-121.5708
WI,44.2563,-89.6385
WV,38.4680,-80.9696
WY,42.7475,-107.2085
1 state latitude longitude
2 AK 61.3850 -152.2683
3 AL 32.7990 -86.8073
4 AR 34.9513 -92.3809
5 AS 14.2417 -170.7197
6 AZ 33.7712 -111.3877
7 CA 36.1700 -119.7462
8 CO 39.0646 -105.3272
9 CT 41.5834 -72.7622
10 DC 38.8964 -77.0262
11 DE 39.3498 -75.5148
12 FL 27.8333 -81.7170
13 GA 32.9866 -83.6487
14 HI 21.1098 -157.5311
15 IA 42.0046 -93.2140
16 ID 44.2394 -114.5103
17 IL 40.3363 -89.0022
18 IN 39.8647 -86.2604
19 KS 38.5111 -96.8005
20 KY 37.6690 -84.6514
21 LA 31.1801 -91.8749
22 MA 42.2373 -71.5314
23 MD 39.0724 -76.7902
24 ME 44.6074 -69.3977
25 MI 43.3504 -84.5603
26 MN 45.7326 -93.9196
27 MO 38.4623 -92.3020
28 MP 14.8058 145.5505
29 MS 32.7673 -89.6812
30 MT 46.9048 -110.3261
31 NC 35.6411 -79.8431
32 ND 47.5362 -99.7930
33 NE 41.1289 -98.2883
34 NH 43.4108 -71.5653
35 NJ 40.3140 -74.5089
36 NM 34.8375 -106.2371
37 NV 38.4199 -117.1219
38 NY 42.1497 -74.9384
39 OH 40.3736 -82.7755
40 OK 35.5376 -96.9247
41 OR 44.5672 -122.1269
42 PA 40.5773 -77.2640
43 PR 18.2766 -66.3350
44 RI 41.6772 -71.5101
45 SC 33.8191 -80.9066
46 SD 44.2853 -99.4632
47 TN 35.7449 -86.7489
48 TX 31.1060 -97.6475
49 UT 40.1135 -111.8535
50 VA 37.7680 -78.2057
51 VI 18.0001 -64.8199
52 VT 44.0407 -72.7093
53 WA 47.3917 -121.5708
54 WI 44.2563 -89.6385
55 WV 38.4680 -80.9696
56 WY 42.7475 -107.2085
@@ -1,20 +0,0 @@
**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 rxDForest 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
----------
@@ -1,158 +0,0 @@
####################################################################################################
## Title: Telco Customer Churn
## Description: Data Exploration and Visualization
## Author: Microsoft
####################################################################################################
library(shiny)
library(leaflet)
library(jsonlite)
library(dplyr)
library(ggplot2)
## Load data from SQL
# cdrDF <- rxImport(inData = cdrSQL)
## Load data from local
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("
@import url('https://fonts.googleapis.com/css?family=Poppins');
body {
font-family: 'Poppins', 'Lucida Grande', Verdana, Lucida, Helvetica, Arial, Calibri, sans-serif;
color: rgb(0,0,0);
background-color: #d2d2d2;
}
")),
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 by Fang Zhou with R and Shiny leaflet. R users can download the
cleaned and tidy call detail record data from <a href = 'https://github.com/Microsoft/sql-server-samples/tree/master/samples/features/r-services/Telco%20Customer%20Churn'>
https://github.com/Microsoft/sql-server-samples/tree/master/samples/features/r-services/Telco%20Customer%20Churn</a>.
The latitute and longitute for each USA state can be found from <a href = 'http://dev.maxmind.com/geoip/legacy/codes/state_latlon/'>
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()
})
}
@@ -1,69 +0,0 @@
####################################################################################################
## Title: Telco Customer Churn
## Description: Data Preparation
## Author: Microsoft
## Note: Prepare the training and testing data sets by pre-processing and spliting on raw data
####################################################################################################
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)
}
@@ -1,39 +0,0 @@
################################################################
## Title: Telco Customer Churn
## Description: Defining pre-functions
## Author: Microsoft
################################################################
####################################################################################################
## Define functions for model evaluation
####################################################################################################
## Define evaluation metrics
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)
}
## Define ROC curve
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)
}
@@ -1,195 +0,0 @@
####################################################################################################
## Title: Telco Customer Churn
## Description: Main R file driving the demo execution
## Author: Microsoft
####################################################################################################
####################################################################################################
## Settings
# In order to run this script, you need to set the values of the parameters in this section to your
# own values.
####################################################################################################
## SQL database and login credentials. Please change this part to your own values.
## If you are using Windows Authentication, "user" and "password" are not needed.
## if you are using Windows Authentication, change authenticationFlag to "Windows"
authenticationFlag <- "SQL" #Valid values: "Windows" or "SQL"
servername <- "."
database <- "telcoedw"
user <- "sa"
password <- "Devzhouf@123" #Please set your own password
## Set working directory. Please change this to the main directory of the demo
wd <- "C:\\Demo\\TelcoChurn4\\TelcoChurn4"
####################################################################################################
## Source function scripts
####################################################################################################
source(file.path(wd, "R", "telcoChurn-setUp.R"))
source(file.path(wd, "R", "telcoChurn-evaluate.R"))
source(file.path(wd, "R", "telcoChurn-dataExploration.R"))
source(file.path(wd, "R", "telcoChurn-dataPreparation.R"))
source(file.path(wd, "R", "telcoChurn-trainModel.R"))
####################################################################################################
## Set up SQL server compute context
# This part just configure the sql compute context. We are still in the default local compute context.
# We will swtich to SQL compute context after loading data into SQL tables.
####################################################################################################
if (authenticationFlag == "Windows") {
sqlConnString <- paste("Driver=SQL Server;Server=", servername, ";Database=", database, ";trusted_connection=true", sep = "")
} else if (authenticationFlag == "SQL") { sqlConnString <- paste("Driver=SQL Server;Server=", servername, ";Database=", database, ";Uid=", user, ";Pwd=", password, sep = "") }
sqlCompute <- RxInSqlServer(connectionString = sqlConnString)
sqlSettings <- vector("list")
sqlSettings$connString <- sqlConnString
####################################################################################################
## Load data into SQL tables
####################################################################################################
rxSetComputeContext('local')
cdrTable <- "edw_cdr"
cdrFile <- RxTextData(file.path(wd, "Data", "edw_cdr.csv"))
cdrColInfo <- list(age = list(type = "integer"),
annualincome = list(type = "integer"),
calldroprate = list(type = "numeric"),
callfailurerate = list(type = "numeric"),
callingnum = list(type = "numeric"),
customerid = list(type = "integer"),
customersuspended = list(type = "factor", levels = c("No", "Yes")),
education = list(type = "factor", levels = c("Bachelor or equivalent", "High School or below", "Master or equivalent", "PhD or equivalent")),
gender = list(type = "factor", levels = c("Female", "Male")),
homeowner = list(type = "factor", levels = c("No", "Yes")),
maritalstatus = list(type = "factor", levels = c("Married", "Single")),
monthlybilledamount = list(type = "integer"),
noadditionallines = list(type = "factor", levels = c("\\N")),
numberofcomplaints = list(type = "factor", levels = as.character(0:3)),
numberofmonthunpaid = list(type = "factor", levels = as.character(0:7)),
numdayscontractequipmentplanexpiring = list(type = "integer"),
occupation = list(type = "factor", levels = c("Non-technology Related Job", "Others", "Technology Related Job")),
penaltytoswitch = list(type = "integer"),
state = list(type = "factor"),
totalminsusedinlastmonth = list(type = "integer"),
unpaidbalance = list(type = "integer"),
usesinternetservice = list(type = "factor", levels = c("No", "Yes")),
usesvoiceservice = list(type = "factor", levels = c("No", "Yes")),
percentagecalloutsidenetwork = list(type = "numeric"),
totalcallduration = list(type = "integer"),
avgcallduration = list(type = "integer"),
churn = list(type = "factor", levels = as.character(0:1)),
year = list(type = "factor", levels = as.character(2015)),
month = list(type = "factor", levels = as.character(1:3)))
cdrSQL <- RxSqlServerData(table = cdrTable,
connectionString = sqlConnString,
colInfo = cdrColInfo)
rxDataStep(inData = cdrFile, outFile = cdrSQL, overwrite = TRUE)
## View raw data information
rxGetInfo(data = cdrSQL, getVarInfo = TRUE)
####################################################################################################
## Data exploration and visualization
####################################################################################################
shinyApp(ui, server)
####################################################################################################
## Data preparation and feature engineering
####################################################################################################
## SQL table names
inputTable <- cdrTable
trainTable <- "edw_cdr_train"
testTable <- "edw_cdr_test"
predTable <- "edw_cdr_pred"
## Data preparation.
# We now delete unnecessary columns, clean missing values, remove duplicate rows,
# but more importantly, split the raw data into training and testing data sets followed by SMOTE.
system.time({
dataPreparation(sqlSettings, trainTable, testTable)
})
## View the number of churn events in training and testing data sets.
trainDataSQL <- RxSqlServerData(connectionString = sqlConnString,
table = trainTable,
colInfo = cdrColInfo)
testDataSQL <- RxSqlServerData(connectionString = sqlConnString,
table = testTable,
colInfo = cdrColInfo)
rxGetInfo(trainDataSQL, getVarInfo = T)
rxGetInfo(testDataSQL, getVarInfo = T)
rxSummary( ~ churn, data = trainDataSQL)
rxSummary( ~ churn, data = testDataSQL)
####################################################################################################
## Train model
####################################################################################################
## Switch to sql compute context.
# From now on, all the executions will be done in the SQL server
rxSetComputeContext(sqlCompute)
## Train Decision Forest model with rxDForest
system.time({
trainModel(sqlSettings, trainTable)
})
## View model results
rx_forest_model
plot(rx_forest_model)
rxVarImpPlot(rx_forest_model)
####################################################################################################
## Score model
####################################################################################################
## Switch to local compute context.
rxSetComputeContext('local')
## Transform the test data set into a data frame
testDF <- rxDataStep(inData = testDataSQL)
## Score model
predictions <- rxPredict(modelObject = rx_forest_model,
data = testDF,
type = "prob",
overwrite = TRUE)
threshold <- 0.5
predictions$X0_prob <- NULL
predictions$churn_Pred <- NULL
names(predictions) <- c("Forest_Probability")
predictions$Forest_Prediction <- ifelse(predictions$Forest_Probability > threshold, 1, 0)
predictions$Forest_Prediction <- factor(predictions$Forest_Prediction, levels = c(1, 0))
predDF <- cbind(testDF[, c("customerid", "churn")], predictions)
head(predDF)
####################################################################################################
## Evaluate model
####################################################################################################
## Visualize confusion matrix
tmp <- rxCube( ~ churn:Forest_Prediction, data = predDF, mean = FALSE)
resultsDF <- rxResultsDF(tmp)
resultsDF %>%
ggplot(aes(x = churn, y = Counts,
group = Forest_Prediction, fill = Forest_Prediction)) +
geom_bar(stat = "identity") +
labs(x = "churn", y = "Counts of customer") +
theme_minimal()
## Generate model performance metrics
rx_forest_metrics <- evaluateModel(data = predDF,
observed = "churn",
predicted = "Forest_Prediction")
rx_forest_metrics
## Draw roc curve
rxrocCurve(data = predDF,
observed = "churn",
predicted = "Forest_Probability")
@@ -1,220 +0,0 @@
####################################################################################################
## Title: Telco Customer Churn
## Description: Building/Comparing the Telco Churn Models with various tree-based algorithms
## provided by open source R packages and RevoScaleR libraries
## Author: Microsoft
####################################################################################################
####################################################################################################
## Connect to the training and testing data
####################################################################################################
## SQL data source
train_table <- RxSqlServerData(connectionString = sqlConnString,
table = "edw_cdr_train",
colInfo = cdrColInfo)
test_table <- RxSqlServerData(connectionString = sqlConnString,
table = "edw_cdr_test",
colInfo = cdrColInfo)
## Transform training and testing data to be data frame
train_df <- rxDataStep(inData = train_table)
test_df <- rxDataStep(inData = test_table)
####################################################################################################
## Random forest modeling with randomForest on the data frame
####################################################################################################
library(randomForest)
## Train model
system.time({
forest_model <- randomForest(churn ~ .,
data = train_df,
ntree = 8,
mtry = 2,
maxdepth = 16,
replace = TRUE)
})
print(forest_model)
#visualize error evolution
plot(forest_model)
#view importance of each predictor
importance(forest_model)
#visualize importance of each predictor
plot(importance(forest_model), lty = 2, pch = 16)
lines(importance(forest_model))
## Score model
predictions_class <- predict(forest_model,
newdata = test_df,
type = "response")
predictions_prob <- predict(forest_model,
newdata = test_df,
type = "prob")
pred_df <- cbind(test_df, predictions_class, predictions_prob[, 2])
names(pred_df)[names(pred_df) == "predictions_class"] <- "randomForest_Prediction"
names(pred_df)[names(pred_df) == "predictions_prob[, 2]"] <- "randomForest_Probability"
head(pred_df)
## Evaluate model
forest_metrics <- evaluateModel(data = pred_df,
observed = "churn",
predicted = "randomForest_Prediction")
forest_metrics
rxrocCurve(data = pred_df,
observed = "churn",
predicted = "randomForest_Probability")
####################################################################################################
## Extreme gradient boost modeling with xgboost on the data frame
####################################################################################################
library(Matrix)
library(xgboost)
## Train Model
ntrain <- apply(train_df[, -27], 2, as.numeric)
dtrain <- list()
dtrain$data <- Matrix(ntrain, sparse = TRUE)
dtrain$label <- as.numeric(train_df$churn) - 1
str(dtrain)
system.time({
xgboost_model <- xgboost(data = dtrain$data,
label = dtrain$label,
max.depth = 32,
eta = 1,
nthread = 2,
nround = 2,
objective = "binary:logistic")
})
importance <- xgb.importance(feature_names = dtrain$data@Dimnames[[2]],
model = xgboost_model)
print(importance)
library(Ckmeans.1d.dp)
xgb.plot.importance(importance)
## Score model
ntest <- apply(test_df[, -27], 2, as.numeric)
dtest <- list()
dtest$data <- Matrix(ntest, sparse = TRUE)
dtest$label <- as.numeric(test_df$churn) - 1
str(dtest)
predictions <- predict(xgboost_model,
newdata = dtest$data)
threshold <- 0.5
xgboost_Probability <- predictions
xgboost_Prediction <- ifelse(xgboost_Probability > threshold, 1, 0)
pred_df <- cbind(test_df[, -27], dtest$label, xgboost_Prediction, xgboost_Probability)
names(pred_df)[names(pred_df) == "dtest$label"] <- "churn"
head(pred_df)
## Evaluate Model
xgboost_metrics <- evaluateModel(data = pred_df,
observed = "churn",
predicted = "xgboost_Prediction")
xgboost_metrics
rxrocCurve(data = pred_df,
observed = "churn",
predicted = "xgboost_Probability")
####################################################################################################
## Decision forest modeling with rxDForest on SQL data source
####################################################################################################
## Train model
rxSetComputeContext(sqlCompute)
train_vars <- rxGetVarNames(train_table)
train_vars <- train_vars[!train_vars %in% c("churn")]
temp <- paste(c("churn", paste(train_vars, collapse = "+")), collapse = "~")
formula <- as.formula(temp)
system.time({
rx_forest_model <- rxDForest(formula = formula,
data = train_table,
nTree = 8,
maxDepth = 16,
mTry = 2,
minBucket = 1,
replace = TRUE,
importance = TRUE,
seed = 8,
parms = list(loss = c(0, 4, 1, 0)))
})
rx_forest_model
plot(rx_forest_model)
rxVarImpPlot(rx_forest_model)
## Score model
rxSetComputeContext('local')
predictions <- rxPredict(modelObject = rx_forest_model,
data = test_df,
type = "prob",
overwrite = TRUE)
threshold <- 0.5
predictions$X0_prob <- NULL
predictions$churn_Pred <- NULL
names(predictions) <- c("Forest_Probability")
predictions$Forest_Prediction <- ifelse(predictions$Forest_Probability > threshold, 1, 0)
predictions$Forest_Prediction <- factor(predictions$Forest_Prediction, levels = c(1, 0))
pred_df <- cbind(test_df[, c("customerid", "churn")], predictions)
head(pred_df)
## Evaluate Model
rx_forest_metrics <- evaluateModel(data = pred_df,
observed = "churn",
predicted = "Forest_Prediction")
rx_forest_metrics
rxrocCurve(data = pred_df,
observed = "churn",
predicted = "Forest_Probability")
####################################################################################################
## Boosted tree modeling with rxBTrees on SQL data source
####################################################################################################
## Train model
rxSetComputeContext(sqlCompute)
system.time({
rx_boosted_model <- rxBTrees(formula = formula,
data = train_table,
minSplit = 10,
minBucket = 10,
learningRate = 0.2,
nTree = 100,
mTry = 2,
maxDepth = 10,
useSurrogate = 0,
replace = TRUE,
importance = TRUE,
lossFunction = "bernoulli")
})
rx_boosted_model
plot(rx_boosted_model, by.class = TRUE)
rxVarImpPlot(rx_boosted_model)
## Score model
rxSetComputeContext('local')
predictions <- rxPredict(modelObject = rx_boosted_model,
data = test_df,
type = "prob",
overwrite = TRUE)
threshold <- 0.5
#predictions <- 1-predictions
names(predictions) <- c("Boosted_Probability")
predictions$Boosted_Prediction <- ifelse(predictions$Boosted_Probability > threshold, 1, 0)
predictions$Boosted_Prediction <- factor(predictions$Boosted_Prediction, levels = c(1, 0))
pred_df <- cbind(test_df[, c("customerid", "churn")], predictions)
head(pred_df)
## Evaluate model
rx_boosted_metrics <- evaluateModel(data = pred_df,
observed = "churn",
predicted = "Boosted_Prediction")
rx_boosted_metrics
rxrocCurve(data = pred_df,
observed = "churn",
predicted = "Boosted_Probability")
@@ -1,40 +0,0 @@
################################################################
## Title: Telco Customer Churn
## Description: Setting up relevant R packages
## Author: Microsoft
################################################################
####################################################################################################
## Install packages
####################################################################################################
## Install packages for data exploration usage
if (!require("devtools"))
install.packages("devtools")
devtools::install_github("rstudio/d3heatmap")
install.packages("dplyr")
install.packages("gplots")
install.packages("ggplot2")
install.packages("qcc")
install.packages("Rcpp")
install.packages("d3heatmap")
install.packages("GGally")
install.packages("shiny")
install.packages("leaflet")
install.packages("jsonlite")
## Install packages for model building usage
install.packages("unbalanced")
install.packages("rpart")
install.packages("randomForest")
install.packages("Matrix")
install.packages("xgboost")
install.packages("Ckmeans.1d.dp")
install.packages("DiagrammeR")
install.packages("ROCR")
install.packages("pROC")
install.packages("AUC")
@@ -1,35 +0,0 @@
####################################################################################################
## Title: Telco Customer Churn
## Description: Train the Telco Churn Model with rxDForest
## Author: Microsoft
####################################################################################################
trainModel = function(sqlSettings, trainTable) {
sqlConnString = sqlSettings$connString
trainDataSQL <- RxSqlServerData(connectionString = sqlConnString,
table = trainTable,
colInfo = cdrColInfo)
## Create training formula
labelVar = "churn"
trainVars <- rxGetVarNames(trainDataSQL)
trainVars <- trainVars[!trainVars %in% c(labelVar)]
temp <- paste(c(labelVar, paste(trainVars, collapse = "+")), collapse = "~")
formula <- as.formula(temp)
## Train gradient tree boosting with mxFastTree on SQL data source
library(RevoScaleR)
rx_forest_model <- rxDForest(formula = formula,
data = trainDataSQL,
nTree = 8,
maxDepth = 16,
mTry = 2,
minBucket = 1,
replace = TRUE,
importance = TRUE,
seed = 8,
parms = list(loss = c(0, 4, 1, 0)))
return(rx_forest_model)
}
@@ -1,52 +0,0 @@
Data Science for Database Professionals
As a data professional, do you wonder how you can leverage data science for creating new value in your organization? In this sample, learn how you can leverage your familiar knowledge on working with databases, and learn how you can get started with doing data science with databases.
----------
**Example**
Businesses need an effective strategy for managing customer churn. Customer churn includes customers stopping the use of a service, switching to a competitor service, switching to a lower-tier experience in the service or reducing engagement with the service.
In this use case, we look at how a mobile phone carrier company can proactively identify customers more likely to churn in the near term in order to improve the service and create custom outreach campaigns that help retain the customers.
Mobile phone carriers face an extremely competitive market. Many mobile carriers lose revenue from postpaid customers due to churn. Hence the ability to proactively and accurately identify customer churn at scale can be a huge competitive advantage. Some of the factors contributing to mobile phone customer churn includes: Perceived frequent service disruptions, poor customer service experiences in online/retail stores, offers from other competing carriers (better family plan, data plan, etc.).
Using a concrete example of building a predictive customer churn model for mobile service provider, well share how you can jumpstart by
- Running R scripts using SQL Server as the compute context
- Operationalize your R scripts using stored procedures.
The insights delivered by these models are visualized using a Power BI dashboard
(e.g.[ https://powerbi.microsoft.com/en-us/industries/telco]( https://powerbi.microsoft.com/en-us/industries/telco)) or a SQL Report (telcoChurn-reportBuilder.rdl).
----------
**Pre-requirements**
You have to do the following set-up before playing with this demo.
- Install SQL Server 2016 or create a SQL Server 2016 Enterprise VM on Azure with Standalone R Server and R Services installed/configured.
- Install R IDE: R Tools for Visual Studio or R Studio.
- Install ReportBuilder for SQL Server 2016 Enterprise.
- Validate the successful installation.
----------
**Files**
This sample consists of the following directory structure.
- **Data** - This folder contains the raw call detail record data and the USA state longitute/latitute data.
- **R** - This folder contains the R code that you can run in any R IDE.
- **SQL Server** - This folder contains the sql files that you can run to create T-SQL stored procedures (with R code embeded) and try out this telco churn example.
- **ReportBuilder** - This folder contains a sample SQL report created by ReportBuilder.
To jumpstart, run the T-SQL files (telcoChurn-operationalize.sql and telcoChurn-main.sql)
@@ -1,12 +0,0 @@
**Instructions**
- Open the file telcoChurn-reportBuilder.rdl in SQL Report Builder
- Click 'run' botton to call the embeded T-SQL stored procedures
----------
**Description**
- **telcoChurn-reportBuilder.rdl** - SQL report created by reportBuilder in order to visualize the telco churn prediction results
----------
@@ -1,598 +0,0 @@
<?xml version="1.0" encoding="utf-8"?>
<Report MustUnderstand="df" xmlns="http://schemas.microsoft.com/sqlserver/reporting/2016/01/reportdefinition" xmlns:rd="http://schemas.microsoft.com/SQLServer/reporting/reportdesigner" xmlns:df="http://schemas.microsoft.com/sqlserver/reporting/2016/01/reportdefinition/defaultfontfamily">
<df:DefaultFontFamily>Segoe UI</df:DefaultFontFamily>
<AutoRefresh>0</AutoRefresh>
<DataSources>
<DataSource Name="telcoedw">
<ConnectionProperties>
<DataProvider>SQL</DataProvider>
<ConnectString>Data Source=datascidevzhouf;Initial Catalog=telcoedw</ConnectString>
<Prompt>Specify a user name and password for data source telcoedw:</Prompt>
</ConnectionProperties>
<rd:SecurityType>DataBase</rd:SecurityType>
<rd:DataSourceID>3a50cfa0-14f7-48a1-94bc-9c8c8126ca68</rd:DataSourceID>
</DataSource>
</DataSources>
<DataSets>
<DataSet Name="telco_pie">
<Query>
<DataSourceName>telcoedw</DataSourceName>
<CommandText>exec pie;</CommandText>
</Query>
<Fields>
<Field Name="plot">
<DataField>plot</DataField>
<rd:TypeName>System.Byte[]</rd:TypeName>
</Field>
</Fields>
</DataSet>
<DataSet Name="roccurve">
<Query>
<DataSourceName>telcoedw</DataSourceName>
<CommandText>exec model_roccurve;</CommandText>
</Query>
<Fields>
<Field Name="plot">
<DataField>plot</DataField>
<rd:TypeName>System.Byte[]</rd:TypeName>
</Field>
</Fields>
</DataSet>
<DataSet Name="telco_stackedbar">
<Query>
<DataSourceName>telcoedw</DataSourceName>
<CommandText>exec stackedbar;</CommandText>
</Query>
<Fields>
<Field Name="plot">
<DataField>plot</DataField>
<rd:TypeName>System.Byte[]</rd:TypeName>
</Field>
</Fields>
</DataSet>
<DataSet Name="telco_predictions">
<Query>
<DataSourceName>telcoedw</DataSourceName>
<CommandText>exec predict_cdr_churn_rx_forest 'rxDForest';</CommandText>
</Query>
<Fields>
<Field Name="customerid">
<DataField>customerid</DataField>
<rd:TypeName>System.Int32</rd:TypeName>
</Field>
<Field Name="churn">
<DataField>churn</DataField>
<rd:TypeName>System.String</rd:TypeName>
</Field>
<Field Name="prediction">
<DataField>prediction</DataField>
<rd:TypeName>System.Double</rd:TypeName>
</Field>
<Field Name="probability">
<DataField>probability</DataField>
<rd:TypeName>System.Double</rd:TypeName>
</Field>
</Fields>
</DataSet>
</DataSets>
<ReportSections>
<ReportSection>
<Body>
<ReportItems>
<Textbox Name="ReportTitle">
<CanGrow>true</CanGrow>
<KeepTogether>true</KeepTogether>
<Paragraphs>
<Paragraph>
<TextRuns>
<TextRun>
<Value>Telco Customer Churn Prediction</Value>
<Style>
<FontFamily>Segoe UI Light</FontFamily>
<FontSize>16pt</FontSize>
<FontWeight>Bold</FontWeight>
<Color>Blue</Color>
</Style>
</TextRun>
</TextRuns>
<Style>
<TextAlign>Center</TextAlign>
</Style>
</Paragraph>
</Paragraphs>
<rd:WatermarkTextbox>Title</rd:WatermarkTextbox>
<rd:DefaultName>ReportTitle</rd:DefaultName>
<Left>0.62917in</Left>
<Height>0.5in</Height>
<Width>5.96805in</Width>
<Style>
<Border>
<Style>None</Style>
</Border>
<PaddingLeft>2pt</PaddingLeft>
<PaddingRight>2pt</PaddingRight>
<PaddingTop>2pt</PaddingTop>
<PaddingBottom>2pt</PaddingBottom>
</Style>
</Textbox>
<Image Name="roccurve">
<Source>Database</Source>
<Value>=First(Fields!plot.Value, "roccurve")</Value>
<MIMEType>image/jpeg</MIMEType>
<Sizing>FitProportional</Sizing>
<Top>0.88194in</Top>
<Left>4.87722in</Left>
<Height>1.51388in</Height>
<Width>1.72in</Width>
<ZIndex>1</ZIndex>
<Style>
<Border>
<Style>None</Style>
</Border>
</Style>
</Image>
<Image Name="pie">
<Source>Database</Source>
<Value>=First(Fields!plot.Value, "telco_pie")</Value>
<MIMEType>image/jpeg</MIMEType>
<Sizing>FitProportional</Sizing>
<Top>0.905in</Top>
<Left>0.62917in</Left>
<Height>1.49082in</Height>
<Width>1.83805in</Width>
<ZIndex>2</ZIndex>
<Style>
<Border>
<Style>None</Style>
</Border>
</Style>
</Image>
<Image Name="stackedbar">
<Source>Database</Source>
<Value>=First(Fields!plot.Value, "telco_stackedbar")</Value>
<MIMEType>image/jpeg</MIMEType>
<Sizing>FitProportional</Sizing>
<Top>0.905in</Top>
<Left>2.84019in</Left>
<Height>1.49082in</Height>
<Width>1.69444in</Width>
<ZIndex>3</ZIndex>
<Style>
<Border>
<Style>None</Style>
</Border>
</Style>
</Image>
<Tablix Name="table">
<TablixBody>
<TablixColumns>
<TablixColumn>
<Width>4.44907in</Width>
</TablixColumn>
</TablixColumns>
<TablixRows>
<TablixRow>
<Height>0.61111in</Height>
<TablixCells>
<TablixCell>
<CellContents>
<Rectangle Name="Rectangle1">
<ReportItems>
<Tablix Name="Tablix2">
<TablixBody>
<TablixColumns>
<TablixColumn>
<Width>1.22454in</Width>
</TablixColumn>
<TablixColumn>
<Width>1.22454in</Width>
</TablixColumn>
<TablixColumn>
<Width>1in</Width>
</TablixColumn>
<TablixColumn>
<Width>1in</Width>
</TablixColumn>
</TablixColumns>
<TablixRows>
<TablixRow>
<Height>0.25in</Height>
<TablixCells>
<TablixCell>
<CellContents>
<Textbox Name="Textbox26">
<CanGrow>true</CanGrow>
<KeepTogether>true</KeepTogether>
<Paragraphs>
<Paragraph>
<TextRuns>
<TextRun>
<Value>CustomerID</Value>
<Style>
<FontWeight>Bold</FontWeight>
</Style>
</TextRun>
</TextRuns>
<Style />
</Paragraph>
</Paragraphs>
<rd:DefaultName>Textbox26</rd:DefaultName>
<Style>
<Border>
<Color>LightGrey</Color>
<Style>Solid</Style>
</Border>
<BackgroundColor>Orange</BackgroundColor>
<PaddingLeft>2pt</PaddingLeft>
<PaddingRight>2pt</PaddingRight>
<PaddingTop>2pt</PaddingTop>
<PaddingBottom>2pt</PaddingBottom>
</Style>
</Textbox>
</CellContents>
</TablixCell>
<TablixCell>
<CellContents>
<Textbox Name="Textbox27">
<CanGrow>true</CanGrow>
<KeepTogether>true</KeepTogether>
<Paragraphs>
<Paragraph>
<TextRuns>
<TextRun>
<Value>Churn</Value>
<Style>
<FontWeight>Bold</FontWeight>
</Style>
</TextRun>
</TextRuns>
<Style />
</Paragraph>
</Paragraphs>
<rd:DefaultName>Textbox27</rd:DefaultName>
<Style>
<Border>
<Color>LightGrey</Color>
<Style>Solid</Style>
</Border>
<BackgroundColor>Orange</BackgroundColor>
<PaddingLeft>2pt</PaddingLeft>
<PaddingRight>2pt</PaddingRight>
<PaddingTop>2pt</PaddingTop>
<PaddingBottom>2pt</PaddingBottom>
</Style>
</Textbox>
</CellContents>
</TablixCell>
<TablixCell>
<CellContents>
<Textbox Name="Textbox28">
<CanGrow>true</CanGrow>
<KeepTogether>true</KeepTogether>
<Paragraphs>
<Paragraph>
<TextRuns>
<TextRun>
<Value>Prediction</Value>
<Style>
<FontWeight>Bold</FontWeight>
</Style>
</TextRun>
</TextRuns>
<Style />
</Paragraph>
</Paragraphs>
<rd:DefaultName>Textbox28</rd:DefaultName>
<Style>
<Border>
<Color>LightGrey</Color>
<Style>Solid</Style>
</Border>
<BackgroundColor>Orange</BackgroundColor>
<PaddingLeft>2pt</PaddingLeft>
<PaddingRight>2pt</PaddingRight>
<PaddingTop>2pt</PaddingTop>
<PaddingBottom>2pt</PaddingBottom>
</Style>
</Textbox>
</CellContents>
</TablixCell>
<TablixCell>
<CellContents>
<Textbox Name="Textbox29">
<CanGrow>true</CanGrow>
<KeepTogether>true</KeepTogether>
<Paragraphs>
<Paragraph>
<TextRuns>
<TextRun>
<Value>Probability</Value>
<Style>
<FontWeight>Bold</FontWeight>
</Style>
</TextRun>
</TextRuns>
<Style />
</Paragraph>
</Paragraphs>
<rd:DefaultName>Textbox29</rd:DefaultName>
<Style>
<Border>
<Color>LightGrey</Color>
<Style>Solid</Style>
</Border>
<BackgroundColor>Orange</BackgroundColor>
<PaddingLeft>2pt</PaddingLeft>
<PaddingRight>2pt</PaddingRight>
<PaddingTop>2pt</PaddingTop>
<PaddingBottom>2pt</PaddingBottom>
</Style>
</Textbox>
</CellContents>
</TablixCell>
</TablixCells>
</TablixRow>
<TablixRow>
<Height>0.36111in</Height>
<TablixCells>
<TablixCell>
<CellContents>
<Textbox Name="customerid">
<CanGrow>true</CanGrow>
<KeepTogether>true</KeepTogether>
<Paragraphs>
<Paragraph>
<TextRuns>
<TextRun>
<Value>=Fields!customerid.Value</Value>
<Style />
</TextRun>
</TextRuns>
<Style />
</Paragraph>
</Paragraphs>
<Style>
<Border>
<Color>LightGrey</Color>
<Style>Solid</Style>
</Border>
<BackgroundColor>CornflowerBlue</BackgroundColor>
<PaddingLeft>2pt</PaddingLeft>
<PaddingRight>2pt</PaddingRight>
<PaddingTop>2pt</PaddingTop>
<PaddingBottom>2pt</PaddingBottom>
</Style>
</Textbox>
</CellContents>
</TablixCell>
<TablixCell>
<CellContents>
<Textbox Name="churn">
<CanGrow>true</CanGrow>
<KeepTogether>true</KeepTogether>
<Paragraphs>
<Paragraph>
<TextRuns>
<TextRun>
<Value>=Fields!churn.Value</Value>
<Style />
</TextRun>
</TextRuns>
<Style />
</Paragraph>
</Paragraphs>
<Style>
<Border>
<Color>LightGrey</Color>
<Style>Solid</Style>
</Border>
<BackgroundColor>CornflowerBlue</BackgroundColor>
<PaddingLeft>2pt</PaddingLeft>
<PaddingRight>2pt</PaddingRight>
<PaddingTop>2pt</PaddingTop>
<PaddingBottom>2pt</PaddingBottom>
</Style>
</Textbox>
</CellContents>
</TablixCell>
<TablixCell>
<CellContents>
<Textbox Name="prediction">
<CanGrow>true</CanGrow>
<KeepTogether>true</KeepTogether>
<Paragraphs>
<Paragraph>
<TextRuns>
<TextRun>
<Value>=Fields!prediction.Value</Value>
<Style />
</TextRun>
</TextRuns>
<Style />
</Paragraph>
</Paragraphs>
<Style>
<Border>
<Color>LightGrey</Color>
<Style>Solid</Style>
</Border>
<BackgroundColor>CornflowerBlue</BackgroundColor>
<PaddingLeft>2pt</PaddingLeft>
<PaddingRight>2pt</PaddingRight>
<PaddingTop>2pt</PaddingTop>
<PaddingBottom>2pt</PaddingBottom>
</Style>
</Textbox>
</CellContents>
</TablixCell>
<TablixCell>
<CellContents>
<Textbox Name="probability">
<CanGrow>true</CanGrow>
<KeepTogether>true</KeepTogether>
<Paragraphs>
<Paragraph>
<TextRuns>
<TextRun>
<Value>=Fields!probability.Value</Value>
<Style />
</TextRun>
</TextRuns>
<Style />
</Paragraph>
</Paragraphs>
<ZIndex>5</ZIndex>
<Style>
<Border>
<Color>LightGrey</Color>
<Style>Solid</Style>
</Border>
<BackgroundColor>CornflowerBlue</BackgroundColor>
<PaddingLeft>2pt</PaddingLeft>
<PaddingRight>2pt</PaddingRight>
<PaddingTop>2pt</PaddingTop>
<PaddingBottom>2pt</PaddingBottom>
</Style>
</Textbox>
</CellContents>
</TablixCell>
</TablixCells>
</TablixRow>
</TablixRows>
</TablixBody>
<TablixColumnHierarchy>
<TablixMembers>
<TablixMember />
<TablixMember />
<TablixMember />
<TablixMember />
</TablixMembers>
</TablixColumnHierarchy>
<TablixRowHierarchy>
<TablixMembers>
<TablixMember />
<TablixMember />
</TablixMembers>
</TablixRowHierarchy>
<Height>0.61111in</Height>
<Width>4.44908in</Width>
<Style>
<Border>
<Style>None</Style>
</Border>
</Style>
</Tablix>
</ReportItems>
<KeepTogether>true</KeepTogether>
<ZIndex>5</ZIndex>
<Style>
<Border>
<Style>None</Style>
</Border>
<BackgroundColor>Orange</BackgroundColor>
</Style>
</Rectangle>
</CellContents>
</TablixCell>
</TablixCells>
</TablixRow>
</TablixRows>
</TablixBody>
<TablixColumnHierarchy>
<TablixMembers>
<TablixMember />
</TablixMembers>
</TablixColumnHierarchy>
<TablixRowHierarchy>
<TablixMembers>
<TablixMember>
<Group Name="Details" />
</TablixMember>
</TablixMembers>
</TablixRowHierarchy>
<RepeatRowHeaders>true</RepeatRowHeaders>
<FixedRowHeaders>true</FixedRowHeaders>
<DataSetName>telco_predictions</DataSetName>
<Top>2.69667in</Top>
<Left>1.42815in</Left>
<Height>0.61111in</Height>
<Width>4.44907in</Width>
<ZIndex>4</ZIndex>
<Style>
<Border>
<Style>None</Style>
</Border>
<BackgroundColor>Blue</BackgroundColor>
</Style>
</Tablix>
</ReportItems>
<Height>4.95139in</Height>
<Style>
<Border>
<Style>None</Style>
</Border>
<BackgroundColor>White</BackgroundColor>
</Style>
</Body>
<Width>7.76111in</Width>
<Page>
<PageFooter>
<Height>2.83889in</Height>
<PrintOnFirstPage>true</PrintOnFirstPage>
<PrintOnLastPage>true</PrintOnLastPage>
<ReportItems>
<Textbox Name="ExecutionTime">
<CanGrow>true</CanGrow>
<KeepTogether>true</KeepTogether>
<Paragraphs>
<Paragraph>
<TextRuns>
<TextRun>
<Value>=Globals!ExecutionTime</Value>
<Style />
</TextRun>
</TextRuns>
<Style>
<TextAlign>Right</TextAlign>
</Style>
</Paragraph>
</Paragraphs>
<rd:DefaultName>ExecutionTime</rd:DefaultName>
<Top>2.29028in</Top>
<Left>5.76111in</Left>
<Height>0.25in</Height>
<Width>2in</Width>
<Style>
<Border>
<Style>None</Style>
</Border>
<PaddingLeft>2pt</PaddingLeft>
<PaddingRight>2pt</PaddingRight>
<PaddingTop>2pt</PaddingTop>
<PaddingBottom>2pt</PaddingBottom>
</Style>
</Textbox>
</ReportItems>
<Style>
<Border>
<Style>None</Style>
</Border>
</Style>
</PageFooter>
<LeftMargin>1in</LeftMargin>
<RightMargin>1in</RightMargin>
<TopMargin>1in</TopMargin>
<BottomMargin>1in</BottomMargin>
<Style />
</Page>
</ReportSection>
</ReportSections>
<ReportParametersLayout>
<GridLayoutDefinition>
<NumberOfColumns>4</NumberOfColumns>
<NumberOfRows>2</NumberOfRows>
</GridLayoutDefinition>
</ReportParametersLayout>
<rd:ReportUnitType>Inch</rd:ReportUnitType>
<rd:ReportID>32d75e2b-ed9b-4ad3-9482-99dca952a1ad</rd:ReportID>
</Report>
@@ -1,33 +0,0 @@
**Instructions**
- After executing those R scripts, an edw_cdr SQL table will be created.
- Run the code in telcoChurn-operationalize.sql
- Run the code in telcoChurn-main.sql
----------
**Description**
- telcoChurn-main.sql - Use this T-SQL script to try out the telco customer churn example.
- telcoChurn-operationalize.sql - T-SQL scripts to create the stored procedures used in this example.
The database consists of the following tables
- **cdr\_models** - Contains the serialized R models that are used for predicting customer churn
- **edw\_cdr**- Base Call Detail Records (CDR)
- **edw\_cdr\_train**- Training data
- **edw\_cdr\_test** - Testing data
- **edw\_cdr\_pred** - Predicted results
and the following stored procedures
- **generate_cdr_rx_forest** - Train decision forest model with the rxDForest algorithm in RevoScaleR library
- **predict_cdr_rx_forest** - Predict customer churn using the trained model
- **model_evaluate** - Generate model performance metrics: Accuracy, Precision, Recall, F-score
- **model_roccurve** - Generate ROC curve
- **pie** - Create a pie chart to visualize the proportion of predicted customer churn
- **stackedbar** - Create a stacked bar chart to visualize the model confusion matrix
----------
@@ -1,28 +0,0 @@
--Set DB
use telcoedw
go
-- Show the serialized model
select * from cdr_models
------------------------------------------------------------------------------------------
-- rxDForest
------------------------------------------------------------------------------------------
-- Step 1 - Train the customer churn model
-- After successful execution, this will create a binary representation of the model
exec generate_cdr_rx_forest;
-- Step 2 - Evaluate the model
-- This uses test data to evaluate the performance of the model.
exec model_evaluate
-- Step 3 - Score the model- In this step, you will invoke the stored procedure predict_cdr_churn_rx_forest
-- The stored procedure uses the rxPredict function to predict the customers that are likely to churn
-- Results are returned as an output dataset
-- Execute scoring procedure
exec predict_cdr_churn_rx_forest 'rxDForest';
go
@@ -1,303 +0,0 @@
------------------------------------------------------------------------------------------
--Choose database to use
------------------------------------------------------------------------------------------
use telcoedw
go
------------------------------------------------------------------------------------------
--View tables
------------------------------------------------------------------------------------------
select top 10 * from dbo.edw_cdr
go
select top 10 * from dbo.edw_cdr_train
go
select top 10 * from dbo.edw_cdr_test
go
--------------------------------------------------------------------------------------------
--Create stored procedures to train models
--------------------------------------------------------------------------------------------
--Create a table to store modeling results
drop table if exists cdr_models;
go
create table cdr_models(
model_name varchar(30) not null default('default model') primary key,
model varbinary(max) not null
);
go
--Create a stored procedure to train Decision Forest Model with RevoScaleR
drop procedure if exists generate_cdr_rx_forest;
go
create procedure generate_cdr_rx_forest
as
begin
execute sp_execute_external_script
@language = N'R'
, @script = N'
require("RevoScaleR");
labelVar = "churn"
trainVars <- rxGetVarNames(edw_cdr_train)
trainVars <- trainVars[!trainVars %in% c(labelVar)]
temp <- paste(c(labelVar, paste(trainVars, collapse = "+")), collapse = "~")
formula <- as.formula(temp)
rx_forest_model <- rxDForest(formula = formula,
data = edw_cdr_train,
nTree = 8,
maxDepth = 32,
mTry = 2,
minBucket=1,
replace = TRUE,
importance = TRUE,
seed=8,
parms=list(loss=c(0,4,1,0)))
rxDForest_model <- data.frame(payload = as.raw(serialize(rx_forest_model, connection=NULL)));
'
, @input_data_1 = N'select * from edw_cdr_train'
, @input_data_1_name = N'edw_cdr_train'
, @output_data_1_name = N'rxDForest_model'
with result sets ((model varbinary(max)));
end;
go
--Update rxDForest modeling results
insert into cdr_models (model)
exec generate_cdr_rx_forest;
update cdr_models set model_name = 'rxDForest' where model_name = 'default model';
select * from cdr_models;
go
--------------------------------------------------------------------------------------------
--Create stored procedures to score models
--------------------------------------------------------------------------------------------
--Create a stored procedure to score Decision Forest Model with RevoScaleR
drop procedure if exists predict_cdr_churn_rx_forest;
go
create procedure predict_cdr_churn_rx_forest (@model varchar(100))
as
begin
declare @rx_model varbinary(max) = (select model from cdr_models where model_name = @model);
-- Predict based on the specified model:
exec sp_execute_external_script
@language = N'R'
, @script = N'
require("RevoScaleR");
cdr_model<-unserialize(rx_model);
predictions <- rxPredict(modelObject = cdr_model,
data = edw_cdr_test,
type="prob",
overwrite = TRUE)
print(head(predictions))
threshold <- 0.5
predictions$X0_prob <- NULL
predictions$churn_Pred <- NULL
names(predictions) <- c("probability")
predictions$prediction <- ifelse(predictions$probability > threshold, 1, 0)
predictions$prediction<- factor(predictions$prediction, levels = c(1, 0))
edw_cdr_pred <- cbind(edw_cdr_test[,c("customerid","churn")],predictions)
print(head(edw_cdr_pred))
edw_cdr_pred<-as.data.frame(edw_cdr_pred);
'
, @input_data_1 = N'
select * from edw_cdr_test'
, @input_data_1_name = N'edw_cdr_test'
, @output_data_1_name=N'edw_cdr_pred'
, @params = N'@rx_model varbinary(max)'
, @rx_model = @rx_model
with result sets ( ("customerid" int, "churn" varchar(255), "probability" float, "prediction" float)
);
end;
go
--Execute scoring procedure
drop table if exists edw_cdr_pred;
go
create table edw_cdr_pred(
customerid int,
churn varchar(255),
probability float,
prediction float
)
insert into edw_cdr_pred
exec predict_cdr_churn_rx_forest 'rxDForest';
go
select * from edw_cdr_pred
--------------------------------------------------------------------------------------------
--Create stored procedures to evaluate models
--------------------------------------------------------------------------------------------
--Create a stored procedure to evaluate model performance
drop procedure if exists model_evaluate;
go
create procedure model_evaluate
as
begin
execute sp_execute_external_script
@language = N'R'
, @script = N'
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)
}
metrics <- evaluateModel(data = edw_cdr_pred,
observed = "churn",
predicted = "prediction")
print(metrics)
metrics<-matrix(metrics,ncol=4)
metrics<-as.data.frame(metrics);
'
, @input_data_1 = N'
select * from edw_cdr_pred'
, @input_data_1_name = N'edw_cdr_pred'
, @output_data_1_name = N'metrics'
with result sets ( ("Accuracy" float, "Precision" float, "Recall" float, "F-Score" float)
);
end;
go
--Execute evaluating procedure
exec model_evaluate
go
--Create a stored procedure to generate roc curve
drop procedure if exists model_roccurve;
go
create procedure model_roccurve
as
begin
execute sp_execute_external_script
@language = N'R'
, @script = N'
require("RevoScaleR");
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)
}
# Open a jpeg file and output plot in that file.
image_file = tempfile();
jpeg(filename=image_file, width=800, height = 550);
print(
rxrocCurve(data = edw_cdr_pred,
observed = "churn",
predicted = "probability")
);
dev.off();
OutputDataSet <- data.frame(data=readBin(file(image_file, "rb"), what=raw(), n=1e6));
'
, @input_data_1 = N'
select * from edw_cdr_pred'
, @input_data_1_name = N'edw_cdr_pred'
with result sets ((plot varbinary(max)));
end;
go
exec model_roccurve
go
--------------------------------------------------------------------------------------------
--Create stored procedures to generate plots for visualization
--------------------------------------------------------------------------------------------
--Create a stored procedure to plot pie chart for predicted churn
drop procedure if exists pie;
go
create procedure pie
as
begin
exec sp_execute_external_script
@language = N'R',
@script = N'
# Set output directory for files
# Prior to plotting ensure there are no files with same file names as the out files below in the above directory.
# Calculate counts of churned/non-churned customers with RevoScaleR
require("RevoScaleR");
tmp <- rxCube( ~ churn, edw_cdr_pred, means = FALSE)
resultsDF <- rxResultsDF(tmp)
library(dplyr)
library(ggplot2)
# Open a jpeg file and output plot in that file.
image_file = tempfile();
jpeg(filename=image_file, width=800, height = 550);
print(
resultsDF %>%
ggplot(aes(x = factor(1), y=Counts, fill=factor(churn))) +
geom_bar(stat = "identity") +
coord_polar(theta = "y") +
theme_minimal()
);
dev.off();
OutputDataSet <- data.frame(data=readBin(file(image_file, "rb"), what=raw(), n=1e6));
'
, @input_data_1 = N'select * from edw_cdr_pred'
, @input_data_1_name = N'edw_cdr_pred'
with result sets ((plot varbinary(max)));
end;
go
--Execute pie procedure
exec pie
go
--Create a stored procedure to plot stackedbar chart for visualizing churn vs predicted churn
drop procedure if exists stackedbar;
go
create procedure stackedbar
as
begin
exec sp_execute_external_script
@language = N'R',
@script = N'
# Set output directory for files
# Prior to plotting ensure there are no files with same file names as the out files below in the above directory.
# Calculate counts of customers by churn and predicted churn with RevoScaleR
require("RevoScaleR");
tmp <- rxCube( ~ churn:F(prediction), data = edw_cdr_pred, mean = FALSE)
resultsDF <- rxResultsDF(tmp)
print(resultsDF)
library(dplyr)
library(ggplot2)
# Open a jpeg file and output plot in that file.
image_file = tempfile();
jpeg(filename=image_file, width=800, height = 550);
print(
resultsDF %>%
ggplot(aes(x = churn, y = Counts,
group = prediction, fill = prediction)) +
geom_bar(stat = "identity") +
labs(x = "churn", y = "Counts of customer") +
theme_minimal()
);
dev.off();
OutputDataSet <- data.frame(data=readBin(file(image_file, "rb"), what=raw(), n=1e6));
'
, @input_data_1 = N'select * from edw_cdr_pred'
, @input_data_1_name = N'edw_cdr_pred'
with result sets ((plot varbinary(max)));
end;
go
--Execute stackedbar procedure
exec stackedbar
go