Air formatting
This commit is contained in:
parent
a4f398ab3d
commit
ead630c106
13 changed files with 816 additions and 640 deletions
398
R/bar.R
398
R/bar.R
|
|
@ -3,7 +3,12 @@
|
|||
#' @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, ...)
|
||||
}
|
||||
|
||||
|
|
@ -92,101 +97,125 @@ bar <- 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)
|
||||
|
||||
#------ 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
|
||||
checkmate::assert_data_frame(df)
|
||||
# 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 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_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)
|
||||
|
||||
# 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))
|
||||
# flip is a logical scalar
|
||||
checkmate::assert_logical(flip, len = 1)
|
||||
|
||||
# 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)
|
||||
# wrap is a numeric scalar or NULL
|
||||
if (!is.null(wrap)) {
|
||||
checkmate::assert_numeric(wrap, len = 1, null.ok = TRUE)
|
||||
}
|
||||
|
||||
# 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)
|
||||
|
||||
# wrap is a numeric scalar or NULL
|
||||
if (!is.null(wrap)) checkmate::assert_numeric(wrap, len = 1, null.ok = TRUE)
|
||||
# add_text is a logical scalar
|
||||
checkmate::assert_logical(add_text, len = 1)
|
||||
|
||||
# alpha is a numeric scalar between 0 and 1
|
||||
checkmate::assert_numeric(alpha, lower = 0, upper = 1, len = 1)
|
||||
# add_text_size is a numeric scalar
|
||||
checkmate::assert_numeric(add_text_size, len = 1)
|
||||
|
||||
# add_text is a logical scalar
|
||||
checkmate::assert_logical(add_text, 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_size is a numeric scalar
|
||||
checkmate::assert_numeric(add_text_size, len = 1)
|
||||
# add_text_threshold_display is a numeric scalar
|
||||
checkmate::assert_numeric(add_text_threshold_display, 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_suffix is a character scalar
|
||||
checkmate::assert_character(add_text_suffix, len = 1)
|
||||
|
||||
# add_text_threshold_display is a numeric scalar
|
||||
checkmate::assert_numeric(add_text_threshold_display, len = 1)
|
||||
# add_text_expand_limit is a numeric scalar
|
||||
checkmate::assert_numeric(add_text_expand_limit, len = 1)
|
||||
|
||||
# add_text_suffix is a character scalar
|
||||
checkmate::assert_character(add_text_suffix, len = 1)
|
||||
# add_text_round is a numeric scalar
|
||||
checkmate::assert_numeric(add_text_round, len = 1)
|
||||
|
||||
# add_text_expand_limit is a numeric scalar
|
||||
checkmate::assert_numeric(add_text_expand_limit, 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"))
|
||||
}
|
||||
|
||||
# add_text_round is a numeric scalar
|
||||
checkmate::assert_numeric(add_text_round, len = 1)
|
||||
# width is a numeric scalar between 0 and 1
|
||||
checkmate::assert_numeric(width, lower = 0, upper = 1, 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"))
|
||||
# Check if position is stack or dodge
|
||||
if (position %notin% c("stack", "dodge")) {
|
||||
rlang::abort("Position should be either 'stack' or 'dodge'.")
|
||||
}
|
||||
|
||||
# Check if position is stack or dodge
|
||||
if (position %notin% c("stack", "dodge")) rlang::abort("Position should be either 'stack' or 'dodge'.")
|
||||
#----- Data wrangling
|
||||
|
||||
#----- 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.")
|
||||
}
|
||||
}
|
||||
|
||||
# remove NAs using base R
|
||||
if (x_rm_na) df <- df[!(is.na(df[[x]])),]
|
||||
if (y_rm_na) df <- df[!(is.na(df[[y]])),]
|
||||
if (group != "" && group_rm_na) df <- df[!(is.na(df[[group]])),]
|
||||
if (facet != "" && facet_rm_na) df <- df[!(is.na(df[[facet]])),]
|
||||
# remove NAs using 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")) {
|
||||
# reorder
|
||||
dir_order <- if (flip && order %in% c("x", "grouped_x")) {
|
||||
-1
|
||||
} else if (!flip && order %in% c("x", "grouped_x")) {
|
||||
} else if (!flip && order %in% c("x", "grouped_x")) {
|
||||
1
|
||||
} else if (flip) {
|
||||
} else if (flip) {
|
||||
1
|
||||
} else {
|
||||
} else {
|
||||
-1
|
||||
}
|
||||
group_order <- if (group != "" || (group == "" && facet == "")) {
|
||||
}
|
||||
group_order <- if (group != "" || (group == "" && facet == "")) {
|
||||
group
|
||||
} else if (group == "" && facet != "") {
|
||||
} 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 != "") {
|
||||
}
|
||||
df <- reorder_by(
|
||||
df = df,
|
||||
x = x,
|
||||
y = y,
|
||||
group = group_order,
|
||||
order = order,
|
||||
dir_order = dir_order
|
||||
)
|
||||
|
||||
# prepare aes
|
||||
if (group != "") {
|
||||
g <- ggplot2::ggplot(
|
||||
df,
|
||||
mapping = ggplot2::aes(
|
||||
|
|
@ -196,9 +225,7 @@ if(group != "") {
|
|||
color = !!rlang::sym(group)
|
||||
)
|
||||
)
|
||||
|
||||
} else {
|
||||
|
||||
} else {
|
||||
g <- ggplot2::ggplot(
|
||||
df,
|
||||
mapping = ggplot2::aes(
|
||||
|
|
@ -206,10 +233,11 @@ if(group != "") {
|
|||
y = !!rlang::sym(y)
|
||||
)
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
# add title, subtitle, caption, x_title, y_title
|
||||
g <- g + ggplot2::labs(
|
||||
# add title, subtitle, caption, x_title, y_title
|
||||
g <- g +
|
||||
ggplot2::labs(
|
||||
title = title,
|
||||
subtitle = subtitle,
|
||||
caption = caption,
|
||||
|
|
@ -217,106 +245,113 @@ g <- g + ggplot2::labs(
|
|||
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")
|
||||
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")
|
||||
g <- g +
|
||||
ggplot2::facet_grid(
|
||||
cols = ggplot2::vars(!!rlang::sym(facet)),
|
||||
scales = "free",
|
||||
space = "free_x"
|
||||
)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# 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(
|
||||
# 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(
|
||||
} else if (position == "dodge") {
|
||||
g <- g +
|
||||
ggplot2::geom_col(
|
||||
alpha = alpha,
|
||||
width = width,
|
||||
position = ggplot2::position_dodge2(
|
||||
width = dodge_width,
|
||||
preserve = "single")
|
||||
preserve = "single"
|
||||
)
|
||||
} else{
|
||||
g <- g + ggplot2::geom_col(
|
||||
)
|
||||
} else {
|
||||
g <- g +
|
||||
ggplot2::geom_col(
|
||||
alpha = alpha,
|
||||
width = width
|
||||
)
|
||||
}
|
||||
|
||||
} else {
|
||||
|
||||
if (position == "stack"){
|
||||
g <- g + ggplot2::geom_col(
|
||||
} 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(
|
||||
} else if (position == "dodge") {
|
||||
g <- g +
|
||||
ggplot2::geom_col(
|
||||
alpha = alpha,
|
||||
width = width,
|
||||
position = ggplot2::position_dodge2(
|
||||
width = dodge_width,
|
||||
preserve = "single"),
|
||||
preserve = "single"
|
||||
),
|
||||
fill = add_color,
|
||||
color = add_color
|
||||
)
|
||||
} else {
|
||||
g <- g + ggplot2::geom_col(
|
||||
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)) {
|
||||
# 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
|
||||
}
|
||||
|
||||
# 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) {
|
||||
# function for interaction
|
||||
interaction_f <- function(group, facet, data) {
|
||||
if (group == "" && facet == "") {
|
||||
return(NULL)
|
||||
} else if (group != "" && facet != "") {
|
||||
|
|
@ -328,16 +363,22 @@ interaction_f <- function(group, facet, data) {
|
|||
} 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 ))
|
||||
# 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(
|
||||
g <- g +
|
||||
ggplot2::geom_blank(
|
||||
data = df,
|
||||
ggplot2::aes(
|
||||
x = !!rlang::sym(x),
|
||||
|
|
@ -345,28 +386,18 @@ if (add_text & position == "dodge") {
|
|||
group = interaction_f(group, facet, df)
|
||||
)
|
||||
)
|
||||
g <- g + ggplot2::geom_text(
|
||||
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)
|
||||
label = ifelse(
|
||||
is.na(!!rlang::sym("y_threshold")),
|
||||
NA,
|
||||
paste0(
|
||||
round(!!rlang::sym("y_threshold"), add_text_round),
|
||||
add_text_suffix
|
||||
)
|
||||
|
||||
} 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,
|
||||
|
|
@ -376,7 +407,37 @@ if (add_text & position == "dodge") {
|
|||
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)
|
||||
),
|
||||
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
|
||||
|
|
@ -389,19 +450,28 @@ if (add_text & position == "dodge") {
|
|||
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
|
||||
# # # 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_color_fun)) {
|
||||
g <- g + scale_color_fun
|
||||
}
|
||||
|
||||
return(g)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
))
|
||||
}
|
||||
}
|
||||
|
|
|
|||
122
R/color.R
122
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
|
||||
|
|
|
|||
54
R/dumbbell.R
54
R/dumbbell.R
|
|
@ -29,7 +29,8 @@
|
|||
#' @return A dumbbell chart.
|
||||
#' @export
|
||||
#'
|
||||
dumbbell <- function(df,
|
||||
dumbbell <- function(
|
||||
df,
|
||||
col,
|
||||
group_x,
|
||||
group_y,
|
||||
|
|
@ -53,8 +54,8 @@ dumbbell <- function(df,
|
|||
add_text_color = color("dark_grey"),
|
||||
theme_fun = theme_dumbbell(),
|
||||
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
|
||||
|
|
@ -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,11 +131,13 @@ 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
|
||||
|
|
@ -132,7 +147,8 @@ dumbbell <- function(df,
|
|||
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,7 +168,8 @@ dumbbell <- function(df,
|
|||
)
|
||||
|
||||
# Add title, subtitle, caption, x_title, y_title
|
||||
g <- g + ggplot2::labs(
|
||||
g <- g +
|
||||
ggplot2::labs(
|
||||
title = title,
|
||||
subtitle = subtitle,
|
||||
caption = caption,
|
||||
|
|
@ -163,7 +180,8 @@ dumbbell <- function(df,
|
|||
)
|
||||
|
||||
# Add stat labels to points
|
||||
if(add_text) g <- g +
|
||||
if (add_text) {
|
||||
g <- g +
|
||||
ggrepel::geom_text_repel(
|
||||
data = df,
|
||||
ggplot2::aes(
|
||||
|
|
@ -175,15 +193,19 @@ dumbbell <- function(df,
|
|||
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)
|
||||
|
||||
}
|
||||
|
|
|
|||
53
R/palette.R
53
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)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
71
R/point.R
71
R/point.R
|
|
@ -52,7 +52,6 @@ point <- function(
|
|||
scale_fill_fun = scale_fill_visualizer_discrete(),
|
||||
scale_color_fun = scale_color_visualizer_discrete()
|
||||
) {
|
||||
|
||||
#------ Checks
|
||||
|
||||
# df is a data frame
|
||||
|
|
@ -66,7 +65,9 @@ point <- function(
|
|||
# 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)
|
||||
|
|
@ -87,9 +88,12 @@ point <- function(
|
|||
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
|
||||
|
||||
|
|
@ -99,10 +103,18 @@ point <- function(
|
|||
}
|
||||
|
||||
# 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 != "") {
|
||||
|
|
@ -126,7 +138,8 @@ point <- function(
|
|||
}
|
||||
|
||||
# add title, subtitle, caption, x_title, y_title
|
||||
g <- g + ggplot2::labs(
|
||||
g <- g +
|
||||
ggplot2::labs(
|
||||
title = title,
|
||||
subtitle = subtitle,
|
||||
caption = caption,
|
||||
|
|
@ -137,31 +150,35 @@ point <- function(
|
|||
)
|
||||
|
||||
# facets
|
||||
# facets
|
||||
if (facet != "") {
|
||||
# facets
|
||||
if (facet != "") {
|
||||
if (flip) {
|
||||
g <- g + ggplot2::facet_grid(
|
||||
g <- g +
|
||||
ggplot2::facet_grid(
|
||||
rows = ggplot2::vars(!!rlang::sym(facet)),
|
||||
scales = facet_scales,
|
||||
space = if(facet_scales == "free") "free_y" else "fixed"
|
||||
space = if (facet_scales == "free") "free_y" else "fixed"
|
||||
)
|
||||
} else {
|
||||
g <- g + ggplot2::facet_grid(
|
||||
g <- g +
|
||||
ggplot2::facet_grid(
|
||||
cols = ggplot2::vars(!!rlang::sym(facet)),
|
||||
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?
|
||||
if (group != "") {
|
||||
g <- g + ggplot2::geom_point(
|
||||
g <- g +
|
||||
ggplot2::geom_point(
|
||||
alpha = alpha,
|
||||
size = size
|
||||
)
|
||||
} else {
|
||||
g <- g + ggplot2::geom_point(
|
||||
g <- g +
|
||||
ggplot2::geom_point(
|
||||
alpha = alpha,
|
||||
size = size,
|
||||
color = add_color
|
||||
|
|
@ -173,15 +190,23 @@ if (facet != "") {
|
|||
}
|
||||
|
||||
# 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_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)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -24,8 +24,7 @@
|
|||
#' 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,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
|
||||
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"))
|
||||
|
|
|
|||
42
R/scale.R
42
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
|
||||
),
|
||||
....)
|
||||
....
|
||||
)
|
||||
}
|
||||
}
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -129,11 +129,13 @@ 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(
|
||||
theme <- theme +
|
||||
ggplot2::theme(
|
||||
# # Text - design
|
||||
text = ggplot2::element_text(
|
||||
family = text_font_family,
|
||||
|
|
@ -362,7 +364,8 @@ theme_default <- function(
|
|||
}
|
||||
|
||||
# Add facet title text size
|
||||
theme <- theme + ggplot2::theme(
|
||||
theme <- theme +
|
||||
ggplot2::theme(
|
||||
strip.text = ggplot2::element_text(
|
||||
size = facet_size,
|
||||
family = facet_font_family,
|
||||
|
|
@ -378,6 +381,5 @@ theme_default <- function(
|
|||
# Other parameters
|
||||
theme <- theme + ggplot2::theme(...)
|
||||
|
||||
|
||||
return(theme)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -8,6 +8,6 @@
|
|||
theme_dumbbell <- function() {
|
||||
theme_default(
|
||||
axis_line_x = TRUE,
|
||||
grid_)
|
||||
grid_
|
||||
)
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -10,8 +10,7 @@
|
|||
#' @return A custom theme object.
|
||||
#'
|
||||
#' @export
|
||||
theme_point <- function(
|
||||
) {
|
||||
theme_point <- function() {
|
||||
t <- theme_default(
|
||||
axis_text_font_face = "plain",
|
||||
axis_x = TRUE,
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue