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

Air formatting

Browse source
This commit is contained in:
gnoblet 2025-07-01 19:49:47 +02:00
parent a4f398ab3d
commit ead630c106
13 changed files with 816 additions and 640 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

398
R/bar.R
View file

@ -3,7 +3,12 @@
#' @inheritParams bar #' @inheritParams bar
#' #'
#' @export #' @export
hbar <- function(..., flip = TRUE, add_text = FALSE, theme_fun = theme_bar(flip = flip, add_text = add_text)) { 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, ...) bar(flip = flip, add_text = add_text, theme_fun = theme_fun, ...)
} }
@ -92,101 +97,125 @@ bar <- function(
), ),
scale_fill_fun = scale_fill_visualizer_discrete(), scale_fill_fun = scale_fill_visualizer_discrete(),
scale_color_fun = scale_color_visualizer_discrete() scale_color_fun = scale_color_visualizer_discrete()
){ ) {
#------ Checks
# df is a data frame
checkmate::assert_data_frame(df)
#------ Checks # 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)
# df is a data frame # x and y are columns in df
checkmate::assert_data_frame(df) checkmate::assert_choice(x, colnames(df))
checkmate::assert_choice(y, colnames(df))
if (group != "") {
checkmate::assert_choice(group, colnames(df))
}
# x and y and group are character # x_rm_na, y_rm_na and group_rm_na are logical scalar
checkmate::assert_character(x, len = 1) checkmate::assert_logical(x_rm_na, len = 1)
checkmate::assert_character(y, len = 1) checkmate::assert_logical(y_rm_na, len = 1)
checkmate::assert_character(group, len = 1) checkmate::assert_logical(group_rm_na, len = 1)
checkmate::assert_logical(facet_rm_na, len = 1)
# x and y are columns in df # flip is a logical scalar
checkmate::assert_choice(x, colnames(df)) checkmate::assert_logical(flip, len = 1)
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 # wrap is a numeric scalar or NULL
checkmate::assert_logical(x_rm_na, len = 1) if (!is.null(wrap)) {
checkmate::assert_logical(y_rm_na, len = 1) checkmate::assert_numeric(wrap, len = 1, null.ok = TRUE)
checkmate::assert_logical(group_rm_na, len = 1) }
checkmate::assert_logical(facet_rm_na, len = 1)
# flip is a logical scalar # alpha is a numeric scalar between 0 and 1
checkmate::assert_logical(flip, len = 1) checkmate::assert_numeric(alpha, lower = 0, upper = 1, len = 1)
# wrap is a numeric scalar or NULL # add_text is a logical scalar
if (!is.null(wrap)) checkmate::assert_numeric(wrap, len = 1, null.ok = TRUE) checkmate::assert_logical(add_text, len = 1)
# alpha is a numeric scalar between 0 and 1 # add_text_size is a numeric scalar
checkmate::assert_numeric(alpha, lower = 0, upper = 1, len = 1) checkmate::assert_numeric(add_text_size, len = 1)
# add_text is a logical scalar # add_text_font_face is a character scalar in bold plain or italic
checkmate::assert_logical(add_text, len = 1) checkmate::assert_choice(add_text_font_face, c("bold", "plain", "italic"))
# add_text_size is a numeric scalar # add_text_threshold_display is a numeric scalar
checkmate::assert_numeric(add_text_size, len = 1) checkmate::assert_numeric(add_text_threshold_display, len = 1)
# add_text_font_face is a character scalar in bold plain or italic # add_text_suffix is a character scalar
checkmate::assert_choice(add_text_font_face, c("bold", "plain", "italic")) checkmate::assert_character(add_text_suffix, len = 1)
# add_text_threshold_display is a numeric scalar # add_text_expand_limit is a numeric scalar
checkmate::assert_numeric(add_text_threshold_display, len = 1) checkmate::assert_numeric(add_text_expand_limit, len = 1)
# add_text_suffix is a character scalar # add_text_round is a numeric scalar
checkmate::assert_character(add_text_suffix, len = 1) checkmate::assert_numeric(add_text_round, len = 1)
# add_text_expand_limit is a numeric scalar # x and y are numeric or character
checkmate::assert_numeric(add_text_expand_limit, len = 1) 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"))
}
# add_text_round is a numeric scalar # width is a numeric scalar between 0 and 1
checkmate::assert_numeric(add_text_round, len = 1) checkmate::assert_numeric(width, lower = 0, upper = 1, len = 1)
# x and y are numeric or character # Check if position is stack or dodge
if (class(df[[y]]) %notin% c("integer", "numeric")) rlang::abort(paste0(y, " must be numeric.")) if (position %notin% c("stack", "dodge")) {
if (!any(class(df[[x]]) %in% c("character", "factor"))) rlang::abort(paste0(x, " must be character or factor")) rlang::abort("Position should be either 'stack' or 'dodge'.")
}
# Check if position is stack or dodge #----- Data wrangling
if (position %notin% c("stack", "dodge")) rlang::abort("Position should be either 'stack' or 'dodge'.")
#----- Data wrangling # facets over group
if (group != "" && facet != "" && group == facet) {
# facets over group
if (group != "" && facet != "" && group == facet) {
rlang::warn("'group' and 'facet' are the same identical.") rlang::warn("'group' and 'facet' are the same identical.")
} }
# remove NAs using base R # remove NAs using base R
if (x_rm_na) df <- df[!(is.na(df[[x]])),] if (x_rm_na) {
if (y_rm_na) df <- df[!(is.na(df[[y]])),] df <- df[!(is.na(df[[x]])), ]
if (group != "" && group_rm_na) df <- df[!(is.na(df[[group]])),] }
if (facet != "" && facet_rm_na) df <- df[!(is.na(df[[facet]])),] 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]])), ]
}
# reorder
# reorder dir_order <- if (flip && order %in% c("x", "grouped_x")) {
dir_order <- if(flip && order %in% c("x", "grouped_x")) {
-1 -1
} else if (!flip && order %in% c("x", "grouped_x")) { } else if (!flip && order %in% c("x", "grouped_x")) {
1 1
} else if (flip) { } else if (flip) {
1 1
} else { } else {
-1 -1
} }
group_order <- if (group != "" || (group == "" && facet == "")) { group_order <- if (group != "" || (group == "" && facet == "")) {
group group
} else if (group == "" && facet != "") { } else if (group == "" && facet != "") {
facet facet
} }
df <- reorder_by(df = df, x = x, y = y, group = group_order, order = order, dir_order = dir_order) df <- reorder_by(
df = df,
# prepare aes x = x,
if(group != "") { y = y,
group = group_order,
order = order,
dir_order = dir_order
)
# prepare aes
if (group != "") {
g <- ggplot2::ggplot( g <- ggplot2::ggplot(
df, df,
mapping = ggplot2::aes( mapping = ggplot2::aes(
@ -196,9 +225,7 @@ if(group != "") {
color = !!rlang::sym(group) color = !!rlang::sym(group)
) )
) )
} else {
} else {
g <- ggplot2::ggplot( g <- ggplot2::ggplot(
df, df,
mapping = ggplot2::aes( mapping = ggplot2::aes(
@ -206,10 +233,11 @@ if(group != "") {
y = !!rlang::sym(y) y = !!rlang::sym(y)
) )
) )
} }
# add title, subtitle, caption, x_title, y_title # add title, subtitle, caption, x_title, y_title
g <- g + ggplot2::labs( g <- g +
ggplot2::labs(
title = title, title = title,
subtitle = subtitle, subtitle = subtitle,
caption = caption, caption = caption,
@ -217,106 +245,113 @@ g <- g + ggplot2::labs(
y = x_title, y = x_title,
color = group_title, color = group_title,
fill = group_title fill = group_title
) )
# width # width
width <- width width <- width
dodge_width <- width dodge_width <- width
# facets # facets
if (facet != "") { if (facet != "") {
if (flip) { if (flip) {
g <- g + ggplot2::facet_grid(rows = ggplot2::vars(!!rlang::sym(facet)), scales = "free", space = "free_y") g <- g +
ggplot2::facet_grid(
rows = ggplot2::vars(!!rlang::sym(facet)),
scales = "free",
space = "free_y"
)
} else { } else {
g <- g + ggplot2::facet_grid(cols = ggplot2::vars(!!rlang::sym(facet)), scales = "free", space = "free_x") g <- g +
ggplot2::facet_grid(
cols = ggplot2::vars(!!rlang::sym(facet)),
scales = "free",
space = "free_x"
)
}
} }
}
# should the graph use position_fill?
# Guides for legend if (group != "") {
# g <- g + ggplot2::guides( if (position == "stack") {
# fill = ggplot2::guide_legend( g <- g +
# title.position = "left", ggplot2::geom_col(
# 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 != "") {
if (position == "stack"){
g <- g + ggplot2::geom_col(
alpha = alpha, alpha = alpha,
width = width, width = width,
position = ggplot2::position_stack() position = ggplot2::position_stack()
) )
} else if (position == "dodge"){ } else if (position == "dodge") {
g <- g + ggplot2::geom_col( g <- g +
ggplot2::geom_col(
alpha = alpha, alpha = alpha,
width = width, width = width,
position = ggplot2::position_dodge2( position = ggplot2::position_dodge2(
width = dodge_width, width = dodge_width,
preserve = "single") preserve = "single"
) )
} else{ )
g <- g + ggplot2::geom_col( } else {
g <- g +
ggplot2::geom_col(
alpha = alpha, alpha = alpha,
width = width width = width
) )
} }
} else {
} else { if (position == "stack") {
g <- g +
if (position == "stack"){ ggplot2::geom_col(
g <- g + ggplot2::geom_col(
alpha = alpha, alpha = alpha,
width = width, width = width,
position = ggplot2::position_stack(), position = ggplot2::position_stack(),
fill = add_color, fill = add_color,
color = add_color color = add_color
) )
} else if (position == "dodge"){ } else if (position == "dodge") {
g <- g + ggplot2::geom_col( g <- g +
ggplot2::geom_col(
alpha = alpha, alpha = alpha,
width = width, width = width,
position = ggplot2::position_dodge2( position = ggplot2::position_dodge2(
width = dodge_width, width = dodge_width,
preserve = "single"), preserve = "single"
),
fill = add_color, fill = add_color,
color = add_color color = add_color
) )
} else { } else {
g <- g + ggplot2::geom_col( g <- g +
ggplot2::geom_col(
alpha = alpha, alpha = alpha,
width = width, width = width,
fill = add_color, fill = add_color,
color = add_color color = add_color
) )
} }
} }
# wrap labels on the x scale? # wrap labels on the x scale?
if (!is.null(wrap)) { if (!is.null(wrap)) {
g <- g + ggplot2::scale_x_discrete(labels = scales::label_wrap(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
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
}
# because a text legend should always be horizontal, especially for an horizontal bar graph # function for interaction
if (flip) g <- g + ggplot2::coord_flip() interaction_f <- function(group, facet, data) {
# 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 == "") { if (group == "" && facet == "") {
return(NULL) return(NULL)
} else if (group != "" && facet != "") { } else if (group != "" && facet != "") {
@ -328,16 +363,22 @@ interaction_f <- function(group, facet, data) {
} else { } else {
return(NULL) return(NULL)
} }
} }
# add text labels
# add text labels if (add_text & position == "dodge") {
if (add_text & position == "dodge") { df <- dplyr::mutate(
df,
df <- dplyr::mutate(df, "y_threshold" := ifelse(!!rlang::sym(y) >= add_text_threshold_display, !!rlang::sym(y), NA )) "y_threshold" := ifelse(
!!rlang::sym(y) >= add_text_threshold_display,
!!rlang::sym(y),
NA
)
)
# expand limits # expand limits
g <- g + ggplot2::geom_blank( g <- g +
ggplot2::geom_blank(
data = df, data = df,
ggplot2::aes( ggplot2::aes(
x = !!rlang::sym(x), x = !!rlang::sym(x),
@ -345,28 +386,18 @@ if (add_text & position == "dodge") {
group = interaction_f(group, facet, df) group = interaction_f(group, facet, df)
) )
) )
g <- g + ggplot2::geom_text( g <- g +
ggplot2::geom_text(
data = df, data = df,
ggplot2::aes( ggplot2::aes(
label = ifelse(is.na(!!rlang::sym("y_threshold")), NA, paste0(round(!!rlang::sym("y_threshold"), add_text_round), add_text_suffix)), label = ifelse(
group = interaction_f(group, facet, df)), is.na(!!rlang::sym("y_threshold")),
hjust = hjust_flip, NA,
vjust = vjust_flip, paste0(
color = add_text_color, round(!!rlang::sym("y_threshold"), add_text_round),
fontface = add_text_font_face, add_text_suffix
size = add_text_size,
position = ggplot2::position_dodge2(width = dodge_width)
) )
),
} else if (add_text & position == "stack") {
df <- dplyr::mutate(df, "y_threshold" := ifelse(!!rlang::sym(y) >= add_text_threshold_display, !!rlang::sym(y), NA ))
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 = interaction_f(group, facet, df) group = interaction_f(group, facet, df)
), ),
hjust = hjust_flip, hjust = hjust_flip,
@ -376,7 +407,37 @@ if (add_text & position == "dodge") {
size = add_text_size, size = add_text_size,
position = ggplot2::position_dodge2(width = dodge_width) position = ggplot2::position_dodge2(width = dodge_width)
) )
} else if (add_text & position == "stack") {
df <- dplyr::mutate(
df,
"y_threshold" := ifelse(
!!rlang::sym(y) >= add_text_threshold_display,
!!rlang::sym(y),
NA
)
)
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 = 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_dodge2(width = dodge_width)
)
} }
# y scale tweaks # y scale tweaks
@ -389,19 +450,28 @@ if (add_text & position == "dodge") {
accuracy = 0.1, accuracy = 0.1,
drop0trailing = TRUE, drop0trailing = TRUE,
big.mark = "", big.mark = "",
decimal.mark = "."), decimal.mark = "."
),
) )
# Remove guides for legend if !add_color_guide # # remove guides for legend if !add_color_guide
if (!add_color_guide) g <- g + ggplot2::guides(fill = "none", color = "none") if (!add_color_guide) {
g <- g + ggplot2::guides(fill = "none", color = "none")
}
# Add theme fun # # add theme fun
if (!is.null(theme_fun)) g <- g + theme_fun if (!is.null(theme_fun)) {
g <- g + theme_fun
}
# Add scale fun # # # add scale fun
if (!is.null(scale_fill_fun)) g <- g + scale_fill_fun if (!is.null(scale_fill_fun)) {
g <- g + scale_fill_fun
}
if (!is.null(scale_color_fun)) g <- g + scale_color_fun if (!is.null(scale_color_fun)) {
g <- g + scale_color_fun
}
return(g) return(g)
} }

