Simo notes

.Rbuildignore

@@ -6,3 +6,4 @@
 ^\.github$
 ^doc$
 ^Meta$
+^CRAN-SUBMISSION$

CRAN-SUBMISSION

@@ -0,0 +1,3 @@
+Version: 1.0.0
+Date: 2026-03-24 13:52:37 UTC
+SHA: 9135f346b2d257f06fc8cf0d3fba92738210b821

DESCRIPTION

@@ -27,7 +27,7 @@ Depends:
      R (>= 4.5)
 Imports:
     ggplot2,
-    ggrepel,
+    HDInterval,
     purrr,
     dplyr,
     magrittr,

NAMESPACE

@@ -2,12 +2,11 @@
 
 export(extract_fit)
 export(plot_volcano)
-export(prepare_volcano_df)
+export(prepare_volcano_input)
 import(ggplot2)
-import(ggrepel)
 import(magrittr)
+importFrom(HDInterval,hdi)
 importFrom(dplyr,left_join)
 importFrom(purrr,list_rbind)
 importFrom(stats,median)
-importFrom(stats,quantile)
 importFrom(tidyr,pivot_longer)

R/plot_volcano.R

@@ -1,25 +1,13 @@
 #' Plot Bayesian Volcano plot
 #'
-#' @param result from [prepare_volcano_df()] (a list with `result` and `meta`).
+#' @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 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").
-#' If `NULL`, no labels are shown.
-#' @param label.parameter.threshold Numeric vector of length 1, absolute lower bound for label
-#' If `NULL` or missing, all points are considered for labeling.
-#' @param label.pi.threshold numeric vector of length 1, absolute lower bound for label
-#' If `NULL` or missing, all points are considered for labeling.
-#' for y-axis to trigger labeling.
-#' If `NULL` or missing, all points are considered for labeling.
-#' @param title Character. Title of plot
-#' @param xlab Character. x-axis label of plot
 #'
 #' @returns a ggplot2 object
 #'
 #' @import ggplot2
-#' @import ggrepel
 #'
 #' @export
 #'
@@ -29,139 +17,113 @@
 #' data("annotation_df")
 #' head(annotation_df)
 #'
-#' result <- prepare_volcano_df(
+#' result <- prepare_volcano_input(
 #'   posterior = posterior,
-#'   annotation_df = annotation_df,
+#'   annotation = annotation_df,
 #' )
 #' plot_volcano(result,
 #'   color = "group",
