diff --git a/.gitignore b/.gitignore index ecb1ef1..c2fca79 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,7 @@ -.Rproj.user -.Rhistory -.Rdata -.httr-oauth -.DS_Store +.Rproj.user +.Rhistory +.Rdata +.httr-oauth +.DS_Store R/test.R +inst/doc diff --git a/DESCRIPTION b/DESCRIPTION index 258f9b0..fd02013 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: visualizeR Type: Package Title: What a color! What a viz! -Version: 0.8.9000 +Version: 1.0 Authors@R: c( person( 'Noblet', 'Guillaume', @@ -32,11 +32,13 @@ Imports: viridisLite, waffle, stringr, - checkmate, - data.table + checkmate Suggests: knitr, + rmarkdown, roxygen2, - sf, - tmap + rio, + testthat (>= 3.0.0), + vdiffr VignetteBuilder: knitr +Config/testthat/edition: 3 diff --git a/R/bar.R b/R/bar.R index b2da2ec..bf4097f 100644 --- a/R/bar.R +++ b/R/bar.R @@ -3,11 +3,13 @@ #' @inheritParams bar #' #' @export -hbar <- function(...) bar(flip = TRUE, theme_fun = theme_bar(flip = TRUE, add_text = FALSE), ...) +hbar <- function(..., flip = TRUE, add_text = FALSE, theme_fun = theme_bar(flip = flip, add_text = add_text)) { + bar(flip = flip, add_text = add_text, theme_fun = theme_fun, ...) +} #' Simple bar chart #' -#' [bar()] is a simple bar chart with some customization allowed, in particular the `theme_fun` argument for theming. [hbar()] uses [bar()] with sane defaults for a horizontal bar chart. +#' `bar()` is a simple bar chart with some customization allowed, in particular the `theme_fun` argument for theming. `hbar()` uses `bar()` with sane defaults for a horizontal bar chart. #' #' @param df A data frame. #' @param x A quoted numeric column. @@ -18,7 +20,10 @@ hbar <- function(...) bar(flip = TRUE, theme_fun = theme_bar(flip = TRUE, add_te #' @param x_rm_na Remove NAs in x? #' @param y_rm_na Remove NAs in y? #' @param group_rm_na Remove NAs in group? +#' @param facet_rm_na Remove NAs in facet? +#' @param y_expand Multiplier to expand the y axis. #' @param add_color Add a color to bars (if no grouping). +#' @param add_color_guide Should a legend be added? #' @param flip TRUE or FALSE (default). Default to TRUE or horizontal bar plot. #' @param wrap Should x-labels be wrapped? Number of characters. #' @param position Should the chart be stacked? Default to "dodge". Can take "dodge" and "stack". @@ -36,11 +41,13 @@ hbar <- function(...) bar(flip = TRUE, theme_fun = theme_bar(flip = TRUE, add_te #' @param add_text_font_face Text font_face. #' @param add_text_threshold_display Minimum value to add the text label. #' @param add_text_suffix If percent is FALSE, should we add a suffix to the text label? -#' @param add_text_expand_limit Default to adding 10% on top of the bar. +#' @param add_text_expand_limit Default to adding 10\% on top of the bar. #' @param add_text_round Round the text label. #' @param theme_fun Whatever theme function. For no custom theme, use theme_fun = NULL. #' -#' @inheritParams reorder +#' @inheritParams reorder_by +#' +#' @importFrom rlang `:=` #' #' @export bar <- function( @@ -54,7 +61,9 @@ bar <- function( y_rm_na = TRUE, group_rm_na = TRUE, facet_rm_na = TRUE, + y_expand = 0.1, add_color = color("cat_5_main_1"), + add_color_guide = TRUE, flip = FALSE, wrap = NULL, position = "dodge", @@ -65,24 +74,24 @@ bar <- function( title = NULL, subtitle = NULL, caption = NULL, - width = 0.7, + width = 0.8, add_text = FALSE, - add_text_size = 4, + add_text_size = 4.5, add_text_color = color("dark_grey"), - add_text_font_face = "plain", + add_text_font_face = "bold", add_text_threshold_display = 0.05, add_text_suffix = "%", add_text_expand_limit = 1.2, add_text_round = 1, theme_fun = theme_bar( - flip = FALSE, - add_text = FALSE, - axis_text_x_angle = 45, - axis_text_x_vjust = 1, - axis_text_x_hjust = 1 + flip = flip, + add_text = add_text, + axis_text_x_angle = 0, + axis_text_x_vjust = 0.5, + axis_text_x_hjust = 0.5 ), - scale_fill_fun = scale_fill_impact_discrete, - scale_color_fun = scale_color_impact_discrete + scale_fill_fun = scale_fill_visualizer_discrete(), + scale_color_fun = scale_color_visualizer_discrete() ){ @@ -105,10 +114,26 @@ if (group != "") checkmate::assert_choice(group, colnames(df)) checkmate::assert_logical(x_rm_na, len = 1) checkmate::assert_logical(y_rm_na, len = 1) checkmate::assert_logical(group_rm_na, len = 1) +checkmate::assert_logical(facet_rm_na, len = 1) # flip is a logical scalar checkmate::assert_logical(flip, len = 1) +# wrap is a numeric scalar or NULL +if (!is.null(wrap)) checkmate::assert_numeric(wrap, len = 1, null.ok = TRUE) + +# alpha is a numeric scalar between 0 and 1 +checkmate::assert_numeric(alpha, lower = 0, upper = 1, len = 1) + +# add_text is a logical scalar +checkmate::assert_logical(add_text, len = 1) + +# add_text_size is a numeric scalar +checkmate::assert_numeric(add_text_size, len = 1) + +# add_text_font_face is a character scalar in bold plain or italic +checkmate::assert_choice(add_text_font_face, c("bold", "plain", "italic")) + # add_text_threshold_display is a numeric scalar checkmate::assert_numeric(add_text_threshold_display, len = 1) @@ -121,8 +146,7 @@ checkmate::assert_numeric(add_text_expand_limit, len = 1) # add_text_round is a numeric scalar checkmate::assert_numeric(add_text_round, len = 1) - -# Check if numeric and character +# x and y are numeric or character if (class(df[[y]]) %notin% c("integer", "numeric")) rlang::abort(paste0(y, " must be numeric.")) if (!any(class(df[[x]]) %in% c("character", "factor"))) rlang::abort(paste0(x, " must be character or factor")) @@ -131,22 +155,36 @@ if (position %notin% c("stack", "dodge")) rlang::abort("Position should be eithe #----- Data wrangling -# want to use df as a data.table -if (!checkmate::test_data_table(df)) { - rlang::warn("Converting df to data.table.") - data.table::setDT(df) +# facets over group +if (group != "" && facet != "" && group == facet) { + rlang::warn("'group' and 'facet' are the same identical.") } + +# remove NAs using base R +if (x_rm_na) df <- df[!(is.na(df[[x]])),] +if (y_rm_na) df <- df[!(is.na(df[[y]])),] +if (group != "" && group_rm_na) df <- df[!(is.na(df[[group]])),] +if (facet != "" && facet_rm_na) df <- df[!(is.na(df[[facet]])),] + -# Remove NAs using data.table -if (x_rm_na) df[, (x) := na.omit(get(x))] -if (y_rm_na) df[, (y) := na.omit(get(y))] -if (group != "" && group_rm_na) df[, (group) := na.omit(get(group))] +# reorder +dir_order <- if(flip && order %in% c("x", "grouped_x")) { + -1 +} else if (!flip && order %in% c("x", "grouped_x")) { + 1 +} else if (flip) { + 1 +} else { + -1 +} +group_order <- if (group != "" || (group == "" && facet == "")) { + group +} else if (group == "" && facet != "") { + facet +} +df <- reorder_by(df = df, x = x, y = y, group = group_order, order = order, dir_order = dir_order) -# Reorder -dir_order = ifelse(flip, 1, -1) -df <- reorder(df, x, y, group, order, dir_order) - -# Prepare aes +# prepare aes if(group != "") { g <- ggplot2::ggplot( @@ -170,7 +208,7 @@ if(group != "") { ) } -# Add title, subtitle, caption, x_title, y_title +# add title, subtitle, caption, x_title, y_title g <- g + ggplot2::labs( title = title, subtitle = subtitle, @@ -181,14 +219,19 @@ g <- g + ggplot2::labs( fill = group_title ) -# Width +# width width <- width dodge_width <- width -#Facets +# facets if (facet != "") { - g <- g + ggforce::facet_row(facet, scales = "free_x", space = "free") + if (flip) { + g <- g + ggplot2::facet_grid(rows = ggplot2::vars(!!rlang::sym(facet)), scales = "free", space = "free_y") + } else { + g <- g + ggplot2::facet_grid(cols = ggplot2::vars(!!rlang::sym(facet)), scales = "free", space = "free_x") + } } + # Guides for legend # g <- g + ggplot2::guides( @@ -206,7 +249,7 @@ if (facet != "") { # direction = "horizontal") # ) -# Should the graph use position_fill? +# should the graph use position_fill? if(group != "") { if (position == "stack"){ @@ -260,35 +303,53 @@ if(group != "") { } } -# Wrap labels on the x scale? +# wrap labels on the x scale? if (!is.null(wrap)) { g <- g + ggplot2::scale_x_discrete(labels = scales::label_wrap(wrap)) } -# Because a text legend should always be horizontal, especially for an horizontal bar graph +# because a text legend should always be horizontal, especially for an horizontal bar graph if (flip) g <- g + ggplot2::coord_flip() # Add text to bars if (flip) hjust_flip <- -0.5 else hjust_flip <- 0.5 if (flip) vjust_flip <- 0.5 else vjust_flip <- -0.5 +# Function for interaction +interaction_f <- function(group, facet, data) { + if (group == "" && facet == "") { + return(NULL) + } else if (group != "" && facet != "") { + return(interaction(data[[group]], data[[facet]])) + } else if (group != "") { + return(data[[group]]) + } else if (facet != "") { + return(data[[facet]]) + } else { + return(NULL) + } +} -# Add text labels + +# add text labels if (add_text & position == "dodge") { df <- dplyr::mutate(df, "y_threshold" := ifelse(!!rlang::sym(y) >= add_text_threshold_display, !!rlang::sym(y), NA )) - # Expand limits + # expand limits g <- g + ggplot2::geom_blank( data = df, - ggplot2::aes(x = !!rlang::sym(x), y = !!rlang::sym(y) * add_text_expand_limit, group = !!rlang::sym(group)) + ggplot2::aes( + x = !!rlang::sym(x), + y = !!rlang::sym(y) * add_text_expand_limit, + group = interaction_f(group, facet, df) + ) ) - g <- g + ggplot2::geom_text( data = df, ggplot2::aes( label = ifelse(is.na(!!rlang::sym("y_threshold")), NA, paste0(round(!!rlang::sym("y_threshold"), add_text_round), add_text_suffix)), - group = !!rlang::sym(group)), + group = interaction_f(group, facet, df)), hjust = hjust_flip, vjust = vjust_flip, color = add_text_color, @@ -304,12 +365,16 @@ if (add_text & position == "dodge") { g <- g + ggplot2::geom_text( data = df, ggplot2::aes( - label = ifelse(is.na(!!rlang::sym("y_threshold")), NA, paste0(round(!!rlang::sym("y_threshold"), add_text_round), add_text_suffix)), - group = !!rlang::sym(group)), + label = ifelse(is.na(!!rlang::sym("y_threshold")), NA, + paste0(round(!!rlang::sym("y_threshold"), add_text_round), add_text_suffix)), + group = interaction_f(group, facet, df) + ), + hjust = hjust_flip, + vjust = vjust_flip, color = add_text_color, fontface = add_text_font_face, size = add_text_size, - position = ggplot2::position_stack(vjust = 0.5) + position = ggplot2::position_dodge2(width = dodge_width) ) } @@ -318,7 +383,7 @@ if (add_text & position == "dodge") { g <- g + ggplot2::scale_y_continuous( # start at 0 - expand = c(0, 0), + expand = ggplot2::expansion(mult = c(0, y_expand)), # remove trailing 0 and choose accuracy of y labels labels = scales::label_number( accuracy = 0.1, @@ -327,9 +392,16 @@ if (add_text & position == "dodge") { decimal.mark = "."), ) + # Remove guides for legend if !add_color_guide + if (!add_color_guide) g <- g + ggplot2::guides(fill = "none", color = "none") + # Add theme fun if (!is.null(theme_fun)) g <- g + theme_fun -return(g) + # Add scale fun + if (!is.null(scale_fill_fun)) g <- g + scale_fill_fun + + if (!is.null(scale_color_fun)) g <- g + scale_color_fun + + return(g) } - \ No newline at end of file diff --git a/R/color.R b/R/color.R index 39cefb9..69f3740 100644 --- a/R/color.R +++ b/R/color.R @@ -25,8 +25,11 @@ color <- function(..., unname = TRUE) { # Defined colors colors <- c( white = "#FFFFFF" + , lighter_grey = "#F5F5F5" , light_grey = "#E3E3E3" , dark_grey = "#464647" + , light_blue_grey = "#B3C6D1" + , grey = "#71716F" , black = "#000000" , cat_2_yellow_1 = "#ffc20a" , cat_2_yellow_2 = "#0c7bdc" @@ -46,7 +49,7 @@ color <- function(..., unname = TRUE) { , seq_5_main_3 = "#6b8bad" , seq_5_main_4 = "#9cb1c9" , seq_5_main_5 = "#ced8e4" - , cat_5_ibm_1 = "#648fff" + , cat_5_ibm_1 = "#648fff" , cat_5_ibm_2 = "#785ef0" , cat_5_ibm_3 = "#dc267f" , cat_5_ibm_4 = "#fe6100" @@ -96,7 +99,7 @@ color <- function(..., unname = TRUE) { if (is.null(cols)) { cols_to_return <- colors - } else { + } else { cols_to_return <- colors[cols] } diff --git a/R/dumbbell.R b/R/dumbbell.R new file mode 100644 index 0000000..eaf59bc --- /dev/null +++ b/R/dumbbell.R @@ -0,0 +1,189 @@ +#' Make dumbbell chart. +#' +#' @param df A data frame. +#' @param col A numeric column. +#' @param group_x The grouping column on the x-axis; only two groups. +#' @param group_y The grouping column on the y-axis. +#' @param point_size Point size. +#' @param point_alpha Point alpha. +#' @param segment_size Segment size. +#' @param segment_color Segment color. +#' @param group_x_title X-group and legend title. +#' @param group_y_title Y-axis and group title. +#' @param x_title X-axis title. +#' @param title Title. +#' @param subtitle Subtitle. +#' @param caption Caption. +#' @param line_to_y_axis TRUE or FALSE; add a line connected points and Y-axis. +#' @param line_to_y_axis_type Line to Y-axis type. +#' @param line_to_y_axis_width Line to Y-axis width. +#' @param line_to_y_axis_color Line to Y-axis color. +#' @param add_text TRUE or FALSE; add text at the points. +#' @param add_text_vjust Vertical adjustment. +#' @param add_text_size Text size. +#' @param add_text_color Text color. +#' @param theme_fun A ggplot2 theme, default to `theme_dumbbell()` +#' @param scale_fill_fun A ggplot2 scale_fill function, default to `scale_fill_visualizer_discrete()` +#' @param scale_color_fun A ggplot2 scale_color function, default to `scale_color_visualizer_discrete()` +#' +#' @return A dumbbell chart. +#' @export +#' +dumbbell <- function(df, + col, + group_x, + group_y, + point_size = 5, + point_alpha = 1, + segment_size = 2.5, + segment_color = color("light_blue_grey"), + group_x_title = NULL, + group_y_title = NULL, + x_title = NULL, + title = NULL, + subtitle = NULL, + caption = NULL, + line_to_y_axis = FALSE, + line_to_y_axis_type = 3, + line_to_y_axis_width = 0.5, + line_to_y_axis_color = color("dark_grey"), + add_text = FALSE, + add_text_vjust = 2, + add_text_size = 3.5, + add_text_color = color("dark_grey"), + theme_fun = theme_dumbbell(), + scale_fill_fun = scale_fill_visualizer_discrete(), + scale_color_fun = scale_color_visualizer_discrete()){ + + #------ Checks + + # df is a data frame + checkmate::assert_data_frame(df) + + # col, group_x, group_y are character + checkmate::assert_character(col, len = 1) + checkmate::assert_character(group_x, len = 1) + checkmate::assert_character(group_y, len = 1) + + # col, group_x, group_y are columns in df + checkmate::assert_choice(col, colnames(df)) + checkmate::assert_choice(group_x, colnames(df)) + checkmate::assert_choice(group_y, colnames(df)) + + # Check numeric/logical values + checkmate::assert_numeric(point_size, len = 1) + checkmate::assert_numeric(point_alpha, lower = 0, upper = 1, len = 1) + checkmate::assert_numeric(segment_size, len = 1) + checkmate::assert_logical(line_to_y_axis, len = 1) + checkmate::assert_numeric(line_to_y_axis_type, len = 1) + checkmate::assert_numeric(line_to_y_axis_width, len = 1) + checkmate::assert_logical(add_text, len = 1) + checkmate::assert_numeric(add_text_vjust, len = 1) + checkmate::assert_numeric(add_text_size, len = 1) + + # Get group keys + group_x_keys <- df |> + dplyr::group_by(!!rlang::sym(group_x)) |> + dplyr::group_keys() |> + dplyr::pull() + + # Check if only two groups + if (length(group_x_keys) > 2) rlang::abort("Cannot draw a dumbbell plot for `group_x` with more than 2 groups") + + # Pivot long data + df_pivot <- df |> + tidyr::pivot_wider( + id_cols = c(!!rlang::sym(group_y)), + values_from = !!rlang::sym(col), + names_from = !!rlang::sym(group_x) + ) + + df_pivot <- df_pivot |> + dplyr::rowwise() |> + dplyr::mutate( + min = min(!!rlang::sym(group_x_keys[[1]]), !!rlang::sym(group_x_keys[[2]]), na.rm = T), + max = max(!!rlang::sym(group_x_keys[[1]]), !!rlang::sym(group_x_keys[[2]]), na.rm = T)) |> + dplyr::ungroup() |> + dplyr::mutate(diff = max - min) + + g <- ggplot2::ggplot(df_pivot) + + # Add line + if(line_to_y_axis) { + + xend <- min(dplyr::pull(df, !!rlang::sym(col))) + + g <- g + + ggplot2::geom_segment( + ggplot2::aes( + x = min, + y = !!rlang::sym(group_y), + yend = !!rlang::sym(group_y)), + xend = xend, + linetype = line_to_y_axis_type, + linewidth = line_to_y_axis_width, + color = line_to_y_axis_color) + } + + # Add segment + g <- g + + ggplot2::geom_segment( + ggplot2::aes( + x = !!rlang::sym(group_x_keys[[1]]), + y = !!rlang::sym(group_y), + xend = !!rlang::sym(group_x_keys[[2]]), + yend = !!rlang::sym(group_y)), + linewidth = segment_size, + color = segment_color + ) + + # Add points + g <- g + + ggplot2::geom_point( + data = df, + ggplot2::aes( + x = !!rlang::sym(col), + y = !!rlang::sym(group_y), + color = !!rlang::sym(group_x), + fill = !!rlang::sym(group_x) + ), + size = point_size, + alpha = point_alpha + ) + + # Add title, subtitle, caption, x_title, y_title + g <- g + ggplot2::labs( + title = title, + subtitle = subtitle, + caption = caption, + x = x_title, + y = group_y_title, + color = group_x_title, + fill = group_x_title + ) + + # Add stat labels to points + if(add_text) g <- g + + ggrepel::geom_text_repel( + data = df, + ggplot2::aes( + x = !!rlang::sym(col), + y = !!rlang::sym(group_y), + label = !!rlang::sym(col) + ), + vjust = add_text_vjust, + size = add_text_size, + color = add_text_color + ) + + # Add theme + g <- g + theme_fun + + # Add scale fun + if (!is.null(scale_fill_fun)) g <- g + scale_fill_fun + + if (!is.null(scale_color_fun)) g <- g + scale_color_fun + + return(g) + +} diff --git a/R/point.R b/R/point.R index 1d4d980..091edff 100644 --- a/R/point.R +++ b/R/point.R @@ -1,11 +1,18 @@ -#' @title Simple point chart +#' @title Simple scatterplot #' #' @param df A data frame. -#' @param x A numeric column. -#' @param y Another numeric column. -#' @param group Some grouping categorical column, e.g. administrative areas or population groups. -#' @param add_color Add a color to bars (if no grouping). -#' @param flip TRUE or FALSE. Default to TRUE or horizontal bar plot. +#' @param x A quoted numeric column. +#' @param y A quoted numeric column. +#' @param group Some quoted grouping categorical column, e.g. administrative areas or population groups. +#' @param facet Some quoted grouping categorical column. +#' @param facet_scales Character. Either "free" (default) or "fixed" for facet scales. +#' @param x_rm_na Remove NAs in x? +#' @param y_rm_na Remove NAs in y? +#' @param group_rm_na Remove NAs in group? +#' @param facet_rm_na Remove NAs in facet? +#' @param add_color Add a color to points (if no grouping). +#' @param add_color_guide Should a legend be added? +#' @param flip TRUE or FALSE. #' @param alpha Fill transparency. #' @param size Point size. #' @param x_title The x scale title. Default to NULL. @@ -14,77 +21,167 @@ #' @param title Plot title. Default to NULL. #' @param subtitle Plot subtitle. Default to NULL. #' @param caption Plot caption. Default to NULL. -#' @param theme_fun Whatever theme. Default to theme_reach(). NULL if no theming needed. -#' @param scale_impact Use the package custom scales for fill and color. +#' @param theme_fun Whatever theme. Default to theme_point(). NULL if no theming needed. #' -#' @inheritParams scale_color_impact_discrete +#' @inheritParams scale_color_visualizer_discrete #' #' @export -point <- function(df, x, y, group = "", add_color = color("branding_reach_red"), flip = TRUE, alpha = 1, size = 2, x_title = NULL, y_title = NULL, group_title = NULL, title = NULL, subtitle = NULL, caption = NULL, theme_fun = theme_reach(grid_major_y = TRUE), palette = "cat_5_ibm", scale_impact = TRUE, direction = 1, reverse_guide = TRUE) { - # # Check if numeric and character - if (!any(c("numeric", "integer") %in% class(df[[x]]))) rlang::abort(paste0(x, " must be numeric.")) - if (!any(c("numeric", "integer") %in% class(df[[y]]))) rlang::abort(paste0(x, " must be numeric.")) +point <- function( + df, + x, + y, + group = "", + facet = "", + facet_scales = "free", + x_rm_na = TRUE, + y_rm_na = TRUE, + group_rm_na = TRUE, + facet_rm_na = TRUE, + add_color = color("cat_5_main_1"), + add_color_guide = TRUE, + flip = TRUE, + alpha = 1, + size = 2, + x_title = NULL, + y_title = NULL, + group_title = NULL, + title = NULL, + subtitle = NULL, + caption = NULL, + theme_fun = theme_point(), + scale_fill_fun = scale_fill_visualizer_discrete(), + scale_color_fun = scale_color_visualizer_discrete() +) { + + #------ Checks + + # df is a data frame + checkmate::assert_data_frame(df) + + # x and y and group are character + checkmate::assert_character(x, len = 1) + checkmate::assert_character(y, len = 1) + checkmate::assert_character(group, len = 1) + + # x and y are columns in df + checkmate::assert_choice(x, colnames(df)) + checkmate::assert_choice(y, colnames(df)) + if (group != "") checkmate::assert_choice(group, colnames(df)) + + # x_rm_na, y_rm_na and group_rm_na are logical scalar + checkmate::assert_logical(x_rm_na, len = 1) + checkmate::assert_logical(y_rm_na, len = 1) + checkmate::assert_logical(group_rm_na, len = 1) + checkmate::assert_logical(facet_rm_na, len = 1) - # Mapping + # facet_scales is a character scalar in c("free", "fixed") + checkmate::assert_choice(facet_scales, c("free", "fixed")) + + # flip is a logical scalar + checkmate::assert_logical(flip, len = 1) + + # alpha is a numeric scalar between 0 and 1 + checkmate::assert_numeric(alpha, lower = 0, upper = 1, len = 1) + + # size is a numeric scalar + checkmate::assert_numeric(size, len = 1) + + # x and y are numeric + if (!any(c("numeric", "integer") %in% class(df[[x]]))) rlang::abort(paste0(x, " must be numeric.")) + if (!any(c("numeric", "integer") %in% class(df[[y]]))) rlang::abort(paste0(y, " must be numeric.")) + + + #----- Data wrangling + + # facets over group + if (group != "" && facet != "" && group == facet) { + rlang::warn("'group' and 'facet' are the same identical.") + } + + # remove NAs using base R + if (x_rm_na) df <- df[!(is.na(df[[x]])),] + if (y_rm_na) df <- df[!(is.na(df[[y]])),] + if (group != "" && group_rm_na) df <- df[!(is.na(df[[group]])),] + if (facet != "" && facet_rm_na) df <- df[!(is.na(df[[facet]])),] + + # prepare aes if (group != "") { - g <- ggplot2::ggplot( - df, - mapping = ggplot2::aes( - x = !!rlang::sym(x), - y = !!rlang::sym(y), - fill = !!rlang::sym(group), - color = !!rlang::sym(group) + g <- ggplot2::ggplot( + df, + mapping = ggplot2::aes( + x = !!rlang::sym(x), + y = !!rlang::sym(y), + fill = !!rlang::sym(group), + color = !!rlang::sym(group) + ) ) + } else { + g <- ggplot2::ggplot( + df, + mapping = ggplot2::aes( + x = !!rlang::sym(x), + y = !!rlang::sym(y) + ) + ) + } + + # add title, subtitle, caption, x_title, y_title + g <- g + ggplot2::labs( + title = title, + subtitle = subtitle, + caption = caption, + x = x_title, + y = y_title, + color = group_title, + fill = group_title + ) + + # facets +# facets +if (facet != "") { + if (flip) { + g <- g + ggplot2::facet_grid( + rows = ggplot2::vars(!!rlang::sym(facet)), + scales = facet_scales, + space = if(facet_scales == "free") "free_y" else "fixed" ) } else { - g <- ggplot2::ggplot( - df, - mapping = ggplot2::aes( - x = !!rlang::sym(x), - y = !!rlang::sym(y) - ) + g <- g + ggplot2::facet_grid( + cols = ggplot2::vars(!!rlang::sym(facet)), + scales = facet_scales, + space = if(facet_scales == "free") "free_x" else "fixed" ) } - - - # Add title, subtitle, caption, x_title, y_title - g <- g + ggplot2::labs( - title = title, - subtitle = subtitle, - caption = caption, - x = x_title, - y = y_title, - color = group_title, - fill = group_title - ) - +} + # Should the graph use position_fill? if (group != "") { - g <- g + ggplot2::geom_point( - alpha = alpha, - size = size - ) + g <- g + ggplot2::geom_point( + alpha = alpha, + size = size + ) } else { - g <- g + ggplot2::geom_point( - alpha = alpha, - size = size, - color = add_color - ) + g <- g + ggplot2::geom_point( + alpha = alpha, + size = size, + color = add_color + ) } - + if (flip) { - g <- g + ggplot2::coord_flip() + g <- g + ggplot2::coord_flip() } - - # Add theme - g <- g + theme_fun - - + + # Remove guides for legend if !add_color_guide + if (!add_color_guide) g <- g + ggplot2::guides(fill = "none", color = "none") + # Add theme if (!is.null(theme_fun)) g <- g + theme_fun - - # Add scale - if (scale_impact) g <- g + scale_fill_impact_discrete(palette, direction, reverse_guide) + scale_color_impact_discrete(palette, direction, reverse_guide) - + + # Add scale fun + if (!is.null(scale_fill_fun)) g <- g + scale_fill_fun + + if (!is.null(scale_color_fun)) g <- g + scale_color_fun + return(g) } diff --git a/R/reorder.R b/R/reorder_by.R similarity index 64% rename from R/reorder.R rename to R/reorder_by.R index 5c09bd5..d0d3adc 100644 --- a/R/reorder.R +++ b/R/reorder_by.R @@ -1,6 +1,5 @@ - -#' Reorder a Data Frame Factoring Column x -#' +#' Reorder a Data Frame +#' #' @param df A data frame to be reordered. #' @param x A character scalar specifying the column to be reordered. #' @param y A character scalar specifying the column to order by if ordering by values. @@ -22,21 +21,16 @@ #' @examples #' # Example usage #' df <- data.frame(col1 = c("b", "a", "c"), col2 = c(10, 25, 3)) -#' reorder(df, "col1", "col2") +#' reorder_by(df, "col1", "col2") +#' #' @export -reorder <- function(df, x, y, group = "", order = "y", dir_order = 1){ +reorder_by <- function(df, x, y, group = "", order = "y", dir_order = 1){ #------ Checks # df is a data frame checkmate::assert_data_frame(df) - # df is data.table, if not convert - if (!checkmate::test_data_table(df)) { - rlang::warn("Converting df to data.table.") - data.table::setDT(df) - } - # x and y are character scalar and in df checkmate::assert_character(x, len = 1) checkmate::assert_character(y, len = 1) @@ -53,52 +47,44 @@ reorder <- function(df, x, y, group = "", order = "y", dir_order = 1){ # dir_order is 1 or -1 (numeric scalar) checkmate::assert_subset(dir_order, c(1, -1)) - - #------ Reorder + #------ Reorder # droplevels first if (is.factor(df[[x]])) { - df[, (x) := droplevels(get(x))] + df[[x]] <- droplevels(df[[x]]) } # reording options if (order == "y") { - - data.table::setorderv(df, y, order = dir_order) - df[, (x) := forcats::fct_inorder(get(x))] - - } else if (order == "grouped" && group == "") { - - rlang::warn("Group is empty. Ordering by y only.") - - data.table::setorderv(df, y, order = dir_order) - df[, (x) := forcats::fct_inorder(get(x))] - + # Order by values of y + df <- df[order(df[[y]] * dir_order), ] + df[[x]] <- forcats::fct_inorder(df[[x]]) } else if (order == "grouped_y" && group != "") { - - data.table::setorderv(df, c(group, y), order = dir_order) - df[, (x) := forcats::fct_inorder(get(x))] - + # Order by group first, then by values of y + df <- df[order(df[[group]], df[[y]] * dir_order), ] + df[[x]] <- forcats::fct_inorder(df[[x]]) + } else if (order == "grouped_y" && group == "") { + # Fallback to ordering by y if group is empty + rlang::warn("Group is empty. Ordering by y only.") + df <- df[order(df[[y]] * dir_order), ] + df[[x]] <- forcats::fct_inorder(df[[x]]) } else if (order == "x") { - - data.table::setorderv(df, x, order = dir_order) - df[, (x) := forcats::fct_inorder(get(x))] - + # Order alphabetically by x + df <- df[order(df[[x]] * dir_order), ] + df[[x]] <- forcats::fct_inorder(df[[x]]) } else if (order == "grouped_x" && group != "") { - - data.table::setorderv(df, c(group, x), order = dir_order) - df[, (x) := forcats::fct_inorder(get(x))] - + # Order by group first, then alphabetically by x + df <- df[order(df[[group]], df[[x]] * dir_order), ] + df[[x]] <- forcats::fct_inorder(df[[x]]) } else if (order == "grouped_x" && group == "") { - + # Fallback to ordering by x if group is empty rlang::warn("Group is empty. Ordering by x only.") - - data.table::setorderv(df, x, order = dir_order) - df[, (x) := forcats::fct_inorder(get(x))] - + df <- df[order(df[[x]] * dir_order), ] + df[[x]] <- forcats::fct_inorder(df[[x]]) } - return(df) + # Reset row names + rownames(df) <- NULL + return(df) } - \ No newline at end of file diff --git a/R/scale.R b/R/scale.R index 4473e58..78ccffa 100644 --- a/R/scale.R +++ b/R/scale.R @@ -1,35 +1,3 @@ - -#' One scale for all -#' -#' This function is based on [palette()]. If palette is NULL, the used palette will be magma from gpplot2's viridis scale constructors. -#' -#' @inheritParams palette_gen -#' -#' @param reverse_guide Boolean indicating whether the guide should be reversed. -#' @param ... Additional arguments passed to [ggplot2::discrete_scale()] if discrete or [ggplot2::scale_fill_gradient()] if continuous. -#' -#' @export -scale_visualizer_discrete <- function(palette = "cat_5_main", direction = 1, reverse_guide = TRUE, title_position = NULL, ...) { - - s <- scale_color_visualizer_discrete(palette, direction, reverse_guide, ...) + - scale_fill_visualizer_discrete(palette, direction, reverse_guide, ...) - - return(s) - -} - -#' @rdname scale_visualizer_dicscrete -#' -#' @export -scale_visualizer_continuous <- function(palette = "seq_5_main", direction = 1, reverse_guide = TRUE, title_position = NULL, ...) { - - s <- scale_color_visualizer_continuous(palette, direction, reverse_guide, ...) + - scale_fill_visualizer_continuous(palette, direction, reverse_guide, ...) - - return(s) - -} - #' Scale constructors for fill and colors #' #' This function is based on [palette()]. If palette is NULL, the used palette will be magma from gpplot2's viridis scale constructors. diff --git a/R/theme_bar.R b/R/theme_bar.R index fc1e245..bb52592 100644 --- a/R/theme_bar.R +++ b/R/theme_bar.R @@ -1,59 +1,86 @@ #' Custom Theme for Bar Charts #' #' @return A custom theme object. -#' +#' +#' @rdname theme_default +#' #' @export theme_bar <- function(flip = TRUE, add_text = FALSE, axis_text_x_angle = 0, axis_text_x_vjust = 0.5, axis_text_x_hjust = 0.5) { # If add_text is TRUE, flip is FALSE if (!flip && !add_text){ + par_axis_text_font_face <- "plain" + par_axis_x <- TRUE + par_axis_y <- TRUE par_axis_line_y <- FALSE - par_axis_ticks_y <- FALSE + par_axis_ticks_y <- TRUE + par_axis_text_y <- TRUE par_axis_line_x <- TRUE par_axis_ticks_x <- TRUE + par_axis_text_x <- TRUE par_grid_major_y <- TRUE par_grid_major_x <- FALSE par_grid_minor_y <- TRUE par_grid_minor_x <- FALSE } else if (flip && !add_text){ + par_axis_text_font_face <- "plain" + par_axis_x <- TRUE + par_axis_y <- TRUE par_axis_line_y <- TRUE par_axis_ticks_y <- TRUE + par_axis_text_y <- TRUE par_axis_line_x <- FALSE - par_axis_ticks_x <- FALSE + par_axis_ticks_x <- TRUE + par_axis_text_x <- TRUE par_grid_major_y <- FALSE par_grid_major_x <- TRUE par_grid_minor_y <- FALSE par_grid_minor_x <- TRUE } else if (!flip && add_text){ + par_axis_text_font_face <- "bold" + par_axis_x <- TRUE + par_axis_y <- TRUE par_axis_line_y <- FALSE par_axis_ticks_y <- FALSE - par_axis_line_x <- TRUE + par_axis_text_y <- FALSE + par_axis_line_x <- FALSE par_axis_ticks_x <- TRUE + par_axis_text_x <- TRUE par_grid_major_y <- FALSE par_grid_major_x <- FALSE par_grid_minor_y <- FALSE par_grid_minor_x <- FALSE } else if (flip && add_text){ - par_axis_line_y <- TRUE + par_axis_text_font_face <- "bold" + par_axis_x <- TRUE + par_axis_y <- TRUE + par_axis_line_y <- FALSE par_axis_ticks_y <- TRUE + par_axis_text_y <- TRUE par_axis_line_x <- FALSE par_axis_ticks_x <- FALSE + par_axis_text_x <- FALSE par_grid_major_y <- FALSE - par_grid_major_x <- FALSE + par_grid_major_x <- FALSE par_grid_minor_y <- FALSE par_grid_minor_x <- FALSE } - + # Theme t <- theme_default( - grid_major_y = par_grid_major_y - , axis_line_y = par_axis_line_y - , axis_ticks_y = par_axis_ticks_y - , axis_ticks_x = par_axis_ticks_x - , axis_line_x = par_axis_line_x + axis_text_font_face = par_axis_text_font_face + , axis_x = par_axis_x + , axis_y = par_axis_y + , grid_major_y = par_grid_major_y , grid_major_x = par_grid_major_x , grid_minor_y = par_grid_minor_y , grid_minor_x = par_grid_minor_x + , axis_text_y = par_axis_text_y + , axis_line_y = par_axis_line_y + , axis_ticks_y = par_axis_ticks_y + , axis_text_x = par_axis_text_x + , axis_line_x = par_axis_line_x + , axis_ticks_x = par_axis_ticks_x , axis_text_x_angle = axis_text_x_angle , axis_text_x_vjust = axis_text_x_vjust , axis_text_x_hjust = axis_text_x_hjust diff --git a/R/theme.R b/R/theme_default.R similarity index 93% rename from R/theme.R rename to R/theme_default.R index 938836f..c641268 100644 --- a/R/theme.R +++ b/R/theme_default.R @@ -86,15 +86,16 @@ theme_default <- function( legend_title_size = 13, legend_title_color = color("dark_grey"), legend_title_font_face = "plain", + legend_title_font_family = "Carlito", legend_text_size = 13, legend_text_color = color("dark_grey"), legend_text_font_face = "plain", - facet_title_size = 13, - facet_title_color = color("dark_grey"), - facet_title_font_face = "bold", - facet_title_font_family = "Carlito", - facet_title_position = "bottom", - facet_background_color = color("light_grey"), + legend_text_font_family = "Carlito", + facet_size = 14, + facet_color = color("dark_grey"), + facet_font_face = "bold", + facet_font_family = "Carlito", + facet_bg_color = color("lighter_grey"), axis_x = TRUE, axis_y = TRUE, axis_text_x = TRUE, @@ -182,20 +183,18 @@ theme_default <- function( color = caption_color, margin = ggplot2::margin(t = 5) ), - # legend.title = ggplot2::element_text( - # size = legend_title_size, - # face = legend_title_font_face, - # family = font_family, - # color = legend_title_color - # #, vjust = 0.5 - # ), - # legend.text = ggplot2::element_text( - # size = legend_text_size, - # face = legend_text_font_face, - # family = font_family, - # color = legend_text_color - # # #, hjust = 0.5 - # # ), + legend.title = ggplot2::element_text( + size = legend_title_size, + face = legend_title_font_face, + family = legend_title_font_family, + color = legend_title_color + ), + legend.text = ggplot2::element_text( + size = legend_text_size, + face = legend_text_font_face, + family = legend_text_font_family, + color = legend_text_color + ), axis.text.x = ggplot2::element_text( angle = axis_text_x_angle, vjust = axis_text_x_vjust, @@ -365,13 +364,13 @@ theme_default <- function( # Add facet title text size theme <- theme + ggplot2::theme( strip.text = ggplot2::element_text( - size = facet_title_size, - family = facet_title_font_family, - face = facet_title_font_face, - color = facet_title_color + size = facet_size, + family = facet_font_family, + face = facet_font_face, + color = facet_color ), strip.background = ggplot2::element_rect( - fill = facet_background_color, + fill = facet_bg_color, linewidth = 0 ) ) diff --git a/R/theme_dumbbell.R b/R/theme_dumbbell.R new file mode 100644 index 0000000..5b2fe44 --- /dev/null +++ b/R/theme_dumbbell.R @@ -0,0 +1,13 @@ +#' @title Dumbbell Theme + +#' @description Theme for dumbbell charts based on theme_default. +#' +#' @rdname theme_default +#' +#' @export +theme_dumbbell <- function() { + theme_default( + axis_line_x = TRUE, + grid_) +} + diff --git a/R/theme_point.R b/R/theme_point.R new file mode 100644 index 0000000..021ed24 --- /dev/null +++ b/R/theme_point.R @@ -0,0 +1,32 @@ +#' Custom Theme for Point Charts +#' +#' @param flip Logical. Whether the plot is flipped (horizonal). +#' @param axis_text_x_angle Angle for x-axis text. +#' @param axis_text_x_vjust Vertical justification for x-axis text. +#' @param axis_text_x_hjust Horizontal justification for x-axis text. +#' +#' @rdname theme_default +#' +#' @return A custom theme object. +#' +#' @export +theme_point <- function( +) { + t <- theme_default( + axis_text_font_face = "plain", + axis_x = TRUE, + axis_y = TRUE, + grid_major_y = TRUE, + grid_major_x = TRUE, + grid_minor_y = FALSE, + grid_minor_x = FALSE, + axis_text_x = TRUE, + axis_line_x = TRUE, + axis_ticks_x = TRUE, + axis_text_x_angle = 0, + axis_text_x_vjust = 0.5, + axis_text_x_hjust = 0 + ) + + return(t) +} diff --git a/R/theme_visualizer_bar.R b/R/theme_visualizer_bar.R deleted file mode 100644 index 5c25e52..0000000 --- a/R/theme_visualizer_bar.R +++ /dev/null @@ -1,49 +0,0 @@ -#' Dynamic Theme for ggplot2 -#' -#' A dynamic theme that adjusts axis text styles based on whether the plot is flipped. -#' -#' This function dynamically applies different axis text styles depending on -#' the coordinate system of the plot. If the plot is flipped (e.g., using -#' `coord_flip()`), the x-axis and y-axis text styles are adjusted accordingly. -#' -#' @return A ggproto object that applies a dynamic theme to a ggplot2 plot. -#' @examples -#' library(ggplot2) -#' -#' # Example with a regular plot -#' p <- ggplot(mpg, aes(displ, hwy)) + -#' geom_col() -#' -#' # Add the dynamic theme -#' p + theme_visualizer_bar() -#' -#' # Add the dynamic theme with a flipped coordinate system -#' p + theme_visualizer_bar() + coord_flip() -#' -#' @export -theme_visualizer_bar <- function() { - out <- theme_grey() - class(out) <- c("ThemeVisualizerBar", class(out)) - - #structure(list(), class = c("ThemeVisualizerBar", "theme", "gg")) - return(out) -} - - - -ggplot_add.theme_visualizer_bar <- function(object, p, object_name) { - # Check if the plot is flipped - is_flipped <- inherits(p$coordinates, "CoordFlip") - - if (!is_flipped) { - object <- object + - theme_minimal() - } else { - object <- object + - theme( - panel.grid.major = ggplot2::element_line(color = "blue") - ) - } - - return(object) -} diff --git a/R/visualizeR-package.R b/R/visualizeR-package.R new file mode 100644 index 0000000..a65cf64 --- /dev/null +++ b/R/visualizeR-package.R @@ -0,0 +1,6 @@ +#' @keywords internal +"_PACKAGE" + +## usethis namespace: start +## usethis namespace: end +NULL diff --git a/README.Rmd b/README.Rmd index b8d23ce..fc9973d 100644 --- a/README.Rmd +++ b/README.Rmd @@ -20,16 +20,15 @@ desc <- read.dcf("DESCRIPTION") desc <- setNames(as.list(desc), colnames(desc)) ``` -# `r desc$Package` +# `r desc$Package` > `r desc$Title` -`visualizeR` proposes some utils to get REACH and AGORA colors, ready-to-go color palettes, and a few visualization functions (horizontal hist graph for instance). +`visualizeR` proposes some utils to sane colors, ready-to-go color palettes, and a few visualization functions. ## Installation -You can install the last version of visualizeR from -[GitHub](https://github.com/) with: +You can install the last version of visualizeR from [GitHub](https://github.com/) with: ```{r, eval = FALSE} # install.packages("devtools") @@ -38,44 +37,32 @@ devtools::install_github("gnoblet/visualizeR", build_vignettes = TRUE) ## Roadmap -Roadmap is as follows: +Roadmap is as follows: - [ ] Full revamp \## Request -- [X] Add IMPACT's colors -- [X] Add all color palettes from the internal documentation -- [ ] There remains to be added more-than-7-color palettes and black color palettes -- [X] Add new types of visualization (e.g. dumbbell plot, lollipop plot, etc.) -- [X] Use examples -- [ ] Add some ease-map functions -- [ ] Add some interactive functions (maps and graphs) -- [ ] Consolidate and make errors transparent +Please, do not hesitate to pull request any new viz or colors or color palettes, or to email request any change ([gnoblet\@zaclys.net](mailto:gnoblet@zaclys.net){.email}). -## Request +## Colors -Please, do not hesitate to pull request any new viz or colors or color palettes, or to email request any change (guillaume.noblet@reach-initiative.org or gnoblet@zaclys.net). - -## Colors - -Color palettes for REACH, AGORA and IMPACT are available. Functions to access colors and palettes are `cols_initiative()` or `pal_initiative()`. For now, the initiative with the most colors and color palettes is REACH. Feel free to pull requests new AGORA and IMPACT colors. +Functions to access colors and palettes are `color()` or `palette()`. Feel free to pull request new colors. ```{r example-colors, eval = TRUE} library(visualizeR) -# Get all saved REACH colors, named -cols_reach(unnamed = F)[1:10] +# Get all saved colors, named +color(unname = F)[1:10] # Extract a color palette as hexadecimal codes and reversed -pal_reach(palette = "main", reversed = TRUE, color_ramp_palette = FALSE) +palette(palette = "cat_5_main", reversed = TRUE, color_ramp_palette = FALSE) # Get all color palettes names -pal_reach(show_palettes = T) +palette(show_palettes = TRUE) ``` ## Charts -### Example 1: Bar chart, already REACH themed +### Example 1: Bar chart ```{r example-bar-chart, out.width = "65%", eval = TRUE} -library(visualizeR) library(palmerpenguins) library(dplyr) @@ -87,33 +74,41 @@ df <- penguins |> ) |> ungroup() +df_island <- penguins |> + group_by(island) |> + summarize( + mean_bl = mean(bill_length_mm, na.rm = T), + mean_fl = mean(flipper_length_mm, na.rm = T) + ) |> + ungroup() + # Simple bar chart by group with some alpha transparency -bar(df, island, mean_bl, species, percent = FALSE, alpha = 0.6, x_title = "Mean of bill length") +bar(df, "island", "mean_bl", "species", x_title = "Mean of bill length", title = "Mean of bill length by island and species") -# Using another color palette through `theme_reach()` and changing scale to percent -bar(df, island, mean_bl, species, percent = TRUE, theme = theme_reach(palette = "artichoke_3")) +# Flipped / Horizontal +hbar(df, "island", "mean_bl", "species", x_title = "Mean of bill length", title = "Mean of bill length by island and species") -# Not flipped, with text added, group_title, no y-axis and no bold for legend -bar(df, island, mean_bl, species, group_title = "Species", flip = FALSE, add_text = TRUE, add_text_suffix = "%", percent = FALSE, theme = theme_reach(text_font_face = "plain", axis_y = FALSE)) +# Facetted +bar(df, "island", "mean_bl", "species", facet = "species", x_title = "Mean of bill length", title = "Mean of bill length by island and species", add_color_guide = FALSE) + +# Flipped, with text, smaller width +hbar(df = df_island, x = "island", y = "mean_bl", group = "island", title = "Mean of bill length by island", add_text = T, width = 0.6, add_text_suffix = "mm", add_text_expand_limit = 1.3, add_color_guide = FALSE) ``` -### Example 2: Point chart, already REACH themed - -At this stage, `point_reach()` only supports categorical grouping colors with the `group` arg. +### Example 2: Scatterplot ```{r example-point-chart, out.width = "65%", eval = TRUE} -# Simple point chart -point(penguins, bill_length_mm, flipper_length_mm) +# Simple scatterplot +point(penguins, "bill_length_mm", "flipper_length_mm") -# Point chart with grouping colors, greater dot size, some transparency, reversed color palette -point(penguins, bill_length_mm, flipper_length_mm, island, alpha = 0.6, size = 3, theme = theme_reach(reverse = TRUE)) +# Scatterplot with grouping colors, greater dot size, some transparency +point(penguins, "bill_length_mm", "flipper_length_mm", "island", group_title = "Island", alpha = 0.6, size = 3, title = "Bill vs. flipper length", , add_color_guide = FALSE) -# Using another color palettes -point(penguins, bill_length_mm, flipper_length_mm, island, size = 1.5, x_title = "Bill", y_title = "Flipper", title = "Length (mm)", theme = theme_reach(palette = "artichoke_3", text_font_face = , grid_major_x = TRUE, title_position_to_plot = FALSE)) +# Facetted scatterplot by island +point(penguins, "bill_length_mm", "flipper_length_mm", "species", "island", "fixed", group_title = "Species", title = "Bill vs. flipper length by species and island", add_color_guide = FALSE) ``` - -### Example 3: Dumbbell plot, REACH themed +### Example 3: Dumbbell plot Remember to ensure that your data are in the long format and you only have two groups on the x-axis; for instance, IDP and returnee and no NA values. @@ -126,32 +121,22 @@ df <- tibble::tibble( ) |> dplyr::mutate(stat = round(stat, 0)) -# Example, adding a parameter to `theme_reach()` passed on `ggplot2::theme()` to align legend title -dumbbell(df, - stat, - setting, - admin1, - title = "% of HHs that reported open defecation as sanitation facility", - group_y_title = "Admin 1", - group_x_title = "Setting", - theme = theme_reach( - legend_position = "bottom", - legend_direction = "horizontal", - legend_title_font_face = "bold", - palette = "primary", - title_position_to_plot = FALSE, - legend.title.align = 0.5 - ) -) + - # Change legend title position (could be included as part of the function) - ggplot2::guides( - color = ggplot2::guide_legend(title.position = "left"), - fill = ggplot2::guide_legend(title.position = "left") - ) + + +# dumbbell( +# df, +# "stat", +# "setting", +# "admin1", +# title = "% of HHs that reported open defecation as sanitation facility", +# group_y_title = "Admin 1", +# group_x_title = "Setting" +# ) ``` -### Example 4: donut chart, REACH themed (to used once, not twice) +### Example 4: donut chart + ```{r example-donut-plot, out.width = "65%", warning = FALSE} # Some summarized data: % of HHs by displacement status df <- tibble::tibble( @@ -160,28 +145,27 @@ df <- tibble::tibble( ) # Donut -donut(df, - status, - percentage, - hole_size = 3, - add_text_suffix = "%", - add_text_color = cols_reach("dk_grey"), - add_text_treshold_display = 5, - x_title = "Displacement status", - title = "% of HHs by displacement status", - theme = theme_reach(legend_reverse = TRUE) -) +# donut(df, +# status, +# percentage, +# hole_size = 3, +# add_text_suffix = "%", +# add_text_color = color("dark_grey"), +# add_text_treshold_display = 5, +# x_title = "Displacement status", +# title = "% of HHs by displacement status" +# ) ``` +### Example 5: Waffle chart -### Example 5: waffle chart ```{r example-waffle-plot, out.width = "65%", warning = FALSE} # -waffle(df, status, percentage, x_title = "A caption", title = "A title", subtitle = "A subtitle") +# waffle(df, status, percentage, x_title = "A caption", title = "A title", subtitle = "A subtitle") ``` +### Example 6: Alluvial chart -### Example 6: alluvial chart, REACH themed ```{r example-alluvial-plot, out.width = "65%", warning = FALSE} # Some summarized data: % of HHs by self-reported status of displacement in 2021 and in 2022 df <- tibble::tibble( @@ -197,23 +181,20 @@ df <- tibble::tibble( # Alluvial, here the group is the status for 2021 -alluvial(df, - status_from, - status_to, - percentage, - status_from, - from_levels = c("Displaced", "Non displaced", "Returnee", "Dnk/Pnts"), - alpha = 0.8, - group_title = "Status for 2021", - title = "% of HHs by self-reported status from 2021 to 2022", - theme = theme_reach( - axis_y = FALSE, - legend_position = "none" - ) -) +# alluvial(df, +# status_from, +# status_to, +# percentage, +# status_from, +# from_levels = c("Displaced", "Non displaced", "Returnee", "Dnk/Pnts"), +# alpha = 0.8, +# group_title = "Status for 2021", +# title = "% of HHs by self-reported status from 2021 to 2022" +# ) ``` -### Example 7: lollipop chart +### Example 7: Lollipop chart + ```{r example-lollipop-chart, out.width = "65%", warning = FALSE} library(tidyr) # Prepare long data @@ -223,80 +204,15 @@ df <- tibble::tibble( ) |> dplyr::mutate(stat = round(stat, 0)) -# Make lollipop plot, REACH themed, vertical with 45 degrees angle X-labels -lollipop(df, - admin1, - stat, - arrange = FALSE, - add_text = FALSE, - flip = FALSE, - y_title = "% of HHs", - x_title = "Admin 1", - title = "% of HHs that reported having received a humanitarian assistance", - theme = theme_reach( - axis_text_x_angle = 45, - grid_major_y = TRUE, - grid_major_y_size = 0.2, - grid_major_x = TRUE, - grid_minor_y = TRUE - ) -) - -# Horizontal, greater point size, arranged by value, no grid, and text labels added -lollipop(df, - admin1, - stat, - arrange = TRUE, - point_size = 10, - point_color = cols_reach("main_beige"), - segment_size = 2, - add_text = TRUE, - add_text_suffix = "%", - y_title = "% of HHs", - x_title = "Admin 1", - title = "% of HHs that reported having received a humanitarian assistance in the 12 months prior to the assessment", - theme = theme_reach(title_position_to_plot = FALSE) -) +# Make lollipop plot, vertical with 45 degrees angle X-labels +# lollipop(df, +# admin1, +# stat, +# arrange = FALSE, +# add_text = FALSE, +# flip = FALSE, +# y_title = "% of HHs", +# x_title = "Admin 1", +# title = "% of HHs that reported having received a humanitarian assistance" +# ) ``` - - -## Maps - -```{r example-map, out.width = "50%"} -# Add indicator layer -# - based on "pretty" classes and title "Proportion (%)" -# - buffer to add a 10% around the bounding box -map <- add_indicator_layer( - indicator_admin1, - opn_dfc, - buffer = 0.1 -) + - # Layout - some defaults - add the map title - add_layout("% of HH that reported open defecation as sanitation facility") + - # Admin boundaries as list of shape files (lines) and colors, line widths and labels as vectors - add_admin_boundaries( - lines = list(line_admin1, border_admin0, frontier_admin0), - colors = cols_reach("main_lt_grey", "dk_grey", "black"), - lwds = c(0.5, 2, 3), - labels = c("Department", "Country", "Dominican Rep. frontier"), - title = "Administrative boundaries" - ) + - # Add text labels - centered on admin 1 centroids - add_admin_labels(centroid_admin1, ADM1_FR_UPPER) + - # Add a compass - add_compass() + - # Add a scale bar - add_scale_bar() + - # Add credits - add_credits("Admin. boundaries. : CNIGS \nCoord. system: GCS WGS 1984") -``` - -```{r map-save, eval = TRUE, include = FALSE, echo = TRUE} -tmap::tmap_save(map, - "man/figures/README-example-map.png", - height = 4.5, - width = 6 -) -``` - -![Once exported with `tmap::tmap_save()`.](man/figures/README-example-map.png) diff --git a/README.md b/README.md index 0e24eb5..b53a2b5 100644 --- a/README.md +++ b/README.md @@ -1,13 +1,12 @@ -# visualizeR +# visualizeR -> What a color\! What a viz\! +> What a color! What a viz! -`visualizeR` proposes some utils to get REACH and AGORA colors, -ready-to-go color palettes, and a few visualization functions -(horizontal hist graph for instance). +`visualizeR` proposes some utils to sane colors, ready-to-go color +palettes, and a few visualization functions. ## Installation @@ -21,128 +20,122 @@ devtools::install_github("gnoblet/visualizeR", build_vignettes = TRUE) ## Roadmap -Roadmap is as follows: - - - \[X\] Add IMPACT’s colors - - \[X\] Add all color palettes from the internal documentation - - \[ \] There remains to be added more-than-7-color palettes and black - color palettes - - \[X\] Add new types of visualization (e.g. dumbbell plot, lollipop - plot, etc.) - - \[X\] Use examples - - \[ \] Add some ease-map functions - - \[ \] Add some interactive functions (maps and graphs) - - \[ \] Consolidate and make errors transparent - -## Request +Roadmap is as follows: - \[ \] Full revamp \## Request Please, do not hesitate to pull request any new viz or colors or color -palettes, or to email request any change -( or ). +palettes, or to email request any change (). ## Colors -Color palettes for REACH, AGORA and IMPACT are available. Functions to -access colors and palettes are `cols_initiative()` or -`pal_initiative()`. For now, the initiative with the most colors and -color palettes is REACH. Feel free to pull requests new AGORA and IMPACT -colors. +Functions to access colors and palettes are `color()` or `palette()`. +Feel free to pull request new colors. ``` r library(visualizeR) -# Get all saved REACH colors, named -cols_reach(unnamed = F)[1:10] -#> white black main_grey main_red main_lt_grey main_beige -#> "#FFFFFF" "#000000" "#58585A" "#EE5859" "#C7C8CA" "#D2CBB8" -#> iroise_1 iroise_2 iroise_3 iroise_4 -#> "#DFECEF" "#B1D7E0" "#699DA3" "#236A7A" +# Get all saved colors, named +color(unname = F)[1:10] +#> white lighter_grey light_grey dark_grey black +#> "#FFFFFF" "#F5F5F5" "#E3E3E3" "#464647" "#000000" +#> cat_2_yellow_1 cat_2_yellow_2 cat_2_light_1 cat_2_light_2 cat_2_green_1 +#> "#ffc20a" "#0c7bdc" "#fefe62" "#d35fb7" "#1aff1a" # Extract a color palette as hexadecimal codes and reversed -pal_reach(palette = "main", reversed = TRUE, color_ramp_palette = FALSE) -#> [1] "#58585A" "#EE5859" "#C7C8CA" "#D2CBB8" +palette(palette = "cat_5_main", reversed = TRUE, color_ramp_palette = FALSE) +#> [1] "#083d77" "#4ecdc4" "#f4c095" "#b47eb3" "#ffd5ff" # Get all color palettes names -pal_reach(show_palettes = T) -#> [1] "main" "primary" "secondary" "two_dots" -#> [5] "two_dots_flashy" "red_main" "red_main_5" "red_alt" -#> [9] "red_alt_5" "iroise" "iroise_5" "discrete_6" -#> [13] "red_2" "red_3" "red_4" "red_5" -#> [17] "red_6" "red_7" "green_2" "green_3" -#> [21] "green_4" "green_5" "green_6" "green_7" -#> [25] "artichoke_2" "artichoke_3" "artichoke_4" "artichoke_5" -#> [29] "artichoke_6" "artichoke_7" "blue_2" "blue_3" -#> [33] "blue_4" "blue_5" "blue_6" "blue_7" +palette(show_palettes = TRUE) +#> [1] "cat_2_yellow" "cat_2_light" +#> [3] "cat_2_green" "cat_2_blue" +#> [5] "cat_5_main" "cat_5_ibm" +#> [7] "cat_3_aquamarine" "cat_3_tol_high_contrast" +#> [9] "cat_8_tol_adapted" "cat_3_custom_1" +#> [11] "cat_4_custom_1" "cat_5_custom_1" +#> [13] "cat_6_custom_1" "div_5_orange_blue" +#> [15] "div_5_green_purple" ``` ## Charts -### Example 1: Bar chart, already REACH themed +### Example 1: Bar chart ``` r -library(visualizeR) library(palmerpenguins) library(dplyr) -df <- penguins |> - group_by(island, species) |> +df <- penguins |> + group_by(island, species) |> summarize( mean_bl = mean(bill_length_mm, na.rm = T), - mean_fl = mean(flipper_length_mm, na.rm = T)) |> + mean_fl = mean(flipper_length_mm, na.rm = T) + ) |> + ungroup() + +df_island <- penguins |> + group_by(island) |> + summarize( + mean_bl = mean(bill_length_mm, na.rm = T), + mean_fl = mean(flipper_length_mm, na.rm = T) + ) |> ungroup() # Simple bar chart by group with some alpha transparency -bar(df, island, mean_bl, species, percent = FALSE, alpha = 0.6, x_title = "Mean of bill length") +bar(df, "island", "mean_bl", "species", x_title = "Mean of bill length", title = "Mean of bill length by island and species") ``` ``` r -# Using another color palette through `theme_reach()` and changing scale to percent -bar(df, island,mean_bl, species, percent = TRUE, theme = theme_reach(palette = "artichoke_3")) +# Flipped / Horizontal +hbar(df, "island", "mean_bl", "species", x_title = "Mean of bill length", title = "Mean of bill length by island and species") ``` ``` r -# Not flipped, with text added, group_title, no y-axis and no bold for legend -bar(df, island, mean_bl, species, group_title = "Species", flip = FALSE, add_text = TRUE, add_text_suffix = "%", percent = FALSE, theme = theme_reach(text_font_face = "plain", axis_y = FALSE)) +# Facetted +bar(df, "island", "mean_bl", "species", facet = "species", x_title = "Mean of bill length", title = "Mean of bill length by island and species", add_color_guide = FALSE) ``` -### Example 2: Point chart, already REACH themed - -At this stage, `point_reach()` only supports categorical grouping colors -with the `group` arg. - ``` r -# Simple point chart -point(penguins, bill_length_mm, flipper_length_mm) +# Flipped, with text, smaller width +hbar(df = df_island, x = "island", y = "mean_bl", group = "island", title = "Mean of bill length by island", add_text = T, width = 0.6, add_text_suffix = "mm", add_text_expand_limit = 1.3, add_color_guide = FALSE) +``` + + + +### Example 2: Scatterplot + +``` r +# Simple scatterplot +point(penguins, "bill_length_mm", "flipper_length_mm") ``` ``` r -# Point chart with grouping colors, greater dot size, some transparency, reversed color palette -point(penguins, bill_length_mm, flipper_length_mm, island, alpha = 0.6, size = 3, theme = theme_reach(reverse = TRUE)) +# Scatterplot with grouping colors, greater dot size, some transparency +point(penguins, "bill_length_mm", "flipper_length_mm", "island", group_title = "Island", alpha = 0.6, size = 3, title = "Bill vs. flipper length", , add_color_guide = FALSE) ``` ``` r -# Using another color palettes -point(penguins, bill_length_mm, flipper_length_mm, island, size = 1.5, x_title = "Bill", y_title = "Flipper", title = "Length (mm)", theme = theme_reach(palette = "artichoke_3", text_font_face = , grid_major_x = TRUE, title_position_to_plot = FALSE)) +# Facetted scatterplot by island +point(penguins, "bill_length_mm", "flipper_length_mm", "species", "island", "fixed", group_title = "Species", title = "Bill vs. flipper length by species and island", add_color_guide = FALSE) ``` -### Example 3: Dumbbell plot, REACH themed +### Example 3: Dumbbell plot Remember to ensure that your data are in the long format and you only have two groups on the x-axis; for instance, IDP and returnee and no NA @@ -157,34 +150,23 @@ df <- tibble::tibble( ) |> dplyr::mutate(stat = round(stat, 0)) -# Example, adding a parameter to `theme_reach()` passed on `ggplot2::theme()` to align legend title -dumbbell(df, - stat, - setting, - admin1, - title = "% of HHs that reported open defecation as sanitation facility", - group_y_title = "Admin 1", - group_x_title = "Setting", - theme = theme_reach(legend_position = "bottom", - legend_direction = "horizontal", - legend_title_font_face = "bold", - palette = "primary", - title_position_to_plot = FALSE, - legend.title.align = 0.5)) + - # Change legend title position (could be included as part of the function) - ggplot2::guides( - color = ggplot2::guide_legend(title.position = "left"), - fill = ggplot2::guide_legend(title.position = "left") - ) + + +# dumbbell( +# df, +# "stat", +# "setting", +# "admin1", +# title = "% of HHs that reported open defecation as sanitation facility", +# group_y_title = "Admin 1", +# group_x_title = "Setting" +# ) ``` - - -### Example 4: donut chart, REACH themed (to used once, not twice) +### Example 4: donut chart ``` r - # Some summarized data: % of HHs by displacement status df <- tibble::tibble( status = c("Displaced", "Non displaced", "Returnee", "Don't know/Prefer not to say"), @@ -192,139 +174,74 @@ df <- tibble::tibble( ) # Donut -donut(df, - status, - percentage, - hole_size = 3, - add_text_suffix = "%", - add_text_color = cols_reach("dk_grey"), - add_text_treshold_display = 5, - x_title = "Displacement status", - title = "% of HHs by displacement status", - theme = theme_reach(legend_reverse = TRUE)) +# donut(df, +# status, +# percentage, +# hole_size = 3, +# add_text_suffix = "%", +# add_text_color = color("dark_grey"), +# add_text_treshold_display = 5, +# x_title = "Displacement status", +# title = "% of HHs by displacement status" +# ) ``` - - -### Example 5: waffle chart +### Example 5: Waffle chart ``` r # -waffle(df, status, percentage, x_title = "A caption", title = "A title", subtitle = "A subtitle") +# waffle(df, status, percentage, x_title = "A caption", title = "A title", subtitle = "A subtitle") ``` - - -### Example 6: alluvial chart, REACH themed +### Example 6: Alluvial chart ``` r - # Some summarized data: % of HHs by self-reported status of displacement in 2021 and in 2022 df <- tibble::tibble( - status_from = c(rep("Displaced", 4), - rep("Non displaced", 4), - rep("Returnee", 4), - rep("Dnk/Pnts", 4)), + status_from = c( + rep("Displaced", 4), + rep("Non displaced", 4), + rep("Returnee", 4), + rep("Dnk/Pnts", 4) + ), status_to = c("Displaced", "Non displaced", "Returnee", "Dnk/Pnts", "Displaced", "Non displaced", "Returnee", "Dnk/Pnts", "Displaced", "Non displaced", "Returnee", "Dnk/Pnts", "Displaced", "Non displaced", "Returnee", "Dnk/Pnts"), percentage = c(20, 8, 18, 1, 12, 21, 0, 2, 0, 3, 12, 1, 0, 0, 1, 1) ) # Alluvial, here the group is the status for 2021 -alluvial(df, - status_from, - status_to, - percentage, - status_from, - from_levels = c("Displaced", "Non displaced", "Returnee", "Dnk/Pnts"), - alpha = 0.8, - group_title = "Status for 2021", - title = "% of HHs by self-reported status from 2021 to 2022", - theme = theme_reach( - axis_y = FALSE, - legend_position = "none")) +# alluvial(df, +# status_from, +# status_to, +# percentage, +# status_from, +# from_levels = c("Displaced", "Non displaced", "Returnee", "Dnk/Pnts"), +# alpha = 0.8, +# group_title = "Status for 2021", +# title = "% of HHs by self-reported status from 2021 to 2022" +# ) ``` - - -### Example 7: lollipop chart +### Example 7: Lollipop chart ``` r library(tidyr) # Prepare long data df <- tibble::tibble( - admin1 = replicate(15, sample(letters, 8)) |> t() |> as.data.frame() |> unite("admin1", sep = "") |> dplyr::pull(admin1), - stat = rnorm(15, mean = 50, sd = 15)) |> + admin1 = replicate(15, sample(letters, 8)) |> t() |> as.data.frame() |> unite("admin1", sep = "") |> dplyr::pull(admin1), + stat = rnorm(15, mean = 50, sd = 15) +) |> dplyr::mutate(stat = round(stat, 0)) -# Make lollipop plot, REACH themed, vertical with 45 degrees angle X-labels -lollipop(df, - admin1, - stat, - arrange = FALSE, - add_text = FALSE, - flip = FALSE, - y_title = "% of HHs", - x_title = "Admin 1", - title = "% of HHs that reported having received a humanitarian assistance", - theme = theme_reach(axis_text_x_angle = 45, - grid_major_y = TRUE, - grid_major_y_size = 0.2, - grid_major_x = TRUE, - grid_minor_y = TRUE)) +# Make lollipop plot, vertical with 45 degrees angle X-labels +# lollipop(df, +# admin1, +# stat, +# arrange = FALSE, +# add_text = FALSE, +# flip = FALSE, +# y_title = "% of HHs", +# x_title = "Admin 1", +# title = "% of HHs that reported having received a humanitarian assistance" +# ) ``` - - - -``` r - -# Horizontal, greater point size, arranged by value, no grid, and text labels added -lollipop(df, - admin1, - stat, - arrange = TRUE, - point_size = 10, - point_color = cols_reach("main_beige"), - segment_size = 2, - add_text = TRUE, - add_text_suffix = "%", - y_title = "% of HHs", - x_title = "Admin 1", - title = "% of HHs that reported having received a humanitarian assistance in the 12 months prior to the assessment", - theme = theme_reach(title_position_to_plot = FALSE)) -``` - - - -## Maps - -``` r - -# Add indicator layer -# - based on "pretty" classes and title "Proportion (%)" -# - buffer to add a 10% around the bounding box -map <- add_indicator_layer( - indicator_admin1, - opn_dfc, - buffer = 0.1) + - # Layout - some defaults - add the map title - add_layout("% of HH that reported open defecation as sanitation facility") + - # Admin boundaries as list of shape files (lines) and colors, line widths and labels as vectors - add_admin_boundaries( - lines = list(line_admin1, border_admin0, frontier_admin0), - colors = cols_reach("main_lt_grey", "dk_grey", "black"), - lwds = c(0.5, 2, 3), - labels = c("Department", "Country", "Dominican Rep. frontier"), - title = "Administrative boundaries") + - # Add text labels - centered on admin 1 centroids - add_admin_labels(centroid_admin1, ADM1_FR_UPPER) + - # Add a compass - add_compass() + - # Add a scale bar - add_scale_bar() + - # Add credits - add_credits("Admin. boundaries. : CNIGS \nCoord. system: GCS WGS 1984") -``` - -![Once exported with -`tmap::tmap_save()`.](man/figures/README-example-map.png) diff --git a/data-raw/border_admin0.dbf b/data-raw/border_admin0.dbf deleted file mode 100644 index 2cdd77c..0000000 Binary files a/data-raw/border_admin0.dbf and /dev/null differ diff --git a/data-raw/border_admin0.prj b/data-raw/border_admin0.prj deleted file mode 100644 index f8e4548..0000000 --- a/data-raw/border_admin0.prj +++ /dev/null @@ -1 +0,0 @@ -PROJCS["WGS_1984_UTM_Zone_18N",GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137.0,298.257223563]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]],PROJECTION["Transverse_Mercator"],PARAMETER["False_Easting",500000.0],PARAMETER["False_Northing",0.0],PARAMETER["Central_Meridian",-75.0],PARAMETER["Scale_Factor",0.9996],PARAMETER["Latitude_Of_Origin",0.0],UNIT["m",1.0]] \ No newline at end of file diff --git a/data-raw/border_admin0.shp b/data-raw/border_admin0.shp deleted file mode 100644 index 559c58d..0000000 Binary files a/data-raw/border_admin0.shp and /dev/null differ diff --git a/data-raw/border_admin0.shx b/data-raw/border_admin0.shx deleted file mode 100644 index f4d8240..0000000 Binary files a/data-raw/border_admin0.shx and /dev/null differ diff --git a/data-raw/centroid_admin1.dbf b/data-raw/centroid_admin1.dbf deleted file mode 100644 index f17bfb9..0000000 Binary files a/data-raw/centroid_admin1.dbf and /dev/null differ diff --git a/data-raw/centroid_admin1.prj b/data-raw/centroid_admin1.prj deleted file mode 100644 index 79392c5..0000000 --- a/data-raw/centroid_admin1.prj +++ /dev/null @@ -1 +0,0 @@ -GEOGCS["GCS_unknown",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137.0,298.257223563]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]] \ No newline at end of file diff --git a/data-raw/centroid_admin1.shp b/data-raw/centroid_admin1.shp deleted file mode 100644 index 67811d2..0000000 Binary files a/data-raw/centroid_admin1.shp and /dev/null differ diff --git a/data-raw/centroid_admin1.shx b/data-raw/centroid_admin1.shx deleted file mode 100644 index f6ca9fc..0000000 Binary files a/data-raw/centroid_admin1.shx and /dev/null differ diff --git a/data-raw/frontier_admin0.dbf b/data-raw/frontier_admin0.dbf deleted file mode 100644 index 20c39d2..0000000 Binary files a/data-raw/frontier_admin0.dbf and /dev/null differ diff --git a/data-raw/frontier_admin0.prj b/data-raw/frontier_admin0.prj deleted file mode 100644 index f45cbad..0000000 --- a/data-raw/frontier_admin0.prj +++ /dev/null @@ -1 +0,0 @@ -GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137.0,298.257223563]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]] \ No newline at end of file diff --git a/data-raw/frontier_admin0.shp b/data-raw/frontier_admin0.shp deleted file mode 100644 index 6a7c832..0000000 Binary files a/data-raw/frontier_admin0.shp and /dev/null differ diff --git a/data-raw/frontier_admin0.shx b/data-raw/frontier_admin0.shx deleted file mode 100644 index aeb62b0..0000000 Binary files a/data-raw/frontier_admin0.shx and /dev/null differ diff --git a/data-raw/indicator_admin1.dbf b/data-raw/indicator_admin1.dbf deleted file mode 100644 index 9dd16e2..0000000 Binary files a/data-raw/indicator_admin1.dbf and /dev/null differ diff --git a/data-raw/indicator_admin1.prj b/data-raw/indicator_admin1.prj deleted file mode 100644 index f45cbad..0000000 --- a/data-raw/indicator_admin1.prj +++ /dev/null @@ -1 +0,0 @@ -GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137.0,298.257223563]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]] \ No newline at end of file diff --git a/data-raw/indicator_admin1.shp b/data-raw/indicator_admin1.shp deleted file mode 100644 index cd956a4..0000000 Binary files a/data-raw/indicator_admin1.shp and /dev/null differ diff --git a/data-raw/indicator_admin1.shx b/data-raw/indicator_admin1.shx deleted file mode 100644 index 114b1d3..0000000 Binary files a/data-raw/indicator_admin1.shx and /dev/null differ diff --git a/data-raw/line_admin1.dbf b/data-raw/line_admin1.dbf deleted file mode 100644 index 27046d0..0000000 Binary files a/data-raw/line_admin1.dbf and /dev/null differ diff --git a/data-raw/line_admin1.prj b/data-raw/line_admin1.prj deleted file mode 100644 index f45cbad..0000000 --- a/data-raw/line_admin1.prj +++ /dev/null @@ -1 +0,0 @@ -GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137.0,298.257223563]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]] \ No newline at end of file diff --git a/data-raw/line_admin1.shp b/data-raw/line_admin1.shp deleted file mode 100644 index 5a39a4b..0000000 Binary files a/data-raw/line_admin1.shp and /dev/null differ diff --git a/data-raw/line_admin1.shx b/data-raw/line_admin1.shx deleted file mode 100644 index e078d09..0000000 Binary files a/data-raw/line_admin1.shx and /dev/null differ diff --git a/data-raw/shapefiles.R b/data-raw/shapefiles.R deleted file mode 100644 index db22c8c..0000000 --- a/data-raw/shapefiles.R +++ /dev/null @@ -1,20 +0,0 @@ -#------ Border - admin 0 -border_admin0 <- sf::st_read("data-raw/border_admin0.shp") -usethis::use_data(border_admin0, overwrite = TRUE) - -#------ Frontier - admin 0 -frontier_admin0 <- sf::st_read("data-raw/frontier_admin0.shp") -usethis::use_data(frontier_admin0, overwrite = TRUE) - -#------ Line - admin 1 -line_admin1 <- sf::st_read("data-raw/line_admin1.shp") -usethis::use_data(line_admin1, overwrite = TRUE) - -#------ Centroid - admin 1 -centroid_admin1 <- sf::st_read("data-raw/centroid_admin1.shp") |> - dplyr::rename(ADM1_FR_UPPER = ADM1_FR_) -usethis::use_data(centroid_admin1, overwrite = TRUE) - -#------ Indicator polygon - admin 1 -indicator_admin1 <- sf::st_read("data-raw/indicator_admin1.shp") -usethis::use_data(indicator_admin1, overwrite = TRUE) diff --git a/data/border_admin0.rda b/data/border_admin0.rda deleted file mode 100644 index a6400e1..0000000 Binary files a/data/border_admin0.rda and /dev/null differ diff --git a/data/centroid_admin1.rda b/data/centroid_admin1.rda deleted file mode 100644 index f144be5..0000000 Binary files a/data/centroid_admin1.rda and /dev/null differ diff --git a/data/frontier_admin0.rda b/data/frontier_admin0.rda deleted file mode 100644 index b57263a..0000000 Binary files a/data/frontier_admin0.rda and /dev/null differ diff --git a/data/indicator_admin1.rda b/data/indicator_admin1.rda deleted file mode 100644 index f1a1a63..0000000 Binary files a/data/indicator_admin1.rda and /dev/null differ diff --git a/data/line_admin1.rda b/data/line_admin1.rda deleted file mode 100644 index 9393fdd..0000000 Binary files a/data/line_admin1.rda and /dev/null differ diff --git a/man/bar.Rd b/man/bar.Rd index e1b1797..2a04989 100644 --- a/man/bar.Rd +++ b/man/bar.Rd @@ -1,16 +1,32 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/bar.R -\name{bar} +\name{hbar} +\alias{hbar} \alias{bar} \title{Simple bar chart} \usage{ +hbar( + ..., + flip = TRUE, + add_text = FALSE, + theme_fun = theme_bar(flip = flip, add_text = add_text) +) + bar( df, x, y, group = "", - add_color = color("dark_grey"), - flip = TRUE, + facet = "", + order = "none", + x_rm_na = TRUE, + y_rm_na = TRUE, + group_rm_na = TRUE, + facet_rm_na = TRUE, + y_expand = 0.1, + add_color = color("cat_5_main_1"), + add_color_guide = TRUE, + flip = FALSE, wrap = NULL, position = "dodge", alpha = 1, @@ -20,18 +36,28 @@ bar( title = NULL, subtitle = NULL, caption = NULL, - width = 0.5, - add_text = TRUE, - add_text_size = 5, + width = 0.8, + add_text = FALSE, + add_text_size = 4.5, add_text_color = color("dark_grey"), - add_text_font_face = "plain", + add_text_font_face = "bold", add_text_threshold_display = 0.05, add_text_suffix = "\%", add_text_expand_limit = 1.2, - add_text_round = 1 + add_text_round = 1, + theme_fun = theme_bar(flip = flip, add_text = add_text, axis_text_x_angle = 0, + axis_text_x_vjust = 0.5, axis_text_x_hjust = 0.5), + scale_fill_fun = scale_fill_visualizer_discrete(), + scale_color_fun = scale_color_visualizer_discrete() ) } \arguments{ +\item{flip}{TRUE or FALSE (default). Default to TRUE or horizontal bar plot.} + +\item{add_text}{TRUE or FALSE. Add values as text.} + +\item{theme_fun}{Whatever theme function. For no custom theme, use theme_fun = NULL.} + \item{df}{A data frame.} \item{x}{A quoted numeric column.} @@ -40,9 +66,23 @@ bar( \item{group}{Some quoted grouping categorical column, e.g. administrative areas or population groups.} +\item{facet}{Some quoted grouping categorical column, e.g. administrative areas or population groups.} + +\item{order}{Should bars be ordered? "none" if no, "y" if yes based on y, "grouped" if yes based on y and group.} + +\item{x_rm_na}{Remove NAs in x?} + +\item{y_rm_na}{Remove NAs in y?} + +\item{group_rm_na}{Remove NAs in group?} + +\item{facet_rm_na}{Remove NAs in facet?} + +\item{y_expand}{Multiplier to expand the y axis.} + \item{add_color}{Add a color to bars (if no grouping).} -\item{flip}{TRUE or FALSE. Default to TRUE or horizontal bar plot.} +\item{add_color_guide}{Should a legend be added?} \item{wrap}{Should x-labels be wrapped? Number of characters.} @@ -64,8 +104,6 @@ bar( \item{width}{Bar width.} -\item{add_text}{TRUE or FALSE. Add values as text.} - \item{add_text_size}{Text size.} \item{add_text_color}{Text color.} @@ -76,14 +114,10 @@ bar( \item{add_text_suffix}{If percent is FALSE, should we add a suffix to the text label?} -\item{add_text_expand_limit}{Default to adding 10% on top of the bar.} +\item{add_text_expand_limit}{Default to adding 10\% on top of the bar.} \item{add_text_round}{Round the text label.} - -\item{theme_fun}{Whatever theme function. For no custom theme, use theme_fun = NULL.} - -\item{scale_impact}{Use the package custom scales for fill and color.} } \description{ -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. } diff --git a/man/dumbbell.Rd b/man/dumbbell.Rd new file mode 100644 index 0000000..2bd7437 --- /dev/null +++ b/man/dumbbell.Rd @@ -0,0 +1,85 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dumbbell.R +\name{dumbbell} +\alias{dumbbell} +\title{Make dumbbell chart.} +\usage{ +dumbbell( + df, + col, + group_x, + group_y, + point_size = 5, + point_alpha = 1, + segment_size = 2.5, + segment_color = cols_reach("main_lt_grey"), + group_x_title = NULL, + group_y_title = NULL, + x_title = NULL, + title = NULL, + subtitle = NULL, + caption = NULL, + line_to_y_axis = TRUE, + line_to_y_axis_type = 3, + line_to_y_axis_width = 0.5, + line_to_y_axis_color = cols_reach("main_grey"), + add_text = TRUE, + add_text_vjust = 2, + add_text_size = 3.5, + add_text_color = cols_reach("main_grey"), + theme = theme_reach(palette = "primary") +) +} +\arguments{ +\item{df}{A data frame.} + +\item{col}{A numeric column.} + +\item{group_x}{The grouping column on the x-axis; only two groups.} + +\item{group_y}{The grouping column on the y-axis.} + +\item{point_size}{Point size.} + +\item{point_alpha}{Point alpha.} + +\item{segment_size}{Segment size.} + +\item{segment_color}{Segment color.} + +\item{group_x_title}{X-group and legend title.} + +\item{group_y_title}{Y-axis and group title.} + +\item{x_title}{X-axis title.} + +\item{title}{Title.} + +\item{subtitle}{Subtitle.} + +\item{caption}{Caption.} + +\item{line_to_y_axis}{TRUE or FALSE; add a line connected points and Y-axis.} + +\item{line_to_y_axis_type}{Line to Y-axis type.} + +\item{line_to_y_axis_width}{Line to Y-axis width.} + +\item{line_to_y_axis_color}{Line to Y-axis color.} + +\item{add_text}{TRUE or FALSE; add text at the points.} + +\item{add_text_vjust}{Vertical adjustment.} + +\item{add_text_size}{Text size.} + +\item{add_text_color}{Text color.} + +\item{theme}{A ggplot2 theme, default to `theme_reach()`} +} +\value{ +A dumbbell chart. +} +\description{ +Make dumbbell chart. +} diff --git a/man/figures/README-example-bar-chart-1.png b/man/figures/README-example-bar-chart-1.png index cc3c997..9d1abb0 100644 Binary files a/man/figures/README-example-bar-chart-1.png and b/man/figures/README-example-bar-chart-1.png differ diff --git a/man/figures/README-example-bar-chart-2.png b/man/figures/README-example-bar-chart-2.png index e5cbaad..08e0c94 100644 Binary files a/man/figures/README-example-bar-chart-2.png and b/man/figures/README-example-bar-chart-2.png differ diff --git a/man/figures/README-example-bar-chart-3.png b/man/figures/README-example-bar-chart-3.png index f4b8b7e..950a898 100644 Binary files a/man/figures/README-example-bar-chart-3.png and b/man/figures/README-example-bar-chart-3.png differ diff --git a/man/figures/README-example-bar-chart-4.png b/man/figures/README-example-bar-chart-4.png new file mode 100644 index 0000000..87958f9 Binary files /dev/null and b/man/figures/README-example-bar-chart-4.png differ diff --git a/man/figures/README-example-point-chart-1.png b/man/figures/README-example-point-chart-1.png index f705a3d..f92acd7 100644 Binary files a/man/figures/README-example-point-chart-1.png and b/man/figures/README-example-point-chart-1.png differ diff --git a/man/figures/README-example-point-chart-2.png b/man/figures/README-example-point-chart-2.png index 76ef877..df4c459 100644 Binary files a/man/figures/README-example-point-chart-2.png and b/man/figures/README-example-point-chart-2.png differ diff --git a/man/figures/README-example-point-chart-3.png b/man/figures/README-example-point-chart-3.png index b32aa89..218e708 100644 Binary files a/man/figures/README-example-point-chart-3.png and b/man/figures/README-example-point-chart-3.png differ diff --git a/man/point.Rd b/man/point.Rd index fcf9760..9392c2a 100644 --- a/man/point.Rd +++ b/man/point.Rd @@ -2,14 +2,21 @@ % Please edit documentation in R/point.R \name{point} \alias{point} -\title{Simple point chart} +\title{Simple scatterplot} \usage{ point( df, x, y, group = "", - add_color = color("branding_reach_red"), + facet = "", + facet_scales = "free", + x_rm_na = TRUE, + y_rm_na = TRUE, + group_rm_na = TRUE, + facet_rm_na = TRUE, + add_color = color("cat_5_main_1"), + add_color_guide = TRUE, flip = TRUE, alpha = 1, size = 2, @@ -19,25 +26,37 @@ point( title = NULL, subtitle = NULL, caption = NULL, - theme_fun = theme_reach(grid_major_y = TRUE), - palette = "cat_5_ibm", - scale_impact = TRUE, - direction = 1, - reverse_guide = TRUE + theme_fun = theme_point(), + scale_fill_fun = scale_fill_visualizer_discrete(), + scale_color_fun = scale_color_visualizer_discrete() ) } \arguments{ \item{df}{A data frame.} -\item{x}{A numeric column.} +\item{x}{A quoted numeric column.} -\item{y}{Another numeric column.} +\item{y}{A quoted numeric column.} -\item{group}{Some grouping categorical column, e.g. administrative areas or population groups.} +\item{group}{Some quoted grouping categorical column, e.g. administrative areas or population groups.} -\item{add_color}{Add a color to bars (if no grouping).} +\item{facet}{Some quoted grouping categorical column.} -\item{flip}{TRUE or FALSE. Default to TRUE or horizontal bar plot.} +\item{facet_scales}{Character. Either "free" (default) or "fixed" for facet scales.} + +\item{x_rm_na}{Remove NAs in x?} + +\item{y_rm_na}{Remove NAs in y?} + +\item{group_rm_na}{Remove NAs in group?} + +\item{facet_rm_na}{Remove NAs in facet?} + +\item{add_color}{Add a color to points (if no grouping).} + +\item{add_color_guide}{Should a legend be added?} + +\item{flip}{TRUE or FALSE.} \item{alpha}{Fill transparency.} @@ -55,10 +74,8 @@ point( \item{caption}{Plot caption. Default to NULL.} -\item{theme_fun}{Whatever theme. Default to theme_reach(). NULL if no theming needed.} - -\item{scale_impact}{Use the package custom scales for fill and color.} +\item{theme_fun}{Whatever theme. Default to theme_point(). NULL if no theming needed.} } \description{ -Simple point chart +Simple scatterplot } diff --git a/man/reorder_by.Rd b/man/reorder_by.Rd new file mode 100644 index 0000000..aed3c01 --- /dev/null +++ b/man/reorder_by.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/reorder_by.R +\name{reorder_by} +\alias{reorder_by} +\title{Reorder a Data Frame} +\usage{ +reorder_by(df, x, y, group = "", order = "y", dir_order = 1) +} +\arguments{ +\item{df}{A data frame to be reordered.} + +\item{x}{A character scalar specifying the column to be reordered.} + +\item{y}{A character scalar specifying the column to order by if ordering by values.} + +\item{group}{A character scalar specifying the grouping column (optional).} + +\item{order}{A character scalar specifying the order type (one of "none", "y", "grouped"). See details.} + +\item{dir_order}{A logical scalar specifying whether to flip the order.} +} +\value{ +The reordered data frame. +} +\description{ +Reorder a Data Frame +} +\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. +} +\examples{ +# Example usage +df <- data.frame(col1 = c("b", "a", "c"), col2 = c(10, 25, 3)) +reorder_by(df, "col1", "col2") + +} diff --git a/man/scale_color_visualizer_discrete.Rd b/man/scale_color_visualizer_discrete.Rd index 6915fc8..da8b0d9 100644 --- a/man/scale_color_visualizer_discrete.Rd +++ b/man/scale_color_visualizer_discrete.Rd @@ -11,6 +11,7 @@ scale_color_visualizer_discrete( palette = "cat_5_main", direction = 1, reverse_guide = TRUE, + title_position = NULL, ... ) @@ -18,6 +19,7 @@ scale_fill_visualizer_discrete( palette = "cat_5_main", direction = 1, reverse_guide = TRUE, + title_position = NULL, ... ) @@ -25,6 +27,7 @@ scale_fill_visualizer_continuous( palette = "seq_5_main", direction = 1, reverse_guide = TRUE, + title_position = NULL, ... ) @@ -32,6 +35,7 @@ scale_color_visualizer_continuous( palette = "seq_5_main", direction = 1, reverse_guide = TRUE, + title_position = NULL, ... ) } diff --git a/man/scale_visualizer_discrete.Rd b/man/scale_visualizer_discrete.Rd deleted file mode 100644 index 88a1754..0000000 --- a/man/scale_visualizer_discrete.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/scale.R -\name{scale_visualizer_discrete} -\alias{scale_visualizer_discrete} -\title{One scale for all} -\usage{ -scale_visualizer_discrete( - palette = "cat_5_main", - direction = 1, - reverse_guide = TRUE, - ... -) -} -\arguments{ -\item{palette}{Palette name from [palette()].} - -\item{direction}{1 or -1; should the order of colors be reversed?} - -\item{reverse_guide}{Boolean indicating whether the guide should be reversed.} - -\item{...}{Additional arguments passed to [ggplot2::discrete_scale()] if discrete or [ggplot2::scale_fill_gradient()] if continuous.} -} -\description{ -This function is based on [palette()]. If palette is NULL, the used palette will be magma from gpplot2's viridis scale constructors. -} diff --git a/man/theme_bar.Rd b/man/theme_bar.Rd new file mode 100644 index 0000000..406844e --- /dev/null +++ b/man/theme_bar.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/theme_bar.R +\name{theme_bar} +\alias{theme_bar} +\title{Custom Theme for Bar Charts} +\usage{ +theme_bar( + flip = TRUE, + add_text = FALSE, + axis_text_x_angle = 0, + axis_text_x_vjust = 0.5, + axis_text_x_hjust = 0.5 +) +} +\value{ +A custom theme object. +} +\description{ +Custom Theme for Bar Charts +} diff --git a/man/theme_custom.Rd b/man/theme_custom.Rd deleted file mode 100644 index 922ab6a..0000000 --- a/man/theme_custom.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/theme_bar.R -\name{theme_custom} -\alias{theme_custom} -\title{Custom Theme} -\usage{ -theme_custom() -} -\value{ -A custom theme object. -} -\description{ -Create a custom theme for ggplot2. -} diff --git a/man/theme_visualizer_default.Rd b/man/theme_default.Rd similarity index 86% rename from man/theme_visualizer_default.Rd rename to man/theme_default.Rd index 182c900..1f71818 100644 --- a/man/theme_visualizer_default.Rd +++ b/man/theme_default.Rd @@ -1,21 +1,23 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/theme.R -\name{theme_visualizer_default} -\alias{theme_visualizer_default} +% Please edit documentation in R/theme_default.R +\name{theme_default} +\alias{theme_default} \title{ggplot2 theme wrapper with fonts and colors} \usage{ -theme_visualizer_default( - font_family = "Carlito", - title_size = 14, +theme_default( + title_font_family = "Carlito", + title_size = 16, title_color = color("dark_grey"), title_font_face = "bold", title_hjust = NULL, title_position_to_plot = TRUE, - title_font_family = "Carlito", - subtitle_size = 13, - subtitle_font_face = "plain", subtitle_font_family = "Carlito", - text_size = 12, + subtitle_size = 15, + subtitle_color = color("dark_grey"), + subtitle_font_face = "plain", + subtitle_hjust = NULL, + text_font_family = "Carlito", + text_size = 13, text_color = color("dark_grey"), text_font_face = "plain", panel_background_color = "#FFFFFF", @@ -25,21 +27,29 @@ theme_visualizer_default( legend_direction = "horizontal", legend_justification = "center", legend_reverse = TRUE, - legend_title_size = 12, + legend_title_size = 13, legend_title_color = color("dark_grey"), legend_title_font_face = "plain", - legend_text_size = 12, + legend_title_font_family = "Carlito", + legend_text_size = 13, legend_text_color = color("dark_grey"), legend_text_font_face = "plain", + legend_text_font_family = "Carlito", + facet_size = 14, + facet_color = color("dark_grey"), + facet_font_face = "bold", + facet_font_family = "Carlito", + facet_bg_color = color("lighter_grey"), axis_x = TRUE, axis_y = TRUE, axis_text_x = TRUE, - axis_line_x = TRUE, - axis_ticks_x = TRUE, + axis_line_x = FALSE, + axis_ticks_x = FALSE, axis_text_y = TRUE, axis_line_y = TRUE, axis_ticks_y = TRUE, - axis_text_size = 12, + axis_text_font_family = "Carlito", + axis_text_size = 13, axis_text_color = color("dark_grey"), axis_text_font_face = "plain", axis_title_size = 15, @@ -53,19 +63,21 @@ theme_visualizer_default( grid_major_color = color("dark_grey"), grid_major_x_size = 0.1, grid_major_y_size = 0.1, - grid_minor_x = FALSE, + grid_minor_x = TRUE, grid_minor_y = FALSE, grid_minor_color = color("dark_grey"), grid_minor_x_size = 0.05, grid_minor_y_size = 0.05, + caption_font_family = "Carlito", + caption_font_face = "plain", caption_position_to_plot = TRUE, - caption_text_size = 10, - caption_text_color = color("dark_grey"), + caption_size = 11, + caption_color = color("dark_grey"), ... ) } \arguments{ -\item{font_family}{The font family for all plot's texts. Default to "Segoe UI".} +\item{title_font_family}{Title font family. Default to "Roboto Condensed".} \item{title_size}{The size of the legend title. Defaults to 11.} @@ -77,8 +89,6 @@ theme_visualizer_default( \item{title_position_to_plot}{TRUE or FALSE. Positioning to plot or to panel?} -\item{title_font_family}{Title font family. Default to "Roboto Condensed".} - \item{text_size}{The size of all text other than the title, subtitle and caption. Defaults to 10.} \item{text_color}{Text color.} @@ -169,7 +179,7 @@ theme_visualizer_default( \item{...}{Additional arguments passed to [ggplot2::theme()].} -\item{p}{A ggplot2 object.} +\item{font_family}{The font family for all plot's texts. Default to "Segoe UI".} } \description{ Give some reach colors and fonts to a ggplot. diff --git a/man/theme_point.Rd b/man/theme_point.Rd new file mode 100644 index 0000000..8ee35d2 --- /dev/null +++ b/man/theme_point.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/theme_point.R +\name{theme_point} +\alias{theme_point} +\title{Custom Theme for Point Charts} +\usage{ +theme_point() +} +\arguments{ +\item{flip}{Logical. Whether the plot is flipped (horizonal).} + +\item{axis_text_x_angle}{Angle for x-axis text.} + +\item{axis_text_x_vjust}{Vertical justification for x-axis text.} + +\item{axis_text_x_hjust}{Horizontal justification for x-axis text.} +} +\value{ +A custom theme object. +} +\description{ +Custom Theme for Point Charts +} diff --git a/man/theme_visualizer.Rd b/man/theme_visualizer.Rd deleted file mode 100644 index 204f04d..0000000 --- a/man/theme_visualizer.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/theme_visualizer_bar.R -\docType{data} -\name{ThemeVisualizerBar} -\alias{ThemeVisualizerBar} -\title{ggplot2 theme for bar charts with sane defaults} -\format{ -An object of class \code{ThemeVisualizerBar} (inherits from \code{ggproto}, \code{gg}) of length 1. -} -\usage{ -ThemeVisualizerBar -} -\description{ -ggplot2 theme for bar charts with sane defaults -} -\keyword{datasets} diff --git a/man/theme_visualizer_bar.Rd b/man/theme_visualizer_bar.Rd deleted file mode 100644 index 92651c5..0000000 --- a/man/theme_visualizer_bar.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/theme_visualizer_bar.R -\name{theme_visualizer_bar} -\alias{theme_visualizer_bar} -\title{Dynamic Theme for ggplot2} -\usage{ -theme_visualizer_bar() -} -\value{ -A ggproto object that applies a dynamic theme to a ggplot2 plot. -} -\description{ -A dynamic theme that adjusts axis text styles based on whether the plot is flipped. -} -\details{ -This function dynamically applies different axis text styles depending on -the coordinate system of the plot. If the plot is flipped (e.g., using -`coord_flip()`), the x-axis and y-axis text styles are adjusted accordingly. -} -\examples{ -library(ggplot2) - -# Example with a regular plot -p <- ggplot(mpg, aes(displ, hwy)) + - geom_col() - -# Add the dynamic theme -p + theme_visualizer_bar() - -# Add the dynamic theme with a flipped coordinate system -p + theme_visualizer_bar() + coord_flip() - -} diff --git a/man/visualizeR-package.Rd b/man/visualizeR-package.Rd new file mode 100644 index 0000000..25e9400 --- /dev/null +++ b/man/visualizeR-package.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/visualizeR-package.R +\docType{package} +\name{visualizeR-package} +\alias{visualizeR} +\alias{visualizeR-package} +\title{visualizeR: What a color! What a viz!} +\description{ +\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} + +It basically provides colors as hex codes, color palettes, and some viz functions (graphs and maps). +} +\seealso{ +Useful links: +\itemize{ + \item \url{https://github.com/gnoblet/visualizeR} + \item \url{https://gnoblet.github.io/visualizeR/} +} + +} +\author{ +\strong{Maintainer}: Noblet Guillaume \email{gnoblet@zaclys.net} + +} +\keyword{internal} diff --git a/plot.svg b/plot.svg deleted file mode 100644 index a3a2125..0000000 --- a/plot.svg +++ /dev/null @@ -1,97 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -DRC -Egypt -Ethiopia -Nigeria -Mexico -Brazil -United States -Thailand -Turkey -Iran -Vietnam -Philippines -Japan -Bangladesh -Pakistan -Indonesia -India -China -Germany -Russia - -0 -500 -1000 -Region - - - - -Africa -Americas -Asia -Europe -Population -of -Global -Regions -in -Million - - diff --git a/test-example.R b/test-example.R index 35fd2cf..c917a9a 100644 --- a/test-example.R +++ b/test-example.R @@ -27,8 +27,17 @@ library(visualizeR) library(rio) dat <- import("https://raw.githubusercontent.com/holtzy/data_to_viz/master/Example_dataset/11_SevCatOneNumNestedOneObsPerGroup.csv") +dumbbell( + df, + "stat", + "setting", + "admin1", + title = "% of HHs that reported open defecation as sanitation facility", + group_y_title = "Admin 1", + group_x_title = "Setting" +) + library(dplyr) -library(ggplot2) library(data.table) # dat as a data.table if it4s not if (!checkmate::test_data_table(dat)) { @@ -46,52 +55,43 @@ dat[, value := fifelse(value == -1, NA_real_, value)] # remove lines where value is NA (in place) dat <- dat[!is.na(value), ] -dat +dat # arrange(value) |> # group_by(region) |> # mutate(key = forcats::fct_reorder(key, value)) |> -df = dat |> arrange(value) |> tail(20) |> mutate( - value = value/1000000, - key = ifelse(key == "Democratic Republic of the Congo", "DRC", key)) + + +dumbbell( + dat |> arrange(value) |> tail(50) |> mutate( + value = value/1000000, + key = ifelse(key == "Democratic Republic of the Congo", "DRC", key)) |> + filter(region %in% c("Europe", "Americas")), + "value", + "region", + "key", + title = "% of HHs that reported open defecation as sanitation facility", + group_y_title = "Admin 1", + group_x_title = "Setting", point_size = 3, line_to_y_axis = T + +) + + bar( - df, + df = dat |> arrange(value) |> tail(20) |> mutate( + value = value/1000000, + key = ifelse(key == "Democratic Republic of the Congo", "DRC", key)), x = "key", y = "value", group = "region", group_title = "Region", - facet = "region", - order = "grouped_y", - title = "Population of Global Regions in Million" -) + scale_fill_visualizer_discrete(title_position = "top") + scale_color_visualizer_discrete() - - - -hbar( - df, - x = "key", - y = "value", - group = "region", - group_title = "Region", - facet = "region", - order = "none", - x_rm_na = T, + order = "grouped", + x_rm_na = T, y_rm_na = T, - group_rm_na = T, - title = "Population of Global Regions (in Million)" -) + scale_fill_visualizer_discrete(title_position = "left") + scale_color_visualizer_discrete() - -ggplot2::ggsave( - "plot.svg", - gg - ) - # ggplot2::theme( - # #legend.direction = "horizontal", - # legend.position = "top" - # ) - - -# -#theme_bar(flip = F, axis_text_x_angle = 45) + -#scale_color_visualizer_discrete() + -#scale_fill_visualizer_discrete() + group_rm_na = T, + flip = F, + title = "Population of Global Regions in Million", +) + +theme_bar(flip = F, axis_text_x_angle = 45) + +scale_color_visualizer_discrete() + +scale_fill_visualizer_discrete() diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..fc6a44f --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,12 @@ +# # This file is part of the standard setup for testthat. +# # It is recommended that you do not modify it. +# # +# # Where should you do additional test configuration? +# # Learn more about the roles of various files in: +# # * https://r-pkgs.org/testing-design.html#sec-tests-files-overview +# # * https://testthat.r-lib.org/articles/special-files.html + +# library(testthat) +# library(visualizeR) + +# test_check("visualizeR") diff --git a/tests/testthat/test-bar.R b/tests/testthat/test-bar.R new file mode 100644 index 0000000..f0b5c5f --- /dev/null +++ b/tests/testthat/test-bar.R @@ -0,0 +1,125 @@ +# testthat::test_that("bar() function handles various edge cases", { +# # Setup minimal test data +# test_df <- data.frame( +# category =c("A", "B", "C"), +# value = c(10, 20, 30), +# group = c("X", "X", "Y"), +# facet_var = c("F1", "F1", "F2") +# ) + +# # Test 1: Basic functionality with all parameters +# testthat::expect_s3_class({ +# bar(test_df, x = "category", y = "value", +# position = "dodge", add_text = TRUE, flip = FALSE) +# }, "ggplot") + +# # Test 2: Missing group parameter +# testthat::expect_s3_class({ +# bar(test_df, x = "category", y = "value", facet = "facet_var") +# }, "ggplot") + +# # Test 3: Missing facet parameter +# testthat::expect_s3_class({ +# bar(test_df, x = "category", y = "value", group = "group") +# }, "ggplot") + +# # Test 4: Identical group and facet +# testthat::expect_warning({ +# bar(test_df, x = "category", y = "value", group = "facet_var", facet = "facet_var") +# }, "Using 'facet' for grouping") + +# # Test 5: NA handling scenarios +# na_df <- data.table::data.table( +# category = c("A", "B", NA), +# value = c(10, NA, 30), +# group = c("X", NA, "Y") +# ) + +# # Test 5a: NA removal enabled +# testthat::expect_silent({ +# bar(na_df, x = "category", y = "value", group = "group", +# x_rm_na = TRUE, y_rm_na = TRUE, group_rm_na = TRUE) +# }) + +# # Test 5b: NA removal disabled +# testthat::expect_warning({ +# bar(na_df, x = "category", y = "value", group = "group", +# x_rm_na = FALSE, y_rm_na = FALSE, group_rm_na = FALSE) +# }, "Converting df to data.table") + +# # Test 6: Ordering scenarios +# # Test 6a: Natural order +# testthat::expect_equal( +# levels(bar(test_df, x = "category", y = "value", order = "none")$data$category), +# c("A", "B", "C") +# ) + +# # Test 6b: Ordered by y +# testthat::expect_equal( +# levels(bar(test_df, x = "category", y = "value", order = "y")$data$category), +# c("A", "B", "C") # Should be ordered by value +# ) + +# # Test 7: Faceting edge cases +# # Test 7a: Single facet level +# single_facet <- data.table::data.table( +# category = c("A", "B"), +# value = c(10, 20), +# facet_var = c("F1", "F1") +# ) +# testthat::expect_s3_class({ +# bar(single_facet, x = "category", y = "value", facet = "facet_var") +# }, "ggplot") + +# # Test 8: Text labeling thresholds +# small_values <- data.table::data.table( +# category = c("A", "B"), +# value = c(0.03, 0.04), # Below default 0.05 threshold +# group = c("X", "Y") +# ) +# plot_data <- bar(small_values, x = "category", y = "value", group = "group", add_text = TRUE) +# testthat::expect_true(all(is.na(plot_data$layers[[2]]$data$y_threshold))) + +# # Test 9: Invalid parameter combinations +# testthat::expect_error( +# bar(test_df, x = "value", y = "category"), # Reversed numeric/character +# "must be character or factor" +# ) + +# # Test 10: Facet/group interaction with insufficient data +# sparse_data <- data.table::data.table( +# category = "A", +# value = 10, +# group = "X", +# facet_var = "F1" +# ) +# testthat::expect_s3_class({ +# bar(sparse_data, x = "category", y = "value", group = "group", facet = "facet_var") +# }, "ggplot") +# }) + +# # Visual regression tests (requires vdiffr) +# testthat::test_that("Visual appearance remains consistent", { +# test_df <- data.table::data.table( +# category = factor(c("A", "B", "C")), +# value = c(10, 20, 30), +# group = c("X", "X", "Y"), +# facet_var = c("F1", "F1", "F2") +# ) + +# # Basic plot +# basic <- bar(test_df, x = "category", y = "value") +# vdiffr::expect_doppelganger("basic-bar", basic) + +# # Grouped+dodged +# grouped <- bar(test_df, x = "category", y = "value", group = "group") +# vdiffr::expect_doppelganger("grouped-dodged-bar", grouped) + +# # Faceted +# faceted <- bar(test_df, x = "category", y = "value", facet = "facet_var") +# vdiffr::expect_doppelganger("faceted-bar", faceted) + +# # Stacked +# stacked <- bar(test_df, x = "category", y = "value", group = "group", position = "stack") +# vdiffr::expect_doppelganger("stacked-bar", stacked) +# }) diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 0000000..9e2bd63 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1,4 @@ +*.html +*.R + +/.quarto/ diff --git a/vignettes/bar_charts.Rmd b/vignettes/bar_charts.Rmd new file mode 100644 index 0000000..a9e558a --- /dev/null +++ b/vignettes/bar_charts.Rmd @@ -0,0 +1,57 @@ +--- +title: "Bar charts" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Bar charts} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` +Let's start by importing some data and running some data wrangling: +```{r data-import} +library(rio) +library(data.table) +dat <- import("https://raw.githubusercontent.com/holtzy/data_to_viz/master/Example_dataset/11_SevCatOneNumNestedOneObsPerGroup.csv", data.table = TRUE) +setDT(dat) + +# in all character columns, tranform empty string to NA +vars_chr <- colnames(dat)[sapply(dat, is.character)] +dat[, (vars_chr) := lapply(.SD, function(x) fifelse(x == "", NA_character_, x)), .SDcols = vars_chr] + +# in value, if -1 replace with NA +dat[, value := fifelse(value == -1, NA_real_, value)] + +# remove lines where value is NA (in place) +dat <- dat[!is.na(value), ] + +# kepp only top 20 values and divide data to get million units +df <- dat[ + !is.na(value), ][ + order(value, decreasing = TRUE), ][ + 1:20, ][ + , value := value/1000000, ][ + , key := ifelse(key == "Democratic Republic of the Congo", "DRC", key)] +``` + +Now, let's see the defaults for a horizontal bar diagram without any grouping and ordering values from highest to smallest: + +```{r hbar} +library(visualizeR) + +hbar( + df, + x = "key", + y = "value", + facet = "region", + order = "y", + title = "Top 20 countries by population (in Million)" +) +``` + +Moving on to a vertical bar chart, with country facets and groups