Standard sample bracketing

DESCRIPTION

@@ -53,7 +53,6 @@ Imports:
     tibble,
     tidyselect,
     units,
-    robCompositions,
     ggplot2,
     ks,
     units, 

NAMESPACE

@@ -32,6 +32,7 @@ export(pointcloud_distribution)
 export(read_archchem)
 export(remove_units)
 export(stacey_kramers_1975)
+export(standard_sample_bracketing)
 export(unify_concentration_unit)
 export(validate)
 importFrom(geometry,convhulln)

R/ASTR_PbIso_AgeModels.R

@@ -46,20 +46,20 @@
 #' @export
 #'
 #' @references Albarède, F. and Juteau, M. (1984) Unscrambling the lead model
-#' ages. Geochimica et Cosmochimica Acta 48(1), pp. 207–212.
+#' ages. Geochimica et Cosmochimica Acta 48(1), pp. 207-212.
 #' <https://dx.doi.org/10.1016/0016-7037(84)90364-8>.
 #'
 #' Albarède, F., Desaulty, A.-M. and Blichert-Toft, J. (2012) A geological
 #' perspective on the use of Pb isotopes in Archaeometry. Archaeometry 54, pp.
-#' 853–867. <https://doi.org/10.1111/j.1475-4754.2011.00653.x>.
+#' 853-867. <https://doi.org/10.1111/j.1475-4754.2011.00653.x>.
 #'
 #' Cumming, G.L. and Richards, J.R. (1975) Ore lead isotope ratios in a
 #' continuously changing earth. Earth and Planetary Science Letters 28(2), pp.
-#' 155–171. <https://dx.doi.org/10.1016/0012-821X(75)90223-X>.
+#' 155-171. <https://dx.doi.org/10.1016/0012-821X(75)90223-X>.
 #'
 #' Stacey, J.S. and Kramers, J.D. (1975) Approximation of terrestrial lead
 #' isotope evolution by a two-stage model. Earth and Planetary Science Letters
-#' 26(2), pp. 207–221. <https://dx.doi.org/10.1016/0012-821X(75)90088-6<.
+#' 26(2), pp. 207-221. <https://dx.doi.org/10.1016/0012-821X(75)90088-6<.
 #'
 #' @name age_models
 #' @aliases stacey_kramers_1975

R/ASTR_Standard_Sample_Bracketing.R