-#'   label = "label",
-#'   label.pi.threshold = 0.9,
-#'   label.parameter.threshold = 0.5
+#'   CrI = TRUE,
+#'   CrI_width = TRUE
 #' )
 plot_volcano <- function(result,
                          CrI = FALSE,
-                         CrI.width = FALSE,
-                         color = NULL,
-                         label = NULL,
-                         label.parameter.threshold = NULL,
-                         label.pi.threshold = NULL,
-                         title = "Bayesian Volcano Plot",
-                         xlab = "median parameter value") {
+                         CrI_width = FALSE,
+                         color = NULL) {
   # Input validation
-  if (!is.list(result) || !("result" %in% names(result)) || !("meta" %in% names(result))) {
-    stop("Argument 'result' must be a list with 'result' and 'meta' components from prepare_volcano_df().")
-  }
-
-  df <- result$result
-
-  # Check if label column exists
-  if (!is.null(label) && !(label %in% names(df))) {
-    stop("Label column '", label, "' not found in result$result.")
-  }
-
-  # Check if color column exists
-  if (!is.null(color) && !(color %in% names(df))) {
-    stop("Color column '", color, "' not found in result$result.")
-  }
-
-  # Check if threshold vectors are valid
-  if (!is.null(label.parameter.threshold)) {
-    if (!is.numeric(label.parameter.threshold) | length(label.parameter.threshold) > 1) {
-      stop("label.parameter.threshold must be a numeric of length 1")
-    }
-  }
-
-  if (!is.null(label.pi.threshold)) {
-    if (!is.numeric(label.pi.threshold) | length(label.pi.threshold) > 1) {
-      stop("label.pi.threshold must be a numeric of length 1")
-    }
-  }
-
-  if (!(is.character(title) & is.character(xlab))) {
-    stop("'xlab' and 'title' must be character values")
+  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
-  distance.CrI <- NULL
+  CrI.level <- NULL
+  CrI.width <- NULL
 
   # create base plot ####
   ## get threshold
-  t <- result$meta$zero.effect
+  t <- unique(result$null.effect)
 
-  subtitle <- paste0("vertical black line: zero effect of parameter = ", t)
+  title <- "Bayesian Volcano plot"
+  subtitle <- paste0("vertical grey line: zero effect of parameter = ", t)
 
-  p <- ggplot(df, (aes(x = parameter.median, y = pi.value))) +
+  p <- ggplot(result, (aes(x = parameter.median, y = pi.value))) +
     geom_point() +
     theme_bw() +
-    # mark user set zero.effect
-    geom_vline(aes(xintercept = t)) +
+    # mark user set null.effect
+    geom_vline(aes(xintercept = t),col="grey") +
     xlab(xlab) +
-    ylab("pi") +
+    ylab(expression(pi)) +
     ggtitle(title, subtitle)
-
-  if (CrI.width == TRUE) {
+
+  # add errorbar ####
+  if (CrI == TRUE) {
     subtitle <- paste0(
       subtitle, "\n",
-      "point size = |CrI|"
+      "errorbar: ",unique(result$CrI.level)*100," % CrI"
     )
-    p <- ggplot(df, (aes(x = parameter.median, y = pi.value))) +
-      geom_point(aes(size = -CrI.width)) +
+
+    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 zero.effect
-      geom_vline(aes(xintercept = t)) +
+      # mark user set null.effect
+      geom_vline(aes(xintercept = t),col="grey") +
       xlab(xlab) +
-      ylab("pi") +
+      ylab(expression(pi)) +
       ggtitle(title, subtitle)
   }
 
-  # add errorbar ####
-  if (CrI == TRUE) {
+  if (CrI_width == TRUE) {
     subtitle <- paste0(
       subtitle, "\n",
-      "errorbar: CrI ", result$meta$CrI.low, ", ", result$meta$CrI.high
+      "point size = |CrI|"
     )
-
-    p <- p +
-      geom_errorbar(aes(xmin = parameter.low, xmax = parameter.high), col = "grey") +
+    p <- p + 
+      geom_point(aes(size = -CrI.width)) +
       ggtitle(title, subtitle)
   }
 
   # add color ####
   if (!is.null(color)) {
-    if (CrI.width == FALSE) {
-      if (is.numeric(df[[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(df[[color]])) {
+      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(df[[color]])) {
+    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(df[[color]])) {
+      if (is.character(result[[color]])) {
         temp <- as.symbol(color)
         temp <- enquo(temp)
         p <- p +
@@ -170,37 +132,5 @@ plot_volcano <- function(result,
       }
     }
   }
-  # add label ####
-  if (!is.null(label)) {
-    # make useable for ggplot
-    temp <- as.symbol(label)
-    temp <- enquo(temp)
-    # if null set to zero
-    if (is.null(label.parameter.threshold)) {
-      label.parameter.threshold <- 0
-    }
-    if (is.null(label.pi.threshold)) {
-      label.pi.threshold <- 0
-    }
-
-    subtitle <- paste0(
-      subtitle, "\n",
-      paste0(
-        "grey lines: label thresholds, |parameter| > ",
-        label.parameter.threshold, ", pi > ", label.pi.threshold
-      )
-    )
-
-
-    p <- p +
-      geom_text_repel(aes(label = ifelse(abs(parameter.median) > label.parameter.threshold & pi.value > label.pi.threshold,
-        yes = !!temp, no = ""
-      ))) +
-      geom_vline(aes(xintercept = label.parameter.threshold), col = "grey") +
-      geom_vline(aes(xintercept = -label.parameter.threshold), col = "grey") +
-      geom_hline(aes(yintercept = label.pi.threshold), col = "grey") +
-      ggtitle(title, subtitle)
-  }
-
   return(p)
 }