gnoblet/visualizeR
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

du chaos

Browse source
This commit is contained in:
gnoblet 2025-01-19 20:06:31 +01:00
parent a9b8b5f708
commit 5beec7fb90
22 changed files with 782 additions and 171 deletions
Download patch file Download diff file Expand all files Collapse all files

156
R/bar.R
View file

@ -1,11 +1,25 @@
#' @rdname bar
#'
#' @inheritParams bar
#'
#' @export
hbar <- function(...) bar(flip = TRUE, theme_fun = theme_bar(flip = TRUE, add_text = FALSE), ...)
#' Simple bar chart
#'
#' [bar()] is a simple bar chart with some customization allowed, in particular the `theme_fun` argument for theming. [hbar()] uses [bar()] with sane defaults for a horizontal bar chart.
#'
#' @param df A data frame.
#' @param x A quoted numeric column.
#' @param y A quoted character column or coercible as a character column.
#' @param group Some quoted grouping categorical column, e.g. administrative areas or population groups.
#' @param facet Some quoted grouping categorical column, e.g. administrative areas or population groups.
#' @param order Should bars be ordered? "none" if no, "y" if yes based on y, "grouped" if yes based on y and group.
#' @param x_rm_na Remove NAs in x?
#' @param y_rm_na Remove NAs in y?
#' @param group_rm_na Remove NAs in group?
#' @param add_color Add a color to bars (if no grouping).
#' @param flip TRUE or FALSE. Default to TRUE or horizontal bar plot.
#' @param flip TRUE or FALSE (default). Default to TRUE or horizontal bar plot.
#' @param wrap Should x-labels be wrapped? Number of characters.
#' @param position Should the chart be stacked? Default to "dodge". Can take "dodge" and "stack".
#' @param alpha Fill transparency.
@ -25,11 +39,8 @@
#' @param add_text_expand_limit Default to adding 10% on top of the bar.
#' @param add_text_round Round the text label.
#' @param theme_fun Whatever theme function. For no custom theme, use theme_fun = NULL.
#' @param scale_impact Use the package custom scales for fill and color.
#'
#' @inheritParams scale_color_impact_discrete
#'
#' @importFrom rlang `%||%`
#' @inheritParams reorder
#'
#' @export
bar <- function(
@ -37,8 +48,14 @@ bar <- function(
x,
y,
group = "",
add_color = color("dark_grey"),
flip = TRUE,
facet = "",
order = "none",
x_rm_na = TRUE,
y_rm_na = TRUE,
group_rm_na = TRUE,
facet_rm_na = TRUE,
add_color = color("cat_5_main_1"),
flip = FALSE,
wrap = NULL,
position = "dodge",
alpha = 1,
@ -48,16 +65,63 @@ bar <- function(
title = NULL,
subtitle = NULL,
caption = NULL,
width = 0.5,
add_text = TRUE,
add_text_size = 5,
width = 0.7,
add_text = FALSE,
add_text_size = 4,
add_text_color = color("dark_grey"),
add_text_font_face = "plain",
add_text_threshold_display = 0.05,
add_text_suffix = "%",
add_text_expand_limit = 1.2,
add_text_round = 1){
add_text_round = 1,
theme_fun = theme_bar(
flip = FALSE,
add_text = FALSE,
axis_text_x_angle = 45,
axis_text_x_vjust = 1,
axis_text_x_hjust = 1
),
scale_fill_fun = scale_fill_impact_discrete,
scale_color_fun = scale_color_impact_discrete
){
#------ Checks
# df is a data frame
checkmate::assert_data_frame(df)
# x and y and group are character
checkmate::assert_character(x, len = 1)
checkmate::assert_character(y, len = 1)
checkmate::assert_character(group, len = 1)
# x and y are columns in df
checkmate::assert_choice(x, colnames(df))
checkmate::assert_choice(y, colnames(df))
if (group != "") checkmate::assert_choice(group, colnames(df))
# x_rm_na, y_rm_na and group_rm_na are logical scalar
checkmate::assert_logical(x_rm_na, len = 1)
checkmate::assert_logical(y_rm_na, len = 1)
checkmate::assert_logical(group_rm_na, len = 1)
# flip is a logical scalar
checkmate::assert_logical(flip, len = 1)
# add_text_threshold_display is a numeric scalar
checkmate::assert_numeric(add_text_threshold_display, len = 1)
# add_text_suffix is a character scalar
checkmate::assert_character(add_text_suffix, len = 1)
# add_text_expand_limit is a numeric scalar
checkmate::assert_numeric(add_text_expand_limit, len = 1)
# add_text_round is a numeric scalar
checkmate::assert_numeric(add_text_round, len = 1)
# Check if numeric and character
if (class(df[[y]]) %notin% c("integer", "numeric")) rlang::abort(paste0(y, " must be numeric."))
if (!any(class(df[[x]]) %in% c("character", "factor"))) rlang::abort(paste0(x, " must be character or factor"))
@ -65,6 +129,24 @@ if (!any(class(df[[x]]) %in% c("character", "factor"))) rlang::abort(paste0(x, "
# Check if position is stack or dodge
if (position %notin% c("stack", "dodge")) rlang::abort("Position should be either 'stack' or 'dodge'.")
#----- Data wrangling
# want to use df as a data.table
if (!checkmate::test_data_table(df)) {
rlang::warn("Converting df to data.table.")
data.table::setDT(df)
}
# Remove NAs using data.table
if (x_rm_na) df[, (x) := na.omit(get(x))]
if (y_rm_na) df[, (y) := na.omit(get(y))]
if (group != "" && group_rm_na) df[, (group) := na.omit(get(group))]
# Reorder
dir_order = ifelse(flip, 1, -1)
df <- reorder(df, x, y, group, order, dir_order)
# Prepare aes
if(group != "") {
g <- ggplot2::ggplot(
@ -99,9 +181,31 @@ g <- g + ggplot2::labs(
fill = group_title
)
# Width
width <- width
dodge_width <- width
#Facets
if (facet != "") {
g <- g + ggforce::facet_row(facet, scales = "free_x", space = "free")
}
# Guides for legend
# g <- g + ggplot2::guides(
# fill = ggplot2::guide_legend(
# title.position = "left",
# title.hjust = 0,
# label.hjust = 0.5,
# #label.position = "bottom",
# direction = "horizontal"),
# color = ggplot2::guide_legend(
# title.position = "left",
# title.hjust = 0,
# label.hjust = 0.5,
# #label.position = "bottom",
# direction = "horizontal")
# )
# Should the graph use position_fill?
if(group != "") {
@ -156,9 +260,7 @@ if(group != "") {
}
}
# Expand scale
g <- g + ggplot2::scale_y_continuous(expand = c(0, 0))
# Wrap labels on the x scale?
if (!is.null(wrap)) {
g <- g + ggplot2::scale_x_discrete(labels = scales::label_wrap(wrap))
}
@ -193,10 +295,9 @@ if (add_text & position == "dodge") {
fontface = add_text_font_face,
size = add_text_size,
position = ggplot2::position_dodge2(width = dodge_width)
)
)
} else if (add_text & position == "stack") {
} else if (add_text & position == "stack") {
df <- dplyr::mutate(df, "y_threshold" := ifelse(!!rlang::sym(y) >= add_text_threshold_display, !!rlang::sym(y), NA ))
@ -211,11 +312,24 @@ if (add_text & position == "dodge") {
position = ggplot2::position_stack(vjust = 0.5)
)
}
}
# Remove trailing 0
! no applicable method for 'round_any' applied to an object of class "character"
# y scale tweaks
g <- g +
ggplot2::scale_y_continuous(
# start at 0
expand = c(0, 0),
# remove trailing 0 and choose accuracy of y labels
labels = scales::label_number(
accuracy = 0.1,
drop0trailing = TRUE,
big.mark = "",
decimal.mark = "."),
)
# Add theme fun
if (!is.null(theme_fun)) g <- g + theme_fun
return(g)
}
}

104
R/reorder.R Normal file
View file

@ -0,0 +1,104 @@
#' Reorder a Data Frame Factoring Column x
#'
#' @param df A data frame to be reordered.
#' @param x A character scalar specifying the column to be reordered.
#' @param y A character scalar specifying the column to order by if ordering by values.
#' @param group A character scalar specifying the grouping column (optional).
#' @param order A character scalar specifying the order type (one of "none", "y", "grouped"). See details.
#' @param dir_order A logical scalar specifying whether to flip the order.
#'
#' @details Ordering takes the following possible values:
#'
#' * "none": No reordering.
#' * "y": Order by values of y.
#' * "grouped_y": Order by values of y and group.
#' * "x": Order alphabetically by x.
#' * "grouped_x": Order alphabetically by x and group.
#'
#'
#' @return The reordered data frame.
#'
#' @examples
#' # Example usage
#' df <- data.frame(col1 = c("b", "a", "c"), col2 = c(10, 25, 3))
#' reorder(df, "col1", "col2")
#' @export
reorder <- function(df, x, y, group = "", order = "y", dir_order = 1){
#------ Checks
# df is a data frame
checkmate::assert_data_frame(df)
# df is data.table, if not convert
if (!checkmate::test_data_table(df)) {
rlang::warn("Converting df to data.table.")
data.table::setDT(df)
}
# x and y are character scalar and in df
checkmate::assert_character(x, len = 1)
checkmate::assert_character(y, len = 1)
checkmate::assert_subset(x, colnames(df))
checkmate::assert_subset(y, colnames(df))
# group is character scalar and in df if not empty
checkmate::assert_character(group, len = 1)
if (group != "") checkmate::assert_subset(group, colnames(df))
# order is a character scalar in c("none", "y", "grouped")
checkmate::assert_choice(order, c("none", "y", "grouped_y", "x", "grouped_x"))
# dir_order is 1 or -1 (numeric scalar)
checkmate::assert_subset(dir_order, c(1, -1))
#------ Reorder
# droplevels first
if (is.factor(df[[x]])) {
df[, (x) := droplevels(get(x))]
}
# reording options
if (order == "y") {
data.table::setorderv(df, y, order = dir_order)
df[, (x) := forcats::fct_inorder(get(x))]
} else if (order == "grouped" && group == "") {
rlang::warn("Group is empty. Ordering by y only.")
data.table::setorderv(df, y, order = dir_order)
df[, (x) := forcats::fct_inorder(get(x))]
} else if (order == "grouped_y" && group != "") {
data.table::setorderv(df, c(group, y), order = dir_order)
df[, (x) := forcats::fct_inorder(get(x))]
} else if (order == "x") {
data.table::setorderv(df, x, order = dir_order)
df[, (x) := forcats::fct_inorder(get(x))]
} else if (order == "grouped_x" && group != "") {
data.table::setorderv(df, c(group, x), order = dir_order)
df[, (x) := forcats::fct_inorder(get(x))]
} else if (order == "grouped_x" && group == "") {
rlang::warn("Group is empty. Ordering by x only.")
data.table::setorderv(df, x, order = dir_order)
df[, (x) := forcats::fct_inorder(get(x))]
}
return(df)
}

45
R/scale.R
View file

@ -9,7 +9,7 @@
#' @param ... Additional arguments passed to [ggplot2::discrete_scale()] if discrete or [ggplot2::scale_fill_gradient()] if continuous.
#'
#' @export
scale_visualizer_discrete <- function(palette = "cat_5_main", direction = 1, reverse_guide = TRUE, ...) {
scale_visualizer_discrete <- function(palette = "cat_5_main", direction = 1, reverse_guide = TRUE, title_position = NULL, ...) {
s <- scale_color_visualizer_discrete(palette, direction, reverse_guide, ...) +
scale_fill_visualizer_discrete(palette, direction, reverse_guide, ...)
@ -21,7 +21,7 @@ scale_visualizer_discrete <- function(palette = "cat_5_main", direction = 1, rev
#' @rdname scale_visualizer_dicscrete
#'
#' @export
scale_visualizer_continuous <- function(palette = "seq_5_main", direction = 1, reverse_guide = TRUE, ...) {
scale_visualizer_continuous <- function(palette = "seq_5_main", direction = 1, reverse_guide = TRUE, title_position = NULL, ...) {
s <- scale_color_visualizer_continuous(palette, direction, reverse_guide, ...) +
scale_fill_visualizer_continuous(palette, direction, reverse_guide, ...)
@ -40,14 +40,14 @@ scale_visualizer_continuous <- function(palette = "seq_5_main", direction = 1, r
#' @param ... Additional arguments passed to [ggplot2::discrete_scale()] if discrete or [ggplot2::scale_fill_gradient()] if continuous.
#'
#' @export
scale_color_visualizer_discrete <- function(palette = "cat_5_main", direction = 1, reverse_guide = TRUE, ...) {
scale_color_visualizer_discrete <- function(palette = "cat_5_main", direction = 1, reverse_guide = TRUE, title_position = NULL, ...) {
if (!(is.null(palette))) {
ggplot2::discrete_scale(
"color",
palette = palette_gen(palette, "categorical", direction),
guide = ggplot2::guide_legend(
title.position = "top",
title.position = title_position,
draw.ulim = TRUE,
draw.llim = TRUE,
# ticks.colour = "#F1F3F5",
@ -56,11 +56,10 @@ scale_color_visualizer_discrete <- function(palette = "cat_5_main", direction =
...
)
} else {
ggplot2::scale_colour_viridis_d(
direction = direction,
guide = ggplot2::guide_legend(
title.position = "top",
title.position = title_position,
draw.ulim = TRUE,
draw.llim = TRUE,
# ticks.colour = "#F1F3F5",
@ -68,23 +67,20 @@ scale_color_visualizer_discrete <- function(palette = "cat_5_main", direction =
),
...
)
}
}
#' @rdname scale_color_visualizer_discrete
#'
#' @export
scale_fill_visualizer_discrete <- function(palette = "cat_5_main", direction = 1, reverse_guide = TRUE, ...) {
scale_fill_visualizer_discrete <- function(palette = "cat_5_main", direction = 1, reverse_guide = TRUE, title_position = NULL, ...) {
if (!(is.null(palette))) {
ggplot2::discrete_scale(
"fill",
palette = palette_gen(palette, "categorical", direction),
guide = ggplot2::guide_legend(
title.position = "top",
title.position = title_position,
draw.ulim = TRUE,
draw.llim = TRUE,
# ticks.colour = "#F1F3F5",
@ -93,11 +89,10 @@ scale_fill_visualizer_discrete <- function(palette = "cat_5_main", direction = 1
...
)
} else {
ggplot2::scale_fill_viridis_d(
direction = direction,
guide = ggplot2::guide_legend(
title.position = "top",
title.position = title_position,
draw.ulim = TRUE,
draw.llim = TRUE,
# ticks.colour = "#F1F3F5",
@ -105,24 +100,21 @@ scale_fill_visualizer_discrete <- function(palette = "cat_5_main", direction = 1
),
...
)
}
}
#' @rdname scale_color_visualizer_discrete
#'
#' @export
scale_fill_visualizer_continuous <- function(palette = "seq_5_main", direction = 1, reverse_guide = TRUE, ...) {
scale_fill_visualizer_continuous <- function(palette = "seq_5_main", direction = 1, reverse_guide = TRUE, title_position = NULL, ...) {
if (!(is.null(palette))) {
pal <- palette_gen(palette, "continuous", direction)
ggplot2::scale_fill_gradientn(
colors = pal(256),
guide = ggplot2::guide_colorbar(
title.position = "top",
title.position = title_position,
draw.ulim = TRUE,
draw.llim = TRUE,
# ticks.colour = "#F1F3F5",
@ -130,37 +122,32 @@ scale_fill_visualizer_continuous <- function(palette = "seq_5_main", direction =
),
...
)
} else {
ggplot2::scale_fill_viridis_c(
option = "magma",
guide = ggplot2::guide_colorbar(
title.position = "top",
title.position = title_position,
draw.ulim = TRUE,
draw.llim = TRUE,
# ticks.colour = "#F1F3F5",
reverse = reverse_guide
),
...)
}
}
#' @rdname scale_color_visualizer_discrete
#'
#' @export
scale_color_visualizer_continuous <- function(palette = "seq_5_main", direction = 1, reverse_guide = TRUE, ...) {
scale_color_visualizer_continuous <- function(palette = "seq_5_main", direction = 1, reverse_guide = TRUE, title_position = NULL, ...) {
if (!(is.null(palette))) {
pal <- palette_gen(palette, "continuous", direction)
ggplot2::scale_fill_gradientn(
colors = pal(256),
guide = ggplot2::guide_colorbar(
title.position = "top",
title.position = title_position,
draw.ulim = TRUE,
draw.llim = TRUE,
# ticks.colour = "#F1F3F5",
@ -168,20 +155,16 @@ scale_color_visualizer_continuous <- function(palette = "seq_5_main", direction
),
...
)
} else {
ggplot2::scale_colour_viridis_c(
option = "magma",
guide = ggplot2::guide_colorbar(
title.position = "top",
title.position = title_position,
draw.ulim = TRUE,
draw.llim = TRUE,
# ticks.colour = "#F1F3F5",
reverse = reverse_guide
),
....)
}
}

22
R/test-example.R
View file

@ -1,22 +0,0 @@
dat <- data.frame(
x = c(15, 34, 59, 21, 33, 66),
y = c("Admin A", "Admin B", "Admin C", "Admin C", "Admin B", "Admin A"),
group = c("Displaced", "Non displaced", "Non displaced", "Displaced", "Displaced", "Non displaced")
)
dat |>
bar(
x = "y",
y = "x",
group = "group",
flip = F,
add_text = F,
title = "In Admin A and C, Non-Displaced Persons Face Greater WASH Challenges Than Their Displaced Counterparts",
subtitle = "% of households not accessing WASH services by admin 1 and status",
caption = "Source: FAO 2022. No message is a real one. Fake data are used in this example. As a cautiom, no decision should be made based on this plot.",
) +
theme_visualizer_bar() +
scale_color_visualizer_discrete() +
scale_fill_visualizer_discrete()

147
R/theme.R
View file

@ -1,22 +1,3 @@
#' ggplot2 theme for bar charts with sane defaults
#'
#' @rdname theme_visualizer
#' @inheritParams theme_visualizer
#'
#' @export
theme_visualizer_bar <- function(...) {
theme_visualizer_default(
grid_major_y = TRUE
, axis_line_y = FALSE
, axis_ticks_y = FALSE
, grid_major_x = FALSE
, ...
)
}
#' ggplot2 theme wrapper with fonts and colors
#'
#' @param font_family The font family for all plot's texts. Default to "Segoe UI".
@ -79,42 +60,51 @@ theme_visualizer_bar <- function(...) {
#' @description Give some reach colors and fonts to a ggplot.
#'
#' @export
theme_visualizer_default <- function(
font_family = "Carlito",
title_size = 14,
theme_default <- function(
title_font_family = "Carlito",
title_size = 16,
title_color = color("dark_grey"),
title_font_face = "bold",
title_hjust = NULL,
title_position_to_plot = TRUE,
title_font_family = "Carlito",
subtitle_size = 13,
subtitle_font_face = "plain",
subtitle_font_family = "Carlito",
text_size = 12,
subtitle_size = 15,
subtitle_color = color("dark_grey"),
subtitle_font_face = "plain",
subtitle_hjust = NULL,
text_font_family = "Carlito",
text_size = 13,
text_color = color("dark_grey"),
text_font_face = "plain",
panel_background_color = "#FFFFFF",
panel_border = FALSE,
panel_border_color = color("dark_grey"),
legend_position = "bottom",
legend_position = "top",
legend_direction = "horizontal",
legend_justification = "center",
legend_reverse = TRUE,
legend_title_size = 12,
legend_title_size = 13,
legend_title_color = color("dark_grey"),
legend_title_font_face = "plain",
legend_text_size = 12,
legend_text_size = 13,
legend_text_color = color("dark_grey"),
legend_text_font_face = "plain",
facet_title_size = 13,
facet_title_color = color("dark_grey"),
facet_title_font_face = "bold",
facet_title_font_family = "Carlito",
facet_title_position = "bottom",
facet_background_color = color("light_grey"),
axis_x = TRUE,
axis_y = TRUE,
axis_text_x = TRUE,
axis_line_x = TRUE,
axis_ticks_x = TRUE,
axis_line_x = FALSE,
axis_ticks_x = FALSE,
axis_text_y = TRUE,
axis_line_y = TRUE,
axis_ticks_y = TRUE,
axis_text_size = 12,
axis_text_font_family = "Carlito",
axis_text_size = 13,
axis_text_color = color("dark_grey"),
axis_text_font_face = "plain",
axis_title_size = 15,
@ -128,29 +118,24 @@ theme_visualizer_default <- function(
grid_major_color = color("dark_grey"),
grid_major_x_size = 0.1,
grid_major_y_size = 0.1,
grid_minor_x = FALSE,
grid_minor_x = TRUE,
grid_minor_y = FALSE,
grid_minor_color = color("dark_grey"),
grid_minor_x_size = 0.05,
grid_minor_y_size = 0.05,
caption_font_family = "Carlito",
caption_font_face = "plain",
caption_position_to_plot = TRUE,
caption_text_size = 10,
caption_text_color = color("dark_grey"),
caption_size = 11,
caption_color = color("dark_grey"),
...) {
# Basic simple theme
# theme <- ggplot2::theme_bw()
theme <- ggplot2::theme_minimal()
theme <- ggplot2::theme(
# Title - design
title = ggtext::element_textbox_simple(
family = title_font_family,
color = title_color,
size = title_size,
face = title_font_face
),
# Text - design
theme <- theme + ggplot2::theme(
# # Text - design
text = ggplot2::element_text(
family = font_family,
family = text_font_family,
color = text_color,
size = text_size,
face = text_font_face
@ -159,58 +144,58 @@ theme_visualizer_default <- function(
legend.position = legend_position,
# Defaut legend to vertical direction
legend.direction = legend_direction,
# Default legend to left justified
legend.justification = legend_justification,
# set panel background color
panel.background = ggplot2::element_rect(
fill = panel_background_color
),
# Remove background for legend key
legend.key = ggplot2::element_blank(),
# Text sizes
axis.text = ggplot2::element_text(
size = axis_text_size,
family = font_family,
family = axis_text_font_family,
face = axis_text_font_face,
color = axis_text_color
),
axis.title = ggplot2::element_text(
size = axis_title_size,
family = font_family,
family = axis_text_font_family,
face = axis_title_font_face,
color = axis_title_color
),
# Wrap title
# # Wrap title
plot.title = ggtext::element_textbox_simple(
hjust = title_hjust,
width = grid::unit(0.8, "npc"),
family = title_font_family,
color = title_color,
size = title_size,
face = title_font_face,
width = grid::unit(0.9, "npc"),
margin = ggplot2::margin(b = 5)
),
plot.subtitle = ggtext::element_textbox_simple(
hjust = title_hjust,
family = subtitle_font_family,
color = text_color,
color = subtitle_color,
size = subtitle_size,
face = subtitle_font_face,
margin = ggplot2::margin(t = 5, b = 5)
),
plot.caption = ggtext::element_textbox_simple(
size = caption_text_size,
family = font_family,
color = caption_text_color
),
legend.title = ggplot2::element_text(
size = legend_title_size,
face = legend_title_font_face,
family = font_family,
color = legend_title_color
),
legend.text = ggplot2::element_text(
size = legend_text_size,
face = legend_text_font_face,
family = font_family,
color = legend_text_color
size = caption_size,
face = caption_font_face,
family = caption_font_family,
color = caption_color,
margin = ggplot2::margin(t = 5)
),
# legend.title = ggplot2::element_text(
# size = legend_title_size,
# face = legend_title_font_face,
# family = font_family,
# color = legend_title_color
# #, vjust = 0.5
# ),
# legend.text = ggplot2::element_text(
# size = legend_text_size,
# face = legend_text_font_face,
# family = font_family,
# color = legend_text_color
# # #, hjust = 0.5
# # ),
axis.text.x = ggplot2::element_text(
angle = axis_text_x_angle,
vjust = axis_text_x_vjust,
@ -377,6 +362,20 @@ theme_visualizer_default <- function(
)
}
# Add facet title text size
theme <- theme + ggplot2::theme(
strip.text = ggplot2::element_text(
size = facet_title_size,
family = facet_title_font_family,
face = facet_title_font_face,
color = facet_title_color
),
strip.background = ggplot2::element_rect(
fill = facet_background_color,
linewidth = 0
)
)
# Other parameters
theme <- theme + ggplot2::theme(...)

63
R/theme_bar.R Normal file
View file

@ -0,0 +1,63 @@
#' Custom Theme for Bar Charts
#'
#' @return A custom theme object.
#'
#' @export
theme_bar <- function(flip = TRUE, add_text = FALSE, axis_text_x_angle = 0, axis_text_x_vjust = 0.5, axis_text_x_hjust = 0.5) {
# If add_text is TRUE, flip is FALSE
if (!flip && !add_text){
par_axis_line_y <- FALSE
par_axis_ticks_y <- FALSE
par_axis_line_x <- TRUE
par_axis_ticks_x <- TRUE
par_grid_major_y <- TRUE
par_grid_major_x <- FALSE
par_grid_minor_y <- TRUE
par_grid_minor_x <- FALSE
} else if (flip && !add_text){
par_axis_line_y <- TRUE
par_axis_ticks_y <- TRUE
par_axis_line_x <- FALSE
par_axis_ticks_x <- FALSE
par_grid_major_y <- FALSE
par_grid_major_x <- TRUE
par_grid_minor_y <- FALSE
par_grid_minor_x <- TRUE
} else if (!flip && add_text){
par_axis_line_y <- FALSE
par_axis_ticks_y <- FALSE
par_axis_line_x <- TRUE
par_axis_ticks_x <- TRUE
par_grid_major_y <- FALSE
par_grid_major_x <- FALSE
par_grid_minor_y <- FALSE
par_grid_minor_x <- FALSE
} else if (flip && add_text){
par_axis_line_y <- TRUE
par_axis_ticks_y <- TRUE
par_axis_line_x <- FALSE
par_axis_ticks_x <- FALSE
par_grid_major_y <- FALSE
par_grid_major_x <- FALSE
par_grid_minor_y <- FALSE
par_grid_minor_x <- FALSE
}
# Theme
t <- theme_default(
grid_major_y = par_grid_major_y
, axis_line_y = par_axis_line_y
, axis_ticks_y = par_axis_ticks_y
, axis_ticks_x = par_axis_ticks_x
, axis_line_x = par_axis_line_x
, grid_major_x = par_grid_major_x
, grid_minor_y = par_grid_minor_y
, grid_minor_x = par_grid_minor_x
, axis_text_x_angle = axis_text_x_angle
, axis_text_x_vjust = axis_text_x_vjust
, axis_text_x_hjust = axis_text_x_hjust
)
return(t)
}

49
R/theme_visualizer_bar.R Normal file
View file

@ -0,0 +1,49 @@
#' Dynamic Theme for ggplot2
#'
#' A dynamic theme that adjusts axis text styles based on whether the plot is flipped.
#'
#' This function dynamically applies different axis text styles depending on
#' the coordinate system of the plot. If the plot is flipped (e.g., using
#' `coord_flip()`), the x-axis and y-axis text styles are adjusted accordingly.
#'
#' @return A ggproto object that applies a dynamic theme to a ggplot2 plot.
#' @examples
#' library(ggplot2)
#'
#' # Example with a regular plot
#' p <- ggplot(mpg, aes(displ, hwy)) +
#' geom_col()
#'
#' # Add the dynamic theme
#' p + theme_visualizer_bar()
#'
#' # Add the dynamic theme with a flipped coordinate system
#' p + theme_visualizer_bar() + coord_flip()
#'
#' @export
theme_visualizer_bar <- function() {
out <- theme_grey()
class(out) <- c("ThemeVisualizerBar", class(out))
#structure(list(), class = c("ThemeVisualizerBar", "theme", "gg"))
return(out)
}
ggplot_add.theme_visualizer_bar <- function(object, p, object_name) {
# Check if the plot is flipped
is_flipped <- inherits(p$coordinates, "CoordFlip")
if (!is_flipped) {
object <- object +
theme_minimal()
} else {
object <- object +
theme(
panel.grid.major = ggplot2::element_line(color = "blue")
)
}
return(object)
}