v0.6.0

.github/workflows/R-CMD-check.yaml

@@ -2,9 +2,9 @@
 # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
-    branches: [main, master]
+    branches: [main, master, dev]
   pull_request:
-    branches: [main, master]
+    branches: [main, master, dev]
 
 name: R-CMD-check
 

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: chromatographR
 Title: Chromatographic Data Analysis Toolset
-Version: 0.5.6
+Version: 0.6.0
 Authors@R: c(
     person("Ethan", "Bass", , "ethanbass@gmail.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-6175-6739")),

NEWS.md

@@ -1,3 +1,18 @@
+# chromatographR 0.6.0
+
+#### New features
+
+* Enabled use of `parallel` package for parallel processing (in addition to current options using `mcapply`). (These options require the installation of suggested package `pbapply`).
+* Updated `get_peaktable` for greater flexibility (e.g. for usage of 'Chemstation' peak lists as input).
+
+#### Other changes
+
+* Made some minor changes to vignette to improve clarity (e.g. using single wavelength for integration, etc.)
+
+#### Bug fixes
+
+* Fixed error in `attach_metadata` when there are NA values in merge column.
+
 # chromatographR 0.5.6
 
 * Fixed bug in preprocess function causing fatal error due to misrecognition of matrices.
@@ -22,7 +37,7 @@
 # chromatographR 0.5.2
 
 * Added `metadata` argument to `reshape_peaktable` for filtering metadata fields.
-* Added option to for renaming peaks via `reshape_peaktable` by providing a named list.
+* Added option for renaming peaks via `reshape_peaktable` by providing a named character vector.
 
 # chromatographR 0.5.1
 

R/attach_metadata.R

@@ -30,7 +30,7 @@ attach_metadata <- function(peak_table, metadata, column){
   }
   if (!(column %in% colnames(metadata)))
     stop(paste0("Column, ", column, ", is not found."))
-  if (sum((duplicated(metadata[,column]))) > 0)
+  if (sum((duplicated(metadata[,column], incomparables = NA))) > 0)
     stop(paste("Sample names must be unique. Please check column", sQuote(column),
     "for duplicates."))
   if (!inherits(peak_table,"peak_table"))

R/chromatographR-package.R

@@ -1,9 +1,11 @@
+
+
 #' chromatographR
 #' 
 #' chromatographR
 #' 
 #' \tabular{ll}{ Package: \tab chromatographR\cr Type: \tab Package\cr Version:
-#' \tab 0.5.6 \cr Date: \tab 2023-09-18\cr License: GPL (>= 2) }
+#' \tab 0.6.0 \cr Date: \tab 2023-09-22\cr License: GPL (>= 2) }
 #' 
 #' @name chromatographR-package
 #' @aliases chromatographR-package chromatographR

R/preprocess.R

