Rearrange functions in R files

R/adj_intens.R

@@ -1,3 +1,5 @@
+#' @rdname adj_intens
+#'
 #' @title Adjust spectral intensities to absorbance units
 #'
 #' @description
@@ -72,37 +74,3 @@ adj_intens.OpenSpecy <- function(object, type = "none", make_rel = TRUE, ...) {
 
   return(object)
 }
-
-#' @rdname adj_intens
-#'
-#' @export
-conform_spec <- function(object, ...) {
-  UseMethod("conform_spec")
-}
-
-#' @rdname adj_intens
-#'
-#' @export
-conform_spec.default <- function(object, ...) {
-  stop("object 'x' needs to be of class 'OpenSpecy'", call. = F)
-}
-
-#' @rdname adj_intens
-#'
-#' @export
-conform_spec.OpenSpecy <- function(object, type = "none", make_rel = TRUE, ...) {
-  wn <- conform_res(object$wavenumber, ...)
-
-  spec <- object$spectra[, lapply(.SD, .clean_spec,
-                                  x = object$wavenumber,
-                                  xout = wn)]
-
-  object$wavenumber <- wn
-  object$spectra <- spec
-
-  adj_intens(object, type = type, make_rel = make_rel, na.rm = T)
-}
-
-.clean_spec <- function(...) {
-  approx(...)$y
-}

R/conform_spec.R

@@ -0,0 +1,80 @@
+#' @rdname conform_spec
+#'
+#' @title Adjust spectral intensities to absorbance units
+#'
+#' @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.
+#'
+#' @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()}.
+#'
+#' @return
+#' \code{adj_intens()} returns a data frame containing two columns
+#' named \code{"wavenumber"} and \code{"intensity"}.
+#'
+#' @examples
+#' data("raman_hdpe")
+#'
+#' adj_intens(raman_hdpe)
+#'
+#' @author
+#' Win Cowger, Zacharias Steinmetz
+#'
+#' @seealso
+#' \code{\link{subtr_bg}()} for spectral background correction;
+#' \code{\link{match_spec}()} matches spectra with the Open Specy or other
+#' reference libraries
+#'
+#' @importFrom magrittr %>%
+#' @importFrom data.table .SD
+#' @export
+conform_spec <- function(object, ...) {
+  UseMethod("conform_spec")
+}
+
+#' @rdname conform_spec
+#'
+#' @export
+conform_spec.default <- function(object, ...) {
+  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, ...)
+
+  spec <- object$spectra[, lapply(.SD, .clean_spec,
+                                  x = object$wavenumber,
+                                  xout = wn)]
+
+  object$wavenumber <- wn
+  object$spectra <- spec
+
+  adj_intens(object, type = type, make_rel = make_rel, na.rm = T)
+}
+
+.clean_spec <- function(...) {
+  approx(...)$y
+}

R/data_norm.R

@@ -64,89 +64,6 @@ conform_res <- function(x, res = 5) {
   seq(adj_res(min(x), res, ceiling), adj_res(max(x), res, floor), by = res)
 }
 
-#' @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){
-
-    if(!is.list(files)){
-        lof <- lapply(files, read_spec, coords = NULL)
-    }
-    else{
-        lof <- files
-    }
-
-    if(!is.null(wavenumbers)){
-        if(wavenumbers == "first"){
-            lof <- lapply(lof, function(x) {
-                conform_spectra(data = x,
-                                xout = {if(!is.null(res)) conform_res(lof[[1]]$wavenumber, res = res) else lof[[1]]$wavenumber},
-                                coords = NULL)
-            })
-        }
-        if(wavenumbers == "max_range"){
-            all = unique(unlist(lapply(lof, function(x) x$wavenumber)))
-            lof <- lapply(lof, function(x) {
-                                        conform_spectra(data = x,
-                                        xout = {if(!is.null(res)) conform_res(all, res = res) else all},
-                                        coords = NULL)})
-        }
-        if(wavenumbers == "min_range"){
-            smallest_range = which.min(vapply(lof, function(x) length(x$wavenumber), FUN.VALUE = numeric(1)))
-            lof <- lapply(lof, function(x) {
-                conform_spectra(data = x,
-                                xout = {if(!is.null(res)) conform_res(lof[[smallest_range]]$wavenumber, res = res) else lof[[smallest_range]]$wavenumber},
-                                coords = NULL)})
-        }
-        if(wavenumbers == "most_common_range"){
-            wavenumbers = table(unlist(lapply(lof, function(x) x$wavenumber)))
-            common_range = as.numeric(names(wavenumbers)[wavenumbers == max(wavenumbers)])
-            lof <- lapply(lof, function(x) {
-                conform_spectra(data = x,
-                                xout = {if(!is.null(res)) conform_res(lof[[common_range]]$wavenumber, res = res) else lof[[common_range]]$wavenumber},
-                                coords = NULL)})
-        }
-    }
-
-    unlisted <- unlist(lof, recursive = F)
-
-    list <- tapply(unlisted, names(unlisted), FUN = function(x) unname((x)))
-
-    if(length(unique(vapply(list$wavenumber, length, FUN.VALUE = numeric(1)))) > 1 & is.null(wavenumbers)){
-        stop("Wavenumbers are not the same between spectra, you need to specify how the wavenumbers should be merged.", call. = F)
-    }
-
-    as_OpenSpecy(
-        x = list$wavenumber[[1]],
-        spectra = as.data.table(list$spectra),
-        metadata = rbindlist(list$metadata, fill = T)
-    )
-}
-
 #' @rdname data_norm
 #'
 #' @export