6
R/checks.R
View file

@ -8,6 +8,10 @@ check_vars_in_df <- function(df, vars) {
vars_nin <- setdiff(vars, colnames(df)) vars_nin <- setdiff(vars, colnames(df))
if (length(vars_nin) > 0) { if (length(vars_nin) > 0) {
rlang::abort(glue::glue("Variables ", glue::glue_collapse(vars_nin, sep = ", ", last = ", and "), " not found in data frame.")) rlang::abort(glue::glue(
"Variables ",
glue::glue_collapse(vars_nin, sep = ", ", last = ", and "),
" not found in data frame."
))
} }
} }

122
R/color.R
View file

@ -16,7 +16,6 @@
#' #'
#' @export #' @export
color <- function(..., unname = TRUE) { color <- function(..., unname = TRUE) {
#------ Prep #------ Prep
# Retrieve colors # Retrieve colors
@ -24,63 +23,62 @@ color <- function(..., unname = TRUE) {
# Defined colors # Defined colors
colors <- c( colors <- c(
white = "#FFFFFF" white = "#FFFFFF",
, lighter_grey = "#F5F5F5" lighter_grey = "#F5F5F5",
, light_grey = "#E3E3E3" light_grey = "#E3E3E3",
, dark_grey = "#464647" dark_grey = "#464647",
, light_blue_grey = "#B3C6D1" light_blue_grey = "#B3C6D1",
, grey = "#71716F" grey = "#71716F",
, black = "#000000" black = "#000000",
, cat_2_yellow_1 = "#ffc20a" cat_2_yellow_1 = "#ffc20a",
, cat_2_yellow_2 = "#0c7bdc" cat_2_yellow_2 = "#0c7bdc",
, cat_2_light_1 = "#fefe62" cat_2_light_1 = "#fefe62",
, cat_2_light_2 = "#d35fb7" cat_2_light_2 = "#d35fb7",
, cat_2_green_1 = "#1aff1a" cat_2_green_1 = "#1aff1a",
, cat_2_green_2 = "#4b0092" cat_2_green_2 = "#4b0092",
, cat_2_blue_1 = "#1a85ff" cat_2_blue_1 = "#1a85ff",
, cat_2_blue_2 = "#d41159" cat_2_blue_2 = "#d41159",
, cat_5_main_1 = "#083d77" # yale blue cat_5_main_1 = "#083d77", # yale blue
, cat_5_main_2 = "#4ecdc4" # robin egg blue cat_5_main_2 = "#4ecdc4", # robin egg blue
, cat_5_main_3 = "#f4c095" # peach cat_5_main_3 = "#f4c095", # peach
, cat_5_main_4 = "#b47eb3" # african violet cat_5_main_4 = "#b47eb3", # african violet
, cat_5_main_5 = "#ffd5ff" # mimi pink cat_5_main_5 = "#ffd5ff", # mimi pink
, seq_5_main_1 = "#083d77" # yale blue seq_5_main_1 = "#083d77", # yale blue
, seq_5_main_2 = "##396492" seq_5_main_2 = "##396492",
, seq_5_main_3 = "#6b8bad" seq_5_main_3 = "#6b8bad",
, seq_5_main_4 = "#9cb1c9" seq_5_main_4 = "#9cb1c9",
, seq_5_main_5 = "#ced8e4" seq_5_main_5 = "#ced8e4",
, cat_5_ibm_1 = "#648fff" cat_5_ibm_1 = "#648fff",
, cat_5_ibm_2 = "#785ef0" cat_5_ibm_2 = "#785ef0",
, cat_5_ibm_3 = "#dc267f" cat_5_ibm_3 = "#dc267f",
, cat_5_ibm_4 = "#fe6100" cat_5_ibm_4 = "#fe6100",
, cat_5_ibm_5 = "#ffb000" cat_5_ibm_5 = "#ffb000",
, cat_3_aquamarine_1 = "aquamarine2" cat_3_aquamarine_1 = "aquamarine2",
, cat_3_aquamarine_2 = "cornflowerblue" cat_3_aquamarine_2 = "cornflowerblue",
, cat_3_aquamarine_3 = "brown1" cat_3_aquamarine_3 = "brown1",
, cat_3_tol_high_contrast_1 = "#215589" cat_3_tol_high_contrast_1 = "#215589",
, cat_3_tol_high_contrast_2 = "#cfaa34" cat_3_tol_high_contrast_2 = "#cfaa34",
, cat_3_tol_high_contrast_3 = "#a35364" cat_3_tol_high_contrast_3 = "#a35364",
, cat_8_tol_adapted_1 = "#332e86" cat_8_tol_adapted_1 = "#332e86",
, cat_8_tol_adapted_2 = "#50504f" cat_8_tol_adapted_2 = "#50504f",
, cat_8_tol_adapted_3 = "#3dab9a" cat_8_tol_adapted_3 = "#3dab9a",
, cat_8_tol_adapted_4 = "#86ccee" cat_8_tol_adapted_4 = "#86ccee",
, cat_8_tol_adapted_5 = "#ddcb77" cat_8_tol_adapted_5 = "#ddcb77",
, cat_8_tol_adapted_6 = "#ee5859" cat_8_tol_adapted_6 = "#ee5859",
, cat_8_tol_adapted_7 = "#aa4599" cat_8_tol_adapted_7 = "#aa4599",
, cat_8_tol_adapted_8 = "#721220" cat_8_tol_adapted_8 = "#721220",
, div_5_orange_blue_1 = "#c85200" div_5_orange_blue_1 = "#c85200",
, div_5_orange_blue_2 = "#e48646" div_5_orange_blue_2 = "#e48646",
, div_5_orange_blue_3 = "#cccccc" div_5_orange_blue_3 = "#cccccc",
, div_5_orange_blue_4 = "#6b8ea4" div_5_orange_blue_4 = "#6b8ea4",
, div_5_orange_blue_5 = "#366785" div_5_orange_blue_5 = "#366785",
, div_5_green_purple_1 = "#c85200" div_5_green_purple_1 = "#c85200",
, div_5_green_purple_2 = "#e48646" div_5_green_purple_2 = "#e48646",
, div_5_green_purple_3 = "#cccccc" div_5_green_purple_3 = "#cccccc",
, div_5_green_purple_4 = "#6b8ea4" div_5_green_purple_4 = "#6b8ea4",
, div_5_green_purple_5 = "#366785" div_5_green_purple_5 = "#366785"
) )
#------ Checks #------ Checks
# Check that if ... is not null, all colors are defined # Check that if ... is not null, all colors are defined
@ -88,10 +86,13 @@ color <- function(..., unname = TRUE) {
if (cols %notallin% names(colors)) { if (cols %notallin% names(colors)) {
rlang::abort(c( rlang::abort(c(
"Some colors not defined", "Some colors not defined",
"*" = glue::glue_collapse(...[which(!... %in% names(cols))], sep = ", ", last = ", and "), "*" = glue::glue_collapse(
...[which(!... %in% names(cols))],
sep = ", ",
last = ", and "
),
"i" = "Use `color(unname = FALSE)` to see all named available colors." "i" = "Use `color(unname = FALSE)` to see all named available colors."
) ))
)
} }
} }
@ -115,8 +116,7 @@ color <- function(..., unname = TRUE) {
#' @param pattern Pattern of the start of colors' name. #' @param pattern Pattern of the start of colors' name.
#' #'
#' @export #' @export
color_pattern <- function(pattern, unname = TRUE){ color_pattern <- function(pattern, unname = TRUE) {
#------ Checks #------ Checks
# Check that pattern is a character scalar # Check that pattern is a character scalar

54
R/dumbbell.R
View file

@ -29,7 +29,8 @@
#' @return A dumbbell chart. #' @return A dumbbell chart.
#' @export #' @export
#' #'
dumbbell <- function(df, dumbbell <- function(
df,
col, col,
group_x, group_x,
group_y, group_y,
@ -53,8 +54,8 @@ dumbbell <- function(df,
add_text_color = color("dark_grey"), add_text_color = color("dark_grey"),
theme_fun = theme_dumbbell(), theme_fun = theme_dumbbell(),
scale_fill_fun = scale_fill_visualizer_discrete(), scale_fill_fun = scale_fill_visualizer_discrete(),
scale_color_fun = scale_color_visualizer_discrete()){ scale_color_fun = scale_color_visualizer_discrete()
) {
#------ Checks #------ Checks
# df is a data frame # df is a data frame
@ -88,7 +89,11 @@ dumbbell <- function(df,
dplyr::pull() dplyr::pull()
# Check if only two groups # 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") if (length(group_x_keys) > 2) {
rlang::abort(
"Cannot draw a dumbbell plot for `group_x` with more than 2 groups"
)
}
# Pivot long data # Pivot long data
df_pivot <- df |> df_pivot <- df |>
@ -101,16 +106,24 @@ dumbbell <- function(df,
df_pivot <- df_pivot |> df_pivot <- df_pivot |>
dplyr::rowwise() |> dplyr::rowwise() |>
dplyr::mutate( dplyr::mutate(
min = min(!!rlang::sym(group_x_keys[[1]]), !!rlang::sym(group_x_keys[[2]]), na.rm = T), min = min(
max = max(!!rlang::sym(group_x_keys[[1]]), !!rlang::sym(group_x_keys[[2]]), na.rm = T)) |> !!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::ungroup() |>
dplyr::mutate(diff = max - min) dplyr::mutate(diff = max - min)
g <- ggplot2::ggplot(df_pivot) g <- ggplot2::ggplot(df_pivot)
# Add line # Add line
if(line_to_y_axis) { if (line_to_y_axis) {
xend <- min(dplyr::pull(df, !!rlang::sym(col))) xend <- min(dplyr::pull(df, !!rlang::sym(col)))
g <- g + g <- g +
@ -118,11 +131,13 @@ dumbbell <- function(df,
ggplot2::aes( ggplot2::aes(
x = min, x = min,
y = !!rlang::sym(group_y), y = !!rlang::sym(group_y),
yend = !!rlang::sym(group_y)), yend = !!rlang::sym(group_y)
),
xend = xend, xend = xend,
linetype = line_to_y_axis_type, linetype = line_to_y_axis_type,
linewidth = line_to_y_axis_width, linewidth = line_to_y_axis_width,
color = line_to_y_axis_color) color = line_to_y_axis_color
)
} }
# Add segment # Add segment
@ -132,7 +147,8 @@ dumbbell <- function(df,
x = !!rlang::sym(group_x_keys[[1]]), x = !!rlang::sym(group_x_keys[[1]]),
y = !!rlang::sym(group_y), y = !!rlang::sym(group_y),
xend = !!rlang::sym(group_x_keys[[2]]), xend = !!rlang::sym(group_x_keys[[2]]),
yend = !!rlang::sym(group_y)), yend = !!rlang::sym(group_y)
),
linewidth = segment_size, linewidth = segment_size,
color = segment_color color = segment_color
) )
@ -152,7 +168,8 @@ dumbbell <- function(df,
) )
# Add title, subtitle, caption, x_title, y_title # Add title, subtitle, caption, x_title, y_title
g <- g + ggplot2::labs( g <- g +
ggplot2::labs(
title = title, title = title,
subtitle = subtitle, subtitle = subtitle,
caption = caption, caption = caption,
@ -163,7 +180,8 @@ dumbbell <- function(df,
) )
# Add stat labels to points # Add stat labels to points
if(add_text) g <- g + if (add_text) {
g <- g +
ggrepel::geom_text_repel( ggrepel::geom_text_repel(
data = df, data = df,
ggplot2::aes( ggplot2::aes(
@ -175,15 +193,19 @@ dumbbell <- function(df,
size = add_text_size, size = add_text_size,
color = add_text_color color = add_text_color
) )
}
# Add theme # Add theme
g <- g + theme_fun g <- g + theme_fun
# Add scale fun # Add scale fun
if (!is.null(scale_fill_fun)) g <- g + scale_fill_fun if (!is.null(scale_fill_fun)) {
g <- g + scale_fill_fun
}
if (!is.null(scale_color_fun)) g <- g + scale_color_fun if (!is.null(scale_color_fun)) {
g <- g + scale_color_fun
}
return(g) return(g)
} }

53
R/palette.R
View file

@ -8,8 +8,12 @@
#' @return A color palette #' @return A color palette
#' #'
#' @export #' @export
palette <- function(palette = "cat_5_main", reverse = FALSE, show_palettes = FALSE, ...) { palette <- function(
palette = "cat_5_main",
reverse = FALSE,
show_palettes = FALSE,
...
) {
#------ Checks #------ Checks
# Check that palette is a character scalar # Check that palette is a character scalar
@ -25,21 +29,28 @@ palette <- function(palette = "cat_5_main", reverse = FALSE, show_palettes = FAL
# Define palettes # Define palettes
pals <- list( pals <- list(
cat_2_yellow = color_pattern("cat_2_yellow") cat_2_yellow = color_pattern("cat_2_yellow"),
, cat_2_light = color_pattern("cat_2_light") cat_2_light = color_pattern("cat_2_light"),
, cat_2_green = color_pattern("cat_2_green") cat_2_green = color_pattern("cat_2_green"),
, cat_2_blue = color_pattern("cat_2_blue") cat_2_blue = color_pattern("cat_2_blue"),
, cat_5_main = color_pattern("cat_5_main") cat_5_main = color_pattern("cat_5_main"),
, cat_5_ibm = color_pattern("cat_5_ibm") cat_5_ibm = color_pattern("cat_5_ibm"),
, cat_3_aquamarine = color_pattern("cat_3_aquamarine") cat_3_aquamarine = color_pattern("cat_3_aquamarine"),
, cat_3_tol_high_contrast = color_pattern("cat_3_tol_high_contrast") cat_3_tol_high_contrast = color_pattern("cat_3_tol_high_contrast"),
, cat_8_tol_adapted = color_pattern("cat_8_tol_adapted") cat_8_tol_adapted = color_pattern("cat_8_tol_adapted"),
, cat_3_custom_1 = c("#003F5C", "#58508D", "#FFA600") cat_3_custom_1 = c("#003F5C", "#58508D", "#FFA600"),
, cat_4_custom_1 = c("#003F5C", "#7a5195", "#ef5675", "#ffa600") cat_4_custom_1 = c("#003F5C", "#7a5195", "#ef5675", "#ffa600"),
, cat_5_custom_1 = c("#003F5C", "#58508d", "#bc5090", "#ff6361", "#ffa600") cat_5_custom_1 = c("#003F5C", "#58508d", "#bc5090", "#ff6361", "#ffa600"),
, cat_6_custom_1 = c("#003F5C", "#444e86", "#955196", "#dd5182", "#ff6e54", "#ffa600") cat_6_custom_1 = c(
, div_5_orange_blue = color_pattern("div_5_orange_blue") "#003F5C",
, div_5_green_purple = color_pattern("div_5_green_purple") "#444e86",
"#955196",
"#dd5182",
"#ff6e54",
"#ffa600"
),
div_5_orange_blue = color_pattern("div_5_orange_blue"),
div_5_green_purple = color_pattern("div_5_green_purple")
) )
# Return if show palettes # Return if show palettes
@ -51,7 +62,9 @@ palette <- function(palette = "cat_5_main", reverse = FALSE, show_palettes = FAL
if (palette %notin% names(pals)) { if (palette %notin% names(pals)) {
rlang::abort(c( rlang::abort(c(
"Palette not defined", "Palette not defined",
"*" = glue::glue("Palette `{palette}` is not defined in the `palettes` list."), "*" = glue::glue(
"Palette `{palette}` is not defined in the `palettes` list."
),
"i" = "Use `palette(show_palettes = TRUE)` to see all available palettes." "i" = "Use `palette(show_palettes = TRUE)` to see all available palettes."
)) ))
} }
@ -60,7 +73,9 @@ palette <- function(palette = "cat_5_main", reverse = FALSE, show_palettes = FAL
pal <- pals[[palette]] pal <- pals[[palette]]
if (reverse) pal <- rev(pal) if (reverse) {
pal <- rev(pal)
}
return(pal) return(pal)
} }

29
R/palette_gen.R
View file

@ -9,15 +9,20 @@
#' #'
#' @export #' @export
palette_gen <- function(palette, type, direction = 1, ...) { palette_gen <- function(palette, type, direction = 1, ...) {
if (type %notin% c("categorical", "sequential", "divergent")) {
if (type %notin% c("categorical", "sequential", "divergent")) rlang::abort("'type' must be categorical or continuous or divergent.") rlang::abort("'type' must be categorical or continuous or divergent.")
}
if (type == "categorical") { if (type == "categorical") {
return(palette_gen_categorical(palette = palette, direction = direction)) return(palette_gen_categorical(palette = palette, direction = direction))
} }
if (type %in% c("sequential", "divergent")) { if (type %in% c("sequential", "divergent")) {
return(palette_gen_sequential(palette = palette, direction = direction, ...)) return(palette_gen_sequential(
palette = palette,
direction = direction,
...
))
} }
} }
@ -26,15 +31,20 @@ palette_gen <- function(palette, type, direction = 1, ...) {
#' #'
#' @export #' @export
palette_gen_categorical <- function(palette = "cat_5_main", direction = 1) { palette_gen_categorical <- function(palette = "cat_5_main", direction = 1) {
if (abs(direction) != 1) {
if (abs(direction) != 1) rlang::abort("Direction must be either 1 or -1.") rlang::abort("Direction must be either 1 or -1.")
}
pal <- palette(palette) pal <- palette(palette)
f <- function(n) { f <- function(n) {
if (is.null(n)) n <- length(pal) if (is.null(n)) {
n <- length(pal)
}
if (n > length(pal)) rlang::warn("Not enough colors in this palette!") if (n > length(pal)) {
rlang::warn("Not enough colors in this palette!")
}
pal <- if (direction == 1) pal else rev(pal) pal <- if (direction == 1) pal else rev(pal)
@ -50,8 +60,9 @@ palette_gen_categorical <- function(palette = "cat_5_main", direction = 1) {
#' #'
#' @export #' @export
palette_gen_sequential <- function(palette = "seq_5_main", direction = 1, ...) { palette_gen_sequential <- function(palette = "seq_5_main", direction = 1, ...) {
if (abs(direction) != 1) {
if (abs(direction) != 1) rlang::abort("Direction must be either 1 or -1.") rlang::abort("Direction must be either 1 or -1.")
}
pal <- palette(palette) pal <- palette(palette)

71
R/point.R
View file

@ -52,7 +52,6 @@ point <- function(
scale_fill_fun = scale_fill_visualizer_discrete(), scale_fill_fun = scale_fill_visualizer_discrete(),
scale_color_fun = scale_color_visualizer_discrete() scale_color_fun = scale_color_visualizer_discrete()
) { ) {
#------ Checks #------ Checks
# df is a data frame # df is a data frame
@ -66,7 +65,9 @@ point <- function(
# x and y are columns in df # x and y are columns in df
checkmate::assert_choice(x, colnames(df)) checkmate::assert_choice(x, colnames(df))
checkmate::assert_choice(y, colnames(df)) checkmate::assert_choice(y, colnames(df))
if (group != "") checkmate::assert_choice(group, colnames(df)) if (group != "") {
checkmate::assert_choice(group, colnames(df))
}
# x_rm_na, y_rm_na and group_rm_na are logical scalar # x_rm_na, y_rm_na and group_rm_na are logical scalar
checkmate::assert_logical(x_rm_na, len = 1) checkmate::assert_logical(x_rm_na, len = 1)
@ -87,9 +88,12 @@ point <- function(
checkmate::assert_numeric(size, len = 1) checkmate::assert_numeric(size, len = 1)
# x and y are numeric # 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[[x]]))) {
if (!any(c("numeric", "integer") %in% class(df[[y]]))) rlang::abort(paste0(y, " must be numeric.")) 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 #----- Data wrangling
@ -99,10 +103,18 @@ point <- function(
} }
# remove NAs using base R # remove NAs using base R
if (x_rm_na) df <- df[!(is.na(df[[x]])),] if (x_rm_na) {
if (y_rm_na) df <- df[!(is.na(df[[y]])),] df <- df[!(is.na(df[[x]])), ]
if (group != "" && group_rm_na) df <- df[!(is.na(df[[group]])),] }
if (facet != "" && facet_rm_na) df <- df[!(is.na(df[[facet]])),] 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 # prepare aes
if (group != "") { if (group != "") {
@ -126,7 +138,8 @@ point <- function(
} }
# add title, subtitle, caption, x_title, y_title # add title, subtitle, caption, x_title, y_title
g <- g + ggplot2::labs( g <- g +
ggplot2::labs(
title = title, title = title,
subtitle = subtitle, subtitle = subtitle,
caption = caption, caption = caption,
@ -137,31 +150,35 @@ point <- function(
) )
# facets # facets
# facets # facets
if (facet != "") { if (facet != "") {
if (flip) { if (flip) {
g <- g + ggplot2::facet_grid( g <- g +
ggplot2::facet_grid(
rows = ggplot2::vars(!!rlang::sym(facet)), rows = ggplot2::vars(!!rlang::sym(facet)),
scales = facet_scales, scales = facet_scales,
space = if(facet_scales == "free") "free_y" else "fixed" space = if (facet_scales == "free") "free_y" else "fixed"
) )
} else { } else {
g <- g + ggplot2::facet_grid( g <- g +
ggplot2::facet_grid(
cols = ggplot2::vars(!!rlang::sym(facet)), cols = ggplot2::vars(!!rlang::sym(facet)),
scales = facet_scales, scales = facet_scales,
space = if(facet_scales == "free") "free_x" else "fixed" space = if (facet_scales == "free") "free_x" else "fixed"
) )
} }
} }
# Should the graph use position_fill? # Should the graph use position_fill?
if (group != "") { if (group != "") {
g <- g + ggplot2::geom_point( g <- g +
ggplot2::geom_point(
alpha = alpha, alpha = alpha,
size = size size = size
) )
} else { } else {
g <- g + ggplot2::geom_point( g <- g +
ggplot2::geom_point(
alpha = alpha, alpha = alpha,
size = size, size = size,
color = add_color color = add_color
@ -173,15 +190,23 @@ if (facet != "") {
} }
# Remove guides for legend if !add_color_guide # Remove guides for legend if !add_color_guide
if (!add_color_guide) g <- g + ggplot2::guides(fill = "none", color = "none") if (!add_color_guide) {
g <- g + ggplot2::guides(fill = "none", color = "none")
}
# Add theme # Add theme
if (!is.null(theme_fun)) g <- g + theme_fun if (!is.null(theme_fun)) {
g <- g + theme_fun
}
# Add scale fun # Add scale fun
if (!is.null(scale_fill_fun)) g <- g + scale_fill_fun if (!is.null(scale_fill_fun)) {
g <- g + scale_fill_fun
}
if (!is.null(scale_color_fun)) g <- g + scale_color_fun if (!is.null(scale_color_fun)) {
g <- g + scale_color_fun
}
return(g) return(g)
} }

7
R/reorder_by.R
View file

@ -24,8 +24,7 @@
#' reorder_by(df, "col1", "col2") #' reorder_by(df, "col1", "col2")
#' #'
#' @export #' @export
reorder_by <- function(df, x, y, group = "", order = "y", dir_order = 1){ reorder_by <- function(df, x, y, group = "", order = "y", dir_order = 1) {
#------ Checks #------ Checks
# df is a data frame # df is a data frame
@ -39,7 +38,9 @@ reorder_by <- function(df, x, y, group = "", order = "y", dir_order = 1){
# group is character scalar and in df if not empty # group is character scalar and in df if not empty
checkmate::assert_character(group, len = 1) checkmate::assert_character(group, len = 1)
if (group != "") checkmate::assert_subset(group, colnames(df)) if (group != "") {
checkmate::assert_subset(group, colnames(df))
}
# order is a character scalar in c("none", "y", "grouped") # order is a character scalar in c("none", "y", "grouped")
checkmate::assert_choice(order, c("none", "y", "grouped_y", "x", "grouped_x")) checkmate::assert_choice(order, c("none", "y", "grouped_y", "x", "grouped_x"))

42
R/scale.R
View file

@ -8,8 +8,13 @@
#' @param ... Additional arguments passed to [ggplot2::discrete_scale()] if discrete or [ggplot2::scale_fill_gradient()] if continuous. #' @param ... Additional arguments passed to [ggplot2::discrete_scale()] if discrete or [ggplot2::scale_fill_gradient()] if continuous.
#' #'
#' @export #' @export
scale_color_visualizer_discrete <- function(palette = "cat_5_main", direction = 1, reverse_guide = TRUE, title_position = NULL, ...) { scale_color_visualizer_discrete <- function(
palette = "cat_5_main",
direction = 1,
reverse_guide = TRUE,
title_position = NULL,
...
) {
if (!(is.null(palette))) { if (!(is.null(palette))) {
ggplot2::discrete_scale( ggplot2::discrete_scale(
"color", "color",
@ -41,8 +46,13 @@ scale_color_visualizer_discrete <- function(palette = "cat_5_main", direction =
#' @rdname scale_color_visualizer_discrete #' @rdname scale_color_visualizer_discrete
#' #'
#' @export #' @export
scale_fill_visualizer_discrete <- function(palette = "cat_5_main", direction = 1, reverse_guide = TRUE, title_position = NULL, ...) { scale_fill_visualizer_discrete <- function(
palette = "cat_5_main",
direction = 1,
reverse_guide = TRUE,
title_position = NULL,
...
) {
if (!(is.null(palette))) { if (!(is.null(palette))) {
ggplot2::discrete_scale( ggplot2::discrete_scale(
"fill", "fill",
@ -74,8 +84,13 @@ scale_fill_visualizer_discrete <- function(palette = "cat_5_main", direction = 1
#' @rdname scale_color_visualizer_discrete #' @rdname scale_color_visualizer_discrete
#' #'
#' @export #' @export
scale_fill_visualizer_continuous <- function(palette = "seq_5_main", direction = 1, reverse_guide = TRUE, title_position = NULL, ...) { scale_fill_visualizer_continuous <- function(
palette = "seq_5_main",
direction = 1,
reverse_guide = TRUE,
title_position = NULL,
...
) {
if (!(is.null(palette))) { if (!(is.null(palette))) {
pal <- palette_gen(palette, "continuous", direction) pal <- palette_gen(palette, "continuous", direction)
@ -100,15 +115,21 @@ scale_fill_visualizer_continuous <- function(palette = "seq_5_main", direction =
# ticks.colour = "#F1F3F5", # ticks.colour = "#F1F3F5",
reverse = reverse_guide reverse = reverse_guide
), ),
...) ...
)
} }
} }
#' @rdname scale_color_visualizer_discrete #' @rdname scale_color_visualizer_discrete
#' #'
#' @export #' @export
scale_color_visualizer_continuous <- function(palette = "seq_5_main", direction = 1, reverse_guide = TRUE, title_position = NULL, ...) { scale_color_visualizer_continuous <- function(
palette = "seq_5_main",
direction = 1,
reverse_guide = TRUE,
title_position = NULL,
...
) {
if (!(is.null(palette))) { if (!(is.null(palette))) {
pal <- palette_gen(palette, "continuous", direction) pal <- palette_gen(palette, "continuous", direction)
@ -133,6 +154,7 @@ scale_color_visualizer_continuous <- function(palette = "seq_5_main", direction
# ticks.colour = "#F1F3F5", # ticks.colour = "#F1F3F5",
reverse = reverse_guide reverse = reverse_guide
), ),
....) ....
)
} }
} }

49
R/theme_bar.R
View file

@ -5,10 +5,15 @@
#' @rdname theme_default #' @rdname theme_default
#' #'
#' @export #' @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) { 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 add_text is TRUE, flip is FALSE
if (!flip && !add_text){ if (!flip && !add_text) {
par_axis_text_font_face <- "plain" par_axis_text_font_face <- "plain"
par_axis_x <- TRUE par_axis_x <- TRUE
par_axis_y <- TRUE par_axis_y <- TRUE
@ -22,7 +27,7 @@ theme_bar <- function(flip = TRUE, add_text = FALSE, axis_text_x_angle = 0, axis
par_grid_major_x <- FALSE par_grid_major_x <- FALSE
par_grid_minor_y <- TRUE par_grid_minor_y <- TRUE
par_grid_minor_x <- FALSE par_grid_minor_x <- FALSE
} else if (flip && !add_text){ } else if (flip && !add_text) {
par_axis_text_font_face <- "plain" par_axis_text_font_face <- "plain"
par_axis_x <- TRUE par_axis_x <- TRUE
par_axis_y <- TRUE par_axis_y <- TRUE
@ -36,7 +41,7 @@ theme_bar <- function(flip = TRUE, add_text = FALSE, axis_text_x_angle = 0, axis
par_grid_major_x <- TRUE par_grid_major_x <- TRUE
par_grid_minor_y <- FALSE par_grid_minor_y <- FALSE
par_grid_minor_x <- TRUE par_grid_minor_x <- TRUE
} else if (!flip && add_text){ } else if (!flip && add_text) {
par_axis_text_font_face <- "bold" par_axis_text_font_face <- "bold"
par_axis_x <- TRUE par_axis_x <- TRUE
par_axis_y <- TRUE par_axis_y <- TRUE
@ -50,7 +55,7 @@ theme_bar <- function(flip = TRUE, add_text = FALSE, axis_text_x_angle = 0, axis
par_grid_major_x <- FALSE par_grid_major_x <- FALSE
par_grid_minor_y <- FALSE par_grid_minor_y <- FALSE
par_grid_minor_x <- FALSE par_grid_minor_x <- FALSE
} else if (flip && add_text){ } else if (flip && add_text) {
par_axis_text_font_face <- "bold" par_axis_text_font_face <- "bold"
par_axis_x <- TRUE par_axis_x <- TRUE
par_axis_y <- TRUE par_axis_y <- TRUE
@ -68,22 +73,22 @@ theme_bar <- function(flip = TRUE, add_text = FALSE, axis_text_x_angle = 0, axis
# Theme # Theme
t <- theme_default( t <- theme_default(
axis_text_font_face = par_axis_text_font_face axis_text_font_face = par_axis_text_font_face,
, axis_x = par_axis_x axis_x = par_axis_x,
, axis_y = par_axis_y axis_y = par_axis_y,
, grid_major_y = par_grid_major_y grid_major_y = par_grid_major_y,
, grid_major_x = par_grid_major_x grid_major_x = par_grid_major_x,
, grid_minor_y = par_grid_minor_y grid_minor_y = par_grid_minor_y,
, grid_minor_x = par_grid_minor_x grid_minor_x = par_grid_minor_x,
, axis_text_y = par_axis_text_y axis_text_y = par_axis_text_y,
, axis_line_y = par_axis_line_y axis_line_y = par_axis_line_y,
, axis_ticks_y = par_axis_ticks_y axis_ticks_y = par_axis_ticks_y,
, axis_text_x = par_axis_text_x axis_text_x = par_axis_text_x,
, axis_line_x = par_axis_line_x axis_line_x = par_axis_line_x,
, axis_ticks_x = par_axis_ticks_x axis_ticks_x = par_axis_ticks_x,
, axis_text_x_angle = axis_text_x_angle axis_text_x_angle = axis_text_x_angle,
, axis_text_x_vjust = axis_text_x_vjust axis_text_x_vjust = axis_text_x_vjust,
, axis_text_x_hjust = axis_text_x_hjust axis_text_x_hjust = axis_text_x_hjust
) )
return(t) return(t)

10
R/theme_default.R
View file

@ -129,11 +129,13 @@ theme_default <- function(
caption_position_to_plot = TRUE, caption_position_to_plot = TRUE,
caption_size = 12, caption_size = 12,
caption_color = color("dark_grey"), caption_color = color("dark_grey"),
...) { ...
) {
# Basic simple theme # Basic simple theme
theme <- ggplot2::theme_minimal() theme <- ggplot2::theme_minimal()
theme <- theme + ggplot2::theme( theme <- theme +
ggplot2::theme(
# # Text - design # # Text - design
text = ggplot2::element_text( text = ggplot2::element_text(
family = text_font_family, family = text_font_family,
@ -362,7 +364,8 @@ theme_default <- function(
} }
# Add facet title text size # Add facet title text size
theme <- theme + ggplot2::theme( theme <- theme +
ggplot2::theme(
strip.text = ggplot2::element_text( strip.text = ggplot2::element_text(
size = facet_size, size = facet_size,
family = facet_font_family, family = facet_font_family,
@ -378,6 +381,5 @@ theme_default <- function(
# Other parameters # Other parameters
theme <- theme + ggplot2::theme(...) theme <- theme + ggplot2::theme(...)
return(theme) return(theme)
} }

4
R/theme_dumbbell.R
View file

@ -8,6 +8,6 @@
theme_dumbbell <- function() { theme_dumbbell <- function() {
theme_default( theme_default(
axis_line_x = TRUE, axis_line_x = TRUE,
grid_) grid_
)
} }

3
R/theme_point.R
View file

@ -10,8 +10,7 @@
#' @return A custom theme object. #' @return A custom theme object.
#' #'
#' @export #' @export
theme_point <- function( theme_point <- function() {
) {
t <- theme_default( t <- theme_default(
axis_text_font_face = "plain", axis_text_font_face = "plain",
axis_x = TRUE, axis_x = TRUE,