Dev

.github/workflows/rcmdcheck.yml

@@ -10,9 +10,9 @@ name: rcmdcheck
 
 on:
   push:
-    branches: [ "main" ]
+    branches: [ "main", "dev" ]
   pull_request:
-    branches: [ "main" ]
+    branches: [ "main", "dev" ]
 
 permissions:
   contents: read

CITATION.cff

@@ -8,7 +8,21 @@ authors:
   given-names: "Philipp"
   orcid: "https://orcid.org/0009-0002-7697-5536"
 title: "pam"
-version: 2.1.1
-date-released: 2026-04-11
 url: "https://github.com/biotoolbox/pam"
 doi: "10.32614/CRAN.package.pam"
+
+preferred-citation:
+  type: article
+  authors:
+    - family-names: "Böhm"
+      given-names: "Julien"
+    - family-names: "Schrag"
+      given-names: "Philipp"
+  title: "pam: An R Package for Fast and Efficient Processing of Pulse-Amplitude Modulation Data"
+  journal: "Ecology and Evolution"
+  year: 2026
+  volume: 16
+  issue: 4
+  start: e73400
+  doi: "10.1002/ece3.73400"
+  url: "https://onlinelibrary.wiley.com/doi/abs/10.1002/ece3.73400"

Makefile

@@ -20,9 +20,9 @@ build:
 buildtest:
 	rm -rf src/tests/testthat/results
 	make build
-	R CMD check pam_2.1.1.tar.gz
+	R CMD check pam_2.2.0.tar.gz
 
 buildtestcran:
 	rm -rf src/tests/testthat/results
 	make build
-	R CMD check --as-cran pam_2.1.1.tar.gz
+	R CMD check --as-cran pam_2.2.0.tar.gz

examples/Example_compare_models.R

@@ -7,7 +7,7 @@ library("pam")
 #### read_dual_pam_data()####
 # raw data file directory
 script_dir <- dirname(sys.frame(1)$ofile)
-data_dir <- file.path(script_dir, "data", "bulk")
+data_dir <- file.path(script_dir, "data", "dual_pam_data", "bulk")
 
 #### compare_regression_models_ETR_II####
 compare_regression_models_ETR_II_result <- compare_regression_models_ETR_II(data_dir, read_dual_pam_data)

examples/Example_multiple_data.R

@@ -6,7 +6,7 @@ library("pam")
 
 #### raw data file directory####
 script_dir <- dirname(sys.frame(1)$ofile)
-data_dir <- file.path(script_dir, "data", "bulk")
+data_dir <- file.path(script_dir, "data", "dual_pam_data", "bulk")
 output_dir <- file.path(script_dir, "output")
 dir.create(output_dir, showWarnings = FALSE)
 output_path_pdf <- file.path(output_dir, "eilers_peters_plot_control.pdf")

src/DESCRIPTION

@@ -1,7 +1,7 @@
 Package: pam
 Type: Package
 Title: Fast and Efficient Processing of PAM Data
