@@ -170,6 +170,8 @@ importFrom(S4Vectors,do.call)

 importFrom(S4Vectors,mcols)

 importFrom(dplyr,mutate)

 importFrom(dplyr,n)

+importFrom(genefilter,rowFtests)

+importFrom(genefilter,rowttests)

 importFrom(randomForest,importance)

 importFrom(randomForest,varUsed)

 importFrom(rlang,sym)

@@ -57,6 +57,7 @@

 #' there are two classes.}

 #' \item{\code{"AUC"}: Area Under the Curve. An area ranging from 0 to 1, under the ROC.}

 #' \item{\code{"C-index"}: For survival data, the concordance index, for models which produce risk scores. Ranges from 0 to 1.}

+#' \item{\code{"Sample C-index"}: Per-individual C-index.}

 #' }

 #' 

 #' @param actualOutcomes A factor vector or survival information specifying each sample's known outcome.

@@ -128,7 +129,7 @@ setMethod("calcCVperformance", "ClassifyResult",

                                                "Micro Precision", "Micro Recall",

                                                "Micro F1", "Macro Precision",

                                                "Macro Recall", "Macro F1", "Matthews Correlation Coefficient", "AUC", 

-                                               "C-index"))

+                                               "C-index", "Sample C-index"))

 {

   performanceType <- match.arg(performanceType)

   actualOutcomes <- actualOutcomes(result) # Extract the known outcomes of all samples.

@@ -143,7 +144,7 @@ setMethod("calcCVperformance", "ClassifyResult",

   }

   ### Performance for survival data

-  if(performanceType == "C-index") {

+  if(performanceType %in% c("C-index", "Sample C-index")) {

     samples <- factor(result@predictions[, "sample"], levels = sampleNames(result))

     performance <- .calcPerformance(actualOutcomes = actualOutcomes[match(result@predictions[, "sample"], sampleNames(result))],

                                     predictedOutcomes = result@predictions[, "risk"], 

@@ -180,30 +181,63 @@ setMethod("calcCVperformance", "ClassifyResult",

 {

   if(performanceType %in% c("Sample Error", "Sample Accuracy"))

   {

-    resultTable <- data.frame(sample = samples,

-                              actual = actualOutcomes,

-                              predicted = predictedOutcomes)

-    allIDs <- levels(resultTable[, "sample"])

-    sampleMetricValues <- sapply(allIDs, function(sampleID)

+    sampleMetricValues <- sapply(levels(samples), function(sampleID)

     {

-      sampleResult <- subset(resultTable, sample == sampleID)

-      if(nrow(sampleResult) == 0)

-        return(NA)

+      consider <- which(samples == sampleID)

       if(performanceType == "Sample Error")

-        sum(as.character(sampleResult[, "predicted"]) != as.character(sampleResult[, "actual"]))

+        sum(predictedOutcomes[consider] != as.character(actualOutcomes[consider]))

       else

-        sum(as.character(sampleResult[, "predicted"]) == as.character(sampleResult[, "actual"]))

+        sum(predictedOutcomes[consider] == as.character(actualOutcomes[consider]))

     })

-    performanceValues <- as.numeric(sampleMetricValues / table(factor(resultTable[, "sample"], levels = allIDs)))

-    names(performanceValues) <- allIDs

+    performanceValues <- as.numeric(sampleMetricValues / table(samples))

+    names(performanceValues) <- levels(samples)

     return(list(name = performanceType, values = performanceValues))

   }

-  

+    

   if(!is.null(grouping))

   {

     actualOutcomes <- split(actualOutcomes, grouping)

     predictedOutcomes <- split(predictedOutcomes, grouping)

+    allSamples <- levels(samples)

+    samples <- split(samples, grouping)

+  }

+    

+  if(performanceType == "Sample C-index")

+  {

+    performanceValues <- do.call(rbind, mapply(function(iterationSurv, iterationPredictions, iterationSamples)

+    {

+      do.call(rbind, lapply(allSamples, function(sampleID)

+      {

+        sampleIndex <- which(iterationSamples == sampleID)

+        otherIndices <- setdiff(seq_along(allSamples), sampleIndex)

+        concordants <- discordants <- 0

+        iterationSurv <- as.matrix(iterationSurv)

+        for(compareIndex in otherIndices)

+        {

+          if(iterationSurv[sampleIndex, "time"] < iterationSurv[compareIndex, "time"] && iterationPredictions[sampleIndex] > iterationPredictions[compareIndex] && iterationSurv[sampleIndex, "status"] == 1)

+          { # Reference sample has shorter time, it is not censored, greater risk. Concordant.

+            concordants <- concordants + 1

+          } else if(iterationSurv[sampleIndex, "time"] > iterationSurv[compareIndex, "time"] && iterationPredictions[sampleIndex] < iterationPredictions[compareIndex] && iterationSurv[compareIndex, "status"] == 1)

+          { # Reference sample has longer time, the comparison sample is not censored, lower risk. Concordant.

+            concordants <- concordants + 1

+          } else if(iterationSurv[sampleIndex, "time"] < iterationSurv[compareIndex, "time"] && iterationPredictions[sampleIndex] < iterationPredictions[compareIndex] && iterationSurv[sampleIndex, "status"] == 1)

+          { # Reference sample has shorter time, it is not censored, but lower risk than comparison sample. Discordant.

+            discordants <- discordants + 1

+          } else if(iterationSurv[sampleIndex, "time"] > iterationSurv[compareIndex, "time"] && iterationPredictions[sampleIndex] > iterationPredictions[compareIndex] && iterationSurv[compareIndex, "status"] == 1)

+          { # Reference sample has longer time, the comparison sample is not censored, but higher risk than comparison sample. Discordant.

+            discordants <- discordants + 1

+          }

+        }

+        data.frame(sample = sampleID, concordant = concordants, discordant = discordants)

+      }))

+    }, actualOutcomes, predictedOutcomes, samples, SIMPLIFY = FALSE))

+

+    sampleValues <- by(performanceValues[, c("concordant", "discordant")], performanceValues[, "sample"], colSums)

+    Cindex <- round(sapply(sampleValues, '[', 1) / (sapply(sampleValues, '[', 1) + sapply(sampleValues, '[', 2)), 2)

+    names(Cindex) <- names(sampleValues)

+    Cindex <- Cindex[!is.nan(Cindex)] # The individual with the smallest censored time will always have no useful inequalities.

+    return(list(name = performanceType, values = Cindex))

   }

   if(!is(actualOutcomes, "list")) actualOutcomes <- list(actualOutcomes)

@@ -49,6 +49,7 @@

 #'     head(ranked)

 #' @usage NULL

 #' @export

+#' @importFrom genefilter rowttests rowFtests

 setGeneric("differentMeansRanking", function(measurementsTrain, ...)

            standardGeneric("differentMeansRanking"))

@@ -40,25 +40,19 @@

     outcomes <- factor(outcomes)

   # Outcomes has columns, so it is tabular. It is inferred to represent survival data.

-  if(!is.null(ncol(outcomes)))

+  if(!is.null(ncol(outcomes)) && ncol(outcomes) %in% 2:3)

   {

     # Assume that event status is in the last column (second for two columns, third for three columns)

-    if(!is.null(dim(outcomes)) && length(dim(data)) == 2 && ncol(outcomes) %in% 2:3)

-    {

-      numberEventTypes <- length(unique(outcomes[, ncol(outcomes)]))

-      # Could be one or two kinds of events. All events might be uncensored or censored

-      # in a rare but not impossible scenario.

-      if(numberEventTypes > 2)

-        stop("Number of distinct event types in the last column exceeds 2 but must be 1 or 2.")

-      

+    numberEventTypes <- length(unique(outcomes[, ncol(outcomes)]))

+    # Could be one or two kinds of events. All events might be uncensored or censored

+    # in a rare but not impossible scenario.

+    if(numberEventTypes > 2)

+      stop("Number of distinct event types in the last column exceeds 2 but must be 1 or 2.")

-      if(ncol(outcomes) == 2) # Typical, right-censored survival data.

-      {

-        outcomes <- survival::Surv(outcomes[, 1], outcomes[, 2])

-      } else { # Three columns. Therefore, counting process data.

-        outcomes <- survival::Surv(outcomes[, 1], outcomes[, 2], outcomes[, 3])

-      }

-    }

+    if(ncol(outcomes) == 2) # Typical, right-censored survival data.

+      outcomes <- survival::Surv(outcomes[, 1], outcomes[, 2])

+    else # Three columns. Therefore, counting process data.

+      outcomes <- survival::Surv(outcomes[, 1], outcomes[, 2], outcomes[, 3])

   }

   if(!is.null(restrict))

@@ -29,7 +29,7 @@ Pair of Factor Vectors}

   performanceType = c("Balanced Error", "Balanced Accuracy", "Error", "Accuracy",

     "Sample Error", "Sample Accuracy", "Micro Precision", "Micro Recall", "Micro F1",

     "Macro Precision", "Macro Recall", "Macro F1", "Matthews Correlation Coefficient",

-    "AUC", "C-index")

+    "AUC", "C-index", "Sample C-index")

 )

 }

 \arguments{

@@ -64,6 +64,7 @@ between -1 and 1 indicating how concordant the predicted classes are to the actu

 there are two classes.}

 \item{\code{"AUC"}: Area Under the Curve. An area ranging from 0 to 1, under the ROC.}

 \item{\code{"C-index"}: For survival data, the concordance index, for models which produce risk scores. Ranges from 0 to 1.}

+\item{\code{"Sample C-index"}: Per-individual C-index.}

 }}

 \item{result}{An object of class \code{\link{ClassifyResult}}.}