R/calc_cor.R
1e8ab7f0
 #' @include HermesData-methods.R
 NULL
40a94888
 
65d72865
 # correlate-AnyHermesData ----
 
1e7a40be
 #' Correlation between Sample Counts of `AnyHermesData`
a00b4df0
 #'
5a49cd35
 #' @description `r lifecycle::badge("experimental")`
 #'
073ebe65
 #' The `correlate()` method can calculate the correlation matrix between the sample vectors of
 #' counts from a specified assay. This produces a [`HermesDataCor`] object, which is an extension
 #' of a [`matrix`] with additional quality flags in the slot `flag_data`
6d249ef9
 #' (containing the `tech_failure_flag` and `low_depth_flag` columns describing the original
073ebe65
 #' input samples).
 #'
 #' An `autoplot()` method then afterwards can produce the corresponding heatmap.
a00b4df0
 #'
1e8ab7f0
 #' @rdname calc_cor
 #' @aliases calc_cor
a00b4df0
 #'
22cac04d
 #' @param object (`AnyHermesData`)\cr object to calculate the correlation.
073ebe65
 #' @param assay_name (`string`)\cr the name of the assay to use.
22cac04d
 #' @param method (`string`)\cr the correlation method, see [stats::cor()] for details.
a00b4df0
 #'
90e38b04
 #' @return A [`HermesDataCor`] object.
a00b4df0
 #'
22cac04d
 #' @export
a00b4df0
 #'
22cac04d
 #' @examples
6d249ef9
 #' object <- hermes_data
073ebe65
 #'
 #' # Calculate the sample correlation matrix.
1e8ab7f0
 #' correlate(object)
073ebe65
 #'
 #' # We can specify another correlation coefficient to be calculated.
 #' result <- correlate(object, method = "spearman")
40a94888
 setMethod(
1e8ab7f0
   f = "correlate",
40a94888
   signature = "AnyHermesData",
   definition = function(object,
a00b4df0
                         assay_name = "counts",
90afd47b
                         method = "pearson",
                         ...) {
1e8ab7f0
     assert_that(is.string(assay_name))
40a94888
     chosen_assay <- assay(object, assay_name)
     sample_cor_matrix <- stats::cor(chosen_assay, method = method)
a00b4df0
 
40a94888
     .HermesDataCor(
       sample_cor_matrix,
6d249ef9
       flag_data = colData(object)[, c("tech_failure_flag", "low_depth_flag")]
40a94888
     )
   }
22cac04d
 )
d1e9b574
 
65d72865
 # HermesDataCor ----
 
1e8ab7f0
 #' @rdname calc_cor
 #' @aliases HermesDataCor
a00b4df0
 #' @exportClass HermesDataCor
 #'
eb3ec4a3
 .HermesDataCor <- setClass( # nolint
1e8ab7f0
   Class = "HermesDataCor",
   contains = "matrix",
   slots = c(flag_data = "DataFrame")
 )
 
65d72865
 # autoplot-HermesDataCor ----
 
073ebe65
 #' @describeIn calc_cor This `autoplot()` method uses the [ComplexHeatmap::Heatmap()] function
90e38b04
 #'   to plot the correlations between samples saved in a [`HermesDataCor`] object.
a00b4df0
 #'
d1e9b574
 #' @param flag_colors (named `character`)\cr a vector that specifies the colors for `TRUE` and `FALSE`
 #'   flag values.
a00b4df0
 #' @param cor_colors (`function`)\cr color scale function for the correlation values in the heatmap,
d1e9b574
 #'   produced by [circlize::colorRamp2()].
 #' @param ... other arguments to be passed to [ComplexHeatmap::Heatmap()].
a00b4df0
 #'
d1e9b574
 #' @export
a00b4df0
 #'
d1e9b574
 #' @examples
073ebe65
 #'
 #' # Plot the correlation matrix.
d1e9b574
 #' autoplot(result)
073ebe65
 #'
 #' # We can customize the heatmap.
d1e9b574
 #' autoplot(result, show_column_names = FALSE, show_row_names = FALSE)
073ebe65
 #'
 #' # Including changing the axis label text size.
 #' autoplot(
 #'   result,
 #'   row_names_gp = grid::gpar(fontsize = 8),
 #'   column_names_gp = grid::gpar(fontsize = 8)
 #' )
d1e9b574
 setMethod(
   f = "autoplot",
   signature = c(object = "HermesDataCor"),
   definition = function(object,
                         flag_colors = c("FALSE" = "green", "TRUE" = "red"),
                         cor_colors = circlize::colorRamp2(c(0, 0.5, 1), c("red", "yellow", "green")),
                         ...) {
     df <- object@flag_data
     left_annotation <- ComplexHeatmap::rowAnnotation(
65d72865
       "Low Depth" = factor(df$low_depth_flag),
       col = list("Low Depth" = flag_colors)
d1e9b574
     )
     top_annotation <- ComplexHeatmap::HeatmapAnnotation(
65d72865
       "Technical Failure" = factor(df$tech_failure_flag),
       col = list("Technical Failure" = flag_colors)
d1e9b574
     )
b7e7bc28
     mat <- as(object, "matrix")
d1e9b574
     ComplexHeatmap::Heatmap(
b7e7bc28
       matrix = mat,
d1e9b574
       col = cor_colors,
       name = "Correlation",
       left_annotation = left_annotation,
       top_annotation = top_annotation,
       ...
     )
   }
 )