v0.5.1 bug fixes

remove default legend in plot_chroms

Author: ethanbass

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: chromatographR
 Title: Chromatographic Data Analysis Toolset
-Version: 0.5.0
+Version: 0.5.1
 Authors@R: c(
     person("Ethan", "Bass", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-6175-6739")),

NEWS.md

@@ -1,3 +1,13 @@
+# chromatographR 0.5.1
+
+* In `plot_chroms`, `show_legend` now defaults to FALSE to prevent overloading of the plot.
+
+#### Bug fixes
+
+* Fixed syntactical bug in `get_peaktable` when applied to gaussian peak list.
+* Fixed bug caused by improper transfer of `time.units` metadata by `filter_peaks` function.
+* Added default for missing `time.units` in `plot.peak_list`.
+
 # chromatographR 0.5.0
 
 #### New features

R/filter_peaks.R

@@ -62,17 +62,13 @@ filter_peaks <- function(peak_list, min_height, min_area,
            lapply(smpl,
                   function(comp)
                     comp[which(comp[,"sd"] < max_sd &
-                           comp[,"sd"] > min_sd &
-                           comp[,"height"] > min_height &
-                           comp[,"area"] > min_area &
-                           comp[,"rt"] > as.numeric(min_rt) &
-                           comp[,"rt"] < as.numeric(max_rt)), , drop = FALSE]))
+                           comp[, "sd"] > min_sd &
+                           comp[, "height"] > min_height &
+                           comp[, "area"] > min_area &
+                           comp[, "rt"] > as.numeric(min_rt) &
+                           comp[, "rt"] < as.numeric(max_rt)), , drop = FALSE]))
   att <- attributes(peak_list)
-  structure(result,
-            chrom_list = att$chrom_list,
-            lambdas = att$lambdas, fit=att$fit, sd.max=att$sd.max,
-            max.iter=att$max.iter,
-            class="peak_list")
+  transfer_metadata(result, peak_list, c('names','row.names','dim','dimnames'))
 }
 
 #' Filter peak table

R/get_peaktable.R

@@ -152,8 +152,9 @@ get_peaktable <- function(peak_list, chrom_list, response = c("area", "height"),
       pkcenters.cl[sing] <- max(pkcenters.cl) + seq_along(sing)
     }
     vars <- c("rt", "start", "end", "sd", "tau", "FWHM", "r.squared", "purity")
-    cl.centers <- aggregate(xx[,vars], by = list(pkcenters.cl), FUN = "mean",
-                            na.rm = TRUE, na.action = "na.pass")[,-1]
+    vars.idx <- which(colnames(xx) %in% vars)
+    cl.centers <- aggregate(xx[,vars.idx], by = list(pkcenters.cl), FUN = "mean",
+                            na.action = "na.pass")[,-1]
     ncl <- length(cl.centers$rt)
 
     ## re-order clusters from small to large rt

R/plot.peak_list.R

@@ -32,12 +32,13 @@
 #' @rdname plot.peak_list
 #' @export
 
