Nothing
CoxBenchmark <- function(theData = NULL, theOutcome = "Class", reps = 100, trainFraction = 0.5,referenceCV = NULL,referenceName = "Reference",referenceFilterName="COX.BSWiMS")
{
if (!requireNamespace("BeSS", quietly = TRUE)) {
install.packages("BeSS", dependencies = TRUE)
}
if (!requireNamespace("survminer", quietly = TRUE)) {
install.packages("survminer", dependencies = TRUE)
}
if (is.null(theData))
{
if (exists("theDataSet", envir=FRESAcacheEnv))
{
theData <- get("theDataSet", envir=FRESAcacheEnv);
theOutcome <- get("theDataOutcome", envir=FRESAcacheEnv);
}
}
else
{
assign("theDataSet",theData,FRESAcacheEnv);
assign("theDataOutcome",theOutcome,FRESAcacheEnv);
}
aucTable <- NULL
accciTable <- NULL
errorciTable <- NULL
senTable <- NULL
speTable <- NULL
aucTable_filter <- NULL
accciTable_filter <- NULL
errorciTable_filter <- NULL
senTable_filter <- NULL
speTable_filter <- NULL
CIRisksTable <- NULL
LogRankTable <- NULL
CIRisksTable_filter <- NULL
LogRankTable_filter <- NULL
fmeth_0 <- NULL;
FilterMethod <- function(clasfun = survival::coxph, classname = "", center = FALSE, ...)
{
#rcvFilter_reference <- cpFinal$TheCVEvaluations$Reference$testPredictions
rcvFilter_reference <- FRESA.CAD::randomCV(theData,theOutcome,clasfun,trainSampleSets = referenceCV$trainSamplesSets,featureSelectionFunction = referenceCV$selectedFeaturesSet);
cStats <- predictionStats_survival(rcvFilter_reference$survMedianTest,plotname="Cox with BSWiMS");
CIRisksTable_filter <- rbind(CIRisksTable_filter,cStats$CIRisk);
LogRankTable_filter <- rbind(LogRankTable_filter,cStats$LogRank);
#Stats binary
#cambiar a median antes de subir
#rcvFilter_reference <- cpFinal$TheCVEvaluations$COX.Reference
binaryPreds <- rcvFilter_reference$survMedianTest[,c("Outcome","LinearPredictorsMedian")]
binaryStats <- predictionStats_binary(binaryPreds,"Cox with BSWiMS")
accciTable_filter <- rbind(accciTable_filter,binaryStats$accc)
errorciTable_filter <- rbind(errorciTable_filter,binaryStats$berror)
aucTable_filter <- rbind(aucTable_filter,binaryStats$aucs)
senTable_filter <- rbind(senTable_filter,binaryStats$sensitivity)
speTable_filter <- rbind(speTable_filter,binaryStats$specificity)
rcvFilter_LASSO <- try(FRESA.CAD::randomCV(theData,theOutcome,clasfun,trainSampleSets = referenceCV$trainSamplesSets,featureSelectionFunction = rcvLASSO$selectedFeaturesSet));
if (!inherits(rcvLASSO, "try-error"))
{
cStats <- predictionStats_survival(rcvFilter_LASSO$survMedianTest,plotname="Cox with LASSO");
CIRisksTable_filter <- rbind(CIRisksTable_filter,cStats$CIRisk);
LogRankTable_filter <- rbind(LogRankTable_filter,cStats$LogRank);
#Stats binary
binaryPreds <- rcvFilter_LASSO$survMedianTest[,c("Outcome","LinearPredictorsMedian")]
binaryStats <- predictionStats_binary(binaryPreds,"Cox with Lasso")
accciTable_filter <- rbind(accciTable_filter,binaryStats$accc)
errorciTable_filter <- rbind(errorciTable_filter,binaryStats$berror)
aucTable_filter <- rbind(aucTable_filter,binaryStats$aucs)
senTable_filter <- rbind(senTable_filter,binaryStats$sensitivity)
speTable_filter <- rbind(speTable_filter,binaryStats$specificity)
}
rcvFilter_BESS <- try(FRESA.CAD::randomCV(theData,theOutcome,clasfun,trainSampleSets = referenceCV$trainSamplesSets,featureSelectionFunction = rcvBESS$selectedFeaturesSet));
if (!inherits(rcvLASSO, "try-error"))
{
cStats <- predictionStats_survival(rcvFilter_BESS$survMedianTest,plotname="Cox with BESS");
CIRisksTable_filter <- rbind(CIRisksTable_filter,cStats$CIRisk);
LogRankTable_filter <- rbind(LogRankTable_filter,cStats$LogRank);
#Stats binary
binaryStats <- predictionStats_binary(rcvFilter_BESS$survMedianTest[,c("Outcome","LinearPredictorsMedian")],"Cox with BeSS")
accciTable_filter <- rbind(accciTable_filter,binaryStats$accc)
errorciTable_filter <- rbind(errorciTable_filter,binaryStats$berror)
aucTable_filter <- rbind(aucTable_filter,binaryStats$aucs)
senTable_filter <- rbind(senTable_filter,binaryStats$sensitivity)
speTable_filter <- rbind(speTable_filter,binaryStats$specificity)
}
cat("Univariate cox Feature Selection: ");
rcvFilter_UniCox <- try(FRESA.CAD::randomCV(theData,theOutcome,clasfun,trainSampleSets = referenceCV$trainSamplesSets,featureSelectionFunction = univariate_cox));
if (!inherits(rcvLASSO, "try-error"))
{
cStats <- predictionStats_survival(rcvFilter_UniCox$survMedianTest,"Cox with Univariate cox Feature Selection");
CIRisksTable_filter <- rbind(CIRisksTable_filter,cStats$CIRisk);
LogRankTable_filter <- rbind(LogRankTable_filter,cStats$LogRank);
#Stats binary
binaryStats <- predictionStats_binary(rcvFilter_UniCox$survMedianTest[,c("Outcome","LinearPredictorsMedian")],"Unicox")
accciTable_filter <- rbind(accciTable_filter,binaryStats$accc)
errorciTable_filter <- rbind(errorciTable_filter,binaryStats$berror)
aucTable_filter <- rbind(aucTable_filter,binaryStats$aucs)
senTable_filter <- rbind(senTable_filter,binaryStats$sensitivity)
speTable_filter <- rbind(speTable_filter,binaryStats$specificity)
}
result <- list(CIRisksTable_filter = CIRisksTable_filter,
LogRankTable_filter = LogRankTable_filter,
accciTable_filter = accciTable_filter,
errorciTable_filter = errorciTable_filter,
aucTable_filter = aucTable_filter,
senTable_filter = senTable_filter,
speTable_filter = speTable_filter,
rcvFilter_reference = rcvFilter_reference,
rcvFilter_LASSO = rcvFilter_LASSO,
rcvFilter_BESS = rcvFilter_BESS,
rcvFilter_UniCox = rcvFilter_UniCox
)
return(result);
}
######################Classification Algorithms####################################
theFiltersets <- character();
theClassMethod <- character();
elapcol <- character();
cputimes <- list();
jaccard <- NULL;
featsize <- NULL;
TheCVEvaluations = list();
times <- list();
jaccard_filter <- list();
selFrequency <- data.frame(colnames(theData));
rownames(selFrequency) <- colnames(theData);
if (is.null(referenceCV))
{
cat("Modeling BSWiMS: + Model found, - No Model \n");
referenceCV <- FRESA.CAD::randomCV(theData,theOutcome,BSWiMS.model,trainFraction = trainFraction,repetitions = reps,featureSelectionFunction = "Self");
referenceName = "BSWiMS";
referenceFilterName = "Cox.BSWiMS";
methods <- c(referenceName);
theFiltersets <- c(referenceName);
}
if (inherits(referenceCV,"list"))
{
elapcol <- names(referenceCV[[1]]$theTimes) == "elapsed"
TheCVEvaluations <- referenceCV;
for (i in 1:length(referenceCV))
{
cStats <- predictionStats_survival(referenceCV[[i]]$survMedianTest,plotname = names(referenceCV)[i]);
CIRisksTable <- rbind(CIRisksTable,cStats$CIRisk);
LogRankTable <- rbind(LogRankTable,cStats$LogRank);
#referenceCV <- cpFinal$TheCVEvaluations$Reference
binaryPreds <- referenceCV[[i]]$survMedianTest[,c("Outcome","LinearPredictorsMedian")]
binaryStats <- predictionStats_binary(binaryPreds,"BSWiMS")
accciTable <- rbind(accciTable,binaryStats$accc)
errorciTable <- rbind(errorciTable,binaryStats$berror)
aucTable <- rbind(aucTable,binaryStats$aucs);
senTable <- rbind(senTable,binaryStats$sensitivity);
speTable <- rbind(speTable,binaryStats$specificity);
cputimes[[i]] = mean(referenceCV[[i]]$theTimes[ elapcol ]);
times[[i]] <- referenceCV[[i]]$theTimes;
selFrequency <- cbind(selFrequency,numeric(ncol(theData)));
selFrequency[names(referenceCV[[i]]$featureFrequency),ncol(selFrequency)] <- referenceCV[[i]]$featureFrequency;
jaccard_filter[[i]] <- referenceCV[[i]]$jaccard;
}
referenceName <- names(referenceCV);
referenceFilterName <- paste("FS",names(referenceCV),sep="_");
referenceCV <- referenceCV[[1]];
class(referenceCV) <- "list"
}
else
{
cStats <- predictionStats_survival(referenceCV$survMedianTest,plotname = referenceName);
CIRisksTable <- rbind(CIRisksTable,cStats$CIRisk);
LogRankTable <- rbind(LogRankTable,cStats$LogRank);
binaryPreds <- referenceCV$survMedianTest[,c("Outcome","LinearPredictorsMedian")]
binaryStats <- predictionStats_binary(binaryPreds,"BSWiMS")
accciTable <- rbind(accciTable,binaryStats$accc)
errorciTable <- rbind(errorciTable,binaryStats$berror)
aucTable <- rbind(aucTable,binaryStats$aucs)
senTable <- rbind(senTable,binaryStats$sensitivity)
speTable <- rbind(speTable,binaryStats$specificity)
TheCVEvaluations$Reference <- referenceCV;
times[[1]] <- referenceCV$theTimes;
elapcol <- names(referenceCV$theTimes) == "elapsed"
cputimes[[1]] = mean(referenceCV$theTimes[ elapcol ]);
selFrequency <- cbind(selFrequency,numeric(ncol(theData)));
selFrequency[names(referenceCV$featureFrequency),ncol(selFrequency)] <- referenceCV$featureFrequency;
jaccard_filter[[1]] <- referenceCV$jaccard;
}
reps <- referenceCV$repetitions;
######################Predictions union ####################################
test_Predictions <- referenceCV$survMedianTest;
tnames <- rownames(test_Predictions)
# 1 - pchisq(cStats$LogRank$chisq, length(cStats$LogRank$n) - 1)
######################LASSO####################################
rcvLASSO <- try(FRESA.CAD::randomCV(theData,theOutcome,LASSO_MIN,trainSampleSets = referenceCV$trainSamplesSets,featureSelectionFunction = "Self"));
if (!inherits(rcvLASSO, "try-error"))
{
methods <- cbind(methods,"LASSO");
cStats <- predictionStats_survival(rcvLASSO$survMedianTest,plotname = "LASSO");
CIRisksTable <- rbind(CIRisksTable,cStats$CIRisk);
LogRankTable <- rbind(LogRankTable,cStats$LogRank);
#rcvLASSO <- cpFinal$TheCVEvaluations$LASSO
binaryPreds <- rcvLASSO$survMedianTest[,c("Outcome","LinearPredictorsMedian")]
binaryStats <- predictionStats_binary(binaryPreds,"Lasso")
accciTable <- rbind(accciTable,binaryStats$accc)
errorciTable <- rbind(errorciTable,binaryStats$berror)
aucTable <- rbind(aucTable,binaryStats$aucs)
senTable <- rbind(senTable,binaryStats$sensitivity)
speTable <- rbind(speTable,binaryStats$specificity)
TheCVEvaluations$LASSO <- rcvLASSO;
times$LASSO <- rcvLASSO$theTimes
selFrequency <- cbind(selFrequency,numeric(ncol(theData)));
selFrequency[names(rcvLASSO$featureFrequency),ncol(selFrequency)] <- rcvLASSO$featureFrequency;
theFiltersets <- c(theFiltersets,"LASSO");
jaccard_filter$LASSO <- rcvLASSO$jaccard;
test_Predictions <- cbind(test_Predictions,rcvLASSO$survMedianTest[tnames,3],rcvLASSO$survMedianTest[tnames,4],rcvLASSO$survMedianTest[tnames,5],rcvLASSO$survMedianTest[tnames,6])
cputimes$LASSO = mean(rcvLASSO$theTimes[ elapcol ])
}
######################GLMNET_RIDGE####################################
rcvGLMNET_RIDGE <- try(FRESA.CAD::randomCV(theData,theOutcome,GLMNET_RIDGE_MIN,trainSampleSets = referenceCV$trainSamplesSets,featureSelectionFunction = "Self"));
if (!inherits(rcvGLMNET_RIDGE, "try-error"))
{
methods <- cbind(methods,"RIDGE");
cStats <- predictionStats_survival(rcvGLMNET_RIDGE$survMedianTest,plotname = "GLMNET_RIDGE");
CIRisksTable <- rbind(CIRisksTable,cStats$CIRisk);
LogRankTable <- rbind(LogRankTable,cStats$LogRank);
#rcvGLMNET_RIDGE <- cpFinal$TheCVEvaluations$GLMNET_RIDGE
binaryPreds <- rcvGLMNET_RIDGE$survMedianTest[,c("Outcome","LinearPredictorsMedian")]
binaryStats <- predictionStats_binary(binaryPreds,"Ridge")
accciTable <- rbind(accciTable,binaryStats$accc)
errorciTable <- rbind(errorciTable,binaryStats$berror)
aucTable <- rbind(aucTable,binaryStats$aucs)
senTable <- rbind(senTable,binaryStats$sensitivity)
speTable <- rbind(speTable,binaryStats$specificity)
TheCVEvaluations$RIDGE <- rcvGLMNET_RIDGE;
times$RIDGE <- rcvGLMNET_RIDGE$theTimes
selFrequency <- cbind(selFrequency,numeric(ncol(theData)));
selFrequency[names(rcvGLMNET_RIDGE$featureFrequency),ncol(selFrequency)] <- rcvGLMNET_RIDGE$featureFrequency;
theFiltersets <- c(theFiltersets,"RIDGE");
jaccard_filter$RIDGE <- rcvGLMNET_RIDGE$jaccard;
test_Predictions <- cbind(test_Predictions,rcvGLMNET_RIDGE$survMedianTest[tnames,3],rcvGLMNET_RIDGE$survMedianTest[tnames,4],rcvGLMNET_RIDGE$survMedianTest[tnames,5],rcvGLMNET_RIDGE$survMedianTest[tnames,6])
cputimes$RIDGE = mean(rcvGLMNET_RIDGE$theTimes[ elapcol ])
}
######################GLMNET_ELASTICNET####################################
rcvGLMNET_ELASTICNET <- try(FRESA.CAD::randomCV(theData,theOutcome,GLMNET_ELASTICNET_MIN,trainSampleSets = referenceCV$trainSamplesSets,featureSelectionFunction = "Self"));
if (!inherits(rcvGLMNET_ELASTICNET, "try-error"))
{
methods <- cbind(methods,"ELASTICNET");
cStats <- predictionStats_survival(rcvGLMNET_ELASTICNET$survMedianTest,plotname = "GLMNET_ELASTICNET");
CIRisksTable <- rbind(CIRisksTable,cStats$CIRisk);
LogRankTable <- rbind(LogRankTable,cStats$LogRank);
#rcvGLMNET_ELASTICNET <- cpFinal$TheCVEvaluations$GLMNET_ELASTICNET
binaryPreds <- rcvGLMNET_ELASTICNET$survMedianTest[,c("Outcome","LinearPredictorsMedian")]
binaryStats <- predictionStats_binary(binaryPreds,"ElasticNet")
accciTable <- rbind(accciTable,binaryStats$accc)
errorciTable <- rbind(errorciTable,binaryStats$berror)
aucTable <- rbind(aucTable,binaryStats$aucs)
senTable <- rbind(senTable,binaryStats$sensitivity)
speTable <- rbind(speTable,binaryStats$specificity)
TheCVEvaluations$ELASTICNET <- rcvGLMNET_ELASTICNET;
times$ELASTICNET <- rcvGLMNET_ELASTICNET$theTimes
selFrequency <- cbind(selFrequency,numeric(ncol(theData)));
selFrequency[names(rcvGLMNET_ELASTICNET$featureFrequency),ncol(selFrequency)] <- rcvGLMNET_ELASTICNET$featureFrequency;
theFiltersets <- c(theFiltersets,"ELASTICNET");
jaccard_filter$ELASTICNET <- rcvGLMNET_ELASTICNET$jaccard;
test_Predictions <- cbind(test_Predictions,rcvGLMNET_ELASTICNET$survMedianTest[tnames,3],rcvGLMNET_ELASTICNET$survMedianTest[tnames,4],rcvGLMNET_ELASTICNET$survMedianTest[tnames,5],rcvGLMNET_ELASTICNET$survMedianTest[tnames,6])
cputimes$ELASTICNET = mean(rcvGLMNET_ELASTICNET$theTimes[ elapcol ])
}
######################BESS####################################
rcvBESS <- try(FRESA.CAD::randomCV(theData,theOutcome,BESS,trainSampleSets = referenceCV$trainSamplesSets,featureSelectionFunction = "Self",method="gsection"));
if (!inherits(rcvBESS, "try-error"))
{
methods <- cbind(methods,"BESS");
cStats <- predictionStats_survival(rcvBESS$survMedianTest,plotname = "BeSS");
CIRisksTable <- rbind(CIRisksTable,cStats$CIRisk);
LogRankTable <- rbind(LogRankTable,cStats$LogRank);
binaryPreds <- rcvBESS$survMedianTest[,c("Outcome","LinearPredictorsMedian")];
binaryStats <- predictionStats_binary(binaryPreds,"BeSS");
accciTable <- rbind(accciTable,binaryStats$accc);
errorciTable <- rbind(errorciTable,binaryStats$berror);
aucTable <- rbind(aucTable,binaryStats$aucs);
senTable <- rbind(senTable,binaryStats$sensitivity);
speTable <- rbind(speTable,binaryStats$specificity);
TheCVEvaluations$BESS <- rcvBESS;
times$BESS <- rcvBESS$theTimes
selFrequency <- cbind(selFrequency,numeric(ncol(theData)));
selFrequency[names(rcvBESS$featureFrequency),ncol(selFrequency)] <- rcvBESS$featureFrequency;
theFiltersets <- c(theFiltersets,"BESS");
jaccard_filter$BESS <- rcvBESS$jaccard;
test_Predictions <- cbind(test_Predictions,rcvBESS$survMedianTest[tnames,3],rcvBESS$survMedianTest[tnames,4],rcvBESS$survMedianTest[tnames,5],rcvBESS$survMedianTest[tnames,6])
cputimes$BESS = mean(rcvBESS$theTimes[ elapcol ])
}
######################BESS SEQUENTIAL####################################
rcvBESSSequential <- try(FRESA.CAD::randomCV(theData,theOutcome,BESS,trainSampleSets = referenceCV$trainSamplesSets,featureSelectionFunction = "Self",method="sequential",ic.type="GIC"));
if (!inherits(rcvBESSSequential, "try-error"))
{
methods <- cbind(methods,"BeSS.SEQUENTIAL");
cStats <- predictionStats_survival(rcvBESSSequential$survMedianTest,plotname = "BeSS.SEQUENTIAL");
CIRisksTable <- rbind(CIRisksTable,cStats$CIRisk);
LogRankTable <- rbind(LogRankTable,cStats$LogRank);
binaryPreds <- rcvBESSSequential$survMedianTest[,c("Outcome","LinearPredictorsMedian")];
binaryStats <- predictionStats_binary(binaryPreds,"BeSS.SEQUENTIAL");
accciTable <- rbind(accciTable,binaryStats$accc);
errorciTable <- rbind(errorciTable,binaryStats$berror);
aucTable <- rbind(aucTable,binaryStats$aucs);
senTable <- rbind(senTable,binaryStats$sensitivity);
speTable <- rbind(speTable,binaryStats$specificity);
TheCVEvaluations$BESS.SEQUENTIAL <- rcvBESSSequential;
times$BESS.SEQUENTIAL <- rcvBESSSequential$theTimes
selFrequency <- cbind(selFrequency,numeric(ncol(theData)));
selFrequency[names(rcvBESSSequential$featureFrequency),ncol(selFrequency)] <- rcvBESSSequential$featureFrequency;
theFiltersets <- c(theFiltersets,"BESS.SEQUENTIAL");
jaccard_filter$BESS.SEQUENTIAL <- rcvBESSSequential$jaccard;
test_Predictions <- cbind(test_Predictions,rcvBESSSequential$survMedianTest[tnames,3],rcvBESSSequential$survMedianTest[tnames,4],rcvBESSSequential$survMedianTest[tnames,5],rcvBESSSequential$survMedianTest[tnames,6])
cputimes$BESS.SEQUENTIAL = mean(rcvBESSSequential$theTimes[ elapcol ])
}
######################BESS SEQUENTIAL BIC####################################
rcvBESSSequentialBIC <- try(FRESA.CAD::randomCV(theData,theOutcome,BESS,trainSampleSets = referenceCV$trainSamplesSets,featureSelectionFunction = "Self"));
if (!inherits(rcvBESSSequentialBIC, "try-error"))
{
methods <- cbind(methods,"BeSS.SEQUENTIAL.BIC");
cStats <- predictionStats_survival(rcvBESSSequentialBIC$survMedianTest,plotname = "BeSS.SEQUENTIAL.BIC");
CIRisksTable <- rbind(CIRisksTable,cStats$CIRisk);
LogRankTable <- rbind(LogRankTable,cStats$LogRank);
binaryPreds <- rcvBESSSequentialBIC$survMedianTest[,c("Outcome","LinearPredictorsMedian")]
binaryStats <- predictionStats_binary(binaryPreds,"BeSS.SEQUENTIAL.BIC")
accciTable <- rbind(accciTable,binaryStats$accc);
errorciTable <- rbind(errorciTable,binaryStats$berror);
aucTable <- rbind(aucTable,binaryStats$aucs);
senTable <- rbind(senTable,binaryStats$sensitivity);
speTable <- rbind(speTable,binaryStats$specificity);
TheCVEvaluations$BESS.SEQUENTIAL.BIC <- rcvBESSSequentialBIC;
times$BESS.SEQUENTIAL.BIC <- rcvBESSSequentialBIC$theTimes
selFrequency <- cbind(selFrequency,numeric(ncol(theData)));
selFrequency[names(rcvBESSSequentialBIC$featureFrequency),ncol(selFrequency)] <- rcvBESSSequentialBIC$featureFrequency;
theFiltersets <- c(theFiltersets,"BESS.SEQUENTIAL.BIC");
jaccard_filter$BESS.SEQUENTIAL.BIC <- rcvBESSSequentialBIC$jaccard;
test_Predictions <- cbind(test_Predictions,rcvBESSSequentialBIC$survMedianTest[tnames,3],rcvBESSSequentialBIC$survMedianTest[tnames,4],rcvBESSSequentialBIC$survMedianTest[tnames,5],rcvBESSSequentialBIC$survMedianTest[tnames,6])
cputimes$BESS.SEQUENTIAL.BIC = mean(rcvBESSSequentialBIC$theTimes[ elapcol ])
}
######################Esemble####################################
predictions <- c("LinearPredictors","Risks");
columnNamesMethods <- NULL;
for(x in methods)
{
for(y in predictions)
{
columnNamesMethods <- cbind(columnNamesMethods,paste(x,y,sep=""))
}
}
colnames(test_Predictions) <- c("Times","Outcome",columnNamesMethods);
thesets <- c("Survival Algorithm")
theMethod <- methods;
rownames(CIRisksTable) <- theMethod;
rownames(LogRankTable) <- theMethod;
rownames(accciTable) <- theMethod;
rownames(errorciTable) <- theMethod;
rownames(aucTable) <- theMethod;
rownames(senTable) <- theMethod;
rownames(speTable) <- theMethod;
cputimes <- unlist(cputimes);
names(cputimes) <- theMethod;
######################Filters ####################################
if (!inherits(referenceCV,"list"))
{
classnames <- colnames(test_Predictions);
cat("Cox\n")
fmeth <- FilterMethod(survival::coxph,"Cox")
CIRisksTable_filter <- rbind(CIRisksTable_filter,fmeth$CIRisksTable_filter);
LogRankTable_filter <- rbind(LogRankTable_filter,fmeth$LogRankTable_filter);
accciTable_filter <- rbind(accciTable_filter,fmeth$accciTable_filter)
errorciTable_filter <- rbind(errorciTable_filter,fmeth$errorciTable_filter)
aucTable_filter <- rbind(aucTable_filter,fmeth$aucTable_filter)
senTable_filter <- rbind(senTable_filter,fmeth$senTable_filter)
speTable_filter <- rbind(speTable_filter,fmeth$speTable_filter)
TheCVEvaluations$Cox.Reference <- fmeth$rcvFilter_reference;
TheCVEvaluations$Cox.LASSO = fmeth$rcvFilter_LASSO;
TheCVEvaluations$Cox.BESS = fmeth$rcvFilter_BESS;
TheCVEvaluations$Cox.Unicox = fmeth$rcvFilter_UniCox;
test_Predictions <- cbind(test_Predictions,fmeth$rcvFilter_reference$survMedianTest[tnames,3],fmeth$rcvFilter_reference$survMedianTest[tnames,4],fmeth$rcvFilter_reference$survMedianTest[tnames,5],fmeth$rcvFilter_reference$survMedianTest[tnames,6]);
filters = c("COX.BSWiMS");
if (!inherits(fmeth$rcvFilter_LASSO, "try-error"))
{
test_Predictions <- cbind(test_Predictions,fmeth$rcvFilter_LASSO$survMedianTest[tnames,3],fmeth$rcvFilter_LASSO$survMedianTest[tnames,4],fmeth$rcvFilter_LASSO$survMedianTest[tnames,5],fmeth$rcvFilter_LASSO$survMedianTest[tnames,6]);
filters = c(filters,"COX.LASSO");
}
if (!inherits(fmeth$rcvFilter_BESS, "try-error"))
{
test_Predictions <- cbind(test_Predictions,fmeth$rcvFilter_BESS$survMedianTest[tnames,3],fmeth$rcvFilter_BESS$survMedianTest[tnames,4],fmeth$rcvFilter_BESS$survMedianTest[tnames,5],fmeth$rcvFilter_BESS$survMedianTest[tnames,6]);
filters = c(filters,"COX.BESS");
}
if (!inherits(fmeth$rcvFilter_UniCox, "try-error"))
{
test_Predictions <- cbind(test_Predictions,fmeth$rcvFilter_UniCox$survMedianTest[tnames,3],fmeth$rcvFilter_UniCox$survMedianTest[tnames,4],fmeth$rcvFilter_UniCox$survMedianTest[tnames,5],fmeth$rcvFilter_UniCox$survMedianTest[tnames,6]);
filters = c(filters,"COX.UnivariateCox");
}
columnNamesMethods <- NULL;
for(x in filters)
{
for(y in predictions)
{
columnNamesMethods <- cbind(columnNamesMethods,paste(x,y,sep=""))
}
}
colnames(test_Predictions) <- c(classnames,columnNamesMethods);
selFrequency <- cbind(selFrequency,numeric(ncol(theData)));
if (!inherits(fmeth$rcvFilter_UniCox, "try-error"))
{
selFrequency[names(fmeth$rcvFilter_UniCox$featureFrequency),ncol(selFrequency)] <- fmeth$rcvFilter_UniCox$featureFrequency;
theFiltersets <- c(theFiltersets,"Cox.Unicox");
jaccard_filter$kendall <- fmeth$rcvFilter_UniCox$jaccard;
}
}
featsize <- unlist(lapply(jaccard_filter, `[`, c('averageLength')))
names(featsize) <- theFiltersets;
jaccard <- unlist(lapply(jaccard_filter, `[`, c('Jaccard.SM')))
names(jaccard) <- theFiltersets;
selFrequency <- as.data.frame(selFrequency[,-1])
selFrequency <- selFrequency/reps;
colnames(selFrequency) <- theFiltersets;
totsum <- apply(selFrequency,1,sum);
selFrequency <- selFrequency[order(-totsum),];
totsum <- totsum[order(-totsum)];
selFrequency <- selFrequency[totsum>0,];
test_Predictions <- as.data.frame(test_Predictions)
for (i in 2:ncol(test_Predictions))
{
if (test_Predictions[,i] < -1)
{
test_Predictions[,i] <- 1.0/(1.0+exp(-test_Predictions[,i] ));
}
}
result <- list(errorciTable = errorciTable,accciTable = accciTable,aucTable = aucTable,senTable = senTable,speTable = speTable,
errorciTable_filter = errorciTable_filter,accciTable_filter = accciTable_filter,aucTable_filter = aucTable_filter,senTable_filter = senTable_filter,speTable_filter = speTable_filter,
CIRisksTable = CIRisksTable,LogRankTable = LogRankTable,
CIRisksTable_filter = CIRisksTable_filter,LogRankTable_filter = LogRankTable_filter,
times = list(Reference = referenceCV$theTimes,LASSO = rcvLASSO$theTimes, RIDGE = rcvGLMNET_RIDGE$theTimes, ELASTICNET = rcvGLMNET_ELASTICNET, BESS = rcvBESS$theTimes, BESS.SEQUENTIAL = rcvBESSSequential$theTimes, BESS.SEQUENTIAL.BIC=rcvBESSSequentialBIC$theTimes),
jaccard = jaccard,
featsize = featsize,
TheCVEvaluations = TheCVEvaluations,
thesets = thesets,
theMethod = theMethod,
theFiltersets = theFiltersets,
testPredictions = test_Predictions,
featureSelectionFrequency = selFrequency,
cpuElapsedTimes=cputimes
)
class(result) <- c("FRESA_benchmark","Survival.COX");
return(result)
}
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.