@@ -68,7 +68,7 @@ preprocess <- function(X, dim1, ## time axis
                           dim2, ## spectral axis
                           remove.time.baseline = TRUE,
                           spec.smooth = TRUE,
-                          maxI, parallel = NULL, 
+                          maxI = NULL, parallel = NULL, 
                           interpolate_rows = TRUE,
                           interpolate_cols = TRUE,
                           mc.cores, cl = 2, show_progress = NULL, ...){
@@ -148,7 +148,7 @@ preprocess_matrix <- function(X,
                               dim2, ## spectral axis
                               remove.time.baseline = TRUE,
                               spec.smooth = TRUE,
-                              maxI,
+                              maxI = NULL,
                               interpolate_rows = TRUE,
                               interpolate_cols = TRUE,
                               ...) {
@@ -186,7 +186,7 @@ preprocess_matrix <- function(X,
   if (min(X, na.rm = TRUE) < 0){
     X[X < 0] <- 0
   }
-  if (!missing(maxI)){
+  if (!is.null(maxI)){
     X <- maxI * X / max(X)
   }
   dimnames(X) <- list(dim1, dim2)

R/reshape_chroms.R

@@ -77,11 +77,12 @@ reshape_peaktable <- function(x, peaks, metadata){
   if (!missing(peaks)){
     x$tab <- x$tab[,which(colnames(x$tab) %in% peaks), drop = FALSE]
     if (!is.null(names(peaks))){
-      colnames(x$tab) <- names(peaks)
+      colnames(x$tab) <- names(peaks)[match(colnames(x$tab), peaks)]
     }
   }
   if (!missing(metadata)){
-    x$sample_meta <- x$sample_meta[,which(colnames(x$sample_meta) %in% metadata), drop = FALSE]
+    meta_idx <- which(colnames(x$sample_meta) %in% metadata)
+    x$sample_meta <- x$sample_meta[, meta_idx, drop = FALSE]
   }
   xx <- reshape(as.data.frame(chr = rownames(x$tab), x$tab), direction = "long",
     varying = list(1:ncol(x$tab)), v.names = x$args[["response"]],

R/utils.R

@@ -238,28 +238,36 @@ transfer_metadata <- function(new_object, old_object,
 #' otherwise returns \code{\link{lapply}}.
 #' @noRd
 choose_apply_fnc <- function(show_progress, parallel = NULL, cl = 2){
+  pbapply_installed <- check_for_pkg("pbapply", return_boolean = TRUE)
+  is_not_windows <- .Platform$OS.type != "windows"
+
   if (is.null(show_progress)){
-    show_progress <- check_for_pkg("pbapply", return_boolean = TRUE)
+    show_progress <- pbapply_installed
   }
+
   if (is.null(parallel)){
-    parallel <- .Platform$OS.type != "windows"
-  } else if (parallel & .Platform$OS.type == "windows"){
-    parallel <- FALSE
-    warning("Parallel processing is not currently available on Windows.")
-  }
-  if (is.null(cl) || cl == 1){
-    parallel <- FALSE
+    if (!is.null(cl) && (class(cl)[1] == "SOCKcluster" || (is_not_windows && cl > 1))){
+      parallel <- TRUE
+    } else {
+      parallel <- FALSE
+    }
   }
+
   if (!parallel){
     cl <- 1
   }
+
+  if (.Platform$OS.type == "windows" && parallel && !pbapply_installed){
+    stop("Please install the pbapply package to use parallel processing on Windows.")
+  }
+
   if (show_progress){
     check_for_pkg("pbapply")
     pblapply <- pbapply::pblapply
     fn <- purrr::partial(pblapply, cl = cl)
-  } else if (!show_progress && parallel){
-    fn <- purrr::partial(mclapply, mc.cores = cl)
-    } else{
+  } else if (!show_progress && is_not_windows && is.numeric(cl) && cl > 1){
+      fn <- purrr::partial(mclapply, mc.cores = cl)
+  } else {
     fn <- lapply
   }
   fn

README.md

@@ -59,5 +59,4 @@ Also see the [contributing.md](https://github.com/ethanbass/chromatographR/blob/
 
 If you use chromatographR in published work, please cite it as follows:
 
-Bass, E. (2023). chromatographR: chromatographic data analysis toolset (version 0.5.6).
-http://doi.org/10.5281/zenodo.6944334
+Bass, E. (2023). chromatographR: chromatographic data analysis toolset (version 0.6.0). http://doi.org/10.5281/zenodo.6944334

inst/CITATION

@@ -5,11 +5,11 @@ citEntry(
   title    = "chromatographR: chromatographic data analysis toolset",
   author   = "Ethan Bass",
   year     = "2023",
-  note     = "version 0.5.6",
+  note     = "version 0.6.0",
   url      = "https://ethanbass.github.io/chromatographR/",
   doi      = "10.5281/zenodo.6944334",
   textVersion = paste("Bass, E. (2023).",
-        "chromatographR: chromatographic data analysis toolset (version 0.5.6).",
+        "chromatographR: chromatographic data analysis toolset (version 0.6.0).",
         "http://doi.org/10.5281/zenodo.6944334"
         )
   )

inst/WORDLIST

@@ -8,6 +8,7 @@ Broeckling
 CMD
 Carvalho
 ChemStation
+Chemstation
 Chromatograms
 Chromatographia
 Chromatographic

tests/testthat/test-pipeline.R

@@ -98,17 +98,6 @@ test_that("plot_chroms works to plot alignments", {
   expect_error(plot_chroms(pktab))
 })
 
-test_that("plot_chroms works with plotly", {
-  skip_on_cran()
-  skip_if_not_installed("vdiffr")
-  skip_if_not_installed("plotly")
-  skip_if_not_installed("reticulate")
-  skip_if_not_installed("rsvg")
-
-  p <- plot_chroms(warp, lambdas="210", engine="plotly")
-  suppressWarnings(expect_doppelganger_plotly(name = "alignment_plotly", p = p))
-})
-
 test_that("plot_chroms works to plot alignments with ggplot", {
   skip_on_cran()
   skip_if_not_installed("vdiffr")
@@ -366,6 +355,16 @@ test_that("plot_spectrum works with plotly engine", {
   expect_doppelganger_plotly("plot_spectrum_plotly", p = p3)
 })
 
+test_that("plot_chroms works with plotly", {
+  skip_on_cran()
+  skip_if_not_installed("vdiffr")
+  skip_if_not_installed("plotly")
+  skip_if_not_installed("reticulate")
+  skip_if_not_installed("rsvg")
+  p <- plot_chroms(warp, lambdas="210", engine="plotly")
+  suppressWarnings(expect_doppelganger_plotly(name = "alignment_plotly", p = p))
+})
+
 test_that("plot_spectrum works with ggplot2", {
   skip_on_cran()
   skip_if_not_installed("vdiffr")
@@ -465,35 +464,35 @@ test_that("cluster_spectra works", {
   expect_equal(class(cl[[2]]), "list")
 })
 
-# test_that("write_peaktable writes csvs correctly", {
-#   data(pk_tab)
-#   skip_on_cran()
-#   path <-  tempdir(check = TRUE)
-#   on.exit(unlink(c(fs::path(path,"peak_table-tab", ext="csv"),
-#                    fs::path(path,"peak_table-pk_meta", ext="csv"),
-#                    path)))
-#   write_peaktable(peak_table = pk_tab, path = path, format = "csv", what=c("tab", "pk_meta"))
-#   path_table <- paste0(file.path(path,"peak_table-tab"), ext =".csv")
-#   path_meta <- paste0(file.path(path,"peak_table-pk_meta"), ext =".csv")
-# 
-#   expect_true(file.exists(path_table))
-#   expect_true(file.exists(path_meta))
-# 
-#   expect_equal(pk_tab$tab, read.csv(file = path_table, row.names = 1), ignore_attr=TRUE)
-#   expect_equal(pk_tab$pk_meta, read.csv(file = path_meta, row.names = 1), ignore_attr=TRUE)
-#   expect_error(write_peaktable(pk_tab, path="fake_path"))
-# })
+test_that("write_peaktable writes csvs correctly", {
+  data(pk_tab)
+  skip_on_cran()
+  path <-  tempdir(check = TRUE)
+  on.exit(unlink(c(fs::path(path,"peak_table-tab", ext="csv"),
+                   fs::path(path,"peak_table-pk_meta", ext="csv"),
+                   path)))
+  write_peaktable(peak_table = pk_tab, path = path, format = "csv", what=c("tab", "pk_meta"))
+  path_table <- paste0(file.path(path,"peak_table-tab"), ext =".csv")
+  path_meta <- paste0(file.path(path,"peak_table-pk_meta"), ext =".csv")
 
-# test_that("write_peaktable writes xlsx correctly", {
-#   skip_on_cran()
-#   skip_if_not_installed("openxlsx")
-#   data(pk_tab)
-#   path <-  tempdir()
-#   on.exit(unlink(c(fs::path(path, "peak_table", ext="xlsx"), path)))
-#   
-#   write_peaktable(pk_tab, path = path, format = "xlsx")
-#   file <- fs::path(path, "peak_table", ext = "xlsx")
-#   xx <- openxlsx::read.xlsx(file, sheet = 1, rowNames = TRUE)
-#   expect_equal(pk_tab$tab, xx, ignore_attr=TRUE)
-#   expect_equal(pk_tab$pk_meta, openxlsx::read.xlsx(file, sheet = 2, rowNames = TRUE), ignore_attr=TRUE)
-# })
+  expect_true(file.exists(path_table))
+  expect_true(file.exists(path_meta))
+
+  expect_equal(pk_tab$tab, read.csv(file = path_table, row.names = 1), ignore_attr=TRUE)
+  expect_equal(pk_tab$pk_meta, read.csv(file = path_meta, row.names = 1), ignore_attr=TRUE)
+  expect_error(write_peaktable(pk_tab, path="fake_path"))
+})
+
+test_that("write_peaktable writes xlsx correctly", {
+  skip_on_cran()
+  skip_if_not_installed("openxlsx")
+  data(pk_tab)
+  path <-  tempdir()
+  on.exit(unlink(c(fs::path(path, "peak_table", ext="xlsx"), path)))
+
+  write_peaktable(pk_tab, path = path, format = "xlsx")
+  file <- fs::path(path, "peak_table", ext = "xlsx")
+  xx <- openxlsx::read.xlsx(file, sheet = 1, rowNames = TRUE)
+  expect_equal(pk_tab$tab, xx, ignore_attr=TRUE)
+  expect_equal(pk_tab$pk_meta, openxlsx::read.xlsx(file, sheet = 2, rowNames = TRUE), ignore_attr=TRUE)
+})

tests/testthat/test-utility-functions.R

@@ -12,40 +12,56 @@ test_that("get_lambdas works as expected", {
 })
 
 test_that("choose_apply_fnc works as expected", {
+  skip_on_cran()
   skip_if_not_installed("pbapply")
   fn <- choose_apply_fnc(show_progress = TRUE)
-  expect_equal(class(fn), c("purrr_function_partial","function"))
+  expect_equal(class(fn), c("purrr_function_partial", "function"))
 
   fn <- choose_apply_fnc(show_progress = FALSE, parallel = FALSE)
   expect_equal(fn, lapply)
-  fn <- choose_apply_fnc(show_progress = FALSE, cl=1)
+  fn <- choose_apply_fnc(show_progress = FALSE, cl = 1)
   expect_equal(fn, lapply)
-  fn <- choose_apply_fnc(show_progress = FALSE, cl=NULL)
+  fn <- choose_apply_fnc(show_progress = FALSE, cl = NULL)
   expect_equal(fn, lapply)
 })
 
 test_that("choose apply_fnc works as expected on unix/linux", {
+  skip_on_cran()
   skip_on_os("windows")
-  fn <- choose_apply_fnc(show_progress = TRUE, parallel=TRUE)
+
+  fn <- choose_apply_fnc(show_progress = TRUE, parallel = TRUE)
   expect_equal(class(fn), c("purrr_function_partial","function"))
 
-  fn <- choose_apply_fnc(show_progress = FALSE, parallel=TRUE)
+  fn <- choose_apply_fnc(show_progress = FALSE, parallel = TRUE)
   expect_equal(class(fn), c("purrr_function_partial","function"))
 
   fn<-choose_apply_fnc(show_progress=NULL, parallel = TRUE)
-  pbapply_exists <- check_for_pkg("pbapply", return_boolean=TRUE)
+  pbapply_exists <- check_for_pkg("pbapply", return_boolean = TRUE)
   expect_equal(fn, choose_apply_fnc(show_progress = pbapply_exists, parallel = TRUE))
+
+  cl <- parallel::makeCluster(2)
+  fn <- choose_apply_fnc(show_progress = NULL, cl = cl)
+  expect_equal(class(fn), c("purrr_function_partial", "function"))
+  parallel::stopCluster(cl)
+
+  fn <- choose_apply_fnc(show_progress = NULL, cl = 2)
+  expect_equal(class(fn), c("purrr_function_partial", "function"))
 })
 
 test_that("choose apply_fnc works as expected on windows", {
+  skip_on_cran()
   skip_on_os(c("mac","linux","solaris"))
-  expect_warning(choose_apply_fnc(show_progress = TRUE, parallel=TRUE))
-  expect_warning(choose_apply_fnc(show_progress = FALSE, parallel=TRUE))
-  expect_warning(choose_apply_fnc(show_progress=NULL, parallel = TRUE))
+  skip_if_not_installed("pbapply")
+
+  cl <- parallel::makeCluster(2)
+  fn <- choose_apply_fnc(show_progress = NULL, cl = cl)
+  parallel::stopCluster(cl)
+  expect_equal(class(fn), c("purrr_function_partial", "function"))
 })
 
 test_that("choose_apply_fnc works as expected with NULL value", {
-  pbapply_exists <- check_for_pkg("pbapply", return_boolean=TRUE)
+  skip_on_cran()
+  pbapply_exists <- check_for_pkg("pbapply", return_boolean = TRUE)
 
   fn<-choose_apply_fnc(show_progress=NULL, parallel = FALSE)
   expect_equal(fn, choose_apply_fnc(show_progress = pbapply_exists, parallel = FALSE))