@@ -0,0 +1,187 @@
+#' Standard Sample Bracketing
+#'
+#' @description Performs Standard Sample Bracketing (SSB) correction for isotope
+#'   ratio data.
+#'
+#' @details This function corrects for instrumental drift or mass bias during
+#'   isotopic analyses using the Standard Sample Bracketing method. The measured
+#'   isotope value of each sample is corrected by the linearly interpolated mass
+#'   bias drift between the two standard measurements taken immediately before
+#'   and after the sample measurement.
+#'
+#' @param df data frame including at least a column with the label, analysis
+#'   results, and analytical precisions of the measurements.
+#' @param id_col String with the name of the column in `df` with the identifiers
+#'   of each row. Default is `ID`.
+#' @param id_values String with the name of the column in `df` with the numeric
+#'   results. Default is ´values´.
+#' @param id_error string with the name of the column in `df` with the
+#'   analytical uncertainties of each measurement. Default is `error`.
+#' @param std String identifying the standard used for bracketing. Default is
+#'   "Std".
+#' @param pos Integer giving the line of the first standard measurement that
+#'   opens the first bracket.
+#' @param notation String that describes the calculation the user wants to be
+#'   performed:
+#' * ratio calculates the ratio between the sample and the standard mean
+#' * delta calculates the delta value of the sample per mille.
+#' * epsilon calculates the epsilon value of the sample per ten thousand.
+#' @param weight_std A vector of length 2 with numeric value giving the weight
+#'   assigned to the opening and closing standard of a bracket, respectively.
+#'   The sum of both weights must be one. The default `0.5` gives the mean of
+#'   both standards.
+#' @param sd_input integer that gives the number the standard deviation will be
+#'   multiplied for.
+#' @param display_details boolean to indicate if the user wants to get the
+#'   detailed list of each measurement with their respective error calculation.
+#'   Default to `FALSE`.
+#'
+#' @references Mason, T. F.D., Weiss, D. J., Horstwood, M., Parrish, R. R.,
+#'   Russell, S. S., Mullaneb, E., and Colesa, B. J. (2004) High-precision Cu
+#'   and Zn isotope analysis by plasma source mass spectrometry. Journal of
+#'   Analytical Atomic Spectrometry 19, pp. 209-217.
+#'   <https://doi.org/10.1039/B306958C>
+#'
+#' @returns If `display_details = FALSE`, a data frame with the average values
+#'   plus standard deviation (SD). Otherwise a list with two data frames.
+#'
+#' @export
+#'
+#' @examples
+#' data <- data.frame(
+#'   ID = c("Std", "Sample_A", "Std", "Sample_A", "Std", "Sample_A", "Std"),
+#'   values = c(16.928, 18.641, 16.932, 18.643, 16.935, 18.642, 16.938),
+#'   error = c(0.05, 0.02, 0.05, 0.06, 0.03, 0.04, 0.02)
+#' )
+#'
+#' result <- ASTR::standard_sample_bracketing(
+#'   df = data,
+#'   id_values = "values",
+#'   id_error = "error",
+#'   sd_input = 2,
+#'   pos = 1,
+#'   notation = "delta",
+#'   display_details = TRUE
+#' )
+#'
+standard_sample_bracketing <- function(
+  df,
+  id_col = "ID",
+  id_values = "values",
+  id_error =  "error",
+  std = "Std",
+  pos = 1,
+  notation = c("ratio", "delta", "epsilon"),
+  sd_input = 1,
+  weight_std = c(0.5, 0.5),
+  display_details = FALSE
+) {
+  # Check there are no empty values in header nor id_std
+  if (std == "") {
+    stop("You need to assign the ID of the standard.")
+  }
+
+  if (!(id_values %in% colnames(df))) {
+    stop("The column name for the measured values is not included in the provided data frame.")
+  }
+
+  if (!(id_error %in% colnames(df))) {
+    stop("The column name for the measured values is not included in the provided data frame.")
+  }
+
+  notation <- match.arg(notation)
+
+  # Check of weight values
+
+  checkmate::assert_vector(weight_std, strict = TRUE, len = 2, any.missing = FALSE)
+
+  if (sum(weight_std) != 1) {
+    stop("The sum of the weights must be 1.")
+  }
+
+  # prepare variables
+  df <- df[c(id_col, id_values, id_error)] # data frame with relevant columns for computation
+  nr <- nrow(df) # count number of rows in the data frame
+
+  sample_names <- sample_results <- error_sample_list <- c()
+
+  # SSB calculation
+
+  while (pos + 1 <= nr) {
+    # iterates over the whole data frame, it starts with the cycles
+    std_opening <- df[pos, 2]
+    error_std_opening <- df[pos, 3]
+    cycle_end <- cycle_start <- pos + 1 # move the index to the first sample
+
+    while (df[cycle_end, 1] != std) { # Find the second (closing) standard bracket from the cycle
+      cycle_end <- cycle_end + 1
+    }
+
+    std_closing <- df[cycle_end, 2]
+    error_std_closing <- df[cycle_end, 3]
+
+    std_mean_weighted <- (weight_std[1] * std_opening) + (weight_std[2] * std_closing) # calculate weighted mean
+
+    while (cycle_start < cycle_end) { # run the samples within the cycle
+      sample_current <- df[cycle_start, 1]
+      error_measurement <- df[cycle_start, 3]
+
+      total_error <- error_measurement * sqrt(
+        (weight_std[1] * error_std_opening)^2 + (weight_std[2] * error_std_closing)^2
+      )
+
+      if (!is.na(sample_current) && sample_current != "") {
+        sample_measurement <- df[cycle_start, 2]
+        ssb <- sample_measurement / std_mean_weighted
+
+        switch(notation,
+          delta = {
+            ssb <- (ssb - 1) * 1000
+          },
+          epsilon = {
+            ssb <- (ssb - 1) * 10000
+          },
+          {
+            ssb
+          }
+        )
+
+        sample_names <- append(sample_names, sample_current)
+        sample_results <- append(sample_results, ssb)
+        error_sample_list <- append(error_sample_list, total_error)
+      }
+      cycle_start <- cycle_start + 1
+    }
+    pos <- cycle_start
+  }
+
+  # for some reason, they are a list rather a vector, so turning them into vector
+  sample_names <- unlist(sample_names)
+  sample_results <- unlist(sample_results)
+  error_sample_list <- unlist(error_sample_list)
+
+  # Combine calculated values into data frame and order them by sample name
+  results <- data.frame(ID = sample_names, SSB = sample_results, Error_err2SD = error_sample_list)
+
+  # Calculate errors and averages for each sample
+  summary <- results %>%
+    dplyr::group_by(.data$ID) %>%
+    dplyr::summarise(
+      Mean = format(signif(mean(.data$SSB), 4), nsmall = 4),
+      SD = format(signif(sd_input * stats::sd(.data$SSB), 4), nsmall = 4)
+    )
+  colnames(results)[2] <- colnames(summary)[2] <- paste(id_values, notation, sep = "_")
+
+  if (sd_input != 1) {
+    colnames(summary)[3] <- paste0(id_values, "_err", sd_input, "SD")
+  } else {
+    colnames(summary)[3] <- paste0(id_values, "_errSD")
+  }
+
+  if (display_details == TRUE) {
+    result <- list(results, summary)
+  } else {
+    result <- summary
+  }
+  result
+}

R/archchem_basic.R

