tests/testthat/test-fmutate.R
In SebKrantz/collapse: Advanced and Fast Data Transformation
context("fsummarise and fmutate")
expect_equal(1, 1)
if(requireNamespace("magrittr", quietly = TRUE) && requireNamespace("dplyr", quietly = TRUE)) {
library(magrittr)
bmean <- base::mean
bsum <- base::sum
bsd <- stats::sd
bmin <- base::min
bmax <- base::max
NCRAN <- identical(Sys.getenv("NCRAN"), "TRUE")
mtc <- dplyr::as_tibble(mtcars)
gmtc <- dplyr::group_by(mtc, cyl, vs, am)
expect_equal(gsplit(mtcars$mpg, GRP(gmtc), TRUE), split(mtcars$mpg, as_factor_GRP(GRP(gmtc))))
if(NCRAN) {
test_that("fsummarise works like dplyr::summarise for tagged vector expressions", {
# Simple computations
expect_equal(smr(mtc, mu = bmean(mpg), sigma = bsd(mpg)), dplyr::summarise(mtc, mu = bmean(mpg), sigma = bsd(mpg)))
# TODO: Could expand like this as well... but who needs this?
# expect_false(all_obj_equal(smr(mtc, mu = bmean(mpg), sigma = bsd(mpg), q = quantile(mpg)),
# dplyr::summarise(mtc, mu = bmean(mpg), sigma = bsd(mpg), q = quantile(mpg))))
expect_equal(smr(mtc, mu = bmean(mpg) + bsd(mpg)), dplyr::summarise(mtc, mu = bmean(mpg) + bsd(mpg)))
expect_equal(smr(mtc, mu = bmean(mpg) + 3), dplyr::summarise(mtc, mu = bmean(mpg) + 3))
q <- 5
expect_equal(smr(mtc, mu = bmean(mpg) + q), dplyr::summarise(mtc, mu = bmean(mpg) + q))
v <- mtcars$disp
expect_equal(smr(mtc, mu = bmean(mpg) + bmean(v)), dplyr::summarise(mtc, mu = bmean(mpg) + bmean(v)))
# Grouped computations
expect_equal(smr(gmtc, mpg = fmean(mpg)), dplyr::summarise(gmtc, mpg = bmean(mpg), .groups = "drop"))
expect_equal(smr(gmtc, mpg = bmean(mpg)), dplyr::summarise(gmtc, mpg = bmean(mpg), .groups = "drop"))
expect_equal(smr(gmtc, mpg = fmean(mpg), carb = fmax(carb)),
dplyr::summarise(gmtc, mpg = bmean(mpg), carb = bmax(carb), .groups = "drop"))
expect_equal(smr(gmtc, mpg = fmean(mpg), carb = bmax(carb)),
dplyr::summarise(gmtc, mpg = bmean(mpg), carb = bmax(carb), .groups = "drop"))
expect_equal(smr(gmtc, mpg = bmean(mpg), carb = bmax(carb)),
dplyr::summarise(gmtc, mpg = bmean(mpg), carb = bmax(carb), .groups = "drop"))
expect_equal(smr(gmtc, mpg = bmean(mpg), carb = fmax(carb)),
dplyr::summarise(gmtc, mpg = bmean(mpg), carb = bmax(carb), .groups = "drop"))
expect_equal(fsummarise(gmtc, mpg = bmean(mpg), carb = fmax(carb), keep.group_vars = FALSE),
fsummarise(gmtc, mpg = bmean(mpg), carb = fmax(carb)) %>% slt(-cyl,-vs,-am))
# Multi-return values
expect_equal(smr(gmtc, mpg = quantile(mpg)),
dplyr::summarise(gmtc, mpg = quantile(mpg), .groups = "drop") %>% tfm(mpg = unname(mpg)))
# More complex expressions
expect_equal(smr(gmtc, mpg = bmean(mpg) + 1),
dplyr::summarise(gmtc, mpg = bmean(mpg) + 1, .groups = "drop"))
expect_equal(smr(gmtc, mpg = bmean(mpg) + q),
dplyr::summarise(gmtc, mpg = bmean(mpg) + q, .groups = "drop"))
expect_equal(smr(gmtc, mpg = quantile(mpg) + q),
dplyr::summarise(gmtc, mpg = quantile(mpg) + q, .groups = "drop") %>% tfm(mpg = unname(mpg)))
expect_equal(smr(gmtc, mpg = bmean(mpg) + bmax(v)),
dplyr::summarise(gmtc, mpg = bmean(mpg) + bmax(v), .groups = "drop"))
expect_equal(smr(gmtc, mpg = quantile(mpg) + bmax(v)),
dplyr::summarise(gmtc, mpg = quantile(mpg) + bmax(v), .groups = "drop") %>% tfm(mpg = unname(mpg)))
expect_equal(smr(gmtc, mpg = bmean(log(mpg))),
dplyr::summarise(gmtc, mpg = bmean(log(mpg)), .groups = "drop"))
expect_equal(smr(gmtc, mpg = bmean(log(mpg)) + bmax(qsec)),
dplyr::summarise(gmtc, mpg = bmean(log(mpg)) + bmax(qsec), .groups = "drop"))
expect_equal(smr(gmtc, mpg = quantile(mpg) + bmax(qsec)),
dplyr::summarise(gmtc, mpg = quantile(mpg) + bmax(qsec), .groups = "drop") %>% tfm(mpg = unname(mpg)))
expect_equal(smr(gmtc, mpg = fmean(log(mpg)) + fmax(qsec)),
dplyr::summarise(gmtc, mpg = bmean(log(mpg)) + bmax(qsec), .groups = "drop"))
expect_false(all_obj_equal(smr(gmtc, mpg = fmean(log(mpg)) + bmax(qsec)),
dplyr::summarise(gmtc, mpg = bmean(log(mpg)) + bmax(qsec), .groups = "drop")))
# Testing expressions turned into functions:
mid_fun <- function(x) (bmin(x) + bmax(x)) / 2
expect_true(all_obj_equal(smr(gmtc, mid_mpg = (bmin(mpg) + bmax(mpg)) / 2),
smr(gmtc, mid_mpg = (fmin(mpg) + fmax(mpg)) / 2),
smr(gmtc, mid_mpg = mid_fun(mpg)),
dplyr::summarise(gmtc, mid_mpg = (bmin(mpg) + bmax(mpg)) / 2, .groups = "drop")))
# Adding global variable:
expect_true(all_obj_equal(smr(gmtc, mid_mpg = (bmin(mpg) + bmax(mpg)) / 2 + q),
smr(gmtc, mid_mpg = (fmin(mpg) + fmax(mpg)) / 2 + q),
smr(gmtc, mid_mpg = mid_fun(mpg) + q),
dplyr::summarise(gmtc, mid_mpg = (bmin(mpg) + bmax(mpg)) / 2 + q, .groups = "drop")))
# Weighted computations
expect_equal(smr(gmtc, mpg = weighted.mean(mpg, wt)), dplyr::summarise(gmtc, mpg = weighted.mean(mpg, wt), .groups = "drop"))
expect_equal(smr(gmtc, mpg = fmean(mpg, wt)), dplyr::summarise(gmtc, mpg = fmean(mpg, w = wt), .groups = "drop"))
expect_equal(smr(gmtc, mpg = weighted.mean(mpg, wt) + 5.5), dplyr::summarise(gmtc, mpg = weighted.mean(mpg, wt) + 5.5, .groups = "drop"))
expect_equal(smr(gmtc, mpg = fmean(mpg, wt) + 5.5), dplyr::summarise(gmtc, mpg = fmean(mpg, w = wt) + 5.5, .groups = "drop"))
expect_equal(smr(gmtc, mpg = weighted.mean(mpg, wt) + q), dplyr::summarise(gmtc, mpg = weighted.mean(mpg, wt) + q, .groups = "drop"))
expect_equal(smr(gmtc, mpg = fmean(mpg, wt) + q), dplyr::summarise(gmtc, mpg = fmean(mpg, w = wt) + q, .groups = "drop"))
expect_equal(smr(gmtc, mpg = weighted.mean(mpg, wt) + bmax(v)), dplyr::summarise(gmtc, mpg = weighted.mean(mpg, wt) + bmax(v), .groups = "drop"))
expect_equal(smr(gmtc, mpg = fmean(mpg, wt) + bmax(v)), dplyr::summarise(gmtc, mpg = fmean(mpg, w = wt) + bmax(v), .groups = "drop"))
expect_equal(smr(gmtc, mpg = weighted.mean(mpg, wt) + bmax(qsec)),
dplyr::summarise(gmtc, mpg = weighted.mean(mpg, wt) + bmax(qsec), .groups = "drop"))
expect_equal(smr(gmtc, mpg = fmean(mpg, wt) + fmax(qsec)),
dplyr::summarise(gmtc, mpg = fmean(mpg, w = wt) + bmax(qsec), .groups = "drop"))
expect_equal(smr(gmtc, mpg = quantile(mpg) + weighted.mean(mpg, wt)),
dplyr::summarise(gmtc, mpg = quantile(mpg) + weighted.mean(mpg, wt), .groups = "drop") %>% tfm(mpg = unname(mpg)))
expect_warning(smr(gmtc, mpg = quantile(mpg) + fmean(mpg, wt)))
})
}
wld <- dplyr::as_tibble(wlddev)
gwld <- dplyr::group_by(wlddev, iso3c)
if(NCRAN) {
test_that("fsummarise works like dplyr::summarise with across and simple usage", {
# Simple usage
expect_true(all_obj_equal(fsummarise(mtc, across(cyl:drat, bsum)),
fsummarise(mtc, across(cyl:drat, fsum)),
dplyr::summarise(mtc, dplyr::across(cyl:drat, bsum))))
expect_true(all_obj_equal(fsummarise(mtc, across(5:8, bsum)),
fsummarise(mtc, across(5:8, fsum)),
dplyr::summarise(mtc, dplyr::across(5:8, bsum))))
expect_true(all_obj_equal(fsummarise(mtc, across(-(5:8), bsum)),
fsummarise(mtc, across(-(5:8), fsum, .apply = FALSE)),
dplyr::summarise(mtc, dplyr::across(-(5:8), bsum))))
expect_true(all_obj_equal(fsummarise(wld, across(is.numeric, bsum, na.rm = TRUE)),
fsummarise(wld, across(is.numeric, fsum)) %>% dapply(unattrib, drop = FALSE),
dplyr::summarise(wld, dplyr::across(where(is.numeric), bsum, na.rm = TRUE))))
expect_true(all_obj_equal(fsummarise(mtc, across(NULL, bsum, na.rm = TRUE)),
fsummarise(mtc, across(NULL, fsum)),
dplyr::summarise(mtc, dplyr::across(everything(), bsum, na.rm = TRUE))))
expect_equal(fsummarise(mtc, across(cyl:vs, bsum)),
fsummarise(mtc, cyl = bsum(cyl), across(disp:qsec, fsum), vs = fsum(vs)))
# Simple programming use
vlist <- list(mtc %>% fselect(cyl:drat, return = "names"), 5:8, NULL) # -(5:8), is.numeric
for(i in seq_along(vlist)) {
expect_true(all_obj_equal(fsummarise(mtc, across(vlist[[i]], bsum)),
fsummarise(mtc, across(vlist[[i]], fsum)),
dplyr::summarise(mtc, dplyr::across(if(is.null(vlist[[i]])) everything() else vlist[[i]], bsum))))
v <- vlist[[i]]
expect_true(all_obj_equal(fsummarise(mtc, across(v, bsum)),
fsummarise(mtc, across(v, fsum)),
dplyr::summarise(mtc, dplyr::across(if(is.null(v)) everything() else v, bsum))))
}
# Simple usage and multiple functions
expect_true(all_obj_equal(fsummarise(mtc, across(cyl:drat, list(bmean, bsum))),
fsummarise(mtc, across(cyl:drat, list(bmean = fmean, bsum = fsum))),
dplyr::summarise(mtc, dplyr::across(cyl:drat, list(bmean = bmean, bsum = bsum)))))
expect_true(all_obj_equal(fsummarise(mtc, across(NULL, list(bmean, bsum))),
fsummarise(mtc, across(NULL, list(bmean = fmean, bsum = fsum))),
dplyr::summarise(mtc, dplyr::across(everything(), list(bmean = bmean, bsum = bsum)))))
# Passing additional arguments
expect_true(all_obj_equal(fsummarise(mtc, across(cyl:drat, bsum, na.rm = FALSE)),
fsummarise(mtc, across(cyl:drat, fsum, na.rm = FALSE)),
dplyr::summarise(mtc, dplyr::across(cyl:drat, bsum, na.rm = FALSE))))
expect_true(all_obj_equal(fsummarise(mtc, across(cyl:drat, weighted.mean, w = wt)),
fsummarise(mtc, across(cyl:drat, fmean, w = wt)),
dplyr::summarise(mtc, dplyr::across(cyl:drat, weighted.mean, w = wt))))
expect_true(all_obj_equal(fsummarise(mtc, across(cyl:drat, list(mean = weighted.mean, sum = fsum), w = wt)),
fsummarise(mtc, across(cyl:drat, list(mean = fmean, sum = fsum), w = wt)),
dplyr::summarise(mtc, dplyr::across(cyl:drat, list(mean = weighted.mean, sum = fsum), w = wt))))
# Simple programming use
flist <- list(bsum, list(bmean = bmean, bsum = bsum), list(bmean, bsum)) # c("bmean", "bsum"), c(mean = "fmean", sum = "fsum")
for(i in seq_along(flist)) {
expect_equal(fsummarise(mtc, across(cyl:drat, flist[[i]])),
dplyr::summarise(mtc, dplyr::across(cyl:drat, flist[[i]])))
f <- flist[[i]]
expect_equal(fsummarise(mtc, across(cyl:drat, f)),
dplyr::summarise(mtc, dplyr::across(cyl:drat, f)))
}
})
test_that("fsummarise works like dplyr::summarise with across and grouped usage", {
# Simple usage
expect_true(all_obj_equal(fsummarise(gmtc, across(hp:drat, bsum)),
fsummarise(gmtc, across(hp:drat, fsum)),
dplyr::summarise(gmtc, dplyr::across(hp:drat, bsum), .groups = "drop")))
expect_true(all_obj_equal(fsummarise(gmtc, across(5:7, bsum)),
fsummarise(gmtc, across(5:7, fsum)),
dplyr::summarise(gmtc, dplyr::across(4:6, bsum), .groups = "drop")))
expect_true(all_obj_equal(fsummarise(gwld, across(is.numeric, bsum, na.rm = TRUE)) %>% setLabels(NULL),
fsummarise(gwld, across(is.numeric, fsum)) %>% replace_NA() %>% setLabels(NULL),
dplyr::summarise(gwld, dplyr::across(where(is.numeric), bsum, na.rm = TRUE))))
expect_true(all_obj_equal(fsummarise(gmtc, across(NULL, bsum, na.rm = TRUE)) %>% setLabels(NULL),
fsummarise(gmtc, across(NULL, fsum)) %>% setLabels(NULL),
dplyr::summarise(gmtc, dplyr::across(everything(), bsum, na.rm = TRUE), .groups = "drop")))
expect_equal(fsummarise(gmtc, across(NULL, bsum, na.rm = TRUE), keep.group_vars = FALSE),
fsummarise(gmtc, across(NULL, bsum, na.rm = TRUE)) %>% slt(-cyl,-vs,-am))
expect_equal(fsummarise(gmtc, across(cyl:vs, bsum)),
fsummarise(gmtc, cyl = bsum(cyl), across(disp:qsec, fsum), vs = fsum(vs)))
# Simple programming use
vlist <- list(mtc %>% fselect(hp:drat, return = "names"), NULL) # -(5:8), is.numeric
for(i in seq_along(vlist)) {
expect_true(all_obj_equal(fsummarise(gmtc, across(vlist[[i]], bsum)),
fsummarise(gmtc, across(vlist[[i]], fsum)),
dplyr::summarise(gmtc, dplyr::across(if(is.null(vlist[[i]])) everything() else vlist[[i]], bsum), .groups = "drop")))
v <- vlist[[i]]
expect_true(all_obj_equal(fsummarise(gmtc, across(v, bsum)),
fsummarise(gmtc, across(v, fsum)),
dplyr::summarise(gmtc, dplyr::across(if(is.null(v)) everything() else v, bsum), .groups = "drop")))
}
# Simple usage and multiple functions
expect_true(all_obj_equal(fsummarise(gmtc, across(hp:drat, list(bmean, bsum))),
fsummarise(gmtc, across(hp:drat, list(bmean = fmean, bsum = fsum))),
dplyr::summarise(gmtc, dplyr::across(hp:drat, list(bmean = bmean, bsum = bsum)), .groups = "drop")))
expect_true(all_obj_equal(fsummarise(gmtc, across(NULL, list(bmean, bsum))),
fsummarise(gmtc, across(NULL, list(bmean = fmean, bsum = fsum))),
dplyr::summarise(gmtc, dplyr::across(everything(), list(bmean = bmean, bsum = bsum)), .groups = "drop")))
# Passing additional arguments
expect_true(all_obj_equal(fsummarise(gwld, across(c("PCGDP", "LIFEEX"), bsum, na.rm = TRUE)) %>% setLabels(NULL),
fsummarise(gwld, across(c("PCGDP", "LIFEEX"), fsum, na.rm = TRUE)) %>% setLabels(NULL) %>% replace_NA(),
dplyr::summarise(gwld, dplyr::across(c("PCGDP", "LIFEEX"), bsum, na.rm = TRUE), .groups = "drop")))
expect_true(all_obj_equal(fsummarise(gmtc, across(hp:drat, weighted.mean, w = wt)),
fsummarise(gmtc, across(hp:drat, fmean, w = wt)),
dplyr::summarise(gmtc, dplyr::across(hp:drat, weighted.mean, w = wt), .groups = "drop")))
expect_equal(fsummarise(gmtc, across(cyl:vs, weighted.mean, w = wt)),
fsummarise(gmtc, cyl = weighted.mean(cyl, wt), across(disp:qsec, fmean, w = wt), vs = fmean(vs, wt)))
expect_true(all_obj_equal(fsummarise(gmtc, across(hp:drat, list(mean = weighted.mean, sum = fsum), w = wt)),
fsummarise(gmtc, across(hp:drat, list(mean = fmean, sum = fsum), w = wt)),
dplyr::summarise(gmtc, dplyr::across(hp:drat, list(mean = weighted.mean, sum = fsum), w = wt), .groups = "drop")))
# Simple programming use
flist <- list(bsum, list(bmean = bmean, bsum = bsum), list(bmean, bsum)) # c("bmean", "bsum"), c(mean = "fmean", sum = "fsum")
for(i in seq_along(flist)) {
expect_equal(fsummarise(gmtc, across(hp:drat, flist[[i]])),
dplyr::summarise(gmtc, dplyr::across(hp:drat, flist[[i]]), .groups = "drop"))
f <- flist[[i]]
expect_equal(fsummarise(gmtc, across(hp:drat, f)),
dplyr::summarise(gmtc, dplyr::across(hp:drat, f), .groups = "drop"))
}
})
}
test_that("fsummarise miscellaneous things", {
expect_equal(smr(gmtc, acr(disp:hp, c("bmean", "bsd"))),
fsummarise(gmtc, across(disp:hp, c("bmean", "bsd"), .transpose = FALSE)) %>%
colorderv(c(4,6,5,7), pos = "exchange"))
expect_identical(names(smr(gmtc, acr(disp:hp, fmean, .names = TRUE)))[4:5], c("disp_fmean", "hp_fmean"))
expect_identical(names(smr(gmtc, acr(disp:hp, bmean, .names = TRUE)))[4:5], c("disp_bmean", "hp_bmean"))
pwcorDF <- function(x, w = NULL) qDF(pwcor(x, w = w), "var")
expect_equal(
mtcars %>% gby(cyl) %>% smr(acr(disp:hp, pwcorDF, .apply = FALSE)),
rsplit(mtcars, disp + hp ~ cyl) %>% lapply(pwcorDF) %>% unlist2d("cyl", "var") %>% tfm(cyl = as.numeric(cyl))
)
if(identical(Sys.getenv("LOCAL"), "TRUE")) # No tests depending on suggested package (except for major ones).
expect_equal(
mtcars %>% gby(cyl) %>% smr(acr(disp:hp, pwcorDF, w = wt, .apply = FALSE)),
rsplit(mtcars, disp + hp + wt ~ cyl) %>% lapply(function(x) pwcorDF(gv(x, 1:2), w = x$wt)) %>%
unlist2d("cyl", "var") %>% tfm(cyl = as.numeric(cyl))
)
if(requireNamespace("data.table", quietly = TRUE)) {
lmest <- function(x) list(Mods = list(lm(disp~., x)))
expect_equal(
qDT(mtcars) %>% gby(cyl) %>% smr(acr(disp:hp, lmest, .apply = FALSE)),
qDT(mtcars) %>% rsplit(disp + hp ~ cyl) %>% lapply(lmest) %>% data.table::rbindlist(idcol = "cyl") %>%
tfm(cyl = as.numeric(cyl))
)
}
})
if(NCRAN) {
test_that("fmutate works as intended for simple usage", {
expect_equal(fmutate(mtc, bla = 1), dplyr::mutate(mtc, bla = 1))
expect_equal(fmutate(mtc, mu = bmean(mpg)), dplyr::mutate(mtc, mu = bmean(mpg)))
expect_equal(fmutate(mtc, mu = bmean(mpg), mpg = NULL), dplyr::mutate(mtc, mu = bmean(mpg), mpg = NULL))
expect_equal(fmutate(mtc, mu = bmean(mpg), dmu = mpg - mu), dplyr::mutate(mtc, mu = bmean(mpg), dmu = mpg - mu))
expect_equal(fmutate(mtc, mu = log(mpg)), dplyr::mutate(mtc, mu = log(mpg)))
expect_equal(fmutate(mtc, mu = log(mpg), dmu = mpg - mu), dplyr::mutate(mtc, mu = log(mpg), dmu = mpg - mu))
expect_true(all_obj_equal(
dplyr::mutate(mtc, dmu = mpg - bmean(mpg)),
fmutate(mtc, dmu = mpg - bmean(mpg)),
fmutate(mtc, dmu = mpg - fmean(mpg)),
fmutate(mtc, dmu = fmean(mpg, TRA = "-")),
fmutate(mtc, dmu = fwithin(mpg))
))
# With groups:
expect_equal(fmutate(gmtc, bla = 1), dplyr::mutate(gmtc, bla = 1))
expect_equal(fmutate(gmtc, mu = bmean(mpg)), dplyr::mutate(gmtc, mu = bmean(mpg)))
expect_equal(fmutate(gmtc, mu = bmean(mpg), mpg = NULL), dplyr::mutate(gmtc, mu = bmean(mpg), mpg = NULL))
expect_equal(fmutate(gmtc, mu = bmean(mpg), dmu = mpg - mu), dplyr::mutate(gmtc, mu = bmean(mpg), dmu = mpg - mu))
expect_equal(fmutate(gmtc, mu = log(mpg)), dplyr::mutate(gmtc, mu = log(mpg)))
expect_equal(fmutate(gmtc, mu = log(mpg), dmu = mpg - mu), dplyr::mutate(gmtc, mu = log(mpg), dmu = mpg - mu))
expect_true(all_obj_equal(
dplyr::mutate(gmtc, dmu = mpg - bmean(mpg)),
fmutate(gmtc, dmu = mpg - bmean(mpg)),
fmutate(gmtc, dmu = mpg - fmean(mpg)),
fmutate(gmtc, dmu = fmean(mpg, TRA = "-")),
fmutate(gmtc, dmu = fwithin(mpg))
))
})
}
test_that("fmutate with across works like ftransformv", {
expect_true(all_obj_equal(
ftransformv(mtcars, cyl:vs, fwithin, w = wt, apply = TRUE),
ftransformv(mtcars, cyl:vs, fwithin, w = wt, apply = FALSE),
fmutate(mtcars, across(cyl:vs, fwithin, w = wt, .apply = TRUE)),
fmutate(mtcars, across(cyl:vs, fwithin, w = wt, .apply = FALSE))
# fmutate(mtcars, fwithin(.data, w = .data[["wt"]]), .cols = slt(., cyl:vs, return = "names"))
))
expect_true(all_obj_equal(
ftransformv(mtcars, cyl:vs, fwithin, g = list(cyl, vs, am), apply = TRUE) %>% setRownames(),
ftransformv(mtcars, cyl:vs, fwithin, g = list(cyl, vs, am), apply = FALSE) %>% setRownames(),
fmutate(gmtc, across(cyl:vs, fwithin, .apply = TRUE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, fwithin, .apply = FALSE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, fmean, TRA = "-", .apply = TRUE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, fmean, TRA = "-", .apply = FALSE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, function(x) x - bmean(x), .apply = TRUE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, function(x) lapply(x, function(y) y - bmean(y)), .apply = FALSE)) %>% qDF(),
gmtc %>% fmutate(fwithin(.data), .cols = slt(., cyl:vs, return = "names")) %>% qDF()
))
expect_true(all_obj_equal(
ftransformv(mtcars, cyl:vs, fwithin, g = list(cyl, vs, am), w = wt, apply = TRUE) %>% setRownames(),
ftransformv(mtcars, cyl:vs, fwithin, g = list(cyl, vs, am), w = wt, apply = FALSE) %>% setRownames(),
fmutate(gmtc, across(cyl:vs, fwithin, w = wt, .apply = TRUE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, fwithin, w = wt, .apply = FALSE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, fmean, TRA = "-", w = wt, .apply = TRUE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, fmean, TRA = "-", w = wt, .apply = FALSE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, function(x, w) x - weighted.mean(x, w), w = wt, .apply = TRUE)) %>% qDF()
))
})
test_that("fmutate with across reorders correctly", {
for(i in seq_col(wlddev)) {
gdf <- fgroup_by(wlddev, i)
expect_true(all_identical(
wlddev,
fungroup(fmutate(gdf, across(c(PCGDP, LIFEEX), identity))),
fungroup(fmutate(gdf, across(.fns = identity))),
fungroup(fmutate(gdf, list(PCGDP = PCGDP, LIFEEX = LIFEEX))),
fungroup(fmutate(gdf, (.data), .cols = .c(PCGDP, LIFEEX))),
fungroup(fmutate(gdf, (.data)))
))
}
})
test_that("fsummarise and fmutate with arbitrary expressions", {
expect_true(
all_obj_equal(
fsummarise(gmtc, qDF(cor(cbind(mpg, wt, hp))), mpg_qs = quantile(mpg, c(0.25, 0.5, 0.75))),
fsummarise(gmtc, acr(c(mpg, wt, hp), function(x) qDF(cor(x)), .apply = FALSE), mpg_qs = quantile(mpg, c(0.25, 0.5, 0.75))),
fsummarise(gmtc, qDF(cor(.data)), .cols = .c(mpg, wt, hp), mpg_qs = quantile(mpg, c(0.25, 0.5, 0.75))),
fsummarise(gmtc, qDF(cor(slt(.data, mpg, wt, hp))), mpg_qs = quantile(mpg, c(0.25, 0.5, 0.75))))
)
expect_true(
all_obj_equal(
fmutate(gmtc, fscale(list(mpg = mpg, wt = wt, hp = hp)), bla = 1, mu = fmean(mpg), su = sum(hp)),
fmutate(gmtc, acr(c(mpg, wt, hp), fscale), bla = 1, mu = fmean(mpg), su = sum(hp)),
fmutate(gmtc, acr(c(mpg, wt, hp), function(x) fscale(x), .apply = FALSE), bla = 1, mu = fmean(mpg), su = sum(hp)),
fmutate(gmtc, fscale(.data), .cols = .c(mpg, wt, hp), bla = 1, mu = fmean(mpg), su = sum(hp)),
fmutate(gmtc, fscale(slt(.data, mpg, wt, hp)), bla = 1, mu = fmean(mpg), su = sum(hp)))
)
expect_equal(fmutate(gmtc, acr(NULL, fscale)), fmutate(gmtc, fscale(.data)))
expect_equal(fmutate(gmtc, acr(mpg:carb, fscale)), fmutate(gmtc, fscale(.data), .cols = seq_col(gmtc)))
})
if(NCRAN) {
test_that("fmutate miscellaneous", {
expect_true(length(fmutate(mtcars, across(cyl:vs, W, w = wt, .names = NULL))) > 15)
expect_true(length(fmutate(mtcars, across(cyl:vs, list(D, W), .names = FALSE, .transpose = FALSE))) > 15)
expect_equal( fmutate(mtcars, across(cyl:vs, L, stubs = FALSE)),
fmutate(mtcars, across(cyl:vs, flag))
)
expect_true(length(fmutate(mtcars, across(cyl:vs, L))) > length(fmutate(mtcars, across(cyl:vs, flag))))
expect_equal(
fmutate(mtcars, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "used"),
dplyr::mutate(mtcars, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "used")
)
expect_equal(
fmutate(mtcars, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "unused"),
dplyr::mutate(mtcars, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "unused")
)
expect_equal(
fmutate(mtcars, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "none"),
dplyr::transmute(mtcars, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb)
)
expect_identical(names(fmutate(mtcars, a = mpg, b = a, c = cyl, hp = wt, .keep = "unused")), c(setdiff(names(mtcars), .c(mpg, cyl, wt)), letters[1:3]))
expect_identical(names(fmutate(mtcars, a = mpg, b = a, c = cyl, hp = wt, .keep = "none")), c("a", "b", "c", "hp"))
expect_equal(
fmutate(gmtc, a = fmax(mpg), b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "used"),
dplyr::mutate(gmtc, a = bmax(mpg), b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "used")
)
expect_equal(
fmutate(gmtc, a = fmax(mpg), b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "unused"),
dplyr::mutate(gmtc, a = bmax(mpg), b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "unused")
)
expect_equal(
fmutate(gmtc, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "none"),
dplyr::transmute(gmtc, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb)
)
# Inconsistent with the above and also inefficient...
# expect_equal(
# fmutate(gmtc, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb, cyl = cyl, .keep = "none"),
# dplyr::mutate(gmtc, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb, cyl = cyl, .keep = "none")
# )
expect_equal(flast(names(fmutate(mtcars, across(cyl:vs, function(x) list(ps = kit::psum(x)), .apply = FALSE)))), "ps")
expect_equal(
fmutate(mtcars, across(cyl:vs, data.table::shift, .apply = FALSE, .names = FALSE)),
fmutate(mtcars, across(cyl:vs, data.table::shift))
)
# Testing expressions turned into functions:
bcumsum = base::cumsum
lorentz_fun <- function(x) bcumsum(x) / bsum(x)
gmtc = mtc %>% roworder(mpg) %>% dplyr::group_by(cyl, vs, am)
expect_true(all_obj_equal(mtt(gmtc, lorentz_mpg = bcumsum(mpg) / bsum(mpg)),
mtt(gmtc, lorentz_mpg = lorentz_fun(mpg)),
mtt(gmtc, lorentz_mpg = fcumsum(mpg) / fsum(mpg)), # doesn't work because of global sorting...
dplyr::mutate(gmtc, lorentz_mpg = bcumsum(mpg) / bsum(mpg))))
# Adding global variable:
q = 5
expect_true(all_obj_equal(mtt(gmtc, lorentz_mpg = bcumsum(mpg) / bsum(mpg) + q),
mtt(gmtc, lorentz_mpg = lorentz_fun(mpg) + q),
mtt(gmtc, lorentz_mpg = fcumsum(mpg) / fsum(mpg) + q),
dplyr::mutate(gmtc, lorentz_mpg = bcumsum(mpg) / bsum(mpg) + q)))
})
}
test_that(".names works properly", {
expect_equal(
smr(gmtc, acr(c(hp, wt), list(sum, max, min))),
smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = TRUE))
)
expect_equal(
smr(gmtc, acr(c(hp, wt), list(sum, max, min))),
smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = function(c, f) paste0(c, "_", f)))
)
expect_equal(
smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = "flip")),
smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = function(c, f) paste0(f, "_", c)))
)
expect_equal(
smr(gmtc, acr(c(hp, wt), list(sum, max, min), .transpose = FALSE)),
smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = function(c, f) paste0(c, "_", f), .transpose = FALSE))
)
expect_equal(
smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = "flip", .transpose = FALSE)),
smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = function(c, f) paste0(f, "_", c), .transpose = FALSE))
)
expect_equal(
names(smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = FALSE))),
.c(cyl, vs, am, hp, hp, hp, wt, wt, wt)
)
expect_equal(
names(smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = FALSE, .transpose = FALSE))),
.c(cyl, vs, am, hp, wt, hp, wt, hp, wt)
)
expect_equal(
names(smr(gmtc, acr(c(hp, wt), sum, .names = FALSE))),
.c(cyl, vs, am, hp, wt)
)
expect_equal(
names(smr(gmtc, acr(c(hp, wt), sum, .names = FALSE, .transpose = FALSE))),
.c(cyl, vs, am, hp, wt)
)
expect_equal(
names(smr(gmtc, acr(c(hp, wt), sum, .names = TRUE))),
.c(cyl, vs, am, hp_sum, wt_sum)
)
expect_equal(
names(smr(gmtc, acr(c(hp, wt), sum, .names = "flip"))),
.c(cyl, vs, am, sum_hp, sum_wt)
)
expect_equal(
names(smr(gmtc, acr(c(hp, wt), sum, .names = "flip", .transpose = FALSE))),
.c(cyl, vs, am, sum_hp, sum_wt)
)
})
test_that("Warnings for unnamed scalar and vector-valued arguments passed", {
tf <- function(x, ...) x
expect_warning(mtt(gmtc, acr(hp:carb, tf, TRUE, wt)))
expect_warning(mtt(gmtc, acr(hp:carb, tf, wt, TRUE)))
expect_warning(mtt(gmtc, acr(hp:carb, tf, TRUE, wt, .apply = FALSE)))
expect_warning(mtt(gmtc, acr(hp:carb, tf, wt, TRUE, .apply = FALSE)))
})
if(FALSE) {
fmutate(mtcars, across(cyl:vs, list(D, W), .names = TRUE, .transpose = FALSE)) %>% head(3)
fmutate(mtcars, across(cyl:vs, list(D, W), .names = TRUE, .transpose = TRUE)) %>% head(3)
fmutate(mtcars, across(cyl:vs, list(D, W), .names = TRUE, .apply = FALSE, .transpose = FALSE)) %>% head(3)
fmutate(mtcars, across(cyl:vs, list(D, W), .names = FALSE, .apply = FALSE, .transpose = FALSE)) %>% head(3)
fmutate(mtcars, across(cyl:vs, list(W, kit::psum), w = wt)) %>% head(3)
fmutate(mtcars, across(cyl:vs, kit::psum)) %>% head(3)
fmutate(mtcars, across(cyl:vs, identity, .apply = FALSE)) # 51 microesecond median on windows
fmutate(mtcars, across(cyl:vs, identity)) # 62 microesecond median on windows
fmutate(mtcars, across(cyl:vs, L))
# TODO: Test all potential issues with environemtns etc. See if there are smarter ways to
# incorporate internal functions, data and objects in the global environment.
}
}
SebKrantz/collapse documentation built on Dec. 16, 2024, 7:26 p.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.
context("fsummarise and fmutate")
expect_equal(1, 1)
if(requireNamespace("magrittr", quietly = TRUE) && requireNamespace("dplyr", quietly = TRUE)) {
library(magrittr)
bmean <- base::mean
bsum <- base::sum
bsd <- stats::sd
bmin <- base::min
bmax <- base::max
NCRAN <- identical(Sys.getenv("NCRAN"), "TRUE")
mtc <- dplyr::as_tibble(mtcars)
gmtc <- dplyr::group_by(mtc, cyl, vs, am)
expect_equal(gsplit(mtcars$mpg, GRP(gmtc), TRUE), split(mtcars$mpg, as_factor_GRP(GRP(gmtc))))
if(NCRAN) {
test_that("fsummarise works like dplyr::summarise for tagged vector expressions", {
# Simple computations
expect_equal(smr(mtc, mu = bmean(mpg), sigma = bsd(mpg)), dplyr::summarise(mtc, mu = bmean(mpg), sigma = bsd(mpg)))
# TODO: Could expand like this as well... but who needs this?
# expect_false(all_obj_equal(smr(mtc, mu = bmean(mpg), sigma = bsd(mpg), q = quantile(mpg)),
# dplyr::summarise(mtc, mu = bmean(mpg), sigma = bsd(mpg), q = quantile(mpg))))
expect_equal(smr(mtc, mu = bmean(mpg) + bsd(mpg)), dplyr::summarise(mtc, mu = bmean(mpg) + bsd(mpg)))
expect_equal(smr(mtc, mu = bmean(mpg) + 3), dplyr::summarise(mtc, mu = bmean(mpg) + 3))
q <- 5
expect_equal(smr(mtc, mu = bmean(mpg) + q), dplyr::summarise(mtc, mu = bmean(mpg) + q))
v <- mtcars$disp
expect_equal(smr(mtc, mu = bmean(mpg) + bmean(v)), dplyr::summarise(mtc, mu = bmean(mpg) + bmean(v)))
# Grouped computations
expect_equal(smr(gmtc, mpg = fmean(mpg)), dplyr::summarise(gmtc, mpg = bmean(mpg), .groups = "drop"))
expect_equal(smr(gmtc, mpg = bmean(mpg)), dplyr::summarise(gmtc, mpg = bmean(mpg), .groups = "drop"))
expect_equal(smr(gmtc, mpg = fmean(mpg), carb = fmax(carb)),
dplyr::summarise(gmtc, mpg = bmean(mpg), carb = bmax(carb), .groups = "drop"))
expect_equal(smr(gmtc, mpg = fmean(mpg), carb = bmax(carb)),
dplyr::summarise(gmtc, mpg = bmean(mpg), carb = bmax(carb), .groups = "drop"))
expect_equal(smr(gmtc, mpg = bmean(mpg), carb = bmax(carb)),
dplyr::summarise(gmtc, mpg = bmean(mpg), carb = bmax(carb), .groups = "drop"))
expect_equal(smr(gmtc, mpg = bmean(mpg), carb = fmax(carb)),
dplyr::summarise(gmtc, mpg = bmean(mpg), carb = bmax(carb), .groups = "drop"))
expect_equal(fsummarise(gmtc, mpg = bmean(mpg), carb = fmax(carb), keep.group_vars = FALSE),
fsummarise(gmtc, mpg = bmean(mpg), carb = fmax(carb)) %>% slt(-cyl,-vs,-am))
# Multi-return values
expect_equal(smr(gmtc, mpg = quantile(mpg)),
dplyr::summarise(gmtc, mpg = quantile(mpg), .groups = "drop") %>% tfm(mpg = unname(mpg)))
# More complex expressions
expect_equal(smr(gmtc, mpg = bmean(mpg) + 1),
dplyr::summarise(gmtc, mpg = bmean(mpg) + 1, .groups = "drop"))
expect_equal(smr(gmtc, mpg = bmean(mpg) + q),
dplyr::summarise(gmtc, mpg = bmean(mpg) + q, .groups = "drop"))
expect_equal(smr(gmtc, mpg = quantile(mpg) + q),
dplyr::summarise(gmtc, mpg = quantile(mpg) + q, .groups = "drop") %>% tfm(mpg = unname(mpg)))
expect_equal(smr(gmtc, mpg = bmean(mpg) + bmax(v)),
dplyr::summarise(gmtc, mpg = bmean(mpg) + bmax(v), .groups = "drop"))
expect_equal(smr(gmtc, mpg = quantile(mpg) + bmax(v)),
dplyr::summarise(gmtc, mpg = quantile(mpg) + bmax(v), .groups = "drop") %>% tfm(mpg = unname(mpg)))
expect_equal(smr(gmtc, mpg = bmean(log(mpg))),
dplyr::summarise(gmtc, mpg = bmean(log(mpg)), .groups = "drop"))
expect_equal(smr(gmtc, mpg = bmean(log(mpg)) + bmax(qsec)),
dplyr::summarise(gmtc, mpg = bmean(log(mpg)) + bmax(qsec), .groups = "drop"))
expect_equal(smr(gmtc, mpg = quantile(mpg) + bmax(qsec)),
dplyr::summarise(gmtc, mpg = quantile(mpg) + bmax(qsec), .groups = "drop") %>% tfm(mpg = unname(mpg)))
expect_equal(smr(gmtc, mpg = fmean(log(mpg)) + fmax(qsec)),
dplyr::summarise(gmtc, mpg = bmean(log(mpg)) + bmax(qsec), .groups = "drop"))
expect_false(all_obj_equal(smr(gmtc, mpg = fmean(log(mpg)) + bmax(qsec)),
dplyr::summarise(gmtc, mpg = bmean(log(mpg)) + bmax(qsec), .groups = "drop")))
# Testing expressions turned into functions:
mid_fun <- function(x) (bmin(x) + bmax(x)) / 2
expect_true(all_obj_equal(smr(gmtc, mid_mpg = (bmin(mpg) + bmax(mpg)) / 2),
smr(gmtc, mid_mpg = (fmin(mpg) + fmax(mpg)) / 2),
smr(gmtc, mid_mpg = mid_fun(mpg)),
dplyr::summarise(gmtc, mid_mpg = (bmin(mpg) + bmax(mpg)) / 2, .groups = "drop")))
# Adding global variable:
expect_true(all_obj_equal(smr(gmtc, mid_mpg = (bmin(mpg) + bmax(mpg)) / 2 + q),
smr(gmtc, mid_mpg = (fmin(mpg) + fmax(mpg)) / 2 + q),
smr(gmtc, mid_mpg = mid_fun(mpg) + q),
dplyr::summarise(gmtc, mid_mpg = (bmin(mpg) + bmax(mpg)) / 2 + q, .groups = "drop")))
# Weighted computations
expect_equal(smr(gmtc, mpg = weighted.mean(mpg, wt)), dplyr::summarise(gmtc, mpg = weighted.mean(mpg, wt), .groups = "drop"))
expect_equal(smr(gmtc, mpg = fmean(mpg, wt)), dplyr::summarise(gmtc, mpg = fmean(mpg, w = wt), .groups = "drop"))
expect_equal(smr(gmtc, mpg = weighted.mean(mpg, wt) + 5.5), dplyr::summarise(gmtc, mpg = weighted.mean(mpg, wt) + 5.5, .groups = "drop"))
expect_equal(smr(gmtc, mpg = fmean(mpg, wt) + 5.5), dplyr::summarise(gmtc, mpg = fmean(mpg, w = wt) + 5.5, .groups = "drop"))
expect_equal(smr(gmtc, mpg = weighted.mean(mpg, wt) + q), dplyr::summarise(gmtc, mpg = weighted.mean(mpg, wt) + q, .groups = "drop"))
expect_equal(smr(gmtc, mpg = fmean(mpg, wt) + q), dplyr::summarise(gmtc, mpg = fmean(mpg, w = wt) + q, .groups = "drop"))
expect_equal(smr(gmtc, mpg = weighted.mean(mpg, wt) + bmax(v)), dplyr::summarise(gmtc, mpg = weighted.mean(mpg, wt) + bmax(v), .groups = "drop"))
expect_equal(smr(gmtc, mpg = fmean(mpg, wt) + bmax(v)), dplyr::summarise(gmtc, mpg = fmean(mpg, w = wt) + bmax(v), .groups = "drop"))
expect_equal(smr(gmtc, mpg = weighted.mean(mpg, wt) + bmax(qsec)),
dplyr::summarise(gmtc, mpg = weighted.mean(mpg, wt) + bmax(qsec), .groups = "drop"))
expect_equal(smr(gmtc, mpg = fmean(mpg, wt) + fmax(qsec)),
dplyr::summarise(gmtc, mpg = fmean(mpg, w = wt) + bmax(qsec), .groups = "drop"))
expect_equal(smr(gmtc, mpg = quantile(mpg) + weighted.mean(mpg, wt)),
dplyr::summarise(gmtc, mpg = quantile(mpg) + weighted.mean(mpg, wt), .groups = "drop") %>% tfm(mpg = unname(mpg)))
expect_warning(smr(gmtc, mpg = quantile(mpg) + fmean(mpg, wt)))
})
}
wld <- dplyr::as_tibble(wlddev)
gwld <- dplyr::group_by(wlddev, iso3c)
if(NCRAN) {
test_that("fsummarise works like dplyr::summarise with across and simple usage", {
# Simple usage
expect_true(all_obj_equal(fsummarise(mtc, across(cyl:drat, bsum)),
fsummarise(mtc, across(cyl:drat, fsum)),
dplyr::summarise(mtc, dplyr::across(cyl:drat, bsum))))
expect_true(all_obj_equal(fsummarise(mtc, across(5:8, bsum)),
fsummarise(mtc, across(5:8, fsum)),
dplyr::summarise(mtc, dplyr::across(5:8, bsum))))
expect_true(all_obj_equal(fsummarise(mtc, across(-(5:8), bsum)),
fsummarise(mtc, across(-(5:8), fsum, .apply = FALSE)),
dplyr::summarise(mtc, dplyr::across(-(5:8), bsum))))
expect_true(all_obj_equal(fsummarise(wld, across(is.numeric, bsum, na.rm = TRUE)),
fsummarise(wld, across(is.numeric, fsum)) %>% dapply(unattrib, drop = FALSE),
dplyr::summarise(wld, dplyr::across(where(is.numeric), bsum, na.rm = TRUE))))
expect_true(all_obj_equal(fsummarise(mtc, across(NULL, bsum, na.rm = TRUE)),
fsummarise(mtc, across(NULL, fsum)),
dplyr::summarise(mtc, dplyr::across(everything(), bsum, na.rm = TRUE))))
expect_equal(fsummarise(mtc, across(cyl:vs, bsum)),
fsummarise(mtc, cyl = bsum(cyl), across(disp:qsec, fsum), vs = fsum(vs)))
# Simple programming use
vlist <- list(mtc %>% fselect(cyl:drat, return = "names"), 5:8, NULL) # -(5:8), is.numeric
for(i in seq_along(vlist)) {
expect_true(all_obj_equal(fsummarise(mtc, across(vlist[[i]], bsum)),
fsummarise(mtc, across(vlist[[i]], fsum)),
dplyr::summarise(mtc, dplyr::across(if(is.null(vlist[[i]])) everything() else vlist[[i]], bsum))))
v <- vlist[[i]]
expect_true(all_obj_equal(fsummarise(mtc, across(v, bsum)),
fsummarise(mtc, across(v, fsum)),
dplyr::summarise(mtc, dplyr::across(if(is.null(v)) everything() else v, bsum))))
}
# Simple usage and multiple functions
expect_true(all_obj_equal(fsummarise(mtc, across(cyl:drat, list(bmean, bsum))),
fsummarise(mtc, across(cyl:drat, list(bmean = fmean, bsum = fsum))),
dplyr::summarise(mtc, dplyr::across(cyl:drat, list(bmean = bmean, bsum = bsum)))))
expect_true(all_obj_equal(fsummarise(mtc, across(NULL, list(bmean, bsum))),
fsummarise(mtc, across(NULL, list(bmean = fmean, bsum = fsum))),
dplyr::summarise(mtc, dplyr::across(everything(), list(bmean = bmean, bsum = bsum)))))
# Passing additional arguments
expect_true(all_obj_equal(fsummarise(mtc, across(cyl:drat, bsum, na.rm = FALSE)),
fsummarise(mtc, across(cyl:drat, fsum, na.rm = FALSE)),
dplyr::summarise(mtc, dplyr::across(cyl:drat, bsum, na.rm = FALSE))))
expect_true(all_obj_equal(fsummarise(mtc, across(cyl:drat, weighted.mean, w = wt)),
fsummarise(mtc, across(cyl:drat, fmean, w = wt)),
dplyr::summarise(mtc, dplyr::across(cyl:drat, weighted.mean, w = wt))))
expect_true(all_obj_equal(fsummarise(mtc, across(cyl:drat, list(mean = weighted.mean, sum = fsum), w = wt)),
fsummarise(mtc, across(cyl:drat, list(mean = fmean, sum = fsum), w = wt)),
dplyr::summarise(mtc, dplyr::across(cyl:drat, list(mean = weighted.mean, sum = fsum), w = wt))))
# Simple programming use
flist <- list(bsum, list(bmean = bmean, bsum = bsum), list(bmean, bsum)) # c("bmean", "bsum"), c(mean = "fmean", sum = "fsum")
for(i in seq_along(flist)) {
expect_equal(fsummarise(mtc, across(cyl:drat, flist[[i]])),
dplyr::summarise(mtc, dplyr::across(cyl:drat, flist[[i]])))
f <- flist[[i]]
expect_equal(fsummarise(mtc, across(cyl:drat, f)),
dplyr::summarise(mtc, dplyr::across(cyl:drat, f)))
}
})
test_that("fsummarise works like dplyr::summarise with across and grouped usage", {
# Simple usage
expect_true(all_obj_equal(fsummarise(gmtc, across(hp:drat, bsum)),
fsummarise(gmtc, across(hp:drat, fsum)),
dplyr::summarise(gmtc, dplyr::across(hp:drat, bsum), .groups = "drop")))
expect_true(all_obj_equal(fsummarise(gmtc, across(5:7, bsum)),
fsummarise(gmtc, across(5:7, fsum)),
dplyr::summarise(gmtc, dplyr::across(4:6, bsum), .groups = "drop")))
expect_true(all_obj_equal(fsummarise(gwld, across(is.numeric, bsum, na.rm = TRUE)) %>% setLabels(NULL),
fsummarise(gwld, across(is.numeric, fsum)) %>% replace_NA() %>% setLabels(NULL),
dplyr::summarise(gwld, dplyr::across(where(is.numeric), bsum, na.rm = TRUE))))
expect_true(all_obj_equal(fsummarise(gmtc, across(NULL, bsum, na.rm = TRUE)) %>% setLabels(NULL),
fsummarise(gmtc, across(NULL, fsum)) %>% setLabels(NULL),
dplyr::summarise(gmtc, dplyr::across(everything(), bsum, na.rm = TRUE), .groups = "drop")))
expect_equal(fsummarise(gmtc, across(NULL, bsum, na.rm = TRUE), keep.group_vars = FALSE),
fsummarise(gmtc, across(NULL, bsum, na.rm = TRUE)) %>% slt(-cyl,-vs,-am))
expect_equal(fsummarise(gmtc, across(cyl:vs, bsum)),
fsummarise(gmtc, cyl = bsum(cyl), across(disp:qsec, fsum), vs = fsum(vs)))
# Simple programming use
vlist <- list(mtc %>% fselect(hp:drat, return = "names"), NULL) # -(5:8), is.numeric
for(i in seq_along(vlist)) {
expect_true(all_obj_equal(fsummarise(gmtc, across(vlist[[i]], bsum)),
fsummarise(gmtc, across(vlist[[i]], fsum)),
dplyr::summarise(gmtc, dplyr::across(if(is.null(vlist[[i]])) everything() else vlist[[i]], bsum), .groups = "drop")))
v <- vlist[[i]]
expect_true(all_obj_equal(fsummarise(gmtc, across(v, bsum)),
fsummarise(gmtc, across(v, fsum)),
dplyr::summarise(gmtc, dplyr::across(if(is.null(v)) everything() else v, bsum), .groups = "drop")))
}
# Simple usage and multiple functions
expect_true(all_obj_equal(fsummarise(gmtc, across(hp:drat, list(bmean, bsum))),
fsummarise(gmtc, across(hp:drat, list(bmean = fmean, bsum = fsum))),
dplyr::summarise(gmtc, dplyr::across(hp:drat, list(bmean = bmean, bsum = bsum)), .groups = "drop")))
expect_true(all_obj_equal(fsummarise(gmtc, across(NULL, list(bmean, bsum))),
fsummarise(gmtc, across(NULL, list(bmean = fmean, bsum = fsum))),
dplyr::summarise(gmtc, dplyr::across(everything(), list(bmean = bmean, bsum = bsum)), .groups = "drop")))
# Passing additional arguments
expect_true(all_obj_equal(fsummarise(gwld, across(c("PCGDP", "LIFEEX"), bsum, na.rm = TRUE)) %>% setLabels(NULL),
fsummarise(gwld, across(c("PCGDP", "LIFEEX"), fsum, na.rm = TRUE)) %>% setLabels(NULL) %>% replace_NA(),
dplyr::summarise(gwld, dplyr::across(c("PCGDP", "LIFEEX"), bsum, na.rm = TRUE), .groups = "drop")))
expect_true(all_obj_equal(fsummarise(gmtc, across(hp:drat, weighted.mean, w = wt)),
fsummarise(gmtc, across(hp:drat, fmean, w = wt)),
dplyr::summarise(gmtc, dplyr::across(hp:drat, weighted.mean, w = wt), .groups = "drop")))
expect_equal(fsummarise(gmtc, across(cyl:vs, weighted.mean, w = wt)),
fsummarise(gmtc, cyl = weighted.mean(cyl, wt), across(disp:qsec, fmean, w = wt), vs = fmean(vs, wt)))
expect_true(all_obj_equal(fsummarise(gmtc, across(hp:drat, list(mean = weighted.mean, sum = fsum), w = wt)),
fsummarise(gmtc, across(hp:drat, list(mean = fmean, sum = fsum), w = wt)),
dplyr::summarise(gmtc, dplyr::across(hp:drat, list(mean = weighted.mean, sum = fsum), w = wt), .groups = "drop")))
# Simple programming use
flist <- list(bsum, list(bmean = bmean, bsum = bsum), list(bmean, bsum)) # c("bmean", "bsum"), c(mean = "fmean", sum = "fsum")
for(i in seq_along(flist)) {
expect_equal(fsummarise(gmtc, across(hp:drat, flist[[i]])),
dplyr::summarise(gmtc, dplyr::across(hp:drat, flist[[i]]), .groups = "drop"))
f <- flist[[i]]
expect_equal(fsummarise(gmtc, across(hp:drat, f)),
dplyr::summarise(gmtc, dplyr::across(hp:drat, f), .groups = "drop"))
}
})
}
test_that("fsummarise miscellaneous things", {
expect_equal(smr(gmtc, acr(disp:hp, c("bmean", "bsd"))),
fsummarise(gmtc, across(disp:hp, c("bmean", "bsd"), .transpose = FALSE)) %>%
colorderv(c(4,6,5,7), pos = "exchange"))
expect_identical(names(smr(gmtc, acr(disp:hp, fmean, .names = TRUE)))[4:5], c("disp_fmean", "hp_fmean"))
expect_identical(names(smr(gmtc, acr(disp:hp, bmean, .names = TRUE)))[4:5], c("disp_bmean", "hp_bmean"))
pwcorDF <- function(x, w = NULL) qDF(pwcor(x, w = w), "var")
expect_equal(
mtcars %>% gby(cyl) %>% smr(acr(disp:hp, pwcorDF, .apply = FALSE)),
rsplit(mtcars, disp + hp ~ cyl) %>% lapply(pwcorDF) %>% unlist2d("cyl", "var") %>% tfm(cyl = as.numeric(cyl))
)
if(identical(Sys.getenv("LOCAL"), "TRUE")) # No tests depending on suggested package (except for major ones).
expect_equal(
mtcars %>% gby(cyl) %>% smr(acr(disp:hp, pwcorDF, w = wt, .apply = FALSE)),
rsplit(mtcars, disp + hp + wt ~ cyl) %>% lapply(function(x) pwcorDF(gv(x, 1:2), w = x$wt)) %>%
unlist2d("cyl", "var") %>% tfm(cyl = as.numeric(cyl))
)
if(requireNamespace("data.table", quietly = TRUE)) {
lmest <- function(x) list(Mods = list(lm(disp~., x)))
expect_equal(
qDT(mtcars) %>% gby(cyl) %>% smr(acr(disp:hp, lmest, .apply = FALSE)),
qDT(mtcars) %>% rsplit(disp + hp ~ cyl) %>% lapply(lmest) %>% data.table::rbindlist(idcol = "cyl") %>%
tfm(cyl = as.numeric(cyl))
)
}
})
if(NCRAN) {
test_that("fmutate works as intended for simple usage", {
expect_equal(fmutate(mtc, bla = 1), dplyr::mutate(mtc, bla = 1))
expect_equal(fmutate(mtc, mu = bmean(mpg)), dplyr::mutate(mtc, mu = bmean(mpg)))
expect_equal(fmutate(mtc, mu = bmean(mpg), mpg = NULL), dplyr::mutate(mtc, mu = bmean(mpg), mpg = NULL))
expect_equal(fmutate(mtc, mu = bmean(mpg), dmu = mpg - mu), dplyr::mutate(mtc, mu = bmean(mpg), dmu = mpg - mu))
expect_equal(fmutate(mtc, mu = log(mpg)), dplyr::mutate(mtc, mu = log(mpg)))
expect_equal(fmutate(mtc, mu = log(mpg), dmu = mpg - mu), dplyr::mutate(mtc, mu = log(mpg), dmu = mpg - mu))
expect_true(all_obj_equal(
dplyr::mutate(mtc, dmu = mpg - bmean(mpg)),
fmutate(mtc, dmu = mpg - bmean(mpg)),
fmutate(mtc, dmu = mpg - fmean(mpg)),
fmutate(mtc, dmu = fmean(mpg, TRA = "-")),
fmutate(mtc, dmu = fwithin(mpg))
))
# With groups:
expect_equal(fmutate(gmtc, bla = 1), dplyr::mutate(gmtc, bla = 1))
expect_equal(fmutate(gmtc, mu = bmean(mpg)), dplyr::mutate(gmtc, mu = bmean(mpg)))
expect_equal(fmutate(gmtc, mu = bmean(mpg), mpg = NULL), dplyr::mutate(gmtc, mu = bmean(mpg), mpg = NULL))
expect_equal(fmutate(gmtc, mu = bmean(mpg), dmu = mpg - mu), dplyr::mutate(gmtc, mu = bmean(mpg), dmu = mpg - mu))
expect_equal(fmutate(gmtc, mu = log(mpg)), dplyr::mutate(gmtc, mu = log(mpg)))
expect_equal(fmutate(gmtc, mu = log(mpg), dmu = mpg - mu), dplyr::mutate(gmtc, mu = log(mpg), dmu = mpg - mu))
expect_true(all_obj_equal(
dplyr::mutate(gmtc, dmu = mpg - bmean(mpg)),
fmutate(gmtc, dmu = mpg - bmean(mpg)),
fmutate(gmtc, dmu = mpg - fmean(mpg)),
fmutate(gmtc, dmu = fmean(mpg, TRA = "-")),
fmutate(gmtc, dmu = fwithin(mpg))
))
})
}
test_that("fmutate with across works like ftransformv", {
expect_true(all_obj_equal(
ftransformv(mtcars, cyl:vs, fwithin, w = wt, apply = TRUE),
ftransformv(mtcars, cyl:vs, fwithin, w = wt, apply = FALSE),
fmutate(mtcars, across(cyl:vs, fwithin, w = wt, .apply = TRUE)),
fmutate(mtcars, across(cyl:vs, fwithin, w = wt, .apply = FALSE))
# fmutate(mtcars, fwithin(.data, w = .data[["wt"]]), .cols = slt(., cyl:vs, return = "names"))
))
expect_true(all_obj_equal(
ftransformv(mtcars, cyl:vs, fwithin, g = list(cyl, vs, am), apply = TRUE) %>% setRownames(),
ftransformv(mtcars, cyl:vs, fwithin, g = list(cyl, vs, am), apply = FALSE) %>% setRownames(),
fmutate(gmtc, across(cyl:vs, fwithin, .apply = TRUE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, fwithin, .apply = FALSE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, fmean, TRA = "-", .apply = TRUE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, fmean, TRA = "-", .apply = FALSE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, function(x) x - bmean(x), .apply = TRUE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, function(x) lapply(x, function(y) y - bmean(y)), .apply = FALSE)) %>% qDF(),
gmtc %>% fmutate(fwithin(.data), .cols = slt(., cyl:vs, return = "names")) %>% qDF()
))
expect_true(all_obj_equal(
ftransformv(mtcars, cyl:vs, fwithin, g = list(cyl, vs, am), w = wt, apply = TRUE) %>% setRownames(),
ftransformv(mtcars, cyl:vs, fwithin, g = list(cyl, vs, am), w = wt, apply = FALSE) %>% setRownames(),
fmutate(gmtc, across(cyl:vs, fwithin, w = wt, .apply = TRUE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, fwithin, w = wt, .apply = FALSE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, fmean, TRA = "-", w = wt, .apply = TRUE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, fmean, TRA = "-", w = wt, .apply = FALSE)) %>% qDF(),
fmutate(gmtc, across(cyl:vs, function(x, w) x - weighted.mean(x, w), w = wt, .apply = TRUE)) %>% qDF()
))
})
test_that("fmutate with across reorders correctly", {
for(i in seq_col(wlddev)) {
gdf <- fgroup_by(wlddev, i)
expect_true(all_identical(
wlddev,
fungroup(fmutate(gdf, across(c(PCGDP, LIFEEX), identity))),
fungroup(fmutate(gdf, across(.fns = identity))),
fungroup(fmutate(gdf, list(PCGDP = PCGDP, LIFEEX = LIFEEX))),
fungroup(fmutate(gdf, (.data), .cols = .c(PCGDP, LIFEEX))),
fungroup(fmutate(gdf, (.data)))
))
}
})
test_that("fsummarise and fmutate with arbitrary expressions", {
expect_true(
all_obj_equal(
fsummarise(gmtc, qDF(cor(cbind(mpg, wt, hp))), mpg_qs = quantile(mpg, c(0.25, 0.5, 0.75))),
fsummarise(gmtc, acr(c(mpg, wt, hp), function(x) qDF(cor(x)), .apply = FALSE), mpg_qs = quantile(mpg, c(0.25, 0.5, 0.75))),
fsummarise(gmtc, qDF(cor(.data)), .cols = .c(mpg, wt, hp), mpg_qs = quantile(mpg, c(0.25, 0.5, 0.75))),
fsummarise(gmtc, qDF(cor(slt(.data, mpg, wt, hp))), mpg_qs = quantile(mpg, c(0.25, 0.5, 0.75))))
)
expect_true(
all_obj_equal(
fmutate(gmtc, fscale(list(mpg = mpg, wt = wt, hp = hp)), bla = 1, mu = fmean(mpg), su = sum(hp)),
fmutate(gmtc, acr(c(mpg, wt, hp), fscale), bla = 1, mu = fmean(mpg), su = sum(hp)),
fmutate(gmtc, acr(c(mpg, wt, hp), function(x) fscale(x), .apply = FALSE), bla = 1, mu = fmean(mpg), su = sum(hp)),
fmutate(gmtc, fscale(.data), .cols = .c(mpg, wt, hp), bla = 1, mu = fmean(mpg), su = sum(hp)),
fmutate(gmtc, fscale(slt(.data, mpg, wt, hp)), bla = 1, mu = fmean(mpg), su = sum(hp)))
)
expect_equal(fmutate(gmtc, acr(NULL, fscale)), fmutate(gmtc, fscale(.data)))
expect_equal(fmutate(gmtc, acr(mpg:carb, fscale)), fmutate(gmtc, fscale(.data), .cols = seq_col(gmtc)))
})
if(NCRAN) {
test_that("fmutate miscellaneous", {
expect_true(length(fmutate(mtcars, across(cyl:vs, W, w = wt, .names = NULL))) > 15)
expect_true(length(fmutate(mtcars, across(cyl:vs, list(D, W), .names = FALSE, .transpose = FALSE))) > 15)
expect_equal( fmutate(mtcars, across(cyl:vs, L, stubs = FALSE)),
fmutate(mtcars, across(cyl:vs, flag))
)
expect_true(length(fmutate(mtcars, across(cyl:vs, L))) > length(fmutate(mtcars, across(cyl:vs, flag))))
expect_equal(
fmutate(mtcars, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "used"),
dplyr::mutate(mtcars, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "used")
)
expect_equal(
fmutate(mtcars, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "unused"),
dplyr::mutate(mtcars, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "unused")
)
expect_equal(
fmutate(mtcars, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "none"),
dplyr::transmute(mtcars, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb)
)
expect_identical(names(fmutate(mtcars, a = mpg, b = a, c = cyl, hp = wt, .keep = "unused")), c(setdiff(names(mtcars), .c(mpg, cyl, wt)), letters[1:3]))
expect_identical(names(fmutate(mtcars, a = mpg, b = a, c = cyl, hp = wt, .keep = "none")), c("a", "b", "c", "hp"))
expect_equal(
fmutate(gmtc, a = fmax(mpg), b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "used"),
dplyr::mutate(gmtc, a = bmax(mpg), b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "used")
)
expect_equal(
fmutate(gmtc, a = fmax(mpg), b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "unused"),
dplyr::mutate(gmtc, a = bmax(mpg), b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "unused")
)
expect_equal(
fmutate(gmtc, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb, .keep = "none"),
dplyr::transmute(gmtc, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb)
)
# Inconsistent with the above and also inefficient...
# expect_equal(
# fmutate(gmtc, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb, cyl = cyl, .keep = "none"),
# dplyr::mutate(gmtc, a = mpg, b = a + hp + disp, c = cyl, hp = wt + carb, cyl = cyl, .keep = "none")
# )
expect_equal(flast(names(fmutate(mtcars, across(cyl:vs, function(x) list(ps = kit::psum(x)), .apply = FALSE)))), "ps")
expect_equal(
fmutate(mtcars, across(cyl:vs, data.table::shift, .apply = FALSE, .names = FALSE)),
fmutate(mtcars, across(cyl:vs, data.table::shift))
)
# Testing expressions turned into functions:
bcumsum = base::cumsum
lorentz_fun <- function(x) bcumsum(x) / bsum(x)
gmtc = mtc %>% roworder(mpg) %>% dplyr::group_by(cyl, vs, am)
expect_true(all_obj_equal(mtt(gmtc, lorentz_mpg = bcumsum(mpg) / bsum(mpg)),
mtt(gmtc, lorentz_mpg = lorentz_fun(mpg)),
mtt(gmtc, lorentz_mpg = fcumsum(mpg) / fsum(mpg)), # doesn't work because of global sorting...
dplyr::mutate(gmtc, lorentz_mpg = bcumsum(mpg) / bsum(mpg))))
# Adding global variable:
q = 5
expect_true(all_obj_equal(mtt(gmtc, lorentz_mpg = bcumsum(mpg) / bsum(mpg) + q),
mtt(gmtc, lorentz_mpg = lorentz_fun(mpg) + q),
mtt(gmtc, lorentz_mpg = fcumsum(mpg) / fsum(mpg) + q),
dplyr::mutate(gmtc, lorentz_mpg = bcumsum(mpg) / bsum(mpg) + q)))
})
}
test_that(".names works properly", {
expect_equal(
smr(gmtc, acr(c(hp, wt), list(sum, max, min))),
smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = TRUE))
)
expect_equal(
smr(gmtc, acr(c(hp, wt), list(sum, max, min))),
smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = function(c, f) paste0(c, "_", f)))
)
expect_equal(
smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = "flip")),
smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = function(c, f) paste0(f, "_", c)))
)
expect_equal(
smr(gmtc, acr(c(hp, wt), list(sum, max, min), .transpose = FALSE)),
smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = function(c, f) paste0(c, "_", f), .transpose = FALSE))
)
expect_equal(
smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = "flip", .transpose = FALSE)),
smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = function(c, f) paste0(f, "_", c), .transpose = FALSE))
)
expect_equal(
names(smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = FALSE))),
.c(cyl, vs, am, hp, hp, hp, wt, wt, wt)
)
expect_equal(
names(smr(gmtc, acr(c(hp, wt), list(sum, max, min), .names = FALSE, .transpose = FALSE))),
.c(cyl, vs, am, hp, wt, hp, wt, hp, wt)
)
expect_equal(
names(smr(gmtc, acr(c(hp, wt), sum, .names = FALSE))),
.c(cyl, vs, am, hp, wt)
)
expect_equal(
names(smr(gmtc, acr(c(hp, wt), sum, .names = FALSE, .transpose = FALSE))),
.c(cyl, vs, am, hp, wt)
)
expect_equal(
names(smr(gmtc, acr(c(hp, wt), sum, .names = TRUE))),
.c(cyl, vs, am, hp_sum, wt_sum)
)
expect_equal(
names(smr(gmtc, acr(c(hp, wt), sum, .names = "flip"))),
.c(cyl, vs, am, sum_hp, sum_wt)
)
expect_equal(
names(smr(gmtc, acr(c(hp, wt), sum, .names = "flip", .transpose = FALSE))),
.c(cyl, vs, am, sum_hp, sum_wt)
)
})
test_that("Warnings for unnamed scalar and vector-valued arguments passed", {
tf <- function(x, ...) x
expect_warning(mtt(gmtc, acr(hp:carb, tf, TRUE, wt)))
expect_warning(mtt(gmtc, acr(hp:carb, tf, wt, TRUE)))
expect_warning(mtt(gmtc, acr(hp:carb, tf, TRUE, wt, .apply = FALSE)))
expect_warning(mtt(gmtc, acr(hp:carb, tf, wt, TRUE, .apply = FALSE)))
})
if(FALSE) {
fmutate(mtcars, across(cyl:vs, list(D, W), .names = TRUE, .transpose = FALSE)) %>% head(3)
fmutate(mtcars, across(cyl:vs, list(D, W), .names = TRUE, .transpose = TRUE)) %>% head(3)
fmutate(mtcars, across(cyl:vs, list(D, W), .names = TRUE, .apply = FALSE, .transpose = FALSE)) %>% head(3)
fmutate(mtcars, across(cyl:vs, list(D, W), .names = FALSE, .apply = FALSE, .transpose = FALSE)) %>% head(3)
fmutate(mtcars, across(cyl:vs, list(W, kit::psum), w = wt)) %>% head(3)
fmutate(mtcars, across(cyl:vs, kit::psum)) %>% head(3)
fmutate(mtcars, across(cyl:vs, identity, .apply = FALSE)) # 51 microesecond median on windows
fmutate(mtcars, across(cyl:vs, identity)) # 62 microesecond median on windows
fmutate(mtcars, across(cyl:vs, L))
# TODO: Test all potential issues with environemtns etc. See if there are smarter ways to
# incorporate internal functions, data and objects in the global environment.
}
}
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.