-plot.peak_list <- function(x, ..., chrom_list, index=1, lambda=NULL,
-                           points=FALSE, ticks=FALSE, a=0.5, color=NULL,
-                           cex.points=0.5, numbers = FALSE, cex.font = 0.5, 
+plot.peak_list <- function(x, ..., chrom_list, index = 1, lambda = NULL,
+                           points = FALSE, ticks = FALSE, a = 0.5, color = NULL,
+                           cex.points = 0.5, numbers = FALSE, cex.font = 0.5, 
                            y.offset = 25, plot_purity = FALSE, res){
   time.units <- attributes(x)$time.units
-  tfac <- switch(time.units, "min" = 1, "s" = 1/60, "ms" = 1/60000)
+  time.units <- ifelse(is.null(time.units), "", time.units)
+  tfac <- switch(time.units, "min" = 1, "s" = 1/60, "ms" = 1/60000, 1)
   if (missing(chrom_list)){
     chrom_list <- get_chrom_list(x)
   }
@@ -50,28 +51,28 @@ plot.peak_list <- function(x, ..., chrom_list, index=1, lambda=NULL,
   if (is.numeric(lambda)){
     lambda <- as.character(lambda)
   }
-  new.ts <- get_times(x=chrom_list, index=index)
+  new.ts <- get_times(x = chrom_list, index = index)
   y <- chrom_list[[index]][,lambda]
   pks <- data.frame(x[[index]][[lambda]])
   if ("r.squared" %in% colnames(pks)){
     fit <- ifelse("tau" %in% colnames(pks), "egh", "gaussian")
   } else{
     fit <- "raw"
   }
-  plot(new.ts, y, type='l', xlab='', ylab='', xaxt='n', yaxt='n', ...)
+  plot(new.ts, y, type = 'l', xlab = '', ylab = '', xaxt = 'n', yaxt = 'n', ...)
   if (points){
-    points(pks$rt, pks$height, pch=20, cex=cex.points, col='red')
+    points(pks$rt, pks$height, pch = 20, cex=cex.points, col = 'red')
   }
   if (ticks){
-    arrows(pks$start, y[which(new.ts %in% pks$start)]-5,
-           pks$start, y[which(new.ts %in% pks$start)]+5,
-           col="blue", length=0)
-    arrows(pks$end, y[which(new.ts %in% pks$end)]-5,
-           pks$end,y[which(new.ts %in% pks$end)]+5,
-           col="blue", length=0)
+    arrows(pks$start, y[which(new.ts %in% pks$start)] - 5,
+           pks$start, y[which(new.ts %in% pks$start)] + 5,
+           col="blue", length = 0)
+    arrows(pks$end, y[which(new.ts %in% pks$end)] - 5,
+           pks$end,y[which(new.ts %in% pks$end)] + 5,
+           col="blue", length = 0)
   }
   if (numbers){
-    text(pks$rt, y[pks$rt] + y.offset, labels=seq_len(nrow(pks)), cex=cex.font)
+    text(pks$rt, y[pks$rt] + y.offset, labels=seq_len(nrow(pks)), cex = cex.font)
   }
   if (missing(res))
     res <- get_time_resolution(chrom_list)
@@ -87,7 +88,7 @@ plot.peak_list <- function(x, ..., chrom_list, index=1, lambda=NULL,
       else if (fit == "egh"){
         yvals <- egh(x = peak.loc, center = pks$rt[i],
                      width=pks$sd[i]*tfac, height = pks$height[i],
-                     tau=pks$tau[i]*tfac)
+                     tau = pks$tau[i]*tfac)
         if (is.null(color))
           color <- "purple"
       }
@@ -97,7 +98,7 @@ plot.peak_list <- function(x, ..., chrom_list, index=1, lambda=NULL,
           color <- "hotpink"
       }
       draw_trapezoid(peak.loc, yvals, color, a)
-    }, silent=TRUE)
+    }, silent = TRUE)
   }
   if (plot_purity){
     try({
@@ -113,10 +114,10 @@ plot.peak_list <- function(x, ..., chrom_list, index=1, lambda=NULL,
         p <- get_purity_values(chrom_list[[index]], pos)
         # lines(as.numeric(new.ts[idx]), -scales::rescale(p, c(0,20)), col = "darkgray", lty=3, lwd=1.5)
         lim=-20
-        draw_trapezoid(new.ts[idx], scales::rescale(p, c(0,lim)), color="black", a=0.6)
-        abline(h=lim, lty=3, col="darkgray")
+        draw_trapezoid(new.ts[idx], scales::rescale(p, c(0,lim)), color="black", a = 0.6)
+        abline(h = lim, lty = 3, col = "darkgray")
       })
-    }, silent=TRUE)
+    }, silent = TRUE)
   }
 }
 

README.md

@@ -57,5 +57,5 @@ 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.0).
+Bass, E. (2023). chromatographR: chromatographic data analysis toolset (version 0.5.1).
 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.0",
+  note     = "version 0.5.1",
   url      = "https://ethanbass.github.io/chromatographR/",
   doi      = "10.5281/zenodo.6944334",
   textVersion = paste("Bass, E. (2023).",
-        "chromatographR: chromatographic data analysis toolset (version 0.5.0).",
+        "chromatographR: chromatographic data analysis toolset (version 0.5.1).",
         "http://doi.org/10.5281/zenodo.6944334"
         )
   )

vignettes/chromatographR.Rmd

@@ -16,8 +16,8 @@ vignette: >
 library("knitr", quietly=TRUE)
 library(chromatographR)
 library(parallel)
-opts_chunk$set(prompt = TRUE, highlight = FALSE, comment=NA, 
-               dpi=200, fig.width=5, out.width="600px")
+opts_chunk$set(prompt = TRUE, highlight = FALSE, comment = NA, 
+               dpi = 200, fig.width = 5, out.width = "600px")
 suppressMessages(require(chromatographR, quiet=TRUE))
 ```
 
@@ -66,8 +66,8 @@ lambda='200.00000'
 
 matplot(x=tpoints, y=Sa[[i]][,lambda],
        type='l', ylab='Abs (mAU)', xlab='Time (min)')
-matplot(x=tpoints, y = ptw::baseline.corr(Sa[[i]][,lambda],p=.001,lambda=1e5),
-       type='l', add = T, col='blue', lty = 3)
+matplot(x=tpoints, y = ptw::baseline.corr(Sa[[i]][,lambda],p = .001,lambda = 1e5),
+       type='l', add = TRUE, col='blue', lty = 3)
 ```
 
 ```{r, preprocessing, eval=T}
@@ -88,7 +88,7 @@ In many cases, liquid chromatography can suffer from retention time shifts (e.g.
 The `ptw` option can take a single wavelength or a list of wavelengths provided by the user using the `lambdas` argument. For each chromatogram, `ptw` then produces a "global" warping function across all the wavelengths supplied by the user. The code block below creates warping models for the samples in the provided list of data matrices. The same function is then used to warp each chromatogram according to the corresponding model, by setting the `models` parameter. Depending on the variety of your samples and the severity of the retention time shifts, it may take some experimentation with the warping parameters to get satisfactory results. Sometimes less can actually be more here -- for example, wavelengths with fewer peaks may sometimes yield better warping models. (Also see the documentation for [ptw](https://CRAN.R-project.org/package=ptw) for more guidance on warp function optimization).
 
 ```{r, warp models}
