R/crowd_plots_as_tabset.R

In saros: Semi-Automatic Reporting of Ordinary Surveys

#' Convert List of Plots to Quarto Tabset
#'
#' @description
#' Creates a Quarto tabset from a named list of ggplot2 objects, typically
#' generated by [makeme()] with `crowd` parameter. Each plot becomes a tab
#' with automatic height calculation and optional download links.
#'
#' @param plot_list A named list of ggplot2 objects. Names become tab labels.
#'   Typically created with `makeme(crowd = c("target", "others"))`.
#' @param plot_type Character. Type of plots in the list. One of:
#'   - `"cat_plot_html"` (default): Categorical horizontal bar charts
#'   - `"int_plot_html"`: Interval plots (violin/box plots)
#'   - `"auto"`: Auto-detect from first non-NULL plot's data structure
#' @param save Logical. If `TRUE` (default), generates download links for plot
#'   data and images via [get_fig_title_suffix_from_ggplot()].
#' @param fig_height Numeric or NULL. Manual figure height override in inches.
#'   If `NULL` (default), height is calculated automatically based on `plot_type`.
#' @param fig_height_int_default Numeric. Default height for interval plots when
#'   auto-calculation is not available (default: 6 inches).
#'
#' @return Invisibly returns `NULL`. The function's purpose is its side effect
#'   of printing Quarto markdown that creates a tabset.
#'
#' @details
#' This function is designed to be called within a Quarto document code chunk.
#' It generates markdown that creates a tabset where each non-NULL plot in
#' `plot_list` appears as a separate tab.
#'
#' **Height Calculation:**
#' - For `"cat_plot_html"`: Uses [fig_height_h_barchart2()] which accounts for
#'   number of variables, categories, and label lengths
#' - For `"int_plot_html"`: Uses `fig_height_int_default` (simpler plots need
#'   less sophisticated calculation)
#' - For `"auto"`: Detects type by checking for `.category` column (categorical)
#'   vs numeric statistics columns (interval)
#'
#' **Requirements:**
#' - Must be run within knitr/Quarto context
#' - Plots should be created with [makeme()]
#' - Plot list should have meaningful names for tab labels
#'
#' @seealso
#' - [makeme()] for creating plots with crowd parameter
#' - [fig_height_h_barchart2()] for categorical plot height calculation
#' - [get_fig_title_suffix_from_ggplot()] for caption generation
#' - [girafe()] for interactive plot rendering
#'
#' @export
#'
#' @examples
#' \dontrun{
#' # In a Quarto document
#' plots <- makeme(
#'   data = ex_survey,
#'   dep = b_1:b_3,
#'   crowd = c("target", "others"),
#'   mesos_var = "f_uni",
#'   mesos_group = "Uni of A"
#' )
#'
#' # Create tabset with auto-detection
#' crowd_plots_as_tabset(plots)
#'
#' # Create tabset for interval plots
#' int_plots <- makeme(
#'   data = ex_survey,
#'   dep = c_1:c_2,
#'   indep = x1_sex,
#'   type = "int_plot_html",
#'   crowd = c("target", "others"),
#'   mesos_var = "f_uni",
#'   mesos_group = "Uni of A"
#' )
#' crowd_plots_as_tabset(int_plots, plot_type = "int_plot_html")
#'
#' # Without download links
#' crowd_plots_as_tabset(plots, save = FALSE)
#'
#' # With manual height override
#' crowd_plots_as_tabset(plots, fig_height = 8)
#' }
crowd_plots_as_tabset <- function(
  plot_list,
  plot_type = c("cat_plot_html", "int_plot_html", "auto"),
  save = FALSE,
  fig_height = NULL,
  fig_height_int_default = 6
) {
  # Validate inputs
  if (!is.list(plot_list)) {
    cli::cli_abort(
      "{.arg plot_list} must be a list, not {.cls {class(plot_list)}}."
    )
  }

  if (length(plot_list) == 0) {
    cli::cli_warn("{.arg plot_list} is empty. No tabset will be created.")
    return(invisible(NULL))
  }

  # Filter out NULL plots
  non_null_plots <- !vapply(plot_list, is.null, logical(1))

  if (!any(non_null_plots)) {
    cli::cli_warn(
      "All plots in {.arg plot_list} are NULL. No tabset will be created."
    )
    return(invisible(NULL))
  }

  # Match plot_type argument
  plot_type <- match.arg(plot_type)

  # Auto-detect plot type if requested
  if (plot_type == "auto") {
    first_plot <- plot_list[[which(non_null_plots)[1]]]
    if (!ggplot2::is_ggplot(first_plot)) {
      cli::cli_warn(c(
        "{.arg plot_list} first non-NULL element is not a valid ggplot object.",
        "i" = "Defaulting to {.val cat_plot_html}."
      ))
      plot_type <- "cat_plot_html"
    } else {
      # Inspect geoms/layers to detect plot type. This is robust because
      # 'int_plot_html' uses violin/box geoms while 'cat_plot_html' uses cols/bars.
      layer_geoms <- vapply(
        first_plot$layers,
        function(l) {
          gclass <- class(l$geom)[1]
          if (is.null(gclass)) "" else gclass
        },
        character(1)
      )

      # Lowercase for simpler matching
      layer_geoms_lc <- tolower(layer_geoms)

      if (
        any(grepl("violin|boxplot|geom_violin|geom_boxplot", layer_geoms_lc))
      ) {
        plot_type <- "int_plot_html"
      } else if (any(grepl("col|bar|geom_col|geom_bar", layer_geoms_lc))) {
        plot_type <- "cat_plot_html"
      } else {
        # Fallback: try to infer from data columns, but do not rely on it.
        if (
          !is.null(first_plot$data) &&
            ".category" %in% colnames(first_plot$data)
        ) {
          plot_type <- "cat_plot_html"
        } else {
          cli::cli_warn(
            c(
              "Could not auto-detect plot type from layers or data.",
              "i" = "Defaulting to {.val cat_plot_html}."
            )
          )
          plot_type <- "cat_plot_html"
        }
      }
    }
  }

  # Generate tabset
  out <-
    lapply(names(plot_list), function(.x) {
      plot <- plot_list[[.x]]

      # Skip NULL plots
      if (is.null(plot)) {
        return(NULL)
      }

      # Validate that each plot is a ggplot object
      if (!ggplot2::is_ggplot(plot)) {
        cli::cli_warn(c(
          "Plot {.val {.x}} is not a valid ggplot object.",
          "i" = "Skipping this plot."
        ))
        return(NULL)
      }

      # Determine figure height
      if (!is.null(fig_height)) {
        height_code <- sprintf("fig.height = %s", fig_height)
      } else if (plot_type == "cat_plot_html") {
        height_code <- "fig.height = saros::fig_height_h_barchart2(plot_list[[.x]])"
      } else {
        # int_plot_html or other types use simple default
        height_code <- sprintf("fig.height = %s", fig_height_int_default)
      }

      # Caption generation code
      cap_str <- sprintf(
        'caption <- saros::get_fig_title_suffix_from_ggplot(plot_list[[.x]],  save=%s)',
        save
      )

      # Generate knitr child document
      knitr::knit_child(
        text = c(
          '',
          '',
          '##### `r .x`',
          '',
          '```{r}',
          sprintf('knitr::opts_template$set(fig = list(%s))', height_code),
          '```',
          '',
          '```{r, opts.label=\'fig\'}',
          cap_str,
          'saros::girafe(ggobj = plot_list[[.x]])',
          '```',
          '',
          '`r caption`',
          ''
        ),
        options = list(echo = FALSE, message = FALSE),
        envir = environment(),
        quiet = TRUE
      )
    }) |>
    unlist()
  cat(out, sep = "\n")
  invisible(NULL)
}