geom_spidergram (new)

DESCRIPTION

@@ -56,6 +56,7 @@ Imports:
     stats,
     tibble,
     tidyselect,
+    tidyr, 
     units,
     vctrs,
     ggplot2,

NAMESPACE

@@ -16,6 +16,7 @@ S3method(print,ASTR)
 S3method(remove_units,ASTR)
 S3method(validate,ASTR)
 S3method(validate,default)
+export(GeomSpider)
 export(abs_to_rel)
 export(albarede_juteau_1984)
 export(amalia)
@@ -29,6 +30,7 @@ export(element_to_oxide)
 export(geom_kde2d)
 export(geom_sk_labels)
 export(geom_sk_lines)
+export(geom_spider)
 export(get_analytical_columns)
 export(get_concentration_columns)
 export(get_contextual_columns)
@@ -37,6 +39,11 @@ export(get_error_columns)
 export(get_isotope_columns)
 export(get_ratio_columns)
 export(get_unit_columns)
+export(normalise_100)
+export(normalise_data)
+export(normalise_element)
+export(normalise_geochem)
+export(normalise_sample)
 export(oxide_to_element)
 export(pb_iso_age_model)
 export(pointcloud_distribution)

R/ASTR_data.R

@@ -69,3 +69,52 @@
 #' @source <https://globalid.dmt-lb.de/>
 #' @name ArgentinaDatabase
 "ArgentinaDatabase"
+
+#' Geochemical and other standard groups of elements, oxides, or isotopes
+#' @format A list of sets of elements, oxides, or isotopes that represent
+#'   geochemical groups or other commonly used groups. To retrieve the full list
+#'   of e.g. the HFSE elements, run `standard_groups$HFSE`.
+#' \describe{
+#'   \item{REE}{Rare Earth Elements, taken from Periodic table of elements}
+#'   \item{HFSE}{High field-strength elements as listed in Salters (1998)}
+#'   \item{LILE}{Large-ion lithophile elements, as listed in Rudnick (1998)}
+#' }
+#'
+#' @references Salters, V.J.M. (1998). Elements: High field strength. In:
+#'   Geochemistry. Encyclopedia of Earth Science. Springer, Dordrecht.
+#'   https://doi.org/10.1007/1-4020-4496-8_101
+#'
+#'   Rudnick, R.L. (1998). Elements: Large-ion lithophile. In: Geochemistry.
+#'   Encyclopedia of Earth Science. Springer, Dordrecht.
+#'   https://doi.org/10.1007/1-4020-4496-8_104
+#'
+#' @name standard_groups
+"standard_groups"
+
+#' Reference compositions
+#'
+#' @format A list including sets of chemical compositions often used as
+#'   reference composition for e.g. normalisation. Values are stored as named
+#'   vectors of their concentration with assigned units (using
+#'   \link[units]{set_units}). To retrieve the list of elements and their
+#'   concentrations for e.g. the PM, run `references_geochem$PM`.
+#' \describe{
+#'   \item{chondrite}{CI chondrite composition in ppm, as defined by Sun &
+#'   McDonough (1989)}
+#'   \item{PM}{Primitive mantle composition in ppm, as defined by Sun &
+#'   McDonough (1989)}
+#'   \item{NMORB}{Normal Mid-ocean ridge basalt composition in ppm, as defined
+#'   by Sun & McDonough (1989)}
+#'   \item{EMORB}{Enhanced Mid-Ocean Ridge Basalt composition in ppm, as
+#'   defined by Sun & McDonough (1989)}
+#'   \item{OIB}{Ocean Island Basalt composition in ppm, as defined by Sun &
+#'   McDonough (1989)}
+#' }
+#'
+#' @references Sun, S.-S. & McDonough, W.F. (1989). Chemical and isotopic
+#'   systematics of oceanic basalts. Geological Society, London, Special
+#'   Publications 42, pp.313-345. Table 1, page 318.
+#'   <https://doi.org/10.1144/gsl.sp.1989.042.01.19>.
+#'
+#' @name references_geochem
+"references_geochem"

R/ASTR_geom_spider.R

