R/device_dual_pam_single_channel_p700.R

Defines functions validate_dual_pam_single_channel_p700_data read_dual_pam_single_channel_p700_data

Documented in read_dual_pam_single_channel_p700_data

#' Read and Process DualPAM Data Single Chanel Mode P700
#'
#' Reads raw CSV files generated by DualPAM software, calculates electron transport rate (ETR) values for Photosystem I, and returns a universal 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 using:
#' \deqn{\text{ETR} = \text{PAR} \cdot \text{ETR-Factor} \cdot \text{Fraction of Photosystem (I)} \cdot \text{Yield (I)}}
#'
#' A detailed documentation can be found under \url{https://github.com/biotoolbox/pam?tab=readme-ov-file#read_dual_pam_data}
#'
#' @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}: NA
#'   \item \code{etr_1}: Calculated ETR for photosystem I
#'   \item \code{etr_2}: NA
#' }
#'
#' @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/dual_pam_single_channel_p700_data", package = "pam"),
#'   "20260130_01_dual_pam_only_p700.csv"
#' )
#' data <- read_dual_pam_single_channel_p700_data(path)
#' @export
read_dual_pam_single_channel_p700_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 = ".")
      data <- data.table::as.data.table(data)

      validate_dual_pam_single_channel_p700_data(data)
      data <- data[data$ID == "SP", ]

      date_time_col_values <- c()
      for (i in seq_len(nrow(data))) {
        row <- data[i, ]

        date_time_row_value <- as.POSIXct(
          paste(row$Date, row$Time, sep = " "),
          tz = "GMT", "%d.%m.%y %H:%M:%S"
        )
        date_time_col_values <- c(date_time_col_values, date_time_row_value)
      }

      data$DateTime <- date_time_col_values
      data <- data[order(data$DateTime), ]

      pm_det_row <- subset(data, data$PAR == 0 & data$Action == "Pm.-Det.")
      yield_1_first <- pm_det_row$Y.I.
      recalc_etr_1 <- calc_etr(yield_1_first, 0, etr_factor, fraction_photosystem_I)


      result <- data.table::data.table(
        par = numeric(),
        yield_1 = numeric(),
        yield_2 = numeric(),
        etr_1 = numeric(),
        etr_2 = numeric()
      )
      new_row <- list(
        par = 0,
        yield_1 = yield_1_first,
        yield_2 = NA_real_,
        etr_1 = recalc_etr_1,
        etr_2 = NA_real_
      )
      result <- rbind(result, new_row)

      last_par <- as.numeric(0)
      for (i in seq_len(nrow(data))) {
        row <- data[i, ]
        current_par <- row$PAR

        if (row$Action != "P700 SP") {
          next
        }

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

        yield_1 <- row$Y.I.
        recalc_etr_1 <- calc_etr(yield_1, current_par, etr_factor, fraction_photosystem_I)

        new_row <- list(
          par = current_par,
          yield_1 = yield_1,
          yield_2 = NA_real_,
          etr_1 = recalc_etr_1,
          etr_2 = NA_real_
        )
        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_dual_pam_single_channel_p700_data <- function(data) {
  validate_data_not_empty(data)

  if (!"ID" %in% colnames(data)) {
    stop("required col 'ID' not found")
  }

  if (!"PAR" %in% colnames(data)) {
    stop("required col 'PAR' not found")
  }

  if (!"Y.I." %in% colnames(data)) {
    stop("required col 'Y(I)' not found")
  }

  if (!"Action" %in% colnames(data)) {
    stop("required col 'Action' not found")
  }

  if (!"Date" %in% colnames(data)) {
    stop("required col 'Date' not found")
  }

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

  if (!"Pm.-Det." %in% data[["Action"]]) {
    stop("required value 'Pm.-Det.' not found in column 'Action'")
  }
}

Try the pam package in your browser

Any scripts or data that you put into this service are public.

pam documentation built on April 23, 2026, 5:08 p.m.