R/compare_SMCs.R

In YAPSA: Yet Another Package for Signature Analysis

# Copyright © 2014-2019  The YAPSA package contributors
# This file is part of the YAPSA package. The YAPSA package is licenced under
# GPL-3

#' Group strata from different stratification axes
#'
#' For a comparison of the strata from different orthogonal stratification axes,
#' i.e. othogonal SMCs, the strata have to be grouped and reformatted. This
#' function does this task for the comparison by cosine similarity of signature
#' exposures. Output of this function is the basis for applying
#' \code{\link{plot_strata}} and \code{\link{make_comparison_matrix}}. It is
#' called by the wrapper functions \code{\link{compare_SMCs}},
#' \code{\link{run_plot_strata_general}} or
#' \code{\link{run_comparison_general}}.
#'
#' @param in_stratification_lists_list List of lists with entries from different
#'   (orthogonal) stratification axes or SMCs
#' @param in_remove_signature_ind Omit one of the signatures in
#'   \code{in_signatures_ind_df} for the comparison if non-NULL. The parameter
#'   specifies the index of the signature to be removed.
#' @param in_additional_stratum Include an additionally supplied stratum in
#'   comparison in non-NULL.
#'
#' @return A list with entries \code{strata_df}, \code{number_of_SMCs},
#'   \code{number_of_strata}. \itemize{ \item \code{strata_df}: Pasted numerical
#'   data frame of all strata (these are going to be compared e.g. by
#'   \code{\link{make_comparison_matrix}}). \item \code{number_of_SMCs}: Number
#'   of orthogonal stratifications in \code{in_stratification_lists_list} and
#'   additional ones. \item \code{number_of_strata}: Cumulative number of strata
#'   (sum over the numbers of strata of the different stratifications in
#'   \code{in_stratification_lists_list}) and additional ones. }
#'
#' @examples
#'  NULL
#'
#' @seealso \code{\link{plot_strata}}
#' @seealso \code{\link{make_comparison_matrix}}
#' @seealso \code{\link{compare_SMCs}}
#' @seealso \code{\link{run_plot_strata_general}}
#' @seealso \code{\link{run_comparison_general}}
#'
#' @export
#' 
make_strata_df <- function(in_stratification_lists_list,
                            in_remove_signature_ind=NULL,
                            in_additional_stratum=NULL) {
    my_number_of_signatures <- 
        dim(in_stratification_lists_list[[1]]$cohort[[1]])[1]
    my_SMCs <- names(in_stratification_lists_list)
    my_strata <- c()
    for(SMC in my_SMCs) {
        temp_strata_names <- 
            paste0(SMC,"_",
                    unlist(in_stratification_lists_list[[SMC]]$name_list))
        temp_all <- paste0(SMC,"_all")
        my_strata <- c(my_strata,temp_all,temp_strata_names)
    }
    out_strata_df <- repeat_df(0,my_number_of_signatures,length(my_strata))
    stratum_counter <- 0
    SMC_counter <- 0
    my_number_of_strata <- c()
    for(SMC in my_SMCs) {
        SMC_counter <- SMC_counter + 1
        my_number_of_strata[SMC_counter] <- 
            length(in_stratification_lists_list[[SMC]]$cohort)
    for(stratum in seq_len(my_number_of_strata[SMC_counter])) {
        stratum_counter <- stratum_counter + 1
        temp_df <- in_stratification_lists_list[[SMC]]$cohort[[stratum]]
        out_strata_df[,stratum_counter] <- temp_df$exposure
        names(out_strata_df)[stratum_counter] <- my_strata[stratum_counter]
        }
    }
    rownames(out_strata_df) <- paste0("S",rownames(out_strata_df))
    my_number_of_SMCs <- length(my_SMCs)
    if(!(is.null(in_remove_signature_ind))) {
        out_strata_df <- out_strata_df[(-1)*in_remove_signature_ind,]
    }
    if(!(is.null(in_additional_stratum))) {
        out_strata_df$compare <- in_additional_stratum
        my_number_of_SMCs <- my_number_of_SMCs+1
        my_number_of_strata <- c(my_number_of_strata,1)
    }
    return(list(strata_df=out_strata_df,
                number_of_SMCs=my_number_of_SMCs,
                number_of_strata=my_number_of_strata))
}


