R/readCurationFile.R
7d29a0be
 #' Read curation file
 #' 
 #' Function that can be used to read the curated output of the
 #' \code{\link{runAbsoluteCN}} function.
 #' 
 #' 
 #' @param file.rds Output of the \code{\link{runAbsoluteCN}} function,
 #' serialized with \code{saveRDS}.
 #' @param file.curation Filename of a curation file that points to the correct
 #' tumor purity and ploidy solution.
 #' @param remove.failed Do not return solutions that failed.
 #' @param report.best.only Only return correct/best solution (useful on low
 #' memory machines when lots of samples are loaded).
 #' @param min.ploidy Minimum ploidy to be considered. If \code{NULL}, all. Can
 #' be used to automatically ignore unlikely solutions.
 #' @param max.ploidy Maximum ploidy to be considered. If \code{NULL}, all. Can
 #' be used to automatically ignore unlikely solutions.
 #' @return The return value of the corresponding \code{\link{runAbsoluteCN}}
 #' call, but with the results array manipulated according the curation CSV file
 #' and arguments of this function.
 #' @author Markus Riester
 #' @seealso \code{\link{runAbsoluteCN} \link{createCurationFile}}
 #' @examples
 #' 
 #' data(purecn.example.output)
 #' file.rds <- "Sample1_PureCN.rds"
 #' createCurationFile(file.rds) 
 #' # User can change the maximum likelihood solution manually in the generated 
 #' # CSV file. The correct solution is then loaded with readCurationFile.
 #' purecn.curated.example.output <-readCurationFile(file.rds) 
 #' 
 #' @export readCurationFile
 #' @importFrom utils read.csv
 readCurationFile <- function(file.rds,
 file.curation = gsub(".rds$", ".csv", file.rds),
 remove.failed = FALSE, report.best.only=FALSE, min.ploidy = NULL,
4d22136e
 max.ploidy = NULL) {
     flog.info("Reading %s...", file.rds)
ea58a451
     res <- readRDS(file.rds)
dd14002e
     if (!file.exists(file.curation)) {
         flog.warn("Curation file %s does not exist, creating one.", file.curation)
         createCurationFile(file.rds)
     }
74e11302
     curation <- read.csv(file.curation, as.is=TRUE, nrows=1)
     .checkLogical <- function(field) {
         if (!is.logical(curation[[field]])) {
             .stopUserError("'", field, "' column in ", file.curation, 
                 " not logical(1).")
         }
     }
     .checkLogical("Failed")
     .checkLogical("Curated")
     .checkLogical("Flagged")
eed5c190
 
     ## Mark all solutions as failed if sample is curated as failed
ea58a451
     if (curation$Failed) {
         if (remove.failed) return(NA)
e2b17570
         for (i in seq_along(res$results)) res$results[[i]]$failed <- TRUE
ea58a451
     } else {
e2b17570
         for (i in seq_along(res$results)) res$results[[i]]$failed <- FALSE
eed5c190
     }
b9fb3c8c
     
     # Make sure purity and ploidy are numeric. Stop if not, not warn.
     curation$Purity <- suppressWarnings(as.numeric(curation$Purity))
     curation$Ploidy <- suppressWarnings(as.numeric(curation$Ploidy))
     
e769c0fc
     if (is.na(curation$Purity) || is.na(curation$Ploidy) ||
b9fb3c8c
         curation$Purity < 0 || curation$Purity > 1 ||
e769c0fc
         curation$Ploidy < 0 || curation$Ploidy > 8) {
b9fb3c8c
         .stopUserError("Purity or Ploidy not numeric or in expected range.")
     }    
e769c0fc
     # Find purity/ploidy solution most similar to curation
eed5c190
     diffCurated <- vapply(res$results, function(x) {
ea58a451
         abs(x$purity-curation$Purity) + (abs(x$ploidy-curation$Ploidy)/6)
eed5c190
     }, double(1))
     idxCurated <- which.min(diffCurated)
     if (idxCurated != 1) {
         res$results[c(1,idxCurated)] <-  res$results[c(idxCurated, 1)]
     }
     
     ## Filter by ploidy if necessary
ea58a451
     ploidy <- sapply(res$results, function(x) x$ploidy)
     if (is.null(min.ploidy)) min.ploidy <- min(ploidy)
     if (is.null(max.ploidy)) max.ploidy <- max(ploidy)
eed5c190
     idxPloidyOk <- which(ploidy>=min.ploidy & ploidy <= max.ploidy)
     res$results <- res$results[idxPloidyOk]
ea58a451
      
     if (report.best.only) {
         res$results <- res$results[1]
eed5c190
     }
ea58a451
     res
7d29a0be
 }