Apply make_rel() to all columns individually + added tests

R/adj_intens.R

@@ -65,7 +65,8 @@ adj_intens.OpenSpecy <- function(x, type = "none", make_rel = TRUE, ...) {
                 "transmittance" = log10(1/adj_neg(spec, ...)),
                 "none" = adj_neg(spec, ...)
   )
-  if (make_rel) x$spectra <- make_rel(adj) else x$spectra <- adj
+
+  if (make_rel) x$spectra <- adj[, lapply(.SD, make_rel)] else x$spectra <- adj
 
   return(x)
 }

R/adj_range.R

@@ -3,7 +3,7 @@
 #'
 #' @description
 #' \code{restrict_range()} restricts wavenumber ranges to user specified values.
-#' Multiple ranges can be specified by inputting the series of max and min
+#' Multiple ranges can be specified by inputting a series of max and min
 #' values in order.
 #' \code{flatten_range()} will flatten ranges of the spectra that should have no
 #' peaks.
@@ -56,22 +56,17 @@ restrict_range.default <- function(x, ...) {
 #' @rdname adj_range
 #'
 #' @export
-restrict_range.OpenSpecy <- function(x,
-                                     min_range = 0,
-                                     max_range = 6000,
-                                     make_rel = TRUE,
-                                        ...) {
+restrict_range.OpenSpecy <- function(x, min_range, max_range, make_rel = TRUE,
+                                     ...) {
     test <- as.data.table(lapply(1:length(min_range), function(y){
         x$wavenumber >= min_range[y] & x$wavenumber <= max_range[y]})
     )
 
-    vals = rowSums(test) > 0
-
+    vals <- rowSums(test) > 0
     filt <- x$spectra[vals,]
-
     x$wavenumber <- x$wavenumber[vals]
 
-    if (make_rel) x$spectra <- make_rel(filt) else x$spectra <- filt
+    if (make_rel) x$spectra <- filt[, lapply(.SD, make_rel)] else x$spectra <- filt
 
     return(x)
 }
@@ -103,23 +98,20 @@ flatten_range.OpenSpecy <- function(x, min_range, max_range, make_rel = TRUE,
   }, FUN.VALUE = logical(1)))) {
     stop("all min_range values must be lower than corresponding max_range")
   }
-  filt <- x$spectra[,lapply(.SD, function(y) {
-    .flatten_range(wavenumber = x$wavenumber,
-                   spectra = y,
-                   min_range = min_range,
-                   max_range = max_range)
-  })]
+  flat <- x$spectra[, lapply(.SD, .flatten_range, x = x$wavenumber,
+                             min_range = min_range, max_range = max_range)]
 
-  if (make_rel) x$spectra <- filt[, lapply(.SD, make_rel)] else x$spectra <- filt
+  if (make_rel) x$spectra <- flat[, lapply(.SD, make_rel)] else x$spectra <- flat
 
   return(x)
 }
 
