diff --git a/R/adj_intens.R b/R/adj_intens.R index d2f8d693..4cdb70c8 100644 --- a/R/adj_intens.R +++ b/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) } diff --git a/R/adj_range.R b/R/adj_range.R index f5571a3d..922134f3 100644 --- a/R/adj_range.R +++ b/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) } diff --git a/R/as_OpenSpecy.R b/R/as_OpenSpecy.R index 5325f47d..6dfa7923 100644 --- a/R/as_OpenSpecy.R +++ b/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() } diff --git a/R/smooth_intens.R b/R/smooth_intens.R index 06c019dd..9ce2caf1 100644 --- a/R/smooth_intens.R +++ b/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) } diff --git a/R/subtr_bg.R b/R/subtr_bg.R index 0410754e..26b743a6 100644 --- a/R/subtr_bg.R +++ b/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 +} diff --git a/man/adj_range.Rd b/man/adj_range.Rd index ec243f99..031d377a 100644 --- a/man/adj_range.Rd +++ b/man/adj_range.Rd @@ -13,7 +13,7 @@ restrict_range(x, ...) \method{restrict_range}{default}(x, ...) -\method{restrict_range}{OpenSpecy}(x, min_range = 0, max_range = 6000, make_rel = TRUE, ...) +\method{restrict_range}{OpenSpecy}(x, min_range, max_range, make_rel = TRUE, ...) flatten_range(x, ...) @@ -40,7 +40,7 @@ ranges restricted or flattened. } \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. diff --git a/tests/testthat/test-adj_range.R b/tests/testthat/test-adj_range.R index f7d9fb29..361de6c7 100644 --- a/tests/testthat/test-adj_range.R +++ b/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))) })