docs: minor changes

.Rbuildignore

@@ -9,3 +9,5 @@
 ^LICENSE$
 ^\.DS_Store$
 ^\.zenodo.json
+^vignettes/articles$
+^\.httr-oauth$

.gitignore

@@ -7,4 +7,5 @@
 doc/chromatographR_vignette.html
 doc/chromatographR_vignette.R
 inst/doc
-chromatographR.Rcheck
+chromatographR.Rcheck
+.httr-oauth

DESCRIPTION

@@ -68,4 +68,4 @@ Encoding: UTF-8
 Language: en-US
 LazyData: true
 LazyDataCompression: xz
-RoxygenNote: 7.3.0
+RoxygenNote: 7.3.2

R/correct_peaks.R

@@ -1,5 +1,4 @@
-
-#' Correct peak positions according to a ptw warping model
+#' Correct peak positions according to a PTW warping model
 #' 
 #' Corrects retention time differences using parametric time warping as 
 #' implemented in \code{\link[ptw]{ptw}}.
@@ -13,8 +12,7 @@
 #' containing a nested list of peak tables where the first level is the sample,
 #' and the second level is the spectral wavelength. Every component is described
 #' by a matrix where every row is one peak, and the columns contain information on
-#' retention time, peak width (FWHM), peak width, height, and
-#' area.
+#' retention time, peak width (FWHM), peak width, height, and area.
 #' @param mod_list A list of ptw models.
 #' @param chrom_list List of chromatograms supplied to create ptw models.
 #' @param match_names Logical. Whether to actively match the names of the 
@@ -121,6 +119,7 @@ plot.ptw_list <- function(x, lambdas, legend = TRUE, ...){
   }
 }
 
+#' Predict PTW
 #' @note This is the function from the ptw package, reproduced here because it
 #' isn't exported from ptw.
 #' @noRd

R/filter_peaks.R

@@ -1,7 +1,7 @@
 #' Filter peak lists
 #' 
-#' Utility function to remove peaks from a peak list, e.g. because their
-#' intensity is too low. Currently one can filter on peak height, peak area,
+#' Utility function to remove peaks from a peak list (e.g., because their
+#' intensity is too low). Currently one can filter on peak height, peak area,
 #' standard deviation, and/or retention time.
 #' 
 #' @param peak_list A peak_list object, consisting of a nested list of peak
