Nothing
tests/testthat/test_modelsum.R
In arsenal: An Arsenal of 'R' Functions for Large-Scale Statistical Summaries
## Tests for modelsum
context("Testing the modelsum output")
# "mdat" now defined in helper-data.R
###########################################################################################################
#### Basic modelsum call
###########################################################################################################
test_that("A basic modelsum call--no labels, no missings", {
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + time, data = mdat), text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:-----------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |39.826 |0.779 |< 0.001 |-0.011 |",
"|Sex Male |-0.258 |1.115 |0.818 | |",
"|(Intercept) |41.130 |1.197 |< 0.001 |0.009 |",
"|time |-0.371 |0.275 |0.182 | |"
)
)
})
test_that("A basic modelsum tableby call--labels, no missings", {
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + trt, data = mdat), text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:---------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |39.826 |0.779 |< 0.001 |-0.011 |",
"|Sex Male |-0.258 |1.115 |0.818 | |",
"|(Intercept) |40.528 |0.874 |< 0.001 |0.006 |",
"|Treatment Arm B |-1.380 |1.128 |0.225 | |"
)
)
})
test_that("A basic modelsum call--adding adjustment", {
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + time, adjust = ~ trt, data = mdat), text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:---------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |40.632 |1.024 |< 0.001 |-0.005 |",
"|Sex Male |-0.221 |1.112 |0.843 | |",
"|Treatment Arm B |-1.373 |1.135 |0.229 | |",
"|(Intercept) |41.938 |1.366 |< 0.001 |0.014 |",
"|time |-0.368 |0.275 |0.184 | |",
"|Treatment Arm B |-1.366 |1.123 |0.227 | |"
)
)
})
test_that("A basic modelsum call--suppressing intercept and/or adjustment vars", {
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + time, adjust = ~ trt, data = mdat), text = TRUE, show.intercept = FALSE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:---------------|:--------|:---------|:-------|:-------------|",
"|Sex Male |-0.221 |1.112 |0.843 |-0.005 |",
"|Treatment Arm B |-1.373 |1.135 |0.229 | |",
"|time |-0.368 |0.275 |0.184 |0.014 |",
"|Treatment Arm B |-1.366 |1.123 |0.227 | |"
)
)
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + time, adjust = ~ trt, data = mdat), text = TRUE, show.adjust = FALSE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:-----------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |40.632 |1.024 |< 0.001 |-0.005 |",
"|Sex Male |-0.221 |1.112 |0.843 | |",
"|(Intercept) |41.938 |1.366 |< 0.001 |0.014 |",
"|time |-0.368 |0.275 |0.184 | |"
)
)
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + time, adjust = ~ trt, data = mdat), text = TRUE, show.intercept = FALSE, show.adjust = FALSE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:--------|:--------|:---------|:-------|:-------------|",
"|Sex Male |-0.221 |1.112 |0.843 |-0.005 |",
"|time |-0.368 |0.275 |0.184 |0.014 |"
)
)
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + time, adjust = ~ trt, data = mdat), text = TRUE, show.intercept = FALSE, show.adjust = FALSE)),
capture.kable(summary(modelsum(Age ~ Sex + time, adjust = ~ trt, data = mdat, show.intercept = FALSE, show.adjust = FALSE), text = TRUE))
)
})
test_that("Reordering variables", {
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + Group + time, data = mdat)[c(3,1,2)], text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:-----------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |41.130 |1.197 |< 0.001 |0.009 |",
"|time |-0.371 |0.275 |0.182 | |",
"|(Intercept) |39.826 |0.779 |< 0.001 |-0.011 |",
"|Sex Male |-0.258 |1.115 |0.818 | |",
"|(Intercept) |40.033 |0.970 |< 0.001 |-0.021 |",
"|Group Low |-0.400 |1.372 |0.771 | |",
"|Group Med |-0.600 |1.372 |0.663 | |"
)
)
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + Group + time, data = mdat)[c(3,1,2)], text = TRUE)),
capture.kable(summary(modelsum(Age ~ Sex + Group + time, data = mdat)[c("time", "Sex", "Group")], text = TRUE))
)
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + Group + time, data = mdat)[1:2], text = TRUE)),
capture.kable(summary(modelsum(Age ~ Sex + Group + time, data = mdat)[c(TRUE, TRUE, FALSE)], text = TRUE))
)
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + Group + time, data = mdat), text = TRUE)),
capture.kable(summary(modelsum(Age ~ Sex + Group + time, data = mdat)[], text = TRUE))
)
expect_warning(modelsum(Age ~ Sex + Group + time, data = mdat)[1:4], "Some indices not found")
expect_error(modelsum(Age ~ Sex + Group + time, data = mdat)[TRUE], "Logical vector")
})
test_that("offset() works", {
expect_error(summary(modelsum(fu.stat ~ age, adjust=~offset(log(fu.time+.01))+ sex + arm,
data=mockstudy, family=poisson)), NA)
})
test_that("strata() works", {
skip_if_not(getRversion() >= "3.3.0")
skip_if_not_installed("survival", "2.43-1")
require(survival)
expect_identical(
capture.kable(summary(modelsum(Surv(time, status) ~ ethan, adjust = ~strata(Sex), data = mdat, family="survival"), text = TRUE)),
c("| |HR |CI.lower.HR |CI.upper.HR |p.value |concordance |Nmiss |",
"|:-------------|:-----|:-----------|:-----------|:-------|:-----------|:-----|",
"|ethan Heinzen |1.051 |0.549 |2.014 |0.880 |0.499 |3 |"
)
)
# borrowed from help page for ?clogit
data("logan")
resp <- levels(logan$occupation)
n <- nrow(logan)
indx <- rep(1:n, length(resp))
logan2 <- data.frame(logan[indx,], id = indx, tocc = factor(rep(resp, each=n)))
logan2$case <- (logan2$occupation == logan2$tocc)
expect_identical(
capture.kable(summary(modelsum(case ~ tocc, adjust = ~ tocc:education + strata(id),
data = set_labels(logan2, list(education = "edu")), family = "clog"))),
c("| |OR |CI.lower.OR |CI.upper.OR |p.value |concordance |",
"|:-------------------------|:-----|:-----------|:-----------|:-------|:-----------|",
"|**tocc farm** |0.150 |0.010 |2.248 |0.170 |0.766 |",
"|**tocc operatives** |3.212 |1.060 |9.732 |0.039 | |",
"|**tocc professional** |0.000 |0.000 |0.001 |< 0.001 | |",
"|**tocc sales** |0.007 |0.001 |0.030 |< 0.001 | |",
"|**tocc craftsmen:edu** |0.717 |0.642 |0.802 |< 0.001 | |",
"|**tocc farm:edu** |0.691 |0.550 |0.868 |0.001 | |",
"|**tocc operatives:edu** |0.656 |0.585 |0.735 |< 0.001 | |",
"|**tocc professional:edu** |1.321 |1.195 |1.460 |< 0.001 | |",
"|**tocc sales:edu** |NA |NA |NA | | |"
)
)
})
test_that("'weights=' works", {
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex, data = mdat, weights = weights))),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |39.826 |0.889 |< 0.001 |0.020 |",
"|**Sex Male** |1.953 |1.167 |0.098 | |"
)
)
})
test_that("interactions work", {
expect_identical(
capture.kable(summary(modelsum(age ~ bmi, adjust = ~ sex*arm, data=mockstudy))),
c("| |estimate |std.error |p.value |adj.r.squared |Nmiss |",
"|:--------------------------------------|:--------|:---------|:-------|:-------------|:-----|",
"|(Intercept) |58.401 |1.691 |< 0.001 |0.001 |33 |",
"|**Body Mass Index (kg/m^2)** |0.051 |0.056 |0.362 | | |",
"|**sex Female** |-0.351 |1.177 |0.765 | | |",
"|**Treatment Arm F: FOLFOX** |0.852 |0.908 |0.348 | | |",
"|**Treatment Arm G: IROX** |0.979 |1.040 |0.347 | | |",
"|**sex Female:Treatment Arm F: FOLFOX** |-0.596 |1.485 |0.688 | | |",
"|**sex Female:Treatment Arm G: IROX** |-1.975 |1.688 |0.242 | | |"
)
)
expect_identical(
capture.kable(summary(modelsum(age ~ bmi, adjust = ~ hgb*arm, data=mockstudy))),
c("| |estimate |std.error |p.value |adj.r.squared |Nmiss |",
"|:-------------------------------|:--------|:---------|:-------|:-------------|:-----|",
"|(Intercept) |54.324 |4.747 |< 0.001 |0.004 |294 |",
"|**Body Mass Index (kg/m^2)** |0.029 |0.062 |0.643 | | |",
"|**hgb** |0.404 |0.366 |0.271 | | |",
"|**Treatment Arm F: FOLFOX** |-1.386 |5.748 |0.809 | | |",
"|**Treatment Arm G: IROX** |-1.228 |6.589 |0.852 | | |",
"|**hgb:Treatment Arm F: FOLFOX** |0.176 |0.462 |0.703 | | |",
"|**hgb:Treatment Arm G: IROX** |0.052 |0.529 |0.922 | | |"
)
)
expect_identical(
capture.kable(summary(modelsum(age ~ bmi:arm, adjust = ~ hgb, data=mockstudy))),
c("| |estimate |std.error |p.value |adj.r.squared |Nmiss |",
"|:----------------------------------------------------|:--------|:---------|:-------|:-------------|:-----|",
"|(Intercept) |53.303 |2.822 |< 0.001 |0.005 |294 |",
"|**hgb** |0.499 |0.193 |0.010 | | |",
"|**Body Mass Index (kg/m^2):Treatment Arm A: IFL** |0.023 |0.065 |0.721 | | |",
"|**Body Mass Index (kg/m^2):Treatment Arm F: FOLFOX** |0.052 |0.063 |0.416 | | |",
"|**Body Mass Index (kg/m^2):Treatment Arm G: IROX** |0.002 |0.065 |0.973 | | |"
)
)
expect_identical(
capture.kable(summary(modelsum(age ~ bmi:arm, adjust = ~ hgb, data=mockstudy))),
c("| |estimate |std.error |p.value |adj.r.squared |Nmiss |",
"|:----------------------------------------------------|:--------|:---------|:-------|:-------------|:-----|",
"|(Intercept) |53.303 |2.822 |< 0.001 |0.005 |294 |",
"|**hgb** |0.499 |0.193 |0.010 | | |",
"|**Body Mass Index (kg/m^2):Treatment Arm A: IFL** |0.023 |0.065 |0.721 | | |",
"|**Body Mass Index (kg/m^2):Treatment Arm F: FOLFOX** |0.052 |0.063 |0.416 | | |",
"|**Body Mass Index (kg/m^2):Treatment Arm G: IROX** |0.002 |0.065 |0.973 | | |"
)
)
expect_identical(
as.data.frame(modelsum(age ~ bmi:arm, adjust = ~ hgb, data=mockstudy))$term.type,
c("Intercept", "Adjuster", "Term", "Term", "Term")
)
})
test_that("ordinal works", {
if(require(MASS))
{
data(housing)
expect_identical(
capture.kable(summary(modelsum(Sat ~ Infl, adjust = ~ Type + Cont, weights = Freq, data = housing, family = "ordinal"))),
c("| |OR |CI.lower.OR |CI.upper.OR |p.value |",
"|:------------------|:-----|:-----------|:-----------|:-------|",
"|Low|Medium |NA |NA |NA |< 0.001 |",
"|Medium|High |NA |NA |NA |< 0.001 |",
"|**Infl Medium** |1.762 |1.436 |2.164 |< 0.001 |",
"|**Infl High** |3.628 |2.832 |4.663 |< 0.001 |",
"|**Type Apartment** |0.564 |0.446 |0.712 |< 0.001 |",
"|**Type Atrium** |0.693 |0.511 |0.940 |0.018 |",
"|**Type Terrace** |0.336 |0.249 |0.451 |< 0.001 |",
"|**Cont High** |1.434 |1.189 |1.730 |< 0.001 |"
)
)
expect_identical(
capture.kable(summary(modelsum(Sat ~ Infl, adjust = ~ Type + Cont, weights = Freq, data = housing, family = "ordinal",
ordinal.stats = c("estimate", "statistic", "p.value")), text = TRUE)),
c("| |estimate |statistic |p.value |",
"|:----------------|:--------|:---------|:-------|",
"|Low|Medium |-0.496 |-3.974 |< 0.001 |",
"|Medium|High |0.691 |5.505 |< 0.001 |",
"|Infl Medium |0.566 |5.412 |< 0.001 |",
"|Infl High |1.289 |10.136 |< 0.001 |",
"|Type Apartment |-0.572 |-4.800 |< 0.001 |",
"|Type Atrium |-0.366 |-2.360 |0.018 |",
"|Type Terrace |-1.091 |-7.202 |< 0.001 |",
"|Cont High |0.360 |3.771 |< 0.001 |"
)
)
expect_identical(
capture.kable(summary(modelsum(Sat ~ Infl, adjust = ~ Type + Cont, weights = Freq, data = housing, family = "ordinal",
show.adjust = FALSE, show.intercept = FALSE), text = TRUE)),
c("| |OR |CI.lower.OR |CI.upper.OR |p.value |",
"|:-----------|:-----|:-----------|:-----------|:-------|",
"|Infl Medium |1.762 |1.436 |2.164 |< 0.001 |",
"|Infl High |3.628 |2.832 |4.663 |< 0.001 |"
)
)
} else skip("'MASS' is not available")
})
test_that("negbin works", {
if(require(MASS))
{
data(mockstudy)
expect_identical(
capture.kable(summary(modelsum(fu.time ~ sex, adjust = ~ age + arm, data = mockstudy, family = negbin),
negbin.stats = c("estimate", "p.value", "theta"), text = TRUE, digits = 5)),
c("| |estimate |p.value |theta |",
"|:-----------------------|:--------|:-------|:-------|",
"|(Intercept) |6.52819 |< 0.001 |1.84776 |",
"|sex Female |-0.02370 |0.545 | |",
"|Age in Years |-0.00342 |0.039 | |",
"|Treatment Arm F: FOLFOX |0.28161 |< 0.001 | |",
"|Treatment Arm G: IROX |0.09396 |0.071 | |"
)
)
} else skip("'MASS' is not available")
})
###########################################################################################################
#### Reported bugs for modelsum
###########################################################################################################
set.seed(3248)
dat <- data.frame(short.name = rnorm(100), really.long.name = rnorm(100),
why.would.you.name.something = rnorm(100),
as.long.as.this = rnorm(100))
test_that("01/26/2017: Brendan Broderick's Bold Text Wrapping Problem", {
expect_identical(
capture.kable(summary(modelsum(short.name ~ really.long.name + as.long.as.this, adjust = ~ why.would.you.name.something, data = dat))),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:--------------------------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |0.035 |0.099 |0.721 |-0.001 |",
"|**really.long.name** |0.099 |0.099 |0.319 | |",
"|**why.would.you.name.something** |-0.083 |0.090 |0.361 | |",
"|(Intercept) |0.048 |0.097 |0.624 |0.023 |",
"|**as.long.as.this** |0.198 |0.106 |0.066 | |",
"|**why.would.you.name.something** |-0.090 |0.089 |0.314 | |"
)
)
})
rm(dat)
#################################################################################################################################
test_that("02/07/2017: Ryan Lennon's R Markdown spacing problem. Also 02/14/2018 (#66)", {
expect_error(capture.kable(summary(modelsum(Age ~ Sex + time, data = mdat), text = TRUE)), NA)
})
#################################################################################################################################
test_that("02/13/2017: Krista Goergen's survival subset and NA problems", {
skip_if_not(getRversion() >= "3.5.0")
skip_if_not_installed("survival", "2.41-3")
require(survival)
mdat.tmp <- keep.labels(mdat)
form <- Surv(time, status) ~ Sex + ethan
expect_identical(capture.kable(summary(modelsum(form, data = mdat.tmp, subset = Group=="High", family="survival"), text = TRUE)),
capture.kable(summary(modelsum(form, data = mdat.tmp[mdat.tmp$Group=="High",], family="survival"), text = TRUE)))
mdat.tmp[3:4,"time"] <- c(NA,NA)
expect_identical(capture.kable(summary(modelsum(form, data = mdat.tmp, subset = Group=="High", family="survival"), text = TRUE)),
capture.kable(summary(modelsum(form, data = mdat.tmp[mdat.tmp$Group=="High",], family="survival"), text = TRUE)))
expect_identical(capture.kable(summary(modelsum(form, adjust = ~Age, data = mdat.tmp, subset = Group=="High", family="survival"), text = TRUE)),
capture.kable(summary(modelsum(form, adjust = ~Age, data = mdat.tmp[mdat.tmp$Group=="High",], family="survival"), text = TRUE)))
expect_identical(
capture.kable(summary(modelsum(form, adjust = ~Age, data = mdat.tmp, subset = Group=="High", family="survival"), text = TRUE)),
c("| |HR |CI.lower.HR |CI.upper.HR |p.value |concordance |Nmiss |",
"|:-------------|:-----|:-----------|:-----------|:-------|:-----------|:-----|",
"|Sex Male |0.612 |0.210 |1.786 |0.369 |0.592 |2 |",
"|Age in Years |1.061 |0.968 |1.164 |0.205 | | |",
"|ethan Heinzen |1.019 |0.297 |3.501 |0.976 |0.639 |4 |",
"|Age in Years |1.058 |0.960 |1.166 |0.258 | | |"
)
)
})
#################################################################################################################################
test_that("04/12/2017: ... vs modelsum.control", {
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + time, adjust = ~ trt, data = mdat, show.adjust = FALSE, control = modelsum.control()), text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:-----------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |40.632 |1.024 |< 0.001 |-0.005 |",
"|Sex Male |-0.221 |1.112 |0.843 | |",
"|(Intercept) |41.938 |1.366 |< 0.001 |0.014 |",
"|time |-0.368 |0.275 |0.184 | |"
)
)
})
#################################################################################################################################
data(mockstudy)
test_that("08/01/2017: Beth Atkinson's subset problem", {
idx <- mockstudy$sex == "Male"
form <- fu.stat - 1 ~ age + hgb
expect_identical(capture.kable(summary(modelsum(form, data = mockstudy, subset = idx, adjust = ~arm, family="binomial"), text = TRUE)),
capture.kable(summary(modelsum(form, data = mockstudy, subset = sex == "Male", adjust = ~arm, family="binomial"), text = TRUE)))
})
#################################################################################################################################
set.seed(88)
df <- data.frame(
y = rnorm(1000),
x1 = rnorm(1000),
x2 = rnorm(1000),
x3 = rpois(1000, 2),
x5 = rnorm(1000),
x7 = rep(LETTERS[1:5], each = 200),
x8 = runif(1000)
)
test_that("07/27/2017: Too many adjustment vars in as.data.frame.modelsum (#12)", {
expect_equal(nrow(as.data.frame(modelsum(y ~ x1, adjust = ~ x7 + x2 + x3 + x5 + x8, data = df))), 10L)
})
#################################################################################################################################
test_that("07/27/2017: modelsum labels (#13)", {
expect_identical(
capture.kable(summary(modelsum(bmi ~ age, adjust = ~sex, data = mockstudy),
labelTranslations = list(sexFemale = "Female", age = "Age, yrs"), text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |Nmiss |",
"|:-----------|:--------|:---------|:-------|:-------------|:-----|",
"|(Intercept) |26.793 |0.766 |< 0.001 |0.004 |33 |",
"|Age, yrs |0.012 |0.012 |0.348 | | |",
"|Female |-0.718 |0.291 |0.014 | | |"
)
)
expect_identical(
capture.kable(summary(modelsum(bmi ~ age, adjust = ~sex, data = mockstudy), labelTranslations = list(sexFemale = "Female", age = "Age, yrs"), text = TRUE)),
capture.kable(summary(modelsum(bmi ~ age, adjust = ~sex, data = mockstudy), labelTranslations = c(sexFemale = "Female", age = "Age, yrs"), text = TRUE))
)
expect_warning(summary(modelsum(bmi ~ age, adjust = ~sex, data = mockstudy), labelTranslations = c(badvar = "Eek")), NA)
})
#################################################################################################################################
test_that("12/23/2017: non-syntactic names (#44, #45)", {
dat <- data.frame(y = 1:10, x1x = rep(c("A", "B"), each = 5),
`1x` = rep(c("C", "D"), each = 5),
stringsAsFactors = FALSE, check.names = FALSE)
expect_identical(
capture.kable(summary(modelsum(y ~ x1x, data = dat))),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:-----------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |3.000 |0.707 |0.003 |0.727 |",
"|**x1x B** |5.000 |1.000 |0.001 | |"
)
)
expect_identical(
capture.kable(summary(modelsum(y ~ `1x`, data = dat))),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:-----------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |3.000 |0.707 |0.003 |0.727 |",
"|**1x D** |5.000 |1.000 |0.001 | |"
)
)
})
#################################################################################################################################
test_that("01/05/2018: leading/trailing whitespace (#48)", {
expect_identical(
capture.kable(summary(modelsum(age ~ arm, data = set_labels(mockstudy, list(arm = " Arm "))))),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:------------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |59.673 |0.557 |< 0.001 |-0.001 |",
"|**Arm F: FOLFOX** |0.628 |0.709 |0.376 | |",
"|**Arm G: IROX** |0.090 |0.812 |0.912 | |"
)
)
expect_identical(
capture.kable(summary(modelsum(age ~ arm, data = set_labels(mockstudy, list(arm = " Arm "))), text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:--------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |59.673 |0.557 |< 0.001 |-0.001 |",
"|Arm F: FOLFOX |0.628 |0.709 |0.376 | |",
"|Arm G: IROX |0.090 |0.812 |0.912 | |"
)
)
})
#################################################################################################################################
test_that("02/23/2018: wrapping long labels (#59)", {
labs <- list(
Group = "This is a really long label for the Group variable",
time = "Another really long label. Can you believe how long this is",
dt = "ThisLabelHasNoSpacesSoLetsSeeHowItBehaves"
)
expect_identical(
capture.kable(print(summary(modelsum(Age ~ Group + time + dt, data = set_labels(mdat, labs)), text = TRUE), width = 30)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:------------------------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |40.033 |0.970 |< 0.001 |-0.021 |",
"|This is a really long label |-0.400 |1.372 |0.771 | |",
"|for the Group variable Low | | | | |",
"|This is a really long label |-0.600 |1.372 |0.663 | |",
"|for the Group variable Med | | | | |",
"|(Intercept) |41.130 |1.197 |< 0.001 |0.009 |",
"|Another really long label. |-0.371 |0.275 |0.182 | |",
"|Can you believe how long this | | | | |",
"|is | | | | |",
"|(Intercept) |41.531 |2.017 |< 0.001 |-0.001 |",
"|ThisLabelHasNoSpacesSoLetsSeeH |0.000 |0.000 |0.348 | |",
"|owItBehaves | | | | |"
)
)
})
#################################################################################################################################
test_that("05/31/2018: similar column names (#98)", {
dat <- data.frame(
y = c(1:9, 11),
a = c(2, 2, 1:8),
aa = c(1, 1:9),
b = factor(rep(c("a", "b"), each = 5))
)
expect_identical(
capture.kable(summary(modelsum(y ~ b, adjust = ~a + aa, data = dat))),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:-----------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |0.417 |0.295 |0.208 |0.984 |",
"|**b b** |-0.467 |0.548 |0.427 | |",
"|**a** |-0.083 |0.217 |0.714 | |",
"|**aa** |1.250 |0.183 |< 0.001 | |"
)
)
})
#################################################################################################################################
test_that("05/31/2018: similar column names (#100)", {
dat <- data.frame(
y = c(1:9, 11),
a = factor(rep(c("a", "b"), each = 5), levels = c("b", "a")),
d = factor(rep(c("c", "d"), times = 5), levels = c("c", "d"))
)
expect_identical(
capture.kable(summary(modelsum(y ~ a, adjust = ~ d, data = set_labels(dat, list(a = "A", d = "D"))), text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:-----------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |8.100 |1.112 |< 0.001 |0.656 |",
"|A a |-5.167 |1.213 |0.004 | |",
"|D d |0.167 |1.213 |0.895 | |"
)
)
})
#################################################################################################################################
test_that("06/19/2018: term.name (#109)", {
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + time, adjust = ~ trt, data = mdat), text = TRUE, term.name = "Term")),
c("|Term |estimate |std.error |p.value |adj.r.squared |",
"|:---------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |40.632 |1.024 |< 0.001 |-0.005 |",
"|Sex Male |-0.221 |1.112 |0.843 | |",
"|Treatment Arm B |-1.373 |1.135 |0.229 | |",
"|(Intercept) |41.938 |1.366 |< 0.001 |0.014 |",
"|time |-0.368 |0.275 |0.184 | |",
"|Treatment Arm B |-1.366 |1.123 |0.227 | |"
)
)
})
#################################################################################################################################
test_that("08/24/2018: latex (#123)", {
expect_identical(
capture.output(summary(modelsum(Age ~ Sex, adjust = ~ trt, data = mdat), text = "latex")),
c("" ,
"\\begin{tabular}{l|l|l|l|l}" ,
"\\hline" ,
" & estimate & std.error & p.value & adj.r.squared\\\\" ,
"\\hline" ,
"(Intercept) & 40.632 & 1.024 & < 0.001 & -0.005\\\\" ,
"\\hline" ,
"\\textbf{Sex Male} & -0.221 & 1.112 & 0.843 & \\\\" ,
"\\hline" ,
"\\textbf{Treatment Arm B} & -1.373 & 1.135 & 0.229 & \\\\",
"\\hline" ,
"\\end{tabular}" ,
""
)
)
})
#################################################################################################################################
test_that("09/05/2018: correctly label contrasts for ordinal variables (#133)", {
mdat$Group.ord <- ordered(mdat$Group.fac, levels = c("Low", "Med", "High"))
expect_identical(
capture.kable(summary(modelsum(Age ~ Phase, adjust = ~ Group.ord + trt + ht_in, data = mdat), text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:----------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |47.686 |7.301 |< 0.001 |-0.019 |",
"|Phase .L |-0.679 |1.152 |0.557 | |",
"|Phase .Q |-1.044 |0.960 |0.280 | |",
"|Group.ord .L |0.243 |0.977 |0.804 | |",
"|Group.ord .Q |0.410 |1.069 |0.702 | |",
"|Treatment Arm B |-1.460 |1.159 |0.211 | |",
"|Height in Inches |-0.112 |0.110 |0.314 | |"
)
)
})
#################################################################################################################################
test_that("08/07/2019: survival confidence limits (#245)", {
skip_if_not(getRversion() >= "3.5.0")
skip_if_not_installed("survival", "2.41-3")
require(survival)
expect_identical(
capture.kable(summary(modelsum(Surv(fu.time, fu.stat) ~ arm, data = mockstudy, conf.level = 0.99, family="survival"), text = TRUE)),
c("| |HR |CI.lower.HR |CI.upper.HR |p.value |concordance |",
"|:-----------------------|:-----|:-----------|:-----------|:-------|:-----------|",
"|Treatment Arm F: FOLFOX |0.638 |0.540 |0.754 |< 0.001 |0.556 |",
"|Treatment Arm G: IROX |0.871 |0.722 |1.050 |0.057 | |"
)
)
})
#################################################################################################################################
test_that("08/07/2019: p.value.lrt (#238)", {
skip_if_not(getRversion() >= "3.5.0")
skip_if_not_installed("survival", "2.41-3")
require(survival)
expect_identical(
capture.kable(summary(modelsum(age ~ sex + arm + bmi, data = mockstudy, gaussian.stats = c("estimate", "p.value.lrt")),
text = TRUE, show.intercept = FALSE)),
c("| |estimate |p.value.lrt |",
"|:------------------------|:--------|:-----------|",
"|sex Female |-1.208 |0.048 |",
"|Treatment Arm F: FOLFOX |0.628 |0.614 |",
"|Treatment Arm G: IROX |0.090 | |",
"|Body Mass Index (kg/m^2) |0.059 |0.289 |"
)
)
expect_identical(
capture.kable(summary(modelsum(Surv(fu.time, fu.stat) ~ sex + arm + bmi, data = mockstudy,
family="survival", survival.stats = c("estimate", "p.value.lrt")),
text = TRUE, show.intercept = FALSE)),
c("| |estimate |p.value.lrt |",
"|:------------------------|:--------|:-----------|",
"|sex Female |0.002 |0.975 |",
"|Treatment Arm F: FOLFOX |-0.449 |< 0.001 |",
"|Treatment Arm G: IROX |-0.138 | |",
"|Body Mass Index (kg/m^2) |-0.016 | |"
)
)
})
test_that("statistic.F works (#262)", {
tab3 <- modelsum(bmi ~ age + sex, data=mockstudy, family=gaussian, gaussian.stats=c("estimate", "N","Nmiss","statistic.F"))
expect_identical(
capture.kable(summary(tab3, text=TRUE)),
c("| |estimate |N |Nmiss |statistic.F |",
"|:------------|:--------|:----|:-----|:-----------|",
"|(Intercept) |26.424 |1466 |33 |1.122 |",
"|Age in Years |0.013 | | | |",
"|(Intercept) |27.491 |1466 |33 |6.341 |",
"|sex Female |-0.731 | | | |"
)
)
})
test_that("Nevents works (#266)", {
skip_if_not(getRversion() >= "3.5.0")
skip_if_not_installed("survival", "2.41-3")
require(survival)
tab3 <- modelsum(Surv(fu.time,fu.stat)~sex, data=mockstudy, survival.stats=c('HR','p.value','Nmiss','Nevents','N'), family = "survival")
expect_identical(
capture.kable(summary(tab3)),
c("| |HR |p.value |Nevents |N |",
"|:--------------|:-----|:-------|:-------|:----|",
"|**sex Female** |1.002 |0.975 |1356 |1499 |"
)
)
})
test_that("relrisk works (#279)", {
skip_if_not(getRversion() >= "3.5.0")
opts <- options()
expect_identical(
capture.kable(summary(modelsum(mdquality.s ~ arm + sex, data = mockstudy, id = case, family = "relrisk"))),
c("| |RR |CI.lower.RR |CI.upper.RR |p.value |Nmiss |",
"|:---------------------------|:-----|:-----------|:-----------|:-------|:-----|",
"|(Intercept) |0.890 |0.859 |0.922 |< 0.001 |252 |",
"|**Treatment Arm F: FOLFOX** |1.014 |0.969 |1.061 |0.538 | |",
"|**Treatment Arm G: IROX** |1.021 |0.972 |1.072 |0.412 | |",
"|(Intercept) |0.899 |0.878 |0.921 |< 0.001 |252 |",
"|**sex Female** |1.004 |0.967 |1.043 |0.826 | |"
)
)
options(opts)
})
test_that("Nevents works for binomial (#325)", {
expect_identical(
capture.kable(summary(modelsum(fu.stat == 1 ~ age, data = mockstudy, family = "binomial",
binomial.stats = c("OR", "Nevents")))),
c("| |OR |Nevents |",
"|:----------------|:-----|:-------|",
"|(Intercept) |0.145 |143 |",
"|**Age in Years** |0.995 | |"
)
)
})
Try the arsenal package in your browser
Any scripts or data that you put into this service are public.
arsenal documentation built on June 5, 2021, 1:06 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.
## Tests for modelsum
context("Testing the modelsum output")
# "mdat" now defined in helper-data.R
###########################################################################################################
#### Basic modelsum call
###########################################################################################################
test_that("A basic modelsum call--no labels, no missings", {
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + time, data = mdat), text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:-----------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |39.826 |0.779 |< 0.001 |-0.011 |",
"|Sex Male |-0.258 |1.115 |0.818 | |",
"|(Intercept) |41.130 |1.197 |< 0.001 |0.009 |",
"|time |-0.371 |0.275 |0.182 | |"
)
)
})
test_that("A basic modelsum tableby call--labels, no missings", {
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + trt, data = mdat), text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:---------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |39.826 |0.779 |< 0.001 |-0.011 |",
"|Sex Male |-0.258 |1.115 |0.818 | |",
"|(Intercept) |40.528 |0.874 |< 0.001 |0.006 |",
"|Treatment Arm B |-1.380 |1.128 |0.225 | |"
)
)
})
test_that("A basic modelsum call--adding adjustment", {
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + time, adjust = ~ trt, data = mdat), text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:---------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |40.632 |1.024 |< 0.001 |-0.005 |",
"|Sex Male |-0.221 |1.112 |0.843 | |",
"|Treatment Arm B |-1.373 |1.135 |0.229 | |",
"|(Intercept) |41.938 |1.366 |< 0.001 |0.014 |",
"|time |-0.368 |0.275 |0.184 | |",
"|Treatment Arm B |-1.366 |1.123 |0.227 | |"
)
)
})
test_that("A basic modelsum call--suppressing intercept and/or adjustment vars", {
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + time, adjust = ~ trt, data = mdat), text = TRUE, show.intercept = FALSE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:---------------|:--------|:---------|:-------|:-------------|",
"|Sex Male |-0.221 |1.112 |0.843 |-0.005 |",
"|Treatment Arm B |-1.373 |1.135 |0.229 | |",
"|time |-0.368 |0.275 |0.184 |0.014 |",
"|Treatment Arm B |-1.366 |1.123 |0.227 | |"
)
)
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + time, adjust = ~ trt, data = mdat), text = TRUE, show.adjust = FALSE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:-----------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |40.632 |1.024 |< 0.001 |-0.005 |",
"|Sex Male |-0.221 |1.112 |0.843 | |",
"|(Intercept) |41.938 |1.366 |< 0.001 |0.014 |",
"|time |-0.368 |0.275 |0.184 | |"
)
)
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + time, adjust = ~ trt, data = mdat), text = TRUE, show.intercept = FALSE, show.adjust = FALSE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:--------|:--------|:---------|:-------|:-------------|",
"|Sex Male |-0.221 |1.112 |0.843 |-0.005 |",
"|time |-0.368 |0.275 |0.184 |0.014 |"
)
)
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + time, adjust = ~ trt, data = mdat), text = TRUE, show.intercept = FALSE, show.adjust = FALSE)),
capture.kable(summary(modelsum(Age ~ Sex + time, adjust = ~ trt, data = mdat, show.intercept = FALSE, show.adjust = FALSE), text = TRUE))
)
})
test_that("Reordering variables", {
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + Group + time, data = mdat)[c(3,1,2)], text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:-----------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |41.130 |1.197 |< 0.001 |0.009 |",
"|time |-0.371 |0.275 |0.182 | |",
"|(Intercept) |39.826 |0.779 |< 0.001 |-0.011 |",
"|Sex Male |-0.258 |1.115 |0.818 | |",
"|(Intercept) |40.033 |0.970 |< 0.001 |-0.021 |",
"|Group Low |-0.400 |1.372 |0.771 | |",
"|Group Med |-0.600 |1.372 |0.663 | |"
)
)
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + Group + time, data = mdat)[c(3,1,2)], text = TRUE)),
capture.kable(summary(modelsum(Age ~ Sex + Group + time, data = mdat)[c("time", "Sex", "Group")], text = TRUE))
)
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + Group + time, data = mdat)[1:2], text = TRUE)),
capture.kable(summary(modelsum(Age ~ Sex + Group + time, data = mdat)[c(TRUE, TRUE, FALSE)], text = TRUE))
)
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + Group + time, data = mdat), text = TRUE)),
capture.kable(summary(modelsum(Age ~ Sex + Group + time, data = mdat)[], text = TRUE))
)
expect_warning(modelsum(Age ~ Sex + Group + time, data = mdat)[1:4], "Some indices not found")
expect_error(modelsum(Age ~ Sex + Group + time, data = mdat)[TRUE], "Logical vector")
})
test_that("offset() works", {
expect_error(summary(modelsum(fu.stat ~ age, adjust=~offset(log(fu.time+.01))+ sex + arm,
data=mockstudy, family=poisson)), NA)
})
test_that("strata() works", {
skip_if_not(getRversion() >= "3.3.0")
skip_if_not_installed("survival", "2.43-1")
require(survival)
expect_identical(
capture.kable(summary(modelsum(Surv(time, status) ~ ethan, adjust = ~strata(Sex), data = mdat, family="survival"), text = TRUE)),
c("| |HR |CI.lower.HR |CI.upper.HR |p.value |concordance |Nmiss |",
"|:-------------|:-----|:-----------|:-----------|:-------|:-----------|:-----|",
"|ethan Heinzen |1.051 |0.549 |2.014 |0.880 |0.499 |3 |"
)
)
# borrowed from help page for ?clogit
data("logan")
resp <- levels(logan$occupation)
n <- nrow(logan)
indx <- rep(1:n, length(resp))
logan2 <- data.frame(logan[indx,], id = indx, tocc = factor(rep(resp, each=n)))
logan2$case <- (logan2$occupation == logan2$tocc)
expect_identical(
capture.kable(summary(modelsum(case ~ tocc, adjust = ~ tocc:education + strata(id),
data = set_labels(logan2, list(education = "edu")), family = "clog"))),
c("| |OR |CI.lower.OR |CI.upper.OR |p.value |concordance |",
"|:-------------------------|:-----|:-----------|:-----------|:-------|:-----------|",
"|**tocc farm** |0.150 |0.010 |2.248 |0.170 |0.766 |",
"|**tocc operatives** |3.212 |1.060 |9.732 |0.039 | |",
"|**tocc professional** |0.000 |0.000 |0.001 |< 0.001 | |",
"|**tocc sales** |0.007 |0.001 |0.030 |< 0.001 | |",
"|**tocc craftsmen:edu** |0.717 |0.642 |0.802 |< 0.001 | |",
"|**tocc farm:edu** |0.691 |0.550 |0.868 |0.001 | |",
"|**tocc operatives:edu** |0.656 |0.585 |0.735 |< 0.001 | |",
"|**tocc professional:edu** |1.321 |1.195 |1.460 |< 0.001 | |",
"|**tocc sales:edu** |NA |NA |NA | | |"
)
)
})
test_that("'weights=' works", {
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex, data = mdat, weights = weights))),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |39.826 |0.889 |< 0.001 |0.020 |",
"|**Sex Male** |1.953 |1.167 |0.098 | |"
)
)
})
test_that("interactions work", {
expect_identical(
capture.kable(summary(modelsum(age ~ bmi, adjust = ~ sex*arm, data=mockstudy))),
c("| |estimate |std.error |p.value |adj.r.squared |Nmiss |",
"|:--------------------------------------|:--------|:---------|:-------|:-------------|:-----|",
"|(Intercept) |58.401 |1.691 |< 0.001 |0.001 |33 |",
"|**Body Mass Index (kg/m^2)** |0.051 |0.056 |0.362 | | |",
"|**sex Female** |-0.351 |1.177 |0.765 | | |",
"|**Treatment Arm F: FOLFOX** |0.852 |0.908 |0.348 | | |",
"|**Treatment Arm G: IROX** |0.979 |1.040 |0.347 | | |",
"|**sex Female:Treatment Arm F: FOLFOX** |-0.596 |1.485 |0.688 | | |",
"|**sex Female:Treatment Arm G: IROX** |-1.975 |1.688 |0.242 | | |"
)
)
expect_identical(
capture.kable(summary(modelsum(age ~ bmi, adjust = ~ hgb*arm, data=mockstudy))),
c("| |estimate |std.error |p.value |adj.r.squared |Nmiss |",
"|:-------------------------------|:--------|:---------|:-------|:-------------|:-----|",
"|(Intercept) |54.324 |4.747 |< 0.001 |0.004 |294 |",
"|**Body Mass Index (kg/m^2)** |0.029 |0.062 |0.643 | | |",
"|**hgb** |0.404 |0.366 |0.271 | | |",
"|**Treatment Arm F: FOLFOX** |-1.386 |5.748 |0.809 | | |",
"|**Treatment Arm G: IROX** |-1.228 |6.589 |0.852 | | |",
"|**hgb:Treatment Arm F: FOLFOX** |0.176 |0.462 |0.703 | | |",
"|**hgb:Treatment Arm G: IROX** |0.052 |0.529 |0.922 | | |"
)
)
expect_identical(
capture.kable(summary(modelsum(age ~ bmi:arm, adjust = ~ hgb, data=mockstudy))),
c("| |estimate |std.error |p.value |adj.r.squared |Nmiss |",
"|:----------------------------------------------------|:--------|:---------|:-------|:-------------|:-----|",
"|(Intercept) |53.303 |2.822 |< 0.001 |0.005 |294 |",
"|**hgb** |0.499 |0.193 |0.010 | | |",
"|**Body Mass Index (kg/m^2):Treatment Arm A: IFL** |0.023 |0.065 |0.721 | | |",
"|**Body Mass Index (kg/m^2):Treatment Arm F: FOLFOX** |0.052 |0.063 |0.416 | | |",
"|**Body Mass Index (kg/m^2):Treatment Arm G: IROX** |0.002 |0.065 |0.973 | | |"
)
)
expect_identical(
capture.kable(summary(modelsum(age ~ bmi:arm, adjust = ~ hgb, data=mockstudy))),
c("| |estimate |std.error |p.value |adj.r.squared |Nmiss |",
"|:----------------------------------------------------|:--------|:---------|:-------|:-------------|:-----|",
"|(Intercept) |53.303 |2.822 |< 0.001 |0.005 |294 |",
"|**hgb** |0.499 |0.193 |0.010 | | |",
"|**Body Mass Index (kg/m^2):Treatment Arm A: IFL** |0.023 |0.065 |0.721 | | |",
"|**Body Mass Index (kg/m^2):Treatment Arm F: FOLFOX** |0.052 |0.063 |0.416 | | |",
"|**Body Mass Index (kg/m^2):Treatment Arm G: IROX** |0.002 |0.065 |0.973 | | |"
)
)
expect_identical(
as.data.frame(modelsum(age ~ bmi:arm, adjust = ~ hgb, data=mockstudy))$term.type,
c("Intercept", "Adjuster", "Term", "Term", "Term")
)
})
test_that("ordinal works", {
if(require(MASS))
{
data(housing)
expect_identical(
capture.kable(summary(modelsum(Sat ~ Infl, adjust = ~ Type + Cont, weights = Freq, data = housing, family = "ordinal"))),
c("| |OR |CI.lower.OR |CI.upper.OR |p.value |",
"|:------------------|:-----|:-----------|:-----------|:-------|",
"|Low|Medium |NA |NA |NA |< 0.001 |",
"|Medium|High |NA |NA |NA |< 0.001 |",
"|**Infl Medium** |1.762 |1.436 |2.164 |< 0.001 |",
"|**Infl High** |3.628 |2.832 |4.663 |< 0.001 |",
"|**Type Apartment** |0.564 |0.446 |0.712 |< 0.001 |",
"|**Type Atrium** |0.693 |0.511 |0.940 |0.018 |",
"|**Type Terrace** |0.336 |0.249 |0.451 |< 0.001 |",
"|**Cont High** |1.434 |1.189 |1.730 |< 0.001 |"
)
)
expect_identical(
capture.kable(summary(modelsum(Sat ~ Infl, adjust = ~ Type + Cont, weights = Freq, data = housing, family = "ordinal",
ordinal.stats = c("estimate", "statistic", "p.value")), text = TRUE)),
c("| |estimate |statistic |p.value |",
"|:----------------|:--------|:---------|:-------|",
"|Low|Medium |-0.496 |-3.974 |< 0.001 |",
"|Medium|High |0.691 |5.505 |< 0.001 |",
"|Infl Medium |0.566 |5.412 |< 0.001 |",
"|Infl High |1.289 |10.136 |< 0.001 |",
"|Type Apartment |-0.572 |-4.800 |< 0.001 |",
"|Type Atrium |-0.366 |-2.360 |0.018 |",
"|Type Terrace |-1.091 |-7.202 |< 0.001 |",
"|Cont High |0.360 |3.771 |< 0.001 |"
)
)
expect_identical(
capture.kable(summary(modelsum(Sat ~ Infl, adjust = ~ Type + Cont, weights = Freq, data = housing, family = "ordinal",
show.adjust = FALSE, show.intercept = FALSE), text = TRUE)),
c("| |OR |CI.lower.OR |CI.upper.OR |p.value |",
"|:-----------|:-----|:-----------|:-----------|:-------|",
"|Infl Medium |1.762 |1.436 |2.164 |< 0.001 |",
"|Infl High |3.628 |2.832 |4.663 |< 0.001 |"
)
)
} else skip("'MASS' is not available")
})
test_that("negbin works", {
if(require(MASS))
{
data(mockstudy)
expect_identical(
capture.kable(summary(modelsum(fu.time ~ sex, adjust = ~ age + arm, data = mockstudy, family = negbin),
negbin.stats = c("estimate", "p.value", "theta"), text = TRUE, digits = 5)),
c("| |estimate |p.value |theta |",
"|:-----------------------|:--------|:-------|:-------|",
"|(Intercept) |6.52819 |< 0.001 |1.84776 |",
"|sex Female |-0.02370 |0.545 | |",
"|Age in Years |-0.00342 |0.039 | |",
"|Treatment Arm F: FOLFOX |0.28161 |< 0.001 | |",
"|Treatment Arm G: IROX |0.09396 |0.071 | |"
)
)
} else skip("'MASS' is not available")
})
###########################################################################################################
#### Reported bugs for modelsum
###########################################################################################################
set.seed(3248)
dat <- data.frame(short.name = rnorm(100), really.long.name = rnorm(100),
why.would.you.name.something = rnorm(100),
as.long.as.this = rnorm(100))
test_that("01/26/2017: Brendan Broderick's Bold Text Wrapping Problem", {
expect_identical(
capture.kable(summary(modelsum(short.name ~ really.long.name + as.long.as.this, adjust = ~ why.would.you.name.something, data = dat))),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:--------------------------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |0.035 |0.099 |0.721 |-0.001 |",
"|**really.long.name** |0.099 |0.099 |0.319 | |",
"|**why.would.you.name.something** |-0.083 |0.090 |0.361 | |",
"|(Intercept) |0.048 |0.097 |0.624 |0.023 |",
"|**as.long.as.this** |0.198 |0.106 |0.066 | |",
"|**why.would.you.name.something** |-0.090 |0.089 |0.314 | |"
)
)
})
rm(dat)
#################################################################################################################################
test_that("02/07/2017: Ryan Lennon's R Markdown spacing problem. Also 02/14/2018 (#66)", {
expect_error(capture.kable(summary(modelsum(Age ~ Sex + time, data = mdat), text = TRUE)), NA)
})
#################################################################################################################################
test_that("02/13/2017: Krista Goergen's survival subset and NA problems", {
skip_if_not(getRversion() >= "3.5.0")
skip_if_not_installed("survival", "2.41-3")
require(survival)
mdat.tmp <- keep.labels(mdat)
form <- Surv(time, status) ~ Sex + ethan
expect_identical(capture.kable(summary(modelsum(form, data = mdat.tmp, subset = Group=="High", family="survival"), text = TRUE)),
capture.kable(summary(modelsum(form, data = mdat.tmp[mdat.tmp$Group=="High",], family="survival"), text = TRUE)))
mdat.tmp[3:4,"time"] <- c(NA,NA)
expect_identical(capture.kable(summary(modelsum(form, data = mdat.tmp, subset = Group=="High", family="survival"), text = TRUE)),
capture.kable(summary(modelsum(form, data = mdat.tmp[mdat.tmp$Group=="High",], family="survival"), text = TRUE)))
expect_identical(capture.kable(summary(modelsum(form, adjust = ~Age, data = mdat.tmp, subset = Group=="High", family="survival"), text = TRUE)),
capture.kable(summary(modelsum(form, adjust = ~Age, data = mdat.tmp[mdat.tmp$Group=="High",], family="survival"), text = TRUE)))
expect_identical(
capture.kable(summary(modelsum(form, adjust = ~Age, data = mdat.tmp, subset = Group=="High", family="survival"), text = TRUE)),
c("| |HR |CI.lower.HR |CI.upper.HR |p.value |concordance |Nmiss |",
"|:-------------|:-----|:-----------|:-----------|:-------|:-----------|:-----|",
"|Sex Male |0.612 |0.210 |1.786 |0.369 |0.592 |2 |",
"|Age in Years |1.061 |0.968 |1.164 |0.205 | | |",
"|ethan Heinzen |1.019 |0.297 |3.501 |0.976 |0.639 |4 |",
"|Age in Years |1.058 |0.960 |1.166 |0.258 | | |"
)
)
})
#################################################################################################################################
test_that("04/12/2017: ... vs modelsum.control", {
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + time, adjust = ~ trt, data = mdat, show.adjust = FALSE, control = modelsum.control()), text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:-----------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |40.632 |1.024 |< 0.001 |-0.005 |",
"|Sex Male |-0.221 |1.112 |0.843 | |",
"|(Intercept) |41.938 |1.366 |< 0.001 |0.014 |",
"|time |-0.368 |0.275 |0.184 | |"
)
)
})
#################################################################################################################################
data(mockstudy)
test_that("08/01/2017: Beth Atkinson's subset problem", {
idx <- mockstudy$sex == "Male"
form <- fu.stat - 1 ~ age + hgb
expect_identical(capture.kable(summary(modelsum(form, data = mockstudy, subset = idx, adjust = ~arm, family="binomial"), text = TRUE)),
capture.kable(summary(modelsum(form, data = mockstudy, subset = sex == "Male", adjust = ~arm, family="binomial"), text = TRUE)))
})
#################################################################################################################################
set.seed(88)
df <- data.frame(
y = rnorm(1000),
x1 = rnorm(1000),
x2 = rnorm(1000),
x3 = rpois(1000, 2),
x5 = rnorm(1000),
x7 = rep(LETTERS[1:5], each = 200),
x8 = runif(1000)
)
test_that("07/27/2017: Too many adjustment vars in as.data.frame.modelsum (#12)", {
expect_equal(nrow(as.data.frame(modelsum(y ~ x1, adjust = ~ x7 + x2 + x3 + x5 + x8, data = df))), 10L)
})
#################################################################################################################################
test_that("07/27/2017: modelsum labels (#13)", {
expect_identical(
capture.kable(summary(modelsum(bmi ~ age, adjust = ~sex, data = mockstudy),
labelTranslations = list(sexFemale = "Female", age = "Age, yrs"), text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |Nmiss |",
"|:-----------|:--------|:---------|:-------|:-------------|:-----|",
"|(Intercept) |26.793 |0.766 |< 0.001 |0.004 |33 |",
"|Age, yrs |0.012 |0.012 |0.348 | | |",
"|Female |-0.718 |0.291 |0.014 | | |"
)
)
expect_identical(
capture.kable(summary(modelsum(bmi ~ age, adjust = ~sex, data = mockstudy), labelTranslations = list(sexFemale = "Female", age = "Age, yrs"), text = TRUE)),
capture.kable(summary(modelsum(bmi ~ age, adjust = ~sex, data = mockstudy), labelTranslations = c(sexFemale = "Female", age = "Age, yrs"), text = TRUE))
)
expect_warning(summary(modelsum(bmi ~ age, adjust = ~sex, data = mockstudy), labelTranslations = c(badvar = "Eek")), NA)
})
#################################################################################################################################
test_that("12/23/2017: non-syntactic names (#44, #45)", {
dat <- data.frame(y = 1:10, x1x = rep(c("A", "B"), each = 5),
`1x` = rep(c("C", "D"), each = 5),
stringsAsFactors = FALSE, check.names = FALSE)
expect_identical(
capture.kable(summary(modelsum(y ~ x1x, data = dat))),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:-----------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |3.000 |0.707 |0.003 |0.727 |",
"|**x1x B** |5.000 |1.000 |0.001 | |"
)
)
expect_identical(
capture.kable(summary(modelsum(y ~ `1x`, data = dat))),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:-----------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |3.000 |0.707 |0.003 |0.727 |",
"|**1x D** |5.000 |1.000 |0.001 | |"
)
)
})
#################################################################################################################################
test_that("01/05/2018: leading/trailing whitespace (#48)", {
expect_identical(
capture.kable(summary(modelsum(age ~ arm, data = set_labels(mockstudy, list(arm = " Arm "))))),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:------------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |59.673 |0.557 |< 0.001 |-0.001 |",
"|**Arm F: FOLFOX** |0.628 |0.709 |0.376 | |",
"|**Arm G: IROX** |0.090 |0.812 |0.912 | |"
)
)
expect_identical(
capture.kable(summary(modelsum(age ~ arm, data = set_labels(mockstudy, list(arm = " Arm "))), text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:--------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |59.673 |0.557 |< 0.001 |-0.001 |",
"|Arm F: FOLFOX |0.628 |0.709 |0.376 | |",
"|Arm G: IROX |0.090 |0.812 |0.912 | |"
)
)
})
#################################################################################################################################
test_that("02/23/2018: wrapping long labels (#59)", {
labs <- list(
Group = "This is a really long label for the Group variable",
time = "Another really long label. Can you believe how long this is",
dt = "ThisLabelHasNoSpacesSoLetsSeeHowItBehaves"
)
expect_identical(
capture.kable(print(summary(modelsum(Age ~ Group + time + dt, data = set_labels(mdat, labs)), text = TRUE), width = 30)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:------------------------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |40.033 |0.970 |< 0.001 |-0.021 |",
"|This is a really long label |-0.400 |1.372 |0.771 | |",
"|for the Group variable Low | | | | |",
"|This is a really long label |-0.600 |1.372 |0.663 | |",
"|for the Group variable Med | | | | |",
"|(Intercept) |41.130 |1.197 |< 0.001 |0.009 |",
"|Another really long label. |-0.371 |0.275 |0.182 | |",
"|Can you believe how long this | | | | |",
"|is | | | | |",
"|(Intercept) |41.531 |2.017 |< 0.001 |-0.001 |",
"|ThisLabelHasNoSpacesSoLetsSeeH |0.000 |0.000 |0.348 | |",
"|owItBehaves | | | | |"
)
)
})
#################################################################################################################################
test_that("05/31/2018: similar column names (#98)", {
dat <- data.frame(
y = c(1:9, 11),
a = c(2, 2, 1:8),
aa = c(1, 1:9),
b = factor(rep(c("a", "b"), each = 5))
)
expect_identical(
capture.kable(summary(modelsum(y ~ b, adjust = ~a + aa, data = dat))),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:-----------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |0.417 |0.295 |0.208 |0.984 |",
"|**b b** |-0.467 |0.548 |0.427 | |",
"|**a** |-0.083 |0.217 |0.714 | |",
"|**aa** |1.250 |0.183 |< 0.001 | |"
)
)
})
#################################################################################################################################
test_that("05/31/2018: similar column names (#100)", {
dat <- data.frame(
y = c(1:9, 11),
a = factor(rep(c("a", "b"), each = 5), levels = c("b", "a")),
d = factor(rep(c("c", "d"), times = 5), levels = c("c", "d"))
)
expect_identical(
capture.kable(summary(modelsum(y ~ a, adjust = ~ d, data = set_labels(dat, list(a = "A", d = "D"))), text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:-----------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |8.100 |1.112 |< 0.001 |0.656 |",
"|A a |-5.167 |1.213 |0.004 | |",
"|D d |0.167 |1.213 |0.895 | |"
)
)
})
#################################################################################################################################
test_that("06/19/2018: term.name (#109)", {
expect_identical(
capture.kable(summary(modelsum(Age ~ Sex + time, adjust = ~ trt, data = mdat), text = TRUE, term.name = "Term")),
c("|Term |estimate |std.error |p.value |adj.r.squared |",
"|:---------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |40.632 |1.024 |< 0.001 |-0.005 |",
"|Sex Male |-0.221 |1.112 |0.843 | |",
"|Treatment Arm B |-1.373 |1.135 |0.229 | |",
"|(Intercept) |41.938 |1.366 |< 0.001 |0.014 |",
"|time |-0.368 |0.275 |0.184 | |",
"|Treatment Arm B |-1.366 |1.123 |0.227 | |"
)
)
})
#################################################################################################################################
test_that("08/24/2018: latex (#123)", {
expect_identical(
capture.output(summary(modelsum(Age ~ Sex, adjust = ~ trt, data = mdat), text = "latex")),
c("" ,
"\\begin{tabular}{l|l|l|l|l}" ,
"\\hline" ,
" & estimate & std.error & p.value & adj.r.squared\\\\" ,
"\\hline" ,
"(Intercept) & 40.632 & 1.024 & < 0.001 & -0.005\\\\" ,
"\\hline" ,
"\\textbf{Sex Male} & -0.221 & 1.112 & 0.843 & \\\\" ,
"\\hline" ,
"\\textbf{Treatment Arm B} & -1.373 & 1.135 & 0.229 & \\\\",
"\\hline" ,
"\\end{tabular}" ,
""
)
)
})
#################################################################################################################################
test_that("09/05/2018: correctly label contrasts for ordinal variables (#133)", {
mdat$Group.ord <- ordered(mdat$Group.fac, levels = c("Low", "Med", "High"))
expect_identical(
capture.kable(summary(modelsum(Age ~ Phase, adjust = ~ Group.ord + trt + ht_in, data = mdat), text = TRUE)),
c("| |estimate |std.error |p.value |adj.r.squared |",
"|:----------------|:--------|:---------|:-------|:-------------|",
"|(Intercept) |47.686 |7.301 |< 0.001 |-0.019 |",
"|Phase .L |-0.679 |1.152 |0.557 | |",
"|Phase .Q |-1.044 |0.960 |0.280 | |",
"|Group.ord .L |0.243 |0.977 |0.804 | |",
"|Group.ord .Q |0.410 |1.069 |0.702 | |",
"|Treatment Arm B |-1.460 |1.159 |0.211 | |",
"|Height in Inches |-0.112 |0.110 |0.314 | |"
)
)
})
#################################################################################################################################
test_that("08/07/2019: survival confidence limits (#245)", {
skip_if_not(getRversion() >= "3.5.0")
skip_if_not_installed("survival", "2.41-3")
require(survival)
expect_identical(
capture.kable(summary(modelsum(Surv(fu.time, fu.stat) ~ arm, data = mockstudy, conf.level = 0.99, family="survival"), text = TRUE)),
c("| |HR |CI.lower.HR |CI.upper.HR |p.value |concordance |",
"|:-----------------------|:-----|:-----------|:-----------|:-------|:-----------|",
"|Treatment Arm F: FOLFOX |0.638 |0.540 |0.754 |< 0.001 |0.556 |",
"|Treatment Arm G: IROX |0.871 |0.722 |1.050 |0.057 | |"
)
)
})
#################################################################################################################################
test_that("08/07/2019: p.value.lrt (#238)", {
skip_if_not(getRversion() >= "3.5.0")
skip_if_not_installed("survival", "2.41-3")
require(survival)
expect_identical(
capture.kable(summary(modelsum(age ~ sex + arm + bmi, data = mockstudy, gaussian.stats = c("estimate", "p.value.lrt")),
text = TRUE, show.intercept = FALSE)),
c("| |estimate |p.value.lrt |",
"|:------------------------|:--------|:-----------|",
"|sex Female |-1.208 |0.048 |",
"|Treatment Arm F: FOLFOX |0.628 |0.614 |",
"|Treatment Arm G: IROX |0.090 | |",
"|Body Mass Index (kg/m^2) |0.059 |0.289 |"
)
)
expect_identical(
capture.kable(summary(modelsum(Surv(fu.time, fu.stat) ~ sex + arm + bmi, data = mockstudy,
family="survival", survival.stats = c("estimate", "p.value.lrt")),
text = TRUE, show.intercept = FALSE)),
c("| |estimate |p.value.lrt |",
"|:------------------------|:--------|:-----------|",
"|sex Female |0.002 |0.975 |",
"|Treatment Arm F: FOLFOX |-0.449 |< 0.001 |",
"|Treatment Arm G: IROX |-0.138 | |",
"|Body Mass Index (kg/m^2) |-0.016 | |"
)
)
})
test_that("statistic.F works (#262)", {
tab3 <- modelsum(bmi ~ age + sex, data=mockstudy, family=gaussian, gaussian.stats=c("estimate", "N","Nmiss","statistic.F"))
expect_identical(
capture.kable(summary(tab3, text=TRUE)),
c("| |estimate |N |Nmiss |statistic.F |",
"|:------------|:--------|:----|:-----|:-----------|",
"|(Intercept) |26.424 |1466 |33 |1.122 |",
"|Age in Years |0.013 | | | |",
"|(Intercept) |27.491 |1466 |33 |6.341 |",
"|sex Female |-0.731 | | | |"
)
)
})
test_that("Nevents works (#266)", {
skip_if_not(getRversion() >= "3.5.0")
skip_if_not_installed("survival", "2.41-3")
require(survival)
tab3 <- modelsum(Surv(fu.time,fu.stat)~sex, data=mockstudy, survival.stats=c('HR','p.value','Nmiss','Nevents','N'), family = "survival")
expect_identical(
capture.kable(summary(tab3)),
c("| |HR |p.value |Nevents |N |",
"|:--------------|:-----|:-------|:-------|:----|",
"|**sex Female** |1.002 |0.975 |1356 |1499 |"
)
)
})
test_that("relrisk works (#279)", {
skip_if_not(getRversion() >= "3.5.0")
opts <- options()
expect_identical(
capture.kable(summary(modelsum(mdquality.s ~ arm + sex, data = mockstudy, id = case, family = "relrisk"))),
c("| |RR |CI.lower.RR |CI.upper.RR |p.value |Nmiss |",
"|:---------------------------|:-----|:-----------|:-----------|:-------|:-----|",
"|(Intercept) |0.890 |0.859 |0.922 |< 0.001 |252 |",
"|**Treatment Arm F: FOLFOX** |1.014 |0.969 |1.061 |0.538 | |",
"|**Treatment Arm G: IROX** |1.021 |0.972 |1.072 |0.412 | |",
"|(Intercept) |0.899 |0.878 |0.921 |< 0.001 |252 |",
"|**sex Female** |1.004 |0.967 |1.043 |0.826 | |"
)
)
options(opts)
})
test_that("Nevents works for binomial (#325)", {
expect_identical(
capture.kable(summary(modelsum(fu.stat == 1 ~ age, data = mockstudy, family = "binomial",
binomial.stats = c("OR", "Nevents")))),
c("| |OR |Nevents |",
"|:----------------|:-----|:-------|",
"|(Intercept) |0.145 |143 |",
"|**Age in Years** |0.995 | |"
)
)
})
Try the arsenal 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.