Hi Hemant,
Here is an example that might answer your questions. Please don't run
previous code as it might not work.
I define the break values as arguments to the function
(rbreaks,fbreaks,mbreaks) If you want the breaks to work, make sure that
they cover the range of the input values, otherwise you get NAs.
# expects a three (or more) column data frame where
# column 1 is customer ID, column 2 is amount of purchase
# and column 3 is date of purchase
qdrfm<-function(x,rbreaks=3,fbreaks=3,mbreaks=3,date.format="%Y-%m-%d",
weights=c(1,1,1),finish=NA) {
# if no finish date is specified, use current date
if(is.na(finish)) finish<-as.Date(date(), "%a %b %d %H:%M:%S %Y")
x$rscore<-as.numeric(finish-as.Date(x[,3],date.format))
x$rscore<-as.numeric(cut(x$rscore,breaks=rbreaks,labels=FALSE))
custIDs<-unique(x[,1])
ncust<-length(custIDs)
rfmout<-data.frame(custID=custIDs,rscore=rep(0,ncust),
fscore=rep(0,ncust),mscore=rep(0,ncust))
rfmout$rscore<-cut(by(x$rscore,x[,1],min),breaks=rbreaks,labels=FALSE)
rfmout$fscore<-cut(table(x[,1]),breaks=fbreaks,labels=FALSE)
rfmout$mscore<-cut(by(x[,2],x[,1],sum),breaks=mbreaks,labels=FALSE)
rfmout$cscore<-(weights[1]*rfmout$rscore+
weights[2]*rfmout$fscore+
weights[3]*rfmout$mscore)/sum(weights)
return(rfmout[order(rfmout$cscore),])
}
set.seed(12345)
x2<-data.frame(ID=sample(1:50,250,TRUE),
purchase=round(runif(250,5,100),2),
date=paste(rep(2016,250),sample(1:12,250,TRUE),
sample(1:28,250,TRUE),sep="-"))
# example 1
qdrfm(x2)
# example 2
qdrfm(x2,rbreaks=c(0,200,400),fbreaks=c(0,5,10),mbreaks=c(0,350,700),
finish=as.Date("2017-01-01"))
Jim
[[alternative HTML version deleted]]
______________________________________________
R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
