tests/testthat/test-apply.R

In familiar: End-to-End Automated Machine Learning and Model Evaluation

# Don't perform any further tests on CRAN due to parallelisation issues.
testthat::skip_on_cran()
testthat::skip_on_ci()

apply_vector_fun <- function(x) {
  Sys.sleep(x)

  return(x)
}

apply_vector_fun_2 <- function(x, y) {
  Sys.sleep(x)

  return(y)
}

apply_list_fun <- function(x) {
  Sys.sleep(x)

  return(list("x" = x))
}

apply_list_fun_2 <- function(x, y) {
  Sys.sleep(x)

  return(list("x" = x, "y" = y))
}

apply_list_fun_3 <- function(x, y, z) {
  Sys.sleep(x)

  return(list("x" = x, "y" = y, "z" = z))
}

# Start local cluster in the overall process.
cl <- familiar:::.test_start_cluster(2L)


# Generate random values.
x_sequential <- stats::rnorm(5, mean = 1.0, sd = 0.2)
x_sequential[x_sequential < 0.2] <- 0.2

x_sequential_named <- x_sequential
names(x_sequential_named) <- letters[seq_along(x_sequential_named)]

x_single <- x_sequential[1]

x_parallel <- stats::rnorm(20, mean = 1.0, sd = 0.2)
x_parallel[x_parallel < 0.2] <- 0.2

x_parallel_named <- x_parallel
names(x_parallel_named) <- letters[seq_along(x_parallel_named)]

# fam_sapply -------------------------------------------------------------------

