R/olink_theme.R

In OlinkAnalyze: Facilitate Analysis of Proteomic Data from Olink

#' Function to set plot theme
#'
#' @description
#' This function sets a coherent plot theme for functions.
#'
#' @param font Font family to use for text elements. Default: "Arial".
#'
#' @return No return value, used as theme for ggplots
#'
#' @export
#'
#' @examples
#' \donttest{
#' if (rlang::is_installed(pkg = c("showtext", "systemfonts",
#'                                 "sysfonts", "curl"))) {
#'   ggplot2::ggplot(
#'     data = datasets::mtcars,
#'     mapping = ggplot2::aes(
#'       x = .data[["wt"]],
#'       y = .data[["mpg"]],
#'       color = as.factor(x = .data[["cyl"]])
#'     )
#'   ) +
#'     ggplot2::geom_point(
#'       size = 4L
#'     ) +
#'     OlinkAnalyze::set_plot_theme()
#'
#'   ggplot2::ggplot(
#'     data = datasets::mtcars,
#'     mapping = ggplot2::aes(
#'       x = .data[["wt"]],
#'       y = .data[["mpg"]],
#'      color = as.factor(x = .data[["cyl"]])
#'     )
#'   ) +
#'     ggplot2::geom_point(
#'       size = 4L
#'     ) +
#'     OlinkAnalyze::set_plot_theme(
#'       font = ""
#'     )
#' }
#' }
set_plot_theme <- function(font = "Arial") {

  usefont <- ""

  if (getOption("OlinkAnalyze.allow.font.load", default = TRUE)) {
    if (requireNamespace("showtext", quietly = TRUE)) {
      # if in testing mode, use a common font across operating systems
      if (testthat::is_testing()) {
        # If the font is already available in systemfonts, or showtext, add it
        # One approach: try to see if the font is installed in system; if not,
        # you may register it manually (via font_add or similar).
        usefont <- "roboto"

        # register font if needed
        register_font(family = usefont, in_test = TRUE)

        # Turn on showtext automatic rendering
        showtext::showtext_auto()

      } else if (font %in% fonts_system()) {

        # If the font is already available in systemfonts, or showtext, add it
        # One approach: try to see if the font is installed in system; if not,
        # you may register it manually (via font_add or similar).
        usefont <- font

        # register font if needed
        register_font(family = usefont, in_test = FALSE)

        # Turn on showtext automatic rendering
        showtext::showtext_auto()
      }
    }
  }

  olink_theme <- ggplot2::theme_bw() +
    ggplot2::theme(
      panel.grid.major = ggplot2::element_blank(),
      panel.grid.minor = ggplot2::element_blank(),
      panel.border = ggplot2::element_blank(),
      strip.background = ggplot2::element_rect(fill = "white"),
      strip.text = ggplot2::element_text(size = 8L),
      strip.text.x = ggplot2::element_text(size = 13L),
      text = ggplot2::element_text(
        family = if (!is.null(usefont)) usefont else "",
        color = "#737373",
        size = 12L
      )
    )

  # Keep support for older ggplot2
  if (utils::packageVersion("ggplot2") >= package_version("3.4.0")) {
    olink_theme <- olink_theme +
      ggplot2::theme(
        axis.line = ggplot2::element_line(linewidth = 0.5)
      )
  } else {
    olink_theme <- olink_theme +
      ggplot2::theme(
        axis.line = ggplot2::element_line(size = 0.5)
      )
  }

  return(olink_theme)

}

# Replacement for extrafont::fonts()
fonts_system <- function() {
  # Check if all required libraries for this function are installed
  rlang::check_installed(
    pkg = c("systemfonts"),
    call = rlang::caller_env()
  )

  fonts_df <- systemfonts::system_fonts()

  # Concatenate family + style, trimming whitespace
  font_names <- c(trimws(paste(fonts_df$family, fonts_df$style)),
                  fonts_df$family) |>
    unique() |>
    sort()

  # Remove duplicates and sort for consistency
  return(font_names)
}

get_font_path <- function(family) {
  ns <- asNamespace("systemfonts")

  if ("match_fonts" %in% getNamespaceExports("systemfonts")) {
    # systemfonts >= 1.1.0
    fonts <- ns$match_fonts(family)
  } else if ("match_font" %in% getNamespaceExports("systemfonts")) {
    # systemfonts <= 1.0.5
    fonts <- ns$match_font(family)
  } else {
    stop("No match_font(s) function found in systemfonts namespace")
  }

  return(fonts$path)
}

# register font if present in OS and not registered
register_font <- function(family, in_test = FALSE) {
  # Check if all required libraries for this function are installed
  rlang::check_installed(
    pkg = c("sysfonts"),
    call = rlang::caller_env()
  )

  # If already known to sysfonts, skip
  if (!(family %in% sysfonts::font_families())) {
    if (in_test == TRUE) {
      # Check if all required libraries for this function are installed
      rlang::check_installed(
        pkg = c("curl"),
        call = rlang::caller_env()
      )

      sysfonts::font_add_google(name = stringr::str_to_title(family),
                                family = family)
    } else {
      # Let sysfonts/font_add ask fontconfig for the actual file
      path <- get_font_path(family = family)
      if (!is.na(path)) {
        sysfonts::font_add(family = family, regular = path)
      }
    }
  }

  return(invisible(NULL))
}