Refactored conform_spec()

In addition:

- I started to work on the `c_spec()` function to concatenate multiple spectra into one OpenSpecy object
- this will be the starting point to improve the current `combine_OpenSpecy()` function further.

Just wanted to push this before I forget.

NAMESPACE

@@ -6,6 +6,9 @@ S3method(as_OpenSpecy,OpenSpecy)
 S3method(as_OpenSpecy,data.frame)
 S3method(as_OpenSpecy,default)
 S3method(as_OpenSpecy,list)
+S3method(conform_spec,OpenSpecy)
+S3method(conform_spec,default)
+S3method(conform_spec,list)
 S3method(flatten_range,default)
 S3method(head,OpenSpecy)
 S3method(match_spec,data.frame)
@@ -29,12 +32,8 @@ export(adj_res)
 export(as_OpenSpecy)
 export(c_spec)
 export(check_lib)
-export(combine_OpenSpecy)
 export(conform_res)
 export(conform_spec)
-export(conform_spec.OpenSpecy)
-export(conform_spec.default)
-export(conform_spectra)
 export(find_spec)
 export(flatten_range)
 export(gen_grid)

R/conform_spec.R

@@ -1,32 +1,15 @@
 #' @rdname conform_spec
 #'
-#' @title Adjust spectral intensities to absorbance units
+#' @title Conform spectra
 #'
 #' @description
-#' Converts reflectance or transmittance intensity units to absorbance units.
+#'
 #'
 #' @details
-#' Many of the Open Specy functions will assume that the spectrum is in
-#' absorbance units. For example, see \code{\link{match_spec}()} and
-#' \code{\link{subtr_bg}()}.
-#' 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)}
-#' 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
-#' is a percent from 1-100 and first correct the intensity by dividing by 100
-#' so that it fits the form expected by the equation.
+#' Many of
 #'
-#' @param object a list object of class \code{OpenSpecy}.
-#' @param type a character string specifying whether the input spectrum is
-#' in absorbance units (\code{"none"}, default) or needs additional conversion
-#' from \code{"reflectance"} or \code{"transmittance"} data.
-#' @param make_rel logical; if \code{TRUE} spectra are automatically normalized
-#' with \code{\link{make_rel}()}.
-#' @param \ldots further arguments passed to submethods; this is
-#' to \code{\link{adj_neg}()} for \code{adj_intens()} and
-#' to \code{\link{conform_res}()} for \code{conform_intens()}.
+#' @param x a list object of class \code{OpenSpecy}.
+#' @param res spectral resolution adjusted to.
 #'
 #' @return
 #' \code{adj_intens()} returns a data frame containing two columns
@@ -48,33 +31,33 @@
 #' @importFrom magrittr %>%
 #' @importFrom data.table .SD
 #' @export
-conform_spec <- function(object, ...) {
+conform_spec <- function(x, res = 5) {
   UseMethod("conform_spec")
 }
 
 #' @rdname conform_spec
 #'
 #' @export
-conform_spec.default <- function(object, ...) {
+conform_spec.default <- function(x, res = 5) {
   stop("object 'x' needs to be of class 'OpenSpecy'", call. = F)
 }
 
 #' @rdname conform_spec
 #'
 #' @export
-conform_spec.OpenSpecy <- function(object, type = "none", make_rel = TRUE, ...) {
-  wn <- conform_res(object$wavenumber, ...)
+conform_spec.OpenSpecy <- function(x, res = 5) {
+  wn <- conform_res(x$wavenumber, res = res)
 
-  spec <- object$spectra[, lapply(.SD, .clean_spec,
-                                  x = object$wavenumber,
-                                  xout = wn)]
+  spec <- x$spectra[, lapply(.SD, .conform_intens,
+                             x = x$wavenumber,
+                             xout = wn)]
 
-  object$wavenumber <- wn
-  object$spectra <- spec
+  x$wavenumber <- wn
+  x$spectra <- spec
 
-  adj_intens(object, type = type, make_rel = make_rel, na.rm = T)
+  return(x)
 }
 
-.clean_spec <- function(...) {
+.conform_intens <- function(...) {
   approx(...)$y
 }

R/manage_spec.R

@@ -34,36 +34,13 @@
 #' @importFrom data.table data.table as.data.table fread
 #' @export
 
-#' @rdname data_norm
-#'
-#' @export
-conform_spec <- function(spec, x, xout){
-  c(
-    approx(x = x, y = spec, xout = xout)$y
-  )
-}
-
-#' @rdname data_norm
-#'
-#' @export
-conform_spectra <- function(data, xout, coords = NULL){
-  if(is_OpenSpecy(data)){
-    as_OpenSpecy(
-      x = xout,
-      spectra = data$spectra[,lapply(.SD, function(x){
-        conform_spec(x = data$wavenumber, spec = x, xout = xout)})],
-      metadata = data$metadata,
-      coords = coords
-    )
-  }
-}
 
 #' @rdname data_norm
 #'
 #' @export
-combine_OpenSpecy <- function(files, wavenumbers = NULL, res = NULL, coords = NULL){
+c_spec <- function(..., wavenumbers = NULL, res = NULL, coords = NULL){
 
-  if(!is.list(files)){
+  if(!is.list(files)) {
     lof <- lapply(files, read_spec, coords = NULL)
   }
   else{
@@ -122,16 +99,43 @@ combine_OpenSpecy <- function(files, wavenumbers = NULL, res = NULL, coords = NU
 #'
 #' @importFrom data.table rbindlist
 #' @export
+# c_spec <- function(...) {
+#     cin <- c(...)
+#
+#     lst <- tapply(cin, names(cin), FUN = function(x) unname((x)))
+#
+#     as_OpenSpecy(
+#         x = lst$wavenumber[[1]],
+#         # TODO: Probably should add a check to make sure all the wavenumbers are
+#         # aligned before doing this.
+#         spectra = as.data.table(lst$spectra),
+#         metadata = rbindlist(lst$metadata, fill = T)
+#     )
+# }
+
 c_spec <- function(...) {
-    cin <- c(...)
+  UseMethod("conform_spec")
+}
+
+#' @rdname conform_spec
+#'
+#' @export
+conform_spec.default <- function(...) {
+  stop("'...' items need to be of class 'OpenSpecy'", call. = F)
+}
+
+#' @rdname conform_spec
+#'
+#' @export
+conform_spec.list <- function(...) {
+
+}
 
-    lst <- tapply(cin, names(cin), FUN = function(x) unname((x)))
+#' @rdname conform_spec
+#'
+#' @export
+conform_spec.OpenSpecy <- function(...) {
+  lst <- list(...)
 
-    as_OpenSpecy(
-        x = lst$wavenumber[[1]],
-        # TODO: Probably should add a check to make sure all the wavenumbers are
-        # aligned before doing this.
-        spectra = as.data.table(lst$spectra),
-        metadata = rbindlist(lst$metadata, fill = T)
-    )
+  do.call
 }