@@ -73,7 +73,7 @@ filter_peaks <- function(peak_list, min_height, min_area,
 
 #' Filter peak table
 #' 
-#' Utility function to remove peaks from peak table, e.g. because their
+#' Utility function to remove peaks from peak table, e.g., because their
 #' intensity is too low. Currently one can filter on mean or median peak intensity,
 #' or retention time.
 #' 

R/fit_gaussian.R

@@ -0,0 +1,45 @@
+fit_gaussian <- function(x, y, start.center = NULL,
+                         start.width = NULL, start.height = NULL,
+                         start.floor = NULL, fit.floor = FALSE,
+                         max.iter = 1000){
+  # estimate starting values
+  who.max <- which.max(y)
+  if (is.null(start.center)) start.center <- x[who.max]
+  if (is.null(start.height)) start.height <- y[who.max]
+  if (is.null(start.width)) start.width <- sum( y > (start.height/2)) / 2
+
+  # call the Nonlinear Least Squares, either fitting the floor too or not
+  controlList <- nls.control(maxiter = max.iter, minFactor = 1/512,
+                             warnOnly = TRUE)
+  starts <- list( "center" = start.center, "width" = start.width,
+                  "height" = start.height)
+  if (!fit.floor) {
+    nlsAns <- try(nlsLM( y ~ gaussian(x = x, center = center,
+                                      width = width, height = height),
+                         start = starts, control = controlList), silent = TRUE)
+  } else{
+    if (is.null(start.floor)) start.floor <- quantile(y, seq(0, 1, 0.1))[2]
+    starts <- c(starts, "floor" = start.floor)
+    nlsAns <- try(nlsLM( y ~ gaussian(x, center, width, height, floor),
+                         start = starts, control = controlList), silent = TRUE)
+  }
+
+  # package up the results to pass back
+
+  if (inherits(nlsAns, "try-error")){
+    yAns <- gaussian(x, start.center, start.width, start.height, start.floor)
+    out <- list("center" = start.center, "width" = start.width,
+                "height" = start.height,
+                "y" = yAns, "residual" = y - yAns)
+    floorAns <- if (fit.floor) start.floor else 0
+  } else {
+    coefs <-coef(nlsAns)
+    out <- list( "center" = coefs[1], "width" = coefs[2], "height" = coefs[3],
+                 "y" = fitted(nlsAns), "residual" = residuals(nlsAns))
+    floorAns <- if (fit.floor) coefs[4] else 0
+  }
+  if (fit.floor) {
+    out <- c( out, "floor" = floorAns)
+  }
+  return( out)
+}

R/fit_peaks.R

@@ -1,4 +1,4 @@
-#' Find peaks in chromatographic profile
+#' Find peaks
 #' 
 #' Find peaks in chromatographic profile.
 #' 
@@ -43,7 +43,7 @@
 #' exclude small peaks from the peak list. (Defaults to \code{0}).
 #' @param bounds Logical. If TRUE, includes peak boundaries in data.frame.
 #' (Defaults to \code{TRUE}).
-#' @return If bounds == \code{TRUE}, returns a data.frame containing the center,
+#' @return If \code{bounds == TRUE}, returns a data.frame containing the center,
 #' start, and end of each identified peak. Otherwise, returns a numeric vector
 #' of peak centers. All locations are expressed as indices.
 #' @note The \code{find_peaks} function is adapted from MATLAB code included in
@@ -362,6 +362,7 @@ fit_egh <- function(x1, y1, start.center = NULL, start.width = NULL,
   return(out)
 }
 
+#' Fit peak (gaussian)
 #' @noRd
 fitpk_gaussian <- function(x, pos, lambda, max.iter,
                            estimate_purity = TRUE, noise_threshold = .001, ...){
@@ -383,6 +384,7 @@ fitpk_gaussian <- function(x, pos, lambda, max.iter,
     "height" = y[xloc], "area" = area, "r.squared" = r.squared, purity = purity)
 }
 
+#' Fit peak (exponential-gaussian hybrid)
 #' @noRd
 fitpk_egh <- function(x, pos, lambda, max.iter,
                       estimate_purity = TRUE, noise_threshold = .001){
@@ -402,12 +404,14 @@ fitpk_egh <- function(x, pos, lambda, max.iter,
     "height" = y[xloc], "area" = area, "r.squared" = r.squared, purity = purity)
 }
 
+#' Fit peak (raw)
 #' @noRd
 fitpk_raw <- function(x, pos, lambda, max.iter,
                       estimate_purity = TRUE, noise_threshold = .001){
   y <- x[,lambda]
   xloc <- pos[1]
   peak.loc <- seq.int(pos[2], pos[3])
+
   # perform trapezoidal integration on raw signal
   area <- sum(diff(peak.loc) * mean(c(y[peak.loc][-1], tail(y[peak.loc],-1))))
   purity <- get_purity(x = x, pos = pos, try = estimate_purity,
@@ -418,7 +422,7 @@ fitpk_raw <- function(x, pos, lambda, max.iter,
 }
 
 
-#' Savitsky Golay Smoothing from pracma
+#' Savitsky Golay Smoothing ported from pracma
 #' @author Hans W. Borchers
 #' @param T Vector of signals to be filtered
 #' @param fl Filter length (for instance fl = 51..151), has to be odd.
@@ -440,14 +444,14 @@ savgol <- function(T, fl, forder = 4, dorder = 0) {
   Y <- pinv(X);                           # pseudoinverse
 
   # -- filter via convolution and take care of the end points --
-  T2 <- convolve(T, rev(Y[(dorder+1),]), type = "o")   # convolve(...)
+  T2 <- convolve(T, rev(Y[(dorder + 1),]), type = "o")   # convolve(...)
   T2 <- T2[(fc+1):(length(T2)-fc)]
 
   Tsg <- (-1)^dorder * T2
   return( Tsg )
 }
 
-#' pinv port from pracma
+#' 'pinv' port from pracma
 #' @author Hans W. Borchers
 #' @note This function is ported from \href{https://cran.r-project.org/web/packages/pracma/index.html}{pracma},
 #' where it is licensed under GPL (>= 3).
@@ -456,10 +460,7 @@ pinv <- function (A, tol = .Machine$double.eps^(2/3)) {
   stopifnot(is.numeric(A) || is.complex(A), is.matrix(A))
 
   s <- svd(A)
-  # D <- diag(s$d); Dinv <- diag(1/s$d)
-  # U <- s$u; V <- s$v
-  # A = U D V'
-  # X = V Dinv U'
+
   if (is.complex(A)) s$u <- Conj(s$u)
 
   p <- ( s$d > max(tol * s$d[1], 0) )

R/get_peaktable.R

@@ -1,6 +1,6 @@
 #' Convert peak list into an ordered peak table.
 #' 
-#' Returns a peak_table object. The first slot contains a matrix of
+#' Returns a \code{peak_table} object. The first slot contains a matrix of
 #' intensities, where rows correspond to samples and columns correspond to
 #' aligned features. The rest of the slots contain various meta-data about peaks,
 #' samples, and experimental settings. 
@@ -30,8 +30,8 @@
 #' @param peak_list A `peak_list` object created by \code{\link{get_peaks}},
 #' containing a nested list of peak tables: the first level is the
 #' sample, and the second level is the spectral wavelength. Every component is
-#' described by a data.frame where every row is one peak, and the columns contain
-#' information on various peak parameters.
+#' described by a \code{data.frame} with a row for each peak and columns
+#' containing information on various peak parameters.
 #' @param chrom_list A list of chromatographic matrices.
 #' @param response Indicates whether peak area or peak height is to be used
 #' as intensity measure. Defaults to `area` setting.
@@ -40,10 +40,10 @@
 #' otherwise specified, the \code{rt.cor} column will be used by default if it 
 #' exists in the provided \code{peak_list}.
 #' @param hmax Height at which the complete linkage dendrogram will be cut. Can
-#' be interpreted as the maximal inter-cluster retention time difference.
-#' @param plot_it Logical. If TRUE, for every component a stripplot will be
+#' be interpreted as the maximal intercluster retention time difference.
+#' @param plot_it Logical. If \code{TRUE}, for every component a strip plot will be
 #' shown indicating the clustering.
-#' @param ask Logical. Ask before showing new plot? Defaults to TRUE.
+#' @param ask Logical. Ask before showing new plot? Defaults to \code{TRUE}.
 #' @param clust Specify whether to perform hierarchical clustering based on
 #' spectral similarity and retention time (\code{sp.rt}) or retention time alone
 #' (\code{rt}). Defaults to \code{rt}. The \code{sp.rt} option is experimental
@@ -64,12 +64,12 @@
 #' following elements:
 #' * `tab`: the peak table itself -- a data-frame of intensities in a
 #' sample x peak configuration.
-#' * `pk_meta`: A data.frame containing peak meta-data (e.g. the spectral component,
+#' * `pk_meta`: A data.frame containing peak meta-data (e.g., the spectral component,
 #' peak number, and average retention time).
 #' * `sample_meta`: A data.frame of sample meta-data. Must be added using
-#' \code{\link{attach_metadata}}).
+#' \code{\link{attach_metadata}}.
 #' * `ref_spectra`: A data.frame of reference spectra (in a wavelength x peak
-#' configuration). Must be added using \code{\link{attach_ref_spectra}}
+#' configuration). Must be added using \code{\link{attach_ref_spectra}}.
 #' * `args`: A vector of arguments given to \code{\link{get_peaktable}} to generate
 #' the peak table.
 #' @author Ethan Bass

R/plot.peak_table.R

@@ -48,10 +48,10 @@
 #' absorbance (or normalized absorbance, if \code{scale_spectrum} is TRUE) for 
 #' the specified sample(s). Otherwise, there is no return value.
 #' @section Side effects:
-#' If \code{plot_trace} is TRUE, plots the chromatographic trace of the specified
-#' chromatogram (\code{chr}), at the specified wavelength (\code{lambda}) with a
-#' dotted red line to indicate the retention time given by \code{loc}. The
-#' trace is a single column from the chromatographic matrix.
+#' If \code{plot_trace} is \code{TRUE}, plots the chromatographic trace of the 
+#' specified chromatogram (\code{idx}), at the specified wavelength 
+#' (\code{lambda}) with a dotted red line to indicate the retention time given 
+#' by \code{loc}. The trace is a single column from the chromatographic matrix.
 #'
 #' If \code{plot_spectrum} is TRUE, plots the spectrum for the specified chromatogram
 #' at the specified retention time. The spectrum is a single row from the chromatographic

R/plot_spectrum.R

@@ -5,7 +5,7 @@
 #' 
 #' Can be used to confirm the identity of a peak or check that a particular
 #' column in the peak table represents a single compound. Retention times can
-#' also be selected by clicking on the plotted trace if what == 'click'.
+#' also be selected by clicking on the plotted trace if \code{what == 'click'}.
 #' 
 #' @importFrom scales rescale
 #' @importFrom graphics identify title text
@@ -22,23 +22,24 @@
 #' @param lambda The wavelength you wish to plot the trace at if plot_trace ==
 #' TRUE and/or the wavelength to be used for the determination of signal
 #' abundance.
-#' @param plot_spectrum Logical. If TRUE, plots the spectrum of the chosen
-#' peak. Defaults to TRUE.
-#' @param plot_trace Logical. If TRUE, plots the trace of the chosen peak at
-#' lambda. Defaults to TRUE.
-#' @param spectrum_labels Logical. If TRUE, plots labels on maxima in spectral
-#' plot. Defaults to TRUE.
-#' @param scale_spectrum Logical. If TRUE, scales spectrum to unit height.
-#' Defaults to FALSE.
-#' @param export_spectrum Logical. If TRUE, exports spectrum to console.
-#' Defaults to FALSE.
-#' @param verbose Logical. If TRUE, prints verbose output to console. Defaults
-#' to TRUE.
+#' @param plot_spectrum Logical. If \code{TRUE}, plots the spectrum of the chosen
+#' peak. Defaults to \code{TRUE}.
+#' @param plot_trace Logical. If \code{TRUE}, plots the trace of the chosen peak at
+#' lambda. Defaults to \code{TRUE}.
+#' @param spectrum_labels Logical. If \code{TRUE}, plots labels on maxima in spectral
+#' plot. Defaults to \code{TRUE}.
+#' @param scale_spectrum Logical. If \code{TRUE}, scales spectrum to unit height.
+#' Defaults to \code{FALSE}.
+#' @param export_spectrum Logical. If \code{TRUE}, exports spectrum to console.
+#' Defaults to \code{FALSE}.
+#' @param verbose Logical. If \code{TRUE}, prints verbose output to console.
+#' Defaults to \code{TRUE}.
 #' @param what What to look for. Either \code{peak} to extract spectral 
 #' information for a certain peak, \code{rt} to scan by retention time, 
 #' \code{idx} to scan by numeric index, or \code{click} to manually select 
 #' retention time by clicking on the chromatogram. Defaults to "peak" mode.
-#' @param engine Which plotting engine to use: \code{base}, \code{ggplot2}, or \code{plotly}.
+#' @param engine Which plotting engine to use: \code{base}, \code{ggplot2}, or
+#' \code{plotly}.
 #' @param ... Additional arguments.
 #' @return If \code{export_spectrum} is TRUE, returns the spectrum as a \code{
 #' data.frame} with wavelengths as rows and a single column encoding the
@@ -48,21 +49,21 @@
 #' object containing the specified plots. Otherwise, if \code{engine == "base"},
 #' there is no return value.
 #' @section Side effects:
-#' * If \code{plot_trace} is TRUE, plots the chromatographic trace of the specified
-#' chromatogram (\code{chr}), at the specified wavelength (\code{lambda}) with a
-#' dotted red line to indicate the retention time given by \code{loc}. The
-#' trace is a single column from the chromatographic matrix.
-#' * If \code{plot_spectrum} is TRUE, plots the spectrum for the specified
+#' * If \code{plot_trace} is \code{TRUE}, plots the chromatographic trace of the
+#' specified chromatogram (\code{idx}), at the specified wavelength 
+#' (\code{lambda}) with a dotted red line to indicate the retention time given 
+#' by \code{loc}. The trace is a single column from the chromatographic matrix.
+#' * If \code{plot_spectrum} is \code{TRUE}, plots the spectrum for the specified
 #' chromatogram at the specified retention time. The spectrum is a single row
 #' from the chromatographic matrix.
 #' @author Ethan Bass
 #' @examplesIf interactive()
 #' data(Sa)
-#' pks <- get_peaks(Sa, lambda="220.00000")
+#' pks <- get_peaks(Sa, lambda = "220.00000")
 #' pk_tab <- get_peaktable(pks)
 #' oldpar <- par(no.readonly = TRUE)
-#' par(mfrow=c(2,1))
-#' plot_spectrum(loc = "V10", peak_table = pk_tab, what="peak")
+#' par(mfrow = c(2, 1))
+#' plot_spectrum(loc = "V10", peak_table = pk_tab, what = "peak")
 #' par(oldpar)
 #' @export plot_spectrum
 #' @md
@@ -314,20 +315,22 @@ plot_spectrum_base <- function(loc, peak_table, chrom_list,
 #' absorbance (or normalized absorbance, if \code{scale_spectrum} is TRUE)
 #' at each wavelength. Otherwise, there is no return value.
 #' @section Side effects:
-#' Plots a chromatographic trace from the specified chromatogram (\code{chr}),
+#' Plots a chromatographic trace from the specified chromatogram (\code{idx}),
 #' at the specified wavelength (\code{lambda}) with a dotted red line to indicate
 #' the user-selected retention time. The trace is a single column from the
 #' chromatographic matrix.
 #' 
 #' If \code{plot_spectrum} is TRUE, plots the spectrum for the specified
 #' chromatogram at the user-specified retention time. The spectrum is a single
-#" row from the chromatographic matrix.
-#' @md
+#' row from the chromatographic matrix.
+#' 
 #' @author Ethan Bass
 #' @examplesIf interactive()
 #' data(Sa_pr)
 #' scan_chrom(Sa_pr, lambda = "210", idx = 2, export_spectrum = TRUE)
 #' @export scan_chrom
+#' @md
+
 
 scan_chrom <- function(chrom_list, idx, lambda,
                         plot_spectrum = TRUE, peak_table=NULL,
@@ -408,7 +411,7 @@ scan_chrom <- function(chrom_list, idx, lambda,
 #' return value.
 #' @section Side effects:
 #' If \code{plot_spectrum} is TRUE, plots the spectra for the specified chromatogram
-#' (\code{chr}) of the given \code{peak}. The spectrum is a single row
+#' (\code{idx}) of the given \code{peak}. The spectrum is a single row
 #' from the chromatographic matrix.
 #' @author Ethan Bass
 #' @seealso \code{\link{plot_spectrum}}

R/reshape_chroms.R

@@ -35,6 +35,7 @@ reshape_chroms <- function(x, idx, sample_var = "sample",
 #' @return A chromatographic matrix in long format.
 #' @author Ethan Bass
 #' @noRd
+
 reshape_chrom <- function(x, lambdas = NULL, rts = NULL){
   if (ncol(x) == 1)
     stop("The provided data is already in long format!")
@@ -71,8 +72,8 @@ reshape_chrom <- function(x, lambdas = NULL, rts = NULL){
 #' @param metadata A character vector specifying the metadata fields to include.
 #' @param fixed_levels Logical. Whether to fix factor levels of features in the
 #' order provided. Defaults to \code{TRUE}.
-#' @return A data.frame containing the information for the specified peaks in
-#' long format.
+#' @return A data.frame containing the information for the specified 
+#' \code{peaks} in long format.
 #' @author Ethan Bass
 #' @export
 
@@ -108,8 +109,3 @@ reshape_peaktable <- function(x, peaks, metadata, fixed_levels = TRUE){
   }
   xx
 }
-
-# reshape <- function(x,...){
-#   UseMethod("reshape")
-# }
-