tests/testthat/test-as_data_list.R

In mnirs: Muscle Near-Infrared Spectroscopy Processing and Analysis

## as_data_list() =====================================================
test_that("as_data_list() errors when dplyr is not installed", {
    skip_if_not_installed("dplyr")

    data <- dplyr::group_by(
        data.frame(time = 1:4, smo2 = c(60, 61, 62, 63), grp = c("a", "a", "b", "b")),
        grp
    )

    ## simulate dplyr being unavailable
    local_mocked_bindings(
        requireNamespace = function(package, ...) {
            if (identical(package, "dplyr")) FALSE else TRUE
        },
        .package = "base"
    )

    expect_error(
        as_data_list(data),
        "is required for grouped data frame input"
    )
})

test_that("as_data_list() wraps a single data frame in a length-1 list", {
    data <- data.frame(time = 1:4, smo2 = c(60, 61, 62, 63))
    result <- as_data_list(data)

    expect_type(result, "list")
    expect_length(result, 1)
    expect_named(result, "interval_1")
    expect_equal(result[[1]], data)
})

test_that("as_data_list() splits mnirs_kinetics coefficients by channel", {
    coefs <- data.frame(
        interval = rep(c("a", "b"), each = 2),
        nirs_channels = rep(c("ch2", "ch1"), 2),
        start_time = rep(c(0, 100), each = 2),
        tau = 1:4
    )
    kinetics <- structure(list(coefficients = coefs), class = "mnirs_kinetics")
    result <- as_data_list(kinetics)

    ## channel order of appearance is kept; each df holds a row per interval
    expect_type(result, "list")
    expect_named(result, c("ch2", "ch1"))
    for (.ch in names(result)) {
        expect_equal(nrow(result[[.ch]]), 2)
        expect_equal(rownames(result[[.ch]]), c("1", "2"))
        expect_true(all(result[[.ch]]$nirs_channels == .ch))
        expect_equal(result[[.ch]]$source_interval, c("a", "b"))
    }
    expect_equal(result$ch1$tau, c(2, 4))
})

test_that("as_data_list() errors when mnirs_kinetics has no coefficients", {
    kinetics <- structure(list(method = "peak_slope"), class = "mnirs_kinetics")
    expect_error(as_data_list(kinetics), "coefficients")
})


## map_mnirs_intervals() ==============================================
test_that("map_mnirs_intervals() returns a list of class 'mnirs'", {
    data <- create_mnirs_data(
        data.frame(time = 1:5, ch1 = rep(50, 5)),
        nirs_channels = "ch1",
        time_channel = "time"
    )
    data_list <- list(a = data, b = data)

    ## each transformer routes list input through `map_mnirs_intervals()`;
    ## the container must carry "mnirs" so `plot()` dispatches to `plot.mnirs`
    results <- list(
        filter = filter_mnirs(
            data_list, method = "moving_average", width = 3, verbose = FALSE
        ),
        resample = resample_mnirs(
            data_list, method = "linear", verbose = FALSE
        ),
        rescale = rescale_mnirs(data_list, range = c(0, 1), verbose = FALSE),
        shift = shift_mnirs(data_list, to = 0, width = 5, verbose = FALSE),
        replace = replace_mnirs(
            data_list, invalid_below = 0, method = "linear", verbose = FALSE
        )
    )

    for (.result in results) {
        expect_type(.result, "list")
        expect_s3_class(.result, "mnirs")
        expect_named(.result, c("a", "b"))
        expect_s3_class(.result$a, "mnirs")
    }
})

test_that("plot() dispatches to plot.mnirs() on transformer list output", {
    skip_if_not_installed("ggplot2")

    data <- create_mnirs_data(
        data.frame(time = 1:5, ch1 = rep(50, 5)),
        nirs_channels = "ch1",
        time_channel = "time"
    )
    result <- filter_mnirs(
        list(a = data, b = data),
        method = "moving_average",
        width = 3,
        verbose = FALSE
    )

    ## an unclassed list falls through to `graphics::plot.default()`
    p <- plot(result)
    expect_s3_class(p, "ggplot")
    expect_no_error(ggplot2::ggplot_build(p))
})