-.flatten_range <- function(wavenumber, spectra, min_range, max_range) {
-  for(i in 1:length(min_range)){
-    spectra[wavenumber >= min_range[i] & wavenumber <= max_range[i]] <- mean(c(spectra[min(which(wavenumber >= min_range[i]))],
-                                                                               spectra[max(which(wavenumber <= max_range[i]))]))
+.flatten_range <- function(y, x, min_range, max_range) {
+  for(i in 1:length(min_range)) {
+    y[x >= min_range[i] & x <= max_range[i]] <-
+      mean(c(y[min(which(x >= min_range[i]))],
+             y[max(which(x <= max_range[i]))]))
   }
 
-  return(spectra)
+  return(y)
 }

R/as_OpenSpecy.R

@@ -282,9 +282,9 @@ as_OpenSpecy.default <- function(x, spectra,
     if (inherits(metadata, c("data.frame", "list"))) {
       obj$metadata <- cbind(obj$metadata, as.data.table(metadata))
       if(session_id){
-          obj$metadata$session_id <- paste(digest(Sys.info()),
-                                           digest(sessionInfo()),
-                                           sep = "/")
+        obj$metadata$session_id <- paste(digest(Sys.info()),
+                                         digest(sessionInfo()),
+                                         sep = "/")
       }
       if(!c("file_id") %in% names(obj$metadata)) {
         obj$metadata$file_id = digest(obj[c("wavenumber", "spectra")])
@@ -357,6 +357,7 @@ OpenSpecy <- function(x, ...) {
 #' @export
 gen_grid <- function(n) {
   base <- sqrt(n)
+
   expand.grid(x = 1:ceiling(base), y = 1:ceiling(base))[1:n,] |>
     as.data.table()
 }

R/smooth_intens.R

@@ -61,7 +61,8 @@ smooth_intens.OpenSpecy <- function(x, p = 3, n = 11, m = 0, abs = FALSE,
                                     make_rel = TRUE,
                                     ...) {
   filt <- x$spectra[, lapply(.SD, .sgfilt, p = p, n = n, m = m, abs = abs, ...)]
-  if (make_rel) x$spectra <- make_rel(filt) else x$spectra <- filt
+
+  if (make_rel) x$spectra <- filt[, lapply(.SD, make_rel)] else x$spectra <- filt
 
   return(x)
 }

R/subtr_bg.R

@@ -61,14 +61,6 @@ subtr_bg.default <- function(x, ...) {
   stop("object 'x' needs to be of class 'OpenSpecy'", call. = F)
 }
 
-.subtr_bg_manual <- function(wavenumber,
-                             intensity,
-                             wavenumber_fit,
-                             intensity_fit,
-                             ...) {
-  intensity - approx(wavenumber_fit, intensity_fit, xout = wavenumber, rule = 2, method = "linear", ties = mean)$y
-}
-
 #' @rdname subtr_bg
 #'
 #' @export
@@ -96,7 +88,7 @@ subtr_bg.OpenSpecy <- function(x,
     })]
   }
 
-  if (make_rel) x$spectra <- make_rel(sbg) else x$spectra <- sbg
+  if (make_rel) x$spectra <- sbg[, lapply(.SD, make_rel)] else x$spectra <- sbg
 
   return(x)
 }
@@ -163,3 +155,9 @@ subtr_bg.OpenSpecy <- function(x,
     dev_prev <- dev_curr
   }
 }
+
+.subtr_bg_manual <- function(wavenumber, intensity, wavenumber_fit,
+                             intensity_fit, ...) {
+  intensity - approx(wavenumber_fit, intensity_fit, xout = wavenumber, rule = 2,
+                     method = "linear", ties = mean)$y
+}

tests/testthat/test-adj_range.R

@@ -1,24 +1,55 @@
 test_that("restrict_range() provides correct range", {
-  test_noise = as_OpenSpecy(x = seq(400,4000, by = 10), spectra = data.table(intensity = rnorm(361)))
-  expect_silent(single_range <- restrict_range(test_noise, min_range = 1000, max_range = 2000))
-  expect_silent(double_range <- restrict_range(test_noise, min_range = c(1000, 2000) , max_range = c(1500, 2500)))
-  expect_true(is_OpenSpecy(single_range))
-  expect_true(is_OpenSpecy(double_range))
+  test_noise <- as_OpenSpecy(x = seq(400,4000, by = 10),
+                             spectra = data.table(intensity = rnorm(361)))
+  single_range <- restrict_range(test_noise, min_range = 1000,
+                                 max_range = 2000) |>
+    expect_silent()
+
+  double_range <- restrict_range(test_noise, min_range = c(1000, 2000),
+                                 max_range = c(1500, 2500)) |>
+    expect_silent()
+
+  is_OpenSpecy(single_range) |> expect_true()
   expect_identical(single_range$wavenumber, seq(1000,2000, by = 10))
-  expect_identical(double_range$wavenumber, c(seq(1000,1500, by = 10), seq(2000,2500, by = 10)))
+  expect_identical(double_range$wavenumber, c(seq(1000,1500, by = 10),
+                                              seq(2000,2500, by = 10)))
 })
 
 test_that("flatten_range() function test", {
-    #spectrum <- read_any(read_extdata(file = "ftir_ps.0"))
-    test <- as_OpenSpecy(x = 1:10, spectra = data.table(V1 = 1:10))
-    flattened_data <- flatten_range(test, min_range = c(4, 7), max_range = c(5, 10), make_rel = F)
-    expect_equal(flattened_data$spectra$V1[4:5], c(4.5, 4.5))
-    expect_equal(flattened_data$spectra$V1[7:10], c(8.5, 8.5, 8.5, 8.5))
+  sam <- as_OpenSpecy(x = 1:10, spectra = data.table(V1 = 1:10))
+  flat_sam <- flatten_range(sam, min_range = c(4, 7), max_range = c(5, 10),
+                             make_rel = F) |>
+    expect_silent()
+
+  expect_equal(flat_sam$spectra$V1[4:5], c(4.5, 4.5))
+  expect_equal(flat_sam$spectra$V1[7:10], c(8.5, 8.5, 8.5, 8.5))
+
+  data("raman_hdpe")
+  flat_hdpe <- flatten_range(raman_hdpe, min_range = c(500, 1000),
+                             max_range = c(700, 1500)) |>
+    expect_silent()
+  expect_equal(flat_hdpe$spectra$intensity[1:50],
+               make_rel(raman_hdpe$spectra$intensity)[1:50])
+  expect_equal(flat_hdpe$spectra$intensity[60:100] |> unique() |> round(6),
+               0.036709)
+
+  tiny_map <- read_extdata("CA_tiny_map.zip") |> read_zip()
+  flat_map <- flatten_range(tiny_map, min_range = c(1000, 2000),
+                            max_range = c(1200, 2400), make_rel = F) |>
+    expect_silent()
+
+  expect_false(all.equal(flat_map$spectra, tiny_map$spectra) |> isTRUE())
+  expect_equal(flat_map$spectra[1:20], tiny_map$spectra[1:20])
+
+  expect_equal(flat_map$spectra[40:60, 1:5] |> unique() |> round(4),
+               data.table(-0.8694, -0.7769, -0.5828, -0.292, 0.1916))
 })
 
 test_that("flatten_range() error handling", {
   test <- as_OpenSpecy(x = 1:10, spectra = data.table(V1 = 1:10))
-    expect_error(flatten_range(test))
-    expect_error(flatten_range(test, min_range = c(1000), max_range = c(2000, 3000)))
-    expect_error(flatten_range(test, min_range = c(2000), max_range = c(1000)))
+
+  expect_error(flatten_range(test))
+  expect_error(flatten_range(test, min_range = c(1000),
+                             max_range = c(2000, 3000)))
+  expect_error(flatten_range(test, min_range = c(2000), max_range = c(1000)))
 })