Merge pull request #35 from isoverse/dev

merge dev into master for release of version 0.4.0

.gitignore

@@ -41,9 +41,10 @@ vignettes/**/*.pdf
 # Temporary files created by R markdown
 *.utf8.md
 *.knit.md
+/**/html/
 
 # Auxiliary package files
-/tmp/
+tmp
 *.pdf
 *.png
 *.jpg

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: isoprocessor
 Title: IRMS data processor
 Description: Data processing and reduction pipelines for isotope ratio mass spectrometry (IRMS) data
-Version: 0.3.7
+Version: 0.4.0
 Authors@R: person("Sebastian", "Kopf", email = "sebastian.kopf@colorado.edu",
     role = c("aut", "cre"))
 URL: https://github.com/isoverse/isoprocessor
@@ -26,10 +26,11 @@ Imports:
     ggrepel,
     lubridate,
     broom,
-    modelr,
     investr,
-    readxl
+    readxl,
+    openxlsx
 Suggests:
+    tidyverse,
     testthat,
     knitr,
     rmarkdown,

NAMESPACE

@@ -14,13 +14,18 @@ export(iso_apply_calibration)
 export(iso_calculate_ratios)
 export(iso_convert_signals)
 export(iso_convert_time)
+export(iso_evaluate_calibration_range)
+export(iso_export_calibration_to_excel)
 export(iso_generate_calibration)
 export(iso_generate_summary_table)
 export(iso_get_default_processor_parameters)
 export(iso_get_problematic_calibrations)
 export(iso_get_problematic_peak_mappings)
 export(iso_get_problematic_peaks)
+export(iso_get_processor_example)
+export(iso_get_processor_examples)
 export(iso_map_peaks)
+export(iso_mark_calibration_range)
 export(iso_plot_calibration_parameters)
 export(iso_plot_calibration_range)
 export(iso_plot_continuous_flow_data)
@@ -104,8 +109,6 @@ importFrom(ggplot2,theme_bw)
 importFrom(glue,glue)
 importFrom(investr,invest)
 importFrom(methods,is)
-importFrom(modelr,add_residuals)
-importFrom(modelr,geom_ref_line)
 importFrom(purrr,map)
 importFrom(purrr,map2)
 importFrom(purrr,map2_chr)
@@ -131,7 +134,7 @@ importFrom(rlang,lang_args)
 importFrom(rlang,lang_head)
 importFrom(rlang,quo)
 importFrom(rlang,quo_expr)
-importFrom(rlang,quo_is_lang)
+importFrom(rlang,quo_is_call)
 importFrom(rlang,quo_is_missing)
 importFrom(rlang,quo_is_null)
 importFrom(rlang,quo_is_symbol)

R/calibration.R

@@ -4,39 +4,44 @@
 #' @param dt data table
 #' @param stds standards data frame
 #' @param match_by what column(s) to match the standards by
-#' @param is_standard new column that holds information about what is a standard and what isn't
+#' @param is_std_peak new column that holds information about which ones are standard peaks (i.e. have known isotopic values)
+#' @param is_standard renamed to \code{is_std_peak} because the naming caused too much confusion, will be removed in future versions, please use \code{is_std_peak} instead
 #' @inheritParams iso_show_default_processor_parameters
 #' @return data frame with standards data frame merged in and the following information column added:
 #' \itemize{
 #' \item{\code{is standard}: }{a logical TRUE/FALSE indicating which data table entry is a standard}
 #' }
 #' @family calibration functions
 #' @export
-iso_add_standards <- function(dt, stds, match_by = default(std_match_by), is_standard = is_standard, quiet = default(quiet)) {
+iso_add_standards <- function(dt, stds, match_by = default(std_match_by), is_std_peak = default(is_std_peak), quiet = default(quiet), is_standard = NULL) {
 
   # make sure params supplied
   if (missing(dt)) stop("no data table supplied", call. = FALSE)
   if (missing(stds)) stop("no standards table supplied", call. = FALSE)
+  if (!missing(is_standard)) {
+    stop("the parameter is_standard was renamed to is_std_peak to avoid confusion, please use is_std_peak instead", call. = FALSE)
+  }
 
   # column names allowing standard and NSE
   dt_cols <- get_column_names(!!enquo(dt), match_by = enquo(match_by), n_reqs = list(match_by = "+"))
   stds_cols <- get_column_names(!!enquo(stds), match_by = enquo(match_by), n_reqs = list(match_by = "+"))
-  new_cols <- get_new_column_names(is_standard = enquo(is_standard))
+  new_cols <- get_new_column_names(is_std_peak = enquo(is_std_peak))
 
   # select standards
   stds <- mutate(stds, ..marker.. = TRUE)
   dt_w_stds <- dt %>%
     left_join(stds, by = dt_cols$match_by) %>%
-    mutate(!!new_cols$is_standard := !is.na(..marker..)) %>%
+    mutate(!!new_cols$is_std_peak := !is.na(..marker..)) %>%
     select(-..marker..) %>%
     # arrange properly
-    select(dt_cols$match_by, new_cols$is_standard, everything())
+    select(dt_cols$match_by, new_cols$is_std_peak, everything())
 
   if (!quiet) {
-    n_stds <- filter(dt_w_stds, !!sym(new_cols$is_standard))[dt_cols$match_by] %>% unique() %>% nrow()
-    n_stds_rows <- filter(dt_w_stds, !!sym(new_cols$is_standard)) %>% nrow()
+    n_stds <- filter(dt_w_stds, !!sym(new_cols$is_std_peak))[dt_cols$match_by] %>% unique() %>% nrow()
+    n_stds_rows <- filter(dt_w_stds, !!sym(new_cols$is_std_peak)) %>% nrow()
     glue("Info: matching standards by '{collapse(dt_cols$match_by, sep = \"', '\", last = \"' and '\")}' - ",
-         "added {n_stds} standard entries to {n_stds_rows} out of {nrow(dt_w_stds)} rows") %>%
+         "added {n_stds} standard entries to {n_stds_rows} out of {nrow(dt_w_stds)} rows, ",
+         "added new column '{new_cols$is_std_peak}' to identify standard peaks") %>%
       message()
   }
   return(dt_w_stds)
@@ -85,7 +90,9 @@ get_calibration_vars <- function(calibration) {
     model_name = str_c(prefix_with_sep, "calib"),
     model_enough_data = str_c(prefix_with_sep, "calib_ok"),
     model_params = str_c(prefix_with_sep, "calib_params"),
-    residual = str_c(prefix_with_sep, "resid")
+    residual = str_c(prefix_with_sep, "resid"),
+    in_reg = str_c(prefix_with_sep, "in_calib"),
+    in_range = str_c(prefix_with_sep, "in_range")
   )
 }
 
