diff --git a/R/graphics_functions.R b/R/graphics_functions.R index 90b2f08..9db444f 100644 --- 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" = "μg ml-1", "ug/l" = "μg l-1", "ng/l" = "ng l-1", - "TEQ ug/kg" = "TEQ μg kg-1", "stg" = "stage", "j/h/g" = "J h -1 g -1", "pmol/min/mg protein" = "pmol min -1 mg protein -1", @@ -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 index 7977148..f428db5 100644 --- 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 index ea5915a..f86ef67 100644 --- 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 index d8eada7..5ce6449 100644 --- 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")