R/integrate_regions.R

In bentrueman/cwrshelpr: Functions for CWRS Data Analysis

#' Fluorescent regional integration (FRI)
#'
#' @param x An excitation-emission matrix generated by cwrshelpr::read_feem().
#' @param ex_min Lower excitation bound of each region.
#' @param ex_max Upper excitation bound of each region.
#' @param em_min Lower emission bound of each region.
#' @param em_max Upper emission bound of each region.
#' @param region_names A vector of region names, corresponding to ex/em_min/max.
#'
#' @return A tibble with columns `name`, `ex_min`, `ex_max`, `em_min`, `em_max`, `integrated`.
#' @importFrom dplyr summarize pull filter select group_by ungroup rowwise %>%
#' @importFrom rlang .data
#' @importFrom purrr map_dfr
#' @importFrom tibble add_row enframe
#' @importFrom tidyr pivot_wider
#' @export
#'
#' @examples
#' file <- list.files(
#'    path = system.file("extdata", package = "cwrshelpr"),
#'    full.names = TRUE,
#'    pattern = ".+\\.csv"
#' )
#' feem <- read_feem(file[1], truncate = TRUE)
#' integrate_regions(feem)
integrate_regions <- function(
  x,
  # regions 1-5 as defined in https://doi.org/10.1021/es034354c
  ex_min = c(200, 200, 200, 250, 250),
  ex_max = c(250, 250, 250, 340, 400),
  em_min = c(200, 330, 380, 200, 380),
  em_max = c(330, 380, 550, 380, 550),
  region_names = 1:5
) {
  bound <- NULL
  value <- NULL
  eem <- NULL
  coords <- list(
    "ex_min" = ex_min,
    "ex_max" = ex_max,
    "em_min" = em_min,
    "em_max" = em_max
  ) %>%
    map_dfr(
      ~ .x %>%
        set_names(nm = paste("region", region_names, sep = "_")) %>%
        enframe(),
      .id = "bound"
    ) %>%
    pivot_wider(names_from = bound, values_from = value)

  resolution <- x %>% # average cell area
    summarize(
      ex_inc = unique(.data$excitation) %>% diff() %>% mean() %>% abs(),
      em_inc = unique(.data$emission) %>% diff() %>% mean() %>% abs(),
      product = .data$ex_inc * .data$em_inc
    ) %>%
    pull(.data$product)

  coords %>%
    rowwise() %>%
    mutate(
      eem = list(x),
      sum = list(
        .data$eem %>%
          filter(
            .data$excitation > ex_min,
            .data$excitation <= ex_max,
            .data$emission > em_min,
            .data$emission <= em_max
          ) %>%
          pull(.data$intensity) %>%
          sum()
      ),
      integrated = .data$sum * resolution
    ) %>%
    ungroup() %>%
    select(-c(eem, sum)) %>%
    add_row(name = "total", integrated = sum(x$intensity) * resolution)
}