@@ -104,14 +111,20 @@ check_calibration_cols <- function(df, cols) {
   }
 }
 
+# convenience function to find calibrations (only works fornested ones)
+find_calibrations <- function(df) {
+  names(df) %>% stringr::str_subset("^.*calib_params$") %>%
+    stringr::str_replace("_?calib_params$", "")
+}
+
 #' Generate data calibration
 #'
 #' Generate a calibration for a specific variable based on one or multiple calibration models. Requires properly nested and grouped data, see \link{iso_prepare_for_calibration} for details. Note that to calibrate different variables, separate calls to this function should be issued each with different \code{calibration} names.
 #'
 #' @param dt nested data table with column \code{all_data} (see \link{iso_prepare_for_calibration})
 #' @param model a single regression model or a list of multiple alternative regression models for the calibration. If a named list is provided, the name(s) will be used instead of the formulaes for the model identification column. Note that if multiple models are provided, the entire data table rows will be duplicated to consider the different models in parallel.
 #' @param calibration an informative name for the calibration (could be e.g. \code{"d13C"} or \code{"conc"}). If provided, will be used as a prefix for the new columns generated by this function. This parameter is most useful if there are multiple variables in the data set that need to be calibrated (e.g. multiple delta values, concentration, etc.). If there is only a single variable to calibrate, the \code{calibration} parameter is completely optional and can just be left blank (the default).
-#' @param is_standard column or filter condition to determine which subset of data to actually use for the calibration (default is the \code{is_standard} field introduced by \code{\link{iso_add_standards}}).
+#' @param is_std_peak column or filter condition to determine which subset of data to actually use for the calibration (default is the \code{is_std_peak} field introduced by \code{\link{iso_add_standards}}).
 #' @inheritParams run_regression
 #' @inheritParams iso_show_default_processor_parameters
 #' @return the data table with the following columns added (prefixed by the \code{calibration} parameter if provided):