#' Group strata from different stratification axes
#'
#' For a comparison of the strata from different orthogonal stratification axes,
#' i.e. othogonal SMCs, the strata have to be grouped and reformatted. This
#' function does this task for the comparison by cosine similarity of mutational
#' catalogues. Output of this function is the basis for applying
#' \code{\link{make_comparison_matrix}}. It is called by the wrapper function
#' \code{\link{run_comparison_catalogues}}.
#'
#' @param in_stratification_lists_list List of lists with entries from different
#'   (orthogonal) stratification axes or SMCs
#' @param in_additional_stratum Include an additionally supplied stratum in
#'   comparison in non-NULL.
#'
#' @return A list with entries \code{strata_df}, \code{number_of_SMCs},
#'   \code{number_of_strata}. \itemize{ \item \code{strata_df}: Pasted numerical
#'   data frame of all strata (these are going to be compared e.g. by
#'   \code{\link{make_comparison_matrix}}). \item \code{number_of_SMCs}: Number
#'   of orthogonal stratifications in \code{in_stratification_lists_list} and
#'   additional ones. \item \code{number_of_strata}: Cumulative number of strata
#'   (sum over the numbers of strata of the different stratifications in
#'   \code{in_stratification_lists_list}) and additional ones. }
#'
#' @examples
#'  NULL
#'
#' @seealso \code{\link{plot_strata}}
#' @seealso \code{\link{make_comparison_matrix}}
#' @seealso \code{\link{run_comparison_catalogues}}
#'
#' @export
#' 
make_catalogue_strata_df <- function(in_stratification_lists_list,
                                    in_additional_stratum=NULL) {
    my_number_of_PIDs <- 
        dim(in_stratification_lists_list[[1]]$catalogues_list[[1]])[2]
    my_number_of_features <- 
        dim(in_stratification_lists_list[[1]]$catalogues_list[[1]])[1]
    my_SMCs <- names(in_stratification_lists_list)
    my_strata <- c()
    ## normalize the catalogues
    normalized_catalogues_lists_list <- list()
    for(SMC in my_SMCs) {
        temp_strata_names <- 
            paste0(SMC,"_",
                    unlist(in_stratification_lists_list[[SMC]]$name_list))
        temp_all <- paste0(SMC,"_all")
        my_strata <- c(my_strata,temp_all,temp_strata_names)
        my_catalogues_list <- 
                    in_stratification_lists_list[[SMC]]$catalogues_list
        sum_catalogue <- sum_over_list_of_df(my_catalogues_list)
        temp_length <- length(my_catalogues_list)
        my_catalogues_list[[temp_length+1]] <- sum_catalogue
        permut_ind <- c(temp_length+1,seq_len(temp_length))
        this_catalogues_list <- my_catalogues_list[permut_ind]
        normalized_catalogues_lists_list[[SMC]] <- 
            base::lapply(this_catalogues_list,
                function(l) normalize_df_per_dim(l,2))
    }
    out_strata_df <- repeat_df(0,my_number_of_features,length(my_strata))
    stratum_counter <- 0
    SMC_counter <- 0
    my_number_of_strata <- c()
    for(SMC in my_SMCs) {
        SMC_counter <- SMC_counter + 1
        my_number_of_strata[SMC_counter] <- 
            length(in_stratification_lists_list[[SMC]]$cohort)
        for(stratum in seq_len(my_number_of_strata[SMC_counter])) {
            stratum_counter <- stratum_counter + 1
            temp_df <- normalized_catalogues_lists_list[[SMC]][[stratum]]
            out_strata_df[,stratum_counter] <- average_over_present(temp_df,1)
            names(out_strata_df)[stratum_counter] <- my_strata[stratum_counter]
        }
    }
    rownames(out_strata_df) <- 
        rownames(in_stratification_lists_list[[1]]$catalogues_list[[1]])
    my_number_of_SMCs <- length(my_SMCs)
    if(!(is.null(in_additional_stratum))) {
        out_strata_df$compare <- in_additional_stratum
        my_number_of_SMCs <- my_number_of_SMCs+1
        my_number_of_strata <- c(my_number_of_strata,1)
    }
    return(list(strata_df=out_strata_df,
                number_of_SMCs=my_number_of_SMCs,
                number_of_strata=my_number_of_strata))
}


