tests/testthat/test-deconvolute_spectrum.R

In metabodecon: Deconvolution and Alignment of 1d NMR Spectra

# Inputs #####
defaults <- list(
    x=sap[[1]],
    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(
    idecon_bwc0 = set(defaults),
    idecon_bwc1 = set(defaults, bwc=1),
    idecon_bwc2 = set(defaults, bwc=2),
    idecon_rust = set(defaults, bwc=2, use_rust=TRUE),
    rdecon_bwc2 = set(defaults, bwc=2, rtyp="rdecon"),
    rdecon_rust = set(defaults, bwc=2, rtyp="rdecon", use_rust=TRUE)
)
mdrb_available <- check_mdrb()

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

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

# Calls #####
obj <- sapply(args, try_deconvolute_spectrum, simplify=FALSE)
prarp <- sapply(obj, try_calc_prarpx, simplify=FALSE)

# Checks #####
r_structures <- test_that(
    "Returned decon objects have correct structure with R backend", {
    # We only test 'idecon' and 'rdecon' objects, as that's enough to
    # cover the R and Rust backends. Conversions to other types are tested
    # in test-as_decon.R.
    expect_identical(object = names(obj$idecon_bwc0), expected = idecon_members)
    expect_identical(object = names(obj$idecon_bwc1), expected = idecon_members)
    expect_identical(object = names(obj$idecon_bwc2), expected = idecon_members)

    expect_identical(object = names(obj$rdecon_bwc2), expected = NULL)

    expect_identical(object = class(obj$idecon_bwc0), expected = "idecon")
    expect_identical(object = class(obj$idecon_bwc1), expected = "idecon")
    expect_identical(object = class(obj$idecon_bwc2), expected = "idecon")
    expect_identical(object = class(obj$rdecon_bwc2), expected = "try-error")
})

r_prarps <- test_that(
    "PRARPs are good with R backend", {
    expect_true(prarp$idecon_bwc0 >= 0.507) # (1)
    expect_true(prarp$idecon_bwc1 >= 0.961)
    expect_true(prarp$idecon_bwc2 >= 0.961)
    expect_true(inherits(prarp$rdecon_bwc2, "try-error"))
    expect_true(prarp$idecon_bwc0 <= prarp$idecon_bwc1) # (2)
    expect_true(prarp$idecon_bwc1 <= prarp$idecon_bwc2) # (2)
    # (1) MetaboDecon1D has a PRARPX of 0.507. See test-MetaboDecon1d.R.
    # (2) Higher bwc versions should lead to higher PRARPs
})

bwc <- test_that(
    "Deconvolute with bwc=0 returns the same result as MetaboDecon1D", {
    decon0_deconvolute <- as_decon0(obj$idecon_bwc0, optional = FALSE)
    decon0_MetaboDecon1D <- MetaboDecon1D_silent(
        filepath = metabodecon_file("bruker/sap"),
        filename = "sap_01",
        number_iterations = 3,
        range_water_signal_ppm = 0,
        signal_free_region = c(3.2, -3.2),
        smoothing_param = c(1, 3),
        delta = 3
    )
    spec <- read_spectrum(metabodecon_file("bruker/sap/sap_01"))
    expect_equal(decon0_deconvolute, decon0_MetaboDecon1D)
})

# 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_structures <- test_that(
    "Returned decon objects have correct structure with Rust backend", {
    expect_identical(object = names(obj$idecon_rust), expected = idecon_members)
    expect_identical(object = names(obj$rdecon_rust), expected = rdecon_members)
    expect_identical(object = class(obj$idecon_rust), expected = "idecon")
    expect_identical(object = class(obj$rdecon_rust), expected = "rdecon")
})

rust_prarps <- test_that(
    "PRARPs are good with Rust backend", {
    expect_true(prarp$idecon_rust >= 0.961)
    expect_true(prarp$rdecon_rust >= 0.961)
    expect_true(prarp$idecon_bwc2 <= prarp$idecon_rust) # (1)
    expect_true(prarp$idecon_bwc2 <= prarp$rdecon_rust) # (1)
    # (1) Rust should be better or equal to R
})

rust_r_equality <- test_that(
    "Rust and R backend produce equal results", {

    # Update all fields from the idecon_bwc2 object for which differences
    # are to be expected. After patching these fields, the objects should
    # be equal.
    idecon_bwc2_mod <- obj$idecon_bwc2
    idecon_rust_mod <- obj$idecon_rust
    idecon_bwc2_mod$args$use_rust <- TRUE
    idecon_bwc2_mod[c("peak", "Z", "lci", "lca", "lcr")] <- NULL
    idecon_rust_mod[c("peak", "Z", "lci", "lca", "lcr")] <- NULL
    expect_equal(idecon_rust_mod, idecon_bwc2_mod)

    # Altough the estimated Lorentzian Parameters are expected to be slightly
    # different, the PRARPs should be roughly the same. In fact, the rust prarp
    # should be higher, as it already uses the raw SIs for the approximation
    # steps, which is not yet implemented in the R version.
    expect_true(prarp$idecon_rust >= prarp$idecon_bwc2)

    # Different return types should not affect PRARPs
    expect_true(prarp$idecon_rust == prarp$rdecon_rust)

    # Make sure the objects are plottable
    expect_no_error(evalwith(plot = "captured", {
        plot_spectrum(obj$idecon_rust)
        plot_spectrum(obj$rdecon_rust)
    }))
})