document pyramid

DESCRIPTION

@@ -23,7 +23,7 @@ Imports:
     lubridate,
     classInt,
     aweek
-RoxygenNote: 7.1.1
+RoxygenNote: 7.2.3
 Suggests: 
     knitr,
     rmarkdown,

NAMESPACE

@@ -1,20 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
-export("%<>%")
-export("%>%")
-export(add_breaks)
-export(dodge_x_labs)
-export(floor_week)
-export(frmt_num)
-export(get_prev_sunday)
-export(guide_axis_label_trans)
-export(integer_breaks)
-export(label_breaks)
-export(max_2)
-export(pad_number)
 export(plot_epicurve)
 export(plot_pyramid)
-export(rounder)
 import(ggplot2)
 importFrom(magrittr,"%<>%")
 importFrom(magrittr,"%>%")

R/epicurve.R

@@ -4,7 +4,7 @@
 #' Helper function to plot epidemic curves with ggplot2 with options for
 #' grouping data, facets and proportion lines.
 #'
-#' @param df unaggregated dataframe with a minumum of a date column with a date or POSIX class
+#' @param df un-aggregated dataframe with a minumum of a date column with a date or POSIX class
 #' @param date_col date variable to plot incidence with. Must be provided.
 #' @param group_col optional grouping variable to be applied to the fill aesthetic of columns
 #' @param facet_col optional faceting variable to split chart into small multiples

R/pyramid.R

@@ -1,35 +1,38 @@
 
 #' Plot Age/Sex Pyramids
 #'
-#' @param df un-aggregated dataframe with a minimum of age and gender variables
-#' @param age_col
-#' @param gender_col
-#' @param gender_levels
-#' @param facet_col
-#' @param make_age_groups
-#' @param age_breaks
-#' @param age_labels
-#' @param drop_age_levels
-#' @param gender_labs
-#' @param x_lab
-#' @param y_lab
-#' @param colours
-#' @param show_data_labs
-#' @param lab_size
-#' @param lab_in_col
-#' @param lab_out_col
-#' @param lab_nudge_factor
-#' @param facet_col
-#' @param facet_nrow
-#' @param facet_ncol
-#' @param facet_scales
-#' @param facet_labs
-#' @param facet_lab_pos
-#' @param add_missing_cap
+#' @param df un-aggregated dataframe with a minimum of age and gender variables.
+#' @param age_col age variable name in `df`. Can be either a numeric vecotr of ages 
+#'  or a character/factor vector of age groups.
+#' @param gender_col gender variable name in `df` with levels indicating male or female.
+#' @param gender_levels length 2 character vector with male and female level in `gender_col`, respectively.
+#' @param facet_col optional faceting variable name to split chart into small multiples.
+#' @param make_age_groups set to TRUE (default) if `age_col` is numeric and needs to be binned into groups.
+#' @param age_breaks breaks to be used for binning a numerical `age_col`.
+#' @param age_labels break labels to accompany `age_breaks`. Defaults to `epivis:::label_breaks(age_breaks)`.
+#' @param drop_age_levels should age groups with no observations be removed from the chart? Defaults to FALSE.
+#' @param gender_labs optional labels for `gender_levels`
+#' @param x_lab optional label for the X axis.
+#' @param y_lab optional label for the Y axis.
+#' @param colours length 2 character vector of colours used for male and female, respectively.
+#' @param show_data_labs show data labels on chart? Defaults to FALSE.
+#' @param lab_size data labels size.
+#' @param lab_in_col data label colour when placed inside a bar.
+#' @param lab_out_col data label colour when placed outside a bar.
+#' @param lab_nudge_factor threshold for moving a data label outside a bar. Defaults to 5. 
+#'  Increasing the number increases the distance from the max value required to move a label outside the bar.
+#' @param facet_nrow nrow argument passed to [`ggplot2::facet_wrap`]
+#' @param facet_ncol ncol argument passed to [`ggplot2::facet_wrap`]
+#' @param facet_scales facet scales argument passed to [`ggplot2::facet_wrap`]. 
+#'  Should scales be fixed ("fixed", the default), free ("free"), or free in one dimension ("free_x", "free_y")?
+#' @param facet_labs facet labeller argument passed to [`ggplot2::facet_wrap`]. Defaults to [`label_wrap_gen(width = 25)`]
+#' @param facet_lab_pos facet label position argument passed to strip.position in [`ggplot2::facet_wrap`]. 
+#'  Defaults to "top". Options are `c("top", "bottom", "left", "right")`.
+#' @param add_missing_cap show missing data counts for `age_col` and `gender_col`? Defaults to TRUE.
 #'
 #' @return a ggplot object
 #'
-#' @example
+#' @examples
 #'
 #' df_flu <- outbreaks::fluH7N9_china_2013
 #'
@@ -152,19 +155,23 @@ plot_pyramid <- function(
   return(p)
 }
 
+#' @noRd 
 pyramid_brks <- function(x, n = 3) {
   brks <- pretty(0:max(abs(x)), n = n)
   c(-brks, brks)
 }
 
+#' @noRd
 pyramid_labs <- function(x) {
   scales::label_number_si()(abs(x))
 }
 
+#' @noRd
 pyramid_limits <- function(x) {
   c(-max(abs(x)), max(abs(x)))
 }
 