-Version: 2.1.1
+Version: 2.2.0
 Authors@R: c(
     person(
         "Julien",

src/NAMESPACE

@@ -17,7 +17,10 @@ export(platt_generate_regression_ETR_II)
 export(platt_modified)
 export(plot_control)
 export(read_dual_pam_data)
+export(read_dual_pam_single_channel_fluo_data)
+export(read_dual_pam_single_channel_p700_data)
 export(read_junior_pam_data)
+export(read_pam_2500_data)
 export(read_universal_data)
 export(vollenweider_default_start_value_a)
 export(vollenweider_default_start_value_alpha)

src/R/compare_regression_models.R

@@ -42,15 +42,14 @@
 #'   New Phytologist, 136(2), 189-209. Available at: \doi{10.1046/j.1469-8137.1997.00736.x}.
 #' }
 #' @examples
-#' path <- file.path(system.file("extdata", package = "pam"))
+#' path <- file.path(system.file("extdata/dual_pam_data", package = "pam"))
 #' points <- compare_regression_models_ETR_I(path, read_dual_pam_data)
 #'
 #' @export
 compare_regression_models_ETR_I <- function(data_dir, read_func) {
   return(compare_regression_models(data_dir, etr_1_type, read_func))
 }
 
-
 #' Compare Regression Models for ETR II
 #'
 #' Compares multiple regression models for electron transport rate (ETR) data using predefined performance metrics.
@@ -95,7 +94,7 @@ compare_regression_models_ETR_I <- function(data_dir, read_func) {
 #'   New Phytologist, 136(2), 189-209. Available at: \doi{10.1046/j.1469-8137.1997.00736.x}.
 #' }
 #' @examples
-#' path <- file.path(system.file("extdata", package = "pam"))
+#' path <- file.path(system.file("extdata/dual_pam_data", package = "pam"))
 #' points <- compare_regression_models_ETR_II(path, read_dual_pam_data)
 #'
 #' @export
@@ -117,50 +116,50 @@ compare_regression_models <- function(data_dir, etr_type, read_func) {
   for (file in csv_files) {
     title <- basename(file)
     data <- do.call(read_func, list(csv_path = file))
-    validate_data(data)
+    validate_intermediate_data(data)
 
     tryCatch(
       {
         eilers_peeters <- eilers_peeters_generate_regression_internal(data, etr_type)
-        eilers_peeters_sdiff <- eilers_peeters[["residual_sum_of_squares"]]
-        if (!is.numeric(eilers_peeters_sdiff)) {
+        eilers_peeters_residual_sum_of_squares <- eilers_peeters[["residual_sum_of_squares"]]
+        if (!is.numeric(eilers_peeters_residual_sum_of_squares)) {
           stop("eilers_peeters residual_sum_of_squares result is not numeric")
         }
-        if (is.na(eilers_peeters_sdiff)) {
+        if (is.na(eilers_peeters_residual_sum_of_squares)) {
           stop("failed to calculate residual_sum_of_squares with eilers_peeters")
         }
 
         platt <- platt_generate_regression_internal(data, etr_type)
-        platt_sdiff <- platt[["residual_sum_of_squares"]]
-        if (!is.numeric(eilers_peeters_sdiff)) {
+        platt_residual_sum_of_squares <- platt[["residual_sum_of_squares"]]
+        if (!is.numeric(platt_residual_sum_of_squares)) {
           stop("platt residual_sum_of_squares result is not numeric")
         }
-        if (is.na(platt_sdiff)) {
+        if (is.na(platt_residual_sum_of_squares)) {
           stop("failed to calculate residual_sum_of_squares with platt")
         }
 
         vollenweider <- vollenweider_generate_regression_internal(data, etr_type)
-        vollenweider_sdiff <- vollenweider[["residual_sum_of_squares"]]
-        if (!is.numeric(eilers_peeters_sdiff)) {
+        vollenweider_residual_sum_of_squares <- vollenweider[["residual_sum_of_squares"]]
+        if (!is.numeric(vollenweider_residual_sum_of_squares)) {
           stop("vollenweider residual_sum_of_squares result is not numeric")
         }
-        if (is.na(vollenweider_sdiff)) {
+        if (is.na(vollenweider_residual_sum_of_squares)) {
           stop("failed to calculate residual_sum_of_squares with vollenweider")
         }
 
         walsby <- walsby_generate_regression_internal(data, etr_type)
-        walsby_sdiff <- walsby[["residual_sum_of_squares"]]
-        if (!is.numeric(eilers_peeters_sdiff)) {
+        walsby_residual_sum_of_squares <- walsby[["residual_sum_of_squares"]]
+        if (!is.numeric(walsby_residual_sum_of_squares)) {
           stop("walsby residual_sum_of_squares result is not numeric")
         }
-        if (is.na(walsby_sdiff)) {
+        if (is.na(walsby_residual_sum_of_squares)) {
           stop("failed to calculate residual_sum_of_squares with walsby")
         }
 
-        data1 <- data.table::data.table(group = "eilers_peeters", value = eilers_peeters_sdiff)
-        data2 <- data.table::data.table(group = "platt", value = platt_sdiff)
-        data3 <- data.table::data.table(group = "vollenweider", value = vollenweider_sdiff)
-        data4 <- data.table::data.table(group = "walsby", value = walsby_sdiff)
+        data1 <- data.table::data.table(group = "eilers_peeters", value = eilers_peeters_residual_sum_of_squares)
+        data2 <- data.table::data.table(group = "platt", value = platt_residual_sum_of_squares)
+        data3 <- data.table::data.table(group = "vollenweider", value = vollenweider_residual_sum_of_squares)
+        data4 <- data.table::data.table(group = "walsby", value = walsby_residual_sum_of_squares)
 
         combined_data <- rbind(data1, data2, data3, data4)
         combined_data <- combined_data[order(combined_data$value), ]

src/R/device_dual_pam.R

@@ -0,0 +1,170 @@
+#' Read and Process DualPAM Data
+#'
+#' Reads raw CSV files generated by DualPAM software, calculates electron transport rate (ETR) values, 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 or II)} \cdot \text{Yield (I or II)}}
+#'
+#' 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}: 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/dual_pam_data", package = "pam"), "20240925.csv")
+#' data <- read_dual_pam_data(path)
+#' @export
+read_dual_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 = ".")
+      data <- data.table::as.data.table(data)
+
+      validate_dual_pam_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)
+
+      fm_det_row <- subset(data, data$PAR == 0 & data$Action == "Fm-Det.")
+      yield_2_first <- fm_det_row$Y.II.
+      recalc_etr_2 <- calc_etr(yield_2_first, 0, etr_factor, fraction_photosystem_II)
+
+
+      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 = yield_2_first,
+        etr_1 = recalc_etr_1,
+        etr_2 = recalc_etr_2
+      )
+      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 != "P.+F. 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)
+
+        yield_2 <- row$Y.II.
+        recalc_etr_2 <- calc_etr(yield_2, current_par, etr_factor, fraction_photosystem_II)
+
+        new_row <- list(
+          par = current_par,
+          yield_1 = yield_1,
+          yield_2 = yield_2,
+          etr_1 = recalc_etr_1,
+          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_dual_pam_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) && !"Y.II." %in% colnames(data)) {
+    stop("required col 'Y(I)' and 'Y(II)' 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' not found in column 'Action'")
+  }
+
+  if (!"Fm-Det." %in% data[["Action"]]) {
+    stop("required value 'Fm' not found in column 'Action'")
+  }
+}