bckp
This commit is contained in:
parent
5beec7fb90
commit
7f56642954
68 changed files with 1380 additions and 953 deletions
166
R/bar.R
166
R/bar.R
|
|
@ -3,11 +3,13 @@
|
|||
#' @inheritParams bar
|
||||
#'
|
||||
#' @export
|
||||
hbar <- function(...) bar(flip = TRUE, theme_fun = theme_bar(flip = TRUE, add_text = FALSE), ...)
|
||||
hbar <- function(..., flip = TRUE, add_text = FALSE, theme_fun = theme_bar(flip = flip, add_text = add_text)) {
|
||||
bar(flip = flip, add_text = add_text, theme_fun = theme_fun, ...)
|
||||
}
|
||||
|
||||
#' 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.
|
||||
#' `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.
|
||||
|
|
@ -18,7 +20,10 @@ hbar <- function(...) bar(flip = TRUE, theme_fun = theme_bar(flip = TRUE, add_te
|
|||
#' @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 facet_rm_na Remove NAs in facet?
|
||||
#' @param y_expand Multiplier to expand the y axis.
|
||||
#' @param add_color Add a color to bars (if no grouping).
|
||||
#' @param add_color_guide Should a legend be added?
|
||||
#' @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".
|
||||
|
|
@ -36,11 +41,13 @@ hbar <- function(...) bar(flip = TRUE, theme_fun = theme_bar(flip = TRUE, add_te
|
|||
#' @param add_text_font_face Text font_face.
|
||||
#' @param add_text_threshold_display Minimum value to add the text label.
|
||||
#' @param add_text_suffix If percent is FALSE, should we add a suffix to the text label?
|
||||
#' @param add_text_expand_limit Default to adding 10% on top of the bar.
|
||||
#' @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.
|
||||
#'
|
||||
#' @inheritParams reorder
|
||||
#' @inheritParams reorder_by
|
||||
#'
|
||||
#' @importFrom rlang `:=`
|
||||
#'
|
||||
#' @export
|
||||
bar <- function(
|
||||
|
|
@ -54,7 +61,9 @@ bar <- function(
|
|||
y_rm_na = TRUE,
|
||||
group_rm_na = TRUE,
|
||||
facet_rm_na = TRUE,
|
||||
y_expand = 0.1,
|
||||
add_color = color("cat_5_main_1"),
|
||||
add_color_guide = TRUE,
|
||||
flip = FALSE,
|
||||
wrap = NULL,
|
||||
position = "dodge",
|
||||
|
|
@ -65,24 +74,24 @@ bar <- function(
|
|||
title = NULL,
|
||||
subtitle = NULL,
|
||||
caption = NULL,
|
||||
width = 0.7,
|
||||
width = 0.8,
|
||||
add_text = FALSE,
|
||||
add_text_size = 4,
|
||||
add_text_size = 4.5,
|
||||
add_text_color = color("dark_grey"),
|
||||
add_text_font_face = "plain",
|
||||
add_text_font_face = "bold",
|
||||
add_text_threshold_display = 0.05,
|
||||
add_text_suffix = "%",
|
||||
add_text_expand_limit = 1.2,
|
||||
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
|
||||
flip = flip,
|
||||
add_text = add_text,
|
||||
axis_text_x_angle = 0,
|
||||
axis_text_x_vjust = 0.5,
|
||||
axis_text_x_hjust = 0.5
|
||||
),
|
||||
scale_fill_fun = scale_fill_impact_discrete,
|
||||
scale_color_fun = scale_color_impact_discrete
|
||||
scale_fill_fun = scale_fill_visualizer_discrete(),
|
||||
scale_color_fun = scale_color_visualizer_discrete()
|
||||
){
|
||||
|
||||
|
||||
|
|
@ -105,10 +114,26 @@ if (group != "") checkmate::assert_choice(group, colnames(df))
|
|||
checkmate::assert_logical(x_rm_na, len = 1)
|
||||
checkmate::assert_logical(y_rm_na, len = 1)
|
||||
checkmate::assert_logical(group_rm_na, len = 1)
|
||||
checkmate::assert_logical(facet_rm_na, len = 1)
|
||||
|
||||
# flip is a logical scalar
|
||||
checkmate::assert_logical(flip, len = 1)
|
||||
|
||||
# wrap is a numeric scalar or NULL
|
||||
if (!is.null(wrap)) checkmate::assert_numeric(wrap, len = 1, null.ok = TRUE)
|
||||
|
||||
# alpha is a numeric scalar between 0 and 1
|
||||
checkmate::assert_numeric(alpha, lower = 0, upper = 1, len = 1)
|
||||
|
||||
# add_text is a logical scalar
|
||||
checkmate::assert_logical(add_text, len = 1)
|
||||
|
||||
# add_text_size is a numeric scalar
|
||||
checkmate::assert_numeric(add_text_size, len = 1)
|
||||
|
||||
# add_text_font_face is a character scalar in bold plain or italic
|
||||
checkmate::assert_choice(add_text_font_face, c("bold", "plain", "italic"))
|
||||
|
||||
# add_text_threshold_display is a numeric scalar
|
||||
checkmate::assert_numeric(add_text_threshold_display, len = 1)
|
||||
|
||||
|
|
@ -121,8 +146,7 @@ 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
|
||||
# x and y are numeric or 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"))
|
||||
|
||||
|
|
@ -131,22 +155,36 @@ if (position %notin% c("stack", "dodge")) rlang::abort("Position should be eithe
|
|||
|
||||
#----- 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)
|
||||
# facets over group
|
||||
if (group != "" && facet != "" && group == facet) {
|
||||
rlang::warn("'group' and 'facet' are the same identical.")
|
||||
}
|
||||
|
||||
# remove NAs using base R
|
||||
if (x_rm_na) df <- df[!(is.na(df[[x]])),]
|
||||
if (y_rm_na) df <- df[!(is.na(df[[y]])),]
|
||||
if (group != "" && group_rm_na) df <- df[!(is.na(df[[group]])),]
|
||||
if (facet != "" && facet_rm_na) df <- df[!(is.na(df[[facet]])),]
|
||||
|
||||
|
||||
# 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 <- if(flip && order %in% c("x", "grouped_x")) {
|
||||
-1
|
||||
} else if (!flip && order %in% c("x", "grouped_x")) {
|
||||
1
|
||||
} else if (flip) {
|
||||
1
|
||||
} else {
|
||||
-1
|
||||
}
|
||||
group_order <- if (group != "" || (group == "" && facet == "")) {
|
||||
group
|
||||
} else if (group == "" && facet != "") {
|
||||
facet
|
||||
}
|
||||
df <- reorder_by(df = df, x = x, y = y, group = group_order, order = order, dir_order = dir_order)
|
||||
|
||||
# Reorder
|
||||
dir_order = ifelse(flip, 1, -1)
|
||||
df <- reorder(df, x, y, group, order, dir_order)
|
||||
|
||||
# Prepare aes
|
||||
# prepare aes
|
||||
if(group != "") {
|
||||
|
||||
g <- ggplot2::ggplot(
|
||||
|
|
@ -170,7 +208,7 @@ if(group != "") {
|
|||
)
|
||||
}
|
||||
|
||||
# Add title, subtitle, caption, x_title, y_title
|
||||
# add title, subtitle, caption, x_title, y_title
|
||||
g <- g + ggplot2::labs(
|
||||
title = title,
|
||||
subtitle = subtitle,
|
||||
|
|
@ -181,14 +219,19 @@ g <- g + ggplot2::labs(
|
|||
fill = group_title
|
||||
)
|
||||
|
||||
# Width
|
||||
# width
|
||||
width <- width
|
||||
dodge_width <- width
|
||||
|
||||
#Facets
|
||||
# facets
|
||||
if (facet != "") {
|
||||
g <- g + ggforce::facet_row(facet, scales = "free_x", space = "free")
|
||||
if (flip) {
|
||||
g <- g + ggplot2::facet_grid(rows = ggplot2::vars(!!rlang::sym(facet)), scales = "free", space = "free_y")
|
||||
} else {
|
||||
g <- g + ggplot2::facet_grid(cols = ggplot2::vars(!!rlang::sym(facet)), scales = "free", space = "free_x")
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# Guides for legend
|
||||
# g <- g + ggplot2::guides(
|
||||
|
|
@ -206,7 +249,7 @@ if (facet != "") {
|
|||
# direction = "horizontal")
|
||||
# )
|
||||
|
||||
# Should the graph use position_fill?
|
||||
# should the graph use position_fill?
|
||||
if(group != "") {
|
||||
|
||||
if (position == "stack"){
|
||||
|
|
@ -260,35 +303,53 @@ if(group != "") {
|
|||
}
|
||||
}
|
||||
|
||||
# Wrap labels on the x scale?
|
||||
# wrap labels on the x scale?
|
||||
if (!is.null(wrap)) {
|
||||
g <- g + ggplot2::scale_x_discrete(labels = scales::label_wrap(wrap))
|
||||
}
|
||||
|
||||
|
||||
# Because a text legend should always be horizontal, especially for an horizontal bar graph
|
||||
# because a text legend should always be horizontal, especially for an horizontal bar graph
|
||||
if (flip) g <- g + ggplot2::coord_flip()
|
||||
# Add text to bars
|
||||
if (flip) hjust_flip <- -0.5 else hjust_flip <- 0.5
|
||||
if (flip) vjust_flip <- 0.5 else vjust_flip <- -0.5
|
||||
|
||||
# Function for interaction
|
||||
interaction_f <- function(group, facet, data) {
|
||||
if (group == "" && facet == "") {
|
||||
return(NULL)
|
||||
} else if (group != "" && facet != "") {
|
||||
return(interaction(data[[group]], data[[facet]]))
|
||||
} else if (group != "") {
|
||||
return(data[[group]])
|
||||
} else if (facet != "") {
|
||||
return(data[[facet]])
|
||||
} else {
|
||||
return(NULL)
|
||||
}
|
||||
}
|
||||
|
||||
# Add text labels
|
||||
|
||||
# add text labels
|
||||
if (add_text & position == "dodge") {
|
||||
|
||||
df <- dplyr::mutate(df, "y_threshold" := ifelse(!!rlang::sym(y) >= add_text_threshold_display, !!rlang::sym(y), NA ))
|
||||
|
||||
# Expand limits
|
||||
# expand limits
|
||||
g <- g + ggplot2::geom_blank(
|
||||
data = df,
|
||||
ggplot2::aes(x = !!rlang::sym(x), y = !!rlang::sym(y) * add_text_expand_limit, group = !!rlang::sym(group))
|
||||
ggplot2::aes(
|
||||
x = !!rlang::sym(x),
|
||||
y = !!rlang::sym(y) * add_text_expand_limit,
|
||||
group = interaction_f(group, facet, df)
|
||||
)
|
||||
)
|
||||
|
||||
g <- g + ggplot2::geom_text(
|
||||
data = df,
|
||||
ggplot2::aes(
|
||||
label = ifelse(is.na(!!rlang::sym("y_threshold")), NA, paste0(round(!!rlang::sym("y_threshold"), add_text_round), add_text_suffix)),
|
||||
group = !!rlang::sym(group)),
|
||||
group = interaction_f(group, facet, df)),
|
||||
hjust = hjust_flip,
|
||||
vjust = vjust_flip,
|
||||
color = add_text_color,
|
||||
|
|
@ -304,12 +365,16 @@ if (add_text & position == "dodge") {
|
|||
g <- g + ggplot2::geom_text(
|
||||
data = df,
|
||||
ggplot2::aes(
|
||||
label = ifelse(is.na(!!rlang::sym("y_threshold")), NA, paste0(round(!!rlang::sym("y_threshold"), add_text_round), add_text_suffix)),
|
||||
group = !!rlang::sym(group)),
|
||||
label = ifelse(is.na(!!rlang::sym("y_threshold")), NA,
|
||||
paste0(round(!!rlang::sym("y_threshold"), add_text_round), add_text_suffix)),
|
||||
group = interaction_f(group, facet, df)
|
||||
),
|
||||
hjust = hjust_flip,
|
||||
vjust = vjust_flip,
|
||||
color = add_text_color,
|
||||
fontface = add_text_font_face,
|
||||
size = add_text_size,
|
||||
position = ggplot2::position_stack(vjust = 0.5)
|
||||
position = ggplot2::position_dodge2(width = dodge_width)
|
||||
)
|
||||
|
||||
}
|
||||
|
|
@ -318,7 +383,7 @@ if (add_text & position == "dodge") {
|
|||
g <- g +
|
||||
ggplot2::scale_y_continuous(
|
||||
# start at 0
|
||||
expand = c(0, 0),
|
||||
expand = ggplot2::expansion(mult = c(0, y_expand)),
|
||||
# remove trailing 0 and choose accuracy of y labels
|
||||
labels = scales::label_number(
|
||||
accuracy = 0.1,
|
||||
|
|
@ -327,9 +392,16 @@ if (add_text & position == "dodge") {
|
|||
decimal.mark = "."),
|
||||
)
|
||||
|
||||
# Remove guides for legend if !add_color_guide
|
||||
if (!add_color_guide) g <- g + ggplot2::guides(fill = "none", color = "none")
|
||||
|
||||
# Add theme fun
|
||||
if (!is.null(theme_fun)) g <- g + theme_fun
|
||||
|
||||
return(g)
|
||||
# Add scale fun
|
||||
if (!is.null(scale_fill_fun)) g <- g + scale_fill_fun
|
||||
|
||||
if (!is.null(scale_color_fun)) g <- g + scale_color_fun
|
||||
|
||||
return(g)
|
||||
}
|
||||
|
||||
|
|
@ -25,8 +25,11 @@ color <- function(..., unname = TRUE) {
|
|||
# Defined colors
|
||||
colors <- c(
|
||||
white = "#FFFFFF"
|
||||
, lighter_grey = "#F5F5F5"
|
||||
, light_grey = "#E3E3E3"
|
||||
, dark_grey = "#464647"
|
||||
, light_blue_grey = "#B3C6D1"
|
||||
, grey = "#71716F"
|
||||
, black = "#000000"
|
||||
, cat_2_yellow_1 = "#ffc20a"
|
||||
, cat_2_yellow_2 = "#0c7bdc"
|
||||
|
|
@ -46,7 +49,7 @@ color <- function(..., unname = TRUE) {
|
|||
, seq_5_main_3 = "#6b8bad"
|
||||
, seq_5_main_4 = "#9cb1c9"
|
||||
, seq_5_main_5 = "#ced8e4"
|
||||
, cat_5_ibm_1 = "#648fff"
|
||||
, cat_5_ibm_1 = "#648fff"
|
||||
, cat_5_ibm_2 = "#785ef0"
|
||||
, cat_5_ibm_3 = "#dc267f"
|
||||
, cat_5_ibm_4 = "#fe6100"
|
||||
|
|
@ -96,7 +99,7 @@ color <- function(..., unname = TRUE) {
|
|||
|
||||
if (is.null(cols)) {
|
||||
cols_to_return <- colors
|
||||
} else {
|
||||
} else {
|
||||
cols_to_return <- colors[cols]
|
||||
}
|
||||
|
||||
|
|
|
|||
189
R/dumbbell.R
Normal file
189
R/dumbbell.R
Normal file
|
|
@ -0,0 +1,189 @@
|
|||
#' Make dumbbell chart.
|
||||
#'
|
||||
#' @param df A data frame.
|
||||
#' @param col A numeric column.
|
||||
#' @param group_x The grouping column on the x-axis; only two groups.
|
||||
#' @param group_y The grouping column on the y-axis.
|
||||
#' @param point_size Point size.
|
||||
#' @param point_alpha Point alpha.
|
||||
#' @param segment_size Segment size.
|
||||
#' @param segment_color Segment color.
|
||||
#' @param group_x_title X-group and legend title.
|
||||
#' @param group_y_title Y-axis and group title.
|
||||
#' @param x_title X-axis title.
|
||||
#' @param title Title.
|
||||
#' @param subtitle Subtitle.
|
||||
#' @param caption Caption.
|
||||
#' @param line_to_y_axis TRUE or FALSE; add a line connected points and Y-axis.
|
||||
#' @param line_to_y_axis_type Line to Y-axis type.
|
||||
#' @param line_to_y_axis_width Line to Y-axis width.
|
||||
#' @param line_to_y_axis_color Line to Y-axis color.
|
||||
#' @param add_text TRUE or FALSE; add text at the points.
|
||||
#' @param add_text_vjust Vertical adjustment.
|
||||
#' @param add_text_size Text size.
|
||||
#' @param add_text_color Text color.
|
||||
#' @param theme_fun A ggplot2 theme, default to `theme_dumbbell()`
|
||||
#' @param scale_fill_fun A ggplot2 scale_fill function, default to `scale_fill_visualizer_discrete()`
|
||||
#' @param scale_color_fun A ggplot2 scale_color function, default to `scale_color_visualizer_discrete()`
|
||||
#'
|
||||
#' @return A dumbbell chart.
|
||||
#' @export
|
||||
#'
|
||||
dumbbell <- function(df,
|
||||
col,
|
||||
group_x,
|
||||
group_y,
|
||||
point_size = 5,
|
||||
point_alpha = 1,
|
||||
segment_size = 2.5,
|
||||
segment_color = color("light_blue_grey"),
|
||||
group_x_title = NULL,
|
||||
group_y_title = NULL,
|
||||
x_title = NULL,
|
||||
title = NULL,
|
||||
subtitle = NULL,
|
||||
caption = NULL,
|
||||
line_to_y_axis = FALSE,
|
||||
line_to_y_axis_type = 3,
|
||||
line_to_y_axis_width = 0.5,
|
||||
line_to_y_axis_color = color("dark_grey"),
|
||||
add_text = FALSE,
|
||||
add_text_vjust = 2,
|
||||
add_text_size = 3.5,
|
||||
add_text_color = color("dark_grey"),
|
||||
theme_fun = theme_dumbbell(),
|
||||
scale_fill_fun = scale_fill_visualizer_discrete(),
|
||||
scale_color_fun = scale_color_visualizer_discrete()){
|
||||
|
||||
#------ Checks
|
||||
|
||||
# df is a data frame
|
||||
checkmate::assert_data_frame(df)
|
||||
|
||||
# col, group_x, group_y are character
|
||||
checkmate::assert_character(col, len = 1)
|
||||
checkmate::assert_character(group_x, len = 1)
|
||||
checkmate::assert_character(group_y, len = 1)
|
||||
|
||||
# col, group_x, group_y are columns in df
|
||||
checkmate::assert_choice(col, colnames(df))
|
||||
checkmate::assert_choice(group_x, colnames(df))
|
||||
checkmate::assert_choice(group_y, colnames(df))
|
||||
|
||||
# Check numeric/logical values
|
||||
checkmate::assert_numeric(point_size, len = 1)
|
||||
checkmate::assert_numeric(point_alpha, lower = 0, upper = 1, len = 1)
|
||||
checkmate::assert_numeric(segment_size, len = 1)
|
||||
checkmate::assert_logical(line_to_y_axis, len = 1)
|
||||
checkmate::assert_numeric(line_to_y_axis_type, len = 1)
|
||||
checkmate::assert_numeric(line_to_y_axis_width, len = 1)
|
||||
checkmate::assert_logical(add_text, len = 1)
|
||||
checkmate::assert_numeric(add_text_vjust, len = 1)
|
||||
checkmate::assert_numeric(add_text_size, len = 1)
|
||||
|
||||
# Get group keys
|
||||
group_x_keys <- df |>
|
||||
dplyr::group_by(!!rlang::sym(group_x)) |>
|
||||
dplyr::group_keys() |>
|
||||
dplyr::pull()
|
||||
|
||||
# Check if only two groups
|
||||
if (length(group_x_keys) > 2) rlang::abort("Cannot draw a dumbbell plot for `group_x` with more than 2 groups")
|
||||
|
||||
# Pivot long data
|
||||
df_pivot <- df |>
|
||||
tidyr::pivot_wider(
|
||||
id_cols = c(!!rlang::sym(group_y)),
|
||||
values_from = !!rlang::sym(col),
|
||||
names_from = !!rlang::sym(group_x)
|
||||
)
|
||||
|
||||
df_pivot <- df_pivot |>
|
||||
dplyr::rowwise() |>
|
||||
dplyr::mutate(
|
||||
min = min(!!rlang::sym(group_x_keys[[1]]), !!rlang::sym(group_x_keys[[2]]), na.rm = T),
|
||||
max = max(!!rlang::sym(group_x_keys[[1]]), !!rlang::sym(group_x_keys[[2]]), na.rm = T)) |>
|
||||
dplyr::ungroup() |>
|
||||
dplyr::mutate(diff = max - min)
|
||||
|
||||
g <- ggplot2::ggplot(df_pivot)
|
||||
|
||||
# Add line
|
||||
if(line_to_y_axis) {
|
||||
|
||||
xend <- min(dplyr::pull(df, !!rlang::sym(col)))
|
||||
|
||||
g <- g +
|
||||
ggplot2::geom_segment(
|
||||
ggplot2::aes(
|
||||
x = min,
|
||||
y = !!rlang::sym(group_y),
|
||||
yend = !!rlang::sym(group_y)),
|
||||
xend = xend,
|
||||
linetype = line_to_y_axis_type,
|
||||
linewidth = line_to_y_axis_width,
|
||||
color = line_to_y_axis_color)
|
||||
}
|
||||
|
||||
# Add segment
|
||||
g <- g +
|
||||
ggplot2::geom_segment(
|
||||
ggplot2::aes(
|
||||
x = !!rlang::sym(group_x_keys[[1]]),
|
||||
y = !!rlang::sym(group_y),
|
||||
xend = !!rlang::sym(group_x_keys[[2]]),
|
||||
yend = !!rlang::sym(group_y)),
|
||||
linewidth = segment_size,
|
||||
color = segment_color
|
||||
)
|
||||
|
||||
# Add points
|
||||
g <- g +
|
||||
ggplot2::geom_point(
|
||||
data = df,
|
||||
ggplot2::aes(
|
||||
x = !!rlang::sym(col),
|
||||
y = !!rlang::sym(group_y),
|
||||
color = !!rlang::sym(group_x),
|
||||
fill = !!rlang::sym(group_x)
|
||||
),
|
||||
size = point_size,
|
||||
alpha = point_alpha
|
||||
)
|
||||
|
||||
# Add title, subtitle, caption, x_title, y_title
|
||||
g <- g + ggplot2::labs(
|
||||
title = title,
|
||||
subtitle = subtitle,
|
||||
caption = caption,
|
||||
x = x_title,
|
||||
y = group_y_title,
|
||||
color = group_x_title,
|
||||
fill = group_x_title
|
||||
)
|
||||
|
||||
# Add stat labels to points
|
||||
if(add_text) g <- g +
|
||||
ggrepel::geom_text_repel(
|
||||
data = df,
|
||||
ggplot2::aes(
|
||||
x = !!rlang::sym(col),
|
||||
y = !!rlang::sym(group_y),
|
||||
label = !!rlang::sym(col)
|
||||
),
|
||||
vjust = add_text_vjust,
|
||||
size = add_text_size,
|
||||
color = add_text_color
|
||||
)
|
||||
|
||||
# Add theme
|
||||
g <- g + theme_fun
|
||||
|
||||
# Add scale fun
|
||||
if (!is.null(scale_fill_fun)) g <- g + scale_fill_fun
|
||||
|
||||
if (!is.null(scale_color_fun)) g <- g + scale_color_fun
|
||||
|
||||
return(g)
|
||||
|
||||
}
|
||||
217
R/point.R
217
R/point.R
|
|
@ -1,11 +1,18 @@
|
|||
#' @title Simple point chart
|
||||
#' @title Simple scatterplot
|
||||
#'
|
||||
#' @param df A data frame.
|
||||
#' @param x A numeric column.
|
||||
#' @param y Another numeric column.
|
||||
#' @param group Some grouping categorical column, e.g. administrative areas or population groups.
|
||||
#' @param add_color Add a color to bars (if no grouping).
|
||||
#' @param flip TRUE or FALSE. Default to TRUE or horizontal bar plot.
|
||||
#' @param x A quoted numeric column.
|
||||
#' @param y A quoted numeric column.
|
||||
#' @param group Some quoted grouping categorical column, e.g. administrative areas or population groups.
|
||||
#' @param facet Some quoted grouping categorical column.
|
||||
#' @param facet_scales Character. Either "free" (default) or "fixed" for facet scales.
|
||||
#' @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 facet_rm_na Remove NAs in facet?
|
||||
#' @param add_color Add a color to points (if no grouping).
|
||||
#' @param add_color_guide Should a legend be added?
|
||||
#' @param flip TRUE or FALSE.
|
||||
#' @param alpha Fill transparency.
|
||||
#' @param size Point size.
|
||||
#' @param x_title The x scale title. Default to NULL.
|
||||
|
|
@ -14,77 +21,167 @@
|
|||
#' @param title Plot title. Default to NULL.
|
||||
#' @param subtitle Plot subtitle. Default to NULL.
|
||||
#' @param caption Plot caption. Default to NULL.
|
||||
#' @param theme_fun Whatever theme. Default to theme_reach(). NULL if no theming needed.
|
||||
#' @param scale_impact Use the package custom scales for fill and color.
|
||||
#' @param theme_fun Whatever theme. Default to theme_point(). NULL if no theming needed.
|
||||
#'
|
||||
#' @inheritParams scale_color_impact_discrete
|
||||
#' @inheritParams scale_color_visualizer_discrete
|
||||
#'
|
||||
#' @export
|
||||
point <- function(df, x, y, group = "", add_color = color("branding_reach_red"), flip = TRUE, alpha = 1, size = 2, x_title = NULL, y_title = NULL, group_title = NULL, title = NULL, subtitle = NULL, caption = NULL, theme_fun = theme_reach(grid_major_y = TRUE), palette = "cat_5_ibm", scale_impact = TRUE, direction = 1, reverse_guide = TRUE) {
|
||||
# # Check if numeric and character
|
||||
if (!any(c("numeric", "integer") %in% class(df[[x]]))) rlang::abort(paste0(x, " must be numeric."))
|
||||
if (!any(c("numeric", "integer") %in% class(df[[y]]))) rlang::abort(paste0(x, " must be numeric."))
|
||||
point <- function(
|
||||
df,
|
||||
x,
|
||||
y,
|
||||
group = "",
|
||||
facet = "",
|
||||
facet_scales = "free",
|
||||
x_rm_na = TRUE,
|
||||
y_rm_na = TRUE,
|
||||
group_rm_na = TRUE,
|
||||
facet_rm_na = TRUE,
|
||||
add_color = color("cat_5_main_1"),
|
||||
add_color_guide = TRUE,
|
||||
flip = TRUE,
|
||||
alpha = 1,
|
||||
size = 2,
|
||||
x_title = NULL,
|
||||
y_title = NULL,
|
||||
group_title = NULL,
|
||||
title = NULL,
|
||||
subtitle = NULL,
|
||||
caption = NULL,
|
||||
theme_fun = theme_point(),
|
||||
scale_fill_fun = scale_fill_visualizer_discrete(),
|
||||
scale_color_fun = scale_color_visualizer_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)
|
||||
checkmate::assert_logical(facet_rm_na, len = 1)
|
||||
|
||||
# Mapping
|
||||
# facet_scales is a character scalar in c("free", "fixed")
|
||||
checkmate::assert_choice(facet_scales, c("free", "fixed"))
|
||||
|
||||
# flip is a logical scalar
|
||||
checkmate::assert_logical(flip, len = 1)
|
||||
|
||||
# alpha is a numeric scalar between 0 and 1
|
||||
checkmate::assert_numeric(alpha, lower = 0, upper = 1, len = 1)
|
||||
|
||||
# size is a numeric scalar
|
||||
checkmate::assert_numeric(size, len = 1)
|
||||
|
||||
# x and y are numeric
|
||||
if (!any(c("numeric", "integer") %in% class(df[[x]]))) rlang::abort(paste0(x, " must be numeric."))
|
||||
if (!any(c("numeric", "integer") %in% class(df[[y]]))) rlang::abort(paste0(y, " must be numeric."))
|
||||
|
||||
|
||||
#----- Data wrangling
|
||||
|
||||
# facets over group
|
||||
if (group != "" && facet != "" && group == facet) {
|
||||
rlang::warn("'group' and 'facet' are the same identical.")
|
||||
}
|
||||
|
||||
# remove NAs using base R
|
||||
if (x_rm_na) df <- df[!(is.na(df[[x]])),]
|
||||
if (y_rm_na) df <- df[!(is.na(df[[y]])),]
|
||||
if (group != "" && group_rm_na) df <- df[!(is.na(df[[group]])),]
|
||||
if (facet != "" && facet_rm_na) df <- df[!(is.na(df[[facet]])),]
|
||||
|
||||
# prepare aes
|
||||
if (group != "") {
|
||||
g <- ggplot2::ggplot(
|
||||
df,
|
||||
mapping = ggplot2::aes(
|
||||
x = !!rlang::sym(x),
|
||||
y = !!rlang::sym(y),
|
||||
fill = !!rlang::sym(group),
|
||||
color = !!rlang::sym(group)
|
||||
g <- ggplot2::ggplot(
|
||||
df,
|
||||
mapping = ggplot2::aes(
|
||||
x = !!rlang::sym(x),
|
||||
y = !!rlang::sym(y),
|
||||
fill = !!rlang::sym(group),
|
||||
color = !!rlang::sym(group)
|
||||
)
|
||||
)
|
||||
} else {
|
||||
g <- ggplot2::ggplot(
|
||||
df,
|
||||
mapping = ggplot2::aes(
|
||||
x = !!rlang::sym(x),
|
||||
y = !!rlang::sym(y)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
# add title, subtitle, caption, x_title, y_title
|
||||
g <- g + ggplot2::labs(
|
||||
title = title,
|
||||
subtitle = subtitle,
|
||||
caption = caption,
|
||||
x = x_title,
|
||||
y = y_title,
|
||||
color = group_title,
|
||||
fill = group_title
|
||||
)
|
||||
|
||||
# facets
|
||||
# facets
|
||||
if (facet != "") {
|
||||
if (flip) {
|
||||
g <- g + ggplot2::facet_grid(
|
||||
rows = ggplot2::vars(!!rlang::sym(facet)),
|
||||
scales = facet_scales,
|
||||
space = if(facet_scales == "free") "free_y" else "fixed"
|
||||
)
|
||||
} else {
|
||||
g <- ggplot2::ggplot(
|
||||
df,
|
||||
mapping = ggplot2::aes(
|
||||
x = !!rlang::sym(x),
|
||||
y = !!rlang::sym(y)
|
||||
)
|
||||
g <- g + ggplot2::facet_grid(
|
||||
cols = ggplot2::vars(!!rlang::sym(facet)),
|
||||
scales = facet_scales,
|
||||
space = if(facet_scales == "free") "free_x" else "fixed"
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
# Add title, subtitle, caption, x_title, y_title
|
||||
g <- g + ggplot2::labs(
|
||||
title = title,
|
||||
subtitle = subtitle,
|
||||
caption = caption,
|
||||
x = x_title,
|
||||
y = y_title,
|
||||
color = group_title,
|
||||
fill = group_title
|
||||
)
|
||||
|
||||
}
|
||||
|
||||
# Should the graph use position_fill?
|
||||
if (group != "") {
|
||||
g <- g + ggplot2::geom_point(
|
||||
alpha = alpha,
|
||||
size = size
|
||||
)
|
||||
g <- g + ggplot2::geom_point(
|
||||
alpha = alpha,
|
||||
size = size
|
||||
)
|
||||
} else {
|
||||
g <- g + ggplot2::geom_point(
|
||||
alpha = alpha,
|
||||
size = size,
|
||||
color = add_color
|
||||
)
|
||||
g <- g + ggplot2::geom_point(
|
||||
alpha = alpha,
|
||||
size = size,
|
||||
color = add_color
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
if (flip) {
|
||||
g <- g + ggplot2::coord_flip()
|
||||
g <- g + ggplot2::coord_flip()
|
||||
}
|
||||
|
||||
# Add theme
|
||||
g <- g + theme_fun
|
||||
|
||||
|
||||
|
||||
# Remove guides for legend if !add_color_guide
|
||||
if (!add_color_guide) g <- g + ggplot2::guides(fill = "none", color = "none")
|
||||
|
||||
# Add theme
|
||||
if (!is.null(theme_fun)) g <- g + theme_fun
|
||||
|
||||
# Add scale
|
||||
if (scale_impact) g <- g + scale_fill_impact_discrete(palette, direction, reverse_guide) + scale_color_impact_discrete(palette, direction, reverse_guide)
|
||||
|
||||
|
||||
# Add scale fun
|
||||
if (!is.null(scale_fill_fun)) g <- g + scale_fill_fun
|
||||
|
||||
if (!is.null(scale_color_fun)) g <- g + scale_color_fun
|
||||
|
||||
return(g)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,6 +1,5 @@
|
|||
|
||||
#' Reorder a Data Frame Factoring Column x
|
||||
#'
|
||||
#' Reorder a Data Frame
|
||||
#'
|
||||
#' @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.
|
||||
|
|
@ -22,21 +21,16 @@
|
|||
#' @examples
|
||||
#' # Example usage
|
||||
#' df <- data.frame(col1 = c("b", "a", "c"), col2 = c(10, 25, 3))
|
||||
#' reorder(df, "col1", "col2")
|
||||
#' reorder_by(df, "col1", "col2")
|
||||
#'
|
||||
#' @export
|
||||
reorder <- function(df, x, y, group = "", order = "y", dir_order = 1){
|
||||
reorder_by <- 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)
|
||||
|
|
@ -53,52 +47,44 @@ reorder <- function(df, x, y, group = "", order = "y", dir_order = 1){
|
|||
# dir_order is 1 or -1 (numeric scalar)
|
||||
checkmate::assert_subset(dir_order, c(1, -1))
|
||||
|
||||
|
||||
#------ Reorder
|
||||
#------ Reorder
|
||||
|
||||
# droplevels first
|
||||
if (is.factor(df[[x]])) {
|
||||
df[, (x) := droplevels(get(x))]
|
||||
df[[x]] <- droplevels(df[[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))]
|
||||
|
||||
# Order by values of y
|
||||
df <- df[order(df[[y]] * dir_order), ]
|
||||
df[[x]] <- forcats::fct_inorder(df[[x]])
|
||||
} else if (order == "grouped_y" && group != "") {
|
||||
|
||||
data.table::setorderv(df, c(group, y), order = dir_order)
|
||||
df[, (x) := forcats::fct_inorder(get(x))]
|
||||
|
||||
# Order by group first, then by values of y
|
||||
df <- df[order(df[[group]], df[[y]] * dir_order), ]
|
||||
df[[x]] <- forcats::fct_inorder(df[[x]])
|
||||
} else if (order == "grouped_y" && group == "") {
|
||||
# Fallback to ordering by y if group is empty
|
||||
rlang::warn("Group is empty. Ordering by y only.")
|
||||
df <- df[order(df[[y]] * dir_order), ]
|
||||
df[[x]] <- forcats::fct_inorder(df[[x]])
|
||||
} else if (order == "x") {
|
||||
|
||||
data.table::setorderv(df, x, order = dir_order)
|
||||
df[, (x) := forcats::fct_inorder(get(x))]
|
||||
|
||||
# Order alphabetically by x
|
||||
df <- df[order(df[[x]] * dir_order), ]
|
||||
df[[x]] <- forcats::fct_inorder(df[[x]])
|
||||
} else if (order == "grouped_x" && group != "") {
|
||||
|
||||
data.table::setorderv(df, c(group, x), order = dir_order)
|
||||
df[, (x) := forcats::fct_inorder(get(x))]
|
||||
|
||||
# Order by group first, then alphabetically by x
|
||||
df <- df[order(df[[group]], df[[x]] * dir_order), ]
|
||||
df[[x]] <- forcats::fct_inorder(df[[x]])
|
||||
} else if (order == "grouped_x" && group == "") {
|
||||
|
||||
# Fallback to ordering by x if group is empty
|
||||
rlang::warn("Group is empty. Ordering by x only.")
|
||||
|
||||
data.table::setorderv(df, x, order = dir_order)
|
||||
df[, (x) := forcats::fct_inorder(get(x))]
|
||||
|
||||
df <- df[order(df[[x]] * dir_order), ]
|
||||
df[[x]] <- forcats::fct_inorder(df[[x]])
|
||||
}
|
||||
|
||||
return(df)
|
||||
# Reset row names
|
||||
rownames(df) <- NULL
|
||||
|
||||
return(df)
|
||||
}
|
||||
|
||||
32
R/scale.R
32
R/scale.R
|
|
@ -1,35 +1,3 @@
|
|||
|
||||
#' One scale for all
|
||||
#'
|
||||
#' This function is based on [palette()]. If palette is NULL, the used palette will be magma from gpplot2's viridis scale constructors.
|
||||
#'
|
||||
#' @inheritParams palette_gen
|
||||
#'
|
||||
#' @param reverse_guide Boolean indicating whether the guide should be reversed.
|
||||
#' @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, title_position = NULL, ...) {
|
||||
|
||||
s <- scale_color_visualizer_discrete(palette, direction, reverse_guide, ...) +
|
||||
scale_fill_visualizer_discrete(palette, direction, reverse_guide, ...)
|
||||
|
||||
return(s)
|
||||
|
||||
}
|
||||
|
||||
#' @rdname scale_visualizer_dicscrete
|
||||
#'
|
||||
#' @export
|
||||
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, ...)
|
||||
|
||||
return(s)
|
||||
|
||||
}
|
||||
|
||||
#' Scale constructors for fill and colors
|
||||
#'
|
||||
#' This function is based on [palette()]. If palette is NULL, the used palette will be magma from gpplot2's viridis scale constructors.
|
||||
|
|
|
|||
|
|
@ -1,59 +1,86 @@
|
|||
#' Custom Theme for Bar Charts
|
||||
#'
|
||||
#' @return A custom theme object.
|
||||
#'
|
||||
#'
|
||||
#' @rdname theme_default
|
||||
#'
|
||||
#' @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_text_font_face <- "plain"
|
||||
par_axis_x <- TRUE
|
||||
par_axis_y <- TRUE
|
||||
par_axis_line_y <- FALSE
|
||||
par_axis_ticks_y <- FALSE
|
||||
par_axis_ticks_y <- TRUE
|
||||
par_axis_text_y <- TRUE
|
||||
par_axis_line_x <- TRUE
|
||||
par_axis_ticks_x <- TRUE
|
||||
par_axis_text_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_text_font_face <- "plain"
|
||||
par_axis_x <- TRUE
|
||||
par_axis_y <- TRUE
|
||||
par_axis_line_y <- TRUE
|
||||
par_axis_ticks_y <- TRUE
|
||||
par_axis_text_y <- TRUE
|
||||
par_axis_line_x <- FALSE
|
||||
par_axis_ticks_x <- FALSE
|
||||
par_axis_ticks_x <- TRUE
|
||||
par_axis_text_x <- TRUE
|
||||
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_text_font_face <- "bold"
|
||||
par_axis_x <- TRUE
|
||||
par_axis_y <- TRUE
|
||||
par_axis_line_y <- FALSE
|
||||
par_axis_ticks_y <- FALSE
|
||||
par_axis_line_x <- TRUE
|
||||
par_axis_text_y <- FALSE
|
||||
par_axis_line_x <- FALSE
|
||||
par_axis_ticks_x <- TRUE
|
||||
par_axis_text_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_text_font_face <- "bold"
|
||||
par_axis_x <- TRUE
|
||||
par_axis_y <- TRUE
|
||||
par_axis_line_y <- FALSE
|
||||
par_axis_ticks_y <- TRUE
|
||||
par_axis_text_y <- TRUE
|
||||
par_axis_line_x <- FALSE
|
||||
par_axis_ticks_x <- FALSE
|
||||
par_axis_text_x <- FALSE
|
||||
par_grid_major_y <- FALSE
|
||||
par_grid_major_x <- 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
|
||||
axis_text_font_face = par_axis_text_font_face
|
||||
, axis_x = par_axis_x
|
||||
, axis_y = par_axis_y
|
||||
, grid_major_y = par_grid_major_y
|
||||
, grid_major_x = par_grid_major_x
|
||||
, grid_minor_y = par_grid_minor_y
|
||||
, grid_minor_x = par_grid_minor_x
|
||||
, axis_text_y = par_axis_text_y
|
||||
, axis_line_y = par_axis_line_y
|
||||
, axis_ticks_y = par_axis_ticks_y
|
||||
, axis_text_x = par_axis_text_x
|
||||
, axis_line_x = par_axis_line_x
|
||||
, axis_ticks_x = par_axis_ticks_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
|
||||
|
|
|
|||
|
|
@ -86,15 +86,16 @@ theme_default <- function(
|
|||
legend_title_size = 13,
|
||||
legend_title_color = color("dark_grey"),
|
||||
legend_title_font_face = "plain",
|
||||
legend_title_font_family = "Carlito",
|
||||
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"),
|
||||
legend_text_font_family = "Carlito",
|
||||
facet_size = 14,
|
||||
facet_color = color("dark_grey"),
|
||||
facet_font_face = "bold",
|
||||
facet_font_family = "Carlito",
|
||||
facet_bg_color = color("lighter_grey"),
|
||||
axis_x = TRUE,
|
||||
axis_y = TRUE,
|
||||
axis_text_x = TRUE,
|
||||
|
|
@ -182,20 +183,18 @@ theme_default <- function(
|
|||
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
|
||||
# # ),
|
||||
legend.title = ggplot2::element_text(
|
||||
size = legend_title_size,
|
||||
face = legend_title_font_face,
|
||||
family = legend_title_font_family,
|
||||
color = legend_title_color
|
||||
),
|
||||
legend.text = ggplot2::element_text(
|
||||
size = legend_text_size,
|
||||
face = legend_text_font_face,
|
||||
family = legend_text_font_family,
|
||||
color = legend_text_color
|
||||
),
|
||||
axis.text.x = ggplot2::element_text(
|
||||
angle = axis_text_x_angle,
|
||||
vjust = axis_text_x_vjust,
|
||||
|
|
@ -365,13 +364,13 @@ theme_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
|
||||
size = facet_size,
|
||||
family = facet_font_family,
|
||||
face = facet_font_face,
|
||||
color = facet_color
|
||||
),
|
||||
strip.background = ggplot2::element_rect(
|
||||
fill = facet_background_color,
|
||||
fill = facet_bg_color,
|
||||
linewidth = 0
|
||||
)
|
||||
)
|
||||
13
R/theme_dumbbell.R
Normal file
13
R/theme_dumbbell.R
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
#' @title Dumbbell Theme
|
||||
|
||||
#' @description Theme for dumbbell charts based on theme_default.
|
||||
#'
|
||||
#' @rdname theme_default
|
||||
#'
|
||||
#' @export
|
||||
theme_dumbbell <- function() {
|
||||
theme_default(
|
||||
axis_line_x = TRUE,
|
||||
grid_)
|
||||
}
|
||||
|
||||
32
R/theme_point.R
Normal file
32
R/theme_point.R
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
#' Custom Theme for Point Charts
|
||||
#'
|
||||
#' @param flip Logical. Whether the plot is flipped (horizonal).
|
||||
#' @param axis_text_x_angle Angle for x-axis text.
|
||||
#' @param axis_text_x_vjust Vertical justification for x-axis text.
|
||||
#' @param axis_text_x_hjust Horizontal justification for x-axis text.
|
||||
#'
|
||||
#' @rdname theme_default
|
||||
#'
|
||||
#' @return A custom theme object.
|
||||
#'
|
||||
#' @export
|
||||
theme_point <- function(
|
||||
) {
|
||||
t <- theme_default(
|
||||
axis_text_font_face = "plain",
|
||||
axis_x = TRUE,
|
||||
axis_y = TRUE,
|
||||
grid_major_y = TRUE,
|
||||
grid_major_x = TRUE,
|
||||
grid_minor_y = FALSE,
|
||||
grid_minor_x = FALSE,
|
||||
axis_text_x = TRUE,
|
||||
axis_line_x = TRUE,
|
||||
axis_ticks_x = TRUE,
|
||||
axis_text_x_angle = 0,
|
||||
axis_text_x_vjust = 0.5,
|
||||
axis_text_x_hjust = 0
|
||||
)
|
||||
|
||||
return(t)
|
||||
}
|
||||
|
|
@ -1,49 +0,0 @@
|
|||
#' 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)
|
||||
}
|
||||
6
R/visualizeR-package.R
Normal file
6
R/visualizeR-package.R
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
#' @keywords internal
|
||||
"_PACKAGE"
|
||||
|
||||
## usethis namespace: start
|
||||
## usethis namespace: end
|
||||
NULL
|
||||
Loading…
Add table
Add a link
Reference in a new issue