## Tests for keep.labels
context("Testing the keep.labels function")
df <- data.frame(z = c("A", "A", "A", "B", "B", "B"),
x = c("C", "C", "D", "C", "D", "D"),
y = c(1, 2, 1, 2, 1, 2),
stringsAsFactors = FALSE)
attr(df$x, "label") <- "My var"
attr(df$y, "label") <- "YYYY"
attr(df, "label") <- "Data Frame Label"
df.kl <- keep.labels(df)
df.ll <- loosen.labels(df.kl)
###########################################################################################################
#### Basic keep.labels stuff
###########################################################################################################
test_that("keep.labels actually keeps labels on data.frame subsetting", {
expect_identical(labels(df.kl$y), "YYYY")
expect_identical(labels(df.kl[["y"]]), "YYYY")
expect_identical(labels(df.kl["y"]), list(y = "YYYY"))
expect_identical(labels(df.kl[, "y", drop = FALSE]), list(y = "YYYY"))
expect_identical(labels(df.kl[, "y", drop = TRUE]), "YYYY")
expect_identical(labels(df.kl[1:5, "y", drop = TRUE]), "YYYY")
expect_identical(labels(df.kl[1:5, ]), list(z = NULL, x = "My var", y = "YYYY"))
})
test_that("loosen.labels actually drops labels", {
expect_identical(attr(df.ll[1:5, "y", drop = TRUE], "label"), NULL)
expect_identical(labels(df.ll[1:5, ]), list(z = NULL, x = NULL, y = NULL))
})
empty.df <- data.frame()
test_that("labels<-.data.frame works", {
expect_error(labels(df.kl) <- list(y = NULL, z = "ZZZZ", a = "a"), NA)
expect_identical(labels(df.kl), list(z = "ZZZZ", x = "My var", y = NULL))
expect_error(labels(df.kl) <- NULL, NA)
expect_identical(labels(df.kl), list(z = NULL, x = NULL, y = NULL))
expect_error(labels(empty.df) <- list(z = "ZZZZ"), NA)
expect_true(length(labels(empty.df)) == 0)
})
###########################################################################################################
#### keep.labels with arsenal functions
###########################################################################################################
data(mockstudy)
test_that("Keep labels in tableby", {
expect_identical(
capture.kable(summary(tableby(sex ~ fe(arm) + age, data = mockstudy, subset = age < 80,
numeric.stats = c("meansd", "q1q3", "range")), text = TRUE)),
c("| | Male (N=891) | Female (N=571) | Total (N=1462) | p value|",
"|:-------------|:---------------:|:---------------:|:---------------:|-------:|",
"|Treatment Arm | | | | 0.187|",
"|- A: IFL | 272 (30.5%) | 149 (26.1%) | 421 (28.8%) | |",
"|- F: FOLFOX | 397 (44.6%) | 273 (47.8%) | 670 (45.8%) | |",
"|- G: IROX | 222 (24.9%) | 149 (26.1%) | 371 (25.4%) | |",
"|Age in Years | | | | 0.071|",
"|- Mean (SD) | 59.850 (10.924) | 58.774 (11.372) | 59.430 (11.110) | |",
"|- Q1, Q3 | 53.000, 68.000 | 52.000, 68.000 | 52.000, 68.000 | |",
"|- Range | 19.000 - 79.000 | 22.000 - 79.000 | 19.000 - 79.000 | |"
)
)
})
test_that("Keep labels in modelsum", {
expect_identical(
capture.kable(summary(modelsum(age ~ sex + arm, data = mockstudy, subset = age < 80), text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:-----------------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |59.850 |0.372 |< 0.001 |0.002 |",
"|sex Female |-1.076 |0.595 |0.071 | |",
"|(Intercept) |59.290 |0.542 |< 0.001 |-0.001 |",
"|Treatment Arm F: FOLFOX |0.340 |0.691 |0.623 | |",
"|Treatment Arm G: IROX |-0.063 |0.792 |0.936 | |"
)
)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.