add CrI width display

Author: KatjaDanielzik

DESCRIPTION

@@ -5,6 +5,8 @@ Authors@R:
   c(person(given="Katja",family= "Danielzik", email="katja.danielzik@uni-due.de", 
            role = c("aut", "cre","cph"),
            comment=c(ORCID="0009-0007-5021-6212")),
+    person(given="Simo",family="Kitanovski",role="aut",
+           comment=c(ORCID="0000-0003-2909-5376")),
     person(given="Daniel",family="Hoffmann",role="aut",
            comment=c(ORCID="0000-0003-2973-7869")))
 URL: https://github.com/KatjaDanielzik/BayesVolcano

R/plot_volcano.R

@@ -2,6 +2,7 @@
 #'
 #' @param result from [prepare_volcano_df()] (a list with `result` and `meta`).
 #' @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.
 #' @param label Character column name in `result$result` to use for labeling 
 #' points (e.g., "label", "parameter").
@@ -40,6 +41,7 @@
 
 plot_volcano <- function(result,
                          CrI = FALSE,
+                         CrI.width = FALSE,
                          color = NULL,
                          label = NULL,
                          label.parameter.threshold = NULL,
@@ -90,6 +92,7 @@ plot_volcano <- function(result,
   pi.value <- NULL
   parameter.low <- NULL
   parameter.high <- NULL
+  distance.CrI <- NULL
 
   # create base plot ####
   ## get threshold
@@ -106,6 +109,19 @@ plot_volcano <- function(result,
     ylab("pi")+
     ggtitle(title, subtitle)
 
+  if(CrI.width==TRUE){
+    subtitle <- paste0(subtitle,'\n',
+"point size = |CrI|")
+    p <- ggplot(df,(aes(x=parameter.median,y=pi.value))) +
+      geom_point(aes(size=-CrI.width))+
+      theme_bw()+
+      # mark user set zero.effect
+      geom_vline(aes(xintercept=t))+
+      xlab(xlab)+
+      ylab("pi")+
+      ggtitle(title, subtitle)
+  }
+  
   # add errorbar ####
   if(CrI==TRUE){
 
@@ -119,22 +135,40 @@ plot_volcano <- function(result,
 
   # add color ####
   if(!is.null(color)){
-    if(is.numeric(df[[color]])){
-    temp <- as.symbol(color)
-    temp <- enquo(temp)
-    p <- p+
-      geom_point(aes(col = !!temp))+
-      scale_color_viridis_c()
-    }
-    if(is.character(df[[color]])){
+    if(CrI.width==FALSE){
+      if(is.numeric(df[[color]])){
       temp <- as.symbol(color)
       temp <- enquo(temp)
       p <- p+
         geom_point(aes(col = !!temp))+
-        scale_color_viridis_d()
+        scale_color_viridis_c()
+      }
+      if(is.character(df[[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(df[[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(df[[color]])){
+        temp <- as.symbol(color)
+        temp <- enquo(temp)
+        p <- p+
+          geom_point(aes(col = !!temp,size=-CrI.width))+
+          scale_color_viridis_d()
+      }
+      
     }
   }
-  
   # add label ####
   if(!is.null(label)){
     # make useable for ggplot

R/prepare_volcano_df.R

@@ -30,6 +30,7 @@
 #'     \item \code{parameter.median}: median posterior parameter value
 #'     \item \code{parameter.low}: lower boundary of CrI of parameter value
 #'     \item \code{paramter.high}: upper boundary of CrI of parameter value
+#'     \item \code{CrI.width}: the absolute distance parameter.low and parameter.high
 #'     \item \code{label}: biological label (e.g., `cell.line`)
 #'     \item Other columns from `annotation_df` (e.g., `group`, `condition`)
 #'   }
@@ -122,14 +123,17 @@ prepare_volcano_df <- function(
     median_val <- median(values)
     crI_low <- stats::quantile(values, probs = CrI.low, na.rm = TRUE)
     crI_high <- stats::quantile(values, probs = CrI.high, na.rm = TRUE)
+    CrI_width <- .CrI.width(CrI.low = crI_low, CrI.high = crI_high)
+    
+    # Return as data frame
 
-    # Return as list
     return(as.data.frame(cbind(
       parameter = param,
       pi.value = pi_value,
       parameter.median = median_val,
       parameter.low = crI_low,
-      parameter.high = crI_high
+      parameter.high = crI_high,
+      CrI.width = CrI_width
     )))
   })
 
@@ -145,6 +149,7 @@ prepare_volcano_df <- function(
   result$parameter.median <- as.numeric(result$parameter.median)
   result$parameter.low <- as.numeric(result$parameter.low)
   result$parameter.high <- as.numeric(result$parameter.high)
+  result$CrI.width <- as.numeric(result$CrI.width)
 
   return(list(result=result,meta=list(CrI.low=as.numeric(CrI.low),
                                       CrI.high=as.numeric(CrI.high),

R/utils.R

@@ -11,4 +11,15 @@
   l <- length(value)
   pi <- 2*max(sum(value<=zero.effect)/l, sum(value>=zero.effect)/l)-1
   return(pi)
+}
+
+#' CrI width
+#'
+#' @param CrI.low lower bound of credible interval
+#' @param CrI.high upper bound of credible interval
+#'
+#' @returns absolute distance between CrI and zero effect
+#' @keywords internal
+.CrI.width <- function(CrI.low, CrI.high){
+  d.CrI <- abs(CrI.high-CrI.low)
 }

man/dot-CrI.width.Rd

@@ -214,7 +214,7 @@ test_that("Left join with annotation_df preserves additional columns", {
 
   expect_equal(names(result$result), c(
     "parameter", "pi.value", "parameter.median", "parameter.low", "parameter.high",
-    "label", "group", "condition"
+    "CrI.width","label", "group", "condition"
   ))
 })