Skip to content

Commit

Permalink
Allow for HTML footnotes. Close #298
Browse files Browse the repository at this point in the history
  • Loading branch information
eheinzen committed Jun 25, 2020
1 parent 06890c5 commit 967a972
Show file tree
Hide file tree
Showing 4 changed files with 102 additions and 20 deletions.
4 changes: 4 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,10 @@

* `tableby()`: added an error if reserved terms are used in the by-variable. (#277)

* Fixed a bug to conform with new `knitr` publication.

* Added an option for HTML footnotes (and superscripts) in `summary.tableby()`. (#298)

# arsenal v3.4.0

* Added a `pkgdown` site: https://eheinzen.github.io/arsenal/
Expand Down
11 changes: 7 additions & 4 deletions R/summary.tableby.R
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,8 @@
#' the latter avoiding all formatting.
#' \code{"html"} uses the HTML tag \code{<strong>} instead of the markdown formatting, and \code{"latex"} uses
#' the LaTeX command \code{\\textbf}.
#' @param pfootnote Logical, denoting whether to put footnotes describing the tests used to generate the p-values.
#' @param pfootnote Logical, denoting whether to put footnotes describing the tests used to generate the p-values. Alternatively,
#' "html" to surround the outputted footnotes with \code{<li>}.
#' @param term.name A character vector denoting the column name for the "terms" column. It should be the same length
#' as the number of tables or less (it will get recycled if needed). The special value \code{TRUE} will
#' use the y-variable's label for each table.
Expand Down Expand Up @@ -97,11 +98,13 @@ as_data_frame_summary_tableby <- function(df, totals, hasStrata, term.name, cont
if(!is.null(df$p.value)) df$p.value[grepl("^\\s*NA$", df$p.value) | is.na(df$p.value)] <- ""

tests.used <- NULL
if(control$test && pfootnote)
if(control$test && (isTRUE(pfootnote) || identical(pfootnote, "html")))
{
tests.used <- unique(df$test[df$test != "No test"])
df$p.value <- ifelse(df$p.value == "", "", paste0(df$p.value, "^", as.integer(factor(df[["test"]], levels = tests.used)), "^"))
tests.used <- paste0(seq_along(tests.used), ". ", tests.used)
sup <- if(!is.null(text) && identical(text, "html")) c("<sup>", "</sup>") else if(isTRUE(text)) c(" (", ")") else c("^", "^")

df$p.value <- ifelse(df$p.value == "", "", paste0(df$p.value, sup[1], as.integer(factor(df[["test"]], levels = tests.used)), sup[2]))
tests.used <- if(identical(pfootnote, "html")) c("<ol>", paste0("<li>", tests.used, "</li>"), "</ol>") else paste0(seq_along(tests.used), ". ", tests.used)
}

#### don't show the same statistics more than once ####
Expand Down
32 changes: 16 additions & 16 deletions tests/testthat/test_lhs_tableby.R
Original file line number Diff line number Diff line change
Expand Up @@ -360,22 +360,22 @@ test_that("01/31/2019: modpval.tableby (#174, #175)", {
tmp <- modpval.tableby(tmp, data.frame(y = "sex", strata = c("1", "2"), x = c("age", "arm"), p = c(1, 0.5)), use.pname = TRUE)
expect_identical(
capture.kable(summary(tmp, pfootnote = TRUE, text = TRUE)),
c("|fu.stat | | Male (N=916) | Female (N=583) | Total (N=1499) | p |",
"|:-------|:-------------|:---------------:|:---------------:|:---------------:|:--------:|",
"|1 |Age in Years | | | | 1.000^1^ |",
"| |- Mean (SD) | 58.253 (12.048) | 61.018 (10.649) | 59.336 (11.561) | |",
"| |- Range | 32.000 - 85.000 | 35.000 - 80.000 | 32.000 - 85.000 | |",
"| |Treatment Arm | | | | |",
"| |- A: IFL | 14 (16.1%) | 4 (7.1%) | 18 (12.6%) | |",
"| |- F: FOLFOX | 56 (64.4%) | 43 (76.8%) | 99 (69.2%) | |",
"| |- G: IROX | 17 (19.5%) | 9 (16.1%) | 26 (18.2%) | |",
"|2 |Age in Years | | | | |",
"| |- Mean (SD) | 60.686 (11.278) | 59.059 (11.824) | 60.054 (11.516) | |",
"| |- Range | 19.000 - 88.000 | 22.000 - 88.000 | 19.000 - 88.000 | |",
"| |Treatment Arm | | | | 0.500^1^ |",
"| |- A: IFL | 263 (31.7%) | 147 (27.9%) | 410 (30.2%) | |",
"| |- F: FOLFOX | 355 (42.8%) | 237 (45.0%) | 592 (43.7%) | |",
"| |- G: IROX | 211 (25.5%) | 143 (27.1%) | 354 (26.1%) | |",
c("|fu.stat | | Male (N=916) | Female (N=583) | Total (N=1499) | p |",
"|:-------|:-------------|:---------------:|:---------------:|:---------------:|:---------:|",
"|1 |Age in Years | | | | 1.000 (1) |",
"| |- Mean (SD) | 58.253 (12.048) | 61.018 (10.649) | 59.336 (11.561) | |",
"| |- Range | 32.000 - 85.000 | 35.000 - 80.000 | 32.000 - 85.000 | |",
"| |Treatment Arm | | | | |",
"| |- A: IFL | 14 (16.1%) | 4 (7.1%) | 18 (12.6%) | |",
"| |- F: FOLFOX | 56 (64.4%) | 43 (76.8%) | 99 (69.2%) | |",
"| |- G: IROX | 17 (19.5%) | 9 (16.1%) | 26 (18.2%) | |",
"|2 |Age in Years | | | | |",
"| |- Mean (SD) | 60.686 (11.278) | 59.059 (11.824) | 60.054 (11.516) | |",
"| |- Range | 19.000 - 88.000 | 22.000 - 88.000 | 19.000 - 88.000 | |",
"| |Treatment Arm | | | | 0.500 (1) |",
"| |- A: IFL | 263 (31.7%) | 147 (27.9%) | 410 (30.2%) | |",
"| |- F: FOLFOX | 355 (42.8%) | 237 (45.0%) | 592 (43.7%) | |",
"| |- G: IROX | 211 (25.5%) | 143 (27.1%) | 354 (26.1%) | |",
"1. Modified by user"
)
)
Expand Down
75 changes: 75 additions & 0 deletions tests/testthat/test_tableby.R
Original file line number Diff line number Diff line change
Expand Up @@ -1479,3 +1479,78 @@ test_that("Warn if reserved word is used in tableby by-variable (#277)", {
)
})


test_that("HTML footnotes (#298)", {
expect_identical(
capture.output(summary(tableby(sex ~ age + arm, data = mockstudy), text = "html", pfootnote = "html")),
c("<table>" ,
" <thead>" ,
" <tr>" ,
" <th style=\"text-align:left;\"> </th>" ,
" <th style=\"text-align:center;\"> Male (N=916) </th>" ,
" <th style=\"text-align:center;\"> Female (N=583) </th>" ,
" <th style=\"text-align:center;\"> Total (N=1499) </th>" ,
" <th style=\"text-align:right;\"> p value </th>" ,
" </tr>" ,
" </thead>" ,
"<tbody>" ,
" <tr>" ,
" <td style=\"text-align:left;\"> <strong>Age in Years</strong> </td>" ,
" <td style=\"text-align:center;\"> </td>" ,
" <td style=\"text-align:center;\"> </td>" ,
" <td style=\"text-align:center;\"> </td>" ,
" <td style=\"text-align:right;\"> 0.048<sup>1</sup> </td>" ,
" </tr>" ,
" <tr>" ,
" <td style=\"text-align:left;\"> &nbsp;&nbsp;&nbsp;Mean (SD) </td>" ,
" <td style=\"text-align:center;\"> 60.455 (11.369) </td>" ,
" <td style=\"text-align:center;\"> 59.247 (11.722) </td>" ,
" <td style=\"text-align:center;\"> 59.985 (11.519) </td>" ,
" <td style=\"text-align:right;\"> </td>" ,
" </tr>" ,
" <tr>" ,
" <td style=\"text-align:left;\"> &nbsp;&nbsp;&nbsp;Range </td>" ,
" <td style=\"text-align:center;\"> 19.000 - 88.000 </td>" ,
" <td style=\"text-align:center;\"> 22.000 - 88.000 </td>" ,
" <td style=\"text-align:center;\"> 19.000 - 88.000 </td>" ,
" <td style=\"text-align:right;\"> </td>" ,
" </tr>" ,
" <tr>" ,
" <td style=\"text-align:left;\"> <strong>Treatment Arm</strong> </td>",
" <td style=\"text-align:center;\"> </td>" ,
" <td style=\"text-align:center;\"> </td>" ,
" <td style=\"text-align:center;\"> </td>" ,
" <td style=\"text-align:right;\"> 0.190<sup>2</sup> </td>" ,
" </tr>" ,
" <tr>" ,
" <td style=\"text-align:left;\"> &nbsp;&nbsp;&nbsp;A: IFL </td>" ,
" <td style=\"text-align:center;\"> 277 (30.2%) </td>" ,
" <td style=\"text-align:center;\"> 151 (25.9%) </td>" ,
" <td style=\"text-align:center;\"> 428 (28.6%) </td>" ,
" <td style=\"text-align:right;\"> </td>" ,
" </tr>" ,
" <tr>" ,
" <td style=\"text-align:left;\"> &nbsp;&nbsp;&nbsp;F: FOLFOX </td>" ,
" <td style=\"text-align:center;\"> 411 (44.9%) </td>" ,
" <td style=\"text-align:center;\"> 280 (48.0%) </td>" ,
" <td style=\"text-align:center;\"> 691 (46.1%) </td>" ,
" <td style=\"text-align:right;\"> </td>" ,
" </tr>" ,
" <tr>" ,
" <td style=\"text-align:left;\"> &nbsp;&nbsp;&nbsp;G: IROX </td>" ,
" <td style=\"text-align:center;\"> 228 (24.9%) </td>" ,
" <td style=\"text-align:center;\"> 152 (26.1%) </td>" ,
" <td style=\"text-align:center;\"> 380 (25.4%) </td>" ,
" <td style=\"text-align:right;\"> </td>" ,
" </tr>" ,
"</tbody>" ,
"</table>" ,
"<ol>" ,
"<li>Linear Model ANOVA</li>" ,
"<li>Pearson's Chi-squared test</li>" ,
"</ol>" ,
""
)
)
})

0 comments on commit 967a972

Please sign in to comment.