mirror of
https://github.com/Microsoft/sql-server-samples.git
synced 2025-12-08 14:58:54 +00:00
Revised version of telco customer churn
This commit is contained in:
Zhou Fang
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,56 @@
|
||||
"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
|
||||
|
@@ -0,0 +1,20 @@
|
||||
**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
|
||||
|
||||
----------
|
||||
@@ -0,0 +1,158 @@
|
||||
####################################################################################################
|
||||
## 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()
|
||||
})
|
||||
}
|
||||
|
||||
@@ -0,0 +1,69 @@
|
||||
####################################################################################################
|
||||
## 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)
|
||||
}
|
||||
@@ -0,0 +1,39 @@
|
||||
################################################################
|
||||
## 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)
|
||||
}
|
||||
|
||||
@@ -0,0 +1,195 @@
|
||||
####################################################################################################
|
||||
## 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")
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,220 @@
|
||||
####################################################################################################
|
||||
## 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")
|
||||
|
||||
@@ -0,0 +1,40 @@
|
||||
################################################################
|
||||
## 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")
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,35 @@
|
||||
####################################################################################################
|
||||
## 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)
|
||||
}
|
||||
@@ -0,0 +1,52 @@
|
||||
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, we’ll 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)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,12 @@
|
||||
**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
|
||||
|
||||
|
||||
----------
|
||||
+598
@@ -0,0 +1,598 @@
|
||||
<?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>
|
||||
@@ -0,0 +1,33 @@
|
||||
**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
|
||||
|
||||
----------
|
||||
@@ -0,0 +1,28 @@
|
||||
--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
|
||||
|
||||
|
||||
|
||||
|
||||
+303
@@ -0,0 +1,303 @@
|
||||
------------------------------------------------------------------------------------------
|
||||
--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
|
||||
|
||||
Reference in New Issue
Block a user