#' Plot all strata from different stratification axes together
#'
#' Plot the cohort wide signature exposures of all strata from different
#' stratification axes together. Naturally called by \code{\link{compare_SMCs}}.
#'
#' @param in_strata_list Data structure created by \code{make_strata_df} or
#'   \code{make_catalogue_strata_df} in which the strata from different
#'   orthogonal stratification axes are reorganized in a consistent structure.
#' @param in_signatures_ind_df A data frame containing meta information about
#'   the signatures
#' @param output_path Path to directory where the results, especially the figure
#'   produced, are going to be stored.
#' @param in_attribute Additional string for the file name where the figure
#'   output is going to be stored.
#'
#' @return The function doesn't return any value.
#'
#' @examples
#'  NULL
#'
#' @seealso \code{\link{compare_SMCs}}
#'
#' @import ggplot2
#' @export
#' 
plot_strata <- function(in_strata_list,
                        in_signatures_ind_df,
                        output_path=NULL,
                        in_attribute="") {
    in_strata_df <- in_strata_list$strata_df
    number_of_SMCs <- in_strata_list$number_of_SMCs
    number_of_strata <- in_strata_list$number_of_strata
    plot_list <- list()
    stratum_counter <- 0
    for(stratum in names(in_strata_df)) {
        stratum_counter <- stratum_counter + 1
        temp_df <- data.frame(sig=rownames(in_strata_df),
                                exposure=in_strata_df[,stratum])
        plot_list[[stratum_counter]] <- ggplot() + 
        ggplot2::geom_bar(data=temp_df,
                        aes_string(x="sig",y="exposure",fill="sig",size=0.3),
                        stat='identity',position="dodge",width=.7) + 
        scale_fill_manual(values=in_signatures_ind_df$colour) +
        labs(x="",y="",title=stratum) +
        theme(axis.text.x = element_blank(), axis.ticks.x = element_blank(),
                legend.position = "none")
    }
    horizontal_element_width <- 10
    number_of_horizontal_units <- number_of_SMCs*horizontal_element_width
    vertical_element_height <- 10
    number_of_vertical_units <- (max(number_of_strata))*vertical_element_height
    horizontal_figure_factor <- 60
    vertical_figure_factor <- 40

    if(!is.null(output_path)){
        fileName <- file.path(output_path,paste0(in_attribute,
                                                    "_all_strata.png"))
        png(fileName,
            width=number_of_horizontal_units*horizontal_figure_factor,
            height=number_of_vertical_units*vertical_figure_factor)
    }
    grid.newpage()
    pushViewport(viewport(layout = grid.layout(number_of_vertical_units, 
                                                number_of_horizontal_units)))
    this_offsets <- c(0,cumsum(number_of_strata)[1:length(number_of_strata)-1])
    vertical_temp_stop <- 0
    for (i in seq_len(sum(number_of_strata))) {
        this_SMC <- findInterval(i,cumsum(number_of_strata)+1)+1
        this_stratum <- i - this_offsets[this_SMC]
        horizontal_temp_start <- (this_SMC-1)*horizontal_element_width+1
        horizontal_temp_stop <- 
            (horizontal_temp_start - 1) + horizontal_element_width
        vertical_temp_start <- vertical_temp_stop + 1
        vertical_temp_start <- (this_stratum-1)*vertical_element_height+1
        vertical_temp_stop <- (vertical_temp_start - 1) + 
                                    vertical_element_height    
        print(plot_list[[i]], 
            vp = vplayout(vertical_temp_start:vertical_temp_stop, 
                        horizontal_temp_start:horizontal_temp_stop))
    }
    if(!is.null(output_path)){
        dev.off()
    }
    return()
}


#' Compute a similarity matrix for different strata
#'
#' Compute and plot a similarity matrix for different strata from different
#' stratification axes together. First, \code{\link{compare_sets}} is called on
#' \code{in_strata_df} with itself, yielding a distance matrix (a numerical data
#' frame) \code{dist_df} of the strata. The corresponding similarity matrix
#' \code{1-dif_df} is then passed to \code{\link[corrplot]{corrplot}}.
#'
#'
#' @param in_strata_df Numerical data frame of all strata to be compared.
#' @param output_path Path to directory where the results, especially the figure
#'   produced by \code{\link[corrplot]{corrplot}} is going to be stored.
#' @param in_nrect Number of clusters in the clustering procedure provided by
#'   \code{\link[corrplot]{corrplot}}
#' @param in_attribute Additional string for the file name where the figure
#'   produced by \code{\link[corrplot]{corrplot}} is going to be stored.
#' @param in_palette Colour palette for the matrix
#'
#' @return The comparison matrix of cosine similarities.
#'
#' @examples
#' data(sigs)
#' make_comparison_matrix(
#'  AlexCosmicValid_sig_df,in_nrect=9,
#'  in_palette=colorRampPalette(c("blue","green","red"))(n=100))
#'
#' @seealso \code{\link{compare_SMCs}}
#'
#' @importFrom grDevices colorRampPalette png dev.off
#' @importFrom corrplot corrplot
#' @export
#' 
make_comparison_matrix <- function(in_strata_df,output_path=NULL,in_nrect=5,
                                    in_attribute="",in_palette=NULL) {
    if(is.null(in_palette)){
        myColorRange <- colorRampPalette(c("blue","green","green","green",
                                            "green","green","green","green",
                                            "green","green","red"))(n=100)    
    } else {
        myColorRange <- in_palette
    }
    compare_list <- compare_sets(in_strata_df,in_strata_df)
    dist_df <- compare_list$distance
    if(!is.null(output_path)){
        fileName <- file.path(output_path,
                                paste0(in_attribute,"_comparison_matrix.png"))
    png(fileName,width=500,height=500)
    }
    corrplot(as.matrix(1-dist_df),method="color",order="hclust",
                addrect=in_nrect,col=myColorRange)
    if(!is.null(output_path)){
        dev.off()
    }
    return(as.matrix(1-dist_df))
}


