Add circular forest plot with br_show_forest_circle() from #42

Introduces the br_show_forest_circle() function for visualizing regression results as circular (polar) forest plots. Updates documentation, NAMESPACE, and pkgdown config to include the new function, and adds tests and references in related documentation files.

Author: ShixiangWang

NAMESPACE

@@ -29,6 +29,7 @@ export(br_show_coxph_diagnostics)
 export(br_show_fitted_line)
 export(br_show_fitted_line_2d)
 export(br_show_forest)
+export(br_show_forest_circle)
 export(br_show_forest_ggstats)
 export(br_show_forest_ggstatsplot)
 export(br_show_nomogram)
@@ -59,6 +60,7 @@ importFrom(ggplot2,ggproto)
 importFrom(ggplot2,labs)
 importFrom(ggplot2,theme)
 importFrom(ggplot2,zeroGrob)
+importFrom(grDevices,rainbow)
 importFrom(lifecycle,deprecated)
 importFrom(mirai,.progress)
 importFrom(rlang,.data)

NEWS.md

@@ -1,9 +1,15 @@
 # bregr (development version)
 
-* Added `br_show_coxph_diagnostics()` for CoxPH diagnostic plots.
-* Added `br_show_nomogram()`.
-* Fixed interaction term display and factor variable scaling in `br_show_nomogram()`.
-* Added `dry_run` option to `br_pipeline()`.
+**Enhancements & New Features:**
+
+- Introduced `br_show_forest_circle()`for circular forest plots.
+- Added diagnostic visualization for Cox PH models via `br_show_coxph_diagnostics()`.
+- Implemented `br_show_nomogram()`for clinical prediction modeling.
+- Added `dry_run`option to `br_pipeline()`for pipeline validation.
+
+**Fixes & Improvements:**
+
+- Resolved interaction term display and factor scaling in `br_show_nomogram()`.
 
 # bregr 1.1.0
 

R/00-bregr-package.R

@@ -10,6 +10,7 @@
 #' @importFrom rlang .data .env
 #' @importFrom utils combn packageDescription packageVersion
 #' @importFrom stats cor pchisq quantile predict sd nobs fitted
+#' @importFrom grDevices rainbow
 #' @rawNamespace if (getRversion() < "4.3.0") importFrom("S7", "@")
 ## usethis namespace: end
 NULL

R/04-show.R

@@ -1409,3 +1409,277 @@ br_show_nomogram <- function(breg,
     cli::cli_abort("Nomograms are currently supported for Cox regression (coxph) and linear/generalized linear models (lm/glm)")
   }
 }
