BayesVolcano/R/plot_volcano.R at 5294ea6b8dbfddb8003bade215d1a966f521cd39 · KatjaDanielzik/BayesVolcano · GitHub

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
#' Plot Bayesian Volcano plot
#'
#' @param result from [prepare_volcano_input()] (a data frame).
#' @param CrI Logical. Whether to display the CrI Interval of the parameter
#' @param CrI_width Logical. Whether to display the CrI width as point size.
#' @param color Column in `result$result. Can be numerical or character.
#'
#' @returns a ggplot2 object
#'
#' @import ggplot2
#'
#' @export
#'
#' @examples
#' data("posterior")
#' head(posterior)
#' data("annotation_df")
#' head(annotation_df)
#'
#' result <- prepare_volcano_input(
#'   posterior = posterior,
#'   annotation = annotation_df,
#' )
#' plot_volcano(result,
#'   color = "group",
#'   CrI = TRUE,
#'   CrI_width = TRUE
#' )
plot_volcano <- function(result,
                         CrI = FALSE,
                         CrI_width = FALSE,
                         color = NULL) {
  # Input validation
  if (!is.data.frame(result)) {
    stop("'result' must be a data frame.")
  }

  if (!is.logical(c(CrI))) {
    stop("'CrI' must be either 'TRUE' or 'FALSE'")
  }
  if (!is.logical(c(CrI_width))) {
    stop("'CrI_width' must be either 'TRUE' or 'FALSE'")
  }

  # Binding of global variables
  parameter.median <- NULL
  pi.value <- NULL
  null.effect <- NULL
  parameter.low <- NULL
  parameter.high <- NULL
  CrI.level <- NULL
  CrI.width <- NULL

  # create base plot ####
  ## get threshold
  t <- unique(result$null.effect)

  title <- "Bayesian Volcano plot"
  subtitle <- paste0("vertical grey line: zero effect of parameter = ", t)

  p <- ggplot(result, (aes(x = parameter.median, y = pi.value))) +
    geom_point() +
    theme_bw() +
    # mark user set null.effect
    geom_vline(aes(xintercept = t),col="grey") +
    xlab(xlab) +
    ylab(expression(pi)) +
    ggtitle(title, subtitle)

  # add errorbar ####
  if (CrI == TRUE) {
    subtitle <- paste0(
      subtitle, "\n",
      "errorbar: ",unique(result$CrI.level)*100," % CrI"
    )

    p <- ggplot(result, (aes(x = parameter.median, y = pi.value))) +
      geom_errorbar(aes(xmin = parameter.low, xmax = parameter.high),
                    col = "grey",
                    width = 0) +
      geom_point() +
      theme_bw() +
      # mark user set null.effect
      geom_vline(aes(xintercept = t),col="grey") +
      xlab(xlab) +
      ylab(expression(pi)) +
      ggtitle(title, subtitle)
  }

  if (CrI_width == TRUE) {
    subtitle <- paste0(
      subtitle, "\n",
      "point size = |CrI|"
    )
    p <- p +
      geom_point(aes(size = -CrI.width)) +
      ggtitle(title, subtitle)
  }

  # add color ####
  if (!is.null(color)) {
    if (CrI_width == FALSE) {
      if (is.numeric(result[[color]])) {
        temp <- as.symbol(color)
        temp <- enquo(temp)
        p <- p +
          geom_point(aes(col = !!temp)) +
          scale_color_viridis_c()
      }
      if (is.character(result[[color]])) {
        temp <- as.symbol(color)
        temp <- enquo(temp)
        p <- p +
          geom_point(aes(col = !!temp)) +
          scale_color_viridis_d()
      }
    }
    if (CrI_width == TRUE) {
      if (is.numeric(result[[color]])) {
        temp <- as.symbol(color)
        temp <- enquo(temp)
        p <- p +
          geom_point(aes(col = !!temp, size = -CrI.width)) +
          scale_color_viridis_c()
      }
      if (is.character(result[[color]])) {
        temp <- as.symbol(color)
        temp <- enquo(temp)
        p <- p +
          geom_point(aes(col = !!temp, size = -CrI.width)) +
          scale_color_viridis_d()
      }
    }
  }
  return(p)
}