Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

add a separator arg to unite fxs for #27 #31

Merged
merged 1 commit into from
Jan 31, 2023
Merged

add a separator arg to unite fxs for #27 #31

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
24 changes: 13 additions & 11 deletions R/inline_fun.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
#' This function is mainly used for placing in the text fields of Rmarkdown
#' reports. You can use it by writing it in something like this:
#' The CFR for Bamako is `` `r fmt_ci_df(case_fatality_rate(10, 50))` `` which
#' will render like this:
#' will render like this:
#' "The CFR for Bamako is `r fmt_ci_df(case_fatality_rate(10, 50))`"
#'
#' @param x a data frame
Expand All @@ -13,6 +13,8 @@
#' @param digits the number of digits to show
#' @param percent if `TRUE` (default), converts the number to percent, otherwise
#' it's treated as a raw value
#' @param separator what to separate lower and upper confidence intervals with,
#' default is "-"
#' @return a text string in the format of "e\% (CI l--u)"
#' @rdname fmt_ci
#' @export
Expand All @@ -26,31 +28,31 @@
#'
#' # It's also possible to provide numbers directly and remove the percent sign.
#' fmt_ci(pi, pi - runif(1), pi + runif(1), percent = FALSE)
fmt_ci <- function(e = numeric(), l = numeric(), u = numeric(), digits = 2, percent = TRUE) {
fmt_ci <- function(e = numeric(), l = numeric(), u = numeric(), digits = 2, percent = TRUE, separator = "-") {
stopifnot(is.numeric(e), is.numeric(l), is.numeric(u), is.numeric(digits))
msg <- "%s (CI %.2f--%.2f)"
msg <- "%s (CI %.2f%s%.2f)"
msg <- gsub("2", digits, msg)
fun <- if (percent) match.fun(scales::percent) else match.fun(scales::number)
e <- fun(e, scale = 1, accuracy = 1 / (10^digits), big.mark = ",")
sprintf(msg, e, l, u)
sprintf(msg, e, l, separator, u)
}

#' @export
#' @rdname fmt_ci
fmt_pci <- function(e = numeric(), l = numeric(), u = numeric(), digits = 2, percent = TRUE) {
fmt_ci(e = e * 100, l = l * 100, u = u * 100, digits = digits, percent = percent)
fmt_pci <- function(e = numeric(), l = numeric(), u = numeric(), digits = 2, percent = TRUE, separator = "-") {
fmt_ci(e = e * 100, l = l * 100, u = u * 100, digits = digits, percent = percent, separator = separator)
}

#' @export
#' @rdname fmt_ci
fmt_pci_df <- function(x, e = 3, l = e + 1, u = e + 2, digits = 2, percent = TRUE) {
fmt_pci(x[[e]], x[[l]], x[[u]], digits = digits, percent = percent)
fmt_pci_df <- function(x, e = 3, l = e + 1, u = e + 2, digits = 2, percent = TRUE, separator = "-") {
fmt_pci(x[[e]], x[[l]], x[[u]], digits = digits, percent = percent, separator = separator)
}

#' @export
#' @rdname fmt_ci
fmt_ci_df <- function(x, e = 3, l = e + 1, u = e + 2, digits = 2, percent = TRUE) {
fmt_ci(x[[e]], x[[l]], x[[u]], digits = digits, percent = percent)
fmt_ci_df <- function(x, e = 3, l = e + 1, u = e + 2, digits = 2, percent = TRUE, separator = "-") {
fmt_ci(x[[e]], x[[l]], x[[u]], digits = digits, percent = percent, separator = separator)
}

#' Counts and proportions inline
Expand All @@ -60,7 +62,7 @@ fmt_ci_df <- function(x, e = 3, l = e + 1, u = e + 2, digits = 2, percent = TRUE
#' @param x a data frame
#'
#' @param ... an expression or series of expressions to pass to [dplyr::filter()]
#'
#'
#' @return a one-element character vector of the format "n (%)"
#'
#' @export
Expand Down
24 changes: 13 additions & 11 deletions R/unite_ci.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
#' Unite estimates and confidence intervals
#'
#' create a character column by combining estimate, lower and upper columns.
#'
#' create a character column by combining estimate, lower and upper columns.
#' This is similar to [tidyr::unite()].
#'
#' @param x a data frame with at least three columns defining an estimate, lower
Expand All @@ -13,7 +13,9 @@
#' @param m100 `TRUE` if the result should be multiplied by 100
#' @param percent `TRUE` if the result should have a percent symbol added.
#' @param ci `TRUE` if the result should include "CI" within the braces (defaults to FALSE)
#'
#' @param separator what to separate lower and upper confidence intervals with,
#' default is "-"
#'
#' @return a modified data frame with merged columns or one additional column
#' representing the estimate and confidence interval
#'
Expand All @@ -26,7 +28,7 @@
#' print(df)
#' unite_ci(df, "slope (CI)", estimate, lower, upper, m100 = FALSE, percent = FALSE)
#'
unite_ci <- function(x, col = NULL, ..., remove = TRUE, digits = 2, m100 = TRUE, percent = FALSE, ci = FALSE) {
unite_ci <- function(x, col = NULL, ..., remove = TRUE, digits = 2, m100 = TRUE, percent = FALSE, ci = FALSE, separator = "-") {

from_vars <- tidyselect::vars_select(colnames(x), ...)
if (length(from_vars) != 3) {
Expand All @@ -45,9 +47,9 @@ unite_ci <- function(x, col = NULL, ..., remove = TRUE, digits = 2, m100 = TRUE,
last_pos <- which(names(x) %in% from_vars)[3]

if (m100) {
new_col <- fmt_pci_df(x, e = from_vars[1], l = from_vars[2], u = from_vars[3], digits = digits, percent = percent)
new_col <- fmt_pci_df(x, e = from_vars[1], l = from_vars[2], u = from_vars[3], digits = digits, percent = percent, separator = separator)
} else {
new_col <- fmt_ci_df(x, e = from_vars[1], l = from_vars[2], u = from_vars[3], digits = digits, percent = percent)
new_col <- fmt_ci_df(x, e = from_vars[1], l = from_vars[2], u = from_vars[3], digits = digits, percent = percent, separator = separator)
}
# remove the CI label if needed
new_col <- if (ci) new_col else gsub("\\(CI ", "(", new_col)
Expand All @@ -60,17 +62,17 @@ unite_ci <- function(x, col = NULL, ..., remove = TRUE, digits = 2, m100 = TRUE,
#' @export
#' @inheritParams fmt_pci_df
#' @rdname unite_ci
merge_ci_df <- function(x, e = 3, l = e + 1, u = e + 2, digits = 2) {
cis <- fmt_ci_df(x, e, l, u, digits)
merge_ci_df <- function(x, e = 3, l = e + 1, u = e + 2, digits = 2, separator = "-") {
cis <- fmt_ci_df(x, e, l, u, digits, separator = separator)
x[c(l, u)] <- NULL
x$ci <- gsub("^.+?\\(CI ", "(", cis)
x
}

#' @export
#' @rdname unite_ci
merge_pci_df <- function(x, e = 3, l = e + 1, u = e + 2, digits = 2) {
cis <- fmt_pci_df(x, e, l, u, digits)
#' @rdname unite_ci
merge_pci_df <- function(x, e = 3, l = e + 1, u = e + 2, digits = 2, separator = "-") {
cis <- fmt_pci_df(x, e, l, u, digits, separator = separator)
x[c(l, u)] <- NULL
x$ci <- gsub("^.+?\\(CI ", "(", cis)
x
Expand Down
37 changes: 32 additions & 5 deletions man/fmt_ci.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

10 changes: 7 additions & 3 deletions man/unite_ci.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

20 changes: 10 additions & 10 deletions tests/testthat/test-inline_fun.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,9 +1,9 @@

cfr <- case_fatality_rate(10, 50)
cfr_expected <- "20.00% (CI 11.24--33.04)"
cfr_expected <- "20.00% (CI 11.24-33.04)"
cfr_merged <- gsub("^[0-9.% (CI]{11}", "(", cfr_expected)
pro <- proportion(5, 50)
pro_expected <- "10.00% (CI 4.35--21.36)"
pro_expected <- "10.00% (CI 4.35-21.36)"
pro_merged <- gsub("^[0-9.% (CI]{11}", "(", pro_expected)

test_that("fmt_ci.default only accepts numbers", {
Expand All @@ -14,17 +14,17 @@ test_that("fmt_ci.default only accepts numbers", {
})

test_that("fmt_ci will treat missing data without messing up", {
expect_identical(fmt_ci(1 , NA_real_, NA_real_), "1.00% (CI NA--NA)")
expect_identical(fmt_ci(1 , 0 , NA_real_), "1.00% (CI 0.00--NA)")
expect_identical(fmt_ci(1 , 0 , Inf), "1.00% (CI 0.00--Inf)")
expect_identical(fmt_ci(NA_real_ , NA_real_, NA_real_), "NA (CI NA--NA)")
expect_identical(fmt_pci(1 , NA_real_, NA_real_), "100.00% (CI NA--NA)")
expect_identical(fmt_pci(NA_real_, NA_real_, NA_real_), "NA (CI NA--NA)")
expect_identical(fmt_ci(1 , NA_real_, NA_real_), "1.00% (CI NA-NA)")
expect_identical(fmt_ci(1 , 0 , NA_real_), "1.00% (CI 0.00-NA)")
expect_identical(fmt_ci(1 , 0 , Inf), "1.00% (CI 0.00-Inf)")
expect_identical(fmt_ci(NA_real_ , NA_real_, NA_real_), "NA (CI NA-NA)")
expect_identical(fmt_pci(1 , NA_real_, NA_real_), "100.00% (CI NA-NA)")
expect_identical(fmt_pci(NA_real_, NA_real_, NA_real_), "NA (CI NA-NA)")
})

test_that("fmt_ci gives expected results", {
expect_identical(fmt_ci(pi, pi, pi, 2), "3.14% (CI 3.14--3.14)")
expect_identical(fmt_ci(pi, pi, pi, 3), "3.142% (CI 3.142--3.142)")
expect_identical(fmt_ci(pi, pi, pi, 2), "3.14% (CI 3.14-3.14)")
expect_identical(fmt_ci(pi, pi, pi, 3), "3.142% (CI 3.142-3.142)")
})

test_that("fmt_p?ci_df can take data frames", {
Expand Down
Loading