@@ -0,0 +1,236 @@
+#' Spidergram geom for ggplot2
+#'
+#' This geom creates spidergrams, line graphs of element concentrations. The
+#' geom supports data normalisation, which is commonly done before plotting.
+#'
+#' This geom is special because no x and y coordinates are provided in the
+#' input. Instead, the aesthetic `elements` must be provided in [ggplot2::aes()]
+#' and it must be provided in the call to this geom, and not in
+#' [ggplot2::ggplot()] (see Examples).
+#'
+#' The elements can be supplied either as user-defined character vector or
+#' pre-made sets. See [standard_groups] for a list of available sets and the
+#' examples below for how to include them. The examples below also show how to
+#' avoid the default sorting into alphabetical order. The geom will throw an
+#' error if any of the supplied elements is not matched by a column name in the
+#' supplied data.
+#'
+#' @inheritParams ggplot2::layer
+#' @param reference Character string with what the data should be normalised to;
+#'   see [normalise_data] fur further details. If `NULL`, the default, data will
+#'   not be normalised.
+#' @param ... Other arguments passed on to [ggplot2::layer()]. These are often
+#'   aesthetics used to set a fixed value, such as `colour = "red"` or `alpha =
+#'   0.5`.
+#'
+#' @section Aesthetics: ### update as needed `geom_spidergram()` understands the
+#'   following aesthetic values (required aesthetics are in bold):
+#' * **`elements`** (character vector with the list of elements to be plotted)
+#' * `colour`
+#' * `linewidth`
+#' * `linetype`
+#' * `alpha`
+#'
+#'   Learn more about setting these aesthetics in `vignette("ggplot2-specs")`.
+#'
+#' @export
+#'
+#' @examples
+#' library(ggplot2)
+#'
+#' test <- data.frame(
+#'   Sample = c("A", "B"),
+#'   La = c(10, 5),
+#'   Ce = c(20, 8),
+#'   Nd = c(15, 6)
+#' )
+#'
+#' # elements must be supplied in the geom, not in ggplot()
+#' ggplot(test) +
+#'   geom_spider(aes(elements = c(La, Ce, Nd), colour = Sample))
+#'
+#' # using a pre-made element set
+#' ggplot(test) +
+#'   geom_spider(aes(elements = standard_groups$REE, colour = Sample))
+#'
+#' # with chondrite normalisation
+#' ggplot(test) +
+#'   geom_spider(aes(elements = c(La, Ce, Nd), colour = Sample),
+#'     reference = "chondrite"
+#'   )
+#'
+geom_spider <- function(mapping = NULL, data = NULL, stat = "identity",
+                        position = "identity", na.rm = FALSE, reference = NULL,
+                        show.legend = NA, inherit.aes = TRUE,
+                        ...) {
+
+  # rename aesthetic x to elements
+  if (!is.null(mapping$x)) {
+    names(mapping)[names(mapping) == "x"] <- "elements"
+  }
+
+  # extract elements from aesthetic `elements`
+  elements <- rlang::eval_tidy(mapping$elements)
+
+  if (length(elements) <= 1) {
+    stop("At least two elements must be provided to draw a spidergram.")
+  }
+
+  # re-mapping elements to single columns
+  for (i in elements) {
+    mapping[[i]] <- rlang::set_expr(mapping$elements, str2lang(i))
+  }
+
+  mapping$elements <- NULL # remove unnecessary aesthetic
+
+  list(
+    ggplot2::layer(
+      geom = GeomSpider,
+      data = data,
+      mapping = mapping,
+      stat = stat,
+      position = position,
+      show.legend = show.legend,
+      inherit.aes = inherit.aes,
+      params = list(
+        reference = reference,
+        elements = elements,
+        na.rm = na.rm, ...
+      )
+    ),
+    ggplot2::scale_x_discrete()
+  )
+}
+
+#' @format NULL
+#' @usage NULL
+#' @export
+GeomSpider <- ggplot2::ggproto(
+  "GeomSpider",
+
+  ggplot2::Geom,
+
+  required_aes = character(0),
+
+  optional_aes = c(ASTR::elements_data, ASTR::isotopes_data, ASTR::oxides_data),
+
+  default_aes = ggplot2::aes(
+    colour = "black",
+    linewidth = 0.5,
+    linetype = 1,
+    alpha = NA
+  ),
+  draw_key = ggplot2::draw_key_path,
+
+  extra_params = c("na.rm", "reference", "elements"),
+
+  setup_data = function(data, params) {
+    # Check all requested elements are present as columns before normalisation
+    missing_elements <- setdiff(params$elements, colnames(data))
+    if (length(missing_elements) > 0) {
+      stop(
+        "The following elements are not present as columns in the data: ",
+        paste(missing_elements, collapse = ", ")
+      )
+    }
+
+    # Normalise data if reference is provided
+    # normalise_geochem renames columns to element_reference (e.g. La_chondrite)
+    elements <- params$elements
+
+    if (!is.null(params$reference)) {
+      data <- normalise_data(data, type = "geochem", reference = params$reference)
+      elements <- paste0(elements, "_", params$reference)
+
+      # verify normalised columns exist
+      missing_norm <- setdiff(elements, colnames(data))
+      if (length(missing_norm) > 0) {
+        stop(
+          "Normalised columns not found after normalisation: ",
+          paste(missing_norm, collapse = ", "),
+          ". This may indicate that the selected elements are not part of ",
+          "the reference composition '", params$reference, "'."
+        )
+      }
+    }
+
+    # Pivot wide -> long using element columns
+    data_long <- tidyr::pivot_longer(
+      data,
+      cols = tidyselect::all_of(elements),
+      names_to = "x",
+      values_to = "y"
+    )
+
+    # Strip the reference suffix from x labels so axis shows element names
+    # e.g. La_chondrite -> La
+    if (!is.null(params$reference)) {
+      data_long$x <- sub(
+        paste0("_", params$reference, "$"),
+        "",
+        data_long$x
+      )
+    }
+
+    # Preserve declared element order on x axis
+    data_long$x <- factor(data_long$x, levels = params$elements)
+
+    data <- data_long
+
+    data
+  },
+  draw_group = function(data, panel_params, coord) {
+    if (nrow(data) < 2) {
+      return(grid::nullGrob())
+    }
+
+    # Replace NA alpha with 1
+    data$alpha[is.na(data$alpha)] <- 1
+
+    data <- data[order(data$x), ]
+
+    # Fast path — no NAs
+    if (!any(is.na(data$y))) {
+      coords <- coord$transform(data, panel_params)
+      return(
+        grid::polylineGrob(
+          coords$x, coords$y,
+          gp = grid::gpar(
+            col   = coords$colour[1],
+            lwd   = coords$linewidth[1] * ggplot2::.pt,
+            lty   = coords$linetype[1],
+            alpha = coords$alpha[1]
+          )
+        )
+      )
+    }
+
+    # NA handling — breaks in line at missing elements
+    not_na <- !is.na(data$y)
+    run_ids <- cumsum(c(TRUE, diff(not_na) != 0))
+
+    grobs <- lapply(unique(run_ids[not_na]), function(run) {
+      segment <- data[not_na & run_ids == run, , drop = FALSE]
+      if (nrow(segment) < 2) {
+        return(NULL)
+      }
+
+      coords <- coord$transform(segment, panel_params)
+      grid::polylineGrob(
+        coords$x, coords$y,
+        gp = grid::gpar(
+          col = coords$colour[1],
+          lwd = coords$linewidth[1] * ggplot2::.pt,
+          lty = coords$linetype[1],
+          alpha = coords$alpha[1]
+        )
+      )
+    })
+
+    grobs <- Filter(Negate(is.null), grobs)
+    if (length(grobs) == 0) {
+      return(grid::nullGrob())
+    }
+    do.call(grid::grobTree, grobs)
+  }
+)

