R/device_junior_pam.R

In pam: Fast and Efficient Processing of PAM Data

#' Read and Process Junior PAM Data
#'
#' Reads raw CSV files generated by Junior PAM software, calculates electron transport rate (ETR) values, and returns a cleaned dataset.
#'
#' @param csv_path File path to the CSV file.
#' @param remove_recovery Logical. Removes recovery measurements if \code{TRUE}. Default is \code{TRUE}.
#' @param etr_factor Numeric. Factor for ETR calculation. Default is \code{0.84}.
#' @param fraction_photosystem_I Numeric. Relative distribution of absorbed PAR to photosystem I. Default is \code{0.5}.
#' @param fraction_photosystem_II Numeric. Relative distribution of absorbed PAR to photosystem II. Default is \code{0.5}.
#'
#' @details
#' Calculates ETR II using:
#' \deqn{\text{ETR II} = \text{PAR} \cdot \text{ETR-Factor} \cdot \text{Fraction of Photosystem (II)} \cdot \text{Yield (II)}}
#'
#' A detailed documentation can be found under \url{https://github.com/biotoolbox/pam/tree/main#functions}
#'
#' @return A \code{data.table} containing:
#' \itemize{
#'   \item \code{par}: Photosynthetically active radiation.
#'   \item \code{yield_1}: Yield for photosystem I.
#'   \item \code{yield_2}: Yield for photosystem II.
#'   \item \code{etr_1}: Calculated ETR for photosystem I.
#'   \item \code{etr_2}: Calculated ETR for photosystem II.
#' }
#'
#' @references{
#'   Heinz Walz GmbH. (2024). \emph{DUAL-PAM-100 DUAL-PAM/F MANUAL, 5th Edition, April 2024, Chapter 7 (pp. 162-172).}
#'   Heinz Walz GmbH, Effeltrich, Germany.
#'   Available at: \url{https://www.walz.com/files/downloads/dualpamed05.pdf}
#' }
#' @examples
#' path <- file.path(
#'   system.file("extdata/junior_pam_data", package = "pam"),
#'   "2026_04_22_junior_pam.csv"
#' )
#' data <- read_junior_pam_data(path)
#' @export
read_junior_pam_data <- function(
  csv_path,
  remove_recovery = TRUE,
  etr_factor = 0.84,
  fraction_photosystem_I = 0.5,
  fraction_photosystem_II = 0.5
) {
  if (fraction_photosystem_I + fraction_photosystem_II != 1) {
    stop("The sum of fraction_photosystem_I and fraction_photosystem_II must be equal 1.")
  }

  tryCatch(
    {
      data <- utils::read.csv(csv_path, sep = ";", dec = ".", skip = 1, header = TRUE)
      data <- data.table::as.data.table(data)

      validate_junior_pam_data(data)

      par_col <- grep("^.+\\.PAR$", names(data), value = TRUE)[1]
      yield_2_col <- grep("^.+\\.Y\\.\\.II\\.$", names(data), value = TRUE)[1]

      data <- data[data$Type == "FO" | data$Type == "F", ]
      data <- data[order(data$"Time..rel.ms."), ]

      result <- data.table::data.table(
        par = numeric(),
        yield_1 = numeric(),
        yield_2 = numeric(),
        etr_1 = numeric(),
        etr_2 = numeric()
      )
      last_par <- as.numeric(0)
      for (i in seq_len(nrow(data))) {
        row <- data[i, ]
        current_par <- row[[par_col]]

        if (remove_recovery && last_par != 0 && current_par < last_par) {
          break
        }

        yield_2 <- row[[yield_2_col]]
        recalc_etr_2 <- calc_etr(yield_2, current_par, etr_factor, fraction_photosystem_II)

        new_row <- list(
          par = current_par,
          yield_1 = NA_real_,
          yield_2 = yield_2,
          etr_1 = NA_real_,
          etr_2 = recalc_etr_2
        )
        result <- rbind(result, new_row)

        last_par <- current_par
      }

      validate_intermediate_data(result)
      return(result)
    },
    warning = function(w) {
      stop("Warning in file: ", csv_path, " Warning: ", w)
    },
    error = function(e) {
      stop("Error in file: ", csv_path, " Error: ", e)
    }
  )
}

validate_junior_pam_data <- function(data) {
  validate_data_not_empty(data)

  par_cols <- grep("^.+\\.PAR$", names(data), value = TRUE)
  if (length(par_cols) == 0) {
    stop("required col 'PAR' not found")
  } else if (length(par_cols) > 1) {
    stop(paste(length(par_cols), " 'PAR' cols found. Only supporting one 'PAR' column"))
  }

  yield_cols <- grep("^.+\\.Y\\.\\.II\\.$", names(data), value = TRUE)
  if (length(yield_cols) == 0) {
    stop("required col 'Y (II)' not found")
  } else if (length(yield_cols) > 1) {
    stop(paste(length(yield_cols), " 'Y (II)' cols found. Only supporting one 'Y (II)' column"))
  }

  if (!"Time..rel.ms." %in% colnames(data)) {
    stop("required col 'Time (rel/ms)' not found")
  }
}