Attributes (#17)

* Started work with attributes * now verifying attributes in check_ftir_data() * more attributes * plot objects have attributes (normal/stacked) * Added tests to ensure stickiness of normalized status after other numeric manipulations. * Introductory work on a `ftir` class * Testing for the introductory class work. * Reverting ftir class work. * Update NEWS * Touch-ups after remerge.
NRCan · Feb 5, 2025 · 3ebaeee · 3ebaeee
1 parent 821bae9
commit 3ebaeee
Show file tree

Hide file tree

Showing 19 changed files with 474 additions and 238 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -3,6 +3,7 @@
 * Added ability to set default language in options() (#10) 
 * Added ability to highlight one or more samples in spectra (#15)
 * Added ability to add a background shaded band (like a wide marker) to indicate a given range (#16)
+* Added attributes to imported data to simplify things like y axis units (#17)
 
 # PlotFTIR 1.0.0
 

diff --git a/PlotFTIR.Rproj b/PlotFTIR.Rproj
@@ -1,4 +1,5 @@
 Version: 1.0
+ProjectId: 20cfe570-0f99-4a3c-b730-e69e15e824cb
 
 RestoreWorkspace: No
 SaveWorkspace: No
@@ -18,7 +19,7 @@ StripTrailingWhitespace: Yes
 BuildType: Package
 PackageUseDevtools: Yes
 PackageInstallArgs: --no-multiarch --with-keep.source
-PackageCheckArgs: --as.cran
+PackageCheckArgs: --as.cran --ignore-vignettes
 PackageRoxygenize: rd,collate,namespace,vignette
 
 ZoteroLibraries: "My Library"
diff --git a/R/io.R b/R/io.R
@@ -155,11 +155,23 @@ read_ftir_directory <- function(path, files, sample_names = NA, ...) {
   }
 
   ftir <- data.frame()
+  intensity <- NA
   for (i in seq_along(files)) {
     tryCatch(
       {
-        f <- read_ftir(path, files[i], sample_names[i])
-        ftir <- rbind(ftir, f)
+        f <- read_ftir(path, files[i], sample_names[i], ...)
+        if (is.na(intensity)) {
+          intensity <- attr(f, "intensity")
+        }
+        if (attr(f, "intensity") == intensity) {
+          ftir <- rbind(ftir, f)
+        } else {
+          if (intensity <- "absorbance") {
+            ftir <- rbind(ftir, transmittance_to_absorbance(f))
+          } else {
+            ftir <- rbind(ftir, absorbance_to_transmittance(f))
+          }
+        }
       },
       error = function(e) cli::cli_warn(c("{e}", i = "{.fn PlotFTIR::read_ftir_directory} will try to continue with the next file."))
     )
@@ -206,14 +218,21 @@ read_ftir_csv <- function(path, file, sample_name = NA, ...) {
     }
   }
   if (!("absorbance" %in% colnames(input_file)) && !("transmittance" %in% colnames(input_file))) {
-    if (max(input_file[, colnames(input_file) != "wavenumber"], na.rm = TRUE) > 10) {
-      # must be intensity = transmittance
+    if (intensity_type(input_file) == "transmittance") {
       cli::cli_inform("{.fn PlotFTIR:::read_ftir_csv} has deduced that input data column {.arg {colnames(input_file)[colnames(input_file) != 'wavenumber']}} is {.val transmittance}.")
       colnames(input_file)[colnames(input_file) != "wavenumber"] <- "transmittance"
+      attr(input_file, "intensity") <- "transmittance"
     } else {
       # must be intensity = absorbance
       cli::cli_inform("{.fn PlotFTIR:::read_ftir_csv} has deduced that input data column {.arg {colnames(input_file)[colnames(input_file) != 'wavenumber']}} is {.val absorbance}.")
       colnames(input_file)[colnames(input_file) != "wavenumber"] <- "absorbance"
+      attr(input_file, "intensity") <- "absorbance"
+    }
+  } else {
+    if ("absorbance" %in% colnames(input_file)) {
+      attr(input_file, "intensity") <- "absorbance"
+    } else {
+      attr(input_file, "intensity") <- "transmittance"
     }
   }
 
@@ -243,14 +262,16 @@ read_ftir_asp <- function(path, file, sample_name = NA, ...) {
     "sample_id" = sample_name
   )
 
-  if (max(ftir_data$intensity, na.rm = TRUE) > 10) {
+  if (intensity_type(ftir_data) == "transmittance") {
     # must be intensity = transmittance
     cli::cli_inform("{.fn PlotFTIR:::read_ftir_spc} has deduced that input data is in {.val transmittance} units.")
     colnames(ftir_data)[colnames(ftir_data) == "intensity"] <- "transmittance"
+    attr(input_file, "intensity") <- "transmittance"
   } else {
     # must be intensity = absorbance
     cli::cli_inform("{.fn PlotFTIR:::read_ftir_spc} has deduced that input data is in {.val absorbance} units.")
     colnames(ftir_data)[colnames(ftir_data) == "intensity"] <- "absorbance"
+    attr(input_file, "intensity") <- "absorbance"
   }
 
   return(ftir_data)
@@ -403,16 +424,11 @@ ir_to_df <- function(ir, what) {
   for (s in seq_along(unique(irdata$sample_id))) {
     id <- unique(irdata$sample_id)[s]
     sampleir <- irdata[irdata$sample_id == id, ]
-    if (max(sampleir$y, na.rm = TRUE) < 10) {
-      sample_intensity <- "absorbance"
-      colnames(sampleir)[colnames(sampleir) == "y"] <- "absorbance"
-    } else {
-      sample_intensity <- "transmittance"
-      colnames(sampleir)[colnames(sampleir) == "y"] <- "transmittance"
-    }
-    if (is.na(intensity)) {
-      intensity <- sample_intensity
-    }
+    intensity <- intensity_type(sampleir)
+
+    sample_intensity <- intensity
+    colnames(sampleir)[colnames(sampleir) == "y"] <- intensity
+    attr(sampleir, "intensity") <- intensity
 
     if (intensity == sample_intensity) {
       ftir <- rbind(ftir, sampleir)
@@ -480,7 +496,7 @@ plotftir_to_ir <- function(ftir, metadata = NA) {
   }
 
   # Param Checks
-  ftir <- check_ftir_data(ftir, "PlotFTIR::plotftir_to_ir")
+  ftir <- check_ftir_data(ftir)
   if (!all(is.na(metadata))) {
     if (!is.data.frame(metadata)) {
       cli::cli_abort("Error in {.fn PlotFTIR::plotftir_to_ir}. {.arg metadata} must be either {.code NA} or a {.cls data.frame}.")
@@ -570,7 +586,7 @@ plotftir_to_chemospec <- function(ftir, group_crit = NA, group_colours = "auto",
   }
 
   # Param Checks
-  ftir <- check_ftir_data(ftir, "PlotFTIR::plotftir_to_chemospec")
+  ftir <- check_ftir_data(ftir)
 
   if (nchar(description) > 40) {
     cli::cli_alert_warning("{.pkg ChemoSpec} advises that {.param description} is 40 characters or less. Your description is {nchar(description)} characters.")
@@ -668,8 +684,9 @@ chemospec_to_plotftir <- function(csdata) {
       "intensity" = csdata$data[i, ],
       "sample_id" = csdata$names[i]
     )
-    sample_units <- ifelse(max(df$intensity, na.rm = TRUE) > 10, "transmittance", "absorbance")
+    sample_units <- intensity_type(df)
     colnames(df)[colnames(df) == "intensity"] <- sample_units
+    attr(df, "intensity") <- sample_units
     if (is.na(allunits)) {
       all_units <- sample_units
     }

diff --git a/R/manipulations.R b/R/manipulations.R
@@ -60,7 +60,11 @@ zoom_in_on_range <- function(ftir_spectra_plot, zoom_range = c(1000, 1900)) {
   }
 
   if ("transmittance" %in% colnames(data)) {
-    yrange <- c(0, 100)
+    if('normal' %in% attr(ftir_spectra_plot, 'spectra_style')) {
+      yrange <- c(0,100)
+    } else {
+      yrange <- c(0, max(c(data$transmittance, 100), na.rm = TRUE))
+    }
   } else {
     yrange <- range(data[(data$wavenumber > min(zoom_range) & data$wavenumber < max(zoom_range)), ]$absorbance)
   }
@@ -345,7 +349,6 @@ add_wavenumber_marker <- function(ftir_spectra_plot, wavenumber, text = NULL, li
     cli::cli_abort("Error in {.fn PlotFTIR::add_wavenumber_marker}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}.")
   }
 
-  # TODO: This should limit on the plot x values.
   data <- ftir_spectra_plot$data
   if (wavenumber < min(data$wavenumber) || wavenumber > max(data$wavenumber)) {
     cli::cli_abort("Error in {.fn PlotFTIR::add_wavenumber_marker}. {.arg wavenumber} must be a value between {round(min(data$wavenumber))} and {round(max(data$wavenumber))} cm^-1.")

diff --git a/R/maths.R b/R/maths.R
@@ -1,4 +1,4 @@
-## Holds functions to do maths on spectra Currently: average like spectra
+## Holds functions to do maths on spectra
 
 #' Average FTIR Spectra
 #'
@@ -40,8 +40,8 @@
 #' average_spectra(biodiesel, c("biodiesel_5_0", "biodiesel_B5", "diesel_unknown"))
 #' @md
 average_spectra <- function(ftir, sample_ids = NA, average_id = "averaged_spectra") {
-  ftir <- check_ftir_data(ftir, "PlotFTIR::average_spectra")
-
+  ftir <- check_ftir_data(ftir)
+  intensity_attribute <- attr(ftir, "intensity")
 
   if (length(sample_ids) <= 1) {
     if (is.na(sample_ids) || is.null(sample_ids) || length(sample_ids) == 0) {
@@ -73,7 +73,7 @@ average_spectra <- function(ftir, sample_ids = NA, average_id = "averaged_spectr
   other_wavenumbers <- ftir[ftir$sample_id != sample_ids[1], "wavenumber"]
   if (all(first_wavenumbers %in% other_wavenumbers) && all(other_wavenumbers %in% first_wavenumbers)) {
     # make average - when all wavenumbers are present in all samples
-    if ("absorbance" %in% names(ftir)) {
+    if (grepl("absorbance", intensity_attribute)) {
       avg_spectra <- stats::aggregate(absorbance ~ wavenumber, data = ftir, FUN = mean)
     } else {
       avg_spectra <- stats::aggregate(transmittance ~ wavenumber, data = ftir, FUN = mean)
@@ -120,6 +120,8 @@ average_spectra <- function(ftir, sample_ids = NA, average_id = "averaged_spectr
     }
   }
 
+  attr(avg_spectra, "intensity") <- intensity_attribute
+
   return(avg_spectra)
 }
 
@@ -169,7 +171,7 @@ NULL
 #' @rdname add_subtract_scalar
 #' @md
 add_scalar_value <- function(ftir, value, sample_ids = NA) {
-  ftir <- check_ftir_data(ftir, "PlotFTIR::add_scalar_value")
+  ftir <- check_ftir_data(ftir)
 
   if (length(sample_ids) <= 1) {
     if (is.na(sample_ids) || is.null(sample_ids) || length(sample_ids) == 0) {
@@ -202,7 +204,7 @@ add_scalar_value <- function(ftir, value, sample_ids = NA) {
 #' @export
 #' @rdname add_subtract_scalar
 subtract_scalar_value <- function(ftir, value, sample_ids = NA) {
-  ftir <- check_ftir_data(ftir, "PlotFTIR::subtract_scalar_value")
+  ftir <- check_ftir_data(ftir)
 
   if (!is.numeric(value)) {
     cli::cli_abort(c("Error in {.fn PlotFTIR::subtract_scalar_value}. Provided {.arg value} must be numeric.",
@@ -320,8 +322,7 @@ subtract_scalar_value <- function(ftir, value, sample_ids = NA) {
 #' # Adjust the biodiesel spectra to minimum for each sample
 #' recalculate_baseline(biodiesel, method = "minimum", individually = TRUE)
 recalculate_baseline <- function(ftir, sample_ids = NA, wavenumber_range = NA, method = "average", individually = TRUE) {
-  ftir <- check_ftir_data(ftir, "PlotFTIR::recalculate_baseline")
-
+  ftir <- check_ftir_data(ftir)
 
   if (length(sample_ids) <= 1) {
     if (is.na(sample_ids) || is.null(sample_ids) || length(sample_ids) == 0) {
@@ -510,13 +511,14 @@ recalculate_baseline <- function(ftir, sample_ids = NA, wavenumber_range = NA, m
 #' # Normalize just `paper` and `isopropanol` spectra from 4000 to 3100 cm^-1^
 #' normalize_spectra(sample_spectra,
 #'   sample_ids = c("paper", "isopropanol"),
-#'   wavenumber_range = c(4000, 3100))
+#'   wavenumber_range = c(4000, 3100)
+#' )
 normalize_spectra <- function(ftir, sample_ids = NA, wavenumber_range = NA) {
   # Check inputs
-  ftir <- check_ftir_data(ftir, "PlotFTIR::normalize_spectra")
-  if ("transmittance" %in% colnames(ftir)) {
+  ftir <- check_ftir_data(ftir)
+  if ("transmittance" %in% colnames(ftir) || attr(ftir, "intensity") == "transmittance") {
     # Can't normalize transmission spectra
-    cli::cli_abort(c("Error in {.fn PlotFTIR::normalize_spectra}: Normalization of Transmittance spectra not supported.",
+    cli::cli_abort(c("Error in {.fn PlotFTIR::normalize_spectra}: Normalization of transmittance spectra not supported.",
       i = "Convert spectra to absorbance using {.fn transmittance_to_absorbance} then try again."
     ))
   }
@@ -556,5 +558,115 @@ normalize_spectra <- function(ftir, sample_ids = NA, wavenumber_range = NA) {
     ftir[ftir$sample_id == sid, ]$absorbance <- spectra$absorbance
   }
 
+  attr(ftir, "intensity") <- "normalized absorbance"
+
+  return(ftir)
+}
+
+
+#' Convert Between Absorbance and Transmittance
+#'
+#' @description These functions allow for the convenient conversion between
+#'   \%Transmittance and Absorbance units for the Y axis.
+#'
+#'   Converting between \%Transmittance and absorbance units for the Y axis is
+#'   not a simple flipping of axis or inversion. Instead, the two are related by
+#'   the following formulas:
+#'
+#' \deqn{
+#'  A=-log_{10}(\tfrac{\%T}{100})
+#' }
+#'   and
+#' \deqn{
+#'  \%T=10^{-A}\cdot 100
+#' }.
+#'
+#'   Ces fonctions permettent une conversion pratique entre les unités
+#'   \%Transmittance et Absorbance pour l'axe Y. La conversion entre les unités
+#'   \%Transmittance et Absorbance pour l'axe Y n'est pas un simple retournement
+#'   d'axe ou une inversion. Au lieu de cela, les deux sont liés par les
+#'   formules suivantes :
+#'
+#' \deqn{
+#'  A=-log_{10}(\tfrac{\%T}{100})
+#' }
+#'   and
+#' \deqn{
+#'  \%T=10^{-A}\cdot 100
+#' }
+#'
+#' @param ftir A data.frame of FTIR spectral data including column to be
+#'   converted. Can't contain both `absorbance` and `transmittance` column as
+#'   the receiving column would be overwritten
+#'
+#'   Un data.frame de données spectrales IRTF incluant la colonne à convertir.
+#'   Ne peut pas contenir les colonnes `absorbance` et `transmittance` car la
+#'   colonne de réception serait écrasée.
+#'
+#' @return a data.frame of FTIR spectral data with conversion between absorbance
+#'   or transmittance as requested. Note the original data column is removed
+#'   since FTIR spectral data frames can't be fed into plotting functions with
+#'   both transmittance and absorbance data included.
+#'
+#'   un data.frame de données spectrales IRTF avec conversion entre l'absorbance
+#'   ou la transmittance comme demandé. Notez que la colonne de données
+#'   d'origine est supprimée car les trames de données spectrales IRTF ne
+#'   peuvent pas être introduites dans les fonctions de tracé avec les données
+#'   de transmittance et d'absorbance incluses.
+#'
+#' @examples
+#' # Convert from absorbance to transmittance
+#' sample_spectra_transmittance <- absorbance_to_transmittance(sample_spectra)
+#'
+#' # Convert back to absorbance
+#' sample_spectra_absorbance <- transmittance_to_absorbance(sample_spectra_transmittance)
+#'
+#' @name conversion
+NULL
+
+#' @export
+#' @rdname conversion
+absorbance_to_transmittance <- function(ftir) {
+  ftir <- check_ftir_data(ftir)
+  normalized <- grepl("normalized", attr(ftir, "intensity"))
+  if (!("absorbance" %in% colnames(ftir)) || attr(ftir, "intensity") %in% c("transmittance", "normalized transmittance")) {
+    cli::cli_abort("Error in {.fn PlotFTIR::absorbance_to_transmittance}. {.arg ftir} must be absorbance data or contain a {.var absorbance} column.")
+  }
+  ftir$transmittance <- (10^(ftir$absorbance * -1)) * 100
+  ftir$absorbance <- NULL
+
+  # this drops the attributes
+  ftir <- ftir[, c("wavenumber", "transmittance", "sample_id")]
+
+  if (normalized) {
+    attr(ftir, "intensity") <- "normalized transmittance"
+  } else {
+    attr(ftir, "intensity") <- "transmittance"
+  }
+
+  return(ftir)
+}
+
+#' @export
+#' @rdname conversion
+transmittance_to_absorbance <- function(ftir) {
+  ftir <- check_ftir_data(ftir)
+  normalized <- grepl("normalized", attr(ftir, "intensity"))
+
+  if (!("transmittance" %in% colnames(ftir)) || attr(ftir, "intensity") %in% c("absorbance", "normalized absorbance")) {
+    cli::cli_abort("Error in {.fn PlotFTIR::transmittance_to_absorbance}. {.arg ftir} must be transmittance data or contain a {.var transmittance} column.")
+  }
+
+  ftir$absorbance <- -log(ftir$transmittance / 100, base = 10)
+  ftir$transmittance <- NULL
+
+  ftir <- ftir[, c("wavenumber", "absorbance", "sample_id")]
+
+  if (normalized) {
+    attr(ftir, "intensity") <- "normalized absorbance"
+  } else {
+    attr(ftir, "intensity") <- "absorbance"
+  }
+
   return(ftir)
 }