Merge pull request #495 from RobFryer/TEQDFP

Remove deprecated TEQ functions
osparcomm · Nov 17, 2024 · 73ae13d · 73ae13d
2 parents 36924fa + 73e4809
commit 73ae13d
Show file tree

Hide file tree

Showing 4 changed files with 2 additions and 189 deletions.
diff --git a/R/graphics_functions.R b/R/graphics_functions.R
@@ -850,7 +850,7 @@ plot.setup <- function(newPage) {
 label.units <- function(
   units = c("ug/kg", "mg/kg", "ng/ml", "pmol/min/mg protein", "ug/ml", "ug/l", 
             "nmol/min/mg protein", "ng/min/mg protein", "stg", "j/h/g", "mins",
-            "d", "%", "nr/1000 cells", "TEQ ug/kg", "ng/l"),
+            "d", "%", "nr/1000 cells", "ng/l"),
   basis, html = FALSE, compartment, extra.text = NA) {
 
   units <- match.arg(units)
@@ -873,7 +873,6 @@ label.units <- function(
       "ug/ml" = "&mu;g ml<sup>-1</sup>", 
       "ug/l" = "&mu;g l<sup>-1</sup>",
       "ng/l" = "ng l<sup>-1</sup>",
-      "TEQ ug/kg" = "TEQ &mu;g kg<sup>-1</sup>", 
       "stg" = "stage",
       "j/h/g" = "J h <sup>-1</sup> g <sup>-1</sup>",
       "pmol/min/mg protein" = "pmol min <sup>-1</sup> mg protein <sup>-1</sup>",
@@ -892,7 +891,6 @@ label.units <- function(
       "ug/ml" = 'paste(mu, "g") ~ "ml"^-1', 
       "ug/l" = 'paste(mu, "g") ~ "l"^-1', 
       "ng/l" = '"ng l"^-1', 
-      "TEQ ug/kg" = 'paste("TEQ", mu, "g") ~ "kg"^-1', 
       "stg" = '"stage"',
       "j/h/g" = '"J h"^-1 ~ "g"^-1',
       "pmol/min/mg protein" = '"pmol min"^-1 ~ "mg protein"^-1',

diff --git a/R/import_check_functions.R b/R/import_check_functions.R
@@ -516,38 +516,13 @@ ctsm.check.unit.biota <- function(data, info) {
     "g/g", "mg/mg", "ug/ug", "ng/ng", "pg/pg", "mg/g", "ug/g", "ng/g", "pg/g", 
     "g/kg", "mg/kg", "ug/kg", "ng/kg", "pg/kg")
 
-  id <- ctsm_is_contaminant(data$pargroup, exclude = "I-RNC") & data$determinand != "TEQDFP"
+  id <- ctsm_is_contaminant(data$pargroup, exclude = "I-RNC") 
   if (any(id))
     data[id,] <- within(data[id,], {
       ok <- unit %in% standard_unit
       action <- ifelse(ok, "none", "error")
     })
 
-  id <- data$determinand %in% "TEQDFP"
-  if (any(id)) {
-
-    TEQ_unit <- paste("TEQ", standard_unit)
-
-    data[id,] <- within(data[id,], {
-      ok <- unit %in% c(standard_unit, TEQ_unit)
-      action <- ifelse(ok, "none", "error")
-
-      if (any(TEQ_unit %in% unit)) {
-        lifecycle::deprecate_warn(
-          "1.0.2", 
-          I("use of units of the form 'TEQ ug/kg' or 'TEQ pg/g'"),
-          details = c(
-            i = "use e.g. 'ug/kg' instead of 'TEQ ug/kg'", 
-            i = "you might need to update the determinand reference table"
-          ),
-          env = rlang::caller_env(), 
-          user_env = rlang::caller_env(2)
-        )
-      }  
-
-    })
-  }
-
   id <- data$determinand %in% c("LNMEA")
   if (any(id))
     data[id,] <- within(data[id,], {

diff --git a/R/import_functions.R b/R/import_functions.R
@@ -3631,145 +3631,6 @@ determinand.link.sum <- function(data, info, keep, drop, weights = NULL) {
 
 
 
-determinand.link.TEQDFP <- function(data, info, keep, drop, weights) {
-
-  lifecycle::deprecate_warn(
-    "1.0.2", 
-    "determinand.link.TEQDFP()", 
-    details = c(
-      i = paste(
-        "use `determinand.link.sum()` with the TEFs supplied in the weights",
-        "argument"
-      ), 
-      i = 'see `vignette("example_HELCOM")` for further details'
-    ),
-    env = rlang::caller_env(), 
-    user_env = rlang::caller_env(2)
-  )
-
-  stopifnot(length(keep) == 1, length(drop) > 1)
-
-  if (!any(data$determinand %in% drop)) 
-    return(data)
-
-
-  # identify samples with drop and not keep, which are the ones that will be summed
-  # if keep already exists, then don't need to do anything
-  # don't delete drop data because might want to assess them individually
-
-  ID <- with(data, paste(sample, matrix))
-
-  dropID <- data$determinand %in% drop 
-  keepID <- data$determinand %in% keep
-
-  sum_ID <- ID %in% setdiff(ID[dropID], ID[keepID])
-
-  if (sum(sum_ID) == 0)
-    return(data)
-
-  dropTxt <- paste(drop, collapse = ", ")
-  cat("   Data submitted as", dropTxt, "summed to give", keep, fill = TRUE)
-
-
-  # get relevant sample matrix combinations
-
-  data <- split(data, with(data, determinand %in% drop))
-
-  ID <- with(data[["TRUE"]], paste(sample, matrix))
-
-  summed_data <- by(data[["TRUE"]], ID, function(x) {
-
-    # check all bases are the same 
-
-    if (!all(drop %in% x$determinand)) return(NULL)
-
-    stopifnot(dplyr::n_distinct(x$basis) == 1)
-
-
-    # convert to ug/kg and then to TEQ
-
-    id <- c("value", "uncertainty", "limit_detection", "limit_quantification")
-
-    x[id] <- lapply(x[id], convert_units, from = x$unit, to = "ug/kg")
-
-    TEQ <- weights[as.character(x$determinand)]
-
-    x[id] <- lapply(x[id], "*", TEQ)
-
-
-    # make output row have all the information from the largest determinand (ad-hoc) 
-
-    # ensures a sensible qaID, method_analysis, etc.
-
-
-    out <- x[which.max(x$value), ]
-
-    out$determinand <- keep
-
-    target_unit <- ctsm_get_info(info$determinand, keep, "unit", info$compartment, sep="_")
-    if (grepl("TEQ", target_unit)) {
-      out$unit <- "TEQ ug/kg"
-    } else {
-      out$unit <- "ug/kg"
-    }
-    out$group <- "Dioxins"
-    out$pargroup <- "OC-DX"
-
-    # sum value and limit_detection, make it a less-than if all are less-thans, and take 
-    # proportional uncertainty from maximum value (for which uncertainty is reported)
-    # if no uncertainties reported at all, then have provided value of CB126 in info.unertainty
-    # with sdConstant multiplied by 0.1 to reflect TEQ effect on detection limit
-
-    out$value <- sum(x$value)
-    out$limit_detection <- sum(x$limit_detection)
-    out$limit_quantification <- sum(x$limit_quantification)
-
-    if ("" %in% x$censoring)
-      out$censoring <- ""
-    else if (dplyr::n_distinct(x$censoring) == 1) 
-      out$censoring <- unique(x$censoring) 
-    else 
-      out$censoring <- "<"
-    out$censoring <- if(all(x$censoring %in% "<")) "<" else ""
-
-    if (all(is.na(x$uncertainty))) 
-      out$uncertainty <- NA
-    else {
-      wk <- x[!is.na(x$uncertainty), ]
-      pos <- which.max(wk$value)
-      upct <- with(wk, uncertainty / value)[pos]
-      out$uncertainty <- out$value * upct
-    }
-
-    out
-
-  })
-
-  summed_data <- do.call(rbind, summed_data)
-
-
-  # see how many samples have been lost due to incomplete submissions
-
-  nTotal <- length(unique(ID))
-  nSummed <- if (is.null(summed_data)) 0 else nrow(summed_data)
-  nLost <- nTotal - nSummed
-
-  if (nLost > 0) 
-    message("     ", nLost, " of ", nTotal, " samples lost due to incomplete submissions")
-
-
-  # combine data for both drop and keep and then add back into main data set
-
-  data[["TRUE"]] <- rbind(data[["TRUE"]], summed_data)
-
-  data <- do.call(rbind, data)
-
-  data
-}  
-
-
-
-
 check_censoring <- function(data, info, print_code_warnings) {
 
   # silence non-standard evaluation warnings

diff --git a/R/information_functions.R b/R/information_functions.R
@@ -647,27 +647,6 @@ ctsm_read_determinand <- function(
   })
 
 
-  # warn about deprecated TEQ units
-
-  not_ok <- sapply(compartment, function(id) {
-    unit_id <- paste0(id, "_unit")
-    any(grepl("^TEQ ", data[[unit_id]]))
-  })
-
-  if (any(not_ok)) {
-    lifecycle::deprecate_warn(
-      "1.0.2", 
-      I("use of units such as 'TEQ ug/kg' and 'TEQ pg/g'"),
-      details = c(
-        i = "use e.g. 'ug/kg' instead of 'TEQ ug/kg'", 
-        i = "you might need to update the determinand reference table"
-      ),
-      env = rlang::caller_env(2), 
-      user_env = rlang::caller_env(3)
-    )
-  }  
-
-
   # tidy up for output
 
   data <- tibble::column_to_rownames(data, "determinand")