testthat::test_that("fam_sapply works correctly.", {
  # Simple sequential fam_sapply
  x <- familiar:::fam_sapply(
    cl = NULL,
    assign = NULL,
    X = x_sequential,
    FUN = apply_vector_fun)

  testthat::expect_equal(x, x_sequential)

  # Simple sequential fam_sapply with names
  x <- familiar:::fam_sapply(
    cl = NULL,
    assign = NULL,
    X = x_sequential_named,
    FUN = apply_vector_fun)

  testthat::expect_equal(x, x_sequential_named)

  # Sequential fam_sapply with extra argument.
  x <- familiar:::fam_sapply(
    cl = NULL,
    assign = NULL,
    X = x_sequential,
    FUN = apply_vector_fun_2,
    y = "A")

  testthat::expect_length(x, length(x_sequential))
  testthat::expect_setequal(x, "A")

  # Sequential fam_sapply with mini-batching (does nothing)
  x <- familiar:::fam_sapply(
    cl = NULL,
    assign = NULL,
    X = x_sequential,
    FUN = apply_vector_fun,
    chopchop = TRUE)

  testthat::expect_equal(x, x_sequential)

  # Simple parallel fam_sapply.
  x <- familiar:::fam_sapply(
    cl = cl,
    assign = NULL,
    X = x_sequential,
    FUN = apply_vector_fun)

  testthat::expect_equal(x, x_sequential)

  # Simple parallel fam_sapply with names.
  x <- familiar:::fam_sapply(
    cl = cl,
    assign = NULL,
    X = x_sequential_named,
    FUN = apply_vector_fun)

  testthat::expect_equal(x, x_sequential_named)

  # Parallel fam_sapply with extra argument.
  x <- familiar:::fam_sapply(
    cl = cl,
    assign = NULL,
    X = x_sequential,
    FUN = apply_vector_fun_2,
    y = "A")

  testthat::expect_length(x, length(x_sequential))
  testthat::expect_setequal(x, "A")

  # Parallel fam_sapply with mini-batching.
  x <- familiar:::fam_sapply(
    cl = cl,
    assign = NULL,
    X = x_parallel,
    FUN = apply_vector_fun,
    chopchop = TRUE)

  testthat::expect_equal(x, x_parallel)

  # Parallel fam_sapply with mini-batching and "predicted" process times.
  x <- familiar:::fam_sapply(
    cl = cl,
    assign = NULL,
    X = x_parallel,
    FUN = apply_vector_fun,
    chopchop = TRUE,
    process_time = x_parallel,
    overhead_time = 0.1)

  testthat::expect_equal(x, x_parallel)

  # Parallel fam_sapply with mini-batching and "predicted" process times.
  x <- familiar:::fam_sapply(
    cl = cl,
    assign = NULL,
    X = x_parallel_named,
    FUN = apply_vector_fun,
    chopchop = TRUE,
    process_time = x_parallel,
    overhead_time = 0.1)

  testthat::expect_equal(x, x_parallel_named)

  # Parallel, load-balanced sapply.
  x <- familiar:::fam_sapply_lb(
    cl = cl,
    assign = NULL,
    X = x_sequential,
    FUN = apply_vector_fun)

  testthat::expect_equal(x, x_sequential)

  # Parallel, load-balanced sapply with time measurement.
  x <- familiar:::fam_sapply_lb(
    cl = cl,
    assign = NULL,
    X = x_sequential,
    FUN = apply_vector_fun_2,
    y = "A",
    MEASURE.TIME = TRUE)

  testthat::expect_length(x$results, length(x_sequential))
  testthat::expect_setequal(x$results, "A")

  testthat::expect_equal(x$process_time, x_sequential, tolerance = 0.1)

  # Sequential sapply with NULL
  x <- familiar:::fam_sapply(
    cl = NULL,
    assign = NULL,
    X = NULL,
    FUN = apply_vector_fun)

  testthat::expect_equal(x, list())

  # Parallel sapply with NULL
  x <- familiar:::fam_sapply(
    cl = cl,
    assign = NULL,
    X = NULL,
    FUN = apply_vector_fun)

  testthat::expect_equal(x, list())

  # Parallel sapply with mini-batching and NULL
  x <- familiar:::fam_sapply(
    cl = cl,
    assign = NULL,
    X = NULL,
    FUN = apply_vector_fun,
    chopchop = TRUE)

  testthat::expect_equal(x, list())

  # Sequential sapply with single value
  x <- familiar:::fam_sapply(
    cl = NULL,
    assign = NULL,
    X = x_single,
    FUN = apply_vector_fun)

  testthat::expect_equal(x, x_single)

  # Parallel sapply with single value
  x <- familiar:::fam_sapply(
    cl = cl,
    assign = NULL,
    X = x_single,
    FUN = apply_vector_fun)

  testthat::expect_equal(x, x_single)

  # Parallel sapply with mini-batching and single value.
  x <- familiar:::fam_sapply(
    cl = cl,
    assign = NULL,
    X = x_single,
    FUN = apply_vector_fun,
    chopchop = TRUE)

  testthat::expect_equal(x, x_single)
})

# fam_lapply -------------------------------------------------------------------

