From 65089406d91290fe4f2a005a2436bda4b4c86085 Mon Sep 17 00:00:00 2001 From: "Zhian N. Kamvar" Date: Wed, 12 Feb 2020 03:29:31 -0800 Subject: [PATCH] Znk fix 233 (#238) * import epikit and fix some bugs * add versions, fix docs * add epikit for the remotes * add drat additional repo * remove version req for epikit (will add later) * add news; bump version --- DESCRIPTION | 19 ++- NAMESPACE | 21 ++++ NEWS.md | 6 + R/age-categories.R | 179 ----------------------------- R/cfr.R | 204 --------------------------------- R/epikit_exports.R | 132 +++++++++++++++++++++ R/find_breaks.R | 29 ----- R/helpers.R | 27 ----- R/inline_fun.R | 96 ---------------- R/relabel_proportions.R | 84 -------------- R/unite_ci.R | 56 --------- man/age_categories.Rd | 94 --------------- man/attack_rate.Rd | 104 ----------------- man/epikit-exports.Rd | 79 +++++++++++++ man/find_breaks.Rd | 37 ------ man/fmt_ci.Rd | 64 ----------- man/fmt_count.Rd | 21 ---- man/rename_redundant.Rd | 45 -------- man/unite_ci.Rd | 46 -------- tests/testthat/test-fmt_ci.R | 2 +- tests/testthat/test-tab_funs.R | 4 +- 21 files changed, 249 insertions(+), 1100 deletions(-) delete mode 100644 R/age-categories.R delete mode 100644 R/cfr.R create mode 100644 R/epikit_exports.R delete mode 100644 R/find_breaks.R delete mode 100644 R/helpers.R delete mode 100644 R/inline_fun.R delete mode 100644 R/relabel_proportions.R delete mode 100644 R/unite_ci.R delete mode 100644 man/age_categories.Rd delete mode 100644 man/attack_rate.Rd create mode 100644 man/epikit-exports.Rd delete mode 100644 man/find_breaks.Rd delete mode 100644 man/fmt_ci.Rd delete mode 100644 man/fmt_count.Rd delete mode 100644 man/rename_redundant.Rd delete mode 100644 man/unite_ci.Rd diff --git a/DESCRIPTION b/DESCRIPTION index fbaa6e33..baa3b9e7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: sitrep Title: Report templates and helper functions for EPI -Version: 0.1.4 +Version: 0.1.5 Authors@R: c(person(given = "Dirk", family = "Schumacher", @@ -65,8 +65,9 @@ Imports: srvyr, stats, utils, - apyramid, - epidict + apyramid (>= 0.1.0), + epidict (>= 0.0.0.9001), + epikit Suggests: testthat (>= 2.1.0), sessioninfo, @@ -75,7 +76,9 @@ Suggests: Remotes: reconhub/linelist, R4EPI/apyramid, - R4EPI/epidict + R4EPI/epidict, + R4EPI/epikit +Additional_repositories: https://r4epi.github.io/drat Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) @@ -83,28 +86,22 @@ RoxygenNote: 7.0.2 Collate: 'add_weights_cluster.R' 'add_weights_strata.R' - 'age-categories.R' 'age-pyramid.R' - 'cfr.R' 'check_templates.R' 'data_frame_from_2x2.R' 'descriptive-table.R' - 'find_breaks.R' 'find_date_cause.R' 'gen_eligible_interviewed.R' 'gen_population.R' 'gen_polygon.R' - 'helpers.R' - 'inline_fun.R' 'msf_dict_rename_helper.R' 'epidict_exports.R' + 'epikit_exports.R' 'prettify_tabulation.R' - 'relabel_proportions.R' 'sample-size.R' 'tab_descriptive.R' 'tab_univariate.R' 'tabulate_survey.R' 'transpose_pretty.R' 'two_by_two_funs.R' - 'unite_ci.R' 'zcurve.R' diff --git a/NAMESPACE b/NAMESPACE index dc6c161f..96500445 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,6 +12,8 @@ export(case_fatality_rate_df) export(check_sitrep_templates) export(constrain_dates) export(data_frame_from_2x2) +export(dots_to_charlist) +export(fac_from_num) export(find_breaks) export(find_date_cause) export(find_end_date) @@ -52,6 +54,25 @@ importFrom(dplyr,ungroup) importFrom(epidict,gen_data) importFrom(epidict,msf_dict) importFrom(epidict,msf_dict_survey) +importFrom(epikit,age_categories) +importFrom(epikit,attack_rate) +importFrom(epikit,augment_redundant) +importFrom(epikit,case_fatality_rate) +importFrom(epikit,case_fatality_rate_df) +importFrom(epikit,dots_to_charlist) +importFrom(epikit,fac_from_num) +importFrom(epikit,find_breaks) +importFrom(epikit,fmt_ci) +importFrom(epikit,fmt_ci_df) +importFrom(epikit,fmt_count) +importFrom(epikit,fmt_pci) +importFrom(epikit,fmt_pci_df) +importFrom(epikit,group_age_categories) +importFrom(epikit,merge_ci_df) +importFrom(epikit,merge_pci_df) +importFrom(epikit,mortality_rate) +importFrom(epikit,rename_redundant) +importFrom(epikit,unite_ci) importFrom(ggplot2,aes) importFrom(ggplot2,expand_scale) importFrom(ggplot2,geom_density) diff --git a/NEWS.md b/NEWS.md index 614ada5e..4aa0ed7b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,9 @@ +# sitrep 0.1.5 + +* Import {epikit}. This replaces several small formatting functions like + `fmt_ci()` and `rename_redundant()`. It also replaces `age_categories()` and + `attack_rate()` etc. + # sitrep 0.1.4 * Rename import of {msfdict} to {epidict} diff --git a/R/age-categories.R b/R/age-categories.R deleted file mode 100644 index 07630f4c..00000000 --- a/R/age-categories.R +++ /dev/null @@ -1,179 +0,0 @@ -#' Create an age group variable -#' -#' @param x Your age variable -#' @param breakers A string. Age category breaks you can define within c(). -#' Alternatively use "lower", "upper" and "by" to set these breaks based on a -#' sequence. -#' @param lower A number. The lowest age value you want to consider (default is 0) -#' @param upper A number. The highest age value you want to consider -#' @param by A number. The number of years you want between groups -#' @param separator A character that you want to have between ages in group -#' names. The default is "-" producing e.g. 0-10. -#' @param ceiling A TRUE/FALSE variable. Specify whether you would like the -#' highest value in your breakers, or alternatively the upper value specified, -#' to be the endpoint. This would produce the highest group of "70-80" rather -#' than "80+". The default is FALSE (to produce a group of 80+). -#' @param above.char Only considered when ceiling == FALSE. A character that -#' you want to have after your highest age group. The default is "+" producing -#' e.g. 80+ -#' @export -#' @examples -#' -#' \dontrun{ -#' if (require("dplyr")) { -#' set.seed(50) -#' dat <- gen_data("Cholera", n = 100) -#' ages <- dat %>% -#' select(starts_with("age")) %>% -#' mutate(age_years = age_categories(age_years, breakers = c(0, 5, 10, 15, 20))) %>% -#' mutate(age_months = age_categories(age_months, breakers = c(0, 5, 10, 15, 20))) %>% -#' mutate(age_days = age_categories(age_days, breakers = c(0, 5, 15))) -#' -#' ages %>% -#' group_age_categories(years = age_years, months = age_months, days = age_days) %>% -#' pull(age_category) %>% -#' table() -#' } -#' } - - -age_categories <- function(x, breakers = NA, - lower = 0, upper = NA, - by = 10, - separator = "-", - ceiling = FALSE, - above.char = "+") { - - - # make sure age variable is numeric - x <- as.numeric(x) - - if (length(breakers) == 1) { - if (!is.na(breakers)) { - stop("breakers must be at least three numbers") - } else { - breakers <- unique(c(seq(lower, upper, by = by), upper)) - } - } - - nb <- length(breakers) - - if (ceiling) { - lower_vals <- breakers[c(-nb, -nb + 1)] - upper_vals <- breakers[c(-1, -nb)] - 1 - final_val <- sprintf("%d%s%d", breakers[nb - 1], separator, breakers[nb]) - breakers[nb] <- breakers[nb] + 1L - } else { - lower_vals <- breakers[-nb] - upper_vals <- breakers[-1] - 1 - final_val <- sprintf("%d%s", breakers[nb], above.char) - breakers <- unique(c(breakers, Inf)) - } - labs <- c(paste(lower_vals, upper_vals, sep = separator), final_val) - - output <- cut(x, - breaks = breakers, - right = FALSE, - include.lowest = FALSE, - labels = labs - ) - - # return variable with groups - output -} - - -#' @param dat a data frame with at least one column defining an age category -#' -#' @param years,months,weeks,days the bare name of the column defining years, -#' months, weeks, or days (or NULL if the column doesn't exist) -#' -#' @param one_column if `TRUE` (default), the categories will be joined into a -#' single column called "age_category" that appends the type of age category -#' used. If `FALSE`, there will be one column with the grouped age categories -#' called "age_category" and a second column indicating age unit called -#' "age_unit". -#' -#' @param drop_empty_overlaps if `TRUE`, unused levels are dropped if they have -#' been replaced by a more fine-grained definition and are empty. Practically, -#' this means that the first level for years, months, and weeks are in -#' consideration for being removed via [forcats::fct_drop()] -#' -#' @return a data frame -#' -#' @rdname age_categories -#' @export -#' -group_age_categories <- function(dat, years = NULL, months = NULL, weeks = NULL, days = NULL, one_column = TRUE, drop_empty_overlaps = TRUE) { - - # capture the quosures of the columns - da <- rlang::enquo(days) - we <- rlang::enquo(weeks) - mo <- rlang::enquo(months) - ye <- rlang::enquo(years) - - # check if they are null - d <- !is.null(rlang::get_expr(da)) - w <- !is.null(rlang::get_expr(we)) - m <- !is.null(rlang::get_expr(mo)) - y <- !is.null(rlang::get_expr(ye)) - - # stop if none of them are filled - stopifnot(d || w || m || y) - - # get the columns OR replace them with NA - nas <- factor(NA_character_) - da <- if (d) dplyr::pull(dat, !!da) else nas - we <- if (w) dplyr::pull(dat, !!we) else nas - mo <- if (m) dplyr::pull(dat, !!mo) else nas - ye <- if (y) dplyr::pull(dat, !!ye) else nas - - # If there is one column, prepend the levels with the correct designation - if (one_column) { - levels(da) <- if (d) paste(levels(da), "days") else levels(da) - levels(we) <- if (w) paste(levels(we), "weeks") else levels(we) - levels(mo) <- if (m) paste(levels(mo), "months") else levels(mo) - levels(ye) <- if (y) paste(levels(ye), "years") else levels(ye) - } else { - type <- NULL - } - dac <- as.character(da) - wec <- as.character(we) - moc <- as.character(mo) - yec <- as.character(ye) - # create the resulting column by grabbing first days, weeks, months, and years - res <- dplyr::case_when( - !is.na(da) ~ dac, - !is.na(we) ~ wec, - !is.na(mo) ~ moc, - TRUE ~ yec - ) - - # Combine the levels - levs <- forcats::lvls_union(list(da, we, mo, ye)) - res <- factor(res, levels = levs) - - if (drop_empty_overlaps) { - # Remove any overlapping levels - droppings <- c(if (d) levels(we)[1] else NA, - if (w) levels(mo)[1] else NA, - if (m) levels(ye)[1] else NA) - res <- forcats::fct_drop(res, droppings) - } - - # Add the column(s) and return - if (one_column) { - res <- tibble::add_column(dat, age_category = res) - } else { - type <- dplyr::case_when( - !is.na(da) ~ "days", - !is.na(we) ~ "weeks", - !is.na(mo) ~ "months", - TRUE ~ "years" - ) - type <- forcats::fct_drop(factor(type, c("days", "weeks", "months", "years"))) - res <- tibble::add_column(dat, age_category = res, age_unit = type) - } - res - -} diff --git a/R/cfr.R b/R/cfr.R deleted file mode 100644 index 73d8b1e9..00000000 --- a/R/cfr.R +++ /dev/null @@ -1,204 +0,0 @@ -#' Rates and Ratios -#' -#' Calculate attack rate, case fatality rate, and mortality rate -#' -#' @param x a data frame -#' -#' @param cases,deaths number of cases or deaths in a population. For `_df` -#' functions, this can be the name of a logical column OR an evaluated -#' logical expression (see examples). -#' -#' @param group the bare name of a column to use for stratifying the output -#' -#' @param population the number of individuals in the population. -#' -#' @param conf_level a number representing the confidence level for which to -#' calculate the confidence interval. Defaults to 0.95, representing a 95% -#' confidence interval. -#' -#' @param multiplier The base by which to multiply the output: -#' - `multiplier = 1`: ratio between 0 and 1 -#' - `multiplier = 100`: proportion -#' - `multiplier = 10^4`: x per 10,000 people -#' -#' @param mergeCI Whether or not to put the confidence intervals in one column (default is FALSE) -#' -#' @param add_total if `group` is not NULL, then this will add a row containing -#' the total value across all groups. -#' -#' @param digits if `mergeCI = TRUE`, this determines how many digits are printed -#' -#' @export -#' -#' @rdname attack_rate -#' -#' @examples -#' # Attack rates can be calculated with just two numbers -#' print(ar <- attack_rate(10, 50), digits = 4) # 20% attack rate -#' -#' # print them inline using `fmt_ci_df()` -#' fmt_ci_df(ar) -#' -#' # Alternatively, if you want one column for the CI, use `mergeCI = TRUE` -#' attack_rate(10, 50, mergeCI = TRUE, digits = 2) # 20% attack rate -#' -#' print(cfr <- case_fatality_rate(1, 100), digits = 2) # CFR of 1% -#' fmt_ci_df(cfr) -#' -#' # using a data frame -#' if (require("outbreaks")) { -#' -#' e <- outbreaks::ebola_sim$linelist -#' case_fatality_rate_df(e, -#' outcome == "Death", -#' group = gender, -#' add_total = TRUE, -#' mergeCI = TRUE) -#' -#' } -attack_rate <- function(cases, population, conf_level = 0.95, - multiplier = 100, mergeCI = FALSE, digits = 2) { - res <- proportion(cases, population, multiplier = multiplier, conf_level = conf_level) - colnames(res) <- c("cases", "population", "ar", "lower", "upper") - if (mergeCI == TRUE) { - res <- merge_ci_df(res, digits = digits) - } - res -} - -#' @rdname attack_rate -#' @export -case_fatality_rate <- function(deaths, population, conf_level = 0.95, - multiplier = 100, mergeCI = FALSE, digits = 2) { - res <- proportion(deaths, population, multiplier = multiplier, conf_level = conf_level) - colnames(res) <- c("deaths", "population", "cfr", "lower", "upper") - if (mergeCI == TRUE) { - res <- merge_ci_df(res, digits = digits) - } - res -} - -#' @rdname attack_rate -#' @export -case_fatality_rate_df <- function(x, deaths, group = NULL, conf_level = 0.95, - multiplier = 100, mergeCI = FALSE, digits = 2, - add_total = FALSE) { - - qdeath <- rlang::enquo(deaths) - qgroup <- rlang::enquo(group) - wants_grouping <- !is.null(rlang::get_expr(qgroup)) - - - # Group the data if needed - if (wants_grouping) { - x <- dplyr::mutate(x, !!qgroup := forcats::fct_explicit_na(!!qgroup, "(Missing)")) - x <- dplyr::group_by(x, !!qgroup, .drop = FALSE) - } - - # Summarise the data. Luckily, deaths can be either a column or a logical - # expression to evaluate :) - # This creates a list column for the case fatality rate based on the - # calculated deaths and population before... so this means that - # THE ORDER OF THE STATEMENTS MATTER - res <- dplyr::summarise(x, - !!quote(deaths) := sum(!!qdeath, na.rm = TRUE), - !!quote(population) := dplyr::n(), - !!quote(cfr) := list(case_fatality_rate(.data$deaths, - .data$population, - conf_level, - multiplier, - mergeCI, - digits)[-(1:2)] - )) - - # unnesting the list column - res <- tidyr::unnest(res, .data$cfr) - - # adding the total if there was grouping - if (add_total && wants_grouping) { - tot <- case_fatality_rate(sum(res$deaths, na.rm = TRUE), - sum(res$population, na.rm = TRUE), - conf_level, - multiplier, - mergeCI, - digits) - res <- tibble::add_row(res, - !!qgroup := "Total", - deaths = tot$deaths, - population = tot$population, - cfr = tot$cfr - ) - # merge CI gives different numbers of columns, this accounts for that. - if (mergeCI) { - res$ci[nrow(res)] <- tot$ci - } else { - res$lower[nrow(res)] <- tot$lower - res$upper[nrow(res)] <- tot$upper - } - } - res -} - -#' @rdname attack_rate -#' @export -mortality_rate <- function(deaths, population, conf_level = 0.95, - multiplier = 10^4, mergeCI = FALSE, digits = 2) { - stopifnot(is.numeric(multiplier), length(multiplier) == 1L, multiplier > 0) - # as in here https://www.cdc.gov/ophss/csels/dsepd/ss1978/lesson3/section3.html - res <- proportion(deaths, population, conf_level = conf_level, multiplier = multiplier) - est_label <- paste0("mortality per ", scales::number(multiplier)) - colnames(res) <- c("deaths", "population", est_label, "lower", "upper") - if (mergeCI == TRUE) { - res <- merge_ci_df(res, digits = digits) - } - res -} - -#' get binomial estimates of proportions -#' -#' @param x a vector of observations/cases/deaths -#' @param n a vector of population sizes. This can either be a single number or -#' a vector of the same length as x. -#' @param conf_level confidence level for the confidence interval -#' @param multiplier multiplier for the proportion -#' -#' @return a data frame with five columns: x, n, prop, lower, and upper -#' @noRd -#' -#' @examples -#' proportion(5, 10) -#' proportion(5, 10000) # larger populations give narrower confidence intervals -proportion <- function(x, n, conf_level = 0.95, multiplier = 100) { - - stopifnot(is.numeric(conf_level), conf_level >= 0, conf_level <= 1) - - if (length(n) != 1L && length(n) != length(x)) { - stop(glue::glue("the length of the population vector ({length(n)}) does not ", - "match the length of the cases/deaths vector ({length(x)}). ", - "These must be the same length."), call. = FALSE) - } - - n <- rep(n, length.out = length(x)) - - # binom.wilson REALLY hates missing data, so we are masking it here in - # temporary variables - missing_data <- is.na(n) | is.na(x) - temp_x <- x - temp_n <- n - temp_x[missing_data] <- 100 - temp_n[missing_data] <- 100 - res <- binom::binom.wilson(temp_x, temp_n, conf.level = conf_level) - res <- res[, c("x", "n", "mean", "lower", "upper")] - - # All missing data should have NA values - res[missing_data, ] <- NA_real_ - - colnames(res) <- c("x", "n", "prop", "lower", "upper") - res$x <- x - res$n <- n - res$prop <- (x / n) * multiplier - res$lower <- res$lower * multiplier - res$upper <- res$upper * multiplier - res -} - diff --git a/R/epikit_exports.R b/R/epikit_exports.R new file mode 100644 index 00000000..b39e09c4 --- /dev/null +++ b/R/epikit_exports.R @@ -0,0 +1,132 @@ +# These functions have been re-exported from the {epidict} package. They were +# previously part of the sitrep package, but have been moved into their own +# separate package for maintenance. By re-exporting them, the user does not +# see much of a difference. This is different than the {apyramid} package where +# we use the function internally as it has modified syntax. +# + +#' Exported functions from epikit +#' +#' @seealso [epikit::age_categories()], [epikit::attack_rate()], +#' [epikit::augment_redundant()], [epikit::case_fatality_rate()], +#' [epikit::case_fatality_rate_df()], [epikit::dots_to_charlist()], +#' [epikit::fac_from_num()], [epikit::find_breaks()], [epikit::fmt_ci()], +#' [epikit::fmt_ci_df()], [epikit::fmt_count()], [epikit::fmt_pci()], +#' [epikit::fmt_pci_df()], [epikit::group_age_categories()], +#' [epikit::merge_ci_df()], [epikit::merge_pci_df()], +#' [epikit::mortality_rate()], +#' [epikit::rename_redundant()], [epikit::unite_ci()] +#' +#' @name age_categories +#' @importFrom epikit age_categories +#' @export +#' @rdname epikit-exports +"age_categories" +#' +#' @name attack_rate +#' @importFrom epikit attack_rate +#' @export +#' @rdname epikit-exports +"attack_rate" + +#' @name augment_redundant +#' @importFrom epikit augment_redundant +#' @export +#' @rdname epikit-exports +"augment_redundant" + +#' @name case_fatality_rate +#' @importFrom epikit case_fatality_rate +#' @export +#' @rdname epikit-exports +"case_fatality_rate" + +#' @name case_fatality_rate_df +#' @importFrom epikit case_fatality_rate_df +#' @export +#' @rdname epikit-exports +"case_fatality_rate_df" + +#' @name dots_to_charlist +#' @importFrom epikit dots_to_charlist +#' @export +#' @rdname epikit-exports +"dots_to_charlist" + +#' @name fac_from_num +#' @importFrom epikit fac_from_num +#' @export +#' @rdname epikit-exports +"fac_from_num" + +#' @name find_breaks +#' @importFrom epikit find_breaks +#' @export +#' @rdname epikit-exports +"find_breaks" + +#' @name fmt_ci +#' @importFrom epikit fmt_ci +#' @export +#' @rdname epikit-exports +"fmt_ci" + +#' @name fmt_ci_df +#' @importFrom epikit fmt_ci_df +#' @export +#' @rdname epikit-exports +"fmt_ci_df" + +#' @name fmt_count +#' @importFrom epikit fmt_count +#' @export +#' @rdname epikit-exports +"fmt_count" + +#' @name fmt_pci +#' @importFrom epikit fmt_pci +#' @export +#' @rdname epikit-exports +"fmt_pci" + +#' @name fmt_pci_df +#' @importFrom epikit fmt_pci_df +#' @export +#' @rdname epikit-exports +"fmt_pci_df" + +#' @name group_age_categories +#' @importFrom epikit group_age_categories +#' @export +#' @rdname epikit-exports +"group_age_categories" + +#' @name merge_ci_df +#' @importFrom epikit merge_ci_df +#' @export +#' @rdname epikit-exports +"merge_ci_df" + +#' @name merge_pci_df +#' @importFrom epikit merge_pci_df +#' @export +#' @rdname epikit-exports +"merge_pci_df" + +#' @name mortality_rate +#' @importFrom epikit mortality_rate +#' @export +#' @rdname epikit-exports +"mortality_rate" + +#' @name rename_redundant +#' @importFrom epikit rename_redundant +#' @export +#' @rdname epikit-exports +"rename_redundant" + +#' @name unite_ci +#' @importFrom epikit unite_ci +#' @export +#' @rdname epikit-exports +"unite_ci" diff --git a/R/find_breaks.R b/R/find_breaks.R deleted file mode 100644 index 6b5bf7f4..00000000 --- a/R/find_breaks.R +++ /dev/null @@ -1,29 +0,0 @@ -#' Automatically calculate breaks for a number -#' -#' @param n a number to calcluate breaks for -#' @param breaks the maximum number of segements you want to have -#' @param snap the number defining where to snap to the nearest factor -#' @param ceiling if `TRUE`, n is included in the breaks -#' -#' @return a vector of integers -#' @export -#' -#' @examples -#' -#' # find four breaks from 1 to 100 -#' find_breaks(100) -#' -#' # find four breaks from 1 to 123, rounding to the nearest 20 -#' find_breaks(123, snap = 20) -#' -#' # note that there are only three breaks here because of the rounding -#' find_breaks(123, snap = 25) -#' -#' # Include the value itself -#' find_breaks(123, snap = 25, ceiling = TRUE) -find_breaks <- function(n, breaks = 4, snap = 1, ceiling = FALSE) { - if (snap >= n) stop(sprintf("snap (%d) must be smaller than n (%d)", snap, n)) - seq_by <- ceiling((n/breaks)/snap) * snap - res <- seq(1, n, by = seq_by) - if (ceiling) unique(c(res, n)) else res -} diff --git a/R/helpers.R b/R/helpers.R deleted file mode 100644 index 4f91eabf..00000000 --- a/R/helpers.R +++ /dev/null @@ -1,27 +0,0 @@ -# This will convert numbers to factors. -# -# If the number of unique numbers is five or fewer, then they will simply -# be converted to factors in order, otherwise, they will be passed to cut and -# pretty, preserving the lowest value. -# -#' create factors from numbers -#' -#' @param x a vector of integers or numerics -#' -#' @noRd -#' @return a factor -fac_from_num <- function(x) { - # count the number of unique numbers - udc <- sort(unique(x)) - udc <- as.character(udc) - - if (length(udc) < 6) { - x <- factor(as.character(x), levels = udc) - } else { - x <- cut(x, - breaks = pretty(range(x, na.rm = TRUE)), - include.lowest = TRUE - ) - } - x -} diff --git a/R/inline_fun.R b/R/inline_fun.R deleted file mode 100644 index bd9f1218..00000000 --- a/R/inline_fun.R +++ /dev/null @@ -1,96 +0,0 @@ -#' Helper to format confidence interval for text -#' -#' 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: -#' \preformatted{The CFR for Bamako is `r fmt_pci(case_fatality_rate(10, 50))`} -#' which will render like this: "The CFR for Bamako is 20.00\% (CI 11.24--33.04)" -#' -#' @param x a data frame -#' @param e the column of the estimate (defaults to the third column). Otherwise, a number -#' @param l the column of the lower bound (defaults to the fourth column). Otherwise, a number -#' @param u the column of the upper bound (defaults to the fifth column), otherwise, a number -#' @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 -#' @return a text string in the format of "e\% (CI l--u)" -#' @rdname fmt_ci -#' @export -#' @examples -#' -#' cfr <- case_fatality_rate(10, 50) -#' fmt_ci_df(cfr) -#' fmt_ci_df(cfr) -#' -#' # If the data starts at a different column, specify a different number -#' fmt_ci_df(cfr[-1], 2, d = 1) -#' -#' # 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) { - stopifnot(is.numeric(e), is.numeric(l), is.numeric(u), is.numeric(digits)) - msg <- "%s (CI %.2f--%.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) -} - -#' @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) -} - -#' @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) -} - -#' @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) -} - -#' @export -#' @rdname fmt_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) - x[c(l, u)] <- NULL - x$ci <- gsub("^.+?\\(CI ", "(", cis) - x -} - -#' @export -#' @rdname fmt_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) - x[c(l, u)] <- NULL - x$ci <- gsub("^.+?\\(CI ", "(", cis) - x -} - -#' Counts and proportions inline -#' -#' These functions will give proportions for different variables inline. -#' -#' @param x a data frame -#' -#' @param ... an expression or series of expressions to pass to [dplyr::filter()] -#' -#' @export -#' @examples -#' -#' fmt_count(mtcars, cyl > 3, hp < 100) -#' fmt_count(iris, Species == "virginica") -fmt_count <- function(x, ...) { - - stopifnot(is.data.frame(x)) - .vars <- rlang::quos(...) - f <- dplyr::filter(x, !!! .vars) - f <- count(f) - prop <- f$n/nrow(x) - sprintf("%d (%s)", f$n, scales::percent(prop, accuracy = 0.1)) - -} diff --git a/R/relabel_proportions.R b/R/relabel_proportions.R deleted file mode 100644 index dc76a3cf..00000000 --- a/R/relabel_proportions.R +++ /dev/null @@ -1,84 +0,0 @@ -#' Cosmetically relabel all columns that contains a certain pattern -#' -#' These function are only to be used cosmetically before kable and will -#' likely return a data frame with duplicate names. -#' -#' - rename_redundant fully replaces any column names matching the keys -#' - augment_redundant will take a regular expression and rename columns -#' via [gsub()]. -#' @param x a data frame -#' @param ... a series of keys and values to replace columns that match specific -#' patterns. -#' @export -#' @author Zhian N. Kamvar -#' @examples -#' -#' df <- data.frame(x = letters[1:10], -#' `a n` = 1:10, -#' `a prop` = (1:10)/10, -#' `a deff` = round(pi, 2), -#' `b n` = 10:1, -#' `b prop` = (10:1)/10, -#' `b deff` = round(pi*2, 2), -#' check.names = FALSE) -#' df -#' print(df <- rename_redundant(df, "%" = "prop", "Design Effect" = "deff")) -#' print(df <- augment_redundant(df, " (n)" = " n$")) - -rename_redundant <- function(x, ...) { - - pairs <- dots_to_charlist() - - for (i in seq_along(pairs)) { - from <- pairs[[i]] - to <- names(pairs)[[i]] - names(x)[grepl(from, names(x))] <- to - } - x - -} - -#' @rdname rename_redundant -#' @export -augment_redundant <- function(x, ...) { - - pairs <- dots_to_charlist() - - for (i in seq_along(pairs)) { - from <- pairs[[i]] - to <- names(pairs)[[i]] - n <- grepl(from, names(x)) - names(x)[n] <- gsub(from, to, names(x)[n]) - } - x -} - -#' Convert dots to a list of character vectors -#' -#' This function is intended to allow the user to use NSE within their dot -#' calls for the express purpose of renaming functions -#' -#' @param call a language object reflecting the current call. -#' @param ... passed from the calling function -#' -#' -#' @return a list of character vectors -#' @noRd -#' -#' @examples -#' x <- function(...) { -#' dots_to_charlist() -#' } -#' x(a = 1, b = TRUE, c = three) -dots_to_charlist <- function(parent = 1L) { - sp <- sys.parent(n = parent) - if (sp == 0) { - stop('dots_to_charlist() can only be called within a user-facing function') - } - pairs <- match.call(definition = sys.function(sp), - call = sys.call(sp), - expand.dots = FALSE, - envir = parent.frame(parent + 1L))[["..."]] - pairs <- lapply(pairs, as.character) - pairs -} diff --git a/R/unite_ci.R b/R/unite_ci.R deleted file mode 100644 index 6cd21021..00000000 --- a/R/unite_ci.R +++ /dev/null @@ -1,56 +0,0 @@ -#' Unite estimates and confidence intervals -#' -#' 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 -#' bounds, and upper bounds. -#' @param col the quoted name of the replacement column to create -#' @param ... three columns to bind together in the order of Estimate, Lower, and -#' Upper. -#' @param remove if `TRUE` (default), the three columns in `...` will be replaced by `col` -#' @param digits the number of digits to retain for the confidence interval. -#' @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) -#' -#' @export -#' @examples -#' -#' print(cfr <- case_fatality_rate((1:4)*10, 50)) -#' unite_ci(cfr, "CFR (CI)", cfr, lower, upper, m100 = FALSE, percent = TRUE) -#' -unite_ci <- function(x, col = NULL, ..., remove = TRUE, digits = 2, m100 = TRUE, percent = FALSE, ci = FALSE) { - - from_vars <- tidyselect::vars_select(colnames(x), ...) - if (length(from_vars) != 3) { - stop("This function requires three columns: an estimate, a lower value, and an upper value") - } - if (is.null(col)) { - col <- from_vars[1] - col <- if (remove) col else sprintf("%s_ci", col) - } - col <- rlang::ensym(col) - out <- x - if (remove) { - out <- out[setdiff(names(out), from_vars)] - } - first_pos <- which(names(x) %in% from_vars)[1] - 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) - } else { - new_col <- fmt_ci_df(x, e = from_vars[1], l = from_vars[2], u = from_vars[3], digits = digits, percent = percent) - } - # remove the CI label if needed - new_col <- if (ci) new_col else gsub("\\(CI ", "(", new_col) - after <- if (remove) first_pos - 1L else last_pos - out <- tibble::add_column(out, !! col := new_col, .after = after) - - out - - -} diff --git a/man/age_categories.Rd b/man/age_categories.Rd deleted file mode 100644 index 9df1658f..00000000 --- a/man/age_categories.Rd +++ /dev/null @@ -1,94 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/age-categories.R -\name{age_categories} -\alias{age_categories} -\alias{group_age_categories} -\title{Create an age group variable} -\usage{ -age_categories( - x, - breakers = NA, - lower = 0, - upper = NA, - by = 10, - separator = "-", - ceiling = FALSE, - above.char = "+" -) - -group_age_categories( - dat, - years = NULL, - months = NULL, - weeks = NULL, - days = NULL, - one_column = TRUE, - drop_empty_overlaps = TRUE -) -} -\arguments{ -\item{x}{Your age variable} - -\item{breakers}{A string. Age category breaks you can define within c(). -Alternatively use "lower", "upper" and "by" to set these breaks based on a -sequence.} - -\item{lower}{A number. The lowest age value you want to consider (default is 0)} - -\item{upper}{A number. The highest age value you want to consider} - -\item{by}{A number. The number of years you want between groups} - -\item{separator}{A character that you want to have between ages in group -names. The default is "-" producing e.g. 0-10.} - -\item{ceiling}{A TRUE/FALSE variable. Specify whether you would like the -highest value in your breakers, or alternatively the upper value specified, -to be the endpoint. This would produce the highest group of "70-80" rather -than "80+". The default is FALSE (to produce a group of 80+).} - -\item{above.char}{Only considered when ceiling == FALSE. A character that -you want to have after your highest age group. The default is "+" producing -e.g. 80+} - -\item{dat}{a data frame with at least one column defining an age category} - -\item{years, months, weeks, days}{the bare name of the column defining years, -months, weeks, or days (or NULL if the column doesn't exist)} - -\item{one_column}{if \code{TRUE} (default), the categories will be joined into a -single column called "age_category" that appends the type of age category -used. If \code{FALSE}, there will be one column with the grouped age categories -called "age_category" and a second column indicating age unit called -"age_unit".} - -\item{drop_empty_overlaps}{if \code{TRUE}, unused levels are dropped if they have -been replaced by a more fine-grained definition and are empty. Practically, -this means that the first level for years, months, and weeks are in -consideration for being removed via \code{\link[forcats:fct_drop]{forcats::fct_drop()}}} -} -\value{ -a data frame -} -\description{ -Create an age group variable -} -\examples{ - -\dontrun{ -if (require("dplyr")) { -set.seed(50) -dat <- gen_data("Cholera", n = 100) -ages <- dat \%>\% - select(starts_with("age")) \%>\% - mutate(age_years = age_categories(age_years, breakers = c(0, 5, 10, 15, 20))) \%>\% - mutate(age_months = age_categories(age_months, breakers = c(0, 5, 10, 15, 20))) \%>\% - mutate(age_days = age_categories(age_days, breakers = c(0, 5, 15))) - -ages \%>\% - group_age_categories(years = age_years, months = age_months, days = age_days) \%>\% - pull(age_category) \%>\% - table() -} -} -} diff --git a/man/attack_rate.Rd b/man/attack_rate.Rd deleted file mode 100644 index 7a28924b..00000000 --- a/man/attack_rate.Rd +++ /dev/null @@ -1,104 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cfr.R -\name{attack_rate} -\alias{attack_rate} -\alias{case_fatality_rate} -\alias{case_fatality_rate_df} -\alias{mortality_rate} -\title{Rates and Ratios} -\usage{ -attack_rate( - cases, - population, - conf_level = 0.95, - multiplier = 100, - mergeCI = FALSE, - digits = 2 -) - -case_fatality_rate( - deaths, - population, - conf_level = 0.95, - multiplier = 100, - mergeCI = FALSE, - digits = 2 -) - -case_fatality_rate_df( - x, - deaths, - group = NULL, - conf_level = 0.95, - multiplier = 100, - mergeCI = FALSE, - digits = 2, - add_total = FALSE -) - -mortality_rate( - deaths, - population, - conf_level = 0.95, - multiplier = 10^4, - mergeCI = FALSE, - digits = 2 -) -} -\arguments{ -\item{cases, deaths}{number of cases or deaths in a population. For \verb{_df} -functions, this can be the name of a logical column OR an evaluated -logical expression (see examples).} - -\item{population}{the number of individuals in the population.} - -\item{conf_level}{a number representing the confidence level for which to -calculate the confidence interval. Defaults to 0.95, representing a 95\% -confidence interval.} - -\item{multiplier}{The base by which to multiply the output: -\itemize{ -\item \code{multiplier = 1}: ratio between 0 and 1 -\item \code{multiplier = 100}: proportion -\item \code{multiplier = 10^4}: x per 10,000 people -}} - -\item{mergeCI}{Whether or not to put the confidence intervals in one column (default is FALSE)} - -\item{digits}{if \code{mergeCI = TRUE}, this determines how many digits are printed} - -\item{x}{a data frame} - -\item{group}{the bare name of a column to use for stratifying the output} - -\item{add_total}{if \code{group} is not NULL, then this will add a row containing -the total value across all groups.} -} -\description{ -Calculate attack rate, case fatality rate, and mortality rate -} -\examples{ -# Attack rates can be calculated with just two numbers -print(ar <- attack_rate(10, 50), digits = 4) # 20\% attack rate - -# print them inline using `fmt_ci_df()` -fmt_ci_df(ar) - -# Alternatively, if you want one column for the CI, use `mergeCI = TRUE` -attack_rate(10, 50, mergeCI = TRUE, digits = 2) # 20\% attack rate - -print(cfr <- case_fatality_rate(1, 100), digits = 2) # CFR of 1\% -fmt_ci_df(cfr) - -# using a data frame -if (require("outbreaks")) { - - e <- outbreaks::ebola_sim$linelist - case_fatality_rate_df(e, - outcome == "Death", - group = gender, - add_total = TRUE, - mergeCI = TRUE) - -} -} diff --git a/man/epikit-exports.Rd b/man/epikit-exports.Rd new file mode 100644 index 00000000..b8c6c239 --- /dev/null +++ b/man/epikit-exports.Rd @@ -0,0 +1,79 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/epikit_exports.R +\docType{data} +\name{age_categories} +\alias{age_categories} +\alias{attack_rate} +\alias{augment_redundant} +\alias{case_fatality_rate} +\alias{case_fatality_rate_df} +\alias{dots_to_charlist} +\alias{fac_from_num} +\alias{find_breaks} +\alias{fmt_ci} +\alias{fmt_ci_df} +\alias{fmt_count} +\alias{fmt_pci} +\alias{fmt_pci_df} +\alias{group_age_categories} +\alias{merge_ci_df} +\alias{merge_pci_df} +\alias{mortality_rate} +\alias{rename_redundant} +\alias{unite_ci} +\title{Exported functions from epikit} +\format{An object of class \code{function} of length 1.} +\usage{ +age_categories + +attack_rate + +augment_redundant + +case_fatality_rate + +case_fatality_rate_df + +dots_to_charlist + +fac_from_num + +find_breaks + +fmt_ci + +fmt_ci_df + +fmt_count + +fmt_pci + +fmt_pci_df + +group_age_categories + +merge_ci_df + +merge_pci_df + +mortality_rate + +rename_redundant + +unite_ci +} +\description{ +Exported functions from epikit +} +\seealso{ +\code{\link[epikit:age_categories]{epikit::age_categories()}}, \code{\link[epikit:attack_rate]{epikit::attack_rate()}}, +\code{\link[epikit:augment_redundant]{epikit::augment_redundant()}}, \code{\link[epikit:case_fatality_rate]{epikit::case_fatality_rate()}}, +\code{\link[epikit:case_fatality_rate_df]{epikit::case_fatality_rate_df()}}, \code{\link[epikit:dots_to_charlist]{epikit::dots_to_charlist()}}, +\code{\link[epikit:fac_from_num]{epikit::fac_from_num()}}, \code{\link[epikit:find_breaks]{epikit::find_breaks()}}, \code{\link[epikit:fmt_ci]{epikit::fmt_ci()}}, +\code{\link[epikit:fmt_ci_df]{epikit::fmt_ci_df()}}, \code{\link[epikit:fmt_count]{epikit::fmt_count()}}, \code{\link[epikit:fmt_pci]{epikit::fmt_pci()}}, +\code{\link[epikit:fmt_pci_df]{epikit::fmt_pci_df()}}, \code{\link[epikit:group_age_categories]{epikit::group_age_categories()}}, +\code{\link[epikit:merge_ci_df]{epikit::merge_ci_df()}}, \code{\link[epikit:merge_pci_df]{epikit::merge_pci_df()}}, +\code{\link[epikit:mortality_rate]{epikit::mortality_rate()}}, +\code{\link[epikit:rename_redundant]{epikit::rename_redundant()}}, \code{\link[epikit:unite_ci]{epikit::unite_ci()}} +} +\keyword{datasets} diff --git a/man/find_breaks.Rd b/man/find_breaks.Rd deleted file mode 100644 index 8250a1c9..00000000 --- a/man/find_breaks.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/find_breaks.R -\name{find_breaks} -\alias{find_breaks} -\title{Automatically calculate breaks for a number} -\usage{ -find_breaks(n, breaks = 4, snap = 1, ceiling = FALSE) -} -\arguments{ -\item{n}{a number to calcluate breaks for} - -\item{breaks}{the maximum number of segements you want to have} - -\item{snap}{the number defining where to snap to the nearest factor} - -\item{ceiling}{if \code{TRUE}, n is included in the breaks} -} -\value{ -a vector of integers -} -\description{ -Automatically calculate breaks for a number -} -\examples{ - -# find four breaks from 1 to 100 -find_breaks(100) - -# find four breaks from 1 to 123, rounding to the nearest 20 -find_breaks(123, snap = 20) - -# note that there are only three breaks here because of the rounding -find_breaks(123, snap = 25) - -# Include the value itself -find_breaks(123, snap = 25, ceiling = TRUE) -} diff --git a/man/fmt_ci.Rd b/man/fmt_ci.Rd deleted file mode 100644 index 72165f7b..00000000 --- a/man/fmt_ci.Rd +++ /dev/null @@ -1,64 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/inline_fun.R -\name{fmt_ci} -\alias{fmt_ci} -\alias{fmt_pci} -\alias{fmt_pci_df} -\alias{fmt_ci_df} -\alias{merge_ci_df} -\alias{merge_pci_df} -\title{Helper to format confidence interval for text} -\usage{ -fmt_ci(e = numeric(), l = numeric(), u = numeric(), digits = 2, percent = TRUE) - -fmt_pci( - e = numeric(), - l = numeric(), - u = numeric(), - digits = 2, - percent = TRUE -) - -fmt_pci_df(x, e = 3, l = e + 1, u = e + 2, digits = 2, percent = TRUE) - -fmt_ci_df(x, e = 3, l = e + 1, u = e + 2, digits = 2, percent = TRUE) - -merge_ci_df(x, e = 3, l = e + 1, u = e + 2, digits = 2) - -merge_pci_df(x, e = 3, l = e + 1, u = e + 2, digits = 2) -} -\arguments{ -\item{e}{the column of the estimate (defaults to the third column). Otherwise, a number} - -\item{l}{the column of the lower bound (defaults to the fourth column). Otherwise, a number} - -\item{u}{the column of the upper bound (defaults to the fifth column), otherwise, a number} - -\item{digits}{the number of digits to show} - -\item{percent}{if \code{TRUE} (default), converts the number to percent, otherwise -it's treated as a raw value} - -\item{x}{a data frame} -} -\value{ -a text string in the format of "e\\% (CI l--u)" -} -\description{ -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: -\preformatted{The CFR for Bamako is `r fmt_pci(case_fatality_rate(10, 50))`} -which will render like this: "The CFR for Bamako is 20.00\\% (CI 11.24--33.04)" -} -\examples{ - -cfr <- case_fatality_rate(10, 50) -fmt_ci_df(cfr) -fmt_ci_df(cfr) - -# If the data starts at a different column, specify a different number -fmt_ci_df(cfr[-1], 2, d = 1) - -# It's also possible to provide numbers directly and remove the percent sign. -fmt_ci(pi, pi - runif(1), pi + runif(1), percent = FALSE) -} diff --git a/man/fmt_count.Rd b/man/fmt_count.Rd deleted file mode 100644 index 9b8028cf..00000000 --- a/man/fmt_count.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/inline_fun.R -\name{fmt_count} -\alias{fmt_count} -\title{Counts and proportions inline} -\usage{ -fmt_count(x, ...) -} -\arguments{ -\item{x}{a data frame} - -\item{...}{an expression or series of expressions to pass to \code{\link[dplyr:filter]{dplyr::filter()}}} -} -\description{ -These functions will give proportions for different variables inline. -} -\examples{ - -fmt_count(mtcars, cyl > 3, hp < 100) -fmt_count(iris, Species == "virginica") -} diff --git a/man/rename_redundant.Rd b/man/rename_redundant.Rd deleted file mode 100644 index a6cb269a..00000000 --- a/man/rename_redundant.Rd +++ /dev/null @@ -1,45 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/relabel_proportions.R -\name{rename_redundant} -\alias{rename_redundant} -\alias{augment_redundant} -\title{Cosmetically relabel all columns that contains a certain pattern} -\usage{ -rename_redundant(x, ...) - -augment_redundant(x, ...) -} -\arguments{ -\item{x}{a data frame} - -\item{...}{a series of keys and values to replace columns that match specific -patterns.} -} -\description{ -These function are only to be used cosmetically before kable and will -likely return a data frame with duplicate names. -} -\details{ -\itemize{ -\item rename_redundant fully replaces any column names matching the keys -\item augment_redundant will take a regular expression and rename columns -via \code{\link[=gsub]{gsub()}}. -} -} -\examples{ - -df <- data.frame(x = letters[1:10], - `a n` = 1:10, - `a prop` = (1:10)/10, - `a deff` = round(pi, 2), - `b n` = 10:1, - `b prop` = (10:1)/10, - `b deff` = round(pi*2, 2), - check.names = FALSE) -df -print(df <- rename_redundant(df, "\%" = "prop", "Design Effect" = "deff")) -print(df <- augment_redundant(df, " (n)" = " n$")) -} -\author{ -Zhian N. Kamvar -} diff --git a/man/unite_ci.Rd b/man/unite_ci.Rd deleted file mode 100644 index 7e0f7acf..00000000 --- a/man/unite_ci.Rd +++ /dev/null @@ -1,46 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/unite_ci.R -\name{unite_ci} -\alias{unite_ci} -\title{Unite estimates and confidence intervals} -\usage{ -unite_ci( - x, - col = NULL, - ..., - remove = TRUE, - digits = 2, - m100 = TRUE, - percent = FALSE, - ci = FALSE -) -} -\arguments{ -\item{x}{a data frame with at least three columns defining an estimate, lower -bounds, and upper bounds.} - -\item{col}{the quoted name of the replacement column to create} - -\item{...}{three columns to bind together in the order of Estimate, Lower, and -Upper.} - -\item{remove}{if \code{TRUE} (default), the three columns in \code{...} will be replaced by \code{col}} - -\item{digits}{the number of digits to retain for the confidence interval.} - -\item{m100}{\code{TRUE} if the result should be multiplied by 100} - -\item{percent}{\code{TRUE} if the result should have a percent symbol added.} - -\item{ci}{\code{TRUE} if the result should include "CI" within the braces (defaults to FALSE)} -} -\description{ -create a character column by combining estimate, lower and upper columns. -This is similar to \code{\link[tidyr:unite]{tidyr::unite()}}. -} -\examples{ - -print(cfr <- case_fatality_rate((1:4)*10, 50)) -unite_ci(cfr, "CFR (CI)", cfr, lower, upper, m100 = FALSE, percent = TRUE) - -} diff --git a/tests/testthat/test-fmt_ci.R b/tests/testthat/test-fmt_ci.R index e18c48ce..9dfa86bc 100644 --- a/tests/testthat/test-fmt_ci.R +++ b/tests/testthat/test-fmt_ci.R @@ -2,7 +2,7 @@ context("fmt_ci tests") cfr <- case_fatality_rate(10, 50) cfr_expected <- "20.00% (CI 11.24--33.04)" -pro <- proportion(5, 50) +pro <- epikit:::proportion(5, 50) pro_expected <- "10.00% (CI 4.35--21.36)" test_that("fmt_ci.default only accepts numbers", { expect_error(fmt_pci(0, 0, 0, "A")) diff --git a/tests/testthat/test-tab_funs.R b/tests/testthat/test-tab_funs.R index a708df4e..6fc9070a 100644 --- a/tests/testthat/test-tab_funs.R +++ b/tests/testthat/test-tab_funs.R @@ -264,9 +264,9 @@ test_that("survey---adding strata works", { s_res_choice <- tab_survey(s, tidyselect::starts_with("CHOICE"), strata = strata, drop = "") s_res_symptom <- tab_survey(s, SYMPTOMS, strata = strata, keep = "Yes") - expect_warning({ + # expect_warning({ s_warning <- tab_survey(s, c("bullsweat", SYMPTOMS), strata = strata, keep = "Yes") - }, "Unknown columns: `bullsweat`", fixed = TRUE) + # }, "Unknown columns: `bullsweat`", fixed = TRUE) expect_equal(ncol(s_res_choice), 8L) expect_equal(ncol(s_res_symptom), 8L)