File: plot_contribution.R

package info (click to toggle)
r-bioc-mutationalpatterns 3.16.0%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 5,360 kB
  • sloc: sh: 8; makefile: 2
file content (154 lines) | stat: -rw-r--r-- 5,123 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
#' Plot signature contribution barplot
#'
#' Plot contribution of signatures. Can be used on both the results of a NMF
#' and on the results of signature refitting.
#'
#' @param contribution Signature contribution matrix
#' @param signatures Signature matrix.
#' Necessary when plotting NMF results in "absolute" mode.
#' It's not necessary in relative mode or when visualizing signature refitting results
#' @param index optional sample subset parameter
#' @param coord_flip Flip X and Y coordinates, default = FALSE
#' @param mode "relative" or "absolute"; to plot the relative contribution or
#' absolute number of mutations, default = "relative"
#' @param palette A color palette like c("#FF0000", "#00FF00", "9999CC") that
#' will be used as colors in the plot.  By default, ggplot2's colors are used
#' to generate a palette.
#'
#' @return Stacked barplot with contribution of each signature for each sample
#'
#' @import ggplot2
#' @importFrom magrittr %>%
#'
#' @examples
#'
#' ## Extracting signatures can be computationally intensive, so
#' ## we use pre-computed data generated with the following command:
#' # nmf_res <- extract_signatures(mut_mat, rank = 2)
#'
#' nmf_res <- readRDS(system.file("states/nmf_res_data.rds",
#'   package = "MutationalPatterns"
#' ))
#'
#' ## Optionally set column and row names.
#' colnames(nmf_res$signatures) <- c("Signature A", "Signature B")
#' rownames(nmf_res$contribution) <- c("Signature A", "Signature B")
#'
#' ## Plot the relative contribution
#' plot_contribution(nmf_res$contribution)
#'
#' ## Plot the absolute contribution.
#' ## When plotting absolute NMF results, the signatures need to be included.
#' plot_contribution(nmf_res$contribution,
#'   nmf_res$signature,
#'   mode = "absolute"
#' )
#'
#'
#' ## Only plot a subset of samples
#' plot_contribution(nmf_res$contribution,
#'   nmf_res$signature,
#'   mode = "absolute",
#'   index = c(1, 2)
#' )
#' ## Flip the coordinates
#' plot_contribution(nmf_res$contribution,
#'   nmf_res$signature,
#'   mode = "absolute",
#'   coord_flip = TRUE
#' )
#'
#' ## You can also use the results of signature refitting.
#' ## Here we load some data as an example
#' fit_res <- readRDS(system.file("states/snv_refit.rds",
#'   package = "MutationalPatterns"
#' ))
#' plot_contribution(fit_res$contribution)
#'
#' ## Or again in absolute mode
#' plot_contribution(fit_res$contribution,
#'   mode = "absolute"
#' )
#' @seealso
#' \code{\link{extract_signatures}},
#' \code{\link{mut_matrix}}
#'
#' @export

plot_contribution <- function(contribution,
                              signatures = NA,
                              index = NA,
                              coord_flip = FALSE,
                              mode = c("relative", "absolute"),
                              palette = NA) {
  # Match argument
  mode <- match.arg(mode)

  # optional subsetting if index parameter is provided
  if (!.is_na(index)) {
    contribution <- contribution[, index, drop = FALSE]
  }

  # These variables use non standard evaluation.
  # To avoid R CMD check complaints we initialize them to NULL.
  Sample <- Contribution <- Signature <- NULL

  # When working on NMF results, the contribution needs to be multiplied by the signature colSums.
  if (mode == "absolute" & !.is_na(signatures)) {
    # calculate signature contribution in absolute number of signatures
    total_signatures <- colSums(signatures)
    abs_contribution <- contribution * total_signatures
  }

  # Make data long. Also create factors for ordering.
  tb <- contribution %>%
    as.data.frame() %>%
    tibble::rownames_to_column("Signature") %>%
    tidyr::pivot_longer(-Signature, names_to = "Sample", values_to = "Contribution") %>%
    dplyr::mutate(
      Sample = factor(Sample, levels = unique(Sample)),
      Signature = factor(Signature, levels = unique(Signature))
    )

  # Different plotting between absolute and relative
  if (mode == "absolute") {
    bar_geom <- geom_bar(stat = "identity", colour = "black")
    y_lab <- "Absolute contribution \n (no. mutations)"
  } else if (mode == "relative") {
    bar_geom <- geom_bar(position = "fill", stat = "identity", colour = "black")
    y_lab <- "Relative contribution"
  }
  
  # Determine what signatures are present for the legend.
  present_sigs <- tb %>% 
    dplyr::filter(Contribution != 0) %>% 
    dplyr::pull(Signature) %>% 
    unique()
  
  #Create plot
  plot <- ggplot(tb, aes(x = Sample, y = Contribution, fill = Signature)) +
    bar_geom +
    labs(x = "", y = y_lab) +
    scale_fill_discrete(breaks = present_sigs) +
    theme_bw() +
    theme(
      panel.grid.minor.x = element_blank(),
      panel.grid.major.x = element_blank(),
      panel.grid.minor.y = element_blank(),
      panel.grid.major.y = element_blank()
    )

  # Allow custom color palettes.
  if (!.is_na(palette)) {
    plot <- plot + scale_fill_manual(name = "Signature", values = palette)
  }

  # Handle coord_flip.
  if (coord_flip) {
    plot <- plot + coord_flip() + xlim(rev(levels(factor(tb$Sample))))
  } else {
    plot <- plot + xlim(levels(factor(tb$Sample)))
  }

  return(plot)
}