tests/testthat/test-deconvolute_spectra.R

In metabodecon: Deconvolution and Alignment of 1d NMR Spectra

library(testthat)

# IMPORTANT: in this file we don't test for good PRARPs, as these checks are
# already done in `test-deconvolute_spectrum` (singular). Here, we only want to
# assert that the "glue code" in `test-deconvolute_spectra` (plural),
# orchestrating multiple invocations of `deconvolute_spectrum`, works as
# expected. We do this by checking that the returned objects have the correct
# types.

# Inputs #####
defaults <- list(
    x=sap,
    nfit=3, smopts=c(1,3), delta=3, sfr=c(3.2,-3.2), wshw=0,
    ask=FALSE, force=FALSE, verbose=FALSE, bwc=0,
    use_rust=FALSE, nw=1, igr=list(), rtyp="idecon"
)
args <- list(
    idecons_bwc0_R = set(defaults),
    idecons_bwc1_R = set(defaults, bwc=1),
    idecons_bwc2_R = set(defaults, bwc=2),
    decons0_bwc2_R = set(defaults, bwc=2, rtyp="decon0"),
    decons1_bwc2_R = set(defaults, bwc=2, rtyp="decon1"),
    decons2_bwc2_R = set(defaults, bwc=2, rtyp="decon2"),
    rdecons_bwc2_R = set(defaults, bwc=2, rtyp="rdecon"),
    rdecons_bwc2_rust = set(defaults, bwc=2, rtyp="rdecon", use_rust=TRUE)
)
mdrb_available <- check_mdrb()

# Helpers #####
try_deconvolute_spectra <- function(args) {
    try(do.call(deconvolute_spectra, args), silent=TRUE)
}

try_calc_prarpx <- function(obj) {
    try(calc_prarpx(obj), silent=TRUE)
}

# Calls #####
obj <- sapply(args, try_deconvolute_spectra, simplify=FALSE)

# Checks #####
r_return_types <- test_that("R return types are ok", {

    expect_identical(class(obj$idecons_bwc0_R), "idecons")
    expect_identical(class(obj$idecons_bwc1_R), "idecons")
    expect_identical(class(obj$idecons_bwc2_R), "idecons")
    expect_identical(class(obj$decons0_bwc2_R), "list")
    expect_identical(class(obj$decons1_bwc2_R), "decons1")
    expect_identical(class(obj$decons2_bwc2_R), "decons2")
    expect_identical(class(obj$rdecons_bwc2_R), "try-error")

    expect_identical(class(obj$idecons_bwc0_R[[1]]), "idecon")
    expect_identical(class(obj$idecons_bwc1_R[[1]]), "idecon")
    expect_identical(class(obj$idecons_bwc2_R[[1]]), "idecon")
    expect_identical(class(obj$decons0_bwc2_R[[1]]), "list")
    expect_identical(class(obj$decons1_bwc2_R[[1]]), "decon1")
    expect_identical(class(obj$decons2_bwc2_R[[1]]), "decon2")

    expect_identical(names(obj$idecons_bwc0_R[[1]]), idecon_members)
    expect_identical(names(obj$idecons_bwc1_R[[1]]), idecon_members)
    expect_identical(names(obj$idecons_bwc2_R[[1]]), idecon_members)
    expect_identical(names(obj$decons1_bwc2_R[[1]]), decon1_members)
    expect_identical(names(obj$decons2_bwc2_R[[1]]), decon2_members)
})

# Rust Checks #####

skip_on_cran()
skip_if(getRversion() < numeric_version("4.2"))
skip_if_not(mdrb_available) # (1)
# (1) If we reach this point, we're not on CRAN and our R version is greater
# equal 4.2. I.e., mdrb should be available. If it is not, the "MDRB is
# available" check from `test-deconvolute.R` will fail and that's enough for us
# to see that something is wrong. I.e, in such as scenario, there is no need to
# execute the following tests and spam the log file.

rust_return_types <- test_that("Rust return types are ok", {
    expect_identical(class(obj$rdecons_bwc2_rust), "rdecons")
    expect_identical(class(obj$rdecons_bwc2_rust[[1]]), "rdecon")
    expect_identical(names(obj$rdecons_bwc2_rust[[1]]), rdecon_members)
})