testthat::test_that("fam_lapply works correctly.", {
  # Simple sequential lapply.
  x <- familiar:::fam_lapply(
    cl = NULL,
    assign = NULL,
    X = x_sequential,
    FUN = apply_list_fun)

  testthat::expect_equal(unname(unlist(x)), x_sequential)

  # Simple sequential fam_sapply with names
  x <- familiar:::fam_lapply(
    cl = NULL,
    assign = NULL,
    X = x_sequential_named,
    FUN = apply_list_fun)

  testthat::expect_equal(names(x), names(x_sequential_named))
  testthat::expect_equal(unname(unlist(x)), x_sequential)

  # Simple sequential lapply with extra argument.
  x <- familiar:::fam_lapply(
    cl = NULL,
    assign = NULL,
    X = x_sequential,
    FUN = apply_list_fun_2,
    y = "A")

  testthat::expect_equal(sapply(x, function(x) (x$x)), x_sequential)
  testthat::expect_setequal(sapply(x, function(x) (x$y)), "A")

  # Sequential lapply with mini-batching (no effect).
  x <- familiar:::fam_lapply(
    cl = NULL,
    assign = NULL,
    X = x_sequential,
    FUN = apply_list_fun,
    chopchop = TRUE)

  testthat::expect_equal(unname(unlist(x)), x_sequential)

  # Parallel lapply.
  x <- familiar:::fam_lapply(
    cl = cl,
    assign = NULL,
    X = x_sequential,
    FUN = apply_list_fun_2,
    y = "A")

  testthat::expect_equal(sapply(x, function(x) (x$x)), x_sequential)
  testthat::expect_setequal(sapply(x, function(x) (x$y)), "A")

  # Parallel lapply with mini-batching.
  x <- familiar:::fam_lapply(
    cl = cl,
    assign = NULL,
    X = x_parallel,
    FUN = apply_list_fun,
    chopchop = TRUE)

  testthat::expect_equal(unname(unlist(x)), x_parallel)

  # Parallel lapply with mini-batching and named elements.
  x <- familiar:::fam_lapply(
    cl = cl,
    assign = NULL,
    X = x_parallel_named,
    FUN = apply_list_fun,
    chopchop = TRUE)

  testthat::expect_equal(names(x), names(x_parallel_named))
  testthat::expect_equal(unname(unlist(x)), x_parallel)

  # Parallel lapply with mini-batching and "predicted" process times.
  x <- familiar:::fam_lapply(
    cl = cl,
    assign = NULL,
    X = x_parallel,
    FUN = apply_list_fun,
    chopchop = TRUE,
    process_time = x_parallel,
    overhead_time = 0.1)

  testthat::expect_equal(unname(unlist(x)), x_parallel)

  # Parallel lapply with mini-batching and "predicted" process times.
  x <- familiar:::fam_lapply(
    cl = cl,
    assign = NULL,
    X = x_parallel_named,
    FUN = apply_list_fun,
    chopchop = TRUE,
    process_time = x_parallel,
    overhead_time = 0.1)

  testthat::expect_equal(names(x), names(x_parallel_named))
  testthat::expect_equal(unname(unlist(x)), x_parallel)

  # Parallel lapply with mini-batching, named elements and vector output.
  x <- familiar:::fam_lapply(
    cl = cl,
    assign = NULL,
    X = x_parallel_named,
    FUN = apply_vector_fun,
    chopchop = TRUE)

  testthat::expect_equal(names(x), names(x_parallel_named))
  testthat::expect_equal(unlist(x), x_parallel_named)

  # Parallel lapply with load balancing.
  x <- familiar:::fam_lapply_lb(
    cl = cl,
    assign = NULL,
    X = x_sequential,
    FUN = apply_list_fun)

  testthat::expect_equal(unname(unlist(x)), x_sequential)

  # Parallel lapply with load balancing and time measurement.
  x <- familiar:::fam_lapply_lb(
    cl = cl,
    assign = NULL,
    X = x_sequential,
    FUN = apply_list_fun_2,
    y = "A",
    MEASURE.TIME = TRUE)

  testthat::expect_equal(sapply(x$results, function(x) (x$x)), x_sequential)
  testthat::expect_setequal(sapply(x$results, function(x) (x$y)), "A")

  testthat::expect_equal(x$process_time, x_sequential, tolerance = 0.1)

  # Sequential lapply with NULL
  x <- familiar:::fam_lapply(
    cl = NULL,
    assign = NULL,
    X = NULL,
    FUN = apply_list_fun)

  testthat::expect_equal(x, list())

  # Parallel lapply with NULL
  x <- familiar:::fam_lapply(
    cl = cl,
    assign = NULL,
    X = NULL,
    FUN = apply_list_fun)

  testthat::expect_equal(x, list())

  # Parallel lapply with mini-batching and NULL
  x <- familiar:::fam_lapply(
    cl = cl,
    assign = NULL,
    X = NULL,
    FUN = apply_list_fun,
    chopchop = TRUE)

  testthat::expect_equal(x, list())

  # Sequential lapply with single value
  x <- familiar:::fam_lapply(
    cl = NULL,
    assign = NULL,
    X = x_single,
    FUN = apply_list_fun)

  testthat::expect_equal(unname(unlist(x)), x_single)

  # Parallel lapply with single value
  x <- familiar:::fam_lapply(
    cl = cl,
    assign = NULL,
    X = x_single,
    FUN = apply_list_fun)

  testthat::expect_equal(unname(unlist(x)), x_single)

  # Parallel lapply with mini-batching and single value.
  x <- familiar:::fam_lapply(
    cl = cl,
    assign = NULL,
    X = x_single,
    FUN = apply_list_fun,
    chopchop = TRUE)

  testthat::expect_equal(unname(unlist(x)), x_single)
})



