Geom spidergram

DESCRIPTION

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

NAMESPACE

@@ -28,6 +28,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)
@@ -36,6 +37,7 @@ export(get_error_columns)
 export(get_isotope_columns)
 export(get_ratio_columns)
 export(get_unit_columns)
+export(normalise_geochem)
 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,179 @@
+#' Spidergram geom for ggplot2
+#'
+#'Descriptions goes here ###################
+#' #### This will likely only work with ASTR objects or similarly wide data frame!?
+#' #### Or is there a way to identify short vs. long form!?
+#' #### e.g. single value to x and col content = character: long format,
+#' x = character vector length > 1 and column content of x = numeric: wide format
+#' #### y = single value and numeric: long format, concentration, y is not provided: wide format
+#' #### long format values do not need to be transformed (but normalised!?),
+#' wide format must be transformed to long format
+#'
+#' Normalisation is done with [normalise_geochem()]. If data are geochemically
+#' normalised, only normalised elements are plotted. Otherwise, all elements
+#' are plotted.
+#'
+#' @inheritParams ggplot2::layer
+#' @param reference `NULL`, the default, if data should not be normalised or
+#'   name of the geochemical reference composition to which data should be
+#'   normalised. See [references_geochem] for a list of names.
+#' @param na.rm Logical: remove NA values
+#' @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`.
+#'
+#' @export
+#'
+#' @examples
+#' # include example with data[[standard_groups$REE]]
+#'
+#' library(ggplot2)
+#'
+#' test <- data.frame(
+#'   Sample = c("A","B"),
+#'   Yb = c(8,9),
+#'   La = c(10,5),
+#'   Ce = c(20,8)
+#' )
+#'
+#' ggplot(test) + geom_spider(mapping = aes(x = standard_groups$REE, color = Sample))
+#'
+geom_spider <- function(mapping = NULL,
+                        data = NULL,
+                        inherit.aes = TRUE,
+                        elements = NULL,
+                        reference = NULL,
+                        na.rm = FALSE,
+                        show.legend = NA,
+                        ...) {
+
+  .data      <- data
+  .elements  <- elements
+  .reference <- reference
+
+  mapping <- utils::modifyList(
+    ggplot2::aes(x = .data$x, y = .data$y),
+    if (!is.null(mapping)) mapping else ggplot2::aes()
+  )
+
+  list(
+    suppressWarnings(
+      ggplot2::layer(
+        geom = GeomSpider,
+        mapping = mapping,
+        data = function(x) {
+          d <- if (!is.null(.data)) .data else x
+
+          if (!is.null(.reference)) {
+            d <- normalise_geochem(d, reference = .reference)
+          }
+
+          elements_present <- intersect(.elements, colnames(d))
+          if (length(elements_present) == 0) {
+            stop("None of the requested elements are present as columns in the data.")
+          }
+          if (length(elements_present) < length(.elements)) {
+            warning("Some requested elements are absent and will be skipped: ",
+                    paste(setdiff(.elements, elements_present), collapse = ", "))
+          }
+
+          meta_cols <- setdiff(colnames(d), elements_present)
+
+          data_long <- do.call(rbind, lapply(elements_present, function(el) {
+            row          <- d[meta_cols]
+            row$elements <- el
+            row$y        <- d[[el]]
+            row
+          }))
+
+          data_long$elements <- factor(data_long$elements, levels = elements_present)
+          data_long$x        <- as.numeric(data_long$elements)
+
+          data_long
+        },
+        stat = "identity",
+        position = "identity",
+        show.legend = show.legend,
+        inherit.aes = inherit.aes,
+        params = list(na.rm = na.rm, ...)
+      )
+    ),
+    ggplot2::scale_x_continuous(
+      breaks = seq_along(.elements),
+      labels = .elements
+    ),
+    ggplot2::labs(x = NULL, y = "Concentration")
+  )
+}
+
+GeomSpider <- ggplot2::ggproto(
+  "GeomSpider",
+  ggplot2::Geom,
+
+  required_aes = character(0),
+
+  default_aes = ggplot2::aes(
+    colour    = "black",
+    linewidth = 0.6,
+    linetype  = 1,
+    alpha     = NA
+  ),
+
+  extra_params = c("na.rm"),
+
+  draw_key = ggplot2::draw_key_path,
+
+  setup_data = function(data, params) {
+    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_geochem.R

@@ -0,0 +1,108 @@
+#' Geochemical normalisation of data
+#'
+#' Normalises selected elemental concentrations to a reference composition such
+#' as chondrite or MORB.
+#'
+#' See [references_geochem] for the supported reference compositions.
+#' Normalisation to other reference compositions is possible by adding them as
+#' named vectors, see examples. They will not be stored permanently in the
+#' package and must be exported and reloaded (or their definition included in
+#' the script). If you would like to include a new reference composition in
+#' ASTR, please reach out to the package maintainers or create a pull request in
+#' the [package's GitHub repo](https://github.com/archaeothommy/ASTR) with the
+#' values to be included and a literature reference.
+#'
+#' The function converts all elements in the data frame for which a reference
+#' composition is available. For [ASTR objects][ASTR], unit conversion is
+#' handled by the function. For all other objects, the user must ensure that
+#' values and reference composition have the same unit.
+#'
+#' @param df A data frame in wide format.
+#' @param reference Character string with the normalisation. See Details for
+#'   further information.
+#'
+#' @return If `df` is an [ASTR object][ASTR], the output is an object of the
+#'   same type including the ID column, the contextual columns, the
+#'   compositional data that was normalised, and the normalised values of the
+#'   respective elements. In all other cases, the data frame provided as input
+#'   with columns added for the calculated age model parameters.
+#'
+#'   The used reference composition is indicated in the column names of the
+#'   output by the value of `reference`.
+#'
+#' @examples
+#' df <- data.frame(
+#'   Sample = c("A","B"),
+#'   La = c(10,5),
+#'   Ce = c(20,8)
+#' )
+#'
+#' normalise_geochem(
+#'   df,
+#'   elements = c("La","Ce"),
+#'   reference = "chondrite"
+#' )
+#'
+#' # For ASTR objects, units are automatically converted
+#' test_file <- system.file("extdata", "test_data_input_good.csv", package = "ASTR")
+#' arch <- read_ASTR(test_file, id_column = "Sample", context = 1:7)
+#'
+#' arch_norm <- normalise_geochem(arch, "chondrite")
+#'
+#' # adding reference composition for 31X 7835.8A of the CHARM Set
+#' references_geochem$"31X 7835.8A" <- units::set_units(
+#'   value = "%",
+#'   x = c(P = 0.122, Mn = 0.093, Fe = 0.1, Co = 0.313, Ni = 0.158, Cu = 69.93,
+#'   Zn = 24.83, As = 0.143, Ag = 0.463, Cd = 0.087, Sn = 0.516, Sb = 0.115,
+#'   Pb = 3.15, Bi = 0.112
+#'   )
+#' )
+#'
+#' references_geochem$"31X 7835.8A"
+#'
+#' @export
+#'
+normalise_geochem <- function(df, reference = names(references_geochem)) {
+
+  reference <- match.arg(reference)
+
+  # Basic checks
+  checkmate::assert_data_frame(df)
+
+  elements <- intersect(colnames(df), names(references_geochem[[reference]]))
+
+  if (length(elements) == 0) {
+    stop("Dataset does not include any element of the reference data.")
+  }
+
+  # Normalisation
+  df_norm <- as.data.frame(
+    mapply(function(x) {
+      t(t(df[[x]]) / references_geochem[[reference]][x])
+    },
+    elements
+    )
+  )
+
+  # rename column names
+  colnames(df_norm) <- paste0(elements, "_", reference)
+
+  if (inherits(df, "ASTR")) {
+    df_norm <- cbind(df["ID"], df_norm)
+
+    df_norm <- suppressWarnings(
+      as_ASTR(
+        df_norm,
+        context = colnames(df_norm)[-1]
+      )
+    )
+
+    df_norm <- cbind(get_contextual_columns(df), df[elements], df_norm[-1])
+    df_norm <- preserve_ASTR_attrs(df_norm, df)
+
+  } else {
+    df_norm <- cbind(df, df_norm)
+  }
+
+  return(df_norm)
+}

R/ASTR_utils.R

@@ -87,3 +87,25 @@
   }
   unit
 }
+
+#' Transforms ASTR format into long format for plotting with ggplot2
+#'
+#' The function expects that a data frame is passed as aesthetic to ggplot,
+#' resulting in a tibble with a nested dataframe with the name of the aesthtic.
+#'
+#' @param df the data frame to be transformed into long format
+#' @param aesthetic the aesthetic that contains the values from ASTR
+#' @param value the name of the column with the values after transformation into
+#'   long format
+#' @keywords internal
+#'
+ASTR_to_long <- function(df, aesthetic, value) {
+  colnames(df[[aesthetic]]) <- paste(aesthetic, colnames(df[[aesthetic]]), sep = ".")
+  tidyr::unnest(df, tidyselect::all_of(aesthetic)) %>%
+    tidyr::pivot_longer(
+    cols = tidyselect::starts_with(aesthetic),
+    names_to = aesthetic,
+    values_to = value,
+    names_prefix = paste0(aesthetic, ".")
+  )
+}