From ead630c1063b12aca05f3d5cddb4a774c8535697 Mon Sep 17 00:00:00 2001 From: gnoblet Date: Tue, 1 Jul 2025 19:49:47 +0200 Subject: [PATCH] Air formatting --- R/bar.R | 622 +++++++++++++++++++++++++-------------------- R/checks.R | 6 +- R/color.R | 122 ++++----- R/dumbbell.R | 140 +++++----- R/palette.R | 53 ++-- R/palette_gen.R | 29 ++- R/point.R | 171 +++++++------ R/reorder_by.R | 23 +- R/scale.R | 44 +++- R/theme_bar.R | 49 ++-- R/theme_default.R | 164 ++++++------ R/theme_dumbbell.R | 4 +- R/theme_point.R | 29 +-- 13 files changed, 816 insertions(+), 640 deletions(-) diff --git a/R/bar.R b/R/bar.R index bf4097f..93e8d29 100644 --- a/R/bar.R +++ b/R/bar.R @@ -1,14 +1,19 @@ #' @rdname bar -#' +#' #' @inheritParams bar -#' +#' #' @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, ...) } #' 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. @@ -46,7 +51,7 @@ hbar <- function(..., flip = TRUE, add_text = FALSE, theme_fun = theme_bar(flip #' @param theme_fun Whatever theme function. For no custom theme, use theme_fun = NULL. #' #' @inheritParams reorder_by -#' +#' #' @importFrom rlang `:=` #' #' @export @@ -92,291 +97,347 @@ bar <- function( ), scale_fill_fun = scale_fill_visualizer_discrete(), scale_color_fun = scale_color_visualizer_discrete() -){ +) { + #------ Checks - -#------ 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) - -# 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) + # df is a data frame + checkmate::assert_data_frame(df) -# 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) - -# 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) - -# 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")) + # 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) -# Check if position is stack or dodge -if (position %notin% c("stack", "dodge")) rlang::abort("Position should be either 'stack' or 'dodge'.") + # 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)) + } -#----- Data wrangling - -# facets over group -if (group != "" && facet != "" && group == facet) { - rlang::warn("'group' and 'facet' are the same identical.") -} + # 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) -# 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]])),] + # flip is a logical scalar + checkmate::assert_logical(flip, len = 1) - -# 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) - -# prepare aes -if(group != "") { + # wrap is a numeric scalar or NULL + if (!is.null(wrap)) { + checkmate::assert_numeric(wrap, len = 1, null.ok = TRUE) + } - g <- ggplot2::ggplot( - df, - mapping = ggplot2::aes( - x = !!rlang::sym(x), - y = !!rlang::sym(y), - fill = !!rlang::sym(group), - color = !!rlang::sym(group) - ) + # 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) + + # 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) + + # 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")) + } + + # width is a numeric scalar between 0 and 1 + checkmate::assert_numeric(width, lower = 0, upper = 1, len = 1) + + # Check if position is stack or dodge + 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) { + 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]])), ] + } + + # 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 ) -} else { - - g <- ggplot2::ggplot( - df, - mapping = ggplot2::aes( - x = !!rlang::sym(x), - y = !!rlang::sym(y) + # 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) + ) ) - ) -} + } 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 = y_title, - y = x_title, - color = group_title, - fill = group_title -) + # add title, subtitle, caption, x_title, y_title + g <- g + + ggplot2::labs( + title = title, + subtitle = subtitle, + caption = caption, + x = y_title, + y = x_title, + color = group_title, + fill = group_title + ) -# width -width <- width -dodge_width <- width + # width + width <- width + dodge_width <- width -# facets -if (facet != "") { + # facets + if (facet != "") { + 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" + ) + } + } + + # should the graph use position_fill? + if (group != "") { + if (position == "stack") { + g <- g + + ggplot2::geom_col( + alpha = alpha, + width = width, + position = ggplot2::position_stack() + ) + } else if (position == "dodge") { + g <- g + + ggplot2::geom_col( + alpha = alpha, + width = width, + position = ggplot2::position_dodge2( + width = dodge_width, + preserve = "single" + ) + ) + } else { + g <- g + + ggplot2::geom_col( + alpha = alpha, + width = width + ) + } + } else { + if (position == "stack") { + g <- g + + ggplot2::geom_col( + alpha = alpha, + width = width, + position = ggplot2::position_stack(), + fill = add_color, + color = add_color + ) + } else if (position == "dodge") { + g <- g + + ggplot2::geom_col( + alpha = alpha, + width = width, + position = ggplot2::position_dodge2( + width = dodge_width, + preserve = "single" + ), + fill = add_color, + color = add_color + ) + } else { + g <- g + + ggplot2::geom_col( + alpha = alpha, + width = width, + fill = add_color, + color = add_color + ) + } + } + + # 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 if (flip) { - g <- g + ggplot2::facet_grid(rows = ggplot2::vars(!!rlang::sym(facet)), scales = "free", space = "free_y") + g <- g + ggplot2::coord_flip() + } + # add text to bars + if (flip) { + hjust_flip <- -0.5 } else { - g <- g + ggplot2::facet_grid(cols = ggplot2::vars(!!rlang::sym(facet)), scales = "free", space = "free_x") + hjust_flip <- 0.5 } -} - - -# 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 != "") { - - if (position == "stack"){ - g <- g + ggplot2::geom_col( - alpha = alpha, - width = width, - position = ggplot2::position_stack() - ) - } else if (position == "dodge"){ - g <- g + ggplot2::geom_col( - alpha = alpha, - width = width, - position = ggplot2::position_dodge2( - width = dodge_width, - preserve = "single") - ) - } else{ - g <- g + ggplot2::geom_col( - alpha = alpha, - width = width - ) - } - -} else { - - if (position == "stack"){ - g <- g + ggplot2::geom_col( - alpha = alpha, - width = width, - position = ggplot2::position_stack(), - fill = add_color, - color = add_color - ) - } else if (position == "dodge"){ - g <- g + ggplot2::geom_col( - alpha = alpha, - width = width, - position = ggplot2::position_dodge2( - width = dodge_width, - preserve = "single"), - fill = add_color, - color = add_color - ) + if (flip) { + vjust_flip <- 0.5 } else { - g <- g + ggplot2::geom_col( - alpha = alpha, - width = width, - fill = add_color, - color = add_color - ) + vjust_flip <- -0.5 } -} -# 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 -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) + # 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 -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 - g <- g + ggplot2::geom_blank( - data = df, - 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 = 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) + # 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 + g <- g + + ggplot2::geom_blank( + data = df, + 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 = 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) + ) } else if (add_text & position == "stack") { + df <- dplyr::mutate( + df, + "y_threshold" := ifelse( + !!rlang::sym(y) >= add_text_threshold_display, + !!rlang::sym(y), + NA + ) + ) - 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) - ) - + 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 @@ -385,23 +446,32 @@ if (add_text & position == "dodge") { # start at 0 expand = ggplot2::expansion(mult = c(0, y_expand)), # remove trailing 0 and choose accuracy of y labels - labels = scales::label_number( + labels = scales::label_number( accuracy = 0.1, drop0trailing = TRUE, big.mark = "", - decimal.mark = "."), - ) + decimal.mark = "." + ), + ) - # Remove guides for legend if !add_color_guide - if (!add_color_guide) g <- g + ggplot2::guides(fill = "none", color = "none") + # # 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 + # # add theme fun + if (!is.null(theme_fun)) { + 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 + # # # 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) } diff --git a/R/checks.R b/R/checks.R index 7cd9978..e602c02 100644 --- a/R/checks.R +++ b/R/checks.R @@ -8,6 +8,10 @@ check_vars_in_df <- function(df, vars) { vars_nin <- setdiff(vars, colnames(df)) 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." + )) } } diff --git a/R/color.R b/R/color.R index 69f3740..6727372 100644 --- a/R/color.R +++ b/R/color.R @@ -16,7 +16,6 @@ #' #' @export color <- function(..., unname = TRUE) { - #------ Prep # Retrieve colors @@ -24,63 +23,62 @@ 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" - , cat_2_light_1 = "#fefe62" - , cat_2_light_2 = "#d35fb7" - , cat_2_green_1 = "#1aff1a" - , cat_2_green_2 = "#4b0092" - , cat_2_blue_1 = "#1a85ff" - , cat_2_blue_2 = "#d41159" - , cat_5_main_1 = "#083d77" # yale blue - , cat_5_main_2 = "#4ecdc4" # robin egg blue - , cat_5_main_3 = "#f4c095" # peach - , cat_5_main_4 = "#b47eb3" # african violet - , cat_5_main_5 = "#ffd5ff" # mimi pink - , seq_5_main_1 = "#083d77" # yale blue - , seq_5_main_2 = "##396492" - , seq_5_main_3 = "#6b8bad" - , seq_5_main_4 = "#9cb1c9" - , seq_5_main_5 = "#ced8e4" - , cat_5_ibm_1 = "#648fff" - , cat_5_ibm_2 = "#785ef0" - , cat_5_ibm_3 = "#dc267f" - , cat_5_ibm_4 = "#fe6100" - , cat_5_ibm_5 = "#ffb000" - , cat_3_aquamarine_1 = "aquamarine2" - , cat_3_aquamarine_2 = "cornflowerblue" - , cat_3_aquamarine_3 = "brown1" - , cat_3_tol_high_contrast_1 = "#215589" - , cat_3_tol_high_contrast_2 = "#cfaa34" - , cat_3_tol_high_contrast_3 = "#a35364" - , cat_8_tol_adapted_1 = "#332e86" - , cat_8_tol_adapted_2 = "#50504f" - , cat_8_tol_adapted_3 = "#3dab9a" - , cat_8_tol_adapted_4 = "#86ccee" - , cat_8_tol_adapted_5 = "#ddcb77" - , cat_8_tol_adapted_6 = "#ee5859" - , cat_8_tol_adapted_7 = "#aa4599" - , cat_8_tol_adapted_8 = "#721220" - , div_5_orange_blue_1 = "#c85200" - , div_5_orange_blue_2 = "#e48646" - , div_5_orange_blue_3 = "#cccccc" - , div_5_orange_blue_4 = "#6b8ea4" - , div_5_orange_blue_5 = "#366785" - , div_5_green_purple_1 = "#c85200" - , div_5_green_purple_2 = "#e48646" - , div_5_green_purple_3 = "#cccccc" - , div_5_green_purple_4 = "#6b8ea4" - , div_5_green_purple_5 = "#366785" + 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", + cat_2_light_1 = "#fefe62", + cat_2_light_2 = "#d35fb7", + cat_2_green_1 = "#1aff1a", + cat_2_green_2 = "#4b0092", + cat_2_blue_1 = "#1a85ff", + cat_2_blue_2 = "#d41159", + cat_5_main_1 = "#083d77", # yale blue + cat_5_main_2 = "#4ecdc4", # robin egg blue + cat_5_main_3 = "#f4c095", # peach + cat_5_main_4 = "#b47eb3", # african violet + cat_5_main_5 = "#ffd5ff", # mimi pink + seq_5_main_1 = "#083d77", # yale blue + seq_5_main_2 = "##396492", + seq_5_main_3 = "#6b8bad", + seq_5_main_4 = "#9cb1c9", + seq_5_main_5 = "#ced8e4", + cat_5_ibm_1 = "#648fff", + cat_5_ibm_2 = "#785ef0", + cat_5_ibm_3 = "#dc267f", + cat_5_ibm_4 = "#fe6100", + cat_5_ibm_5 = "#ffb000", + cat_3_aquamarine_1 = "aquamarine2", + cat_3_aquamarine_2 = "cornflowerblue", + cat_3_aquamarine_3 = "brown1", + cat_3_tol_high_contrast_1 = "#215589", + cat_3_tol_high_contrast_2 = "#cfaa34", + cat_3_tol_high_contrast_3 = "#a35364", + cat_8_tol_adapted_1 = "#332e86", + cat_8_tol_adapted_2 = "#50504f", + cat_8_tol_adapted_3 = "#3dab9a", + cat_8_tol_adapted_4 = "#86ccee", + cat_8_tol_adapted_5 = "#ddcb77", + cat_8_tol_adapted_6 = "#ee5859", + cat_8_tol_adapted_7 = "#aa4599", + cat_8_tol_adapted_8 = "#721220", + div_5_orange_blue_1 = "#c85200", + div_5_orange_blue_2 = "#e48646", + div_5_orange_blue_3 = "#cccccc", + div_5_orange_blue_4 = "#6b8ea4", + div_5_orange_blue_5 = "#366785", + div_5_green_purple_1 = "#c85200", + div_5_green_purple_2 = "#e48646", + div_5_green_purple_3 = "#cccccc", + div_5_green_purple_4 = "#6b8ea4", + div_5_green_purple_5 = "#366785" ) - #------ Checks # Check that if ... is not null, all colors are defined @@ -88,10 +86,13 @@ color <- function(..., unname = TRUE) { if (cols %notallin% names(colors)) { rlang::abort(c( "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." - ) - ) + )) } } @@ -115,8 +116,7 @@ color <- function(..., unname = TRUE) { #' @param pattern Pattern of the start of colors' name. #' #' @export -color_pattern <- function(pattern, unname = TRUE){ - +color_pattern <- function(pattern, unname = TRUE) { #------ Checks # Check that pattern is a character scalar diff --git a/R/dumbbell.R b/R/dumbbell.R index eaf59bc..e38acda 100644 --- a/R/dumbbell.R +++ b/R/dumbbell.R @@ -29,32 +29,33 @@ #' @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()){ - +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 @@ -88,7 +89,11 @@ dumbbell <- function(df, 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") + 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 |> @@ -101,16 +106,24 @@ dumbbell <- function(df, 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)) |> + 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) { - + if (line_to_y_axis) { xend <- min(dplyr::pull(df, !!rlang::sym(col))) g <- g + @@ -118,21 +131,24 @@ dumbbell <- function(df, ggplot2::aes( x = min, y = !!rlang::sym(group_y), - yend = !!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) + color = line_to_y_axis_color + ) } # Add segment - g <- g + + 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)), + yend = !!rlang::sym(group_y) + ), linewidth = segment_size, color = segment_color ) @@ -152,38 +168,44 @@ dumbbell <- function(df, ) # 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 - ) + 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 - ) + 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_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) - } diff --git a/R/palette.R b/R/palette.R index e92ca25..e804701 100644 --- a/R/palette.R +++ b/R/palette.R @@ -8,8 +8,12 @@ #' @return A color palette #' #' @export -palette <- function(palette = "cat_5_main", reverse = FALSE, show_palettes = FALSE, ...) { - +palette <- function( + palette = "cat_5_main", + reverse = FALSE, + show_palettes = FALSE, + ... +) { #------ Checks # Check that palette is a character scalar @@ -25,21 +29,28 @@ palette <- function(palette = "cat_5_main", reverse = FALSE, show_palettes = FAL # Define palettes pals <- list( - cat_2_yellow = color_pattern("cat_2_yellow") - , cat_2_light = color_pattern("cat_2_light") - , cat_2_green = color_pattern("cat_2_green") - , cat_2_blue = color_pattern("cat_2_blue") - , cat_5_main = color_pattern("cat_5_main") - , cat_5_ibm = color_pattern("cat_5_ibm") - , cat_3_aquamarine = color_pattern("cat_3_aquamarine") - , cat_3_tol_high_contrast = color_pattern("cat_3_tol_high_contrast") - , cat_8_tol_adapted = color_pattern("cat_8_tol_adapted") - , cat_3_custom_1 = c("#003F5C", "#58508D", "#FFA600") - , cat_4_custom_1 = c("#003F5C", "#7a5195", "#ef5675", "#ffa600") - , cat_5_custom_1 = c("#003F5C", "#58508d", "#bc5090", "#ff6361", "#ffa600") - , cat_6_custom_1 = c("#003F5C", "#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") + cat_2_yellow = color_pattern("cat_2_yellow"), + cat_2_light = color_pattern("cat_2_light"), + cat_2_green = color_pattern("cat_2_green"), + cat_2_blue = color_pattern("cat_2_blue"), + cat_5_main = color_pattern("cat_5_main"), + cat_5_ibm = color_pattern("cat_5_ibm"), + cat_3_aquamarine = color_pattern("cat_3_aquamarine"), + cat_3_tol_high_contrast = color_pattern("cat_3_tol_high_contrast"), + cat_8_tol_adapted = color_pattern("cat_8_tol_adapted"), + cat_3_custom_1 = c("#003F5C", "#58508D", "#FFA600"), + cat_4_custom_1 = c("#003F5C", "#7a5195", "#ef5675", "#ffa600"), + cat_5_custom_1 = c("#003F5C", "#58508d", "#bc5090", "#ff6361", "#ffa600"), + cat_6_custom_1 = c( + "#003F5C", + "#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 @@ -51,7 +62,9 @@ palette <- function(palette = "cat_5_main", reverse = FALSE, show_palettes = FAL if (palette %notin% names(pals)) { rlang::abort(c( "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." )) } @@ -60,7 +73,9 @@ palette <- function(palette = "cat_5_main", reverse = FALSE, show_palettes = FAL pal <- pals[[palette]] - if (reverse) pal <- rev(pal) + if (reverse) { + pal <- rev(pal) + } return(pal) } diff --git a/R/palette_gen.R b/R/palette_gen.R index 28870e2..0fcba9c 100644 --- a/R/palette_gen.R +++ b/R/palette_gen.R @@ -9,15 +9,20 @@ #' #' @export palette_gen <- function(palette, type, direction = 1, ...) { - - if (type %notin% c("categorical", "sequential", "divergent")) rlang::abort("'type' must be categorical or continuous or divergent.") + if (type %notin% c("categorical", "sequential", "divergent")) { + rlang::abort("'type' must be categorical or continuous or divergent.") + } if (type == "categorical") { return(palette_gen_categorical(palette = palette, direction = direction)) } 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 palette_gen_categorical <- function(palette = "cat_5_main", direction = 1) { - - if (abs(direction) != 1) rlang::abort("Direction must be either 1 or -1.") + if (abs(direction) != 1) { + rlang::abort("Direction must be either 1 or -1.") + } pal <- palette(palette) 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) @@ -50,8 +60,9 @@ palette_gen_categorical <- function(palette = "cat_5_main", direction = 1) { #' #' @export palette_gen_sequential <- function(palette = "seq_5_main", direction = 1, ...) { - - if (abs(direction) != 1) rlang::abort("Direction must be either 1 or -1.") + if (abs(direction) != 1) { + rlang::abort("Direction must be either 1 or -1.") + } pal <- palette(palette) diff --git a/R/point.R b/R/point.R index 091edff..e4dab31 100644 --- a/R/point.R +++ b/R/point.R @@ -52,22 +52,23 @@ point <- function( 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)) - + 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) @@ -76,57 +77,69 @@ point <- function( # 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.")) - - + 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.") + 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]])),] + 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) - ) + 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( + g <- g + + ggplot2::labs( title = title, subtitle = subtitle, caption = caption, @@ -134,54 +147,66 @@ point <- function( 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 <- g + ggplot2::facet_grid( - cols = ggplot2::vars(!!rlang::sym(facet)), - scales = facet_scales, - space = if(facet_scales == "free") "free_x" else "fixed" - ) + # 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 <- g + + ggplot2::facet_grid( + cols = ggplot2::vars(!!rlang::sym(facet)), + scales = facet_scales, + space = if (facet_scales == "free") "free_x" else "fixed" + ) + } } -} - + # 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() } - + # 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 - if (!is.null(theme_fun)) g <- g + theme_fun - + if (!is.null(theme_fun)) { + 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 - + if (!is.null(scale_fill_fun)) { + g <- g + scale_fill_fun + } + + if (!is.null(scale_color_fun)) { + g <- g + scale_color_fun + } + return(g) } diff --git a/R/reorder_by.R b/R/reorder_by.R index d0d3adc..cd6df24 100644 --- a/R/reorder_by.R +++ b/R/reorder_by.R @@ -1,31 +1,30 @@ #' 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. #' @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_by(df, "col1", "col2") -#' +#' #' @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 # df is a data frame @@ -39,15 +38,17 @@ reorder_by <- function(df, x, y, group = "", order = "y", dir_order = 1){ # group is character scalar and in df if not empty 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") 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 + #------ Reorder # droplevels first if (is.factor(df[[x]])) { diff --git a/R/scale.R b/R/scale.R index 78ccffa..0d6382c 100644 --- a/R/scale.R +++ b/R/scale.R @@ -8,8 +8,13 @@ #' @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, title_position = NULL, ...) { - +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", @@ -41,8 +46,13 @@ 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, title_position = NULL, ...) { - +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", @@ -74,8 +84,13 @@ 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, title_position = NULL, ...) { - +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) @@ -100,15 +115,21 @@ scale_fill_visualizer_continuous <- function(palette = "seq_5_main", direction = # 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, title_position = NULL, ...) { - +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) @@ -133,6 +154,7 @@ scale_color_visualizer_continuous <- function(palette = "seq_5_main", direction # ticks.colour = "#F1F3F5", reverse = reverse_guide ), - ....) + .... + ) } -} \ No newline at end of file +} diff --git a/R/theme_bar.R b/R/theme_bar.R index bb52592..1494c68 100644 --- a/R/theme_bar.R +++ b/R/theme_bar.R @@ -5,10 +5,15 @@ #' @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) { - +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){ + if (!flip && !add_text) { par_axis_text_font_face <- "plain" par_axis_x <- 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_minor_y <- TRUE par_grid_minor_x <- FALSE - } else if (flip && !add_text){ + } else if (flip && !add_text) { par_axis_text_font_face <- "plain" par_axis_x <- 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_minor_y <- FALSE par_grid_minor_x <- TRUE - } else if (!flip && add_text){ + } else if (!flip && add_text) { par_axis_text_font_face <- "bold" par_axis_x <- 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_minor_y <- FALSE par_grid_minor_x <- FALSE - } else if (flip && add_text){ + } else if (flip && add_text) { par_axis_text_font_face <- "bold" par_axis_x <- TRUE par_axis_y <- TRUE @@ -68,22 +73,22 @@ theme_bar <- function(flip = TRUE, add_text = FALSE, axis_text_x_angle = 0, axis # Theme t <- theme_default( - 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 + 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 ) return(t) diff --git a/R/theme_default.R b/R/theme_default.R index 66cc29a..e8f9853 100644 --- a/R/theme_default.R +++ b/R/theme_default.R @@ -129,78 +129,80 @@ theme_default <- function( caption_position_to_plot = TRUE, caption_size = 12, caption_color = color("dark_grey"), - ...) { + ... +) { # Basic simple theme theme <- ggplot2::theme_minimal() - theme <- theme + ggplot2::theme( - # # Text - design - text = ggplot2::element_text( - family = text_font_family, - color = text_color, - size = text_size, - face = text_font_face - ), - # Default legend to right position - legend.position = legend_position, - # Defaut legend to vertical direction - legend.direction = legend_direction, - # Text sizes - axis.text = ggplot2::element_text( - size = axis_text_size, - family = axis_text_font_family, - face = axis_text_font_face, - color = axis_text_color - ), - axis.title = ggplot2::element_text( - size = axis_title_size, - family = axis_text_font_family, - face = axis_title_font_face, - color = axis_title_color - ), - # # Wrap title - plot.title = ggtext::element_textbox_simple( - hjust = title_hjust, - family = title_font_family, - color = title_color, - size = title_size, - face = title_font_face, - width = grid::unit(0.9, "npc"), - margin = ggplot2::margin(b = 10) - ), - plot.subtitle = ggtext::element_textbox_simple( - hjust = title_hjust, - family = subtitle_font_family, - color = subtitle_color, - size = subtitle_size, - face = subtitle_font_face, - margin = ggplot2::margin(t = 5, b = 10) - ), - plot.caption = ggtext::element_textbox_simple( - size = caption_size, - face = caption_font_face, - family = caption_font_family, - color = caption_color, - margin = ggplot2::margin(t = 10) - ), - 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, - hjust = axis_text_x_hjust + theme <- theme + + ggplot2::theme( + # # Text - design + text = ggplot2::element_text( + family = text_font_family, + color = text_color, + size = text_size, + face = text_font_face + ), + # Default legend to right position + legend.position = legend_position, + # Defaut legend to vertical direction + legend.direction = legend_direction, + # Text sizes + axis.text = ggplot2::element_text( + size = axis_text_size, + family = axis_text_font_family, + face = axis_text_font_face, + color = axis_text_color + ), + axis.title = ggplot2::element_text( + size = axis_title_size, + family = axis_text_font_family, + face = axis_title_font_face, + color = axis_title_color + ), + # # Wrap title + plot.title = ggtext::element_textbox_simple( + hjust = title_hjust, + family = title_font_family, + color = title_color, + size = title_size, + face = title_font_face, + width = grid::unit(0.9, "npc"), + margin = ggplot2::margin(b = 10) + ), + plot.subtitle = ggtext::element_textbox_simple( + hjust = title_hjust, + family = subtitle_font_family, + color = subtitle_color, + size = subtitle_size, + face = subtitle_font_face, + margin = ggplot2::margin(t = 5, b = 10) + ), + plot.caption = ggtext::element_textbox_simple( + size = caption_size, + face = caption_font_face, + family = caption_font_family, + color = caption_color, + margin = ggplot2::margin(t = 10) + ), + 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, + hjust = axis_text_x_hjust + ) ) - ) # Position of title if (title_position_to_plot) { @@ -362,22 +364,22 @@ theme_default <- function( } # Add facet title text size - theme <- theme + ggplot2::theme( - strip.text = ggplot2::element_text( - size = facet_size, - family = facet_font_family, - face = facet_font_face, - color = facet_color - ), - strip.background = ggplot2::element_rect( - fill = facet_bg_color, - linewidth = 0 + theme <- theme + + ggplot2::theme( + strip.text = ggplot2::element_text( + size = facet_size, + family = facet_font_family, + face = facet_font_face, + color = facet_color + ), + strip.background = ggplot2::element_rect( + fill = facet_bg_color, + linewidth = 0 + ) ) - ) - + # Other parameters theme <- theme + ggplot2::theme(...) - return(theme) } diff --git a/R/theme_dumbbell.R b/R/theme_dumbbell.R index 5b2fe44..21a0eae 100644 --- a/R/theme_dumbbell.R +++ b/R/theme_dumbbell.R @@ -8,6 +8,6 @@ theme_dumbbell <- function() { theme_default( axis_line_x = TRUE, - grid_) + grid_ + ) } - diff --git a/R/theme_point.R b/R/theme_point.R index 021ed24..5ce0ba6 100644 --- a/R/theme_point.R +++ b/R/theme_point.R @@ -10,22 +10,21 @@ #' @return A custom theme object. #' #' @export -theme_point <- function( -) { +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 + 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)