R/manage_spec.R

@@ -0,0 +1,137 @@
+#' @rdname manage_spec
+#'
+#' @title Manage spectral objects
+#'
+#' @description
+#' Functions for
+#'
+#' @details
+#' details
+#'
+#' @param x a list object of class \code{OpenSpecy}.
+#' @param file file to be read from or written to.
+#' @param share defaults to \code{NULL}; needed to share spectra with the
+#' Open Specy community; see \code{\link{share_spec}()} for details.
+#' @param method submethod to be used for reading text files; defaults to
+#' \code{\link[data.table]{fread}()} but \code{\link[utils]{read.csv}()} works
+#' as well.
+#' @param \ldots further arguments passed to the submethods.
+#'
+#' @return
+#' All \code{read_*()} functions return data frames containing two columns
+#' named \code{"wavenumber"} and \code{"intensity"}.
+#'
+#' @examples
+#' c()
+#'
+#' @author
+#' Zacharias Steinmetz, Win Cowger
+#'
+#' @seealso
+#' \code{\link[hyperSpec]{read.jdx}()};
+#'
+#' @importFrom magrittr %>%
+#' @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){
+
+  if(!is.list(files)){
+    lof <- lapply(files, read_spec, coords = NULL)
+  }
+  else{
+    lof <- files
+  }
+
+  if(!is.null(wavenumbers)){
+    if(wavenumbers == "first"){
+      lof <- lapply(lof, function(x) {
+        conform_spectra(data = x,
+                        xout = {if(!is.null(res)) conform_res(lof[[1]]$wavenumber, res = res) else lof[[1]]$wavenumber},
+                        coords = NULL)
+      })
+    }
+    if(wavenumbers == "max_range"){
+      all = unique(unlist(lapply(lof, function(x) x$wavenumber)))
+      lof <- lapply(lof, function(x) {
+        conform_spectra(data = x,
+                        xout = {if(!is.null(res)) conform_res(all, res = res) else all},
+                        coords = NULL)})
+    }
+    if(wavenumbers == "min_range"){
+      smallest_range = which.min(vapply(lof, function(x) length(x$wavenumber), FUN.VALUE = numeric(1)))
+      lof <- lapply(lof, function(x) {
+        conform_spectra(data = x,
+                        xout = {if(!is.null(res)) conform_res(lof[[smallest_range]]$wavenumber, res = res) else lof[[smallest_range]]$wavenumber},
+                        coords = NULL)})
+    }
+    if(wavenumbers == "most_common_range"){
+      wavenumbers = table(unlist(lapply(lof, function(x) x$wavenumber)))
+      common_range = as.numeric(names(wavenumbers)[wavenumbers == max(wavenumbers)])
+      lof <- lapply(lof, function(x) {
+        conform_spectra(data = x,
+                        xout = {if(!is.null(res)) conform_res(lof[[common_range]]$wavenumber, res = res) else lof[[common_range]]$wavenumber},
+                        coords = NULL)})
+    }
+  }
+
+  unlisted <- unlist(lof, recursive = F)
+
+  list <- tapply(unlisted, names(unlisted), FUN = function(x) unname((x)))
+
+  if(length(unique(vapply(list$wavenumber, length, FUN.VALUE = numeric(1)))) > 1 & is.null(wavenumbers)){
+    stop("Wavenumbers are not the same between spectra, you need to specify how the wavenumbers should be merged.", call. = F)
+  }
+
+  as_OpenSpecy(
+    x = list$wavenumber[[1]],
+    spectra = as.data.table(list$spectra),
+    metadata = rbindlist(list$metadata, fill = T)
+  )
+}
+
+
+#' @rdname manage_spec
+#'
+#' @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)
+    )
+}