#' Compare all strata from different stratifications
#'
#' Compare all strata from different orthogonal stratification axes, i.e.
#' othogonal SMCs by cosine similarity of signature exposures. First calls
#' \itemize{ \item \code{make_strata_df}, then \item \code{\link{plot_strata}}
#' and finally \item \code{\link{make_comparison_matrix}} }
#'
#' @param in_stratification_lists_list List of lists with entries from different
#'   (orthogonal) stratification axes or SMCs
#' @param in_signatures_ind_df A data frame containing meta information about
#'   the signatures
#' @param output_path Path to directory where the results, especially the figure
#'   produced by \code{\link[corrplot]{corrplot}} is going to be stored.
#' @param in_nrect Number of clusters in the clustering procedure provided by
#'   \code{\link[corrplot]{corrplot}}
#' @param in_attribute Additional string for the file name where the figure
#'   produced by \code{\link[corrplot]{corrplot}} is going to be stored.
#'
#' @return The comparison matrix of cosine similarities.
#'
#' @examples
#'  NULL
#'
#' @seealso \code{\link{plot_strata}}
#' @seealso \code{\link{make_comparison_matrix}}
#'
#' @export
#' 
compare_SMCs <- function(in_stratification_lists_list,
                            in_signatures_ind_df,
                            output_path,
                            in_nrect=5,
                            in_attribute="") {
    strata_list <- make_strata_df(in_stratification_lists_list)
    strata_df <- strata_list$strata_df
    plot_strata(strata_list,in_signatures_ind_df,output_path,in_attribute)
    reduced_strata_df <- strata_df
    names(reduced_strata_df)[1] <- "all"
    remove_ind <- grep("_all$",names(reduced_strata_df))
    reduced_strata_df <- reduced_strata_df[,-remove_ind]
    my_matrix <- make_comparison_matrix(reduced_strata_df,output_path,
                                        in_nrect,in_attribute)
    return(my_matrix)
}

#' Wrapper function for \code{plot_strata}
#'
#' First calls \itemize{ \item \code{make_strata_df}, then \item
#' \code{\link{plot_strata}} }
#'
#' @param in_stratification_lists_list List of lists with entries from different
#'   (orthogonal) stratification axes or SMCs
#' @param in_signatures_ind_df A data frame containing meta information about
#'   the signatures
#' @param output_path Path to directory where the results, especially the figure
#'   produced by \code{\link{plot_strata}} is going to be stored.
#' @param in_attribute Additional string for the file name where the figure
#'   produced by \code{\link{plot_strata}} is going to be stored.
#' @param in_remove_signature_ind Omit one of the signatures in
#'   \code{in_signatures_ind_df} for the comparison if non-NULL. The parameter
#'   specifies the index of the signature to be removed.
#' @param in_additional_stratum Include an additionally supplied stratum in
#'   comparison in non-NULL.
#'
#' @return The function doesn't return any value.
#'
#' @examples
#'  NULL
#'
#' @seealso \code{\link{plot_strata}}
#'
#' @export
#' 
run_plot_strata_general <- function(in_stratification_lists_list,
                                    in_signatures_ind_df,
                                    output_path=NULL,
                                    in_attribute="",
                                    in_remove_signature_ind=NULL,
                                    in_additional_stratum=NULL) {
    strata_list <- make_strata_df(in_stratification_lists_list,
                                in_remove_signature_ind,
                                in_additional_stratum)
    plot_strata(strata_list$strata_df,in_signatures_ind_df,
                    output_path,in_attribute)
}


