Feature/interactive plots

DESCRIPTION

@@ -42,7 +42,8 @@ Imports:
   	shiny,
   	stringr,
   	stringi,
-  	tidyr
+  	tidyr,
+  	ggiraph
 Suggests:
     spelling, 
     covr,

NAMESPACE

@@ -105,6 +105,7 @@ importFrom(dplyr,select)
 importFrom(dplyr,summarise)
 importFrom(dplyr,summarize)
 importFrom(dplyr,ungroup)
+importFrom(ggiraph,geom_point_interactive)
 importFrom(ggplot2,aes)
 importFrom(ggplot2,aes_string)
 importFrom(ggplot2,annotation_custom)
@@ -138,6 +139,7 @@ importFrom(ggplot2,scale_x_continuous)
 importFrom(ggplot2,scale_x_log10)
 importFrom(ggplot2,scale_y_continuous)
 importFrom(ggplot2,theme)
+importFrom(glue,glue)
 importFrom(magick,image_read)
 importFrom(plyr,.)
 importFrom(readr,col_character)

R/overlaps.R

@@ -171,6 +171,7 @@ create_overlap_distribution_dataset <- function(dat,
 #' function
 #' @param start start start position of chosen protein.
 #' @param end end position of chosen protein.
+#' @inheritParams plot_butterfly
 #' 
 #' @details This plot presents how many times (by how many peptides) 
 #' a amino position in protein sequence is covered. 
@@ -192,13 +193,23 @@ create_overlap_distribution_dataset <- function(dat,
 
 plot_overlap_distribution <- function(overlap_dist_dat,
                                       start = 1,
-                                      end = max(overlap_dist_dat[["pos"]])){
+                                      end = max(overlap_dist_dat[["pos"]]),
+                                      interactive = getOption("hadex_use_interactive_plots")){
 
   mean_coverage <- round(mean(overlap_dist_dat[["coverage"]], na.rm = TRUE), 2)
   display_position <- (start + end)/2
 
+  chosen_geom_col <- if (interactive) ggiraph::geom_col_interactive(
+    aes(tooltip = glue(
+      "Position: {pos}
+       Amino acid: {amino}
+       Coverage: {coverage}"
+    )),
+    width = 1
+  ) else geom_col(width = 1)
+
   overlap_dist_dat_plot <- ggplot(overlap_dist_dat, aes(x = pos, y = coverage)) +
-    geom_col(width = 1) +
+    chosen_geom_col +
     labs(x = 'Position', y = 'Position frequency in peptides') +
     theme(legend.position = "none") + 
     coord_cartesian(xlim = c(start, end)) +

R/plot_amino_distribution.R

@@ -8,6 +8,7 @@
 #' @param hydro_properties ...
 #' @param protein ...
 #' @param charge_colors ...
+#' @inheritParams plot_butterfly
 #' 
 #' @details The data for this function is not packaged yet.
 #' 
@@ -24,17 +25,27 @@
 plot_amino_distribution <- function(position_in_sequence, 
                                     hydro_properties,
                                     protein,
-                                    charge_colors){
+                                    charge_colors,
+                                    interactive = getOption("hadex_use_interactive_plots")){
   amino_groups <- c("G", "A", "V", "I", "L", "F", "P", "M", "S", "T", "Y", "W", "N", "Q", "C", "D", "E", "K", "R", "H")
 
+  chosen_geom_col <- if (interactive) ggiraph::geom_col_interactive(
+    aes(tooltip = glue(
+      "Amino acid: {amino}
+       Charge: {charge}
+       Is hydrophobic? {is_hydrophobic}
+       Count: {cnt}"
+    ))
+  ) else geom_col()
+
   position_in_sequence %>%
     mutate(affinity = ifelse(is_hydrophobic, "phobic", "philic")) %>% 
     filter(affinity %in% hydro_properties) %>%
     mutate(amino = factor(amino, levels = amino_groups)) %>%
     group_by(amino, charge, is_hydrophobic) %>%
     summarise(cnt = n()) %>%
     ggplot(aes(x = amino, y = cnt, fill = charge)) + 
-    geom_col() +
+    chosen_geom_col +
     scale_fill_manual("Charge", values = charge_colors) + 
     labs(title = paste0('Amino acid composition for ', protein),
          x = 'Amino acid',

R/plot_butterfly.R

@@ -9,6 +9,9 @@
 #' @param fractional \code{logical}, determines if values are fractional.
 #' @param uncertainty_type type of presenting uncertainty, possible values:
 #' "ribbon", "bars" or "bars + line".
+#' @param interactive \code{logical}, whether plot should have an interactive 
+#' layer created with with ggiraph, which would add tooltips to the plot in an
+#' interactive display (HTML/Markdown documents or shiny app).
 #' 
 #' @details Function \code{\link{plot_butterfly}} generates butterfly plot
 #' based on provided data and parameters. On X-axis there is peptide ID. On the Y-axis
@@ -26,11 +29,14 @@
 #' plot_butterfly(state_uptake_dat)
 #' 
 #' @export plot_butterfly
+#' @importFrom ggiraph geom_point_interactive
+#' @importFrom glue glue
 
 plot_butterfly <- function(uptake_dat, 
                            theoretical = FALSE, 
                            fractional = FALSE,
-                           uncertainty_type = "ribbon"){
+                           uncertainty_type = "ribbon",
+                           interactive = getOption("hadex_use_interactive_plots")){
 
   uncertainty_type <- match.arg(uncertainty_type, c("ribbon", "bars", "bars + line"))
   state <- unique(uptake_dat[["State"]])
@@ -85,31 +91,40 @@ plot_butterfly <- function(uptake_dat,
                          Start = uptake_dat[["Start"]],
                          End = uptake_dat[["End"]])
 
-  butterfly_plot <- ggplot(plot_dat, aes(x = ID, y = value, color = Exposure)) +
-    geom_point(aes(group = Exposure, color = Exposure)) +
+  chosen_geom_point <- if (interactive) geom_point_interactive( 
+    aes(tooltip = glue(
+      "{Sequence}
+       Position: {Start}-{End}
+       Value: {round(value, 2)}
+       Exposure: {Exposure} min"
+    ))
+  ) else geom_point()
+
+  chosen_uncertainty_geom <- switch (
+    uncertainty_type,
+    ribbon = geom_ribbon(alpha = 0.5, size = 0, linetype = "blank"),
+    bars = geom_errorbar(width = 0.25, alpha = 0.5),
+    `bars + line` = geom_errorbar(width = 0.25, alpha = 0.5) + geom_line()
+  )
+
+  butterfly_plot <- ggplot(
+    plot_dat, 
+    aes(
+      x = ID, 
+      y = value, 
+      group = Exposure, 
+      color = Exposure, 
+      fill = Exposure,
+      ymin = value - err_value, 
+      ymax = value + err_value
+    )) +
+    chosen_uncertainty_geom +
+    chosen_geom_point +
     coord_cartesian(ylim = c(0, NA)) +
     labs(x = "Peptide ID",
          y = y_label) +
     theme(legend.position = "bottom")
 
-  if(uncertainty_type == "ribbon"){
-
-    butterfly_plot <- butterfly_plot +
-      geom_ribbon(aes(x = ID, ymin = value - err_value, ymax = value + err_value, fill = Exposure), alpha = 0.5, size = 0, linetype = "blank")
-
-  } else if (uncertainty_type == "bars") {
-
-    butterfly_plot <- butterfly_plot +
-      geom_errorbar(aes(x = ID, ymin = value - err_value, ymax = value + err_value, color = Exposure), width = 0.25, alpha = 0.5)
-
-  } else if (uncertainty_type == "bars + line"){
-
-    butterfly_plot <- butterfly_plot +
-      geom_errorbar(aes(x = ID, ymin = value - err_value, ymax = value + err_value, color = Exposure), width = 0.25, alpha = 0.5) +
-      geom_line()
-
-  }
-
   return(HaDeXify(butterfly_plot))
 
 }

R/plot_chiclet.R

@@ -11,6 +11,7 @@
 #' @param fractional \code{logical}, determines if values are fractional.
 #' @param show_uncertainty \code{logical}, determines if the
 #' uncertainty is shown. 
+#' @inheritParams plot_butterfly
 #' 
 #' @details Function \code{\link{plot_chiclet}} produces a chiclet
 #' plot based on the same dataset as butterfly plot, as it is the different
@@ -35,7 +36,8 @@
 plot_chiclet <- function(uptake_dat, 
                          theoretical = FALSE, 
                          fractional = FALSE,
-                         show_uncertainty = FALSE){
+                         show_uncertainty = FALSE,
+                         interactive = getOption("hadex_use_interactive_plots")){
 
   state <- unique(uptake_dat[["State"]])
 
@@ -88,8 +90,18 @@ plot_chiclet <- function(uptake_dat,
                          Start = uptake_dat[["Start"]],
                          End = uptake_dat[["End"]])
 
-  chiclet_plot <- ggplot(plot_dat, aes(y = Exposure, x = ID)) +
-    geom_tile(aes(fill = value)) +
+  chosen_tile_geom <- if (interactive) ggiraph::geom_tile_interactive(
+    aes(tooltip = glue(
+      "{Sequence}
+       Position: {Start}-{End}
+       ID: {ID}
+       Value: {round(value, 2)}
+       Exposure: {Exposure} min"
+    ))
+  ) else geom_tile()
+
+  chiclet_plot <- ggplot(plot_dat, aes(y = Exposure, x = ID, fill = value)) +
+    chosen_tile_geom +
     scale_fill_gradient2(low = "blue", mid = "white", high = "red", guide = guide_legend(keywidth = 3)) +
     labs(title = title,
          y = "Exposure [min]",

R/plot_differential.R

@@ -27,6 +27,7 @@
 #' @param all_times \code{logical}, determines if all the time points from the
 #' supplied data should be displayed on the plots next to each other.
 #' @param line_size line size of the lines displayed on the plot.
+#' @inheritParams plot_butterfly
 #'
 #' @details Function \code{\link{plot_differential}} presents
 #' provided data in a form of differential (Woods) plot. The plot shows
@@ -84,7 +85,8 @@ plot_differential <- function(diff_uptake_dat = NULL,
                               hide_tstud_insignificant = FALSE, 
                               confidence_level = 0.98,
                               all_times = FALSE,
-                              line_size = 1.5){
+                              line_size = 1.5,
+                              interactive = getOption("hadex_use_interactive_plots")) {
 
   ## conditions
 
@@ -181,6 +183,15 @@ plot_differential <- function(diff_uptake_dat = NULL,
                          err_value = diff_uptake_dat[[err_value]],
                          Exposure = diff_uptake_dat[["Exposure"]])
 
+  chosen_geom_segment <- if (interactive) ggiraph::geom_segment_interactive( 
+    aes(tooltip = glue(
+      "{Sequence}
+       Position: {Start}-{End}
+       Value: {round(value, 2)}"
+    )),
+    size = line_size
+  ) else geom_segment(size = line_size)
+
   if(hide_houde_insignificant){
 
     plot_dat <- plot_dat[abs(value) >= h_interval[2]]
@@ -200,23 +211,37 @@ plot_differential <- function(diff_uptake_dat = NULL,
 
   }
 
+  differential_base <- function(plot_dat) ggplot(
+    plot_dat,
+    aes(
+      x = Start, 
+      y = value, 
+      xend = End, 
+      yend = value, 
+      color = colour
+    )) +
+    chosen_geom_segment +
+    geom_errorbar(aes(
+      x = Med_Sequence, 
+      ymin = value - err_value, 
+      ymax = value + err_value, 
+    )) +
+    geom_hline(yintercept = 0, linetype = "dotted", color = "green", size = .7) +
+    scale_colour_identity() 
+
   if(show_houde_interval){
 
     plot_dat[, colour := fcase(value > h_interval[2], "firebrick1",
                                value < h_interval[1], "deepskyblue1",
                                default = "azure3")]
 
 
-    differential_plot <- ggplot(plot_dat) +
-      geom_segment(aes(x = Start, y = value, xend = End, yend = value, color = colour), size = line_size) +
-      geom_errorbar(aes(x = Med_Sequence, ymin = value - err_value, ymax = value + err_value, color = colour)) +
-      geom_hline(yintercept = 0, linetype = "dotted", color = "green", size = .7) +
+    differential_plot <- differential_base(plot_dat) +
       ## intervals
       geom_hline(aes(yintercept = h_interval[1], linetype = paste0(" Confidence interval ", confidence_level*100, "% : ", round(h_interval[2], 4))), color = "deepskyblue1", size = .7, show.legend = TRUE) +
       geom_hline(aes(yintercept = h_interval[2], linetype = paste0(" Confidence interval ", confidence_level*100, "% : ", round(h_interval[2], 4))), color = "firebrick1", size = .7, show.legend = FALSE) +
       scale_linetype_manual(values = c("dashed", "dotdash")) +
       ## other
-      scale_colour_identity() +
       labs(title = title,
            x = "Position in the sequence",
            y = y_label,
@@ -231,12 +256,8 @@ plot_differential <- function(diff_uptake_dat = NULL,
                                value < 0, "deepskyblue1",
                                default = "azure3")]
 
-    differential_plot <- ggplot(plot_dat) +
-      geom_segment(aes(x = Start, y = value, xend = End, yend = value, color = colour), size = line_size) +
-      geom_errorbar(aes(x = Med_Sequence, ymin = value - err_value, ymax = value + err_value, color = colour)) +
-      geom_hline(yintercept = 0, linetype = "dotted", color = "green", size = .7) +
+    differential_plot <- differential_base(plot_dat) +
       ## other
-      scale_colour_identity() +
       labs(title = title,
            x = "Position in the sequence",
            y = y_label) +

R/plot_differential_butterfly.R

@@ -15,6 +15,7 @@
 #' @param confidence_level confidence level for the test, from range [0, 1].
 #' Important if selected show_confidence_limit.
 #' @param uncertainty_type ...
+#' @inheritParams plot_butterfly
 #'
 #' @details Function \code{\link{plot_differential_butterfly}} generates
 #' differential butterfly plot based on provided data and parameters. On X-axis
@@ -51,7 +52,8 @@ plot_differential_butterfly <- function(diff_uptake_dat = NULL,
                                         show_houde_interval = FALSE,
                                         show_tstud_confidence = FALSE,
                                         uncertainty_type = "ribbon",
-                                        confidence_level = 0.98){
+                                        confidence_level = 0.98,
+                                        interactive = getOption("hadex_use_interactive_plots")){
 
   uncertainty_type <- match.arg(uncertainty_type, c("ribbon", "bars", "bars + line"))
 
@@ -123,31 +125,40 @@ plot_differential_butterfly <- function(diff_uptake_dat = NULL,
 
   attr(plot_dat, "n_rep") <- attr(diff_uptake_dat, "n_rep")
 
-  butterfly_differential_plot <- ggplot() +
-    geom_point(data = plot_dat, aes(x = ID, y = value, group = Exposure, color = Exposure)) +
+  chosen_geom_point <- if (interactive) geom_point_interactive( 
+    aes(tooltip = glue(
+      "{Sequence}
+       Position: {Start}-{End}
+       Value: {round(value, 2)}
+       Exposure: {Exposure} min"
+    ))
+  ) else geom_point()
+
+  chosen_uncertainty_geom <- switch (
+    uncertainty_type,
+    ribbon = geom_ribbon(alpha = 0.5, size = 0, linetype = "blank"),
+    bars = geom_errorbar(width = 0.25, alpha = 0.5),
+    `bars + line` = geom_errorbar(width = 0.25, alpha = 0.5) + geom_line()
+  )
+
+  butterfly_differential_plot <- ggplot(
+    data = plot_dat, 
+    aes(
+      x = ID, 
+      y = value, 
+      group = Exposure, 
+      color = Exposure, 
+      fill = Exposure,
+      ymin = value - err_value, 
+      ymax = value + err_value
+    )) +
+    chosen_uncertainty_geom +
+    chosen_geom_point +
     labs(title = title,
          x = "Peptide ID",
          y = y_label) +
     theme(legend.position = "bottom")
 
-  if(uncertainty_type == "ribbon"){
-
-    butterfly_differential_plot <- butterfly_differential_plot +
-      geom_ribbon(data = plot_dat, aes(x = ID, ymin = value - err_value, ymax = value + err_value, fill = Exposure), alpha = 0.5, size = 0, linetype = "blank")
-
-  } else if (uncertainty_type == "bars"){
-
-    butterfly_differential_plot <- butterfly_differential_plot +
-      geom_errorbar(data = plot_dat, aes(x = ID, ymin = value - err_value, ymax = value + err_value, color = Exposure), width = 0.25, alpha = 0.5)
-
-  } else if (uncertainty_type == "bars + line"){
-
-    butterfly_differential_plot <- butterfly_differential_plot +
-      geom_errorbar(data = plot_dat, aes(x = ID, ymin = value - err_value, ymax = value + err_value, color = Exposure), width = 0.25, alpha = 0.5) + 
-      geom_line(data = plot_dat, aes(x = ID, y = value, group = Exposure, color = Exposure))
-
-  }
-
   if(show_houde_interval){
 
     # t_value <- qt(c((1 - confidence_level)/2, 1-(1 - confidence_level)/2), df = 2)[2]