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
Files
89eccdd5e8e173ec5f7a0710648bf4e5764d8528
sql-server-samples/samples/features/r-services/Retail Precision Marketing/SQL/crm_demo.sql
T

429 lines
13 KiB
Transact-SQL
Raw Blame History

--use the database RREDemoSql
use sqlr;
go
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
if @now is null
set @now = getdate()
select
ID, DATEDIFF(d,R,@now) as R ,F,M
from
(select
ID, MAX([Date]) as R, COUNT(Volume) as F, round(avg(Amount),2) as M
from
[dbo].[CDNOW]
where
[Date] BETWEEN @start AND @end
group by ID ) as rfm_tmp
order by cast (ID as int)
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)
as
begin
if @now is null
set @now = getdate()
declare @r_cut1 float = 100, @r_cut2 float = 200, @r_cut3 float = 300, @r_cut4 float = 400
declare @f_cut1 float = 100, @f_cut2 float = 200, @f_cut3 float = 300, @f_cut4 float = 400
declare @m_cut1 float = 100, @m_cut2 float = 200, @m_cut3 float = 300, @m_cut4 float = 400
declare @idx int = 0, @len int = 0
--get cut parameter, should add more code to check cut parameter.
if(@r_cut is not null) -- and @r_cut follow the syntax
begin
set @idx = CHARINDEX('-',@r_cut)
set @len = len(@r_cut)
set @r_cut1 = substring(@r_cut,1,@idx-1)
set @r_cut=substring(@r_cut,@idx+1,@len-@idx)
set @idx = CHARINDEX('-',@r_cut)
set @len = len(@r_cut)
set @r_cut2 = substring(@r_cut,1,@idx-1)
set @r_cut=substring(@r_cut,@idx+1,@len-@idx)
set @idx = CHARINDEX('-',@r_cut)
set @len = len(@r_cut)
set @r_cut3 = substring(@r_cut,1,@idx-1)
set @r_cut4=substring(@r_cut,@idx+1,@len-@idx)
end
if(@f_cut is not null) -- and @f_cut follow the syntax
begin
set @idx = CHARINDEX('-',@f_cut)
set @len = len(@f_cut)
set @f_cut1 = substring(@f_cut,1,@idx-1)
set @f_cut=substring(@f_cut,@idx+1,@len-@idx)
set @idx = CHARINDEX('-',@f_cut)
set @len = len(@f_cut)
set @f_cut2 = substring(@f_cut,1,@idx-1)
set @f_cut=substring(@f_cut,@idx+1,@len-@idx)
set @idx = CHARINDEX('-',@f_cut)
set @len = len(@f_cut)
set @f_cut3 = substring(@f_cut,1,@idx-1)
set @f_cut4=substring(@f_cut,@idx+1,@len-@idx)
end
if(@m_cut is not null) -- and @m_cut follow the syntax
begin
set @idx = CHARINDEX('-',@m_cut)
set @len = len(@m_cut)
set @m_cut1 = substring(@m_cut,1,@idx-1)
set @m_cut=substring(@m_cut,@idx+1,@len-@idx)
set @idx = CHARINDEX('-',@m_cut)
set @len = len(@m_cut)
set @m_cut2 = substring(@m_cut,1,@idx-1)
set @m_cut=substring(@m_cut,@idx+1,@len-@idx)
set @idx = CHARINDEX('-',@m_cut)
set @len = len(@m_cut)
set @m_cut3 = substring(@m_cut,1,@idx-1)
set @m_cut4=substring(@m_cut,@idx+1,@len-@idx)
end
--drop exists tmp tables.
if exists (select 1 from sys.tables where [object_id] =object_id('RFM_Score') and type= 'U')
begin
truncate table RFM_Score
drop table RFM_Score
end
if exists (select 1 from sys.tables where [object_id] =object_id('RFM') and type= 'U')
begin
truncate table RFM
drop table RFM
end
-- get RFM table from initial data.
select
ID, DATEDIFF(d,R,@now) as R, F, M into RFM
from
(select
ID, max([Date]) as R, count(Volume) as F, round(avg(Amount),2) as M
from
CDNOW
where
[Date] between @start and @end
group by ID ) as rfm_tmp
order by cast (ID as int)
-- record R_Score at temp table '#R'
select
ID,
case when R <= @r_cut1 then 5
when R > @r_cut1 and R <= @r_cut2 then 4
when R > @r_cut2 and R <= @r_cut3 then 3
when R > @r_cut3 and R <= @r_cut4 then 2
when R > @r_cut4 then 1
else 0
end as R_Score
into #R
from RFM
-- score F
select
ID,
case when F >= @f_cut4 then 5
when F > @f_cut3 and F <= @f_cut4 then 4
when F > @f_cut2 and F <= @f_cut3 then 3
when F > @f_cut3 and F <= @f_cut4 then 2
when F < @f_cut4 then 1
else 0
end as F_Score
into #F
from RFM
-- score M
select
ID,
case when M >= @m_cut4 then 5
when M > @m_cut3 and M <= @m_cut4 then 4
when M > @m_cut2 and M <= @m_cut3 then 3
when M > @m_cut3 and M <= @m_cut4 then 2
when M < @m_cut4 then 1
else 0
end as M_Score
into #M
from RFM
--union all
select #R.ID, R_Score, F_Score, M_Score, R_Score*100 + F_Score*10 + M_Score as Toltal_Score
into RFM_Score
from #R, #F, #M
where #R.ID = #F.ID and #R.ID = #M.ID
select * from RFM_Score order by Toltal_Score desc,ID
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
from
[dbo].[RFM] a left outer join
[dbo].[RFM_Score] b on
a.[ID] = b.[ID];
select top 10 * from RFM_Result;
--create stored procedure to visualize RFM
drop procedure if exists visualizeRFM;
go
create procedure visualizeRFM
as
begin
execute sp_execute_external_script
@language = N'R'
, @script = N'
drawHistograms <- function(df,r=5,f=5,m=5){
#set the layout plot window
par(mfrow = c(f,r))
names <-rep("",times=m)
for(i in 1:m) names[i]<-paste("M",i)
for (i in 1:f){
for (j in 1:r){
c <- rep(0,times=m)
for(k in 1:m){
tmpdf <-df[df$R_Score==j & df$F_Score==i & df$M_Score==k,]
c[k]<- dim(tmpdf)[1]
}
if (i==1 & j==1)
barplot(c,col="lightblue",names.arg=names)
else
barplot(c,col="lightblue")
if (j==1) title(ylab=paste("F",i))
if (i==1) title(main=paste("R",j))
}
}
par(mfrow = c(1,1))
}
RFMhist<-drawHistograms(RFM_Result[,1:4])
ff= tempfile()
png(filename=ff, width=620, height=240)
print(RFMhist)
dev.off()
OutputDataSet <- data.frame(data=readBin(file(ff, "rb"), what=raw(), n=1e6));
'
, @input_data_1 = N'select "R", "F", "M" from RFM_Result'
, @input_data_1_name = N'RFM_Result'
with result sets ((plot varbinary(max)));
end;
go
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
create table CDNOW_rx_models(
model_name varchar(30) not null default('default model') primary key,
model varbinary(max) not null
);
go
create table Kmeans_Result (
"X_rxCluster" int null
, "R" int null, "F" int null, "M" float null
, "R_Score" int null, "F_Score" int null, "M_Score" int null
);
go
--create stored procedure to do clustering
drop procedure if exists generate_CDNOW_rx_Kmeans;
go
create procedure generate_CDNOW_rx_Kmeans
as
begin
execute sp_execute_external_script
@language = N'R'
, @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)));
'
, @input_data_1 = N'select * from RFM_Result'
, @input_data_1_name = N'RFM_Result'
, @output_data_1_name = N'rxKmeans_model'
with result sets ((model varbinary(max)));
end;
go
--how to write Kmeans_Result back to database?[To Be Modified]
insert into CDNOW_rx_models (model)
exec generate_CDNOW_rx_Kmeans;
update CDNOW_rx_models set model_name = 'rxKmeans' where model_name = 'default model';
select * from CDNOW_rx_models;
go
--create stored procedure to build logistic regression model
drop procedure if exists generate_CDNOW_rx_Logit;
go
create procedure generate_CDNOW_rx_Logit
as
begin
execute sp_execute_external_script
@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)
rxLogit_model <- data.frame(payload = as.raw(serialize(CDNOWLogit, connection=NULL)));
'
, @input_data_1 = N'select * from RFMVIPCluster'
, @input_data_1_name = N'RFMVIPCluster'
, @output_data_1_name = N'rxLogit_model'
with result sets ((model varbinary(max)));
end;
go
insert into CDNOW_rx_models (model)
exec generate_CDNOW_rx_Logit;
update CDNOW_rx_models set model_name = 'rxLogit' where model_name = 'default model';
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
as
begin
execute sp_execute_external_script
@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)));
'
, @input_data_1 = N'select * from RFMVIPCluster'
, @input_data_1_name = N'RFMVIPCluster'
, @output_data_1_name = N'rxDtree_model'
with result sets ((model varbinary(max)));
end;
go
insert into CDNOW_rx_models (model)
exec generate_CDNOW_rx_Dtree;
update CDNOW_rx_models set model_name = 'rxDtree' where model_name = 'default model';
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
create procedure predict_CDNOW_IsVIP (@model varchar(100))
as
begin
declare @rx_model varbinary(max) = (select model from CDNOW_rx_models where model_name = @model);
-- Predict based on the specified model:
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);
'
, @input_data_1 = N'
select * from RFMVIPCluster'
, @input_data_1_name = N'RFMVIPCluster'
, @params = N'@rx_model varbinary(max)'
, @rx_model = @rx_model
with result sets ( ("ID" int, "IsVIP.Actual" int, "IsVIP.Expected" float)
);
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))
as
begin
declare @rx_model varbinary(max) = (select model from CDNOW_rx_models where model_name = @model);
-- Predict based on the specified model:
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);
'
, @input_data_1 = N'
select * from RFMVIPCluster'
, @input_data_1_name = N'RFMVIPCluster'
, @params = N'@rx_model varbinary(max)'
, @rx_model = @rx_model
with result sets ( ("ID" int, "Cluster.Actual" int, "Cluster1.Prob" float,"Cluster2.Prob" float,"Cluster3.Prob" float,"Cluster4.Prob" float,"Cluster5.Prob" float,"Cluster6.Prob" float,"Cluster7.Prob" float,"Cluster8.Prob" float)
);
end;
go
--execute the stored procedure to obtain the prediction on Cluster
exec predict_CDNOW_Cluster 'rxDtree';
go
Reference in New Issue View Git Blame Copy Permalink