Nothing
regVarImp <- function(model, xTrain, yTrain, xTest, fitControl, myTimeLimit, no.cores, lk_col, supress.output){
resultVarImpListCombREG <- NULL
resultVarImpListCombREG <- list()
regVarImpFuncRES <- NULL
regVarImpFuncRES <- list()
myTimeLimitSet <- myTimeLimit
fitControlSet <- fitControl
lk_col <- lk_col
supress.output <- supress.output
no.cores <- no.cores
regVarPred <- function(funcRegPred) {
#Print out function names
cat("----------------------------------------\n")
cat("Calculating: ", funcRegPred,"\n")
cat("----------------------------------------\n")
if(.Platform$OS.type != "windows"){
outfile<-paste(tempdir(),"/",(lk_col-1),"in_default_REGControl_", paste(funcRegPred),".RData",sep="")
outfileImp<-paste(tempdir(),"/",(lk_col-1),"in_default_REGControl_VarImp_", paste(funcRegPred),".txt",sep="")
} else if(.Platform$OS.type == "windows") {
outfile<-paste(tempdir(),"\\",(lk_col-1),"in_default_REGControl_", paste(funcRegPred),".RData",sep="")
outfileImp<-paste(tempdir(),"\\",(lk_col-1),"in_default_REGControl_VarImp_", paste(funcRegPred),".txt",sep="")
}
# print(outfile)
# print(outfileImp)
#start feature selection method
timer1 <- proc.time()
if(.Platform$OS.type !="windows"){
if(supress.output==TRUE){
# Supress output
sink("/dev/null")
res <- invisible(try(timeout(train(xTrain,yTrain, method=funcRegPred, trControl=fitControlSet),seconds=myTimeLimitSet),silent=TRUE))
sink()
} else {
res <- invisible(try(timeout(train(xTrain,yTrain, method=funcRegPred, trControl=fitControlSet),seconds=myTimeLimitSet),silent=TRUE))
}
} else if (.Platform$OS.type == "windows"){
if(supress.output==TRUE){
# Supress output
sink("NUL")
res <- try(train(xTrain,yTrain, method=funcRegPred, trControl=fitControlSet),silent=TRUE)
sink()
} else {
res <- try(train(xTrain,yTrain, method=funcRegPred, trControl=fitControlSet),silent=TRUE)
}
}
timer2 <- proc.time() - timer1
variableImportanceRes <- try(varImp(res$finalModel),silent=TRUE)
resultVarImpListCombREG[funcRegPred] <- try(list(variableImportanceRes),silent=TRUE)
cat("----------------------------------------\n")
cat("",funcRegPred,"\n")
cat("----------------------------------------\n")
cat("Elapsed time: ",timer2,"\n")
# cat("Variable importance: \n")
if((class(res) != "try-error")&&(class(variableImportanceRes) != "try-error")){
# save results
save(res, file=outfile)
write.table(variableImportanceRes, col.names=TRUE, row.names=TRUE, quote=FALSE, sep="\t", file=outfileImp)
} else if(class(res) != "try-error"){
yPred <- try(predict(res,xTest),silent=TRUE)
if(class(yPred)!="try-error"){
variableImportanceRes <- try(filterVarImp(xTest,yPred,nonpara=TRUE),silent=TRUE)
if(class(variableImportanceRes)!="try-error") {
resultVarImpListCombREG[funcRegPred] <- try(list(variableImportanceRes),silent=TRUE)
try(write.table(variableImportanceRes,col.names=TRUE, row.names=TRUE, quote=FALSE, sep="\t", file=outfileImp))
} else if(class(variableImportanceRes)=="try-error") {
print("Predicting variable importance (first try) has failed!")
resultVarImpListCombREG[funcRegPred] <- try(list(NA),silent=TRUE)
}
}
if((class(res)!="try-error") && (class(variableImportanceRes) != "try-error")){
# save results
try(save(res, file=outfile),silent=TRUE)
try(write.table(variableImportanceRes,col.names=TRUE, row.names=TRUE, quote=FALSE, sep="\t", file=outfileImp))
}
if ((class(res)!="try-error") && (class(variableImportanceRes) == "try-error")){
variableImportanceRes <- try(varImp(res),silent=TRUE)
resultVarImpListCombREG[funcRegPred] <- try(list(variableImportanceRes$importance),silent=TRUE)
# save results
try(save(res, file=outfile),silent=TRUE)
try(write.table(variableImportanceRes$importance,col.names=TRUE, row.names=TRUE, quote=FALSE, sep="\t", file=outfileImp))
}
} else if (class(variableImportanceRes) == "try-error"){
variableImportanceRes <- try(varImp(res),silent=TRUE)
if(class(variableImportanceRes)!="try-error") {
resultVarImpListCombREG[funcRegPred] <- try(list(variableImportanceRes$importance),silent=TRUE)
# save results
try(save(res, file=outfile),silent=TRUE)
try(write.table(variableImportanceRes$importance,col.names=TRUE, row.names=TRUE, quote=FALSE, sep="\t", file=outfileImp))
} else if(class(variableImportanceRes)!="try-error"){
yPred <- try(predict(res,xTest),silent=TRUE)
if(class(yPred)!="try-error"){
variableImportanceRes <- try(filterVarImp(xTest,yPred,nonpara=TRUE),silent=TRUE)
if(class(variableImportanceRes)!="try-error") {
resultVarImpListCombREG[funcRegPred] <- try(list(variableImportanceRes),silent=TRUE)
try(write.table(variableImportanceRes,col.names=TRUE, row.names=TRUE, quote=FALSE, sep="\t", file=outfileImp))
} else if(class(variableImportanceRes)=="try-error") {
print("Predicting variable importance (second try) has failed!")
resultVarImpListCombREG[funcRegPred] <- try(list(NA),silent=TRUE)
}
}
} else if(class(res)=="try-error"){
print("Building model has failed or reached timelimit!")
resultVarImpListCombREG[funcRegPred] <- try(list(NA),silent=TRUE)
}
} else {
print("Predicting variable importance (third try) has failed!")
resultVarImpListCombREG[funcRegPred] <- try(list(NA),silent=TRUE)
}
# Last check to get all possible varImp
tmpSum <- sum(variableImportanceRes[,1])
if(tmpSum == 0){
variableImportanceRes <- try(varImp(res),silent=TRUE)
resultVarImpListCombREG[funcRegPred] <- try(list(variableImportanceRes$importance),silent=TRUE)
try(write.table(variableImportanceRes$importance,col.names=TRUE, row.names=TRUE, quote=FALSE, sep="\t", file=outfileImp))
}
if(class(variableImportanceRes)!="try-error"){
# Print out variable importance
# try(print(variableImportanceRes),silent=TRUE)
cat("Variable importance has been calculated! \n")
} else if(class(variableImportanceRes)=="try-error"){
print("Predicting variable importance (fourth try) has failed!")
resultVarImpListCombREG[funcRegPred] <- try(list(NA),silent=TRUE)
}
if((file.exists(paste(outfile))) || file.exists(outfileImp)){
# general check for files RData and VarImp.txt
if(((file.exists(paste(outfile)))==FALSE) || (file.exists(outfileImp)==FALSE)){
try(file.remove(paste(outfile)))
try(file.remove(paste(outfileImp)))
} else {
print("RData and VarImp.txt files exists!")
cat("Variable importance: \n")
try(print(variableImportanceRes),silent=TRUE)
}
}
}
# resultVarImpListCombREG[model] <- mclapply(model,regVarPred, mc.preschedule=TRUE, mc.cores=no.cores, mc.set.seed=TRUE, mc.cleanup=TRUE, mc.allow.recursive=TRUE)
if (.Platform$OS.type == "windows"){
# Windows parallel implementation
# require(snow)
# Spawn child processes using fork()
# cl <- makeCluster(no.cores, type="SOCK")
# Run function
# resultVarImpListCombREG[model] <- parLapply(cl, model, regVarPred)
# Stop cluster and kill child processes
# stopCluster(cl)
resultVarImpListCombREG[model] <- lapply(model,regVarPred)
} else if (.Platform$OS.type != "windows"){
# POSIX OS parallel implementation
resultVarImpListCombREG[model] <- mclapply(model,regVarPred,
mc.preschedule=FALSE, mc.cores=no.cores, mc.cleanup=FALSE)
}
# Return variable importance or NULL
for(i in 1:length(resultVarImpListCombREG)){
if(class(resultVarImpListCombREG[i])=="try-error"){
resultVarImpListCombREG[i] <- NULL
}
}
return(resultVarImpListCombREG)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.