Nothing
context("value formatting")
test_that("sprintf_format works correctly", {
myfun <- sprintf_format("hi there %1.4f")
lyt <- basic_table() %>%
split_cols_by("Species") %>%
analyze("Sepal.Width", afun = mean, format = myfun)
tbl <- build_table(lyt, iris)
matform <- matrix_form(tbl)
expect_identical(
matform$strings[2, ],
c(
"mean", "hi there 3.4280",
myfun(2.77),
myfun(mean(subset(iris, Species == "virginica")$Sepal.Width))
)
)
})
test_that("table_shell works", {
tbl <- rtable(c("A", "B"),
rrow("Hiya",
rcell(c(2, .2),
format = "xx (xx.x%)"
),
rcell(c(.1, .2)),
format = "xx.x - xx.x"
),
rrow("bye", 5.2345, 17.2),
format = "xx.xx"
)
tblsh <- rtable(
c("A", "B"),
rrow("Hiya", "xx (xx.x%)", "xx.x - xx.x"),
rrow("bye", "xx.xx", "xx.xx")
)
expect_identical(
toString(tblsh),
paste0(capture_output(table_shell(tbl)), "\n")
)
tbl2 <- rtable(c("A", "B"),
rrow("Hiya",
rcell(c(2, .2),
format = function(x, ...) paste0(x)
),
rcell(c(.1, .2)),
format = "xx.x - xx.x"
),
rrow("bye", 5.2345, 17.2),
format = "xx.xx"
)
tbl2sh <- rtable(
c("A", "B"),
rrow("Hiya", "<fnc>", "xx.x - xx.x"),
rrow("bye", "xx.xx", "xx.xx")
)
expect_identical(
toString(tbl2sh),
paste0(capture_output(table_shell(tbl2)), "\n")
)
})
test_that("rcell format_na_str functionality works", {
expect_identical(
format_rcell(rcell(NA_real_,
format = "xx.xx",
format_na_str = "hiya"
)),
"hiya"
)
## default still works
expect_identical(
format_rcell(rcell(NA_real_, format = "xx.x")),
"NA"
)
irs <- in_rows(
val1 = NA_real_, val2 = NA_integer_,
.formats = list(val1 = "xx.x", val2 = "xx.x"),
.format_na_strs = list(val1 = "hiya", val2 = "lowdown")
)
})
test_that("format_na_str functionality works in get_formatted_cells (i.e. printing) and make_afun", {
DM2 <- subset(DM, COUNTRY %in% c("USA", "CAN", "CHN"))
DM2$AGE <- NA
DM2$AGE[1] <- 1
s_summary <- function(x) {
stopifnot(is.numeric(x))
list(
n = sum(!is.na(x)),
mean = mean(x),
min_max = range(x)
)
}
a_summary <- make_afun(
fun = s_summary,
.formats = c(n = "xx", mean = "xx.xx", min_max = "xx.xx - xx.xx"),
.labels = c(n = "n", mean = "Mean", min_max = "min - max")
)
a_summary3 <- make_afun(a_summary,
.formats = c(mean = "xx.xxx"),
.format_na_strs = c(mean = "Ridiculous")
)
l <- basic_table() %>%
split_cols_by("ARM") %>%
split_rows_by("COUNTRY", split_fun = drop_split_levels) %>%
summarize_row_groups(label_fstr = "%s (n)") %>%
analyze("AGE", afun = a_summary3, format = "xx.xx")
tbl <- suppressWarnings(build_table(l, DM2))
tbl
expect_identical(
get_formatted_cells(tbl)[3, 1, drop = TRUE],
"Ridiculous"
)
})
test_that("format and na_str inheritance", {
# Test data
DM2 <- DM %>%
filter(ARM != levels(DM$ARM)[3]) %>%
mutate(ARM = as.factor(as.character(ARM)))
DM2$AGE[1] <- NA # Adding one NA
# Manually building the table
weird_afun <- function(x, ...) {
in_rows(
cell_fmt = rcell(mean(x, na.rm = TRUE), format = "xx.x"),
no_cell_fmt = rcell(median(x, na.rm = TRUE)),
no_cell_na_str = rcell(NA, format = "xx.x"),
cell_na_str_no_cell_fmt = rcell(NA, format_na_str = "what"),
cell_fmt_range = rcell(range(x, na.rm = TRUE), format = "xx.x - xx.x"),
cell_na_str_range = rcell(c(NA, 2), format = "xx.x - xx.x", format_na_str = "bah"),
no_cell_na_str_no_cell_fmt_range = rcell(c(NA, 2), format = "xx.x - xx.x")
)
}
# Main builder
tbl <- basic_table() %>%
split_cols_by("ARM") %>%
analyze("AGE", weird_afun, format = "xx.xx", na_str = "lol") %>%
build_table(DM2)
# Get the ASCII table
result <- get_formatted_cells(tbl) # Main function
# Expected data-set is built with dplyr
expected <- DM2 %>%
dplyr::group_by(ARM) %>%
summarise(
m_age = format_value(mean(AGE, na.rm = TRUE), format = "xx.x"),
me_age = format_value(median(AGE, na.rm = TRUE), format = "xx.xx"),
m_range = paste(sapply(range(AGE, na.rm = TRUE), format_value, format = "xx.x"), collapse = " - ")
) %>%
mutate(b = "lol", c = "what", d = "bah - 2.0", e = "lol - 2.0") %>%
select(m_age, me_age, b, c, m_range, d, e) %>%
mutate_all(as.character) %>%
t() %>%
as.matrix()
dimnames(expected) <- NULL # Fixing attributes
# Check if it preserves the format and na_str replacements
expect_identical(result, expected)
# Get the ASCII table of formats (shell)
result <- get_formatted_cells(tbl, shell = TRUE) # Main function
# Expected ASCII table (manual insertion)
one_col <- c("xx.x", "xx.xx", "xx.x", "xx.xx", "xx.x - xx.x", "xx.x - xx.x", "xx.x - xx.x")
expected <- cbind(one_col, one_col)
dimnames(expected) <- NULL # Fixing attributes
# Check if it preserves the shell format
expect_identical(result, expected)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.