#' Compare all strata from different stratifications
#'
#' Compare all strata from different orthogonal stratification axes, i.e.
#' othogonal SMCs by cosine similarity of signature exposures. Function similar
#' to \code{\link{compare_SMCs}}, but without calling \code{\link{plot_strata}}.
#' First calls \itemize{ \item \code{make_strata_df}, then \item
#' \code{\link{make_comparison_matrix}} }
#'
#' @param in_stratification_lists_list List of lists with entries from different
#'   (orthogonal) stratification axes or SMCs
#' @param output_path Path to directory where the results, especially the figure
#'   produced by \code{\link[corrplot]{corrplot}} is going to be stored.
#' @param in_nrect Number of clusters in the clustering procedure provided by
#'   \code{\link[corrplot]{corrplot}}
#' @param in_attribute Additional string for the file name where the figure
#'   produced by \code{\link[corrplot]{corrplot}} is going to be stored.
#' @param in_remove_signature_ind Omit one of the signatures in
#'   \code{in_signatures_ind_df} for the comparison if non-NULL. The parameter
#'   specifies the index of the signature to be removed.
#' @param in_additional_stratum Include an additionally supplied stratum in
#'   comparison in non-NULL.
#'
#' @return The comparison matrix of cosine similarities.
#'
#' @examples
#'  NULL
#'
#' @seealso \code{\link{make_comparison_matrix}}
#' @seealso \code{\link{compare_SMCs}}
#' @seealso \code{\link{run_comparison_catalogues}}
#'
#' @export
#' 
run_comparison_general <- function(in_stratification_lists_list,
                                    output_path=NULL,
                                    in_nrect=5,
                                    in_attribute="",
                                    in_remove_signature_ind=NULL,
                                    in_additional_stratum=NULL) {
    strata_list <- make_strata_df(in_stratification_lists_list,
                                    in_remove_signature_ind,
                                    in_additional_stratum)
    strata_df <- strata_list$strata_df
    reduced_strata_df <- strata_df
    names(reduced_strata_df)[1] <- "all"
    remove_ind <- grep("_all$",names(reduced_strata_df))
    if(length(remove_ind)>0) {
        reduced_strata_df <- reduced_strata_df[,-remove_ind]
    }
    my_matrix <- make_comparison_matrix(reduced_strata_df,
                                    output_path,
                                    in_nrect,
                                    in_attribute)
    return(my_matrix)
}

#' Compare all strata from different stratifications
#'
#' Compare all strata from different orthogonal stratification axes, i.e.
#' othogonal SMCs by cosine similarity of mutational catalogues. Function
#' similar to \code{\link{run_comparison_general}}. First calls \itemize{ \item
#' \code{make_catalogue_strata_df}, then \item
#' \code{\link{make_comparison_matrix}} }
#'
#' @param in_stratification_lists_list List of lists with entries from different
#'   (orthogonal) stratification axes or SMCs
#' @param output_path Path to directory where the results, especially the figure
#'   produced by \code{\link[corrplot]{corrplot}} is going to be stored.
#' @param in_nrect Number of clusters in the clustering procedure provided by
#'   \code{\link[corrplot]{corrplot}}
#' @param in_attribute Additional string for the file name where the figure
#'   produced by
#'
#' @return The comparison matrix of cosine similarities.
#'
#' @examples
#'  NULL
#'
#' @seealso \code{\link{make_comparison_matrix}}
#' @seealso \code{\link{run_comparison_general}}
#'
#' @export
#' 
run_comparison_catalogues <- function(in_stratification_lists_list,
                                        output_path=NULL,
                                        in_nrect=5,
                                        in_attribute="") {
    catalogue_strata_list <- 
        make_catalogue_strata_df(in_stratification_lists_list)
    catalogue_strata_df <- catalogue_strata_list$strata_df
    reduced_strata_df <- catalogue_strata_df
    names(reduced_strata_df)[1] <- "all"
    remove_ind <- grep("_all$",names(reduced_strata_df))
    if(length(remove_ind)>0) {
        reduced_strata_df <- reduced_strata_df[,-remove_ind]
    }
    my_matrix <- make_comparison_matrix(reduced_strata_df,
                                        output_path,
                                        in_nrect,
                                        in_attribute)
    return(my_matrix)
}