library(caret) # try different size for training ii<-createDataPartition(iris$Species,p=2/3,list=F) x.train<-as.matrix(iris[ii,-5]) x.test<-as.matrix(iris[-ii,-5]) y<-as.factor(iris[,5]) y.train<-y[ii] y.test<-y[-ii] ### LDA cc<-train(x=x.train,y=y.train,method="lda") confusionMatrix(cc) # training error pp<-predict(cc,x.test) confusionMatrix(pp,y.test) # test error pp<-predict(cc,x.test,type="prob") pp$obs<-y.test head(pp) pp$pred<-predict(cc,x.test) AA<-multiClassSummary(pp,lev=levels(pp$obs)) ## summaries like specifity and sensitivity cc2<-train(x=x.train,y=y.train,method="rda") plot(cc2) # lda vs qda, lambda=1 vs 0. lda or qda vs nb, gamma=0 or 1. pp<-predict(cc2,x.test,type="prob") pp$obs<-y.test head(pp) pp$pred<-predict(cc2,x.test) AA<-rbind(AA,multiClassSummary(pp,lev=levels(pp$obs))) #### LDA DLDA regularization cc2<-train(x=x.train,y=y.train,method="sda") plot(cc2) pp<-predict(cc2,x.test,type="prob") pp$obs<-y.test head(pp) pp$pred<-predict(cc2,x.test) AA<-rbind(AA,multiClassSummary(pp,lev=levels(pp$obs))) #### sparse LDA #### ### xx<-normalize(iris[,-5]) yy<-as.factor(iris$Species) cc2<-train(x=xx$Xc[ii,],y=yy[ii],method="sparseLDA") plot(cc2) pp<-predict(cc2,xx$Xc[-ii,],type="prob") pp$obs<-yy[-ii] pp$pred<-predict(cc2,xx$Xc[-ii,]) AA<-rbind(AA,multiClassSummary(pp,lev=levels(pp$obs))) AA ###### library(caret) # try different size for training ii<-createDataPartition(iris$Species,p=.25,list=F) x.train<-as.matrix(iris[ii,-5]) x.test<-as.matrix(iris[-ii,-5]) y<-as.factor(iris[,5]) y.train<-y[ii] y.test<-y[-ii] ### LDA cc<-train(x=x.train,y=y.train,method="lda") confusionMatrix(cc) # training error pp<-predict(cc,x.test) confusionMatrix(pp,y.test) # test error pp<-predict(cc,x.test,type="prob") pp$obs<-y.test head(pp) pp$pred<-predict(cc,x.test) AA<-multiClassSummary(pp,lev=levels(pp$obs)) ## summaries like specifity and sensitivity cc2<-train(x=x.train,y=y.train,method="rda") plot(cc2) # lda vs qda, lambda=1 vs 0. lda or qda vs nb, gamma=0 or 1. pp<-predict(cc2,x.test,type="prob") pp$obs<-y.test head(pp) pp$pred<-predict(cc2,x.test) AA<-rbind(AA,multiClassSummary(pp,lev=levels(pp$obs))) #### LDA DLDA regularization cc2<-train(x=x.train,y=y.train,method="sda") plot(cc2) pp<-predict(cc2,x.test,type="prob") pp$obs<-y.test head(pp) pp$pred<-predict(cc2,x.test) AA<-rbind(AA,multiClassSummary(pp,lev=levels(pp$obs))) #### sparse LDA #### ### Y<-matrix(0,dim(iris)[1],3) Y[iris$Sp=="setosa",1]<-1 Y[iris$Sp=="versicolor",2]<-1 Y[iris$Sp=="virginica",3]<-1 colnames(Y)<-c("A","B","C") xc<-normalize(x.train) # This is needed for the penalties to mean the same for all variables.. ss<-spLDA(x=xc$Xc,y=Y[ii,],lambda=.0001,stop=3) # lambda controls the L2 regularization. # pp<-predict(ss,normalizetest(x.test,xc)) confusion(y.test,pp$class) plot(pp$x,col=y.test,pch=apply(pp$posterior,1,sort.list)[3,]) ss$beta ss$varNames ##### xx<-normalize(iris[,-5]) yy<-as.factor(iris$Species) cc2<-train(x=xx$Xc[ii,],y=yy[ii],method="sparseLDA") plot(cc2) pp<-predict(cc2,xx$Xc[-ii,],type="prob") pp$obs<-yy[-ii] pp$pred<-predict(cc2,xx$Xc[-ii,]) AA<-rbind(AA,multiClassSummary(pp,lev=levels(pp$obs))) AA ###### iAccL<-matrix(0,5,14) iAccQ<-matrix(0,5,14) iAccR<-matrix(0,5,14) iAccS<-matrix(0,5,14) iAccSp<-matrix(0,5,14) iAccM<-matrix(0,5,14) iRDAtune<-matrix(0,5,2) iMtune<-matrix(0,5,1) iStune<-matrix(0,5,2) iSptune<-matrix(0,5,2) for (b in (1:5)) { ii<-createDataPartition(iris$Species,p=.25,list=F) #play with different training sample sizes here.... x.train<-as.matrix(iris[ii,-5]) x.test<-as.matrix(iris[-ii,-5]) xx<-normalize(iris[,-5]) y<-as.factor(iris[,5]) y.train<-y[ii] y.test<-y[-ii] # cclda<-train(x=x.train,y=y.train,method="lda") pp<-predict(cclda,x.test,type="prob") pp$obs<-y.test pp$pred<-predict(cclda,x.test) iAccL[b,]<-multiClassSummary(pp,lev=levels(pp$obs)) # ccqda<-train(x=x.train,y=y.train,method="qda") pp<-predict(ccqda,x.test,type="prob") pp$obs<-y.test pp$pred<-predict(ccqda,x.test) iAccQ[b,]<-multiClassSummary(pp,lev=levels(pp$obs)) # ccrda<-train(x=x.train,y=y.train,method="rda") pp<-predict(ccrda,x.test,type="prob") pp$obs<-y.test pp$pred<-predict(ccrda,x.test) iAccR[b,]<-multiClassSummary(pp,lev=levels(pp$obs)) iRDAtune[b,1]<-ccrda$bestTune$gamma iRDAtune[b,2]<-ccrda$bestTune$lambda # # ccsda<-train(x=x.train,y=y.train,method="sda") pp<-predict(ccsda,x.test,type="prob") pp$obs<-y.test pp$pred<-predict(ccsda,x.test) iAccS[b,]<-multiClassSummary(pp,lev=levels(pp$obs)) iStune[b,1]<-ccsda$bestTune$diagonal iStune[b,2]<-ccsda$bestTune$lambda # ccspda<-train(x=xx$Xc[ii,],y=y.train,method="sparseLDA") pp<-predict(ccspda,xx$Xc[-ii,],type="prob") pp$obs<-y.test pp$pred<-predict(ccspda,xx$Xc[-ii,]) iAccSp[b,]<-multiClassSummary(pp,lev=levels(pp$obs)) iSptune[b,1]<-ccspda$bestTune$NumVars iSptune[b,2]<-ccspda$bestTune$lambda # # ccmda<-train(x=x.train,y=y.train,method="mda") pp<-predict(ccmda,x.test,type="prob") pp$obs<-y.test pp$pred<-predict(ccmda,x.test) iAccM[b,]<-multiClassSummary(pp,lev=levels(pp$obs)) iMtune[b,1]<-ccmda$bestTune$subclasses # print(b) } # comparing methods par(mfrow=c(2,2)) boxplot(cbind(iAccL[,4],iAccQ[,4],iAccR[,4],iAccS[,4],iAccSp[,4],iAccM[,4]),names=c("LDA","QDA","RDA","SDA","spLDA","MDA"),main="Accuracy") boxplot(cbind(iAccL[,2],iAccQ[,2],iAccR[,2],iAccS[,2],iAccSp[,4],iAccM[,2]),names=c("LDA","QDA","RDA","SDA","spLDA","MDA"),main="AUC") boxplot(cbind(iAccL[,7],iAccQ[,7],iAccR[,7],iAccS[,7],iAccSp[,4],iAccM[,7]),names=c("LDA","QDA","RDA","SDA","spLDA","MDA"),main="Sensititivy") boxplot(cbind(iAccL[,8],iAccQ[,8],iAccR[,8],iAccS[,8],iAccSp[,4],iAccM[,8]),names=c("LDA","QDA","RDA","SDA","spLDA","MDA"),main="Specificity") # tuning parameters used par(mfrow=c(2,2)) boxplot(iRDAtune,names=c("gamma","lambda")) boxplot(iMtune,names=c("subclasses")) boxplot(iStune,names=c("diagonal","lambda")) boxplot(iSptune,names=c("NumVars","lambda"))