# fam_mapply -------------------------------------------------------------------

testthat::test_that("fam_mapply works correctly.", {
  # Simple sequential mapply,
  x <- familiar:::fam_mapply(
    cl = NULL,
    assign = NULL,
    FUN = apply_list_fun,
    x = x_sequential)

  testthat::expect_equal(unname(unlist(x)), x_sequential)

  # Simple sequential mapply, with additional argument.
  x <- familiar:::fam_mapply(
    cl = NULL,
    assign = NULL,
    FUN = apply_list_fun_2,
    x = x_sequential,
    y = seq_along(x_sequential))

  testthat::expect_equal(sapply(x, function(x) (x$x)), x_sequential)
  testthat::expect_equal(sapply(x, function(x) (x$y)), seq_along(x_sequential))

  # Simple sequential mapply, with two additional arguments.
  x <- familiar:::fam_mapply(
    cl = NULL,
    assign = NULL,
    FUN = apply_list_fun_3,
    x = x_sequential,
    y = seq_along(x_sequential),
    MoreArgs = list("z" = "A"))

  testthat::expect_equal(sapply(x, function(x) (x$x)), x_sequential)
  testthat::expect_equal(sapply(x, function(x) (x$y)), seq_along(x_sequential))
  testthat::expect_setequal(sapply(x, function(x) (x$z)), "A")

  # Simple sequential mapply, with two additional arguments, and named input.
  x <- familiar:::fam_mapply(
    cl = NULL,
    assign = NULL,
    FUN = apply_list_fun_3,
    x = x_sequential_named,
    y = seq_along(x_sequential_named),
    MoreArgs = list("z" = "A"))

  testthat::expect_equal(names(x), names(x_sequential_named))
  testthat::expect_equal(unname(sapply(x, function(x) (x$x))), x_sequential)
  testthat::expect_equal(unname(sapply(x, function(x) (x$y))), seq_along(x_sequential))
  testthat::expect_setequal(unname(sapply(x, function(x) (x$z))), "A")

  # Sequential mapply with mini-batching (no effect)
  x <- familiar:::fam_mapply(
    cl = NULL,
    assign = NULL,
    FUN = apply_list_fun_2,
    x = x_sequential,
    y = seq_along(x_sequential),
    chopchop = TRUE)

  testthat::expect_equal(sapply(x, function(x) (x$x)), x_sequential)
  testthat::expect_equal(sapply(x, function(x) (x$y)), seq_along(x_sequential))

  # Simple parallel mapply.
  x <- familiar:::fam_mapply(
    cl = cl,
    assign = NULL,
    FUN = apply_list_fun_2,
    x = x_sequential,
    y = seq_along(x_sequential))

  testthat::expect_equal(sapply(x, function(x) (x$x)), x_sequential)
  testthat::expect_equal(sapply(x, function(x) (x$y)), seq_along(x_sequential))

  # Parallel mapply with mini-batching.
  x <- familiar:::fam_mapply(
    cl = cl,
    assign = NULL,
    FUN = apply_list_fun_2,
    x = x_parallel,
    y = seq_along(x_parallel),
    chopchop = TRUE)

  testthat::expect_equal(sapply(x, function(x) (x$x)), x_parallel)
  testthat::expect_equal(sapply(x, function(x) (x$y)), seq_along(x_parallel))

  # Parallel mapply with mini-batching and "predicted" process times.
  x <- familiar:::fam_mapply(
    cl = cl,
    assign = NULL,
    FUN = apply_list_fun_2,
    x = x_parallel,
    y = seq_along(x_parallel),
    process_time = x_parallel,
    overhead_time = 0.1,
    chopchop = TRUE)

  testthat::expect_equal(sapply(x, function(x) (x$x)), x_parallel)
  testthat::expect_equal(sapply(x, function(x) (x$y)), seq_along(x_parallel))

  # Parallel mapply with mini-batching, "predicted" process times and additional
  # arguments.
  x <- familiar:::fam_mapply(
    cl = cl,
    assign = NULL,
    FUN = apply_list_fun_3,
    x = x_parallel,
    y = seq_along(x_parallel),
    process_time = x_parallel,
    overhead_time = 0.1,
    MoreArgs = list("z" = "A"),
    chopchop = TRUE)

  testthat::expect_equal(sapply(x, function(x) (x$x)), x_parallel)
  testthat::expect_equal(sapply(x, function(x) (x$y)), seq_along(x_parallel))
  testthat::expect_setequal(sapply(x, function(x) (x$z)), "A")

  # Parallel mapply with load balancing.
  x <- familiar:::fam_mapply_lb(
    cl = cl,
    assign = NULL,
    FUN = apply_list_fun_2,
    x = x_sequential,
    y = seq_along(x_sequential))

  testthat::expect_equal(sapply(x, function(x) (x$x)), x_sequential)
  testthat::expect_equal(sapply(x, function(x) (x$y)), seq_along(x_sequential))

  # Parallel mapply with load balancing and time measurement.
  x <- familiar:::fam_mapply_lb(
    cl = cl,
    assign = NULL,
    FUN = apply_list_fun_2,
    x = x_sequential,
    y = seq_along(x_sequential),
    MEASURE.TIME = TRUE)

  testthat::expect_equal(sapply(x$results, function(x) (x$x)), x_sequential)
  testthat::expect_equal(sapply(x$results, function(x) (x$y)), seq_along(x_sequential))

  testthat::expect_equal(x$process_time, x_sequential, tolerance = 0.1)

  # Sequential mapply with NULL
  x <- familiar:::fam_mapply(
    cl = NULL,
    assign = NULL,
    FUN = apply_list_fun,
    x = NULL)

  testthat::expect_equal(x, list())

  # Parallel mapply with NULL
  x <- familiar:::fam_mapply(
    cl = cl,
    assign = NULL,
    FUN = apply_list_fun,
    x = NULL)

  testthat::expect_equal(x, list())

  # Parallel mapply with mini-batching and NULL
  x <- familiar:::fam_mapply(
    cl = cl,
    assign = NULL,
    FUN = apply_list_fun,
    x = NULL,
    chopchop = TRUE)

  testthat::expect_equal(x, list())

  # Sequential mapply with single value
  x <- familiar:::fam_mapply(
    cl = NULL,
    assign = NULL,
    FUN = apply_list_fun,
    x = x_single)

  testthat::expect_equal(unname(unlist(x)), x_single)

  # Parallel mapply with single value
  x <- familiar:::fam_mapply(
    cl = cl,
    assign = NULL,
    FUN = apply_list_fun,
    x = x_single)

  testthat::expect_equal(unname(unlist(x)), x_single)

  # Parallel mapply with mini-batching and single value.
  x <- familiar:::fam_mapply(
    cl = cl,
    assign = NULL,
    FUN = apply_list_fun,
    x = x_single,
    chopchop = TRUE)

  testthat::expect_equal(unname(unlist(x)), x_single)
})

familiar:::.terminate_cluster(cl)