R/compareMethods.R

In ataudt/aneufinder: Analysis of Copy Number Variation in Single-Cell-Sequencing Data

#' Compare copy number models
#' 
#' Compare two \code{\link{aneuHMM}} objects. The function computes the fraction of copy number calls that is concordant between both models.
#' 
#' @param model1 An \code{\link{aneuHMM}} object or file that contains such an object.
#' @param model2 An \code{\link{aneuHMM}} object or file that contains such an object.
#' @return A numeric.
#' @author Aaron Taudt
compareModels <- function(model1, model2) {
  
    model1 <- suppressMessages( loadFromFiles(model1, check.class="aneuHMM")[[1]] )
    model2 <- suppressMessages( loadFromFiles(model2, check.class="aneuHMM")[[1]] )
    
    ## Check concordance
    if (is.null(model1) | is.null(model2)) {
        concordance <- NA
    } else {
        concordance <- length(which(as.character(model1$bins$state) == as.character(model2$bins$state))) / length(model1$bins)
    }
    return(concordance)
    
} 


#' Compare copy number calling methods
#' 
#' Compare two sets of \code{\link{aneuHMM}} objects generated by different methods (see option \code{method} of \code{\link{findCNVs}}).
#' 
#' @param models1 A list of \code{\link{aneuHMM}} objects or a character vector with files that contain such objects.
#' @param models2 A list of \code{\link{aneuHMM}} objects or a character vector with files that contain such objects. IDs of the models must match the ones in \code{models1}.
#' @return A data.frame with one column 'concordance' which gives the fraction of the genome that is called concordantly between both models.
#' @author Aaron Taudt
#' @export
#' @examples
#'## Get a list of HMMs
#'folder <- system.file("extdata", "primary-lung", "hmms", package="AneuFinderData")
#'files <- list.files(folder, full.names=TRUE)
#'## Compare the models with themselves (non-sensical)
#'df <- compareMethods(files, files)
#'head(df)
compareMethods <- function(models1, models2) {
  
    models1 <- loadFromFiles(models1, check.class="aneuHMM")
    models2 <- loadFromFiles(models2, check.class="aneuHMM")
    ids1 <- sapply(models1, '[[', 'ID')
    ids2 <- sapply(models2, '[[', 'ID')
    
    concordances <- list()
    for (id in ids1) {
        model1 <- models1[[which(ids1==id)]]
        model2 <- models2[[which(ids2==id)]]
        concordances[[id]] <- compareModels(model1, model2)
    }
    concordances <- data.frame(concordance=unlist(concordances))
    return(concordances)
    
}