@@ -222,7 +222,7 @@ read_archchem <- function(
     answer <- readline("Package `readxl` required to import Excel files. Do you want to install it now? [Y/n]: ")
 
     if (tolower(answer) %in% c("yes", "y")) {
-      install.packages("readxl")
+      utils::install.packages("readxl")
     } else {
       stop("Please import your data in another file format or install 'readxl' manually.")
     }

data-raw/FlowerDataProcessing-SBB-test-04.csv

@@ -0,0 +1,18 @@
+ID;Isotope_data;Isotope_data_Error;SBB_linear;SBB_weighted;;;;;;;;
+Std;0,447093;0,000004;;;;;;;;;;
+Sample-01;0,446465;0,000003;0,9985828;0,9985854;;;;;;;;
+Sample-02;0,446494;0,000003;0,9986474;0,9986500;;;;;;;;
+Sample-03;0,446475;0,000003;0,9986038;0,9986064;;;;;;;;
+Std;0,447105;0,000004;;;;;;;;;;
+Sample-04;0,446816;0,000003;0,99936;0,99936;;;;;;;;
+Sample-05;0,446494;0,000003;0,99864;0,99864;;;;;;;;
+Sample-06;0,446465;0,000003;0,99858;0,99858;;;;;;;;
+Std;0,447098;0,000003;;;;;;;;;;
+Sample-09;0,446503;0,000003;0,99869;0,99869;;;;;;;;
+Sample-08;0,446734;0,000004;0,99921;0,99920;;;;;;;;
+Sample-07;0,446799;0,000003;0,99935;0,99935;;;;;;;;
+Std;0,447080;0,000004;;;;;;;;;;
+;;;;;;;;;;;;
+;;;;;;;;;;;;
+;;;;;;;;;;;;
+;;;;;;;;;;;;

dev_guide/drafts/bracketing/bracketing-tidyverse.R

@@ -0,0 +1,114 @@
+
+
+# here is the function to do SSB using the tidyverse
+standard_sample_bracketing <- function(
+    data = data,
+    sample_id = "ID",
+    values = "value",
+    standard_name = "Std",
+    multiplier = 1000,
+    start_at_row = 1
+) {
+
+  library(dplyr)
+
+  # start where the user says the data starts
+  data <-
+  data |>
+    slice(start_at_row:n()) |>
+    # we need a unique row number to rejoin the data later
+    mutate(original_row_id = row_number())
+
+  sample_id_sym <- sym(sample_id)  # turn string into symbol
+  values_sym    <- sym(values)  # turn string into symbol
+
+  # Find positions of all standard rows
+  std_rows <- which(data[[sample_id_sym]] == standard_name)
+
+  # build overlapping Std–Sample–Std groups, we duplicate
+  # some stds to have distinct groups that we can process
+  groups <- map2(
+    std_rows[-length(std_rows)],
+    std_rows[-1],
+    .f = function(start, end) {
+      idx <- which(std_rows[-length(std_rows)] == start)
+      data[start:end, ] |>
+        mutate(group_id =  paste0("group_", sprintf("%03d", idx)))
+    }
+  )
+
+  df_grouped <- bind_rows(groups)
+
+  # for eachStd–Sample–Std group,  take the first std and the last std
+  # and compute mean and add in a new column containing this mean
+  # for each group
+  df_grouped_with_means <-
+  df_grouped |>
+    group_by(group_id) %>%
+    # keep only Std rows
+    filter({{sample_id_sym}} == standard_name) %>%
+    # take only first and last Std in each group
+    slice(c(1, n())) %>%
+    summarise(
+      mean_std = mean({{values_sym}}, na.rm = TRUE),
+      .groups = "drop"
+    )  |>
+  right_join(df_grouped)
+
+  # for each group, take the sample value, divide by the mean std
+  # value -1, then multiple by the multiplier
+  df_grouped_with_means_ssb <-
+  df_grouped_with_means |>
+    # Exclude the standards from the final calculation
+    filter({{sample_id_sym}} != standard_name) |>
+    mutate(
+      # output is per mil
+      ssb_value = ({{values_sym}} / mean_std - 1) * multiplier
+    ) |>
+    # Select only the ID and the result to avoid duplicate columns
+    select(original_row_id, ssb_value)
+
+  # Join the calculated values back to the original data frame
+  final_data <- data |>
+    left_join(df_grouped_with_means_ssb,
+              by = "original_row_id") |>
+    # Remove the temporary ID column
+    select(-original_row_id)
+
+  return(final_data)
+
+}
+
+# Test the function with some data -------------------------------------------
+
+library(readxl)
+library(tidyverse)
+
+# import the data
+df <- read_excel("data-raw/ULB_Cu_20190903-test 2.xlsx",
+                 sheet = "03092019",
+                 skip = 2)
+
+# subset just the sequences of samples to apply SSB
+subset_to_bracket <-
+  df |>
+  slice(13:45, 68:104)
+
+# apply the function to create a new data frame with the new column
+x <-
+standard_sample_bracketing(data = subset_to_bracket,
+                           sample_id = "Sample Name...1",
+                           standard_name = "Cu/Zn in house 25ppb",
+                           values = "Cu65/63 corr 68/66")
+x
+
+# take a look and compare the function result to the Excel result
+x |>
+  select(`Sample Name...1`,
+         `Cu65/63 corr 68/66`,
+         `δ65Cu`,
+         ssb_value) |>
+  mutate(all_equal = all.equal(`δ65Cu`,ssb_value )) |> View()
+
+
+