R/uplot_vk.R

Defines functions uplot_vk

Documented in uplot_vk

#' Plot Van Krevelen Diagram
#'
#' @title uplot_vk
#' @description Creates a Van Krevelen diagram (H/C vs O/C).

#' @inheritParams main_docu
#' @inheritDotParams f_colorz

#' @param projection If TRUE, median z-values per (oc,hc) are used.
#' @param median_vK Add median VK point.
#' @param col_median Color of the marker for the median O/C and H/C value (Default = "white")
#' @param ai Add aromaticity index threshold lines.
#'
#' @family plots
#' @return ggplot or plotly object
#' @references
#' Van Krevelen D. (1950). Graphical-statistical method for
#' the study of structure and reaction processes of coal. *Fuel*, **29**, 269-284.
#'
#' Kim S., Kramer R.W., Hatcher P.G. (2003). Graphical method for analysis of ultrahigh-resolution broadband mass spectra of natural
#' organic matter, the Van Krevelen Diagram. *Analytical Chemistry*, **75**, 5336-5344.
#' \doi{10.1021/ac034415p}
#' @export

uplot_vk <- function(mfd,
                     z_var = "norm_int",
                     nice_labels = TRUE,
                     projection = TRUE,
                     palname = "viridis",
                     median_vK = TRUE,
                     col_median = "white",
                     ai = TRUE,
                     logo = TRUE,
                     size_dots = 3,
                     col_bar = TRUE,
                     tf = FALSE,
                     cex.axis = 12,
                     cex.lab = 15,
                     plotly = FALSE,
                     ...) {

  # --- Checks -------------------------------------------------------------------
  if (!z_var %in% names(mfd)) {
    stop("Column '", z_var, "' not found in mfd.")
  }

  if (!all(c("oc", "hc") %in% names(mfd))) {
    stop("mfd must contain columns 'oc' and 'hc'.")
  }

  if (nrow(mfd) == 0) {
    stop("mfd contains no rows.")
  }

  # --- Safety: remove accidental column named "z_var" ---------------------------
  if ("z_var" %in% names(mfd) && z_var != "z_var") {
    warning("Column 'z_var' found in mfd and removed to avoid name conflicts.")
    mfd[, z_var := NULL]
  }

  # --- Data ---------------------------------------------------------------------
  mfd_vk <- mfd[!is.na(get(z_var)), .(oc, hc, z = get(z_var))]

  if (tf) {
    if (any(mfd_vk$z <= 0)) {
      stop("Log transform requires z > 0.")
    }
    mfd_vk[, z := log10(z)]
  }

  if (projection) {
    mfd_vk <- mfd_vk[, .(z = median(z)), by = .(oc, hc)]
  }

  # --- Labels -------------------------------------------------------------------
  if (nice_labels) {
    xlabel <- .f_label(colname = "oc")
    ylabel <- .f_label("hc")
    colorlabel <- .f_label(z_var)
  } else {
    xlabel <- "Molecular O/C ratio"
    ylabel <- "Molecular H/C ratio"
    colorlabel <- z_var
  }

  # --- Build palette ------------------------------------------------------------
  pal_vec <- f_colorz(
    z = seq(0, 1, length.out = 256),
    col_num = 256, ...
  )

  if (!is.character(pal_vec) || length(pal_vec) < 2) {
    stop("Palette generation failed: pal_vec must be a vector of hex colors.")
  }

  # --- Base plot ----------------------------------------------------------------
  p <- ggplot(mfd_vk, aes(x = oc, y = hc, color = z)) +
    geom_point(size = size_dots) +
    labs(x = xlabel, y = ylabel) +
    scale_color_gradientn(
      colours = pal_vec,
      name = colorlabel,
      guide = if (col_bar) "colourbar" else "none"
    ) +
    theme(
      panel.background = element_rect(fill = "white", color = NA),
      plot.background  = element_rect(fill = "white", color = NA),
      panel.grid.major = element_blank(),
      panel.grid.minor = element_blank(),
      axis.line  = element_line(color = "black", linewidth = 0.6),
      axis.ticks = element_line(color = "black", linewidth = 0.6),
      axis.text  = element_text(size = cex.axis, color = "black"),
      axis.title = element_text(size = cex.lab, color = "black"),
      legend.title = element_text(size = cex.lab * 0.8),
      legend.text  = element_text(size = cex.axis)
    )

  # --- Median marker -------------------------------------------------------------
  if (median_vK) {
    p <- p + geom_point(
      data = data.frame(
        oc = median(mfd_vk$oc),
        hc = median(mfd_vk$hc)
      ),
      aes(oc, hc),
      inherit.aes = FALSE,
      color = col_median,
      size = 5,
      shape = 13
    )
  }

  # --- Aromaticity lines ---------------------------------------------------------
  if (ai) {
    p <- p +
      annotate("segment",
               x = 0, y = 1.125, xend = 1, yend = 0.2,
               colour = "grey50", linewidth = 0.4) +
      annotate("segment",
               x = 0, y = 0.75, xend = 1, yend = 0.1,
               colour = "grey20", linewidth = 0.7)
  }

  # --- Logo (ggplot only) --------------------------------------------------------
  if (logo && !plotly) {
    p <- p + labs(caption = "UltraMassExplorer")
  }

  # --- Plotly output -------------------------------------------------------------
  if (plotly) {
    pp <- plotly::ggplotly(p)

    if (logo) {
      pp <- pp |> plotly::layout(
        annotations = list(
          list(
            text = "UltraMassExplorer",
            xref = "paper", yref = "paper",
            x = 1, y = -0.15,
            xanchor = "right", yanchor = "top",
            showarrow = FALSE,
            font = list(size = 12, color = "black")
          )
        )
      )
    }

    return(pp)
  }

  return(p)
}

Try the ume package in your browser

Any scripts or data that you put into this service are public.

ume documentation built on Dec. 13, 2025, 1:06 a.m.