Preparing CRAN submission (#135)

* separating app and package vignettes.
* update sig_noise and other docs
* change transmittance to natural log, log10 is too agressive.
* default smoothing set to optimal.
* add and update tests
* allow `make_rel()` to accept OpenSpecy objects
* bug discoved, `smooth_intens()` can't handle NA's
* force conform wavenumbers to stay inbounds
* better names for plot. def_features when 1 pixel features present. more sop.
* add funders, docs, update functions for consistency.
* remove unused images
* discovered that := can override the original data if we aren't careful.
* Add methods to convert OpenSpecy objects to tables
* Add ordering to `match_spec()`
* Prep for CRAN submission
* Submission 🥳

---------

Co-authored-by: Zacharias Steinmetz <git@zsteinmetz.de>

.Rbuildignore

@@ -8,9 +8,11 @@
 ^Meta$
 ^cran-comments\.md$
 ^CRAN-RELEASE$
+^CRAN-SUBMISSION$
 ^_pkgdown\.yml$
 ^docs$
 ^pkgdown$
 ^codecov\.yml$
-^vignettes/spectragryph.*
 ^vignettes/advanced.*
+^vignettes/app.*
+^vignettes/spectragryph.*

CRAN-SUBMISSION

@@ -0,0 +1,3 @@
+Version: 1.0.0
+Date: 2023-09-01 14:53:15 UTC
+SHA: 1924ab057e7bd36723eccdd4649204fef0b2366c

DESCRIPTION

@@ -2,7 +2,7 @@ Package: OpenSpecy
 Type: Package
 Title: Analyze, Process, Identify, and Share Raman and (FT)IR Spectra
 Version: 1.0.0
-Date: 2023-08-29
+Date: 2023-09-01
 Authors@R: c(person("Win", "Cowger", role = c("cre", "aut", "dtc"),
       email = "wincowger@gmail.com",
       comment = c(ORCID = "0000-0001-9226-3104")),
@@ -31,13 +31,16 @@ Authors@R: c(person("Win", "Cowger", role = c("cre", "aut", "dtc"),
     person("Mary C", "Norris", role = c("ctb")),
     person("Christine M", "Knauss", role = c("ctb"), 
       comment = c(ORCID = "0000-0003-4404-8922")), 
-    person("Aleksandra","Karapetrova", role = c("ctb", "dtc", "rev"),
+    person("Aleksandra", "Karapetrova", role = c("ctb", "dtc", "rev"),
       comment = c(ORCID = "0000-0002-9856-1644")),
-    person("Vesna","Teofilovic", role = c("ctb"),
+    person("Vesna", "Teofilovic", role = c("ctb"),
       comment = c(ORCID = "0000-0002-3557-1482")),
-    person("Laura A. T.","Markley", role = c("ctb"),
+    person("Laura A. T.", "Markley", role = c("ctb"),
       comment = c(ORCID = "0000-0003-0620-8366")),
-    person("Shreyas","Patankar", role = c("ctb", "dtc")))
+    person("Shreyas", "Patankar", role = c("ctb", "dtc")),
+    person("Katherine", "Lasdin", role = c("ctb")),
+    person("National Renewable Energy Laboratory", role = c("fnd")), 
+    person("Possibility Lab", role = c("fnd")))
 Description: Raman and (FT)IR spectral analysis tool for plastic particles and
     other environmental samples (Cowger et al. 2021,
     <doi:10.1021/acs.analchem.1c00123>). With read_any(), Open Specy provides a

NAMESPACE

@@ -4,6 +4,8 @@ S3method(adj_intens,OpenSpecy)
 S3method(adj_intens,default)
 S3method(ai_classify,OpenSpecy)
 S3method(ai_classify,default)
+S3method(as.data.frame,OpenSpecy)
+S3method(as.data.table,OpenSpecy)
 S3method(as_OpenSpecy,OpenSpecy)
 S3method(as_OpenSpecy,data.frame)
 S3method(as_OpenSpecy,default)
@@ -32,6 +34,8 @@ S3method(heatmap_spec,default)
 S3method(interactive_plot,OpenSpecy)
 S3method(interactive_plot,default)
 S3method(lines,OpenSpecy)
+S3method(make_rel,OpenSpecy)
+S3method(make_rel,default)
 S3method(match_spec,OpenSpecy)
 S3method(match_spec,default)
 S3method(plot,OpenSpecy)

NEWS.md

@@ -6,7 +6,8 @@
 - The Shiny app has been outsourced to an own GitHub repository:
   https://github.com/wincowgerDEV/OpenSpecy-shiny
 - Spectra are now stored in dedicated `OpenSpecy` objects, which can be managed
-  with a set of new functions including `c_spec()` for concatenating spectra
+  with a set of new functions including `c_spec()` for concatenating spectra or
+  converting them back to tables
 - Various functions have been renamed and improved, for instance, to facilitate
   reading (and writing) spectral files
 - New functions include `def_features()` to identify microplastics in spectral

R/adj_intens.R

@@ -9,7 +9,7 @@
 #' absorbance units. For example, see \code{\link{subtr_baseline}()}.
 #' To run those functions properly, you will need to first convert any spectra
 #' from transmittance or reflectance to absorbance using this function.
-#' The transmittance adjustment uses the \eqn{log10(1 / T)}
+#' The transmittance adjustment uses the \eqn{log(1 / T)}
 #' calculation which does not correct for system and particle characteristics.
 #' The reflectance adjustment uses the Kubelka-Munk equation
 #' \eqn{(1 - R)^2 / 2R}. We assume that the reflectance intensity
@@ -62,7 +62,7 @@ adj_intens.OpenSpecy <- function(x, type = "none", make_rel = TRUE, ...) {
 
   adj <- switch(type,
                 "reflectance" = (1 - spec/100)^2 / (2 * spec/100),
-                "transmittance" = log10(1/adj_neg(spec, ...)),
+                "transmittance" = log(1/adj_neg(spec, ...)),
                 "none" = adj_neg(spec, ...)
   )
 

R/as_OpenSpecy.R

@@ -318,7 +318,6 @@ check_OpenSpecy <- function(x) {
     stop("object 'x' is not of class 'OpenSpecy'", call. = F)
   if(!identical(names(x), c("wavenumber", "spectra", "metadata")))
     stop("names of the object components are incorrect", call. = F)
-
   if(!(cw <- is.vector(x$wavenumber)))
     warning("Wavenumber is not a vector", call. = F)
   if(!(cs <- is.data.table(x$spectra)))

R/conform_spec.R

@@ -60,7 +60,7 @@ conform_spec.OpenSpecy <- function(x, range = NULL, res = 5, type = "interp",
 
     wn <- conform_res(range, res = res)
   } else {
-    wn <- range
+    wn <- range[range >= min(x$wavenumber) & range <= max(x$wavenumber)]
   }
 
   if(type == "interp")
@@ -70,7 +70,8 @@ conform_spec.OpenSpecy <- function(x, range = NULL, res = 5, type = "interp",
   if(type == "roll") {
     join <- data.table("wavenumber" = wn)
     # Rolling join option
-    spec <- x$spectra[,"wavenumber" := x$wavenumber]
+    spec <- x$spectra
+    spec$wavenumber <- x$wavenumber
     spec <- spec[join, roll = "nearest", on = "wavenumber"]
     spec <- spec[,-"wavenumber"]
   }

R/data_norm.R

@@ -75,15 +75,6 @@ adj_neg <- function(y, na.rm = FALSE) {
   }
 }
 
-#' @rdname data_norm
-#'
-#' @export
-make_rel <- function(y, na.rm = FALSE) {
-  r <- range(y, na.rm = na.rm)
-
-  (y - r[1]) / (r[2] - r[1])
-}
-
 #' @rdname data_norm
 #' @importFrom data.table fifelse
 #'

R/def_features.R

@@ -154,6 +154,13 @@ def_features.OpenSpecy <- function(x, features, ...) {
   features_dt <- rbindlist(lapply(seq_along(convex_hulls), function(i) {
     hull <- convex_hulls[[i]]
     id <- names(convex_hulls)[i]
+    if(nrow(hull) == 1)
+      return(data.table(feature_id = id,
+                        area = 1,
+                        perimeter = 4,
+                        feret_min = 1,
+                        feret_max = 1)
+      )
 
     # Calculate Feret dimensions
     dist_matrix <- as.matrix(dist(hull))

R/gen_OpenSpecy.R

@@ -2,7 +2,7 @@
 #' @rdname gen_OpenSpecy
 #'
 #' @description
-#' Methods to visualize \code{OpenSpecy} objects.
+#' Methods to visualize and convert \code{OpenSpecy} objects.
 #'
 #' @details
 #' \code{head()} shows the first few lines of an \code{OpenSpecy} object.
@@ -19,6 +19,8 @@
 #' \code{head()}, \code{print()}, and \code{summary()} return a textual
 #' representation of an \code{OpenSpecy} object.
 #' \code{plot()} and \code{lines()} return a plot.
+#' \code{as.data.frame()} and \code{as.data.table()} convert \code{OpenSpecy}
+#' objects into tabular data.
 #'
 #' @examples
 #' data("raman_hdpe")
@@ -38,7 +40,9 @@
 #' @seealso
 #' \code{\link[utils]{head}()}, \code{\link[base]{print}()},
 #' \code{\link[base]{summary}()}, \code{\link[graphics]{matplot}()}, and
-#' \code{\link[graphics]{matlines}()}
+#' \code{\link[graphics]{matlines}()},
+#' \code{\link[base]{as.data.frame}()},
+#' \code{\link[data.table]{as.data.table}()}
 #'
 #' @importFrom utils head
 #' @importFrom graphics matplot matlines
@@ -93,7 +97,7 @@ summary.OpenSpecy <- function(object, ...) {
 
   cat("\n$spectra\n")
   sl <- length(object$spectra)
-  sr <- range(object$spectra)
+  sr <- range(object$spectra, na.rm = T)
   array(c(sl, sr), c(1,3), list("", c("Number", "Min. Intensity",
                                       "Max. Intensity"))) |>
     print()
@@ -104,3 +108,21 @@ summary.OpenSpecy <- function(object, ...) {
   t(array(c(xr, yr), c(2,2), list(c("Min.", "Max."), c("x", "y")))) |> print()
   names(object$metadata) |> print()
 }
+
+#' @rdname gen_OpenSpecy
+#'
+#' @method as.data.frame OpenSpecy
+#' @export
+as.data.frame.OpenSpecy <- function(x, ...) {
+  data.frame(wavenumber = x$wavenumber, x$spectra)
+}
+
+#' @rdname gen_OpenSpecy
+#'
+#' @method as.data.table OpenSpecy
+#'
+#' @importFrom data.table data.table
+#' @export
+as.data.table.OpenSpecy <- function(x, ...) {
+  data.table(wavenumber = x$wavenumber, x$spectra)
+}

R/interactive_plots.R

@@ -89,7 +89,7 @@ plotly_spec.OpenSpecy <- function(x, x2 = NULL,
   p <- plot_ly(dt, type = "scatter", mode = "lines", ...) |>
     add_trace(x = ~wavenumber, y = ~make_rel(intensity, na.rm = T),
               color = ~id, line = line,
-              name = "Your Spectra", showlegend = F) |>
+              name = "x1", showlegend = F) |>
     layout(xaxis = list(title = "wavenumber [cm<sup>-1</sup>]",
                         autorange = "reversed"),
            yaxis = list(title = "intensity [-]"),
@@ -100,7 +100,7 @@ plotly_spec.OpenSpecy <- function(x, x2 = NULL,
   # Add dummy trace for Your Spectra
   p <- p |>
     add_trace(x = NULL, y = NULL,
-              line = line, name = "Your Spectra", showlegend = T)
+              line = line, name = "x1", showlegend = T)
 
   if (!is.null(x2)) {
     dt2 <- cbind(wavenumber = x2$wavenumber, x2$spectra) |>
@@ -109,14 +109,14 @@ plotly_spec.OpenSpecy <- function(x, x2 = NULL,
     p <- p |>
       add_trace(data = dt2, x = ~wavenumber, y = ~make_rel(intensity, na.rm = T),
                 color = ~id, type = "scatter", mode = "lines",
-                name = "Library Spectra",
+                name = "x2",
                 line = line2, showlegend = F)
 
     # Add dummy trace for Library Spectra
     p <- p |>
       add_trace(x = NULL, y = NULL,
                 line = line2,
-                name = "Library Spectra", showlegend = T)
+                name = "x2", showlegend = T)
   }
 
   return(p)

R/make_rel.R

@@ -0,0 +1,57 @@
+#' @rdname make_rel
+#' @title Make spectral intensities relative
+#'
+#' @description
+#' \code{make_rel()} converts intensities \code{x} into relative values between
+#' 0 and 1 using the standard normalization equation.
+#' If \code{na.rm} is \code{TRUE}, missing values are removed before the
+#' computation proceeds.
+#'
+#' @details
+#' \code{make_rel()} is used to retain the relative height proportions between
+#' spectra while avoiding the large numbers that can result from some spectral
+#' instruments.
+#'
+#' @param x a numeric vector or an \R OpenSpecy object
+#' @param na.rm logical. Should missing values be removed?
+#' @param \ldots further arguments passed to \code{make_rel()}.
+#'
+#' @return
+#' \code{make_rel()} return numeric vectors (if vector provided) or an
+#' \code{OpenSpecy} object with the normalized intensity data.
+#'
+#' @examples
+#' make_rel(c(-1000, -1, 0, 1, 10))
+#'
+#' @author
+#' Win Cowger, Zacharias Steinmetz
+#'
+#' @seealso
+#' \code{\link[base]{min}()} and \code{\link[base]{round}()};
+#' \code{\link{adj_intens}()} for log transformation functions;
+#' \code{\link{conform_spec}()} for conforming wavenumbers of an
+#' \code{OpenSpecy} object to be matched with a reference library
+#'
+#'
+#' @export
+make_rel <- function(x, ...) {
+  UseMethod("make_rel")
+}
+
+#' @rdname make_rel
+#'
+#' @export
+make_rel.default <- function(x, na.rm = FALSE, ...) {
+  r <- range(x, na.rm = na.rm)
+
+  return((x - r[1]) / (r[2] - r[1]))
+}
+
+#' @rdname make_rel
+#'
+#' @export
+make_rel.OpenSpecy <- function(x, na.rm = FALSE, ...) {
+  x$spectra <- x$spectra[, lapply(.SD, make_rel, na.rm = na.rm, ...)]
+
+  return(x)
+}

R/manage_spec.R

@@ -12,6 +12,8 @@
 #' spectra having all the same wavenumber range.
 #' @param res defaults to \code{NULL}, the resolution you want the output
 #' wavenumbers to be.
+#' @param size the number of spectra to sample. 
+#' @param prob probabilities to use for the sampling.
 #' @param \ldots further arguments passed to submethods.
 #'
 #' @return
@@ -115,14 +117,10 @@ sample_spec.default <- function(x, ...) {
 #' @rdname manage_spec
 #'
 #' @export
-sample_spec.OpenSpecy <- function(x, ...) {
+sample_spec.OpenSpecy <- function(x, size = 1, prob = NULL, ...) {
   # replace = false is mandatory currently because we don't have a way to
   # rename and recoordinate duplicates.
-  cols <- sample(1:ncol(x$spectra), ...)
+  cols <- sample(1:ncol(x$spectra), size = size, replace = FALSE, prob = prob, ...)
 
-  as_OpenSpecy(
-    x = x$wavenumber,
-    spectra = x$spectra[, cols, with = F],
-    metadata = x$metadata[cols, ]
-  )
+  filter_spec(x, cols)
 }

R/match_spec.R

@@ -22,6 +22,8 @@
 #' If \code{NULL} (default), all matches will be returned.
 #' @param cor_matrix a correlation matrix for object and library,
 #' can be returned by \code{cor_spec()}
+#' @param order an \code{OpenSpecy} used for sorting, ideally the unprocessed
+#' one; \code{NULL} skips sorting.
 #' @param add_library_metadata name of a column in the library metadata to be
 #' joined; \code{NULL} if you don't want to join.
 #' @param add_object_metadata name of a column in the object metadata to be
@@ -53,19 +55,23 @@
 #'
 #' @examples
 #' data("test_lib")
+#'
 #' unknown <- read_extdata("ftir_ldpe_soil.asp") |>
 #'   read_any() |>
 #'   conform_spec(range = test_lib$wavenumber,
 #'                res = spec_res(test_lib)) |>
 #'   process_spec()
-#' matches <- cor_spec(unknown, test_lib)
+#' cor_spec(unknown, test_lib)
 #'
 #' test_lib_extract <- filter_spec(test_lib,
 #'   logic = grepl("polycarbonate", test_lib$metadata$polymer_class,
 #'                 ignore.case = TRUE)
 #' )
 #'
-#' matches2 <- cor_spec(unknown, library = test_lib_extract)
+#' cor_spec(unknown, library = test_lib_extract)
+#'
+#' match_spec(unknown, test_lib, add_library_metadata = "sample_name",
+#'            top_n = 1)
 #'
 #' @author
 #' Win Cowger, Zacharias Steinmetz
@@ -136,16 +142,24 @@ match_spec.default <- function(x, ...) {
 #'
 #' @export
 match_spec.OpenSpecy <- function(x, library, na.rm = T, top_n = NULL,
-                                 add_library_metadata = NULL,
+                                 order = NULL, add_library_metadata = NULL,
                                  add_object_metadata = NULL, fill = NULL, ...) {
   if(is_OpenSpecy(library)) {
-    cor_spec(x, library =  library) |>
+    res <- cor_spec(x, library =  library) |>
       ident_spec(x, library = library, top_n = top_n,
                  add_library_metadata = add_library_metadata,
                  add_object_metadata = add_object_metadata)
   } else {
-    ai_classify(x, library, fill)
+    res <- ai_classify(x, library, fill)
+  }
+
+  if(!is.null(order)) {
+    .r <- NULL
+    match <- match(colnames(order$spectra), res$object_id)
+    setorder(res[, .r := order(match)], .r)[, .r := NULL]
   }
+
+  return(res)
 }
 
 #' @rdname match_spec