Code styling

wincowgerDEV · Mar 19, 2024 · f7a0061 · f7a0061
1 parent 9ea80c1
commit f7a0061
Show file tree

Hide file tree

Showing 16 changed files with 447 additions and 462 deletions.
diff --git a/R/adj_intens.R b/R/adj_intens.R
@@ -58,10 +58,10 @@ adj_intens.default <- function(x, ...) {
 #'
 #' @export
 adj_intens.OpenSpecy <- function(x, type = "none", make_rel = TRUE, ...) {
-  
-  if(!type %in% c("none", "transmittance", "reflectance")) 
-      stop('type argument must be one of "none", "transmittance", or "reflectance"')
-    
+
+  if(!type %in% c("none", "transmittance", "reflectance"))
+    stop('type argument must be one of "none", "transmittance", or "reflectance"')
+
   spec <- x$spectra
 
   adj <- switch(type,

diff --git a/R/as_OpenSpecy.R b/R/as_OpenSpecy.R
@@ -14,7 +14,7 @@
 #' @param metadata metadata for each spectrum with one row per spectrum,
 #' see details.
 #' @param attributes a list of attributes describing critical aspects for interpreting the spectra.
-#' see details. 
+#' see details.
 #' @param coords spatial coordinates for the spectra.
 #' @param session_id logical. Whether to add a session ID to the metadata.
 #' The session ID is based on current session info so metadata of the same
@@ -104,7 +104,7 @@
 #'   \item{`baseline`}{supported options include `"raw"` or `"nobaseline"`}
 #'   \item{`spectra_type`}{supported options include `"ftir"` or `"raman"`}
 #' }
-#' 
+#'
 #' The \code{attributes} argument may contain a named list with the following
 #' details, when set, they will be used to automate transformations and warning messages:
 #'
@@ -271,9 +271,9 @@ as_OpenSpecy.default <- function(x, spectra,
                                    other_info = NULL,
                                    license = "CC BY-NC"),
                                  attributes = list(
-                                   intensity_unit = NULL, 
-                                   derivative_order = NULL, 
-                                   baseline = NULL, 
+                                   intensity_unit = NULL,
+                                   derivative_order = NULL,
+                                   baseline = NULL,
                                    spectra_type = NULL
                                  ),
                                  coords = "gen_grid",
@@ -292,27 +292,27 @@ as_OpenSpecy.default <- function(x, spectra,
   if (length(x) != nrow(spectra))
     stop("'x' and 'spectra' must be of equal length", call. = F)
 
-  obj <- structure(list(), 
-
+  obj <- structure(list(),
                    class = c("OpenSpecy", "list"),
                    intensity_unit = attributes$intensity_unit,
                    derivative_order = attributes$derivative_order,
                    baseline = attributes$baseline,
                    spectra_type = attributes$spectra_type
-                   )
-
+  )
 
   obj$wavenumber <- x[order(x)]
 
   obj$spectra <- as.data.table(spectra)[order(x)]
 
-  if (inherits(coords, "character") && !any(is.element(c("x", "y"), names(metadata)))) {
+  if (inherits(coords, "character") && !any(is.element(c("x", "y"),
+                                                       names(metadata)))) {
     obj$metadata <- do.call(coords, list(ncol(obj$spectra)))
   } else if(inherits(coords, c("data.frame", "list")) &&
              all(is.element(c("x", "y"), names(coords)))) {
     obj$metadata <- as.data.table(coords)
   } else {
-    if(!all(is.element(c("x", "y"), names(metadata))))  stop("inconsistent input for 'coords'", call. = F)
+    if(!all(is.element(c("x", "y"), names(metadata))))
+      stop("inconsistent input for 'coords'", call. = F)
     obj$metadata <- data.table()
   }
   if (!is.null(metadata)) {

diff --git a/R/conform_spec.R b/R/conform_spec.R
@@ -10,15 +10,15 @@
 #' min and max value.
 #' @param res spectral resolution adjusted to or \code{NULL} if the raw range
 #' should be used.
-#' @param allow_na logical; should NA values in places beyond the wavenumbers 
+#' @param allow_na logical; should NA values in places beyond the wavenumbers
 #' of the dataset be allowed?
 #' @param type the type of wavenumber adjustment to make. \code{"interp"}
 #' results in linear interpolation while \code{"roll"} conducts a nearest
 #' rolling join of the wavenumbers. \code{"mean_up"} only works when
-#' Spectra are being aggregated, we take the mean of the intensities within the 
+#' Spectra are being aggregated, we take the mean of the intensities within the
 #' wavenumber specified. This can maintain smaller peaks and make spectra more
 #' similar to it's less resolved relatives. mean_up option is still experimental.
-#' 
+#'
 #' @param \ldots further arguments passed to \code{\link[stats]{approx}()}
 #'
 #' @return
@@ -53,10 +53,11 @@ conform_spec.default <- function(x, ...) {
 #' @rdname conform_spec
 #'
 #' @export
-conform_spec.OpenSpecy <- function(x, range = NULL, res = 5, allow_na = F, type = "interp",
+conform_spec.OpenSpecy <- function(x, range = NULL, res = 5, allow_na = F,
+                                   type = "interp",
                                    ...) {
   if(!any(type %in% c("interp", "roll", "mean_up")))
-    stop("type must be either interp, roll, or mean_up")
+    stop("type must be either 'interp', 'roll', or 'mean_up'")
 
   if(is.null(range)) range <- x$wavenumber
 
@@ -81,26 +82,26 @@ conform_spec.OpenSpecy <- function(x, range = NULL, res = 5, allow_na = F, type
     spec <- spec[join, roll = "nearest", on = "wavenumber"]
     spec <- spec[,-"wavenumber"]
   }
-  
+
   if(type == "mean_up"){
-      spec <- x$spectra[,lapply(.SD, mean), 
-                                   by = cut(x = x$wavenumber, breaks = wn)][,-"cut"]
+    spec <- x$spectra[,lapply(.SD, mean),
+                      by = cut(x = x$wavenumber, breaks = wn)][,-"cut"]
   }
-  
+
   if(allow_na){
-      if(min(range) < min(wn) | max(range) > max(wn)){
-          if(!is.null(res)){
-              filler_range  <- conform_res(range, res = res)
-          }
-          else{
-              filler_range <- range
-          }
-          filler = data.table("wavenumber" = filler_range)
-          spec <- spec[,"wavenumber" := wn][filler, on = "wavenumber"][,-"wavenumber"]
-          wn <- filler_range
+    if(min(range) < min(wn) | max(range) > max(wn)){
+      if(!is.null(res)){
+        filler_range  <- conform_res(range, res = res)
       }
+      else{
+        filler_range <- range
+      }
+      filler = data.table("wavenumber" = filler_range)
+      spec <- spec[,"wavenumber" := wn][filler, on = "wavenumber"][,-"wavenumber"]
+      wn <- filler_range
+    }
   }
-  
+
   x$wavenumber <- wn
   x$spectra <- spec
 

diff --git a/R/io_spec.R b/R/io_spec.R
@@ -36,7 +36,7 @@
 #' read_extdata("raman_hdpe.json") |> read_spec()
 #' read_extdata("raman_hdpe.rds") |> read_spec()
 #' read_extdata("raman_hdpe.csv") |> read_spec()
-#' 
+#'
 #' \dontrun{
 #' data(raman_hdpe)
 #' write_spec(raman_hdpe, "raman_hdpe.yml")
@@ -90,19 +90,14 @@ write_spec.OpenSpecy <- function(x, file, method = NULL,
       write_json(x, path = file, dataframe = "columns", digits = digits, ...)
     } else if (grepl("\\.rds$", file, ignore.case = T)) {
       saveRDS(x, file = file, ...)
+    } else if (grepl("\\.csv$", file, ignore.case = T)) {
+      wave_names <- round(x$wavenumber, 0)
+      spectra <- t(x$spectra)
+      colnames(spectra) <- wave_names
+      flat_specy <- cbind(spectra, x$metadata)
+      fwrite(flat_specy, file = file)
     }
-      else if (grepl("\\.csv$", file, ignore.case = T)){
-          wave_names <- round(x$wavenumber, 0)
-
-          spectra <- t(x$spectra)
-
-          colnames(spectra) <- wave_names
-
-          flat_specy <- cbind(spectra, x$metadata)
-
-          fwrite(flat_specy, file = file)
-    }
-      else {
+    else {
       stop("unknown file type: specify a method to write custom formats or ",
            "provide one of the supported .yml, .json, or .rds formats as ",
            "file extension", call. = F)
@@ -140,12 +135,11 @@ read_spec <- function(file, share = NULL, method = NULL, ...) {
       else if (grepl("\\.csv$", file, ignore.case = T)) {
           os <- read_text(file, ...)
           os$metadata$file_name <- basename(file)
-    }
-      else {
+    } else {
       stop("unknown file type: specify a method to read custom formats or ",
            "provide files of one of the supported file types .yml, .json, .rds",
            call. = F)
-    }
+      }
   } else {
     io <- do.call(method, list(file, ...))
 

diff --git a/R/manage_na.R b/R/manage_na.R
@@ -1,13 +1,14 @@
 #' @rdname manage_na
-#' @title Ignore or Remove NA intensities
+#' @title Ignore or remove NA intensities
 #'
 #' @description
-#' Sometimes you want to keep or remove NA values in intensities to allow for spectra with 
-#' varying shapes to be analyzed together or maintained in a single Open Specy object. 
-#' 
-#' @param x a numeric vector or an \R OpenSpecy object
-#' @param lead_tail_only logical whether to only look at leading adn tailing values. 
-#' @param ig character vector, values to ignore
+#' Sometimes you want to keep or remove NA values in intensities to allow for
+#' spectra with varying shapes to be analyzed together or maintained in a single
+#' Open Specy object.
+#'
+#' @param x a numeric vector or an \R OpenSpecy object.
+#' @param lead_tail_only logical whether to only look at leading adn tailing values.
+#' @param ig character vector, values to ignore.
 #' @param fun the name of the function you want run, this is only used if the "ignore" type is chosen.
 #' @param type character of either "ignore" or "remove".
 #' @param \ldots further arguments passed to \code{fun}.
@@ -22,13 +23,13 @@
 #' manage_na(c(NA, 0, NA, 1, 10), lead_tail_only = FALSE, ig = c(NA,0))
 #' data(raman_hdpe)
 #' raman_hdpe$spectra[[1]][1:10] <- NA
-#' 
-#' #would normally return all NA without na.rm = TRUE but doesn't here. 
-#' manage_na(raman_hdpe, fun = make_rel) 
-#' 
+#'
+#' #would normally return all NA without na.rm = TRUE but doesn't here.
+#' manage_na(raman_hdpe, fun = make_rel)
+#'
 #' #will remove the first 10 values we set to NA
-#' manage_na(raman_hdpe, type = "remove") 
-#' 
+#' manage_na(raman_hdpe, type = "remove")
+#'
 #' @author
 #' Win Cowger, Zacharias Steinmetz
 #'
@@ -39,66 +40,68 @@
 #'
 #' @export
 manage_na <- function(x, ...) {
-    UseMethod("manage_na")
+  UseMethod("manage_na")
 }
 
 #' @rdname manage_na
 #' @export
 manage_na.default <- function(x, lead_tail_only = TRUE, ig = c(NA), ...) {
 
-    if(all(is.na(x))) stop("All intensity values are NA, cannot remove or ignore with manage na.")
-
-    if(lead_tail_only){
-        na_positions <- logical(length(x))
-        if(x[1] %in% ig){
-            criteria = TRUE
-            y = 1
-            while(criteria){
-                if(x[y] %in% ig) na_positions[y] <- TRUE 
-                y = y + 1
-                criteria = x[y] %in% ig
-            }
-        }
-        if(x[length(x)] %in% ig){
-            criteria = TRUE
-            y = length(x)
-            while(criteria){
-                if(x[y] %in% ig) na_positions[y] <- TRUE 
-                y = y - 1
-                criteria = x[y] %in% ig
-            }
-        }
+  if(all(is.na(x)))
+    stop("All intensity values are NA, cannot remove or ignore with manage na.")
+
+  if(lead_tail_only) {
+    na_positions <- logical(length(x))
+    if(x[1] %in% ig) {
+      criteria = T
+      y = 1
+      while(criteria) {
+        if(x[y] %in% ig) na_positions[y] <- T
+        y = y + 1
+        criteria = x[y] %in% ig
+      }
     }
-    else{
-        na_positions <- x %in% ig
+    if(x[length(x)] %in% ig) {
+      criteria = T
+      y = length(x)
+      while(criteria){
+        if(x[y] %in% ig) na_positions[y] <- T
+        y = y - 1
+        criteria = x[y] %in% ig
+      }
     }
-
-    return(na_positions)
+  }
+  else{
+    na_positions <- x %in% ig
+  }
+
+  return(na_positions)
 }
 
 #' @rdname manage_na
 #' @export
-manage_na.OpenSpecy <- function(x, lead_tail_only = TRUE, ig = c(NA), fun, type = "ignore", ...) {
-
-    consistent <- x$spectra[, lapply(.SD, manage_na, 
-                               lead_tail_only = lead_tail_only, 
-                               ig = ig)] |>
-        rowSums() == 0
-
-    if(type == "ignore"){
-        reduced <- as_OpenSpecy(x$wavenumber[consistent], x$spectra[consistent,], x$metadata) |>
-            fun(...)
-
-        x$spectra <- x$spectra[, lapply(.SD, as.numeric)]
-
-        x$spectra[consistent,] <- reduced$spectra        
-    }
-
-    if(type == "remove"){
-        x <- as_OpenSpecy(x$wavenumber[consistent], x$spectra[consistent,], x$metadata)
-    }
-
-    return(x)
+manage_na.OpenSpecy <- function(x, lead_tail_only = TRUE, ig = c(NA), fun,
+                                type = "ignore", ...) {
 
-}
+  consistent <- x$spectra[, lapply(.SD, manage_na,
+                                   lead_tail_only = lead_tail_only,
+                                   ig = ig)] |>
+    rowSums() == 0
+
+  if(type == "ignore"){
+    reduced <- as_OpenSpecy(x$wavenumber[consistent], x$spectra[consistent,],
+                            x$metadata) |>
+      fun(...)
+
+    x$spectra <- x$spectra[, lapply(.SD, as.numeric)]
 
+    x$spectra[consistent,] <- reduced$spectra
+  }
+
+  if(type == "remove"){
+    x <- as_OpenSpecy(x$wavenumber[consistent], x$spectra[consistent,],
+                      x$metadata)
+  }
+
+  return(x)
+}
diff --git a/R/manage_spec.R b/R/manage_spec.R
@@ -12,7 +12,7 @@
 #' 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 size the number of spectra to sample.
 #' @param prob probabilities to use for the sampling.
 #' @param \ldots further arguments passed to submethods.
 #'
@@ -79,17 +79,18 @@ c_spec.list <- function(x, range = NULL, res = 5, ...) {
         stop("data points need to overlap in their ranges", call. = F)
 
       wn <- c(max(pmin), min(pmax))
+    } else {
+      stop("If range is specified it should be a numeric vector or 'common'",
+           call. = F)
     }
-      else{
-          stop("If range is specified it should be a numeric vector or 'common'", call. = F)
-      }
-      x <- lapply(x, conform_spec, range = wn, res = res)
+    x <- lapply(x, conform_spec, range = wn, res = res)
   }
 
   unlisted <- unlist(unname(x), recursive = F)
   list <- tapply(unlisted, names(unlisted), unname)
 
-  if(length(unique(vapply(list$wavenumber, length, FUN.VALUE = numeric(1)))) > 1 & is.null(range)) {
+  if(length(unique(vapply(list$wavenumber, length, FUN.VALUE = numeric(1)))) > 1 &
+     is.null(range)) {
     stop("wavenumbers need to be identical between spectra; specify how; use ",
          "'range' to specify how wavenumbers should be merged", call. = F)
   }