Skip to content

Commit

Permalink
Merge branch 'development'
Browse files Browse the repository at this point in the history 
# Conflicts:
#	README.Rmd
#	README.md
  • Loading branch information
@sambtalcott
sambtalcott committed Feb 1, 2024
2 parents 0f2b818 + a7cfecb commit eb609a3
Show file tree
Hide file tree
Showing 44 changed files with 1,209 additions and 442 deletions.
15 changes: 9 additions & 6 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,30 +22,33 @@ Imports:
grDevices,
grid,
janitor,
keyring,
labelled,
lazyeval,
lubridate (>= 1.7.4),
magrittr (>= 1.5),
plyr,
purrr (>= 0.3.3),
readr,
rlang,
rstudioapi,
scales,
stringr (>= 1.4.0),
tibble (>= 2.1.3),
tidyr (>= 1.0.0)
tidyr (>= 1.0.0),
tidyselect
Suggests:
devtools,
knitr,
rmarkdown,
testthat,
testthat (>= 3.0.0),
usethis,
ggridges,
ggalt,
forcats
forcats,
qualtRics,
haven
VignetteBuilder:
knitr
Encoding: UTF-8
LazyData: true
RoxygenNote: 7.2.3
RoxygenNote: 7.3.0
Config/testthat/edition: 3
5 changes: 4 additions & 1 deletion NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,11 +32,14 @@ export(tableN)
export(theme_tntp)
export(theme_tntp_2018)
export(tntp_colors)
export(tntp_cred)
export(tntp_cred_list)
export(tntp_cred_set)
export(tntp_palette)
export(tntp_style)
export(update_geom_font_defaults)
export(update_tntpr)
importFrom(formattable,percent)
importFrom(ggplot2,'%+replace%')
importFrom(ggplot2,"%+replace%")
importFrom(ggplot2,theme_minimal)
importFrom(magrittr,"%>%")
209 changes: 88 additions & 121 deletions R/bar_chart_counts.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@
#' @param var unquoted column name for variable to count
#' @param group_var (optional) unquoted column name for group variable. If this is specified, you get a 2-variable clustered bar chart. If left blank, a single variable bar chart.
#' @param labels should labels show the count (\code{"n"}) or the percentage (\code{"pct"})?
#' @param var_color color for non-grouped charts; set to medium_blue by default. For both this and \code{group_colors}, strings will be tried in \code{palette_tntp} automatically. So \code{c("orange", "dark_blue")} will get you the official TNTP colors, while \code{c("orange", "blue")} will get you TNTP orange but generic blue.
#' @param var_color color for non-grouped charts; set to TNTP green by default. For both this and \code{group_colors}, strings will be tried in \code{tntp_colors} automatically. So \code{c("red", "green")} will get you the official TNTP colors, while \code{c("red", "brown")} will get you base R red and blue.
#' @param group_colors character vector of group colors, if a specific palette is desired
#' @param title main chart title
#' @param var_label label for x-axis
Expand All @@ -17,40 +17,45 @@
#' @export
#' @examples
#'
#' # all examples not run b/c of Travis CI failures
#' # failure due to not having Segoe UI font imported
#' # library(dplyr) # for %>% pipe
#' # # An N bar chart by default
#' # mtcars %>%
#' # bar_chart_counts(var = cyl,
#' # title = "Number of mtcars by cylinder")
#' #
#' # # Use a grouping variable
#' # mtcars %>%
#' # bar_chart_counts(var = cyl,
#' # group_var = vs,
#' # labels = "pct",
#' # title = "Percentage of V vs. Straight engines by # of cylinders")
#' #
#' # # Change default color
#' # mtcars %>%
#' # bar_chart_counts(var = cyl,
#' # var_color = "orange",
#' # title = "Number of mtcars by cylinder")
#' # # Specify color by group
#' # bar_chart_counts(mtcars, am, cyl,
#' # group_colors = c("orange", "green", "dark_blue"),
#' # labels = "pct")
#' # An N bar chart by default
#' # All examples use font = "sans" to avoid triggering font warnings
#' mtcars |>
#' bar_chart_counts(var = cyl,
#' title = "Number of mtcars by cylinder",
#' font = "sans")
#'
#' # Use a grouping variable
#' mtcars |>
#' bar_chart_counts(var = cyl,
#' group_var = vs,
#' labels = "pct",
#' title = "% of V vs. Straight engines by # of cylinders",
#' font = "sans")
#'
#' # Change default color
#' mtcars |>
#' bar_chart_counts(var = cyl,
#' var_color = "orange",
#' title = "Number of mtcars by cylinder",
#' font = "sans")
#'
#' # Specify color by group
#' mtcars |>
#' bar_chart_counts(am, cyl,
#' group_colors = c("orange", "green", "navy"),
#' labels = "pct",
#' font = "sans")

