mirror of
https://github.com/Microsoft/sql-server-samples.git
synced 2025-12-08 14:58:54 +00:00
update retail precision marketing demo
This commit is contained in:
Zhou Fang
Binary file not shown.
|
Before Width: | Height: | Size: 97 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 678 KiB |
@@ -1,284 +0,0 @@
|
||||
#############################################################
|
||||
#CRM Demo on CDNOW
|
||||
#Microsoft
|
||||
#############################################################
|
||||
##check if necessary R packages are installed
|
||||
install.packages("RODBC")
|
||||
|
||||
library(RODBC)
|
||||
|
||||
##set directory
|
||||
setwd("C:/Users/zhouf/Documents/Revolution Analytics/Demo/RREDemo/CRM")
|
||||
data.path<-"C:/Users/zhouf/Documents/Revolution Analytics/Demo/RREDemo/CRM/Data/CDNOW_master"
|
||||
output.path<-"C:/Users/zhouf/Documents/Revolution Analytics/Demo/RREDemo/CRM/Output/Xdf"
|
||||
|
||||
##Set Compute Context
|
||||
#rxOptions(computeContext=RxLocalSeq())
|
||||
rxOptions(computeContext=RxLocalParallel())
|
||||
rxOptions(xdfCompressionLevel = -1)
|
||||
rxOptions(reportProgress=1)
|
||||
#-----------------------------------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
##Connect to SQL database via RxOdbcData
|
||||
CRMSQL = "SELECT * FROM dbo.CDNOW"
|
||||
CRMDS<- RxOdbcData(sqlQuery = CRMSQL,
|
||||
connectionString = "Driver={SQL Server Native Client 11.0};
|
||||
Server=tcp:sqlserver2012-81yms1ai.cloudapp.net,57500;
|
||||
Database=RREDemoSql;Uid=zhouf;Pwd=Microsoft1;")
|
||||
|
||||
CRMDS<- RxOdbcData(sqlQuery = CRMSQL,
|
||||
connectionString = "Driver=SQL Server;
|
||||
Server=tcp:192.168.220.128,1433;
|
||||
Database=sqlr;
|
||||
Uid=sa;
|
||||
Pwd=Microsoft1")
|
||||
|
||||
#CRMDS<- RxOdbcData(sqlQuery = CRMSQL,
|
||||
# connectionString = "Driver={SQL Server Native Client 11.0};Server=tcp:168.63.172.116,57500;Database=RREDemoSql;Uid=zhouf;Pwd=Microsoft1;")
|
||||
#CRMDS<- RxOdbcData(sqlQuery = CRMSQL,
|
||||
#connectionString = "DSN=MiningDatabaseSql;Uid=zhouf;Pwd=Microsoft1;")
|
||||
#CRMDataFile <- RxXdfData("CDNOW_master.xdf")
|
||||
CRMDataFile<-file.path(output.path,"CDNOW_master.xdf")
|
||||
##Read data with RRE
|
||||
dfcolInfo<-list(
|
||||
ID=list(type="factor"),
|
||||
Date=list(type="character"),
|
||||
Volume=list(type="numeric"),
|
||||
Amount=list(type="numeric")
|
||||
)
|
||||
rxImport(inData=CRMDS,outFile =CRMDataFile,colInfo=dfcolInfo,overwrite =TRUE,useFastRead=TRUE)
|
||||
#rxImport(inData=CRMDS,outFile =CRMDataFile,overwrite =TRUE,useFastRead=TRUE)
|
||||
rxGetInfo(CRMDataFile,getVarInfo=T,numRows=3)
|
||||
#------------------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
##Connect to SQL database via odbcConnect
|
||||
#channel<-odbcConnect("Driver={SQL Server Native Client 11.0};Server=tcp:sqlserver2012-81yms1ai.cloudapp.net,57500;Database=AIAPoVSql;Uid=zhouf;Pwd=Microsoft2;")
|
||||
channel<-odbcConnect(dsn="MiningDatabaseSql",uid="zhouf",pwd="Microsoft1")
|
||||
|
||||
channel<-odbcDriverConnect(connection="Driver=SQL Server;
|
||||
Server=tcp:192.168.176.132,1433;
|
||||
Database=sqlr;
|
||||
Uid=sa;
|
||||
Pwd=Microsoft1")
|
||||
##Read data from SQL via OSR
|
||||
aia<-sqlQuery(channel,paste(" select * from dbo.AIOE_MODAL_RAWDATAL_revised"))
|
||||
df<-sqlFetch(channel, 'CDNOW')
|
||||
df<- sqlQuery(channel,paste("select * from dbo.CDNOW"))
|
||||
#df.csv <- file.path(data.path,"CDNOW_master.csv")
|
||||
df.xdf<-file.path(output.path,"CDNOW_master.xdf")
|
||||
dfcolInfo<-list(
|
||||
ID=list(type="factor"),
|
||||
Date=list(type="Date"),
|
||||
Volume=list(type="numeric"),
|
||||
Amount=list(type="numeric")
|
||||
)
|
||||
rxImport(inData=df,outFile =df.xdf,colInfo=dfcolInfo,overwrite =TRUE,useFastRead=F)
|
||||
rxGetInfo(df.xdf,getVarInfo=T,numRows=3)
|
||||
#------------------------------------------------------------------------------------------------------
|
||||
|
||||
df.xdf<-file.path(output.path,"CDNOW_master.xdf")
|
||||
df1.xdf<-file.path(output.path,"CDNOW_master1.xdf")
|
||||
rxDataStep(inData=df.xdf,outFile=df1.xdf,
|
||||
transforms=list(
|
||||
Date=as.Date(Date,"%Y-%m-%d")
|
||||
),
|
||||
removeMissings=TRUE,
|
||||
overwrite=T)
|
||||
rxGetInfo(df1.xdf,getVarInfo=T,numRows=3)
|
||||
#rxSummary(~ID+Date+Volume+Amount,df.xdf)
|
||||
|
||||
##Step 1: RFM Model
|
||||
# set the startDate and endDate, we will only analysis the records in this date range
|
||||
RFMSQL="SELECT * FROM dbo.RFM_Result"
|
||||
RFMDS<- RxOdbcData(sqlQuery = RFMSQL,
|
||||
connectionString = "Driver=SQL Server;
|
||||
Server=tcp:192.168.176.130,1433;
|
||||
Database=sqlr;
|
||||
Uid=sa;
|
||||
Pwd=Microsoft1")
|
||||
RFMResult.xdf<-file.path(output.path,"RFM_Result.xdf")
|
||||
rxImport(inData=RFMDS,outFile =RFMResult.xdf,overwrite =TRUE,useFastRead=TRUE)
|
||||
rxGetInfo(RFMResult.xdf,getVarInfo=T,numRows=3)
|
||||
#visualize the RFM values
|
||||
rxHistogram(~R,data=RFMResult.xdf, xNumTicks=20)
|
||||
rxHistogram(~F,data=RFMResult.xdf,rowSelection=F<30,
|
||||
xNumTicks=20)
|
||||
rxHistogram(~M,data=RFMResult.xdf,rowSelection=M<200,
|
||||
xNumTicks=20)
|
||||
|
||||
#count frequency of each RFMscore Level
|
||||
tmp<-rxCube(~F(Total_Score),data=RFMResult.xdf)
|
||||
results <- rxResultsDF(tmp)
|
||||
results<-results[results$Counts!=0,]
|
||||
results[order(results$Counts,decreasing=TRUE),]
|
||||
|
||||
##Step 2: K-means Clustering
|
||||
|
||||
#K-means Clustering
|
||||
Kmeans.xdf<-file.path(output.path,"Kmeans.xdf")
|
||||
md.km <- rxKmeans(formula=~R+F+M+R_Score+F_Score+M_Score,
|
||||
data = RFMResult.xdf,
|
||||
outFile =Kmeans.xdf,
|
||||
numClusters=8,
|
||||
algorithm = "lloyd",
|
||||
writeModelVars=TRUE,
|
||||
overwrite=TRUE)
|
||||
rxGetInfo(Kmeans.xdf,getVarInfo=TRUE,numRows=10)
|
||||
|
||||
centers<-round(md.km$centers,digits=2)
|
||||
size<-md.km$size
|
||||
centers.txt<-file.path(output.path,"centers.txt")
|
||||
write.table(centers,file=centers.txt,sep=" ")
|
||||
size.txt<-file.path(output.path,"size.txt")
|
||||
write.table(size,file=size.txt,sep=" ")
|
||||
|
||||
mdDf <- rxXdfToDataFrame(file=Kmeans.xdf)
|
||||
head(mdDf)
|
||||
plot(mdDf[,2:7],col=mdDf$.rxCluster)
|
||||
title(main="RFM-based K-means on CDNOW Data",line=3)
|
||||
##Step 3: Prediction-logistic and decision tree
|
||||
|
||||
##1.Prediction on Personal Customer Data without considering age and sex
|
||||
#Create IsVIP variable
|
||||
RFMVIP.xdf<-file.path(output.path,"RFMVIP.xdf")
|
||||
rxDataStep(inData=RFMResult.xdf,outFile=RFMVIP.xdf,
|
||||
transforms=list(IsVIP=ifelse(Toltal_Score>=441,1,0)),
|
||||
overwrite=TRUE,reportProgress=1
|
||||
)
|
||||
RFMVIPInfo<-rxGetInfo(RFMVIP.xdf,getVarInfo=T,numRows=3)
|
||||
|
||||
#Write IsVIP and Cluster result to SQL database
|
||||
RFMVIP.df<-rxXdfToDataFrame(file=RFMVIP.xdf)
|
||||
Cluster<-factor(mdDf$.rxCluster)
|
||||
RFMVIPCluster<-cbind(RFMVIP.df,Cluster)
|
||||
sqlSave(channel,RFMVIPCluster,rownames=FALSE,append=FALSE,varTypes=list(numeric="float",integer="int",Date="date"))
|
||||
|
||||
|
||||
#Creat training/testing data set
|
||||
RD<-sample(1:10,RFMVIPInfo$numRows,replace=TRUE)
|
||||
str(RD)
|
||||
table(RD)
|
||||
RFMVIPCluster$RD<-RD;
|
||||
RFMVIPCluster.xdf<-file.path(output.path,"RFMVIPCluster.xdf")
|
||||
rxDataFrameToXdf(data=RFMVIPCluster,outFile=RFMVIPCluster.xdf,overwrite=TRUE)
|
||||
|
||||
TrainTest.xdf<-file.path(output.path,"TrainTest.xdf")
|
||||
rxDataStep(inData=RFMVIPCluster.xdf,outFile=TrainTest.xdf,
|
||||
transforms=list(
|
||||
urv=factor(ifelse(RD<=8,'TRAIN','TEST'))
|
||||
),
|
||||
overwrite=T)
|
||||
rxGetInfo(TrainTest.xdf,T,numRows=3)
|
||||
|
||||
##Split data into training/testing data set
|
||||
train.xdf <- file.path(output.path,'TrainTest.urv.TRAIN.xdf')
|
||||
test.xdf <- file.path(output.path,'TrainTest.urv.TEST.xdf')
|
||||
|
||||
rxSplit(TrainTest.xdf,outFilesBase=TrainTest.xdf,splitByFactor='urv',overwrite=T,reportProgress=1)
|
||||
|
||||
##Build our Logistic Regression Model with IsVIP as response
|
||||
r1<- rxLogit(IsVIP~R+F+M,
|
||||
data =train.xdf,
|
||||
variableSelection = rxStepControl(method="stepwise",
|
||||
scope = ~ R+F+M))
|
||||
summary(r1)
|
||||
|
||||
|
||||
##r1:stepwise selection shows that Monetary,Recency are significant.
|
||||
##Build our Logistic REgression MOdel
|
||||
r2<- rxLogit(IsVIP ~R+F,
|
||||
data =train.xdf,covCoef=TRUE)
|
||||
summary(r2)
|
||||
|
||||
##Predict our Logistic Model on our test Dataset
|
||||
LogisticPred.xdf<-file.path(output.path,"LogisticPred.xdf")
|
||||
rxPredict(r2,data=test.xdf,outData=LogisticPred.xdf,writeModelVars = TRUE,extraVarsToWrite="ID",computeResiduals=TRUE,computeStdErr = TRUE,
|
||||
interval = "confidence",predVarNames='LogitPredict',overwrite=TRUE)
|
||||
rxGetInfo(LogisticPred.xdf,getVarInfo=T,numRows=10)
|
||||
LogisticPredInfoTop10<-rxGetInfo(LogisticPred.xdf,getVarInfo=T,numRows=10)
|
||||
LogisticPredInfoTop10.txt<-file.path(output.path,"LogisticPredInfoTop10.txt")
|
||||
write.table(LogisticPredInfoTop10$data,file=LogisticPredInfoTop10.txt,sep=" ")
|
||||
|
||||
LogisticPred<-rxXdfToDataFrame(file=LogisticPred.xdf)
|
||||
sqlSave(channel,LogisticPred,rownames=FALSE,append=FALSE,varTypes=list(numeric="float",integer="int",Date="date"))
|
||||
|
||||
|
||||
##Draw a ROC curve
|
||||
rxRocCurve(actualVarName='IsVIP',predVarNames='LogitPredict',data=LogisticPred.xdf)
|
||||
|
||||
##Build a Decision Tree with Cluster as response
|
||||
d1 <- rxDTree(Cluster~R+F+M,data=train.xdf,blocksPerRead=5)
|
||||
d1 <- rxDTree(Cluster~R_Score+F_Score+M_Score,data=train.xdf,blocksPerRead=5)
|
||||
d1Cp<- rxDTreeBestCp(d1)
|
||||
d1 <- prune.rxDTree(d1, cp=d1Cp)
|
||||
d1
|
||||
d2 <- rxDTree(Cluster~R+F+M,data=train.xdf, pruneCp="auto")
|
||||
d2 <- rxDTree(Cluster~R_Score+F_Score+M_Score,data=train.xdf, pruneCp="auto")
|
||||
d2
|
||||
|
||||
#View Decision Tree
|
||||
#View 1
|
||||
library(RevoTreeView)
|
||||
plot(createTreeView(d1))
|
||||
plot(createTreeView(d2))
|
||||
|
||||
#View 2
|
||||
library(rpart)
|
||||
plot(rxAddInheritance(d1))
|
||||
text(rxAddInheritance(d1))
|
||||
title(main="RFM-based Decision Tree on CDNOW Data",line=3)
|
||||
plot(rxAddInheritance(d2))
|
||||
text(rxAddInheritance(d2))
|
||||
title(main="RFM-based Decision Tree on CDNOW Data",line=3)
|
||||
|
||||
#Prediction
|
||||
DTreePred.xdf<-file.path(output.path,"DTreePred.xdf")
|
||||
rxPredict(d2, data=test.xdf,outData=DTreePred.xdf,predVarNames=c('prob1','prob2','prob3','prob4','prob5','prob6','prob7','prob8'),writeModelVars = TRUE,extraVarsToWrite="ID",computeResiduals=T,overwrite=TRUE)
|
||||
rxGetInfo(DTreePred.xdf,getVarInfo=T,numRows=3)
|
||||
DTreePredInfoTop10<-rxGetInfo(DTreePred.xdf,getVarInfo=T,numRows=10)
|
||||
DTreePredInfoTop10.txt<-file.path(output.path,"DTreePredInfoTop10.txt")
|
||||
write.table(DTreePredInfoTop10$data,file=DTreePredInfoTop10.txt,sep=" ")
|
||||
|
||||
DTreePred<-rxXdfToDataFrame(file=DTreePred.xdf)
|
||||
sqlSave(channel,DTreePred,rownames=FALSE,append=FALSE,varTypes=list(numeric="float",integer="int",Date="date"))
|
||||
odbcClose(channel)
|
||||
|
||||
#-------------------------------------------------------------------------------------
|
||||
##Build a Decision Tree with IsVIP as response
|
||||
d<-rxDTree(IsVIP~R+F+M,data=train.xdf,maxDepth=5,blocksPerRead=5)
|
||||
d1 <- rxDTree(IsVIP~R+F+M,data=train.xdf,blocksPerRead=5)
|
||||
d1
|
||||
d1Cp<- rxDTreeBestCp(d1)
|
||||
d1 <- prune.rxDTree(d1, cp=d1Cp)
|
||||
d2 <- rxDTree(IsVIP~R+F+M,data=train.xdf, pruneCp="auto")
|
||||
d2
|
||||
|
||||
#View Decision Tree
|
||||
#View 1
|
||||
library(RevoTreeView)
|
||||
plot(createTreeView(d))
|
||||
plot(createTreeView(d1))
|
||||
plot(createTreeView(d2))
|
||||
|
||||
#View 2
|
||||
library(rpart)
|
||||
plot(rxAddInheritance(d))
|
||||
text(rxAddInheritance(d))
|
||||
title(main="RFM-based Decision Tree on CDNOW Data",line=3)
|
||||
plot(rxAddInheritance(d1))
|
||||
text(rxAddInheritance(d1))
|
||||
title(main="RFM-based Decision Tree on CDNOW Data",line=3)
|
||||
plot(rxAddInheritance(d2))
|
||||
text(rxAddInheritance(d2))
|
||||
title(main="RFM-based Decision Tree on CDNOW Data",line=3)
|
||||
|
||||
#Prediction
|
||||
DTreePred.xdf<-file.path(output.path,"DTreePred.xdf")
|
||||
rxPredict(d, data=test.xdf,outData=DTreePred.xdf,writeModelVars = TRUE,extraVarsToWrite="ID",computeResiduals=T,overwrite=TRUE)
|
||||
rxGetInfo(DTreePred.xdf,getVarInfo=T,numRows=3)
|
||||
DTreePredInfoTop10<-rxGetInfo(DTreePred.xdf,getVarInfo=T,numRows=10)
|
||||
DTreePredInfoTop10.txt<-file.path(output.path,"DTreePredInfoTop10.txt")
|
||||
write.table(DTreePredInfoTop10$data,file=DTreePredInfoTop10.txt,sep=" ")
|
||||
|
||||
#Draw ROC
|
||||
rxRocCurve(actualVarName='IsVIP',predVarNames='IsVIP_Pred',data=DTreePred.xdf)
|
||||
@@ -1,173 +1,237 @@
|
||||
#############################################################
|
||||
#CRM Demo on CDNOW
|
||||
#Microsoft
|
||||
# Title : CRM Demo in-memory
|
||||
# Author: Microsoft
|
||||
# Date: Dec, 2015
|
||||
#############################################################
|
||||
|
||||
#install package
|
||||
# Install package
|
||||
|
||||
install.packages("rmarkdown")
|
||||
install.packages("fpc")
|
||||
|
||||
#set directory
|
||||
setwd("C:/Users/zhouf/Documents/Revolution Analytics/Demo/RREDemo/CRM")
|
||||
data.path<-"C:/Users/zhouf/Documents/Revolution Analytics/Demo/RREDemo/CRM/Data/CDNOW_master"
|
||||
# Set directory
|
||||
|
||||
wd <- getwd()
|
||||
data.path <- file.path(wd, "Data", "CDNOW_master.csv")
|
||||
|
||||
# Connect to SQL database using ODBC and read data from SQL via Open Source R
|
||||
|
||||
##connect to SQL database using ODBC and read data from SQL via Open Source R
|
||||
library(RODBC)
|
||||
getSqlTypeInfo()
|
||||
#connect from local PC
|
||||
channel<-odbcDriverConnect("driver={SQL Server Native Client 11.0};server=tcp:sqlserver2012-81yms1ai.cloudapp.net,57500;database=RREDemoSql;uid=zhouf;pwd=Microsoft2;")
|
||||
#connect from Windows201201
|
||||
channel<-odbcConnect(dsn="MiningDatabaseSql",uid="zhouf",pwd="Microsoft1")
|
||||
#connect with error
|
||||
channel<-odbcDriverConnect('driver={SQL Server};server=tcp:192.168.220.128,1433;database=sqlr;uid=sa;pwd=Microsoft1')
|
||||
|
||||
|
||||
df<-sqlFetch(channel, 'CDNOW')
|
||||
df<- sqlQuery(channel,paste("select * from dbo.CDNOW"))
|
||||
# Connect from local PC
|
||||
|
||||
channel <- odbcDriverConnect("driver={SQL Server Native Client 11.0};
|
||||
server=tcp:sqlserver2012-81yms1ai.cloudapp.net,57500;
|
||||
database=RREDemoSql;
|
||||
uid=******;
|
||||
pwd=******;")
|
||||
|
||||
df <- sqlFetch(channel, 'CDNOW')
|
||||
df <- sqlQuery(channel, paste("select * from dbo.CDNOW"))
|
||||
|
||||
df$Date<-as.Date(df$Date)
|
||||
|
||||
str(df)
|
||||
head(df)
|
||||
|
||||
#remove the rows with the duplicated IDs to see how many customers in total
|
||||
uid <- df[!duplicated(df[,"ID"]),]
|
||||
# Remove the rows with the duplicated IDs to see how many customers in total
|
||||
|
||||
uid <- df[!duplicated(df[,"ID"]), ]
|
||||
|
||||
dim(uid)
|
||||
|
||||
#call RFM source code
|
||||
source("RFM_Analysis_R_Source_Codes_V1.3.R")
|
||||
# Step 1: RFM analysis
|
||||
|
||||
# Call RFM source code
|
||||
|
||||
source(wd, "R", "RFM_Analysis_R_Source_Codes_V1.3.R")
|
||||
|
||||
# Set the startDate and endDate, we will only analysis the records in this date range
|
||||
|
||||
#set the startDate and endDate, we will only analysis the records in this date range
|
||||
startDate <- as.Date("19970101","%Y%m%d")
|
||||
endDate <- as.Date("19980701","%Y%m%d")
|
||||
|
||||
#calculate RFM value
|
||||
df <- getDataFrame(df,startDate,endDate,tIDColName="ID",tDateColName="Date",tAmountColName="Amount")
|
||||
# Calculate RFM value
|
||||
|
||||
df <- getDataFrame(df, startDate, endDate, tIDColName="ID", tDateColName="Date", tAmountColName="Amount")
|
||||
|
||||
head(df)
|
||||
|
||||
#obtain Independent RFM score
|
||||
# Obtain independent RFM score
|
||||
|
||||
df1 <-getIndependentScore(df)
|
||||
|
||||
head(df1)
|
||||
|
||||
#draw the histograms in the R, F, and M dimensions
|
||||
# Draw the histograms in the R, F, and M dimensions
|
||||
|
||||
drawHistograms(df1)
|
||||
|
||||
S500<-df1[df1$Total_Score>500,]
|
||||
S500 <- df1[df1$Total_Score > 500, ]
|
||||
dim(S500)
|
||||
|
||||
S400<-df1[df1$Total_Score>400,]
|
||||
S400 <- df1[df1$Total_Score > 400, ]
|
||||
dim(S400)
|
||||
|
||||
# Obtain RFM score with breaks
|
||||
# Take a look at the distribution of R, F, M
|
||||
|
||||
#obtain RFM score with breaks
|
||||
#take a look at the distribution of R, F, M
|
||||
par(mfrow = c(1,3))
|
||||
hist(df$Recency)
|
||||
hist(df$Frequency)
|
||||
hist(df$Monetary)
|
||||
|
||||
#set the Recency ranges as 0-120 days, 120-240 days, 240-450 days, 450-500days, and more than 500days.
|
||||
r <-c(120,240,450,500)
|
||||
#set the Frequency ranges as 0 ? 2times, 2-5 times,5-8 times, 8-10 times, and more than 10 times.
|
||||
f <-c(2,5,8,10)
|
||||
#set the Monetary ranges as 0-10 dollars, 10-20 dollars, and so on.
|
||||
# Set the Recency ranges as 0-120 days, 120-240 days, 240-450 days, 450-500 days, and more than 500 days.
|
||||
|
||||
r <- c(120, 240, 450, 500)
|
||||
|
||||
# Set the Frequency ranges as 0-2 times, 2-5 times, 5-8 times, 8-10 times, and more than 10 times.
|
||||
|
||||
f <- c(2, 5, 8, 10)
|
||||
|
||||
# Set the Monetary ranges as 0-10 dollars, 10-20 dollars, and so on.
|
||||
|
||||
m <-c(10,20,30,100)
|
||||
|
||||
#calculate RFM score with breaks
|
||||
df2<-getScoreWithBreaks(df,r,f,m)
|
||||
# Calculate RFM score with breaks
|
||||
|
||||
df2 <- getScoreWithBreaks(df, r, f, m)
|
||||
drawHistograms(df2)
|
||||
|
||||
S500<-df2[df2$Total_Score>500,]
|
||||
S500 <- df2[df2$Total_Score > 500, ]
|
||||
dim(S500)
|
||||
|
||||
S400<-df2[df2$Total_Score>400,]
|
||||
S400 <- df2[df2$Total_Score > 400, ]
|
||||
dim(S400)
|
||||
|
||||
target <- df2[df2$Total_Score>=441,]
|
||||
target <- df2[df2$Total_Score >= 441,]
|
||||
dim(target)
|
||||
|
||||
#obtain RFM scores with quantiles as breaks
|
||||
# Obtain RFM scores with quantiles as breaks
|
||||
|
||||
r <-c(cutpoint(df$Recency))
|
||||
f <-c(cutpoint(df$Frequency))
|
||||
m <-c(cutpoint(df$Monetary))
|
||||
|
||||
df3<-getScoreWithBreaks(df,r,f,m)
|
||||
df3 <- getScoreWithBreaks(df, r, f, m)
|
||||
|
||||
str(df3)
|
||||
head(df3)
|
||||
tail(df3)
|
||||
|
||||
RFM_Result_osr<-subset(df3,select=c("ID","Recency","Frequency","Monetary","R_Score","F_Score","M_Score","Total_Score"))
|
||||
colnames(RFM_Result_osr)<-c("ID","R","F","M","R_Score","F_Score","M_Score","Total_Score")
|
||||
head(RFM_Result_osr)
|
||||
RFM_Result <- subset(df3,
|
||||
select=c("ID", "Recency", "Frequency", "Monetary",
|
||||
"R_Score", "F_Score", "M_Score", "Total_Score"))
|
||||
|
||||
system.time(
|
||||
sqlSave(channel,RFM_Result_osr,rownames=FALSE,append=FALSE,varTypes=list(numeric="float",integer="int"))
|
||||
)
|
||||
colnames(RFM_Result) <- c("ID", "R", "F", "M", "R_Score", "F_Score", "M_Score", "Total_Score")
|
||||
|
||||
sqlUpdate(channel,df)
|
||||
head(RFM_Result)
|
||||
|
||||
time <- system.time({
|
||||
|
||||
sqlSave(channel,
|
||||
RFM_Result,
|
||||
rownames=FALSE,
|
||||
append=FALSE,
|
||||
varTypes=list(numeric="float",
|
||||
integer="int"))
|
||||
})
|
||||
|
||||
sqlUpdate(channel, df)
|
||||
odbcClose(channel)
|
||||
|
||||
#Clustering using RFM
|
||||
# Clustering using RFM
|
||||
|
||||
library(fpc)
|
||||
library(cluster)
|
||||
#kmeans clustering with cluster =8
|
||||
cl.fit1<-kmeans(RFM_Result_osr[,2:8],centers=8,iter.max=10,nstart=1)
|
||||
cl.fit2<-kmeans(RFM_Result_osr[,2:8],centers=8,iter.max=20,nstart=200)
|
||||
|
||||
# Kmeans clustering with number of cluster equal to 8
|
||||
|
||||
cl.fit1 <- kmeans(RFM_Result[, 2:8],
|
||||
centers=8,
|
||||
iter.max=10,
|
||||
nstart=1)
|
||||
|
||||
cl.fit2 <- kmeans(RFM_Result[, 2:8],
|
||||
centers=8,
|
||||
iter.max=20,
|
||||
nstart=200)
|
||||
|
||||
summary(cl.fit1)
|
||||
|
||||
cluster<-cl.fit1$cluster
|
||||
centers<-cl.fit1$centers
|
||||
size<-cl.fit1$size
|
||||
plot(RFM_Result_osr[,2:4],col=cl.fit1$cluster)
|
||||
|
||||
plot(RFM_Result[, 2:4], col=cl.fit1$cluster)
|
||||
title(main="K-means",line=3)
|
||||
|
||||
##Classification using RFM
|
||||
#Create IsVIP variable
|
||||
IsVIP<-ifelse(RFM_Result_osr[,'Total_Score']>=441,1,0);
|
||||
Cluster<-cl.fit1$cluster
|
||||
RFMVIPCluster<-cbind(RFM_Result_osr,IsVIP,Cluster)
|
||||
# Classification using RFM
|
||||
|
||||
# Create IsVIP variable
|
||||
|
||||
IsVIP <- ifelse(RFM_Result[,'Total_Score'] >= 441, 1, 0)
|
||||
Cluster <- cl.fit1$cluster
|
||||
RFMVIPCluster <- cbind(RFM_Result, IsVIP, Cluster)
|
||||
|
||||
# Create training/testing data set
|
||||
|
||||
RD <- sample(1:10, dim(RFMVIPCluster)[1], replace=TRUE)
|
||||
|
||||
#Create training/testing data set
|
||||
RD<-sample(1:10,dim(RFMVIPCluster)[1],replace=TRUE)
|
||||
str(RD)
|
||||
table(RD)
|
||||
RFMVIPCluster$RD<-RD;
|
||||
urv=factor(ifelse(RD<=8,'TRAIN','TEST'))
|
||||
TrainTest<-cbind(RFMVIPCluster,urv)
|
||||
Train<-TrainTest[which(TrainTest$urv=="TRAIN"),]
|
||||
Test<-TrainTest[which(TrainTest$urv=="TEST"),]
|
||||
|
||||
#logistic model
|
||||
##Build our Logistic Regression Model with IsVIP as response
|
||||
r1<-glm(IsVIP~R+F+M, data=Train, family = binomial)
|
||||
RFMVIPCluster$RD <- RD;
|
||||
|
||||
urv <- factor(ifelse(RD <= 8,'TRAIN','TEST'))
|
||||
TrainTest <- cbind(RFMVIPCluster, urv)
|
||||
Train <- TrainTest[which(TrainTest$urv == "TRAIN"), ]
|
||||
Test <- TrainTest[which(TrainTest$urv == "TEST"), ]
|
||||
|
||||
# Logistic model
|
||||
# Build our Logistic Regression Model with IsVIP as response
|
||||
|
||||
r1 <- glm(IsVIP~R+F+M, data=Train, family = binomial)
|
||||
summary(r1)
|
||||
|
||||
p1<-predict.glm(r1,data=Test,type="response")
|
||||
p1 <- predict.glm(r1, data=Test, type="response")
|
||||
head(p1)
|
||||
tail(p1)
|
||||
|
||||
#decision tree
|
||||
#grow tree
|
||||
# Decision tree
|
||||
# Grow tree
|
||||
|
||||
fit <- rpart(Cluster~R+F+M,
|
||||
method="class", data=Train)
|
||||
method="class",
|
||||
data=Train)
|
||||
|
||||
# Display the results
|
||||
|
||||
printcp(fit)
|
||||
|
||||
# Visualize cross-validation results
|
||||
|
||||
#display the results
|
||||
printcp(fit)
|
||||
#visualize cross-validation results
|
||||
plotcp(fit)
|
||||
#detailed summary of splits
|
||||
|
||||
# Detailed summary of splits
|
||||
|
||||
summary(fit)
|
||||
|
||||
# plot tree
|
||||
# Plot tree
|
||||
|
||||
library(rpart)
|
||||
plot(fit, uniform=TRUE,
|
||||
main="Classification Tree for CDNOW")
|
||||
|
||||
plot(fit, uniform=TRUE, main="Classification Tree for CDNOW")
|
||||
text(fit, use.n=TRUE, all=TRUE, cex=.8)
|
||||
|
||||
# prune the tree
|
||||
pfit<- prune(fit, cp= fit$cptable[which.min(fit$cptable[,"xerror"]),"CP"])
|
||||
# Prune the tree
|
||||
|
||||
pfit <- prune(fit, cp=fit$cptable[which.min(fit$cptable[,"xerror"]), "CP"])
|
||||
|
||||
# Plot the pruned tree
|
||||
|
||||
# plot the pruned tree
|
||||
plot(pfit, uniform=TRUE,
|
||||
main="Pruned Classification Tree for CDNOW")
|
||||
main="Pruned Classification Tree for CDNOW")
|
||||
text(pfit, use.n=TRUE, all=TRUE, cex=.8)
|
||||
|
||||
|
||||
@@ -1,157 +1,203 @@
|
||||
################################################################
|
||||
##CRM Demo in-SQL compute context
|
||||
##Microsoft
|
||||
# Title: CRM Demo in-SQL
|
||||
# Author: Microsoft
|
||||
# Date: Dec, 2015
|
||||
#################################################################
|
||||
|
||||
connectionString <- "Driver=SQL Server;Server=tcp:192.168.176.130,1433;Database=sqlr;Uid=sa;Pwd=Microsoft1"
|
||||
# Specify connection string and compute context
|
||||
|
||||
RFMData <- RxSqlServerData(
|
||||
connectionString = connectionString,
|
||||
table = "RFM_Result")
|
||||
connectionString <- "Driver=SQL Server;
|
||||
Server=tcp:192.168.176.130,1433;
|
||||
Database=sqlr;
|
||||
Uid=******;
|
||||
Pwd=******"
|
||||
|
||||
RFMData <- RxSqlServerData(connectionString=connectionString,
|
||||
table="RFM_Result")
|
||||
|
||||
cc <- RxInSqlServer(connectionString = connectionString, autoCleanup = FALSE, consoleOutput = TRUE)
|
||||
cc <- RxInSqlServer(connectionString=connectionString,
|
||||
autoCleanup=FALSE,
|
||||
consoleOutput=TRUE)
|
||||
|
||||
rxSetComputeContext(cc)
|
||||
|
||||
rxGetInfo(RFMData,getVarInfo=T,numRows=3)
|
||||
rxGetInfo(RFMData, getVarInfo=T, numRows=3)
|
||||
|
||||
#Step 1: RFM analysis
|
||||
#visualize the RFM values
|
||||
rxHistogram(~R,data=RFMData, xNumTicks=20)
|
||||
rxHistogram(~F,data=RFMData,rowSelection=F<30,
|
||||
xNumTicks=20)
|
||||
rxHistogram(~M,data=RFMData,rowSelection=M<200,
|
||||
xNumTicks=20)
|
||||
# Step 1: RFM analysis
|
||||
|
||||
#count frequency of each RFMscore Level
|
||||
tmp<-rxCube(~F(Toltal_Score),data=RFMData)
|
||||
# Visualize the RFM values
|
||||
|
||||
rxHistogram(~R, data=RFMData, xNumTicks=20)
|
||||
rxHistogram(~F, data=RFMData, rowSelection=F < 30, xNumTicks=20)
|
||||
rxHistogram(~M, data=RFMData, rowSelection=M < 200, xNumTicks=20)
|
||||
|
||||
# Count frequency of each RFMscore Level
|
||||
|
||||
tmp <- rxCube(~F(Toltal_Score), data=RFMData)
|
||||
results <- rxResultsDF(tmp)
|
||||
results<-results[results$Counts!=0,]
|
||||
results[order(results$Counts,decreasing=TRUE),]
|
||||
results <- results[results$Counts != 0, ]
|
||||
results[order(results$Counts, decreasing=TRUE), ]
|
||||
|
||||
# Step 2: K-means Clustering
|
||||
|
||||
KmeansData <- RxSqlServerData(connectionString=connectionString,
|
||||
table = "Kmeans_Result")
|
||||
|
||||
#Step 2: K-means Clustering
|
||||
KmeansData <- RxSqlServerData(
|
||||
connectionString = connectionString,
|
||||
table = "Kmeans_Result")
|
||||
md.km <- rxKmeans(formula=~R+F+M+R_Score+F_Score+M_Score,
|
||||
data = RFMData,
|
||||
outFile =KmeansData,
|
||||
numClusters=8,
|
||||
algorithm = "lloyd",
|
||||
writeModelVars=TRUE,
|
||||
overwrite=TRUE)
|
||||
rxGetInfo(KmeansData,getVarInfo=TRUE,numRows=10)
|
||||
data=RFMData,
|
||||
outFile=KmeansData,
|
||||
numClusters=8,
|
||||
algorithm="lloyd",
|
||||
writeModelVars=TRUE,
|
||||
overwrite=TRUE)
|
||||
|
||||
centers<-round(md.km$centers,digits=2)
|
||||
size<-md.km$size
|
||||
centers.txt<-file.path(output.path,"centers.txt")
|
||||
write.table(centers,file=centers.txt,sep=" ")
|
||||
size.txt<-file.path(output.path,"size.txt")
|
||||
write.table(size,file=size.txt,sep=" ")
|
||||
rxGetInfo(KmeansData, getVarInfo=TRUE, numRows=10)
|
||||
|
||||
centers <- round(md.km$centers, digits=2)
|
||||
size <- md.km$size
|
||||
centers.txt <- file.path(output.path, "centers.txt")
|
||||
write.table(centers, file=centers.txt, sep=" ")
|
||||
size.txt <- file.path(output.path, "size.txt")
|
||||
write.table(size, file=size.txt, sep=" ")
|
||||
|
||||
# Connect to SQL database via odbcConnect
|
||||
|
||||
##Connect to SQL database via odbcConnect
|
||||
install.packages("RODBC")
|
||||
library(RODBC)
|
||||
|
||||
channel<-odbcDriverConnect(connection=connectionString)
|
||||
##Read Kmeans_Result from SQL via OSR
|
||||
Kmeans.df<- sqlQuery(channel,paste("select * from dbo.Kmeans_Result"))
|
||||
|
||||
# Read Kmeans_Result from SQL via OSR
|
||||
|
||||
Kmeans.df <- sqlQuery(channel, paste("select * from dbo.Kmeans_Result"))
|
||||
|
||||
head(Kmeans.df)
|
||||
plot(Kmeans.df[,2:4],col=Kmeans.df$X_rxCluster)
|
||||
title(main="RFM-based K-means on CDNOW Data",line=3)
|
||||
plot(Kmeans.df[, 2:4], col=Kmeans.df$X_rxCluster)
|
||||
title(main="RFM-based K-means on CDNOW Data", line=3)
|
||||
|
||||
##Step 3: Prediction-logistic and decision tree
|
||||
#Create IsVIP variable
|
||||
RFMVIPData <- RxSqlServerData(
|
||||
connectionString = connectionString,
|
||||
table = "RFMVIP")
|
||||
rxDataStep(inData=RFMData,outFile=RFMVIPData,
|
||||
transforms=list(IsVIP=ifelse(Toltal_Score>=441,1,0)
|
||||
),
|
||||
overwrite=TRUE,reportProgress=1
|
||||
)
|
||||
rxGetInfo(RFMVIPData,getVarInfo=T,numRows=3)
|
||||
rxGetInfo(RFMVIPRDData,getVarInfo=T,numRows=3)
|
||||
RFMVIPRDData <- RxSqlServerData(
|
||||
connectionString = connectionString,
|
||||
table = "RFMVIPRD")
|
||||
RFMVIPTrainTestData <- RxSqlServerData(
|
||||
connectionString = connectionString,
|
||||
table = "RFMVIPTrainTest")
|
||||
rxDataStep(inData=RFMVIPRDData,outFile=RFMVIPTrainTestData,
|
||||
transforms=list(
|
||||
urv=factor(ifelse(RD<=8,'TRAIN','TEST'))
|
||||
),
|
||||
# Step 3: Prediction-logistic and decision tree
|
||||
|
||||
# Create IsVIP variable
|
||||
|
||||
RFMVIPData <- RxSqlServerData(connectionString=connectionString,
|
||||
table="RFMVIP")
|
||||
|
||||
rxDataStep(inData=RFMData,
|
||||
outFile=RFMVIPData,
|
||||
transforms=list(IsVIP=ifelse(Toltal_Score >= 441, 1, 0)),
|
||||
overwrite=TRUE,
|
||||
reportProgress=1)
|
||||
|
||||
rxGetInfo(RFMVIPData, getVarInfo=T, numRows=3)
|
||||
rxGetInfo(RFMVIPRDData, getVarInfo=T, numRows=3)
|
||||
|
||||
RFMVIPRDData <- RxSqlServerData(connectionString=connectionString,
|
||||
table="RFMVIPRD")
|
||||
|
||||
RFMVIPTrainTestData <- RxSqlServerData(connectionString = connectionString,
|
||||
table="RFMVIPTrainTest")
|
||||
|
||||
rxDataStep(inData=RFMVIPRDData,
|
||||
outFile=RFMVIPTrainTestData,
|
||||
transforms=list(urv=factor(ifelse(RD <= 8,'TRAIN','TEST'))),
|
||||
overwrite=T)
|
||||
rxGetInfo(RFMVIPTrainTestData,T,numRows=3)
|
||||
|
||||
##Split data into training/testing data set
|
||||
TrainData <- RxSqlServerData(
|
||||
connectionString = connectionString,
|
||||
table = "RFMVIPTrainTest.urv.TRAIN")
|
||||
TestData <- RxSqlServerData(
|
||||
connectionString = connectionString,
|
||||
table = "RFMVIPTrainTest.urv.TEST")
|
||||
rxSplit(RFMVIPTrainTestData,outFilesBase=RFMVIPTrainTestData,splitByFactor='urv',overwrite=T,reportProgress=1)
|
||||
rxGetInfo(RFMVIPTrainTestData, T, numRows=3)
|
||||
|
||||
##Build our Logistic Regression Model with IsVIP as response
|
||||
r1<- rxLogit(IsVIP ~R+F+M,
|
||||
data =RFMVIPData,
|
||||
variableSelection = rxStepControl(method="stepwise",
|
||||
scope = ~ R+F+M))
|
||||
summary(r1)
|
||||
## Split data into training/testing data set
|
||||
|
||||
##r1:stepwise selection shows that Monetary,Recency are significant.
|
||||
##Build our Logistic REgression MOdel
|
||||
r2<- rxLogit(IsVIP ~R+F,
|
||||
data =RFMVIPData,covCoef=TRUE)
|
||||
TrainData <- RxSqlServerData(connectionString=connectionString,
|
||||
table = "RFMVIPTrainTest.urv.TRAIN")
|
||||
|
||||
TestData <- RxSqlServerData(connectionString=connectionString,
|
||||
table="RFMVIPTrainTest.urv.TEST")
|
||||
|
||||
rxSplit(RFMVIPTrainTestData, outFilesBase=RFMVIPTrainTestData,
|
||||
splitByFactor='urv', overwrite=T, reportProgress=1)
|
||||
|
||||
## Built our Logistic Regression Model with IsVIP as response
|
||||
|
||||
r1<- rxLogit(IsVIP~R+F+M,
|
||||
data =RFMVIPData,
|
||||
variableSelection = rxStepControl(method="stepwise",
|
||||
scope = ~ R+F+M))
|
||||
summary(r1)
|
||||
|
||||
## r1:stepwise selection shows that Monetary, Recency are significant.
|
||||
## Build our Logistic Regression Model
|
||||
|
||||
r2 <- rxLogit(IsVIP~R+F,
|
||||
data=RFMVIPData, covCoef=TRUE)
|
||||
summary(r2)
|
||||
|
||||
##Predict our Logistic Model on our test Dataset
|
||||
LogisticPred.xdf<-file.path(output.path,"LogisticPred.xdf")
|
||||
p2<-rxPredict(r2,data=test.xdf,outData=LogisticPred.xdf,writeModelVars = TRUE,extraVarsToWrite="ID",computeResiduals=TRUE,computeStdErr = TRUE,
|
||||
interval = "confidence",predVarNames='LogitPredict',overwrite=TRUE)
|
||||
rxGetInfo(LogisticPred.xdf,getVarInfo=T,numRows=10)
|
||||
LogisticPredInfoTop10<-rxGetInfo(LogisticPred.xdf,getVarInfo=T,numRows=10)
|
||||
LogisticPredInfoTop10.txt<-file.path(output.path,"LogisticPredInfoTop10.txt")
|
||||
write.table(LogisticPredInfoTop10$data,file=LogisticPredInfoTop10.txt,sep=" ")
|
||||
## Predict our Logistic Model on our test Dataset
|
||||
|
||||
LogisticPred.xdf <- file.path(output.path,"LogisticPred.xdf")
|
||||
p2 <- rxPredict(r2, data=test.xdf, outData=LogisticPred.xdf,
|
||||
writeModelVars=TRUE, extraVarsToWrite="ID",
|
||||
computeResiduals=TRUE, computeStdErr=TRUE,
|
||||
interval="confidence", predVarNames='LogitPredict',
|
||||
overwrite=TRUE)
|
||||
|
||||
rxGetInfo(LogisticPred.xdf, getVarInfo=T, numRows=10)
|
||||
LogisticPredInfoTop10 <- rxGetInfo(LogisticPred.xdf, getVarInfo=T, numRows=10)
|
||||
LogisticPredInfoTop10.txt <- file.path(output.path, "LogisticPredInfoTop10.txt")
|
||||
write.table(LogisticPredInfoTop10$data, file=LogisticPredInfoTop10.txt, sep=" ")
|
||||
|
||||
## Draw a ROC curve
|
||||
|
||||
##Draw a ROC curve
|
||||
rxRocCurve(actualVarName='IsVIP',predVarNames='LogitPredict',data=LogisticPred.xdf)
|
||||
|
||||
##Build a Decision Tree with Cluster as response
|
||||
d1 <- rxDTree(Cluster~R+F+M,data=TrainData,blocksPerRead=5)
|
||||
d1 <- rxDTree(Cluster~R_Score+F_Score+M_Score,data=TrainData,blocksPerRead=5)
|
||||
## Build a Decision Tree with Cluster as response
|
||||
|
||||
d1 <- rxDTree(Cluster~R+F+M, data=TrainData, blocksPerRead=5)
|
||||
d1 <- rxDTree(Cluster~R_Score+F_Score+M_Score, data=TrainData, blocksPerRead=5)
|
||||
d1
|
||||
d1Cp<- rxDTreeBestCp(d1)
|
||||
d1 <- prune.rxDTree(d1, cp=d1Cp)
|
||||
d2 <- rxDTree(Cluster~R+F+M,data=TrainData, pruneCp="auto")
|
||||
d2 <- rxDTree(Cluster~R_Score+F_Score+M_Score,data=TrainData, pruneCp="auto")
|
||||
d2 <- rxDTree(Cluster~R+F+M, data=TrainData, pruneCp="auto")
|
||||
d2 <- rxDTree(Cluster~R_Score+F_Score+M_Score, data=TrainData, pruneCp="auto")
|
||||
d2
|
||||
|
||||
#View Decision Tree
|
||||
#View 1
|
||||
# View Decision Tree
|
||||
|
||||
# View 1
|
||||
|
||||
library(RevoTreeView)
|
||||
|
||||
plot(createTreeView(d1))
|
||||
plot(createTreeView(d2))
|
||||
|
||||
#View 2
|
||||
# View 2
|
||||
|
||||
library(rpart)
|
||||
|
||||
plot(rxAddInheritance(d1))
|
||||
text(rxAddInheritance(d1))
|
||||
title(main="RFM-based Decision Tree on CDNOW Data",line=3)
|
||||
title(main="RFM-based Decision Tree on CDNOW Data",line=3)
|
||||
|
||||
plot(rxAddInheritance(d2))
|
||||
text(rxAddInheritance(d2))
|
||||
title(main="RFM-based Decision Tree on CDNOW Data",line=3)
|
||||
|
||||
#Prediction
|
||||
DTreePred.xdf<-file.path(output.path,"DTreePred.xdf")
|
||||
rxPredict(d1, data=test.xdf,outData=DTreePred.xdf,writeModelVars = TRUE,extraVarsToWrite="ID",computeResiduals=T,overwrite=TRUE)
|
||||
rxGetInfo(DTreePred.xdf,getVarInfo=T,numRows=3)
|
||||
DTreePredInfoTop10<-rxGetInfo(DTreePred.xdf,getVarInfo=T,numRows=10)
|
||||
DTreePredInfoTop10.txt<-file.path(output.path,"DTreePredInfoTop10.txt")
|
||||
write.table(DTreePredInfoTop10$data,file=DTreePredInfoTop10.txt,sep=" ")
|
||||
# Prediction
|
||||
|
||||
DTreePred<-rxXdfToDataFrame(file=DTreePred.xdf)
|
||||
sqlSave(channel,DTreePred,rownames=FALSE,append=FALSE,varTypes=list(numeric="float",integer="int",Date="date"))
|
||||
DTreePred.xdf<-file.path(output.path,"DTreePred.xdf")
|
||||
rxPredict(d1, data=test.xdf, outData=DTreePred.xdf,
|
||||
writeModelVars=TRUE, extraVarsToWrite="ID",
|
||||
computeResiduals=T, overwrite=TRUE)
|
||||
|
||||
rxGetInfo(DTreePred.xdf, getVarInfo=T, numRows=3)
|
||||
|
||||
DTreePredInfoTop10 <- rxGetInfo(DTreePred.xdf, getVarInfo=T, numRows=10)
|
||||
DTreePredInfoTop10.txt <- file.path(output.path, "DTreePredInfoTop10.txt")
|
||||
write.table(DTreePredInfoTop10$data, file=DTreePredInfoTop10.txt, sep=" ")
|
||||
|
||||
DTreePred <- rxXdfToDataFrame(file=DTreePred.xdf)
|
||||
|
||||
sqlSave(channel, DTreePred, rownames=FALSE, append=FALSE,
|
||||
varTypes=list(numeric="float",
|
||||
integer="int",
|
||||
Date="date"))
|
||||
odbcClose(channel)
|
||||
|
||||
|
||||
|
||||
@@ -43,6 +43,10 @@ This sample consists of the following directory structure.
|
||||
|
||||
To jumpstart, run the T-SQL files (crm_demo.sql)
|
||||
|
||||
**Note**
|
||||
|
||||
This is a demo built on SQL 2016 RC1 in Dec 2015. To try out it, please modify it to fit the new version of SQL Server R Services.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -1,4 +1,5 @@
|
||||
--use the database RREDemoSql
|
||||
|
||||
use sqlr;
|
||||
go
|
||||
|
||||
@@ -6,6 +7,7 @@ drop procedure if exists get_CDNOW_RFM
|
||||
go
|
||||
|
||||
--create stored procedure to get RFM
|
||||
|
||||
create proc get_CDNOW_RFM (@start datetime = '1900-1-1', @end datetime = '3000-1-1', @now datetime = null)
|
||||
as
|
||||
begin
|
||||
@@ -27,12 +29,14 @@ end
|
||||
go
|
||||
|
||||
--execute the stored procedure to obtain CDNOWRFM table
|
||||
|
||||
exec dbo.get_CDNOW_RFM @start='1997-1-1',@end='1998-7-1',@now='1998-7-1'
|
||||
go
|
||||
|
||||
drop procedure if exists BreakScoreRFM
|
||||
go
|
||||
|
||||
--create stored procedure to break RFM score
|
||||
|
||||
create proc BreakScoreRFM (@start datetime = '1900-1-1', @end datetime = '3000-1-1', @now datetime = null,
|
||||
@r_cut varchar(254) = null, @f_cut varchar(254) = null, @m_cut varchar(254) = null)
|
||||
@@ -175,10 +179,13 @@ end
|
||||
|
||||
go
|
||||
|
||||
--execute the stored procedure to obtain RFM_Score table
|
||||
|
||||
exec dbo.BreakScoreRFM @start ='1997-1-1', @end = '1998-7-1' ,@now = '1998-7-1', @r_cut ='142-433-486-513', @f_cut = '1-1-2-4', @m_cut ='14.37-20.25-29.37-44.29'
|
||||
go
|
||||
|
||||
--combine RFM and RFM_Score
|
||||
|
||||
drop table RFM_Result;
|
||||
select a.*, b.R_Score, b.F_Score, b.M_Score, b.Toltal_Score
|
||||
into RFM_Result
|
||||
@@ -188,7 +195,8 @@ from
|
||||
a.[ID] = b.[ID];
|
||||
select top 10 * from RFM_Result;
|
||||
|
||||
--visualize RFM
|
||||
--create stored procedure to visualize RFM
|
||||
|
||||
drop procedure if exists visualizeRFM;
|
||||
go
|
||||
create procedure visualizeRFM
|
||||
@@ -235,6 +243,7 @@ grant execute on visualizeRFM to rdemo;
|
||||
go
|
||||
|
||||
--clustering based on RFM
|
||||
|
||||
drop table if exists Kmeans_Result;
|
||||
drop table if exists CDNOW_rx_models;
|
||||
go
|
||||
@@ -251,6 +260,8 @@ create table Kmeans_Result (
|
||||
);
|
||||
go
|
||||
|
||||
--create stored procedure to do clustering
|
||||
|
||||
drop procedure if exists generate_CDNOW_rx_Kmeans;
|
||||
go
|
||||
create procedure generate_CDNOW_rx_Kmeans
|
||||
@@ -261,13 +272,13 @@ begin
|
||||
, @script = N'
|
||||
require("RevoScaleR");
|
||||
CDNOWKmeans <- rxKmeans(formula=~R+F+M+R_Score+F_Score+M_Score,
|
||||
data = RFM_Result,
|
||||
#outFile =Kmeans_Result,
|
||||
numClusters=8,
|
||||
algorithm = "lloyd",
|
||||
writeModelVars=TRUE,
|
||||
overwrite=TRUE)
|
||||
rxKmeans_model <- data.frame(payload = as.raw(serialize(CDNOWKmeans, connection=NULL)));
|
||||
data=RFM_Result,
|
||||
#outFile=Kmeans_Result,
|
||||
numClusters=8,
|
||||
algorithm="lloyd",
|
||||
writeModelVars=TRUE,
|
||||
overwrite=TRUE)
|
||||
rxKmeans_model <- data.frame(payload=as.raw(serialize(CDNOWKmeans, connection=NULL)));
|
||||
'
|
||||
, @input_data_1 = N'select * from RFM_Result'
|
||||
, @input_data_1_name = N'RFM_Result'
|
||||
@@ -275,7 +286,8 @@ begin
|
||||
with result sets ((model varbinary(max)));
|
||||
end;
|
||||
go
|
||||
--how to write Kmeans_Result back to database?
|
||||
|
||||
--how to write Kmeans_Result back to database?[To Be Modified]
|
||||
|
||||
insert into CDNOW_rx_models (model)
|
||||
exec generate_CDNOW_rx_Kmeans;
|
||||
@@ -283,7 +295,7 @@ update CDNOW_rx_models set model_name = 'rxKmeans' where model_name = 'default m
|
||||
select * from CDNOW_rx_models;
|
||||
go
|
||||
|
||||
--cannot write result table back to data base in rxKmeans.
|
||||
--create stored procedure to build logistic regression model
|
||||
|
||||
drop procedure if exists generate_CDNOW_rx_Logit;
|
||||
go
|
||||
@@ -294,11 +306,11 @@ begin
|
||||
@language = N'R'
|
||||
, @script = N'
|
||||
require("RevoScaleR");
|
||||
CDNOWLogit<- rxLogit(IsVIP~R+F+M,
|
||||
data =RFMVIPCluster,
|
||||
variableSelection = rxStepControl(method="stepwise",
|
||||
scope = ~ R+F+M))
|
||||
summary(CDNOWLogit)
|
||||
CDNOWLogit <- rxLogit(IsVIP~R+F+M,
|
||||
data=RFMVIPCluster,
|
||||
variableSelection=rxStepControl(method="stepwise",
|
||||
scope=~R+F+M))
|
||||
summary(CDNOWLogit)
|
||||
rxLogit_model <- data.frame(payload = as.raw(serialize(CDNOWLogit, connection=NULL)));
|
||||
'
|
||||
, @input_data_1 = N'select * from RFMVIPCluster'
|
||||
@@ -314,6 +326,8 @@ update CDNOW_rx_models set model_name = 'rxLogit' where model_name = 'default mo
|
||||
select * from CDNOW_rx_models;
|
||||
go
|
||||
|
||||
--create stored procedure to build decision tree model
|
||||
|
||||
drop procedure if exists generate_CDNOW_rx_Dtree;
|
||||
go
|
||||
create procedure generate_CDNOW_rx_Dtree
|
||||
@@ -323,8 +337,8 @@ begin
|
||||
@language = N'R'
|
||||
, @script = N'
|
||||
require("RevoScaleR");
|
||||
CDNOWDtree <- rxDTree(Cluster~R+F+M,data=RFMVIPCluster, pruneCp="auto")
|
||||
rxDtree_model <- data.frame(payload = as.raw(serialize(CDNOWDtree, connection=NULL)));
|
||||
CDNOWDtree <- rxDTree(Cluster~R+F+M, data=RFMVIPCluster, pruneCp="auto")
|
||||
rxDtree_model <- data.frame(payload=as.raw(serialize(CDNOWDtree, connection=NULL)));
|
||||
'
|
||||
, @input_data_1 = N'select * from RFMVIPCluster'
|
||||
, @input_data_1_name = N'RFMVIPCluster'
|
||||
@@ -339,6 +353,7 @@ update CDNOW_rx_models set model_name = 'rxDtree' where model_name = 'default mo
|
||||
select * from CDNOW_rx_models;
|
||||
go
|
||||
|
||||
--create stored procedure to predict whether the customer is VIP or not
|
||||
|
||||
drop procedure if exists predict_CDNOW_IsVIP;
|
||||
go
|
||||
@@ -350,12 +365,12 @@ begin
|
||||
exec sp_execute_external_script
|
||||
@language = N'R'
|
||||
, @script = N'
|
||||
require("RevoScaleR");
|
||||
CDNOWmodel<-unserialize(rx_model);
|
||||
CDNOWpred<-rxPredict(CDNOWmodel,data=RFMVIPCluster,writeModelVars = TRUE);
|
||||
OutputDataSet <- cbind(RFMVIPCluster[,1], CDNOWpred$IsVIP, round(CDNOWpred$IsVIP_Pred,2));
|
||||
colnames(OutputDataSet) <- c("ID", "IsVIP.Actual", "IsVIP.Expected");
|
||||
OutputDataSet<-as.data.frame(OutputDataSet);
|
||||
require("RevoScaleR");
|
||||
CDNOWmodel <- unserialize(rx_model);
|
||||
CDNOWpred <- rxPredict(CDNOWmodel, data=RFMVIPCluster, writeModelVars = TRUE);
|
||||
OutputDataSet <- cbind(RFMVIPCluster[,1], CDNOWpred$IsVIP, round(CDNOWpred$IsVIP_Pred,2));
|
||||
colnames(OutputDataSet) <- c("ID", "IsVIP.Actual", "IsVIP.Expected");
|
||||
OutputDataSet <- as.data.frame(OutputDataSet);
|
||||
'
|
||||
, @input_data_1 = N'
|
||||
select * from RFMVIPCluster'
|
||||
@@ -367,9 +382,13 @@ OutputDataSet<-as.data.frame(OutputDataSet);
|
||||
end;
|
||||
go
|
||||
|
||||
--execute the stored procedure to obtain the prediction on IsVIP
|
||||
|
||||
exec predict_CDNOW_IsVIP 'rxLogit';
|
||||
go
|
||||
|
||||
--create stored procedure to predict which cluster the customer belongs to
|
||||
|
||||
drop procedure if exists predict_CDNOW_Cluster;
|
||||
go
|
||||
create procedure predict_CDNOW_Cluster (@model varchar(100))
|
||||
@@ -380,15 +399,20 @@ begin
|
||||
exec sp_execute_external_script
|
||||
@language = N'R'
|
||||
, @script = N'
|
||||
require("RevoScaleR");
|
||||
CDNOWmodel<-unserialize(rx_model);
|
||||
CDNOWpred<-rxPredict(CDNOWmodel,data=RFMVIPCluster, predVarNames=c("prob1","prob2","prob3","prob4","prob5","prob6","prob7","prob8"),writeModelVars = TRUE,extraVarsToWrite="ID",computeResiduals=T,overwrite=TRUE);
|
||||
OutputDataSet <- round(cbind(RFMVIPCluster[,1], RFMVIPCluster[,10],
|
||||
CDNOWpred$prob1,CDNOWpred$prob2,CDNOWpred$prob3,CDNOWpred$prob4,
|
||||
CDNOWpred$prob5,CDNOWpred$prob6,CDNOWpred$prob7,CDNOWpred$prob8),2);
|
||||
colnames(OutputDataSet) <- c("ID", "Cluster.Actual", "Cluster1.Prob","Cluster2.Prob","Cluster3.Prob","Cluster4.Prob","Cluster5.Prob","Cluster6.Prob","Cluster7.Prob","Cluster8.Prob");
|
||||
OutputDataSet<-as.data.frame(OutputDataSet);
|
||||
'
|
||||
require("RevoScaleR");
|
||||
CDNOWmodel <- unserialize(rx_model);
|
||||
CDNOWpred <- rxPredict(CDNOWmodel,
|
||||
data=RFMVIPCluster,
|
||||
predVarNames=c("prob1", "prob2", "prob3", "prob4", "prob5", "prob6", "prob7", "prob8"),
|
||||
writeModelVars=TRUE, extraVarsToWrite="ID",
|
||||
computeResiduals=T, overwrite=TRUE);
|
||||
OutputDataSet <- round(cbind(RFMVIPCluster[,1], RFMVIPCluster[,10],
|
||||
CDNOWpred$prob1,CDNOWpred$prob2,CDNOWpred$prob3,CDNOWpred$prob4,
|
||||
CDNOWpred$prob5,CDNOWpred$prob6,CDNOWpred$prob7,CDNOWpred$prob8),2);
|
||||
|
||||
colnames(OutputDataSet) <- c("ID", "Cluster.Actual", "Cluster1.Prob","Cluster2.Prob","Cluster3.Prob","Cluster4.Prob","Cluster5.Prob","Cluster6.Prob","Cluster7.Prob","Cluster8.Prob");
|
||||
OutputDataSet<-as.data.frame(OutputDataSet);
|
||||
'
|
||||
, @input_data_1 = N'
|
||||
select * from RFMVIPCluster'
|
||||
, @input_data_1_name = N'RFMVIPCluster'
|
||||
@@ -399,5 +423,7 @@ OutputDataSet<-as.data.frame(OutputDataSet);
|
||||
end;
|
||||
go
|
||||
|
||||
--execute the stored procedure to obtain the prediction on Cluster
|
||||
|
||||
exec predict_CDNOW_Cluster 'rxDtree';
|
||||
go
|
||||
@@ -2,20 +2,25 @@ use sqlr;
|
||||
go
|
||||
drop table if exists CDNOW;
|
||||
go
|
||||
|
||||
-- create the fraud table to hold invoice data:
|
||||
|
||||
create table CDNOW(
|
||||
[ID] int not null,
|
||||
[Date] date not null,
|
||||
[Volume] int not null,
|
||||
[Amount] float not null);
|
||||
go
|
||||
-- Modify path to the data file: "po.txt"
|
||||
|
||||
-- Modify path to the data file: "CDNOW_master.csv"
|
||||
|
||||
bulk insert CDNOW
|
||||
from 'C:\sqlr\mydemos\CRM\CDNOW_master.csv'
|
||||
with(
|
||||
fieldterminator = ',',
|
||||
firstrow = 2);
|
||||
go
|
||||
|
||||
--create clustered columnstore index cs_CDNOW on CDNOW;
|
||||
--go
|
||||
|
||||
|
||||
Reference in New Issue
Block a user