-warping.models <- correct_rt(dat.pr, what = "models", lambdas=c("210"), scale = TRUE)
+warping.models <- correct_rt(dat.pr, what = "models", lambdas = c("210"), scale = TRUE)
 warp <- correct_rt(chrom_list = dat.pr, models = warping.models, what = "corrected.values")
 ```
 
@@ -121,10 +121,10 @@ oldpar <- par(no.readonly = TRUE)
 
 par(mfrow=c(2,1))
 plot_chroms(warp, lambdas = c("210","260"))
-legend("topleft", legend="vpdtw", bty = "n")
+legend("topleft", legend = "vpdtw", bty = "n")
 
 plot_chroms(dat.pr, lambdas = c("210","260"))
-legend("topleft", legend="raw", bty = "n")
+legend("topleft", legend = "raw", bty = "n")
 
 par(oldpar)
 ```
@@ -154,9 +154,9 @@ The `plot.peak_list` function allows you to visually assess the peak integration
 ```{r, plot_peaks, warning=FALSE, fig.height=6}
 oldpar <- par(no.readonly = TRUE)
 par(mfrow=c(3,1))
-plot(pks_gauss, index=1, lambda='210')
-plot(pks_egh, index=1, lambda='210')
-plot(pks_raw, index=1, lambda='210')
+plot(pks_gauss, index = 1, lambda = '210')
+plot(pks_egh, index = 1, lambda = '210')
+plot(pks_raw, index = 1, lambda = '210')
 par(oldpar)
 ```
 
@@ -189,7 +189,7 @@ pk_tab <- normalize_data(peak_table = pk_tab, column="mass")
 The `mirror_plot` function provides a quick way to visually compare results across treatment groups.
 
 ```{r}
-mirror_plot(pk_tab, lambdas = c("210","260"), var = "trt", legend_size=2)
+mirror_plot(pk_tab, lambdas = c("210","260"), var = "trt", legend_size = 2)
 ```
 
 ##### Plotting spectra
@@ -198,9 +198,9 @@ The `plot_spectrum` function allows you to easily plot or record the spectra ass
 
 ```{r, plot spectra, fig.height=6}
 oldpar <- par(no.readonly = TRUE)
-par(mfrow=c(2,1))
-peak="V7"
-plot_spectrum(peak, peak_table = pk_tab, chrom_list=warp, verbose=FALSE)
+par(mfrow = c(2,1))
+peak = "V7"
+plot_spectrum(peak, peak_table = pk_tab, chrom_list = warp, verbose = FALSE)
 par(oldpar)
 ```
 

vignettes/references.bib

@@ -23,7 +23,7 @@ @article{birkett2006
   urldate = {2022-11-12},
   abstract = {The stemborers Chilo partellus and Busseola fusca are major pests of subsistence cereal farming in Africa. Volatiles released by two cultivated hosts, sorghum and maize (Sorghum bicolor and Zea mays), and two wild grass hosts, Pennisetum purpureum and Hyparrhenia tamba, were collected by air entrainment. Electrophysiologically active components in these samples were detected by coupled gas chromatography-electroantennography (GC-EAG), and the active peaks identified by gas chromatography-mass spectrometry. A total of 41 compounds were identified from the four plant species, all of which, as well as two unidentified compounds, elicited an electrophysiological response from one or both of the stemborers. The compounds included a number of green leaf volatiles and other aliphatic aldehydes, ketones, and esters, mono- and sesquiterpenoids, and some aromatic compounds. EAG studies with authentic samples, conducted at two discriminating doses for all compounds, and dose\textendash response curves for 14 of the most highly EAG-active compounds, showed significant differences in relative responses between species. The compounds that elicited large responses in both species of moths included linalool, acetophenone, and 4-allylanisole, while a number of compounds such as the aliphatic aldehydes octanal, nonanal, and decanal elicited a large response in B. fusca, but a significantly smaller response in C. partellus. Furthermore, the wild hosts produced higher levels of physiologically active compounds compared with either of the cultivated hosts. These differences are discussed in relation to the differential attraction/oviposition of the two stemborers observed in the field and, particularly for eastern African small-scale farming systems, in the context of using a push\textendash pull strategy for their control.},
   langid = {english},
-  keywords = {Electrophysiology,GC-MS,Host location,Maize,Push–pull,Sorghum,Stemborer,Volatiles},
+  keywords = {Electrophysiology,GC-MS,Host location,Maize,Push\textendash pull,Sorghum,Stemborer,Volatiles},
   file = {/Users/ethanbass/Zotero/storage/VVDS3TTN/Birkett et al. - 2006 - Electrophysiological Responses of the Lepidopterou.pdf}
 }