Nothing
tests/testthat/test-matsindf_apply.R
In matsindf: Matrices in Data Frames
test_that("matsindf_apply() fails with an unexpected argument", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_error(matsindf_apply(.dat = "a string", FUN = example_fun, a = 2, b = 2),
".dat must be NULL, a data frame, or a list in matsindf_apply\\(\\), was character")
})
test_that("matsindf_apply() works as expected for single values", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_equal(example_fun(a = 2, b = 2), list(c = 4, d = 0))
expect_equal(matsindf_apply(FUN = example_fun, a = 2, b = 2),
list(c = 4, d = 0))
})
test_that("matsindf_apply() works as expected for single matrices", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
a <- matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a
c <- matsbyname::sum_byname(a, b)
d <- matsbyname::difference_byname(a, b)
expected_list <- list(c = c, d = d)
expect_equal(example_fun(a, b), expected_list)
expect_equal(matsindf_apply(FUN = example_fun, a = a, b = b),
expected_list)
})
test_that("matsindf_apply() works as expected for single Matrix objects", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b),
d = matsbyname::difference_byname(a, b)))
}
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a
c <- matsbyname::sum_byname(a, b)
d <- matsbyname::difference_byname(a, b)
expected_list <- list(c = a + b, d = a - b)
expect_equal(example_fun(a, b), expected_list)
expect_equal(matsindf_apply(FUN = example_fun, a = a, b = b), expected_list)
})
test_that("matsindf_apply() works as expected for lists of single values", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_equal(example_fun(a = list(2, 2), b = list(2, 2)), list(c = list(4, 4), d = list(0, 0)))
expect_equal(matsindf_apply(FUN = example_fun, a = list(2, 2, 2), b = list(2, 2, 2)),
data.frame(c = I(list(4, 4, 4)), d = I(list(0, 0, 0))),
ignore_attr = TRUE)
expect_equal(matsindf_apply(FUN = example_fun, a = list(2, 2), b = list(1, 2)),
data.frame(c = I(list(3, 4)), d = I(list(1, 0))),
ignore_attr = TRUE)
})
test_that("matsindf_apply() works as expected for lists of matrices", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
a <- matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a
c <- a + b
d <- a - b
a <- list(a, a)
b <- list(b, b)
list_expected <- list(c = list(c, c), d = list(d, d))
# Because DF_expected$c and DF_expected$d are created with I(list()), their class is "AsIs".
# Need to set the class of DF_expected$c and DF_expected$d to NULL to get a match.
attr(list_expected$c, which = "class") <- NULL
attr(list_expected$d, which = "class") <- NULL
expect_equal(matsindf_apply(FUN = example_fun, a = a, b = b),
list_expected)
})
test_that("matsindf_apply() works as expected for lists of Matrix objects", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")),
rowtype = "rows", coltype = "cols")
b <- a
c <- matsbyname::sum_byname(a, b)
d <- matsbyname::difference_byname(a, b)
a <- list(a, a)
b <- list(b, b)
list_expected <- list(c = list(c, c), d = list(d, d))
# Because DF_expected$c and DF_expected$d are created with I(list()), their class is "AsIs".
# Need to set the class of DF_expected$c and DF_expected$d to NULL to get a match.
attr(list_expected$c, which = "class") <- NULL
attr(list_expected$d, which = "class") <- NULL
expect_equal(matsindf_apply(FUN = example_fun, a = a, b = b),
list_expected)
})
test_that("matsindf_apply() works as expected using .dat with single numbers", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
DF <- tibble::tibble(a = c(4, 4, 5), b = c(4, 4, 4))
expect_equal(matsindf_apply(DF, FUN = example_fun, a = "a", b = "b"),
tibble::tibble(a = c(4, 4, 5), b = c(4, 4, 4), c = c(8, 8, 9), d = c(0, 0, 1)))
})
test_that("matsindf_apply() works as expected using .DF with matrices", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
a <- matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a
c <- a + b
d <- a - b
DF <- data.frame(a = I(list(a, a)), b = I(list(b,b)))
result <- matsindf_apply(DF, FUN = example_fun, a = "a", b = "b")
expected <- dplyr::bind_cols(DF, data.frame(c = I(list(c, c)), d = I(list(d, d))))
expect_equal(result, expected, ignore_attr = TRUE)
# Try with piped .DF argument
result <- DF |>
matsindf_apply(FUN = example_fun, a = "a", b = "b")
expect_equal(result, expected, ignore_attr = TRUE)
})
test_that("matsindf_apply() works as expected using .DF with Matrix objects", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")),
rowtype = "rows", coltype = "cols")
b <- a
c <- matsbyname::sum_byname(a, b)
d <- matsbyname::difference_byname(a, b)
DF <- data.frame(a = I(list(a, a)), b = I(list(b,b)), stringsAsFactors = FALSE)
result <- matsindf_apply(DF, FUN = example_fun, a = "a", b = "b")
expected <- dplyr::bind_cols(DF, data.frame(c = I(list(c, c)), d = I(list(d, d)), stringsAsFactors = FALSE))
expect_equal(result, expected, ignore_attr = TRUE)
# Try with piped .DF argument
result <- DF |>
matsindf_apply(FUN = example_fun, a = "a", b = "b")
expect_equal(result, expected, ignore_attr = TRUE)
})
test_that("matsindf_apply() works with .DF containing lists of Matrix objects, only some of which are named", {
# This is a failure mode for one set of calculations in the PFUAGgDatabase pipeline,
# namely when doing chops.
# See if we can reproduce the error here.
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")),
rowtype = "rows", coltype = "cols")
b <- a
c <- matsbyname::sum_byname(a, b)
d <- matsbyname::difference_byname(a, b)
DF <- data.frame(a = I(list(a, named_a = a)), b = I(list(b, named_b = b)), stringsAsFactors = FALSE)
result <- matsindf_apply(DF, FUN = example_fun, a = "a", b = "b")
expected <- dplyr::bind_cols(DF, data.frame(c = I(list(c, c)), d = I(list(d, d)), stringsAsFactors = FALSE))
expect_equal(result, expected, ignore_attr = TRUE)
})
test_that("matsindf_apply() fails as expected when not all same type for ...", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b),
d = matsbyname::difference_byname(a, b)))
}
matsindf_apply(FUN = example_fun, a = "a", b = 2) |>
expect_warning("In matsindf::matsindf_apply\\(\\), the following named arguments to FUN were not found in any of .dat, ..., or defaults to FUN: a") |>
expect_error('argument "a" is missing, with no default')
})
test_that("matsindf_apply() fails as expected when wrong type of data is sent in ...", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_error(matsindf_apply(FUN = example_fun, a = list("a"), b = list(2)), "non-numeric argument to binary operator")
})
test_that("matsindf_apply() fails gracefully when some of ... are NULL", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_error(matsindf_apply(FUN = example_fun, a = 1, b = 2, c = NULL),
"In matsindf::matsindf_apply\\(\\), the following unused arguments appeared in ...: c")
})
test_that("matsindf_apply() fails as expected when .DF argument is missing from a data frame", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
matsindf_apply(FUN = example_fun, a = "a", b = "b") |>
expect_warning("In matsindf::matsindf_apply\\(\\), the following named arguments to FUN were not found in any of .dat, ..., or defaults to FUN: a, b")
})
test_that("matsindf_apply() fails as expected when .DF argument is not a data frame or a list", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
matsindf_apply(.DF = "string", FUN = example_fun, a = "a", b = "b") |>
expect_warning("In matsindf::matsindf_apply\\(\\), the following named arguments to FUN were not found in any of .dat, ..., or defaults to FUN: a, b") |>
expect_error("In matsindf::matsindf_apply\\(\\), the following unused arguments appeared in ...: .DF")
})
test_that("matsindf_apply() works with a NULL argument", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
a <- matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a
c <- a + b
d <- a - b
DF <- data.frame(a = I(list(a, a)), b = I(list(b,b)))
# Here is where the NULL is given as an argument to matsindf_apply.
# This attempt fails, because z is an extra argument in ... .
expect_error(matsindf_apply(DF, FUN = example_fun, a = "a", b = "b", z = NULL),
"In matsindf::matsindf_apply\\(\\), the following unused arguments appeared in ...: z")
# Try with piped .dat argument
expect_error(matsindf_apply(DF, FUN = example_fun, a = "a", b = "b", z = NULL),
"In matsindf::matsindf_apply\\(\\), the following unused arguments appeared in ...: z")
})
test_that("matsindf_apply() works with a NULL argument and Matrix objects", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a
c <- matsbyname::sum_byname(a, b)
d <- matsbyname::difference_byname(a, b)
DF <- data.frame(a = I(list(a, a)), b = I(list(b,b)), stringsAsFactors = FALSE)
# Here is where the NULL is given as an argument to matsindp_apply.
# This attempt fails, because z is an extra argument in ... .
expect_error(matsindf_apply(DF, FUN = example_fun, a = "a", b = "b", z = NULL),
"In matsindf::matsindf_apply\\(\\), the following unused arguments appeared in ...: z")
# Try with piped .DF argument
expect_error(matsindf_apply(DF, FUN = example_fun, a = "a", b = "b", z = NULL),
"In matsindf::matsindf_apply\\(\\), the following unused arguments appeared in ...: z")
})
test_that("matsindf_apply() works when FUN returns NULL", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
df <- tibble::tibble(a = list(NULL, 20), b = list(NULL, 10))
res <- matsindf_apply(df, FUN = example_fun, a = "a", b = "b")
expect_equal(res, df |> dplyr::mutate(c = c(0, 30), d = c(0, 10)))
example_fun2 <- function(a, b) {
return(list(c = NULL, d = NULL))
}
df2 <- tibble::tibble(a = list(NULL, 20), b = list(NULL, 10))
res2 <- matsindf_apply(df2, FUN = example_fun2, a = "a", b = "b")
expect_equal(res2, df2 |> dplyr::mutate(c = list(NULL, NULL), d = list(NULL, NULL)))
})
test_that("matsindf_apply() works when all named arguments are NULL", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_equal(matsindf_apply(FUN = example_fun, a = NULL, b = NULL),
list(a = list(), b = list()))
})
test_that("matsindf_apply() works when .dat is a list", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b),
d = matsbyname::difference_byname(a, b)))
}
expect_equal(matsindf_apply(list(a = 1, b = 2), FUN = example_fun, a = "a", b = "b"),
list(a = 1, b = 2, c = 3, d = -1))
})
test_that("matsindf_apply() works when .dat supplies some or all argument names", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
# All arguments to FUN are supplied by named items in .dat (Case 11)
expect_equal(matsindf_apply(list(a = 1, b = 2), FUN = example_fun),
list(a = 1, b = 2, c = 3, d = -1))
# All arguments are supplied by named arguments in ... (Case 3)
expect_equal(matsindf_apply(list(a = 1, b = 2), FUN = example_fun, a = "a", b = "b"),
list(a = 1, b = 2, c = 3, d = -1))
# All arguments are supplied by named arguments in ..., but mix them up. (Case 3)
# Note that the named arguments override the items in .DF
expect_equal(matsindf_apply(list(a = 1, b = 2, z = 10), FUN = example_fun, a = "z", b = "b"),
list(a = 1, b = 2, z = 10, c = 12, d = 8))
# Try when one of the output names is same as an input name (Case 3)
expect_warning(res <- matsindf_apply(list(a = 1, b = 2, c = 10), FUN = example_fun, a = "c", b = "b"),
"Name collision in matsindf::matsindf_apply\\(\\). The following arguments appear both in .dat and in the output of `FUN`: c")
expect_equal(res, c(list(a = 1, b = 2, c = 10), list(c = 12, d = 8)))
})
test_that("matsindf_apply() works for single numbers in data frame columns", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
DF <- tibble::tibble(a = c(4, 4, 5), b = c(4, 4, 4))
expected <- DF
expected$c <- c(8, 8, 9)
expected$d <- c(0, 0, 1)
expect_equal(matsindf_apply(DF, FUN = example_fun, a = "a", b = "b"), expected)
expect_equal(matsindf_apply(DF, FUN = example_fun), expected)
})
test_that("override works() for single numbers supplied in a list", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_equal(matsindf_apply(list(a = 2, b = 1), FUN = example_fun, a = 10),
list(a = 10, b = 1, c = 11, d = 9))
})
test_that("matsindf_apply() works when an argument is missing", {
outer_fun <- function(.DF = NULL, a = "a", b = "b") {
inner_fun <- function(a_num, b_num = NULL) {
return(list(c = matsbyname::sum_byname(a_num, b_num),
d = matsbyname::difference_byname(a_num, b_num)))
}
matsindf_apply(.DF, FUN = inner_fun, a_num = a, b_num = b)
}
# Make sure it works when all arguments are present.
expect_equal(outer_fun(a = 2, b = 2), list(c = 4, d = 0))
# Now try when an argument is missing and the inner function can handle it.
expect_equal(outer_fun(a = 2), list(c = 2, d = 2))
# Try when an argument is missing and the inner function can't handle it.
outer_fun(b = 2) |>
expect_warning("In matsindf::matsindf_apply\\(\\), the following named arguments to FUN were not found in any of .dat, ..., or defaults to FUN: a_num") |>
expect_error('argument "a_num" is missing, with no default')
})
test_that("matsindf_apply() works with functions similar in form to those in `Recca`", {
# This function is similar in form to functions in `Recca`.
find_matching_rownames <- function(.DF = NULL,
prefixes,
m = "m",
out_colname = "matching_rows") {
rowmatch_fun <- function(prefixes_arg, m_arg) {
out <- m_arg %>%
matsbyname::select_rows_byname(retain_pattern =
RCLabels::make_or_pattern(strings = prefixes_arg, pattern_type = "leading")) |>
matsbyname::getrownames_byname()
# If we don't have a list, make a list.
if (!is.list(out)) {
out <- list(out)
}
# At this point, we already have a list.
# All that remains is to set the name of the list.
out %>%
magrittr::set_names(out_colname)
}
matsindf_apply(.DF,
FUN = rowmatch_fun,
prefixes_arg = prefixes,
m_arg = m)
}
# Set up a matrix
mat <- matrix(c(0, 1,
2, 3,
4, 5), nrow = 3, ncol = 2, byrow = TRUE, dimnames = list(c("ra1", "ra2", "b3"), c("c1", "c2")))
expect_equal(find_matching_rownames(prefixes = list("ra"), m = mat),
list(matching_rows = c("ra1", "ra2")))
# Now make lists and try again. This works fine.
res2 <- find_matching_rownames(prefixes = list("ra"), m = list(mat))
expect_type(res2, type = "list")
expect_equal(res2[["matching_rows"]][[1]], "ra1")
expect_equal(res2[["matching_rows"]][[2]], "ra2")
# Use with lists and 2 items in each list.
res3 <- find_matching_rownames(prefixes = list("ra", "ra"), m = list(mat, mat))
expect_type(res3, type = "list")
expect_equal(res3[["matching_rows"]][[1]], c("ra1", "ra2"))
expect_equal(res3[["matching_rows"]][[2]], c("ra1", "ra2"))
expect_equal(length(res3), 1)
# Try in a data frame.
df <- tibble::tibble(prefixes = list("ra", c("r", "b"), "b"), m = list(mat, mat, mat)) |>
find_matching_rownames(prefixes = "prefixes")
expect_equal(df$matching_rows[[1]], c("ra1", "ra2"))
expect_equal(df$matching_rows[[2]], c("ra1", "ra2", "b3"))
expect_equal(df$matching_rows[[3]], "b3")
})
test_that("matsindf_apply() works with functions similar in form to those in `Recca` with Matrix objects", {
# This function is similar in form to functions in `Recca`.
find_matching_rownames <- function(.DF = NULL,
prefixes,
m = "m",
out_colname = "matching_rows") {
rowmatch_fun <- function(prefixes_arg, m_arg) {
out <- m_arg %>%
matsbyname::select_rows_byname(retain_pattern =
RCLabels::make_or_pattern(strings = prefixes_arg, pattern_type = "leading")) %>%
matsbyname::getrownames_byname()
# If we don't have a list, make a list.
if (!is.list(out)) {
out <- list(out)
}
# At this point, we already have a list.
# All that remains is to set the name of the list.
out %>%
magrittr::set_names(out_colname)
}
matsindf_apply(.DF,
FUN = rowmatch_fun,
prefixes_arg = prefixes,
m_arg = m)
}
# Set up a matrix
mat <- matsbyname::Matrix(c(0, 1,
2, 3,
4, 5), nrow = 3, ncol = 2, byrow = TRUE, dimnames = list(c("ra1", "ra2", "b3"), c("c1", "c2")))
# This fails, because we go into find_matching_rownames without the string prefixes_arg argument.
expect_equal(find_matching_rownames(prefixes = list("ra"), m = mat),
list(matching_rows = c("ra1", "ra2")))
res2 <- find_matching_rownames(prefixes = list("ra"), m = list(mat))
expect_type(res2, type = "list")
expect_equal(res2[["matching_rows"]][[1]], "ra1")
expect_equal(res2[["matching_rows"]][[2]], "ra2")
# Use with lists and 2 items in each list. (Case 15)
res3 <- find_matching_rownames(prefixes = list("ra", "ra"), m = list(mat, mat))
expect_type(res3, type = "list")
expect_equal(res3[["matching_rows"]][[1]], c("ra1", "ra2"))
expect_equal(res3[["matching_rows"]][[2]], c("ra1", "ra2"))
expect_equal(length(res3), 1)
# Try in a data frame. (Case 13)
df <- tibble::tibble(prefixes = list("ra", c("r", "b"), "b"), m = list(mat, mat, mat)) |>
find_matching_rownames(prefixes = "prefixes")
expect_equal(df$matching_rows[[1]], c("ra1", "ra2"))
expect_equal(df$matching_rows[[2]], c("ra1", "ra2", "b3"))
expect_equal(df$matching_rows[[3]], "b3")
})
test_that("matsindf_apply() issues a warning when replacing a column", {
# Create a data frame with a matrix in a column.
a <- matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- 2 * a
DF <- data.frame(a = I(list(a, a)), b = I(list(b, b)), stringsAsFactors = FALSE)
replace_func <- function(a_mat, b_mat) {
a <- matsbyname::difference_byname(a_mat, b_mat)
d <- matsbyname::sum_byname(a_mat, b_mat)
list(a, d) %>%
magrittr::set_names(c(a_name, d_name))
}
a_name <- "a"
d_name <- "d"
expect_warning(
suppressMessages(
# The next call gives a warning but also a "New names:" message.
# The message clutters the output of the tests,
# so suppress it.
# We already know of the problem and are testing for it, anyway.
matsindf_apply(DF, FUN = replace_func, a_mat = "a", b_mat = "b")
),
"Name collision in matsindf::matsindf_apply\\(\\). The following arguments appear both in .dat and in the output of `FUN`: a"
)
})
test_that("matsindf_apply() issues a warning when replacing a column with Matrix objects", {
# Create a data frame with a matrix in a column.
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- matsbyname::hadamardproduct_byname(2, a)
DF <- data.frame(a = I(list(a, a)), b = I(list(b, b)), stringsAsFactors = FALSE)
replace_func <- function(a_mat, b_mat) {
a <- matsbyname::difference_byname(a_mat, b_mat)
d <- matsbyname::sum_byname(a_mat, b_mat)
list(a, d) %>%
magrittr::set_names(c(a_name, d_name))
}
a_name <- "a"
d_name <- "d"
expect_warning(
suppressMessages(
# The next call gives a warning but also a "New names:" message.
# The message clutters the output of the tests,
# so suppress it.
# We already know of the problem and are testing for it, anyway.
matsindf_apply(DF, FUN = replace_func, a_mat = "a", b_mat = "b")
),
"Name collision in matsindf::matsindf_apply\\(\\). The following arguments appear both in .dat and in the output of `FUN`: a"
)
})
test_that("matsindf_apply() works for a string and numbers", {
example_fun <- function(str_a, b) {
a <- as.numeric(str_a)
list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b))
}
res <- matsindf_apply(FUN = example_fun, str_a = list("1"), b = list(2))
expect_equal(res$c[[1]], 3)
expect_equal(res$d[[1]], -1)
})
test_that("matsindf_apply() works as desired in degenerate case", {
sum_fun <- function(a, b) {
paste0(a, b) |>
magrittr::set_names("term")
}
expected <- list(term = list("string142", "string243"))
expect_equal(
matsindf_apply(FUN = sum_fun, a = c("string1", "string2"), b = list("42", "43")),
expected
)
})
test_that("matsindf_apply() works as desired with zero-row data frames", {
example_fun <- function(a_var, b_var) {
return(list(c = matsbyname::sum_byname(a_var, b_var),
d = matsbyname::difference_byname(a_var, b_var)))
}
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a + 1
# Make a data frame
df <- tibble::tribble(~acol, ~bcol,
a, b,
a, b)
expected_df <- df |>
dplyr::mutate(
c = matsbyname::sum_byname(acol, bcol),
d = matsbyname::difference_byname(acol, bcol)
)
res <- matsindf_apply(df, FUN = example_fun, a_var = "acol", b_var = "bcol")
expect_equal(res, expected_df)
# Now try with no rows in df
dfzero <- df[0, ]
res <- matsindf_apply(dfzero, FUN = example_fun, a_var = "acol", b_var = "bcol")
# Should return the input data frame unmodified.
expect_equal(res, dfzero)
})
test_that("matsindf_apply() works as desired with zero-length lists and matrix objects", {
example_fun <- function(a_var, b_var) {
return(list(c = matsbyname::sum_byname(a_var, b_var),
d = matsbyname::difference_byname(a_var, b_var)))
}
a <- matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a + 1
c <- a + b
d <- a - b
expected_list <- list(c = list(c, c), d = list(d, d))
res <- matsindf_apply(FUN = example_fun, a_var = list(a, a), b_var = list(b, b))
expect_equal(res, expected_list)
# Now try with zero-length lists
res_zero <- matsindf_apply(FUN = example_fun, a_var = list(), b_var = list())
expect_equal(res_zero, list(a_var = list(), b_var = list()))
})
test_that("matsindf_apply() works as desired with zero-length lists and Matrix objects", {
example_fun <- function(a_var, b_var) {
return(list(c = matsbyname::sum_byname(a_var, b_var),
d = matsbyname::difference_byname(a_var, b_var)))
}
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a + 1
c <- a + b
d <- a - b
expected_list <- list(c = list(c, c), d = list(d, d))
res <- matsindf_apply(FUN = example_fun, a_var = list(a, a), b_var = list(b, b))
expect_equal(res, expected_list)
# Now try with zero-length lists
res_zero <- matsindf_apply(FUN = example_fun, a_var = list(), b_var = list())
expect_equal(res_zero, list(a_var = list(), b_var = list()))
})
test_that("matsindf_apply() works with empty lists", {
example_fun <- function(a_var, b_var) {
return(list(c = matsbyname::sum_byname(a_var, b_var),
d = matsbyname::difference_byname(a_var, b_var)))
}
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a + 1
a_list <- list(a = a)
b_list <- list(b = b)
a_list_0 <- a_list[0]
b_list_0 <- b_list[0]
# Try with zero-length lists (Case 5)
res_zero <- matsindf_apply(FUN = example_fun, a_var = a_list_0, b_var = b_list_0)
expect_equal(res_zero, list(a_var = a_list[0], b_var = b_list[0]))
# Try with a zero-length variable store (Case 15)
var_store <- list(a_var = a_list_0, b_var = b_list_0)
res_zero_2 <- matsindf_apply(var_store, FUN = example_fun)
expect_equal(res_zero_2, list(a_var = a_list[0], b_var = b_list[0]))
})
test_that("matsindf_apply() works with a no-argument function", {
example_fun <- function() {42}
expect_equal(matsindf_apply(FUN = example_fun), 42)
})
test_that("matsindf_apply_types() works as expected", {
example_fun <- function(a, b) {
c(a, b)
}
matsindf_apply_types(.dat = NULL, FUN = example_fun) |>
expect_warning("In matsindf::matsindf_apply\\(\\), the following named arguments to FUN were not found in any of .dat, ..., or defaults to FUN: a, b")
# Set the warning flag to FALSE to suppress the warning
no_warn <- matsindf_apply_types(.dat = NULL, FUN = example_fun, .warn_missing_FUN_args = FALSE)
expect_equal(no_warn$keep_args, list(.dat = NULL, FUN = NULL, dots = NULL))
matsindf_apply_types(.dat = NULL, FUN = example_fun, a = 1, b = 2) |>
expect_equal(list(.dat_null = TRUE, .dat_df = FALSE, .dat_list = FALSE, .dat_names = NULL,
FUN_arg_all_names = c("a", "b"),
FUN_arg_default_names = NULL,
FUN_arg_default_values = NULL,
dots_present = TRUE, all_dots_num = TRUE, all_dots_mats = FALSE, all_dots_list = FALSE,
all_dots_vect = TRUE, all_dots_char = FALSE, all_dots_longer_than_1 = FALSE,
dots_names = c("a", "b"),
keep_args = list(.dat = NULL,
FUN = NULL,
dots = c(a = "a", b = "b"))))
matsindf_apply_types(.dat = data.frame(a = 42), FUN = example_fun,
a = matrix(c(1, 2)), b = matrix(c(2, 3))) |>
expect_equal(list(.dat_null = FALSE, .dat_df = TRUE, .dat_list = TRUE, .dat_names = "a",
FUN_arg_all_names = c("a", "b"),
FUN_arg_default_names = NULL,
FUN_arg_default_values = NULL,
dots_present = TRUE, all_dots_num = FALSE, all_dots_mats = TRUE, all_dots_list = FALSE,
all_dots_vect = FALSE, all_dots_char = FALSE, all_dots_longer_than_1 = FALSE,
dots_names = c("a", "b"),
keep_args = list(.dat = NULL,
FUN = NULL,
dots = c(a = "a", b = "b"))))
matsindf_apply_types(.dat = list(a = 1, b = 2), FUN = example_fun,
a = list(1, 2), b = list(3, 4)) |>
expect_equal(list(.dat_null = FALSE, .dat_df = FALSE, .dat_list = TRUE, .dat_names = c("a", "b"),
FUN_arg_all_names = c("a", "b"),
FUN_arg_default_names = NULL,
FUN_arg_default_values = NULL,
dots_present = TRUE, all_dots_num = FALSE, all_dots_mats = FALSE, all_dots_list = TRUE,
all_dots_vect = TRUE, all_dots_char = FALSE, all_dots_longer_than_1 = TRUE,
dots_names = c("a", "b"),
keep_args = list(.dat = NULL,
FUN = NULL,
dots = c(a = "a", b = "b"))))
matsindf_apply_types(.dat = NULL, FUN = example_fun, a = "a", b = "b") |>
expect_warning("In matsindf::matsindf_apply\\(\\), the following named arguments to FUN were not found in any of .dat, ..., or defaults to FUN: a, b")
# Try with Matrix objects
matsindf_apply_types(.dat = NULL, FUN = example_fun,
a = matsbyname::Matrix(c(1, 2)), b = matsbyname::Matrix(c(2, 3))) |>
expect_equal(list(.dat_null = TRUE, .dat_df = FALSE, .dat_list = FALSE, .dat_names = NULL,
FUN_arg_all_names = c("a", "b"),
FUN_arg_default_names = NULL,
FUN_arg_default_values = NULL,
dots_present = TRUE, all_dots_num = FALSE, all_dots_mats = TRUE, all_dots_list = FALSE,
all_dots_vect = FALSE, all_dots_char = FALSE, all_dots_longer_than_1 = FALSE,
dots_names = c("a", "b"),
keep_args = list(.dat = NULL,
FUN = NULL,
dots = c(a = "a", b = "b"))))
# Try with data coming from one but not the other source.
matsindf_apply_types(.dat = data.frame(a = 42), FUN = example_fun,
b = matrix(c(2, 3))) |>
expect_equal(list(.dat_null = FALSE, .dat_df = TRUE, .dat_list = TRUE, .dat_names = "a",
FUN_arg_all_names = c("a", "b"),
FUN_arg_default_names = NULL,
FUN_arg_default_values = NULL,
dots_present = TRUE, all_dots_num = FALSE, all_dots_mats = TRUE, all_dots_list = FALSE,
all_dots_vect = FALSE, all_dots_char = FALSE, all_dots_longer_than_1 = FALSE,
dots_names = "b",
keep_args = list(.dat = c(a = "a"),
FUN = NULL,
dots = c(b = "b"))))
})
test_that("matsindf_apply_types() works with functions that have default values", {
example_fun <- function(a = 2, b, c = "string") {
list(a = a, b = b, c = c)
}
expect_equal(matsindf_apply_types(.dat = NULL, FUN = example_fun,
a = 1, b = 2),
list(.dat_null = TRUE, .dat_df = FALSE, .dat_list = FALSE, .dat_names = NULL,
FUN_arg_all_names = c("a", "b", "c"),
FUN_arg_default_names = c("a", "c"),
FUN_arg_default_values = list(a = 2, c = "string"),
dots_present = TRUE, all_dots_num = TRUE, all_dots_mats = FALSE, all_dots_list = FALSE,
all_dots_vect = TRUE, all_dots_char = FALSE, all_dots_longer_than_1 = FALSE,
dots_names = c("a", "b"),
keep_args = list(.dat = NULL,
FUN = c(c = "c"),
dots = c(a = "a", b = "b"))))
})
test_that("matsindf_apply_types() works with a degenerate case with simple FUN and no parameters", {
example_fun <- function() {42}
expect_equal(matsindf_apply_types(FUN = example_fun),
list(.dat_null = TRUE, .dat_df = FALSE, .dat_list = FALSE, .dat_names = NULL,
FUN_arg_all_names = NULL,
FUN_arg_default_names = NULL,
FUN_arg_default_values = NULL,
dots_present = FALSE, all_dots_num = FALSE, all_dots_mats = FALSE, all_dots_list = FALSE,
all_dots_vect = FALSE, all_dots_char = FALSE, all_dots_longer_than_1 = FALSE,
dots_names = NULL,
keep_args = list(.dat = NULL,
FUN = NULL,
dots = NULL)))
})
test_that("matsindf_apply_types() works for examples", {
identity_fun <- function(a, b) {list(a = a, b = b)}
types <- matsindf_apply_types(.dat = data.frame(), FUN = identity_fun,
a = matrix(c(1, 2)), b = matrix(c(2, 3)))
expect_null(types$keep_args$.dat)
})
test_that("build_matsindf_apply_data_frame() works as expected", {
example_fun <- function(a_var, b_var = c(42, 43)) {
c(a_var, b_var)
}
DF <- tibble::tribble(~a, ~b, ~z,
1, 2, 3,
4, 5, NULL)
expected_df <- DF |>
dplyr::select("a", "b") |>
dplyr::rename(
a_var = "a", b_var = "b"
)
res_df <- build_matsindf_apply_data_frame(.dat = DF, FUN = example_fun, a_var = "a", b_var = "b")
expect_equal(names(res_df), c("a_var", "b_var"))
expect_equal(res_df, expected_df)
DF_2 <- DF |>
dplyr::select(-b)
expected_df_2 <- DF |>
dplyr::mutate(
b_var = c(42, 43),
b = NULL) |>
dplyr::rename(a_var = "a") |>
dplyr::select(a_var, b_var)
res_df_2 <- build_matsindf_apply_data_frame(.dat = DF_2, FUN = example_fun, a_var = "a")
expect_equal(res_df_2, expected_df_2)
})
test_that("build_matsindf_apply_data_frame() works with NULL args in ...", {
example_fun <- function(R_mat, U_mat) {
return(matsbyname::sum_byname(R_mat, matsbyname::transpose_byname(U_mat)))
}
expected <- tibble::tribble(~R_mat, ~U_mat,
NULL, matrix(c(42, 43)))
res <- build_matsindf_apply_data_frame(FUN = example_fun, R_mat = NULL, U_mat = matrix(c(42, 43)))
expect_equal(res, expected)
})
test_that("matsindf_apply() works when FUN can handle zero-row DF's", {
example_fun <- function(a, b) {
if (length(a) == 0 & length(b) == 0) {
return(list(c = numeric(), d = numeric()))
}
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_equal(example_fun(a = 2, b = 2), list(c = 4, d = 0))
expect_equal(matsindf_apply(FUN = example_fun, a = 2, b = 2), list(c = 4, d = 0))
expect_equal(matsindf_apply(list(a = 2, b = 2), FUN = example_fun), list(a = 2, b = 2, c = 4, d = 0))
df <- data.frame(a = 2, b = 2)
df_expected <- tibble::tibble(a = 2, b = 2, c = 4, d = 0)
expect_equal(matsindf_apply(df, example_fun), df_expected)
dfzero <- df[0, ]
dfzero_expected <- df_expected[0, ]
expect_equal(matsindf_apply(dfzero, example_fun), dfzero_expected)
})
test_that("matsindf_apply() works when FUN can handle zero-length lists", {
example_fun <- function(a, b) {
if (length(a) == 0 & length(b) == 0) {
return(list(c = numeric(), d = numeric()))
}
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_equal(matsindf_apply(FUN = example_fun, a = numeric(), b = numeric()),
list(c = numeric(), d = numeric()))
input <- list(a = numeric(), b = numeric())
output_expected <- list(a = numeric(), b = numeric(), c = numeric(), d = numeric())
expect_equal(matsindf_apply(input, example_fun), output_expected)
})
test_that("matsindf_apply() works for an edge case", {
# This example comes from the matsindf_apply primer.
calc_W <- function(.DF = NULL, U = "U", V = "V", W = "W") {
# The inner function does all the work.
W_func <- function(U_mat, V_mat){
# When we get here, U_mat and V_mat will be single matrices or single numbers,
# not a column in a data frame or an item in a list.
if (length(U_mat) == 0 & length(V_mat == 0)) {
# Tolerate zero-length arguments by returning a zero-length
# a list with the correct name and return type.
return(list(numeric()) |> magrittr::setnames(W))
}
# Calculate W_mat from the inputs U_mat and V_mat.
W_mat <- matsbyname::difference_byname(matsbyname::transpose_byname(V_mat), U_mat)
# Return a named list.
list(W_mat) |> magrittr::set_names(W)
}
# The body of the main function consists of a call to matsindf_apply
# that specifies the inner function in the FUN argument.
matsindf_apply(.DF, FUN = W_func, U_mat = U, V_mat = V)
}
expect_equal(calc_W(list(U = c(2, 2, 2, 2), V = c(3, 4, 5, 6))),
list(U = c(2, 2, 2, 2), V = c(3, 4, 5, 6), W = c(1, 2, 3, 4)))
})
test_that("should_unlist() works as expected", {
DF <- tibble::tibble(a = list(1, 2, 3), b = c("a", "b", "c"),
c = list(matrix(c(42, 43)),
matrix(c(44, 45)),
matrix(c(46, 47))))
expect_true(matsindf:::should_unlist(DF$a))
expect_false(matsindf:::should_unlist(DF$b))
expect_false(matsindf:::should_unlist(DF$c))
expect_equal(sapply(DF, FUN = function(this_col) {matsindf:::should_unlist(this_col)}),
c(a = TRUE, b = FALSE, c = FALSE))
expect_equal(matsindf:::should_unlist(DF),
c(a = TRUE, b = FALSE, c = FALSE))
})
test_that("should_unlist() correctly says 'FALSE' for a list of NULL items", {
# Unlist when length is 1
expect_true(matsindf:::should_unlist(list(NULL)))
# Do not unlist when the length is > 1
expect_false(matsindf:::should_unlist(list(NULL, NULL, NULL)))
})
test_that("should_unlist() correctly says 'FALSE' for a list of data frames", {
my_col <- list(data.frame(a = 42), tibble::tibble(b = 43) )
expect_false(matsindf:::should_unlist(my_col))
})
test_that("matsindf_apply() works for missing arg in .dat", {
example_fun <- function(a_val = 2, b_val = 1) {
list(c = matsbyname::sum_byname(a_val, b_val),
d = matsbyname::difference_byname(a_val, b_val))
}
# Try when everything is available.
df <- tibble::tibble(a = c(10, 11, 12), b = c(5, 6, 7))
expected_df <- dplyr::bind_cols(df, data.frame(c = c(15, 17, 19), d = c(5, 5, 5)))
res <- df |>
matsindf_apply(FUN = example_fun, a_val = "a", b_val = "b")
expect_equal(res, expected_df)
# Try when df lacks a column.
# matsindf_apply() should use the default value in the signature of example_fun.
# But as of 4 April 2023, it does not.
# This test exposes that bug.
res <- df |>
dplyr::select("a") |>
matsindf_apply(FUN = example_fun, a_val = "a")
expect_equal(res, tibble::tribble(~a, ~c, ~d,
10, 11, 9,
11, 12, 10,
12, 13, 11))
})
test_that("where_to_get_args() works as intended", {
example_fun <- function(a = 1, b) {
list(c = a + b, d = a - b)
}
matsindf:::where_to_get_args(FUN = example_fun) |>
expect_equal(list(a = c(source = "FUN", arg_name = "a"),
b = NULL))
matsindf:::where_to_get_args(FUN = example_fun, b = 2) |>
expect_equal(list(a = c(source = "FUN", arg_name = "a"),
b = c(source = "...", arg_name = "b")))
matsindf:::where_to_get_args(list(a = 2), FUN = example_fun, b = 2) |>
expect_equal(list(a = c(source = ".dat", arg_name = "a"),
b = c(source = "...", arg_name = "b")))
matsindf:::where_to_get_args(list(a = 2, b = 2), FUN = example_fun) |>
expect_equal(list(a = c(source = ".dat", arg_name = "a"),
b = c(source = ".dat", arg_name = "b")))
# Map to self
matsindf:::where_to_get_args(list(a = 2, b = 2, c = 2), FUN = example_fun, a = "a", b = "b") |>
expect_equal(list(a = c(source = ".dat", arg_name = "a"),
b = c(source = ".dat", arg_name = "b")))
# Check redirection
matsindf:::where_to_get_args(list(a = 2, b = 2, c = 2), FUN = example_fun, b = "c") |>
expect_equal(list(a = c(source = ".dat", arg_name = "a"),
b = c(source = ".dat", arg_name = "c")))
# Leave an argument out
matsindf:::where_to_get_args(list(a = 2), FUN = example_fun) |>
expect_equal(list(a = c(source = ".dat", arg_name = "a"),
b = NULL))
# Try redirecting to an item that doesn't exist in .dat
matsindf:::where_to_get_args(list(a = 2, b = 2, c = 2), FUN = example_fun, b = "d") |>
expect_equal(list(a = c(source = ".dat", arg_name = "a"),
b = NULL))
# In this case a comes from .dat and b comes from .dat as well.
matsindf:::where_to_get_args(list(a = 2, c = 2), FUN = example_fun, b = "a") |>
expect_equal(list(a = c(source = ".dat", arg_name = "a"),
b = c(source = ".dat", arg_name = "a")))
# In this case, both a and b should be found in defaults to FUN.
matsindf:::where_to_get_args(list(c = 2), FUN = example_fun, b = "a") |>
expect_equal(list(a = c(source = "FUN", arg_name = "a"),
b = c(source = "FUN", arg_name = "a")))
# In this case, both a and b should be found in .dat.
matsindf:::where_to_get_args(list(a = 2, c = 2), FUN = example_fun, b = "a") |>
expect_equal(list(a = c(source = ".dat", arg_name = "a"),
b = c(source = ".dat", arg_name = "a")))
# Cross the mappings
matsindf:::where_to_get_args(list(a = 2, b = 2), FUN = example_fun, a = "b", b = "a") |>
expect_equal(list(a = c(source = ".dat", arg_name = "b"),
b = c(source = ".dat", arg_name = "a")))
})
test_that("matsindf_apply() handles different lengths correctly (i.e., with an error)", {
example_fun <- function(a = 1, b) {
list(c = a + b, d = a - b)
}
expect_error(matsindf_apply(FUN = example_fun, a = c(1, 2, 3), b = c(4, 5)),
"Different lengths in handle_null_args\\(\\)")
})
test_that("matsindf_apply() correctly handles NULL default args on FUN", {
example_fun <- function(a = 1, b = NULL) {
list(c = a, d = b)
}
expect_equal(matsindf:::where_to_get_args(list(a = 1), FUN = example_fun),
list(a = c(source = ".dat", arg_name = "a"), b = c(source = "FUN", arg_name = "b")))
expect_equal(matsindf_apply(list(a = 1), FUN = example_fun),
list(a = 1, b = NULL, c = 1, d = NULL))
})
test_that("matsindf_apply() works correctly for a list of matrices each with length 1", {
example_fun <- function(a, b) {
list(c = matsbyname::sum_byname(a, b),
d = matsbyname::difference_byname(a, b))
}
m <- matrix(c(1, 2,
3, 4), nrow = 2, ncol = 2, byrow = TRUE)
my_mat_list <- list(a = m, b = m+1)
expected_c <- my_mat_list$a + my_mat_list$b
expected_d <- my_mat_list$a - my_mat_list$b
expect_equal(matsindf_apply(my_mat_list, example_fun),
list(a = list(my_mat_list$a), b = list(my_mat_list$b), c = expected_c, d = expected_d))
expect_equal(matsindf_apply(FUN = example_fun, a = m, b = m+1),
list(c = expected_c, d = expected_d))
})
Try the matsindf package in your browser
Any scripts or data that you put into this service are public.
matsindf documentation built on July 4, 2024, 1:11 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
test_that("matsindf_apply() fails with an unexpected argument", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_error(matsindf_apply(.dat = "a string", FUN = example_fun, a = 2, b = 2),
".dat must be NULL, a data frame, or a list in matsindf_apply\\(\\), was character")
})
test_that("matsindf_apply() works as expected for single values", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_equal(example_fun(a = 2, b = 2), list(c = 4, d = 0))
expect_equal(matsindf_apply(FUN = example_fun, a = 2, b = 2),
list(c = 4, d = 0))
})
test_that("matsindf_apply() works as expected for single matrices", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
a <- matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a
c <- matsbyname::sum_byname(a, b)
d <- matsbyname::difference_byname(a, b)
expected_list <- list(c = c, d = d)
expect_equal(example_fun(a, b), expected_list)
expect_equal(matsindf_apply(FUN = example_fun, a = a, b = b),
expected_list)
})
test_that("matsindf_apply() works as expected for single Matrix objects", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b),
d = matsbyname::difference_byname(a, b)))
}
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a
c <- matsbyname::sum_byname(a, b)
d <- matsbyname::difference_byname(a, b)
expected_list <- list(c = a + b, d = a - b)
expect_equal(example_fun(a, b), expected_list)
expect_equal(matsindf_apply(FUN = example_fun, a = a, b = b), expected_list)
})
test_that("matsindf_apply() works as expected for lists of single values", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_equal(example_fun(a = list(2, 2), b = list(2, 2)), list(c = list(4, 4), d = list(0, 0)))
expect_equal(matsindf_apply(FUN = example_fun, a = list(2, 2, 2), b = list(2, 2, 2)),
data.frame(c = I(list(4, 4, 4)), d = I(list(0, 0, 0))),
ignore_attr = TRUE)
expect_equal(matsindf_apply(FUN = example_fun, a = list(2, 2), b = list(1, 2)),
data.frame(c = I(list(3, 4)), d = I(list(1, 0))),
ignore_attr = TRUE)
})
test_that("matsindf_apply() works as expected for lists of matrices", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
a <- matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a
c <- a + b
d <- a - b
a <- list(a, a)
b <- list(b, b)
list_expected <- list(c = list(c, c), d = list(d, d))
# Because DF_expected$c and DF_expected$d are created with I(list()), their class is "AsIs".
# Need to set the class of DF_expected$c and DF_expected$d to NULL to get a match.
attr(list_expected$c, which = "class") <- NULL
attr(list_expected$d, which = "class") <- NULL
expect_equal(matsindf_apply(FUN = example_fun, a = a, b = b),
list_expected)
})
test_that("matsindf_apply() works as expected for lists of Matrix objects", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")),
rowtype = "rows", coltype = "cols")
b <- a
c <- matsbyname::sum_byname(a, b)
d <- matsbyname::difference_byname(a, b)
a <- list(a, a)
b <- list(b, b)
list_expected <- list(c = list(c, c), d = list(d, d))
# Because DF_expected$c and DF_expected$d are created with I(list()), their class is "AsIs".
# Need to set the class of DF_expected$c and DF_expected$d to NULL to get a match.
attr(list_expected$c, which = "class") <- NULL
attr(list_expected$d, which = "class") <- NULL
expect_equal(matsindf_apply(FUN = example_fun, a = a, b = b),
list_expected)
})
test_that("matsindf_apply() works as expected using .dat with single numbers", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
DF <- tibble::tibble(a = c(4, 4, 5), b = c(4, 4, 4))
expect_equal(matsindf_apply(DF, FUN = example_fun, a = "a", b = "b"),
tibble::tibble(a = c(4, 4, 5), b = c(4, 4, 4), c = c(8, 8, 9), d = c(0, 0, 1)))
})
test_that("matsindf_apply() works as expected using .DF with matrices", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
a <- matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a
c <- a + b
d <- a - b
DF <- data.frame(a = I(list(a, a)), b = I(list(b,b)))
result <- matsindf_apply(DF, FUN = example_fun, a = "a", b = "b")
expected <- dplyr::bind_cols(DF, data.frame(c = I(list(c, c)), d = I(list(d, d))))
expect_equal(result, expected, ignore_attr = TRUE)
# Try with piped .DF argument
result <- DF |>
matsindf_apply(FUN = example_fun, a = "a", b = "b")
expect_equal(result, expected, ignore_attr = TRUE)
})
test_that("matsindf_apply() works as expected using .DF with Matrix objects", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")),
rowtype = "rows", coltype = "cols")
b <- a
c <- matsbyname::sum_byname(a, b)
d <- matsbyname::difference_byname(a, b)
DF <- data.frame(a = I(list(a, a)), b = I(list(b,b)), stringsAsFactors = FALSE)
result <- matsindf_apply(DF, FUN = example_fun, a = "a", b = "b")
expected <- dplyr::bind_cols(DF, data.frame(c = I(list(c, c)), d = I(list(d, d)), stringsAsFactors = FALSE))
expect_equal(result, expected, ignore_attr = TRUE)
# Try with piped .DF argument
result <- DF |>
matsindf_apply(FUN = example_fun, a = "a", b = "b")
expect_equal(result, expected, ignore_attr = TRUE)
})
test_that("matsindf_apply() works with .DF containing lists of Matrix objects, only some of which are named", {
# This is a failure mode for one set of calculations in the PFUAGgDatabase pipeline,
# namely when doing chops.
# See if we can reproduce the error here.
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")),
rowtype = "rows", coltype = "cols")
b <- a
c <- matsbyname::sum_byname(a, b)
d <- matsbyname::difference_byname(a, b)
DF <- data.frame(a = I(list(a, named_a = a)), b = I(list(b, named_b = b)), stringsAsFactors = FALSE)
result <- matsindf_apply(DF, FUN = example_fun, a = "a", b = "b")
expected <- dplyr::bind_cols(DF, data.frame(c = I(list(c, c)), d = I(list(d, d)), stringsAsFactors = FALSE))
expect_equal(result, expected, ignore_attr = TRUE)
})
test_that("matsindf_apply() fails as expected when not all same type for ...", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b),
d = matsbyname::difference_byname(a, b)))
}
matsindf_apply(FUN = example_fun, a = "a", b = 2) |>
expect_warning("In matsindf::matsindf_apply\\(\\), the following named arguments to FUN were not found in any of .dat, ..., or defaults to FUN: a") |>
expect_error('argument "a" is missing, with no default')
})
test_that("matsindf_apply() fails as expected when wrong type of data is sent in ...", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_error(matsindf_apply(FUN = example_fun, a = list("a"), b = list(2)), "non-numeric argument to binary operator")
})
test_that("matsindf_apply() fails gracefully when some of ... are NULL", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_error(matsindf_apply(FUN = example_fun, a = 1, b = 2, c = NULL),
"In matsindf::matsindf_apply\\(\\), the following unused arguments appeared in ...: c")
})
test_that("matsindf_apply() fails as expected when .DF argument is missing from a data frame", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
matsindf_apply(FUN = example_fun, a = "a", b = "b") |>
expect_warning("In matsindf::matsindf_apply\\(\\), the following named arguments to FUN were not found in any of .dat, ..., or defaults to FUN: a, b")
})
test_that("matsindf_apply() fails as expected when .DF argument is not a data frame or a list", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
matsindf_apply(.DF = "string", FUN = example_fun, a = "a", b = "b") |>
expect_warning("In matsindf::matsindf_apply\\(\\), the following named arguments to FUN were not found in any of .dat, ..., or defaults to FUN: a, b") |>
expect_error("In matsindf::matsindf_apply\\(\\), the following unused arguments appeared in ...: .DF")
})
test_that("matsindf_apply() works with a NULL argument", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
a <- matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a
c <- a + b
d <- a - b
DF <- data.frame(a = I(list(a, a)), b = I(list(b,b)))
# Here is where the NULL is given as an argument to matsindf_apply.
# This attempt fails, because z is an extra argument in ... .
expect_error(matsindf_apply(DF, FUN = example_fun, a = "a", b = "b", z = NULL),
"In matsindf::matsindf_apply\\(\\), the following unused arguments appeared in ...: z")
# Try with piped .dat argument
expect_error(matsindf_apply(DF, FUN = example_fun, a = "a", b = "b", z = NULL),
"In matsindf::matsindf_apply\\(\\), the following unused arguments appeared in ...: z")
})
test_that("matsindf_apply() works with a NULL argument and Matrix objects", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a
c <- matsbyname::sum_byname(a, b)
d <- matsbyname::difference_byname(a, b)
DF <- data.frame(a = I(list(a, a)), b = I(list(b,b)), stringsAsFactors = FALSE)
# Here is where the NULL is given as an argument to matsindp_apply.
# This attempt fails, because z is an extra argument in ... .
expect_error(matsindf_apply(DF, FUN = example_fun, a = "a", b = "b", z = NULL),
"In matsindf::matsindf_apply\\(\\), the following unused arguments appeared in ...: z")
# Try with piped .DF argument
expect_error(matsindf_apply(DF, FUN = example_fun, a = "a", b = "b", z = NULL),
"In matsindf::matsindf_apply\\(\\), the following unused arguments appeared in ...: z")
})
test_that("matsindf_apply() works when FUN returns NULL", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
df <- tibble::tibble(a = list(NULL, 20), b = list(NULL, 10))
res <- matsindf_apply(df, FUN = example_fun, a = "a", b = "b")
expect_equal(res, df |> dplyr::mutate(c = c(0, 30), d = c(0, 10)))
example_fun2 <- function(a, b) {
return(list(c = NULL, d = NULL))
}
df2 <- tibble::tibble(a = list(NULL, 20), b = list(NULL, 10))
res2 <- matsindf_apply(df2, FUN = example_fun2, a = "a", b = "b")
expect_equal(res2, df2 |> dplyr::mutate(c = list(NULL, NULL), d = list(NULL, NULL)))
})
test_that("matsindf_apply() works when all named arguments are NULL", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_equal(matsindf_apply(FUN = example_fun, a = NULL, b = NULL),
list(a = list(), b = list()))
})
test_that("matsindf_apply() works when .dat is a list", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b),
d = matsbyname::difference_byname(a, b)))
}
expect_equal(matsindf_apply(list(a = 1, b = 2), FUN = example_fun, a = "a", b = "b"),
list(a = 1, b = 2, c = 3, d = -1))
})
test_that("matsindf_apply() works when .dat supplies some or all argument names", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
# All arguments to FUN are supplied by named items in .dat (Case 11)
expect_equal(matsindf_apply(list(a = 1, b = 2), FUN = example_fun),
list(a = 1, b = 2, c = 3, d = -1))
# All arguments are supplied by named arguments in ... (Case 3)
expect_equal(matsindf_apply(list(a = 1, b = 2), FUN = example_fun, a = "a", b = "b"),
list(a = 1, b = 2, c = 3, d = -1))
# All arguments are supplied by named arguments in ..., but mix them up. (Case 3)
# Note that the named arguments override the items in .DF
expect_equal(matsindf_apply(list(a = 1, b = 2, z = 10), FUN = example_fun, a = "z", b = "b"),
list(a = 1, b = 2, z = 10, c = 12, d = 8))
# Try when one of the output names is same as an input name (Case 3)
expect_warning(res <- matsindf_apply(list(a = 1, b = 2, c = 10), FUN = example_fun, a = "c", b = "b"),
"Name collision in matsindf::matsindf_apply\\(\\). The following arguments appear both in .dat and in the output of `FUN`: c")
expect_equal(res, c(list(a = 1, b = 2, c = 10), list(c = 12, d = 8)))
})
test_that("matsindf_apply() works for single numbers in data frame columns", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
DF <- tibble::tibble(a = c(4, 4, 5), b = c(4, 4, 4))
expected <- DF
expected$c <- c(8, 8, 9)
expected$d <- c(0, 0, 1)
expect_equal(matsindf_apply(DF, FUN = example_fun, a = "a", b = "b"), expected)
expect_equal(matsindf_apply(DF, FUN = example_fun), expected)
})
test_that("override works() for single numbers supplied in a list", {
example_fun <- function(a, b) {
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_equal(matsindf_apply(list(a = 2, b = 1), FUN = example_fun, a = 10),
list(a = 10, b = 1, c = 11, d = 9))
})
test_that("matsindf_apply() works when an argument is missing", {
outer_fun <- function(.DF = NULL, a = "a", b = "b") {
inner_fun <- function(a_num, b_num = NULL) {
return(list(c = matsbyname::sum_byname(a_num, b_num),
d = matsbyname::difference_byname(a_num, b_num)))
}
matsindf_apply(.DF, FUN = inner_fun, a_num = a, b_num = b)
}
# Make sure it works when all arguments are present.
expect_equal(outer_fun(a = 2, b = 2), list(c = 4, d = 0))
# Now try when an argument is missing and the inner function can handle it.
expect_equal(outer_fun(a = 2), list(c = 2, d = 2))
# Try when an argument is missing and the inner function can't handle it.
outer_fun(b = 2) |>
expect_warning("In matsindf::matsindf_apply\\(\\), the following named arguments to FUN were not found in any of .dat, ..., or defaults to FUN: a_num") |>
expect_error('argument "a_num" is missing, with no default')
})
test_that("matsindf_apply() works with functions similar in form to those in `Recca`", {
# This function is similar in form to functions in `Recca`.
find_matching_rownames <- function(.DF = NULL,
prefixes,
m = "m",
out_colname = "matching_rows") {
rowmatch_fun <- function(prefixes_arg, m_arg) {
out <- m_arg %>%
matsbyname::select_rows_byname(retain_pattern =
RCLabels::make_or_pattern(strings = prefixes_arg, pattern_type = "leading")) |>
matsbyname::getrownames_byname()
# If we don't have a list, make a list.
if (!is.list(out)) {
out <- list(out)
}
# At this point, we already have a list.
# All that remains is to set the name of the list.
out %>%
magrittr::set_names(out_colname)
}
matsindf_apply(.DF,
FUN = rowmatch_fun,
prefixes_arg = prefixes,
m_arg = m)
}
# Set up a matrix
mat <- matrix(c(0, 1,
2, 3,
4, 5), nrow = 3, ncol = 2, byrow = TRUE, dimnames = list(c("ra1", "ra2", "b3"), c("c1", "c2")))
expect_equal(find_matching_rownames(prefixes = list("ra"), m = mat),
list(matching_rows = c("ra1", "ra2")))
# Now make lists and try again. This works fine.
res2 <- find_matching_rownames(prefixes = list("ra"), m = list(mat))
expect_type(res2, type = "list")
expect_equal(res2[["matching_rows"]][[1]], "ra1")
expect_equal(res2[["matching_rows"]][[2]], "ra2")
# Use with lists and 2 items in each list.
res3 <- find_matching_rownames(prefixes = list("ra", "ra"), m = list(mat, mat))
expect_type(res3, type = "list")
expect_equal(res3[["matching_rows"]][[1]], c("ra1", "ra2"))
expect_equal(res3[["matching_rows"]][[2]], c("ra1", "ra2"))
expect_equal(length(res3), 1)
# Try in a data frame.
df <- tibble::tibble(prefixes = list("ra", c("r", "b"), "b"), m = list(mat, mat, mat)) |>
find_matching_rownames(prefixes = "prefixes")
expect_equal(df$matching_rows[[1]], c("ra1", "ra2"))
expect_equal(df$matching_rows[[2]], c("ra1", "ra2", "b3"))
expect_equal(df$matching_rows[[3]], "b3")
})
test_that("matsindf_apply() works with functions similar in form to those in `Recca` with Matrix objects", {
# This function is similar in form to functions in `Recca`.
find_matching_rownames <- function(.DF = NULL,
prefixes,
m = "m",
out_colname = "matching_rows") {
rowmatch_fun <- function(prefixes_arg, m_arg) {
out <- m_arg %>%
matsbyname::select_rows_byname(retain_pattern =
RCLabels::make_or_pattern(strings = prefixes_arg, pattern_type = "leading")) %>%
matsbyname::getrownames_byname()
# If we don't have a list, make a list.
if (!is.list(out)) {
out <- list(out)
}
# At this point, we already have a list.
# All that remains is to set the name of the list.
out %>%
magrittr::set_names(out_colname)
}
matsindf_apply(.DF,
FUN = rowmatch_fun,
prefixes_arg = prefixes,
m_arg = m)
}
# Set up a matrix
mat <- matsbyname::Matrix(c(0, 1,
2, 3,
4, 5), nrow = 3, ncol = 2, byrow = TRUE, dimnames = list(c("ra1", "ra2", "b3"), c("c1", "c2")))
# This fails, because we go into find_matching_rownames without the string prefixes_arg argument.
expect_equal(find_matching_rownames(prefixes = list("ra"), m = mat),
list(matching_rows = c("ra1", "ra2")))
res2 <- find_matching_rownames(prefixes = list("ra"), m = list(mat))
expect_type(res2, type = "list")
expect_equal(res2[["matching_rows"]][[1]], "ra1")
expect_equal(res2[["matching_rows"]][[2]], "ra2")
# Use with lists and 2 items in each list. (Case 15)
res3 <- find_matching_rownames(prefixes = list("ra", "ra"), m = list(mat, mat))
expect_type(res3, type = "list")
expect_equal(res3[["matching_rows"]][[1]], c("ra1", "ra2"))
expect_equal(res3[["matching_rows"]][[2]], c("ra1", "ra2"))
expect_equal(length(res3), 1)
# Try in a data frame. (Case 13)
df <- tibble::tibble(prefixes = list("ra", c("r", "b"), "b"), m = list(mat, mat, mat)) |>
find_matching_rownames(prefixes = "prefixes")
expect_equal(df$matching_rows[[1]], c("ra1", "ra2"))
expect_equal(df$matching_rows[[2]], c("ra1", "ra2", "b3"))
expect_equal(df$matching_rows[[3]], "b3")
})
test_that("matsindf_apply() issues a warning when replacing a column", {
# Create a data frame with a matrix in a column.
a <- matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- 2 * a
DF <- data.frame(a = I(list(a, a)), b = I(list(b, b)), stringsAsFactors = FALSE)
replace_func <- function(a_mat, b_mat) {
a <- matsbyname::difference_byname(a_mat, b_mat)
d <- matsbyname::sum_byname(a_mat, b_mat)
list(a, d) %>%
magrittr::set_names(c(a_name, d_name))
}
a_name <- "a"
d_name <- "d"
expect_warning(
suppressMessages(
# The next call gives a warning but also a "New names:" message.
# The message clutters the output of the tests,
# so suppress it.
# We already know of the problem and are testing for it, anyway.
matsindf_apply(DF, FUN = replace_func, a_mat = "a", b_mat = "b")
),
"Name collision in matsindf::matsindf_apply\\(\\). The following arguments appear both in .dat and in the output of `FUN`: a"
)
})
test_that("matsindf_apply() issues a warning when replacing a column with Matrix objects", {
# Create a data frame with a matrix in a column.
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- matsbyname::hadamardproduct_byname(2, a)
DF <- data.frame(a = I(list(a, a)), b = I(list(b, b)), stringsAsFactors = FALSE)
replace_func <- function(a_mat, b_mat) {
a <- matsbyname::difference_byname(a_mat, b_mat)
d <- matsbyname::sum_byname(a_mat, b_mat)
list(a, d) %>%
magrittr::set_names(c(a_name, d_name))
}
a_name <- "a"
d_name <- "d"
expect_warning(
suppressMessages(
# The next call gives a warning but also a "New names:" message.
# The message clutters the output of the tests,
# so suppress it.
# We already know of the problem and are testing for it, anyway.
matsindf_apply(DF, FUN = replace_func, a_mat = "a", b_mat = "b")
),
"Name collision in matsindf::matsindf_apply\\(\\). The following arguments appear both in .dat and in the output of `FUN`: a"
)
})
test_that("matsindf_apply() works for a string and numbers", {
example_fun <- function(str_a, b) {
a <- as.numeric(str_a)
list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b))
}
res <- matsindf_apply(FUN = example_fun, str_a = list("1"), b = list(2))
expect_equal(res$c[[1]], 3)
expect_equal(res$d[[1]], -1)
})
test_that("matsindf_apply() works as desired in degenerate case", {
sum_fun <- function(a, b) {
paste0(a, b) |>
magrittr::set_names("term")
}
expected <- list(term = list("string142", "string243"))
expect_equal(
matsindf_apply(FUN = sum_fun, a = c("string1", "string2"), b = list("42", "43")),
expected
)
})
test_that("matsindf_apply() works as desired with zero-row data frames", {
example_fun <- function(a_var, b_var) {
return(list(c = matsbyname::sum_byname(a_var, b_var),
d = matsbyname::difference_byname(a_var, b_var)))
}
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a + 1
# Make a data frame
df <- tibble::tribble(~acol, ~bcol,
a, b,
a, b)
expected_df <- df |>
dplyr::mutate(
c = matsbyname::sum_byname(acol, bcol),
d = matsbyname::difference_byname(acol, bcol)
)
res <- matsindf_apply(df, FUN = example_fun, a_var = "acol", b_var = "bcol")
expect_equal(res, expected_df)
# Now try with no rows in df
dfzero <- df[0, ]
res <- matsindf_apply(dfzero, FUN = example_fun, a_var = "acol", b_var = "bcol")
# Should return the input data frame unmodified.
expect_equal(res, dfzero)
})
test_that("matsindf_apply() works as desired with zero-length lists and matrix objects", {
example_fun <- function(a_var, b_var) {
return(list(c = matsbyname::sum_byname(a_var, b_var),
d = matsbyname::difference_byname(a_var, b_var)))
}
a <- matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a + 1
c <- a + b
d <- a - b
expected_list <- list(c = list(c, c), d = list(d, d))
res <- matsindf_apply(FUN = example_fun, a_var = list(a, a), b_var = list(b, b))
expect_equal(res, expected_list)
# Now try with zero-length lists
res_zero <- matsindf_apply(FUN = example_fun, a_var = list(), b_var = list())
expect_equal(res_zero, list(a_var = list(), b_var = list()))
})
test_that("matsindf_apply() works as desired with zero-length lists and Matrix objects", {
example_fun <- function(a_var, b_var) {
return(list(c = matsbyname::sum_byname(a_var, b_var),
d = matsbyname::difference_byname(a_var, b_var)))
}
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a + 1
c <- a + b
d <- a - b
expected_list <- list(c = list(c, c), d = list(d, d))
res <- matsindf_apply(FUN = example_fun, a_var = list(a, a), b_var = list(b, b))
expect_equal(res, expected_list)
# Now try with zero-length lists
res_zero <- matsindf_apply(FUN = example_fun, a_var = list(), b_var = list())
expect_equal(res_zero, list(a_var = list(), b_var = list()))
})
test_that("matsindf_apply() works with empty lists", {
example_fun <- function(a_var, b_var) {
return(list(c = matsbyname::sum_byname(a_var, b_var),
d = matsbyname::difference_byname(a_var, b_var)))
}
a <- matsbyname::Matrix(c(1,2,3,4), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")))
b <- a + 1
a_list <- list(a = a)
b_list <- list(b = b)
a_list_0 <- a_list[0]
b_list_0 <- b_list[0]
# Try with zero-length lists (Case 5)
res_zero <- matsindf_apply(FUN = example_fun, a_var = a_list_0, b_var = b_list_0)
expect_equal(res_zero, list(a_var = a_list[0], b_var = b_list[0]))
# Try with a zero-length variable store (Case 15)
var_store <- list(a_var = a_list_0, b_var = b_list_0)
res_zero_2 <- matsindf_apply(var_store, FUN = example_fun)
expect_equal(res_zero_2, list(a_var = a_list[0], b_var = b_list[0]))
})
test_that("matsindf_apply() works with a no-argument function", {
example_fun <- function() {42}
expect_equal(matsindf_apply(FUN = example_fun), 42)
})
test_that("matsindf_apply_types() works as expected", {
example_fun <- function(a, b) {
c(a, b)
}
matsindf_apply_types(.dat = NULL, FUN = example_fun) |>
expect_warning("In matsindf::matsindf_apply\\(\\), the following named arguments to FUN were not found in any of .dat, ..., or defaults to FUN: a, b")
# Set the warning flag to FALSE to suppress the warning
no_warn <- matsindf_apply_types(.dat = NULL, FUN = example_fun, .warn_missing_FUN_args = FALSE)
expect_equal(no_warn$keep_args, list(.dat = NULL, FUN = NULL, dots = NULL))
matsindf_apply_types(.dat = NULL, FUN = example_fun, a = 1, b = 2) |>
expect_equal(list(.dat_null = TRUE, .dat_df = FALSE, .dat_list = FALSE, .dat_names = NULL,
FUN_arg_all_names = c("a", "b"),
FUN_arg_default_names = NULL,
FUN_arg_default_values = NULL,
dots_present = TRUE, all_dots_num = TRUE, all_dots_mats = FALSE, all_dots_list = FALSE,
all_dots_vect = TRUE, all_dots_char = FALSE, all_dots_longer_than_1 = FALSE,
dots_names = c("a", "b"),
keep_args = list(.dat = NULL,
FUN = NULL,
dots = c(a = "a", b = "b"))))
matsindf_apply_types(.dat = data.frame(a = 42), FUN = example_fun,
a = matrix(c(1, 2)), b = matrix(c(2, 3))) |>
expect_equal(list(.dat_null = FALSE, .dat_df = TRUE, .dat_list = TRUE, .dat_names = "a",
FUN_arg_all_names = c("a", "b"),
FUN_arg_default_names = NULL,
FUN_arg_default_values = NULL,
dots_present = TRUE, all_dots_num = FALSE, all_dots_mats = TRUE, all_dots_list = FALSE,
all_dots_vect = FALSE, all_dots_char = FALSE, all_dots_longer_than_1 = FALSE,
dots_names = c("a", "b"),
keep_args = list(.dat = NULL,
FUN = NULL,
dots = c(a = "a", b = "b"))))
matsindf_apply_types(.dat = list(a = 1, b = 2), FUN = example_fun,
a = list(1, 2), b = list(3, 4)) |>
expect_equal(list(.dat_null = FALSE, .dat_df = FALSE, .dat_list = TRUE, .dat_names = c("a", "b"),
FUN_arg_all_names = c("a", "b"),
FUN_arg_default_names = NULL,
FUN_arg_default_values = NULL,
dots_present = TRUE, all_dots_num = FALSE, all_dots_mats = FALSE, all_dots_list = TRUE,
all_dots_vect = TRUE, all_dots_char = FALSE, all_dots_longer_than_1 = TRUE,
dots_names = c("a", "b"),
keep_args = list(.dat = NULL,
FUN = NULL,
dots = c(a = "a", b = "b"))))
matsindf_apply_types(.dat = NULL, FUN = example_fun, a = "a", b = "b") |>
expect_warning("In matsindf::matsindf_apply\\(\\), the following named arguments to FUN were not found in any of .dat, ..., or defaults to FUN: a, b")
# Try with Matrix objects
matsindf_apply_types(.dat = NULL, FUN = example_fun,
a = matsbyname::Matrix(c(1, 2)), b = matsbyname::Matrix(c(2, 3))) |>
expect_equal(list(.dat_null = TRUE, .dat_df = FALSE, .dat_list = FALSE, .dat_names = NULL,
FUN_arg_all_names = c("a", "b"),
FUN_arg_default_names = NULL,
FUN_arg_default_values = NULL,
dots_present = TRUE, all_dots_num = FALSE, all_dots_mats = TRUE, all_dots_list = FALSE,
all_dots_vect = FALSE, all_dots_char = FALSE, all_dots_longer_than_1 = FALSE,
dots_names = c("a", "b"),
keep_args = list(.dat = NULL,
FUN = NULL,
dots = c(a = "a", b = "b"))))
# Try with data coming from one but not the other source.
matsindf_apply_types(.dat = data.frame(a = 42), FUN = example_fun,
b = matrix(c(2, 3))) |>
expect_equal(list(.dat_null = FALSE, .dat_df = TRUE, .dat_list = TRUE, .dat_names = "a",
FUN_arg_all_names = c("a", "b"),
FUN_arg_default_names = NULL,
FUN_arg_default_values = NULL,
dots_present = TRUE, all_dots_num = FALSE, all_dots_mats = TRUE, all_dots_list = FALSE,
all_dots_vect = FALSE, all_dots_char = FALSE, all_dots_longer_than_1 = FALSE,
dots_names = "b",
keep_args = list(.dat = c(a = "a"),
FUN = NULL,
dots = c(b = "b"))))
})
test_that("matsindf_apply_types() works with functions that have default values", {
example_fun <- function(a = 2, b, c = "string") {
list(a = a, b = b, c = c)
}
expect_equal(matsindf_apply_types(.dat = NULL, FUN = example_fun,
a = 1, b = 2),
list(.dat_null = TRUE, .dat_df = FALSE, .dat_list = FALSE, .dat_names = NULL,
FUN_arg_all_names = c("a", "b", "c"),
FUN_arg_default_names = c("a", "c"),
FUN_arg_default_values = list(a = 2, c = "string"),
dots_present = TRUE, all_dots_num = TRUE, all_dots_mats = FALSE, all_dots_list = FALSE,
all_dots_vect = TRUE, all_dots_char = FALSE, all_dots_longer_than_1 = FALSE,
dots_names = c("a", "b"),
keep_args = list(.dat = NULL,
FUN = c(c = "c"),
dots = c(a = "a", b = "b"))))
})
test_that("matsindf_apply_types() works with a degenerate case with simple FUN and no parameters", {
example_fun <- function() {42}
expect_equal(matsindf_apply_types(FUN = example_fun),
list(.dat_null = TRUE, .dat_df = FALSE, .dat_list = FALSE, .dat_names = NULL,
FUN_arg_all_names = NULL,
FUN_arg_default_names = NULL,
FUN_arg_default_values = NULL,
dots_present = FALSE, all_dots_num = FALSE, all_dots_mats = FALSE, all_dots_list = FALSE,
all_dots_vect = FALSE, all_dots_char = FALSE, all_dots_longer_than_1 = FALSE,
dots_names = NULL,
keep_args = list(.dat = NULL,
FUN = NULL,
dots = NULL)))
})
test_that("matsindf_apply_types() works for examples", {
identity_fun <- function(a, b) {list(a = a, b = b)}
types <- matsindf_apply_types(.dat = data.frame(), FUN = identity_fun,
a = matrix(c(1, 2)), b = matrix(c(2, 3)))
expect_null(types$keep_args$.dat)
})
test_that("build_matsindf_apply_data_frame() works as expected", {
example_fun <- function(a_var, b_var = c(42, 43)) {
c(a_var, b_var)
}
DF <- tibble::tribble(~a, ~b, ~z,
1, 2, 3,
4, 5, NULL)
expected_df <- DF |>
dplyr::select("a", "b") |>
dplyr::rename(
a_var = "a", b_var = "b"
)
res_df <- build_matsindf_apply_data_frame(.dat = DF, FUN = example_fun, a_var = "a", b_var = "b")
expect_equal(names(res_df), c("a_var", "b_var"))
expect_equal(res_df, expected_df)
DF_2 <- DF |>
dplyr::select(-b)
expected_df_2 <- DF |>
dplyr::mutate(
b_var = c(42, 43),
b = NULL) |>
dplyr::rename(a_var = "a") |>
dplyr::select(a_var, b_var)
res_df_2 <- build_matsindf_apply_data_frame(.dat = DF_2, FUN = example_fun, a_var = "a")
expect_equal(res_df_2, expected_df_2)
})
test_that("build_matsindf_apply_data_frame() works with NULL args in ...", {
example_fun <- function(R_mat, U_mat) {
return(matsbyname::sum_byname(R_mat, matsbyname::transpose_byname(U_mat)))
}
expected <- tibble::tribble(~R_mat, ~U_mat,
NULL, matrix(c(42, 43)))
res <- build_matsindf_apply_data_frame(FUN = example_fun, R_mat = NULL, U_mat = matrix(c(42, 43)))
expect_equal(res, expected)
})
test_that("matsindf_apply() works when FUN can handle zero-row DF's", {
example_fun <- function(a, b) {
if (length(a) == 0 & length(b) == 0) {
return(list(c = numeric(), d = numeric()))
}
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_equal(example_fun(a = 2, b = 2), list(c = 4, d = 0))
expect_equal(matsindf_apply(FUN = example_fun, a = 2, b = 2), list(c = 4, d = 0))
expect_equal(matsindf_apply(list(a = 2, b = 2), FUN = example_fun), list(a = 2, b = 2, c = 4, d = 0))
df <- data.frame(a = 2, b = 2)
df_expected <- tibble::tibble(a = 2, b = 2, c = 4, d = 0)
expect_equal(matsindf_apply(df, example_fun), df_expected)
dfzero <- df[0, ]
dfzero_expected <- df_expected[0, ]
expect_equal(matsindf_apply(dfzero, example_fun), dfzero_expected)
})
test_that("matsindf_apply() works when FUN can handle zero-length lists", {
example_fun <- function(a, b) {
if (length(a) == 0 & length(b) == 0) {
return(list(c = numeric(), d = numeric()))
}
return(list(c = matsbyname::sum_byname(a, b), d = matsbyname::difference_byname(a, b)))
}
expect_equal(matsindf_apply(FUN = example_fun, a = numeric(), b = numeric()),
list(c = numeric(), d = numeric()))
input <- list(a = numeric(), b = numeric())
output_expected <- list(a = numeric(), b = numeric(), c = numeric(), d = numeric())
expect_equal(matsindf_apply(input, example_fun), output_expected)
})
test_that("matsindf_apply() works for an edge case", {
# This example comes from the matsindf_apply primer.
calc_W <- function(.DF = NULL, U = "U", V = "V", W = "W") {
# The inner function does all the work.
W_func <- function(U_mat, V_mat){
# When we get here, U_mat and V_mat will be single matrices or single numbers,
# not a column in a data frame or an item in a list.
if (length(U_mat) == 0 & length(V_mat == 0)) {
# Tolerate zero-length arguments by returning a zero-length
# a list with the correct name and return type.
return(list(numeric()) |> magrittr::setnames(W))
}
# Calculate W_mat from the inputs U_mat and V_mat.
W_mat <- matsbyname::difference_byname(matsbyname::transpose_byname(V_mat), U_mat)
# Return a named list.
list(W_mat) |> magrittr::set_names(W)
}
# The body of the main function consists of a call to matsindf_apply
# that specifies the inner function in the FUN argument.
matsindf_apply(.DF, FUN = W_func, U_mat = U, V_mat = V)
}
expect_equal(calc_W(list(U = c(2, 2, 2, 2), V = c(3, 4, 5, 6))),
list(U = c(2, 2, 2, 2), V = c(3, 4, 5, 6), W = c(1, 2, 3, 4)))
})
test_that("should_unlist() works as expected", {
DF <- tibble::tibble(a = list(1, 2, 3), b = c("a", "b", "c"),
c = list(matrix(c(42, 43)),
matrix(c(44, 45)),
matrix(c(46, 47))))
expect_true(matsindf:::should_unlist(DF$a))
expect_false(matsindf:::should_unlist(DF$b))
expect_false(matsindf:::should_unlist(DF$c))
expect_equal(sapply(DF, FUN = function(this_col) {matsindf:::should_unlist(this_col)}),
c(a = TRUE, b = FALSE, c = FALSE))
expect_equal(matsindf:::should_unlist(DF),
c(a = TRUE, b = FALSE, c = FALSE))
})
test_that("should_unlist() correctly says 'FALSE' for a list of NULL items", {
# Unlist when length is 1
expect_true(matsindf:::should_unlist(list(NULL)))
# Do not unlist when the length is > 1
expect_false(matsindf:::should_unlist(list(NULL, NULL, NULL)))
})
test_that("should_unlist() correctly says 'FALSE' for a list of data frames", {
my_col <- list(data.frame(a = 42), tibble::tibble(b = 43) )
expect_false(matsindf:::should_unlist(my_col))
})
test_that("matsindf_apply() works for missing arg in .dat", {
example_fun <- function(a_val = 2, b_val = 1) {
list(c = matsbyname::sum_byname(a_val, b_val),
d = matsbyname::difference_byname(a_val, b_val))
}
# Try when everything is available.
df <- tibble::tibble(a = c(10, 11, 12), b = c(5, 6, 7))
expected_df <- dplyr::bind_cols(df, data.frame(c = c(15, 17, 19), d = c(5, 5, 5)))
res <- df |>
matsindf_apply(FUN = example_fun, a_val = "a", b_val = "b")
expect_equal(res, expected_df)
# Try when df lacks a column.
# matsindf_apply() should use the default value in the signature of example_fun.
# But as of 4 April 2023, it does not.
# This test exposes that bug.
res <- df |>
dplyr::select("a") |>
matsindf_apply(FUN = example_fun, a_val = "a")
expect_equal(res, tibble::tribble(~a, ~c, ~d,
10, 11, 9,
11, 12, 10,
12, 13, 11))
})
test_that("where_to_get_args() works as intended", {
example_fun <- function(a = 1, b) {
list(c = a + b, d = a - b)
}
matsindf:::where_to_get_args(FUN = example_fun) |>
expect_equal(list(a = c(source = "FUN", arg_name = "a"),
b = NULL))
matsindf:::where_to_get_args(FUN = example_fun, b = 2) |>
expect_equal(list(a = c(source = "FUN", arg_name = "a"),
b = c(source = "...", arg_name = "b")))
matsindf:::where_to_get_args(list(a = 2), FUN = example_fun, b = 2) |>
expect_equal(list(a = c(source = ".dat", arg_name = "a"),
b = c(source = "...", arg_name = "b")))
matsindf:::where_to_get_args(list(a = 2, b = 2), FUN = example_fun) |>
expect_equal(list(a = c(source = ".dat", arg_name = "a"),
b = c(source = ".dat", arg_name = "b")))
# Map to self
matsindf:::where_to_get_args(list(a = 2, b = 2, c = 2), FUN = example_fun, a = "a", b = "b") |>
expect_equal(list(a = c(source = ".dat", arg_name = "a"),
b = c(source = ".dat", arg_name = "b")))
# Check redirection
matsindf:::where_to_get_args(list(a = 2, b = 2, c = 2), FUN = example_fun, b = "c") |>
expect_equal(list(a = c(source = ".dat", arg_name = "a"),
b = c(source = ".dat", arg_name = "c")))
# Leave an argument out
matsindf:::where_to_get_args(list(a = 2), FUN = example_fun) |>
expect_equal(list(a = c(source = ".dat", arg_name = "a"),
b = NULL))
# Try redirecting to an item that doesn't exist in .dat
matsindf:::where_to_get_args(list(a = 2, b = 2, c = 2), FUN = example_fun, b = "d") |>
expect_equal(list(a = c(source = ".dat", arg_name = "a"),
b = NULL))
# In this case a comes from .dat and b comes from .dat as well.
matsindf:::where_to_get_args(list(a = 2, c = 2), FUN = example_fun, b = "a") |>
expect_equal(list(a = c(source = ".dat", arg_name = "a"),
b = c(source = ".dat", arg_name = "a")))
# In this case, both a and b should be found in defaults to FUN.
matsindf:::where_to_get_args(list(c = 2), FUN = example_fun, b = "a") |>
expect_equal(list(a = c(source = "FUN", arg_name = "a"),
b = c(source = "FUN", arg_name = "a")))
# In this case, both a and b should be found in .dat.
matsindf:::where_to_get_args(list(a = 2, c = 2), FUN = example_fun, b = "a") |>
expect_equal(list(a = c(source = ".dat", arg_name = "a"),
b = c(source = ".dat", arg_name = "a")))
# Cross the mappings
matsindf:::where_to_get_args(list(a = 2, b = 2), FUN = example_fun, a = "b", b = "a") |>
expect_equal(list(a = c(source = ".dat", arg_name = "b"),
b = c(source = ".dat", arg_name = "a")))
})
test_that("matsindf_apply() handles different lengths correctly (i.e., with an error)", {
example_fun <- function(a = 1, b) {
list(c = a + b, d = a - b)
}
expect_error(matsindf_apply(FUN = example_fun, a = c(1, 2, 3), b = c(4, 5)),
"Different lengths in handle_null_args\\(\\)")
})
test_that("matsindf_apply() correctly handles NULL default args on FUN", {
example_fun <- function(a = 1, b = NULL) {
list(c = a, d = b)
}
expect_equal(matsindf:::where_to_get_args(list(a = 1), FUN = example_fun),
list(a = c(source = ".dat", arg_name = "a"), b = c(source = "FUN", arg_name = "b")))
expect_equal(matsindf_apply(list(a = 1), FUN = example_fun),
list(a = 1, b = NULL, c = 1, d = NULL))
})
test_that("matsindf_apply() works correctly for a list of matrices each with length 1", {
example_fun <- function(a, b) {
list(c = matsbyname::sum_byname(a, b),
d = matsbyname::difference_byname(a, b))
}
m <- matrix(c(1, 2,
3, 4), nrow = 2, ncol = 2, byrow = TRUE)
my_mat_list <- list(a = m, b = m+1)
expected_c <- my_mat_list$a + my_mat_list$b
expected_d <- my_mat_list$a - my_mat_list$b
expect_equal(matsindf_apply(my_mat_list, example_fun),
list(a = list(my_mat_list$a), b = list(my_mat_list$b), c = expected_c, d = expected_d))
expect_equal(matsindf_apply(FUN = example_fun, a = m, b = m+1),
list(c = expected_c, d = expected_d))
})
Try the matsindf package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.