+#' @noRd
 pyramid_labs_pos <- function(x, f = 5) {
   dplyr::case_when(
     x > 0 & x < max(abs(x)) / f ~ -0.1,
@@ -174,6 +181,7 @@ pyramid_labs_pos <- function(x, f = 5) {
   )
 }
 
+#' @noRd
 pyramid_labs_colour <- function(x, f = 5, in_col = "white", out_col = "grey30") {
   dplyr::case_when(
     x > 0 & x < max(abs(x)) / f ~ out_col,

R/utils.R

@@ -1,18 +1,18 @@
 
 #' @importFrom magrittr %>%
-#' @export
+#' @noRd
 magrittr::`%>%`
 
 #' @importFrom magrittr %<>%
-#' @export
+#' @noRd
 magrittr::`%<>%`
 
 #' Re-set date to the first day of the week the date falls in
 #'
 #' @param date a date or something coercible by lubridate::as_date to a date
 #' @param week_start first day of the week to re-set to. 7 = Sunday, 1 = Monday.
 #'
-#' @export
+#' @noRd 
 floor_week <- function(date, week_start = 1) {
   lubridate::floor_date(lubridate::as_date(date), unit = "week", week_start = week_start)
 }
@@ -22,13 +22,13 @@ floor_week <- function(date, week_start = 1) {
 #' @param x numeric vector
 #' @param y 10 will round up to nearest 10, -10 down to nearest 10 etc
 #'
-#' @export
+#' @noRd
 rounder <- function(x, y) {
   if(y >= 0) { x + (y - x %% y)}
   else { x - (x %% abs(y))}
 }
 
-#' @export
+#' @noRd
 integer_breaks <- function(n = 5, ...) {
   fxn <- function(x) {
     breaks <- floor(pretty(x, n, ...))
@@ -38,7 +38,7 @@ integer_breaks <- function(n = 5, ...) {
   return(fxn)
 }
 
-#' @export
+#' @noRd
 dodge_x_labs <- function(n.dodge = 2) {
   ggplot2::guides(x = ggplot2::guide_axis(n.dodge = n.dodge))
 }
@@ -53,7 +53,7 @@ dodge_x_labs <- function(n.dodge = 2) {
 #' @param lab_accuracy accuracy of labels, passed to [`scales::label_number_si`]
 #' @param replace_Inf if `Inf` is your final break, replace with a + sign in the label?
 #'
-#' @export
+#' @noRd
 add_breaks <- function(x, n = 5, style = "jenks", lab_accuracy = 1, replace_Inf = TRUE) {
   style <- match.arg(style, c("fixed", "sd", "equal", "pretty", "quantile", "kmeans", "hclust", "bclust", "fisher", "jenks", "dpih", "headtails"), several.ok = FALSE)
   breaks <- classInt::classIntervals(x, n = n, style = style)
@@ -68,7 +68,7 @@ add_breaks <- function(x, n = 5, style = "jenks", lab_accuracy = 1, replace_Inf
 #' @param lab_accuracy accuracy of labels, passed to [`scales::label_number_si`]
 #' @param replace_Inf if `Inf` is your final break, replace with a + sign in the label?
 #'
-#' @export
+#' @noRd
 label_breaks <- function(breaks, lab_accuracy = 1, replace_Inf = TRUE) {
   labs <- sprintf(
     "%s-%s",
@@ -86,7 +86,7 @@ label_breaks <- function(breaks, lab_accuracy = 1, replace_Inf = TRUE) {
 #' @param x a number to format
 #' @param accuracy accuracy of labels, passed to [`scales::label_number_si`]
 #'
-#' @export
+#' @noRd
 frmt_num <- function(x, accuracy = 1) {
   scales::label_number_si(accuracy = accuracy)(x)
 }
@@ -102,7 +102,7 @@ frmt_num <- function(x, accuracy = 1) {
 #' @param sep separator between week number and year for axis labels. defaults to "\n" (new line)
 #'
 #' @return character vector of week labels
-#' @export
+#' @noRd
 label_weeks <- function(weeks, week_start = 1, sep = "\n") {
   week_labs <- as.character(aweek::date2week(weeks, week_start = week_start, floor_day = TRUE))
   new_labs <- week_labs
@@ -122,17 +122,18 @@ label_weeks <- function(weeks, week_start = 1, sep = "\n") {
 
 #' Duplicate discrete axis labels
 #'
-#' @param label_trans
-#' @param ...
+#' @param label_trans label trans
+#' @param ... additional arguments passed to [ggplot2::guide_axis]
 #'
-#' @export
+#' @noRd
 guide_axis_label_trans <- function(label_trans = identity, ...) {
   axis_guide <- ggplot2::guide_axis(...)
   axis_guide$label_trans <- rlang::as_function(label_trans)
   class(axis_guide) <- c("guide_axis_trans", class(axis_guide))
   axis_guide
 }
 
+#' @noRd
 guide_train.guide_axis_trans <- function(x, ...) {
   trained <- NextMethod()
   trained$key$.label <- x$label_trans(trained$key$.label)
@@ -143,7 +144,7 @@ guide_train.guide_axis_trans <- function(x, ...) {
 #'
 #' @param x
 #'
-#' @export
+#' @noRd
 max_2 <- function(x) {
   x <- unique(x) %>% purrr::discard(is.na) %>% sort()
   n <- length(x)
@@ -156,12 +157,12 @@ max_2 <- function(x) {
 #'
 #' @param date
 #'
-#' @export
+#' @noRd
 get_prev_sunday <- function(date) {
   lubridate::floor_date(as.Date(date), unit = "week", week_start = 7)
 }
 
-#' @export
+#' @noRd
 pad_number <- function(x) {
   formatC(as.numeric(x), width = 2, format = "d", flag = "0")
 }