R/ASTR_normalise_100.R

@@ -0,0 +1,31 @@
+#' Normalise data to 100%
+#'
+#' Rescales all numeric columns in a data frame so that the row sums equal 100.
+#' This is commonly used in compositional data analysis to express
+#' concentrations as relative proportions.
+#'
+#' @param df A data frame in wide format.
+#'
+#' @return The input data frame with normalised values.
+#'
+#' @family data normalisation functions
+#' @export
+#'
+#' @examples
+#' df <- data.frame(
+#'   ID = c("A", "B"),
+#'   La = c(10, 5),
+#'   Ce = c(20, 8),
+#'   Nd = c(15, 6)
+#' )
+#' normalise_to_100(df)
+#'
+normalise_100 <- function(df) {
+
+  checkmate::assert_data_frame(df)
+
+  numeric_cols <- names(df)[sapply(df, is.numeric)]
+
+  df[numeric_cols] <- normalise_rows(df[numeric_cols])
+  df
+}

R/ASTR_normalise_element.R

@@ -0,0 +1,40 @@
+#' Normalise data against a single element
+#'
+#' Normalises values in all numeric columns in a data frame by dividing them by
+#' the values of a reference element column, expressing each element as a ratio
+#' relative to the reference element.
+#'
+#' @param df A data frame in wide format.
+#' @param reference Character string with the column name of the element to
+#'   normalise against. Must be a numeric column in `df`.
+#'
+#' @return The input data frame with normalised values. The reference element
+#'   column is not divided by itself.
+#'
+#' @family data normalisation functions
+#' @export
+#'
+#' @examples
+#' df <- data.frame(
+#'   ID = c("A", "B"),
+#'   La = c(10, 5),
+#'   Ce = c(20, 8),
+#'   Nd = c(15, 6)
+#' )
+#' normalise_element(df, reference = "La")
+#'
+normalise_element <- function(df, reference = colnames(df)) {
+
+  reference <- match.arg(reference)
+
+  checkmate::assert_data_frame(df)
+
+  if (!is.numeric(df[[reference]])) {
+    stop("Column '", reference, "' is not numeric and cannot be used for normalisation.")
+  }
+
+  numeric_cols <- names(df)[sapply(df, is.numeric)]
+  numeric_cols <- numeric_cols[numeric_cols != reference]
+  df[numeric_cols] <- lapply(df[numeric_cols], function(x) x / df[[reference]])
+  df
+}