bar_chart_counts <- function(df,
var,
group_var,
group_var = NULL,
labels = "n",
var_color = "medium_blue",
group_colors,
var_color = "green",
group_colors = NULL,
title = NULL,
var_label,
var_label = NULL,
digits = 1,
font = "Segoe UI",
font = "Halyard Display",
font_size = 12) {
# QC: Throw an error if object supplied to df is not a data.frame -----------
if (!is.data.frame(df)) {
Expand All @@ -62,86 +67,87 @@ bar_chart_counts <- function(df,
stop("You must supply a column name to the var argument")
}

# Ensure the specified font is valid
font <- get_usable_family(font)

# Store whether there is a grouping variable
grouped <- !rlang::quo_is_null(rlang::enquo(group_var))

# Create a plot_data object -------------------------------------------------
# plot_data should contain user specified column and its factor equivalent

# Check if a grouping variable was specified
if (missing(group_var)) {
plot_data <- df %>%
dplyr::select_(.dots = list(vec = lazyeval::lazy(var))) %>%
dplyr::mutate(vec.factor = as.factor(vec)) %>%
dplyr::group_by(vec.factor) %>%
dplyr::tally() %>%
if (!grouped) {
plot_data <- df |>
dplyr::select(vec = {{var}}) |>
dplyr::mutate(vec.factor = as.factor(vec)) |>
dplyr::group_by(vec.factor) |>
dplyr::tally() |>
dplyr::mutate(perc = n / sum(n))
} else {
plot_data <- df %>%
dplyr::select_(.dots = list(
vec = lazyeval::lazy(var),
group.vec = lazyeval::lazy(group_var)
)) %>%
plot_data <- df |>
dplyr::select(vec = {{var}},
group.vec = {{group_var}}) |>
dplyr::mutate(
vec.factor = as.factor(vec),
group.factor = as.factor(group.vec)
) %>%
dplyr::group_by(vec.factor, group.factor) %>%
dplyr::tally() %>%
dplyr::group_by(vec.factor) %>%
dplyr::mutate(perc = n / sum(n)) %>%
dplyr::ungroup() %>%
) |>
dplyr::group_by(vec.factor, group.factor) |>
dplyr::tally() |>
dplyr::group_by(vec.factor) |>
dplyr::mutate(perc = n / sum(n)) |>
dplyr::ungroup() |>
tidyr::complete(vec.factor, group.factor, fill = list(n = NA, perc = NA))
}

# Create a color palette ----------------------------------------------------

# Check if group_var is supplied
if (!missing(group_var)) {
if (missing(group_colors)) {
if (grouped) {
if (is.null(group_colors)) {
# QC: If group_var is supplied, but no colors, create a color palette
# while also making sure there are enough colors for each group

# Select a color for each level of the factor-ed grouping variable. Must
# be less than or equal to 11 (because we only have 11 TNTP colors)
num_groups <- plot_data$group.factor %>%
levels() %>%
num_groups <- plot_data$group.factor |>
levels() |>
length()

if (num_groups > 11) {
stop("The maximum number of levels allowed in group_var is 11")
if (num_groups > 7) {
stop("The maximum number of levels in group_var with the default color palette is 7")
}

tntp_col_pal <- palette_tntp(
"dark_blue", "medium_blue", "light_blue",
"orange", "gold", "green", "dark_grey",
"medium_grey", "light_grey", "white",
"black"
)[1:num_groups]
# Use the new colorful palette by default
tntp_col_pal <- tntp_palette('colorful')

} else {
# QC: Throw an error if the number of levels in supplied group_var does
# not equal the number of group_colors
num_group_var <- plot_data$group.factor %>%
levels() %>%
num_group_var <- plot_data$group.factor |>
levels() |>
length()
num_group_col <- group_colors %>% length()
num_group_col <- group_colors |> length()

if (num_group_var != num_group_col) {
stop("The number of group_colors must equal
the number of levels supplied to group_var")
}
# Switch color name strings to the HEX codes

# Match provided color names to either TNTP or base R colors
tntp_col_pal <- swap_colors(group_colors)
}
}

# Check whether user specified an x axis label ------------------------------
if (missing(var_label)) {
if (is.null(var_label)) {
var_label <- deparse(substitute(var))
}

# Build the N bar chart -----------------------------------------------------
# Condition on presence of group_var

if (missing(group_var)) {
if (!grouped) {
if (labels == "pct") {
nbc <- ggplot2::ggplot(data = plot_data, ggplot2::aes(x = vec.factor, y = perc)) +
ggplot2::geom_bar(fill = swap_colors(var_color), stat = "identity") +
Expand Down Expand Up @@ -200,7 +206,7 @@ bar_chart_counts <- function(df,

# Polish the plot to presentation standards ---------------------------------

# so labels don't get cropped, set the y scale 5% higher than the highest bar
# so labels don't get cropped, set the y scale 10% higher than the highest bar
max_height <- dplyr::if_else(labels == "pct",
max(plot_data$perc, na.rm = TRUE) * 1.1,
max(plot_data$n, na.rm = TRUE) * 1.1
Expand All @@ -211,64 +217,25 @@ bar_chart_counts <- function(df,
limits = c(0, max_height)
) +
ggplot2::labs(title = title, x = var_label) +
ggplot2::theme(
axis.line.y = ggplot2::element_blank(),
axis.line.x = ggplot2::element_line(
color = "grey70",
size = 0.20
),
axis.text.y = ggplot2::element_blank(),
axis.text.x = ggplot2::element_text(
family = font,
size = font_size
),
axis.ticks = ggplot2::element_blank(),
axis.title.x = ggplot2::element_text(
family = font,
size = font_size
),
axis.title.y = ggplot2::element_blank(),
legend.key = ggplot2::element_blank(),
legend.position = "bottom",
legend.text = ggplot2::element_text(
family = font,
size = font_size
),
legend.title = ggplot2::element_blank(),
panel.background = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank(),
plot.title = ggplot2::element_text(
family = font,
face = "bold",
size = font_size
)
)
tntp_style(family = font) +
ggplot2::theme(axis.text.y = ggplot2::element_blank())
nbc
}

# function to swap in custom TNTP colors

swap_colors <- function(x) {
plyr::mapvalues(x,
from = c(
"dark_blue", "medium_blue",
"light_blue", "green",
"orange", "gold",
"dark_grey", "dark_gray",
"medium_grey", "medium_gray",
"light_grey", "light_gray",
"white", "black"
),
to = c(
"#034772", "#2888BC",
"#73B7CE", "#699D46",
"#EA8936", "#F9C347",
"#58595B", "#58595B",
"#7D7E81", "#7D7E81",
"#C1C2C4", "#C1C2C4",
"#FFFFFF", "#000000"
),
warn_missing = FALSE
)
# Attempt to match to TNTP colors first
tryCatch(tntp_colors(x),
error = \(e) {
# Attempt to test all values as R colors next
if(is_color(x)) {
cli::cli_inform(c("i" = "Unable to map some colors from {.val {x}} to TNTP colors. Using base R colors instead."))
x
} else {
cli::cli_warn(c("!" = "Unable to map some colors from {.val {x}} to either TNTP colors or base R colors.",
"i" = "Using values from {.code tntp_palette('colorful')} instead."))
tntp_palette('colorful')
}

})
}
Loading

0 comments on commit eb609a3

Please sign in to comment.