+
+#' Show a circular forest plot for regression results
+#'
+#' @description
+#' `r lifecycle::badge('experimental')`
+#'
+#' This function creates a circular (polar) forest plot from regression results,
+#' providing an alternative visualization to the traditional linear forest plot.
+#' The function uses the same input as [br_show_forest()] but displays the results
+#' in a circular format using [ggplot2::coord_polar()].
+#'
+#' @param breg A regression object with results.
+#' @param rm_controls If `TRUE`, remove control terms.
+#' @param style Character string specifying the style of circular forest plot.
+#' Options are:
+#' - `"points"` (default): Display point estimates with error bars in circular format
+#' - `"bars"`: Display as bars with points overlaid
+#' @param ref_line Logical or numeric. If `TRUE`, shows reference circle at default value
+#' (1 for exponentiated estimates, 0 for regular estimates).
+#' If numeric, shows reference circle at specified value.
+#' If `FALSE`, no reference circle is shown.
+#' @param sort_by Character string specifying how to sort the variables.
+#' Options are:
+#' - `"none"` (default): No sorting, use original order
+#' - `"estimate"`: Sort by effect estimate (ascending)
+#' - `"estimate_desc"`: Sort by effect estimate (descending)
+#' - `"pvalue"`: Sort by p-value (ascending, most significant first)
+#' - `"variable"`: Sort alphabetically by variable name
+#' @param subset Expression for subsetting the results data (`br_get_results(breg)`).
+#' @param log_first Log transformed the estimates and their confident intervals.
+#' @returns A ggplot object
+#' @export
+#' @family br_show
+#' @examples
+#' m <- br_pipeline(mtcars,
+#'   y = "mpg",
+#'   x = colnames(mtcars)[2:4],
+#'   x2 = "vs",
+#'   method = "gaussian"
+#' )
+#' br_show_forest_circle(m)
+#' br_show_forest_circle(m, style = "bars")
+#' br_show_forest_circle(m, sort_by = "estimate")
+#' br_show_forest_circle(m, ref_line = FALSE)
+#' br_show_forest_circle(m, ref_line = 0.5)
+#' @testexamples
+#' assert_s3_class(br_show_forest_circle(m), "ggplot")
+br_show_forest_circle <- function(
+    breg,
+    rm_controls = FALSE,
+    style = c("points", "bars"),
+    ref_line = TRUE,
+    sort_by = c("none", "estimate", "estimate_desc", "pvalue", "variable"),
+    subset = NULL,
+    log_first = FALSE) {
+  assert_breg_obj_with_results(breg)
+  assert_bool(rm_controls)
+  style <- match.arg(style)
+  sort_by <- match.arg(sort_by)
+
+  # Get the data using br_get_results
+  dt <- br_get_results(breg)
+
+  if (log_first) {
+    dt <- dt |> dplyr::mutate(
+      estimate = log(.data$estimate),
+      conf.high = log(.data$conf.high),
+      conf.low = log(.data$conf.low)
+    )
+  }
+
+  # Determine reference line value based on exponentiate attribute
+  exponentiate <- attr(breg, "exponentiate")
+  default_ref_value <- if (exponentiate && !log_first) 1L else 0L
+
+  # Handle ref_line parameter following br_show_forest design
+  if (is.logical(ref_line)) {
+    if (ref_line) {
+      ref_line_value <- default_ref_value
+      show_ref_line <- TRUE
+    } else {
+      show_ref_line <- FALSE
+      ref_line_value <- NULL
+    }
+  } else if (is.numeric(ref_line)) {
+    ref_line_value <- ref_line
+    show_ref_line <- TRUE
+  } else {
+    cli_abort("ref_line must be logical or numeric")
+  }
+
+  if (rm_controls) {
+    dt <- dt |> dplyr::filter(.data$Focal_variable == .data$variable)
+  }
+
+  subset <- rlang::enquo(subset)
+  if (!rlang::quo_is_null(subset)) {
+    dt <- dt |> dplyr::filter(!!subset)
+  }
+
+  # Enhanced data validation and cleaning
+  dt <- dt |>
+    dplyr::mutate(
+      # Handle infinite and missing values
+      conf.low = dplyr::case_when(
+        is.na(.data$conf.low) | is.infinite(.data$conf.low) ~ .data$estimate,
+        TRUE ~ .data$conf.low
+      ),
+      conf.high = dplyr::case_when(
+        is.na(.data$conf.high) | is.infinite(.data$conf.high) ~ .data$estimate,
+        TRUE ~ .data$conf.high
+      ),
+      # Filter for valid estimates
+      valid_estimate = !is.na(.data$estimate) & !is.infinite(.data$estimate) &
+        !is.na(.data$conf.low) & !is.na(.data$conf.high)
+    ) |>
+    dplyr::filter(.data$valid_estimate) |>
+    dplyr::select(-"valid_estimate")
+
+  # Check if we have valid data after filtering
+  if (nrow(dt) == 0) {
+    cli::cli_abort("no valid data to plot")
+  }
+
+  # Apply sorting
+  if (sort_by != "none") {
+    dt <- switch(sort_by,
+      "estimate" = dt |> dplyr::arrange(.data$estimate),
+      "estimate_desc" = dt |> dplyr::arrange(dplyr::desc(.data$estimate)),
+      "pvalue" = dt |> dplyr::arrange(.data$p.value),
+      "variable" = dt |> dplyr::arrange(.data$variable),
+      dt # fallback to original order
+    )
+  }
+
+  # Create display labels and positioning
+  dt <- dt |>
+    dplyr::mutate(
+      display_label = dplyr::case_when(
+        !is.na(.data$label) & .data$label != "" ~ .data$label,
+        TRUE ~ .data$variable
+      ),
+      # Create unique labels in case of duplicates
+      display_label = make.unique(.data$display_label, sep = "_"),
+      x_pos = factor(.data$display_label, levels = unique(.data$display_label))
+    )
+
+  # Handle grouping for colors - robust approach
+  has_group <- !is.null(br_get_group_by(breg))
+  if (has_group && "Group_variable" %in% colnames(dt) && length(unique(dt$Group_variable)) > 1) {
+    color_var <- "Group_variable"
+  } else if ("Focal_variable" %in% colnames(dt) && length(unique(dt$Focal_variable)) > 1) {
+    color_var <- "Focal_variable"
+  } else {
+    color_var <- "variable"
+  }
+
+  # Create the base plot
+  if (style == "points") {
+    # Points style with proper error bars using segments for polar coordinates
+    p <- ggplot2::ggplot(dt, ggplot2::aes(x = .data$x_pos)) +
+      ggplot2::geom_point(
+        ggplot2::aes(y = .data$estimate, color = .data[[color_var]]),
+        size = 2
+      ) +
+      ggplot2::geom_segment(
+        ggplot2::aes(
+          y = .data$conf.low,
+          yend = .data$conf.high,
+          color = .data[[color_var]]
+        ),
+        linewidth = 0.8
+      )
+  } else {
+    # Bars style
+    base_offset <- max(abs(c(dt$conf.low, dt$conf.high, dt$estimate)), na.rm = TRUE) + 1
+
+    dt <- dt |>
+      dplyr::mutate(
+        bar_height = 1, # Base height for bars
+        point_y = .data$estimate + base_offset, # Offset points above bars
+        ci_low = .data$conf.low + base_offset, # Offset CI accordingly
+        ci_high = .data$conf.high + base_offset
+      )
+
+    p <- ggplot2::ggplot(dt, ggplot2::aes(x = .data$x_pos)) +
+      ggplot2::geom_col(
+        ggplot2::aes(y = .data$bar_height, fill = .data[[color_var]]),
+        alpha = 0.3, width = 1
+      ) +
+      ggplot2::geom_point(
+        ggplot2::aes(y = .data$point_y, color = .data[[color_var]]),
+        size = 1.5
+      ) +
+      ggplot2::geom_segment(
+        ggplot2::aes(
+          y = .data$ci_low,
+          yend = .data$ci_high,
+          color = .data[[color_var]]
+        ),
+        linewidth = 0.8
+      )
+  }
+
+  # Convert to polar coordinates
+  p <- p + ggplot2::coord_polar()
+
+  # Add reference circle if requested
+  if (show_ref_line) {
+    ref_y <- if (style == "points") {
+      ref_line_value
+    } else {
+      ref_line_value + base_offset
+    }
+    p <- p + ggplot2::geom_hline(
+      yintercept = ref_y,
+      linetype = "dashed",
+      color = "gray60",
+      linewidth = 0.5
+    )
+  }
+
+  # Enhanced theming with proper axis display
+  axis_label <- if (log_first) "log(Estimate)" else "Estimate"
+
+  p <- p +
+    ggplot2::theme_minimal() +
+    ggplot2::theme(
+      # Remove default polar grid lines for cleaner visualization
+      panel.grid.major.x = ggplot2::element_blank(),
+      panel.grid.minor.x = ggplot2::element_blank(),
+      panel.grid.minor.y = ggplot2::element_blank(),
+      # Keep radial grid lines but make them subtle
+      panel.grid.major.y = ggplot2::element_line(
+        color = "gray80",
+        linewidth = 0.3,
+        linetype = "dotted"
+      ),
+      # Display proper variable names on angular axis
+      axis.text.x = ggplot2::element_text(size = 8, color = "black"),
+      # Display numerical values on radial axis
+      axis.text.y = ggplot2::element_text(size = 8, color = "black"),
+      axis.title = ggplot2::element_blank(),
+      legend.position = "right",
+      plot.title = ggplot2::element_text(hjust = 0.5, size = 14),
+      legend.title = ggplot2::element_text(size = 10),
+      legend.text = ggplot2::element_text(size = 8),
+      panel.background = ggplot2::element_blank()
+    ) +
+    ggplot2::labs(
+      title = glue::glue("Circular Forest Plot ({axis_label})"),
+      color = gsub("_", " ", color_var)
+    )
+
+  # Apply color palette
+  n_groups <- length(unique(dt[[color_var]]))
+  if (n_groups > 1) {
+    # Colors inspired by reference code
+    colors <- c("#3cc34e", "#00aeff", "#ff800e", "#6A51A3", "#2B8CBE", "#E31A1C", "#FF7F00", "#33A02C")
+    if (n_groups > length(colors)) {
+      colors <- rainbow(n_groups)
+    }
+    colors <- colors[1:n_groups]
+
+    p <- p + ggplot2::scale_color_manual(values = colors)
+
+    # Only add fill scale if style uses bars (which uses fill aesthetic)
+    if (style == "bars") {
+      p <- p + ggplot2::scale_fill_manual(values = colors, guide = "none")
+    }
+  }
+
+  return(p)
+}

_pkgdown.yml

@@ -26,6 +26,7 @@ reference:
     desc: Visualize results using forest plots and more.
     contents:
     - br_show_forest
+    - br_show_forest_circle
     - br_show_risk_network
     - br_show_forest_ggstats
     - br_show_forest_ggstatsplot