github/sql-server-samples
1
0
Fork 0
mirror of https://github.com/Microsoft/sql-server-samples.git synced 2025-12-08 14:58:54 +00:00
Code Issues Releases Wiki Activity

update retail precision marketing demo

Browse Source
This commit is contained in:
Zhou Fang
2017-07-20 15:23:59 +08:00
parent 49394b7189
commit 89eccdd5e8
8 changed files with 371 additions and 510 deletions
Download Patch File Download Diff File Expand all files Collapse all files
samples/features/r-services/Retail Precision Marketing/Image/PowerBI 1.PNG
BIN
View File
Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 97 KiB

samples/features/r-services/Retail Precision Marketing/Image/PowerBI 1.jpg
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 678 KiB

samples/features/r-services/Retail Precision Marketing/R/CRMonCDNOWInDisk.R
-284
View File
@@ -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)
samples/features/r-services/Retail Precision Marketing/R/CRMonCDNOWInMemory.R
+147 -83
View File
@@ -1,173 +1,237 @@
############################################################# #############################################################
#CRM Demo on CDNOW # Title : CRM Demo in-memory
#Microsoft # Author: Microsoft
# Date: Dec, 2015
############################################################# #############################################################
#install package # Install package
install.packages("rmarkdown") install.packages("rmarkdown")
install.packages("fpc") install.packages("fpc")
#set directory # 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"
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) library(RODBC)
getSqlTypeInfo() 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') # Connect from local PC
df<- sqlQuery(channel,paste("select * from dbo.CDNOW"))
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) df$Date<-as.Date(df$Date)
str(df) str(df)
head(df) head(df)
#remove the rows with the duplicated IDs to see how many customers in total # Remove the rows with the duplicated IDs to see how many customers in total
uid <- df[!duplicated(df[,"ID"]),]
uid <- df[!duplicated(df[,"ID"]), ]
dim(uid) dim(uid)
#call RFM source code # Step 1: RFM analysis
source("RFM_Analysis_R_Source_Codes_V1.3.R")
# 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") startDate <- as.Date("19970101","%Y%m%d")
endDate <- as.Date("19980701","%Y%m%d") endDate <- as.Date("19980701","%Y%m%d")
#calculate RFM value # Calculate RFM value
df <- getDataFrame(df,startDate,endDate,tIDColName="ID",tDateColName="Date",tAmountColName="Amount")
df <- getDataFrame(df, startDate, endDate, tIDColName="ID", tDateColName="Date", tAmountColName="Amount")
head(df) head(df)
#obtain Independent RFM score # Obtain independent RFM score
df1 <-getIndependentScore(df) df1 <-getIndependentScore(df)
head(df1) head(df1)
#draw the histograms in the R, F, and M dimensions # Draw the histograms in the R, F, and M dimensions
drawHistograms(df1) drawHistograms(df1)
S500<-df1[df1$Total_Score>500,] S500 <- df1[df1$Total_Score > 500, ]
dim(S500) dim(S500)
S400<-df1[df1$Total_Score>400,] S400 <- df1[df1$Total_Score > 400, ]
dim(S400) 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)) par(mfrow = c(1,3))
hist(df$Recency) hist(df$Recency)
hist(df$Frequency) hist(df$Frequency)
hist(df$Monetary) hist(df$Monetary)
#set the Recency ranges as 0-120 days, 120-240 days, 240-450 days, 450-500days, and more than 500days. # 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 ? 2times, 2-5 times,5-8 times, 8-10 times, and more than 10 times. r <- c(120, 240, 450, 500)
f <-c(2,5,8,10)
#set the Monetary ranges as 0-10 dollars, 10-20 dollars, and so on. # 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) m <-c(10,20,30,100)
#calculate RFM score with breaks # Calculate RFM score with breaks
df2<-getScoreWithBreaks(df,r,f,m)
df2 <- getScoreWithBreaks(df, r, f, m)
drawHistograms(df2) drawHistograms(df2)
S500<-df2[df2$Total_Score>500,] S500 <- df2[df2$Total_Score > 500, ]
dim(S500) dim(S500)
S400<-df2[df2$Total_Score>400,] S400 <- df2[df2$Total_Score > 400, ]
dim(S400) dim(S400)
target <- df2[df2$Total_Score>=441,] target <- df2[df2$Total_Score >= 441,]
dim(target) dim(target)
#obtain RFM scores with quantiles as breaks # Obtain RFM scores with quantiles as breaks
r <-c(cutpoint(df$Recency)) r <-c(cutpoint(df$Recency))
f <-c(cutpoint(df$Frequency)) f <-c(cutpoint(df$Frequency))
m <-c(cutpoint(df$Monetary)) m <-c(cutpoint(df$Monetary))
df3<-getScoreWithBreaks(df,r,f,m) df3 <- getScoreWithBreaks(df, r, f, m)
str(df3) str(df3)
head(df3) head(df3)
tail(df3) tail(df3)
RFM_Result_osr<-subset(df3,select=c("ID","Recency","Frequency","Monetary","R_Score","F_Score","M_Score","Total_Score")) RFM_Result <- subset(df3,
colnames(RFM_Result_osr)<-c("ID","R","F","M","R_Score","F_Score","M_Score","Total_Score") select=c("ID", "Recency", "Frequency", "Monetary",
head(RFM_Result_osr) "R_Score", "F_Score", "M_Score", "Total_Score"))
system.time( colnames(RFM_Result) <- c("ID", "R", "F", "M", "R_Score", "F_Score", "M_Score", "Total_Score")
sqlSave(channel,RFM_Result_osr,rownames=FALSE,append=FALSE,varTypes=list(numeric="float",integer="int"))
)
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) odbcClose(channel)
#Clustering using RFM # Clustering using RFM
library(fpc) library(fpc)
library(cluster) library(cluster)
#kmeans clustering with cluster =8
cl.fit1<-kmeans(RFM_Result_osr[,2:8],centers=8,iter.max=10,nstart=1) # Kmeans clustering with number of cluster equal to 8
cl.fit2<-kmeans(RFM_Result_osr[,2:8],centers=8,iter.max=20,nstart=200)
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) summary(cl.fit1)
cluster<-cl.fit1$cluster cluster<-cl.fit1$cluster
centers<-cl.fit1$centers centers<-cl.fit1$centers
size<-cl.fit1$size 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) title(main="K-means",line=3)
##Classification using RFM # Classification using RFM
#Create IsVIP variable
IsVIP<-ifelse(RFM_Result_osr[,'Total_Score']>=441,1,0); # Create IsVIP variable
Cluster<-cl.fit1$cluster
RFMVIPCluster<-cbind(RFM_Result_osr,IsVIP,Cluster) 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) str(RD)
table(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 RFMVIPCluster$RD <- RD;
##Build our Logistic Regression Model with IsVIP as response
r1<-glm(IsVIP~R+F+M, data=Train, family = binomial) 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) summary(r1)
p1<-predict.glm(r1,data=Test,type="response") p1 <- predict.glm(r1, data=Test, type="response")
head(p1) head(p1)
tail(p1) tail(p1)
#decision tree # Decision tree
#grow tree # Grow tree
fit <- rpart(Cluster~R+F+M, 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) plotcp(fit)
#detailed summary of splits
# Detailed summary of splits
summary(fit) summary(fit)
# plot tree # Plot tree
library(rpart) 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) text(fit, use.n=TRUE, all=TRUE, cex=.8)
# prune the tree # Prune the tree
pfit<- prune(fit, cp= fit$cptable[which.min(fit$cptable[,"xerror"]),"CP"])
pfit <- prune(fit, cp=fit$cptable[which.min(fit$cptable[,"xerror"]), "CP"])
# Plot the pruned tree
# plot the pruned tree
plot(pfit, uniform=TRUE, 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) text(pfit, use.n=TRUE, all=TRUE, cex=.8)
samples/features/r-services/Retail Precision Marketing/R/CRMonCDNOWInSql.R
+156 -110
View File
@@ -1,157 +1,203 @@
################################################################ ################################################################
##CRM Demo in-SQL compute context # Title: CRM Demo in-SQL
##Microsoft # 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 <- "Driver=SQL Server;
connectionString = connectionString, Server=tcp:192.168.176.130,1433;
table = "RFM_Result") 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) rxSetComputeContext(cc)
rxGetInfo(RFMData,getVarInfo=T,numRows=3) rxGetInfo(RFMData, getVarInfo=T, numRows=3)
#Step 1: RFM analysis # 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)
#count frequency of each RFMscore Level # Visualize the RFM values
tmp<-rxCube(~F(Toltal_Score),data=RFMData)
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 <- rxResultsDF(tmp)
results<-results[results$Counts!=0,] results <- results[results$Counts != 0, ]
results[order(results$Counts,decreasing=TRUE),] 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, md.km <- rxKmeans(formula=~R+F+M+R_Score+F_Score+M_Score,
data = RFMData, data=RFMData,
outFile =KmeansData, outFile=KmeansData,
numClusters=8, numClusters=8,
algorithm = "lloyd", algorithm="lloyd",
writeModelVars=TRUE, writeModelVars=TRUE,
overwrite=TRUE) overwrite=TRUE)
rxGetInfo(KmeansData,getVarInfo=TRUE,numRows=10)
centers<-round(md.km$centers,digits=2) rxGetInfo(KmeansData, getVarInfo=TRUE, numRows=10)
size<-md.km$size
centers.txt<-file.path(output.path,"centers.txt") centers <- round(md.km$centers, digits=2)
write.table(centers,file=centers.txt,sep=" ") size <- md.km$size
size.txt<-file.path(output.path,"size.txt") centers.txt <- file.path(output.path, "centers.txt")
write.table(size,file=size.txt,sep=" ") 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) library(RODBC)
channel<-odbcDriverConnect(connection=connectionString) 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) head(Kmeans.df)
plot(Kmeans.df[,2:4],col=Kmeans.df$X_rxCluster) plot(Kmeans.df[, 2:4], col=Kmeans.df$X_rxCluster)
title(main="RFM-based K-means on CDNOW Data",line=3) title(main="RFM-based K-means on CDNOW Data", line=3)
##Step 3: Prediction-logistic and decision tree # Step 3: Prediction-logistic and decision tree
#Create IsVIP variable
RFMVIPData <- RxSqlServerData( # Create IsVIP variable
connectionString = connectionString,
table = "RFMVIP") RFMVIPData <- RxSqlServerData(connectionString=connectionString,
rxDataStep(inData=RFMData,outFile=RFMVIPData, table="RFMVIP")
transforms=list(IsVIP=ifelse(Toltal_Score>=441,1,0)
), rxDataStep(inData=RFMData,
overwrite=TRUE,reportProgress=1 outFile=RFMVIPData,
) transforms=list(IsVIP=ifelse(Toltal_Score >= 441, 1, 0)),
rxGetInfo(RFMVIPData,getVarInfo=T,numRows=3) overwrite=TRUE,
rxGetInfo(RFMVIPRDData,getVarInfo=T,numRows=3) reportProgress=1)
RFMVIPRDData <- RxSqlServerData(
connectionString = connectionString, rxGetInfo(RFMVIPData, getVarInfo=T, numRows=3)
table = "RFMVIPRD") rxGetInfo(RFMVIPRDData, getVarInfo=T, numRows=3)
RFMVIPTrainTestData <- RxSqlServerData(
connectionString = connectionString, RFMVIPRDData <- RxSqlServerData(connectionString=connectionString,
table = "RFMVIPTrainTest") table="RFMVIPRD")
rxDataStep(inData=RFMVIPRDData,outFile=RFMVIPTrainTestData,
transforms=list( RFMVIPTrainTestData <- RxSqlServerData(connectionString = connectionString,
urv=factor(ifelse(RD<=8,'TRAIN','TEST')) table="RFMVIPTrainTest")
),
rxDataStep(inData=RFMVIPRDData,
outFile=RFMVIPTrainTestData,
transforms=list(urv=factor(ifelse(RD <= 8,'TRAIN','TEST'))),
overwrite=T) overwrite=T)
rxGetInfo(RFMVIPTrainTestData,T,numRows=3)
##Split data into training/testing data set rxGetInfo(RFMVIPTrainTestData, T, numRows=3)
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)
##Build our Logistic Regression Model with IsVIP as response ## Split data into training/testing data set
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. TrainData <- RxSqlServerData(connectionString=connectionString,
##Build our Logistic REgression MOdel table = "RFMVIPTrainTest.urv.TRAIN")
r2<- rxLogit(IsVIP ~R+F,
data =RFMVIPData,covCoef=TRUE) 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) summary(r2)
##Predict our Logistic Model on our test Dataset ## 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, LogisticPred.xdf <- file.path(output.path,"LogisticPred.xdf")
interval = "confidence",predVarNames='LogitPredict',overwrite=TRUE) p2 <- rxPredict(r2, data=test.xdf, outData=LogisticPred.xdf,
rxGetInfo(LogisticPred.xdf,getVarInfo=T,numRows=10) writeModelVars=TRUE, extraVarsToWrite="ID",
LogisticPredInfoTop10<-rxGetInfo(LogisticPred.xdf,getVarInfo=T,numRows=10) computeResiduals=TRUE, computeStdErr=TRUE,
LogisticPredInfoTop10.txt<-file.path(output.path,"LogisticPredInfoTop10.txt") interval="confidence", predVarNames='LogitPredict',
write.table(LogisticPredInfoTop10$data,file=LogisticPredInfoTop10.txt,sep=" ") 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) rxRocCurve(actualVarName='IsVIP',predVarNames='LogitPredict',data=LogisticPred.xdf)
##Build a Decision Tree with Cluster as response ## 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 <- rxDTree(Cluster~R+F+M, data=TrainData, blocksPerRead=5)
d1 <- rxDTree(Cluster~R_Score+F_Score+M_Score, data=TrainData, blocksPerRead=5)
d1 d1
d1Cp<- rxDTreeBestCp(d1) d1Cp<- rxDTreeBestCp(d1)
d1 <- prune.rxDTree(d1, cp=d1Cp) d1 <- prune.rxDTree(d1, cp=d1Cp)
d2 <- rxDTree(Cluster~R+F+M,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 <- rxDTree(Cluster~R_Score+F_Score+M_Score, data=TrainData, pruneCp="auto")
d2 d2
#View Decision Tree # View Decision Tree
#View 1
# View 1
library(RevoTreeView) library(RevoTreeView)
plot(createTreeView(d1)) plot(createTreeView(d1))
plot(createTreeView(d2)) plot(createTreeView(d2))
#View 2 # View 2
library(rpart) library(rpart)
plot(rxAddInheritance(d1)) plot(rxAddInheritance(d1))
text(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)) plot(rxAddInheritance(d2))
text(rxAddInheritance(d2)) text(rxAddInheritance(d2))
title(main="RFM-based Decision Tree on CDNOW Data",line=3) title(main="RFM-based Decision Tree on CDNOW Data",line=3)
#Prediction # 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=" ")
DTreePred<-rxXdfToDataFrame(file=DTreePred.xdf) DTreePred.xdf<-file.path(output.path,"DTreePred.xdf")
sqlSave(channel,DTreePred,rownames=FALSE,append=FALSE,varTypes=list(numeric="float",integer="int",Date="date")) 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) odbcClose(channel)
samples/features/r-services/Retail Precision Marketing/README.md
+4
View File
@@ -43,6 +43,10 @@ This sample consists of the following directory structure.
To jumpstart, run the T-SQL files (crm_demo.sql) 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.
samples/features/r-services/Retail Precision Marketing/SQL/crm_demo.sql
+58 -32
View File
@@ -1,4 +1,5 @@
--use the database RREDemoSql --use the database RREDemoSql
use sqlr; use sqlr;
go go
@@ -6,6 +7,7 @@ drop procedure if exists get_CDNOW_RFM
go go
--create stored procedure to get RFM --create stored procedure to get RFM
create proc get_CDNOW_RFM (@start datetime = '1900-1-1', @end datetime = '3000-1-1', @now datetime = null) create proc get_CDNOW_RFM (@start datetime = '1900-1-1', @end datetime = '3000-1-1', @now datetime = null)
as as
begin begin
@@ -27,12 +29,14 @@ end
go go
--execute the stored procedure to obtain CDNOWRFM table --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' exec dbo.get_CDNOW_RFM @start='1997-1-1',@end='1998-7-1',@now='1998-7-1'
go go
drop procedure if exists BreakScoreRFM drop procedure if exists BreakScoreRFM
go go
--create stored procedure to break RFM score
create proc BreakScoreRFM (@start datetime = '1900-1-1', @end datetime = '3000-1-1', @now datetime = null, 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) @r_cut varchar(254) = null, @f_cut varchar(254) = null, @m_cut varchar(254) = null)
@@ -175,10 +179,13 @@ end
go 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' 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 go
--combine RFM and RFM_Score --combine RFM and RFM_Score
drop table RFM_Result; drop table RFM_Result;
select a.*, b.R_Score, b.F_Score, b.M_Score, b.Toltal_Score select a.*, b.R_Score, b.F_Score, b.M_Score, b.Toltal_Score
into RFM_Result into RFM_Result
@@ -188,7 +195,8 @@ from
a.[ID] = b.[ID]; a.[ID] = b.[ID];
select top 10 * from RFM_Result; select top 10 * from RFM_Result;
--visualize RFM --create stored procedure to visualize RFM
drop procedure if exists visualizeRFM; drop procedure if exists visualizeRFM;
go go
create procedure visualizeRFM create procedure visualizeRFM
@@ -235,6 +243,7 @@ grant execute on visualizeRFM to rdemo;
go go
--clustering based on RFM --clustering based on RFM
drop table if exists Kmeans_Result; drop table if exists Kmeans_Result;
drop table if exists CDNOW_rx_models; drop table if exists CDNOW_rx_models;
go go
@@ -251,6 +260,8 @@ create table Kmeans_Result (
); );
go go
--create stored procedure to do clustering
drop procedure if exists generate_CDNOW_rx_Kmeans; drop procedure if exists generate_CDNOW_rx_Kmeans;
go go
create procedure generate_CDNOW_rx_Kmeans create procedure generate_CDNOW_rx_Kmeans
@@ -261,13 +272,13 @@ begin
, @script = N' , @script = N'
require("RevoScaleR"); require("RevoScaleR");
CDNOWKmeans <- rxKmeans(formula=~R+F+M+R_Score+F_Score+M_Score, CDNOWKmeans <- rxKmeans(formula=~R+F+M+R_Score+F_Score+M_Score,
data = RFM_Result, data=RFM_Result,
#outFile =Kmeans_Result, #outFile=Kmeans_Result,
numClusters=8, numClusters=8,
algorithm = "lloyd", algorithm="lloyd",
writeModelVars=TRUE, writeModelVars=TRUE,
overwrite=TRUE) overwrite=TRUE)
rxKmeans_model <- data.frame(payload = as.raw(serialize(CDNOWKmeans, connection=NULL))); rxKmeans_model <- data.frame(payload=as.raw(serialize(CDNOWKmeans, connection=NULL)));
' '
, @input_data_1 = N'select * from RFM_Result' , @input_data_1 = N'select * from RFM_Result'
, @input_data_1_name = N'RFM_Result' , @input_data_1_name = N'RFM_Result'
@@ -275,7 +286,8 @@ begin
with result sets ((model varbinary(max))); with result sets ((model varbinary(max)));
end; end;
go 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) insert into CDNOW_rx_models (model)
exec generate_CDNOW_rx_Kmeans; 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; select * from CDNOW_rx_models;
go 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; drop procedure if exists generate_CDNOW_rx_Logit;
go go
@@ -294,11 +306,11 @@ begin
@language = N'R' @language = N'R'
, @script = N' , @script = N'
require("RevoScaleR"); require("RevoScaleR");
CDNOWLogit<- rxLogit(IsVIP~R+F+M, CDNOWLogit <- rxLogit(IsVIP~R+F+M,
data =RFMVIPCluster, data=RFMVIPCluster,
variableSelection = rxStepControl(method="stepwise", variableSelection=rxStepControl(method="stepwise",
scope = ~ R+F+M)) scope=~R+F+M))
summary(CDNOWLogit) summary(CDNOWLogit)
rxLogit_model <- data.frame(payload = as.raw(serialize(CDNOWLogit, connection=NULL))); rxLogit_model <- data.frame(payload = as.raw(serialize(CDNOWLogit, connection=NULL)));
' '
, @input_data_1 = N'select * from RFMVIPCluster' , @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; select * from CDNOW_rx_models;
go go
--create stored procedure to build decision tree model
drop procedure if exists generate_CDNOW_rx_Dtree; drop procedure if exists generate_CDNOW_rx_Dtree;
go go
create procedure generate_CDNOW_rx_Dtree create procedure generate_CDNOW_rx_Dtree
@@ -323,8 +337,8 @@ begin
@language = N'R' @language = N'R'
, @script = N' , @script = N'
require("RevoScaleR"); require("RevoScaleR");
CDNOWDtree <- rxDTree(Cluster~R+F+M,data=RFMVIPCluster, pruneCp="auto") CDNOWDtree <- rxDTree(Cluster~R+F+M, data=RFMVIPCluster, pruneCp="auto")
rxDtree_model <- data.frame(payload = as.raw(serialize(CDNOWDtree, connection=NULL))); rxDtree_model <- data.frame(payload=as.raw(serialize(CDNOWDtree, connection=NULL)));
' '
, @input_data_1 = N'select * from RFMVIPCluster' , @input_data_1 = N'select * from RFMVIPCluster'
, @input_data_1_name = N'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; select * from CDNOW_rx_models;
go go
--create stored procedure to predict whether the customer is VIP or not
drop procedure if exists predict_CDNOW_IsVIP; drop procedure if exists predict_CDNOW_IsVIP;
go go
@@ -350,12 +365,12 @@ begin
exec sp_execute_external_script exec sp_execute_external_script
@language = N'R' @language = N'R'
, @script = N' , @script = N'
require("RevoScaleR"); require("RevoScaleR");
CDNOWmodel<-unserialize(rx_model); CDNOWmodel <- unserialize(rx_model);
CDNOWpred<-rxPredict(CDNOWmodel,data=RFMVIPCluster,writeModelVars = TRUE); CDNOWpred <- rxPredict(CDNOWmodel, data=RFMVIPCluster, writeModelVars = TRUE);
OutputDataSet <- cbind(RFMVIPCluster[,1], CDNOWpred$IsVIP, round(CDNOWpred$IsVIP_Pred,2)); OutputDataSet <- cbind(RFMVIPCluster[,1], CDNOWpred$IsVIP, round(CDNOWpred$IsVIP_Pred,2));
colnames(OutputDataSet) <- c("ID", "IsVIP.Actual", "IsVIP.Expected"); colnames(OutputDataSet) <- c("ID", "IsVIP.Actual", "IsVIP.Expected");
OutputDataSet<-as.data.frame(OutputDataSet); OutputDataSet <- as.data.frame(OutputDataSet);
' '
, @input_data_1 = N' , @input_data_1 = N'
select * from RFMVIPCluster' select * from RFMVIPCluster'
@@ -367,9 +382,13 @@ OutputDataSet<-as.data.frame(OutputDataSet);
end; end;
go go
--execute the stored procedure to obtain the prediction on IsVIP
exec predict_CDNOW_IsVIP 'rxLogit'; exec predict_CDNOW_IsVIP 'rxLogit';
go go
--create stored procedure to predict which cluster the customer belongs to
drop procedure if exists predict_CDNOW_Cluster; drop procedure if exists predict_CDNOW_Cluster;
go go
create procedure predict_CDNOW_Cluster (@model varchar(100)) create procedure predict_CDNOW_Cluster (@model varchar(100))
@@ -380,15 +399,20 @@ begin
exec sp_execute_external_script exec sp_execute_external_script
@language = N'R' @language = N'R'
, @script = N' , @script = N'
require("RevoScaleR"); require("RevoScaleR");
CDNOWmodel<-unserialize(rx_model); 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); CDNOWpred <- rxPredict(CDNOWmodel,
OutputDataSet <- round(cbind(RFMVIPCluster[,1], RFMVIPCluster[,10], data=RFMVIPCluster,
CDNOWpred$prob1,CDNOWpred$prob2,CDNOWpred$prob3,CDNOWpred$prob4, predVarNames=c("prob1", "prob2", "prob3", "prob4", "prob5", "prob6", "prob7", "prob8"),
CDNOWpred$prob5,CDNOWpred$prob6,CDNOWpred$prob7,CDNOWpred$prob8),2); writeModelVars=TRUE, extraVarsToWrite="ID",
colnames(OutputDataSet) <- c("ID", "Cluster.Actual", "Cluster1.Prob","Cluster2.Prob","Cluster3.Prob","Cluster4.Prob","Cluster5.Prob","Cluster6.Prob","Cluster7.Prob","Cluster8.Prob"); computeResiduals=T, overwrite=TRUE);
OutputDataSet<-as.data.frame(OutputDataSet); 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' , @input_data_1 = N'
select * from RFMVIPCluster' select * from RFMVIPCluster'
, @input_data_1_name = N'RFMVIPCluster' , @input_data_1_name = N'RFMVIPCluster'
@@ -399,5 +423,7 @@ OutputDataSet<-as.data.frame(OutputDataSet);
end; end;
go go
--execute the stored procedure to obtain the prediction on Cluster
exec predict_CDNOW_Cluster 'rxDtree'; exec predict_CDNOW_Cluster 'rxDtree';
go go
samples/features/r-services/Retail Precision Marketing/SQL/crm_setup.sql
+6 -1
View File
@@ -2,20 +2,25 @@ use sqlr;
go go
drop table if exists CDNOW; drop table if exists CDNOW;
go go
-- create the fraud table to hold invoice data: -- create the fraud table to hold invoice data:
create table CDNOW( create table CDNOW(
[ID] int not null, [ID] int not null,
[Date] date not null, [Date] date not null,
[Volume] int not null, [Volume] int not null,
[Amount] float not null); [Amount] float not null);
go go
-- Modify path to the data file: "po.txt"
-- Modify path to the data file: "CDNOW_master.csv"
bulk insert CDNOW bulk insert CDNOW
from 'C:\sqlr\mydemos\CRM\CDNOW_master.csv' from 'C:\sqlr\mydemos\CRM\CDNOW_master.csv'
with( with(
fieldterminator = ',', fieldterminator = ',',
firstrow = 2); firstrow = 2);
go go
--create clustered columnstore index cs_CDNOW on CDNOW; --create clustered columnstore index cs_CDNOW on CDNOW;
--go --go