@@ -122,19 +135,23 @@ check_calibration_cols <- function(df, cols) {
 #'   \item{\code{resid} within \code{all_data}: }{a new column within the nested \code{all_data} that holds the residuals for all standards used in the regression model}
 #' }
 #' @export
-iso_generate_calibration <- function(dt, model, calibration = "", is_standard = default(is_standard), min_n_datapoints = 2, quiet = default(quiet)) {
+iso_generate_calibration <- function(dt, model, calibration = "", is_std_peak = default(is_std_peak), min_n_datapoints = 2, quiet = default(quiet), is_standard = NULL) {
 
   # safety checks
   if (missing(dt)) stop("no data table supplied", call. = FALSE)
   if (missing(model)) stop("no calibration model(s) supplied", call. = FALSE)
+  if (!missing(is_standard)) {
+    stop("the parameter is_standard was renamed to is_std_peak to avoid confusion, please use is_std_peak instead", call. = FALSE)
+  }
+
   dt_quo <- enquo(dt)
   model_quos <- enquo(model)
-  filter_quo <- enquo(is_standard) %>% resolve_defaults()
+  filter_quo <- enquo(is_std_peak) %>% resolve_defaults()
   calib_vars <- get_calibration_vars(calibration)
 
   # information
   if (!quiet) {
-    if (quo_is_lang(model_quos) && quo_text(lang_head(model_quos)) %in% c("c", "list")) {
+    if (quo_is_call(model_quos) && quo_text(lang_head(model_quos)) %in% c("c", "list")) {
       lquos <- quos(!!!lang_args(model_quos))
     } else {
       lquos <- quos(!!!model_quos)
@@ -143,7 +160,8 @@ iso_generate_calibration <- function(dt, model, calibration = "", is_standard =
     plural <- if (length(models) > 1) "s" else ""
     glue("Info: generating {calib_vars$calib_name}calibration based on {length(models)} model{plural} ('{collapse(models, \"', '\")}') ",
          "for {nrow(dt)} data group(s) with standards filter '{quo_text(filter_quo)}'. ",
-         "Storing residuals in new column '{calib_vars$residual}'.") %>%
+         "Storing residuals in new column '{calib_vars$residual}'. ",
+         "Storing calibration info in new column '{calib_vars$in_reg}'.") %>%
       message()
   }
 
@@ -155,8 +173,9 @@ iso_generate_calibration <- function(dt, model, calibration = "", is_standard =
     model_name = !!sym(calib_vars$model_name),
     model_enough_data = !!sym(calib_vars$model_enough_data),
     model_params = !!sym(calib_vars$model_params),
+    in_reg = !!sym(calib_vars$in_reg),
     residual = !!sym(calib_vars$residual),
-    model_fit = model_fit, model_range = model_range, model_coefs = model_coefs, model_summary = model_summary
+    model_fit = model_fit, model_coefs = model_coefs, model_summary = model_summary
   )
 
   return(dt_w_regs)
@@ -226,6 +245,53 @@ iso_remove_problematic_calibrations <- function(dt, calibration = "", remove_cal
   return(dt_out)
 }
 
+# EVALUATING CALIBRATION RANGES -------
+
+#' Evaluate calibration range
+#'
+#' Evaluates the calibration ranges for all calibrations and all data with respect to the provided terms (\code{...}). Generates a summary column called \code{in_range} (with \code{calibration} prefix if used) in the \code{all_data} data frames summarizing the range information. Also stores the calibration ranges themselves in a nested data frame, which can be accessed via \link{iso_unnest_calibration_range} if needed.
+#'
+#' Note that this function requires prior generation of a calibration (\code{\link{iso_generate_calibration}}). All measured parameters and derived terms can be included in the calibration range evalution. However, if the predicted term is intended to be included in the range evaluation, the calibration(s) must also be applied (\code{\link{iso_apply_calibration}}) first so the predicted term is actually available.
+#'
+#' @inheritParams evaluate_range
+#' @inheritParams iso_show_default_processor_parameters
+#' @export
+iso_evaluate_calibration_range <- function(dt, ..., calibration = "", quiet = default(quiet)) {
+
+  # safety checks
+  if (missing(dt)) stop("no data table supplied", call. = FALSE)
+  terms_quos <- rlang::enquos(...)
+  if (length(terms_quos) == 0) {
+    stop("no terms for calibration range evaluation are provided, please specify at least one term", call. = FALSE)
+  }
+
+  dt_quo <- enquo(dt)
+  calib_vars <- get_calibration_vars(calibration)
+  check_calibration_cols(!!dt_quo, calib_vars$model_params)
+
+  # information
+  if (!quiet) {
+    glue("Info: evaluating range for terms ",
+         "'{glue::glue_collapse(map_chr(terms_quos, rlang::as_label), sep = \"', '\", last = \"' and '\")}' ",
+         "in {calib_vars$calib_name}calibration for {nrow(dt)} data group(s); ",
+         "storing resulting summary for each data entry in new column '{calib_vars$in_range}'.") %>%
+      message()
+  }
+
+  # evaluate range
+  dt_out <- evaluate_range(
+    dt = dt, !!!terms_quos,
+    nested_model = TRUE,
+    model_data = all_data,
+    model_params = !!sym(calib_vars$model_params),
+    in_reg = !!sym(calib_vars$in_reg),
+    model_range = model_range,
+    in_range = !!sym(calib_vars$in_range)
+  )
+
+  return(dt_out)
+}
+
 # INVERTING CALIBRATION --------
 
 #' Apply calibration
@@ -277,11 +343,9 @@ iso_apply_calibration <- function(dt, predict, calibration = "", predict_range =
     model_data = all_data,
     model_name = !!sym(calib_vars$model_name),
     model_fit = model_fit,
-    model_range = model_range,
     model_params = !!sym(calib_vars$model_params),
     predict_value = !!pred_col_quo,
     predict_error = !!pred_se_col_quo,
-    predict_in_range = !!pred_se_in_range_quo,
     predict_range = predict_range
   )
 
@@ -369,7 +433,7 @@ iso_unnest_calibration_summary <- function(dt, calibration = "", select = everyt
 
 #' Unnest calibration range
 #'
-#' Retrieve range information for a calibration. Problematic calibrations are silently omitted (use \link{iso_get_problematic_calibrations} and \link{iso_remove_problematic_calibrations} to deal with them more explicitly).
+#' Retrieve range information created by \link{iso_evaluate_calibration_range}. Problematic calibrations are silently omitted (use \link{iso_get_problematic_calibrations} and \link{iso_remove_problematic_calibrations} to deal with them more explicitly).
 #'
 #' @inheritParams iso_generate_calibration
 #' @inheritParams unnest_model_column