## ---- include = FALSE--------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup-------------------------------------------------------------------- library(TPLSr) attach(TPLSdat) ## ----------------------------------------------------------------------------- sum(mask) ## ----------------------------------------------------------------------------- cvmdl = TPLS_cv(X,Y,subj) ## ----------------------------------------------------------------------------- compvec = 1:25 ## ----------------------------------------------------------------------------- threshvec = seq(0,1,by=0.05) ## ----------------------------------------------------------------------------- subfold = run; ## ----------------------------------------------------------------------------- cvstats = evalTuningParam(cvmdl,'AUC',X,Y,compvec,threshvec,subfold); ## ----------------------------------------------------------------------------- cvstats$compval_best cvstats$threshval_best ## ----------------------------------------------------------------------------- mdl = TPLS(X,Y,8); ## ----------------------------------------------------------------------------- plot(mdl$pctVar); plot(mdl$scoreCorr) ## ----------------------------------------------------------------------------- compval = cvstats$compval_best; threshval = cvstats$threshval_best; result = makePredictor(mdl,compval,threshval); ## ----------------------------------------------------------------------------- sum(result$betamap!=0) ## ----------------------------------------------------------------------------- prediction = X %*% result$betamap; stats::cor(prediction,Y) # 0.63 correlation! In-sample though so not that impressive plot(prediction,Y) ## ----------------------------------------------------------------------------- prediction = TPLSpredict(mdl,compval,threshval,X) ## ----------------------------------------------------------------------------- mymap = mask mymap[mask==1] = result$betamap ## ----------------------------------------------------------------------------- heatmap(1*mask[,15,], Colv = NA, Rowv = NA,scale ="none") heatmap(mymap[,15,], Colv = NA, Rowv = NA,scale ="none")