From 8418a55e598aa86498c30280af8e617afc6daa56 Mon Sep 17 00:00:00 2001 From: Matthijs Berends Date: Mon, 26 Aug 2024 16:05:26 +0200 Subject: [PATCH] split from new `plot2::plot2()` --- DESCRIPTION | 32 +- NAMESPACE | 147 +- R/add_mapping.R | 35 - R/add_type.R | 578 --- R/certe_scales.R | 15 +- R/certeplot2-methods.R | 1958 +++++++++ R/data.R | 40 - R/get_plot_title.R | 158 - R/labellers.R | 65 - R/md_to_expression.R | 128 - R/move_layer.R | 56 - R/plot2-methods.R | 3711 ----------------- R/plot2.R | 1756 -------- R/plotly.R | 76 - R/theme_minimal2.R | 106 - R/utils.R | 658 +-- R/validate.R | 2856 ------------- R/zzz.R | 50 + data-raw/generation_admitted_patients.R | 48 - data/admitted_patients.rda | Bin 1752 -> 0 bytes data/netherlands.rda | Bin 163460 -> 0 bytes man/add_mapping.Rd | 22 - man/add_type.Rd | 251 -- man/admitted_patients.Rd | 25 - man/certeplot2-package.Rd | 2 +- man/get_plot_title.Rd | 32 - man/labellers.Rd | 38 - man/md_to_expression.Rd | 51 - man/move_layer.Rd | 18 - man/netherlands.Rd | 21 - man/{plot2-methods.Rd => plot2-extensions.Rd} | 831 +--- man/plot2.Rd | 618 --- man/plotly.Rd | 46 - man/reexports.Rd | 33 - man/scale_certe.Rd | 2 +- man/theme_minimal2.Rd | 42 - pkgdown/extra.css | 12 + tests/testthat/test_plot2.R | 525 +-- vignettes/.gitignore | 2 - vignettes/plot2.Rmd | 584 --- 40 files changed, 2078 insertions(+), 13550 deletions(-) delete mode 100644 R/add_mapping.R delete mode 100644 R/add_type.R create mode 100644 R/certeplot2-methods.R delete mode 100644 R/data.R delete mode 100644 R/get_plot_title.R delete mode 100644 R/labellers.R delete mode 100644 R/md_to_expression.R delete mode 100644 R/move_layer.R delete mode 100644 R/plot2-methods.R delete mode 100644 R/plot2.R delete mode 100644 R/plotly.R delete mode 100644 R/theme_minimal2.R delete mode 100644 R/validate.R create mode 100644 R/zzz.R delete mode 100644 data-raw/generation_admitted_patients.R delete mode 100644 data/admitted_patients.rda delete mode 100644 data/netherlands.rda delete mode 100644 man/add_mapping.Rd delete mode 100644 man/add_type.Rd delete mode 100644 man/admitted_patients.Rd delete mode 100644 man/get_plot_title.Rd delete mode 100644 man/labellers.Rd delete mode 100644 man/md_to_expression.Rd delete mode 100644 man/move_layer.Rd delete mode 100644 man/netherlands.Rd rename man/{plot2-methods.Rd => plot2-extensions.Rd} (65%) delete mode 100644 man/plot2.Rd delete mode 100644 man/plotly.Rd delete mode 100644 man/reexports.Rd delete mode 100644 man/theme_minimal2.Rd delete mode 100644 vignettes/.gitignore delete mode 100644 vignettes/plot2.Rmd diff --git a/DESCRIPTION b/DESCRIPTION index d226de22..64c69543 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: certeplot2 Title: A Certe R Package for Convenient Plotting -Version: 1.24.1 +Version: 2.0.0 Authors@R: c( person(given = c("Matthijs", "S."), family = "Berends", @@ -12,42 +12,25 @@ Authors@R: c( email = "e.hassing@certe.nl"), person(given = "Certe Medical Diagnostics & Advice Foundation", role = c("cph", "fnd"))) -Description: A Certe R Package for fast and convenient plotting, +Description: A Certe R Package for fast and convenient plotting based on 'plot2', by providing wrappers around 'tidyverse' packages such as 'ggplot2', while also providing plotting in the Certe organisational style. This package is part of the 'certedata' universe. URL: https://certe-medical-epidemiology.github.io/certeplot2, https://github.com/certe-medical-epidemiology/certeplot2 Depends: - R (>= 4.1.0) + R (>= 4.1.0), + plot2 (>= 1.25.0) Imports: certestyle, - cleaner (>= 1.5.1), + AMR (>= 2.0.0), dplyr (>= 1.0.0), - forcats (>= 0.5.1), - ggforce (>= 0.4.0), ggplot2 (>= 3.5.1), - rlang (>= 1.1.0), - scales (>= 1.3.0), - stringr (>= 1.4.0), - tibble (>= 3.0.0), - tidyselect (>= 1.2.0), tidyr (>= 1.0.0), yaml (>= 2.2.0) Suggests: - certestats, certegis, - AMR (>= 2.0.0), - glue (>= 1.2.0), - grDevices, - grid (>= 4.3.0), - rmarkdown (>= 2.11), - knitr (>= 1.30), - patchwork (>= 1.0.0), - plotly (>= 4.8.0), - sf (>= 0.9.5), - showtext (>= 0.9.0), - showtextdb (>= 3.0.0), - sysfonts (>= 0.8.0), + certestats, + sf (>= 1.0.0), testthat (>= 2.0.0) License: GPL-2 Encoding: UTF-8 @@ -55,4 +38,3 @@ LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 Config/testthat/edition: 2 -VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index e4acac9a..4ee6a4fc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,180 +2,49 @@ S3method(plot2,antibiogram) S3method(plot2,bug_drug_combinations) -S3method(plot2,data.frame) -S3method(plot2,default) S3method(plot2,early_warning_cluster) -S3method(plot2,freq) -S3method(plot2,matrix) S3method(plot2,qc_test) -S3method(plot2,sf) S3method(plot2,sir_df) -export(add_col) -export(add_errorbar) -export(add_line) -export(add_mapping) -export(add_point) -export(add_sf) -export(add_type) -export(all_of) -export(any_of) -export(as_plotly) -export(big_mark) -export(colourpicker) -export(dec_mark) -export(dollars) -export(ends_with) -export(euros) -export(everything) -export(first) -export(get_plot_title) -export(last) -export(matches) -export(md_to_expression) -export(move_layer) -export(n) -export(n_distinct) -export(plot2) -export(plotly_style) export(scale_color_certe_c) export(scale_color_certe_d) export(scale_colour_certe_c) export(scale_colour_certe_d) export(scale_fill_certe_c) export(scale_fill_certe_d) -export(starts_with) -export(theme_minimal2) -export(where) -importFrom(certestyle,add_white) +importFrom(AMR,ab_name) +importFrom(AMR,as.sir) importFrom(certestyle,big_mark) -importFrom(certestyle,colourpicker) +importFrom(certestyle,certe.colours) importFrom(certestyle,dec_mark) -importFrom(certestyle,font_black) -importFrom(certestyle,font_blue) -importFrom(certestyle,font_bold) -importFrom(certestyle,font_magenta) -importFrom(certestyle,font_stripstyle) -importFrom(certestyle,font_white) importFrom(certestyle,format2) -importFrom(certestyle,format2_scientific) -importFrom(cleaner,as.percentage) -importFrom(cleaner,format_datetime) importFrom(dplyr,`%>%`) -importFrom(dplyr,across) -importFrom(dplyr,all_of) -importFrom(dplyr,any_of) -importFrom(dplyr,arrange) -importFrom(dplyr,as_tibble) -importFrom(dplyr,bind_cols) -importFrom(dplyr,bind_rows) -importFrom(dplyr,count) -importFrom(dplyr,cur_column) -importFrom(dplyr,distinct) importFrom(dplyr,filter) -importFrom(dplyr,first) importFrom(dplyr,group_by) -importFrom(dplyr,group_size) -importFrom(dplyr,if_all) -importFrom(dplyr,if_else) -importFrom(dplyr,is_grouped_df) -importFrom(dplyr,last) importFrom(dplyr,left_join) importFrom(dplyr,mutate) -importFrom(dplyr,n) importFrom(dplyr,n_distinct) -importFrom(dplyr,pull) -importFrom(dplyr,reframe) -importFrom(dplyr,rename) importFrom(dplyr,select) importFrom(dplyr,summarise) importFrom(dplyr,ungroup) -importFrom(dplyr,vars) -importFrom(forcats,fct_inorder) -importFrom(forcats,fct_relabel) -importFrom(forcats,fct_relevel) -importFrom(forcats,fct_reorder) -importFrom(ggforce,geom_parallel_sets) -importFrom(ggforce,geom_parallel_sets_axes) -importFrom(ggforce,geom_parallel_sets_labels) -importFrom(ggplot2,`%+replace%`) importFrom(ggplot2,aes) -importFrom(ggplot2,after_stat) -importFrom(ggplot2,coord_flip) -importFrom(ggplot2,element_blank) -importFrom(ggplot2,element_line) -importFrom(ggplot2,element_rect) importFrom(ggplot2,element_text) -importFrom(ggplot2,expansion) -importFrom(ggplot2,facet_grid) importFrom(ggplot2,facet_wrap) -importFrom(ggplot2,fortify) importFrom(ggplot2,geom_col) -importFrom(ggplot2,geom_density) importFrom(ggplot2,geom_hline) -importFrom(ggplot2,geom_label) importFrom(ggplot2,geom_line) importFrom(ggplot2,geom_point) -importFrom(ggplot2,geom_segment) -importFrom(ggplot2,geom_sf) -importFrom(ggplot2,geom_sf_label) -importFrom(ggplot2,geom_sf_text) -importFrom(ggplot2,geom_smooth) -importFrom(ggplot2,geom_text) importFrom(ggplot2,ggplot) -importFrom(ggplot2,ggplot_build) -importFrom(ggplot2,guide_colourbar) -importFrom(ggplot2,guide_legend) -importFrom(ggplot2,guides) -importFrom(ggplot2,is.ggplot) importFrom(ggplot2,labs) -importFrom(ggplot2,margin) importFrom(ggplot2,position_dodge2) -importFrom(ggplot2,position_fill) -importFrom(ggplot2,position_jitter) -importFrom(ggplot2,position_stack) -importFrom(ggplot2,rel) -importFrom(ggplot2,scale_colour_continuous) -importFrom(ggplot2,scale_colour_date) -importFrom(ggplot2,scale_colour_datetime) importFrom(ggplot2,scale_colour_discrete) -importFrom(ggplot2,scale_colour_gradient) -importFrom(ggplot2,scale_colour_gradient2) importFrom(ggplot2,scale_colour_gradientn) -importFrom(ggplot2,scale_colour_manual) -importFrom(ggplot2,scale_fill_continuous) -importFrom(ggplot2,scale_fill_date) -importFrom(ggplot2,scale_fill_datetime) importFrom(ggplot2,scale_fill_discrete) -importFrom(ggplot2,scale_fill_manual) -importFrom(ggplot2,scale_linetype_manual) -importFrom(ggplot2,scale_linewidth_manual) -importFrom(ggplot2,scale_shape_manual) -importFrom(ggplot2,scale_x_continuous) -importFrom(ggplot2,scale_x_date) -importFrom(ggplot2,scale_x_datetime) -importFrom(ggplot2,scale_x_discrete) -importFrom(ggplot2,scale_y_continuous) -importFrom(ggplot2,sec_axis) -importFrom(ggplot2,stat_boxplot) importFrom(ggplot2,theme) -importFrom(ggplot2,theme_bw) -importFrom(ggplot2,theme_grey) importFrom(ggplot2,unit) -importFrom(ggplot2,waiver) -importFrom(rlang,as_label) -importFrom(rlang,cnd_message) -importFrom(rlang,is_quosure) -importFrom(rlang,new_quosure) -importFrom(scales,pretty_breaks) -importFrom(scales,reverse_trans) -importFrom(stringr,str_sort) -importFrom(tibble,rownames_to_column) -importFrom(tidyr,complete) -importFrom(tidyr,full_seq) +importFrom(plot2,add_line) +importFrom(plot2,add_type) +importFrom(plot2,get_colour) +importFrom(plot2,plot2) +importFrom(plot2,register_colour) importFrom(tidyr,pivot_longer) -importFrom(tidyselect,ends_with) -importFrom(tidyselect,everything) -importFrom(tidyselect,matches) -importFrom(tidyselect,starts_with) -importFrom(tidyselect,where) importFrom(yaml,read_yaml) diff --git a/R/add_mapping.R b/R/add_mapping.R deleted file mode 100644 index cdc80c4a..00000000 --- a/R/add_mapping.R +++ /dev/null @@ -1,35 +0,0 @@ -# ===================================================================== # -# An R package by Certe: # -# https://github.com/certe-medical-epidemiology # -# # -# Licensed as GPL-v2.0. # -# # -# Developed at non-profit organisation Certe Medical Diagnostics & # -# Advice, department of Medical Epidemiology. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# ===================================================================== # - -#' Add Additional Mapping -#' -#' This function can be used to adjust the mapping of a plot. -#' @param plot a `ggplot2` plot -#' @param ... arguments passed on to [ggplot2::aes()] -#' @importFrom ggplot2 aes -#' @export -#' @examples -#' p <- iris |> plot2(Sepal.Length, Sepal.Width, Species, zoom = TRUE) -#' p -#' -#' p |> add_mapping(shape = Species) -add_mapping <- function(plot, ...) { - plot$mapping <- utils::modifyList(plot$mapping, aes(...)) - plot -} diff --git a/R/add_type.R b/R/add_type.R deleted file mode 100644 index aa38587c..00000000 --- a/R/add_type.R +++ /dev/null @@ -1,578 +0,0 @@ -# ===================================================================== # -# An R package by Certe: # -# https://github.com/certe-medical-epidemiology # -# # -# Licensed as GPL-v2.0. # -# # -# Developed at non-profit organisation Certe Medical Diagnostics & # -# Advice, department of Medical Epidemiology. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# ===================================================================== # - -#' Add Plot Element -#' -#' Quickly and conveniently add a new 'geom' to an existing `plot2`/`ggplot` model. Like [plot2()], these functions support tidy evaluation, meaning that variables can be unquoted. Better yet, they can contain any function with any output length, or any vector. They can be added using the pipe (new base \R's `|>` or tidyverse's `%>%`). -#' @param plot a `ggplot2` plot -#' @param type a `ggplot2` geom name, all geoms are supported. Full function names can be used (e.g., `"geom_line"`), but they can also be abbreviated (e.g., `"l"`, `"line"`). These geoms can be abbreviated by their first character: area (`"a"`), boxplot (`"b"`), column (`"c"`), histogram (`"h"`), jitter (`"j"`), line (`"l"`), point (`"p"`), ribbon (`"r"`), violin (`"v"`). -#' @param mapping a mapping created with [`aes()`][ggplot2::aes()] to pass on to the geom -#' @param linetype,linewidth,shape,size,width,... arguments passed on to the geom -#' @param data data to use in mapping -#' @param move number of layers to move the newly added geom down, e.g., `move = 1` will place the newly added geom down 1 layer, thus directly under the highest layer -#' @param inherit.aes a [logical] to indicate whether the default aesthetics should be inherited, rather than combining with them -#' @param legend.value text to show in an additional legend that will be created. Since `ggplot2` does not actually support this, it may give some false-positive warnings or messages, such as "Removed 1 row containing missing values or values outside the scale range". -#' @importFrom ggplot2 is.ggplot aes -#' @rdname add_type -#' @return a `ggplot` object -#' @export -#' @examples -#' head(iris) -#' -#' p <- iris |> -#' plot2(x = Sepal.Length, -#' y = Sepal.Width, -#' category = Species, -#' zoom = TRUE) -#' p -#' -#' # if not specifying x or y, current plot data are taken -#' p |> add_line() -#' -#' # single values for add_line() will plot 'hline' or 'vline' -#' # even considering the `category` if set -#' p |> -#' add_line(y = mean(Sepal.Width)) -#' -#' # set `colour` to ignore existing colours -#' # and use `legend.value` to add a legend -#' p |> -#' add_line(y = mean(Sepal.Width), -#' colour = "red", -#' legend.value = "Average") -#' -#' p |> -#' add_line(x = mean(Sepal.Length)) |> -#' add_line(y = mean(Sepal.Width)) -#' -#' p |> -#' add_point(x = median(Sepal.Length), -#' y = median(Sepal.Width), -#' shape = 13, -#' size = 25, -#' show.legend = FALSE) -#' -#' # multiple values will just plot multiple lines -#' p |> -#' add_line(y = fivenum(Sepal.Width), -#' colour = "blue", -#' legend.value = "Tukey's Numbers") -#' -#' p |> -#' add_line(y = quantile(Sepal.Width, c(0.25, 0.5, 0.75)), -#' colour = c("red", "black", "red"), -#' linewidth = 1) -#' -#' # use move to move the new layer down -#' p |> -#' add_point(size = 5, -#' colour = "lightpink", -#' move = -1) -#' -#' # providing x and y will just plot the points as new data, -#' p |> -#' add_point(y = 2:4, -#' x = 5:7, -#' colour = "red", -#' size = 5) -#' # even with expanded grid if x and y are not of the same length -#' p |> -#' add_point(y = 2:4, -#' x = 5:8, -#' colour = "red", -#' size = 5) -#' -#' # any mathematical transformation of current values is supported -#' df <- data.frame(var_1 = c(1:100), -#' var_2 = rnorm(100, 100, 25)) -#' df |> -#' plot2() |> -#' add_line(y = mean(var_2), -#' linetype = 3, -#' legend.value = "Average") |> -#' add_col(y = var_2 / 5, -#' width = 0.25, -#' colour = "blue", -#' legend.value = "This *is* **some** symbol: $beta$") -#' -#' # plotting error bars was never easier -#' if (require("dplyr", warn.conflicts = FALSE)) { -#' df2 <- df |> -#' as_tibble() |> -#' slice(1:25) |> -#' filter(var_1 <= 50) |> -#' mutate(error1 = var_2 * 0.9, -#' error2 = var_2 * 1.1) -#' -#' print(df2) -#' -#' df2 |> -#' plot2(type = "col", datalabels = FALSE, alpha = 0.25, width = 0.75) |> -#' # add the error bars, simply by referencing the lower and upper values -#' add_errorbar(error1, error2) -#' } -#' -#' if (require("certestats", warn.conflicts = FALSE)) { -#' df |> -#' plot2() |> -#' add_line(y = ewma(var_2, 0.75), -#' colour = "certeroze", -#' linewidth = 1) -#' } -#' -#' if (require("certegis")) { -#' hospitals <- geocode(c("Martini Ziekenhuis", -#' "Medisch Centrum Leeuwarden", -#' "Tjongerschans Heerenveen", -#' "Treant Emmen")) -#' geo_gemeenten |> -#' crop_certe() |> -#' plot2(datalabels = FALSE, -#' category.title = "Inhabitants", -#' colour_fill = c("white", "certeblauw2")) |> -#' add_sf(hospitals, -#' colour = "certeroze", -#' datalabels = place) |> -#' add_sf(geo_provincies |> crop_certe(), -#' colour_fill = NA, -#' colour = "certeblauw", -#' linetype = 2, -#' linewidth = 0.5) -#' } -add_type <- function(plot, type = NULL, mapping = aes(), ..., data = NULL, move = 0) { - if (!is.ggplot(plot)) { - stop("`plot` must be a ggplot2 model.", call. = FALSE) - } - type <- validate_type(type[1L]) - if (type == "") { - stop("`type` must be set for `add_type()`", call. = FALSE) - } else if (type == "geom_smooth") { - plot2_caution("Adding a smooth using `add_type()` is less convenient than using `plot2(..., smooth = TRUE)") - } - - args <- list(...) - if (length(args) == 1 && is.list(args[[1]])) { - args <- args[[1]] - } - # "data" can also be in "args", so: - if (is.null(data)) { - data <- args$data - } - args$data <- NULL - args <- utils::modifyList(list(mapping = mapping, data = data), args) - args <- args[!vapply(FUN.VALUE = logical(1), args, is.null)] - - geom_fn <- getExportedValue(name = type, ns = asNamespace("ggplot2")) - p <- plot + - do.call(geom_fn, args = args) - if (move != 0) { - p <- move_layer(p, move = -abs(move)) - } - p -} - -NA_missing_ <- structure(NA, class = c("missing", "logical")) - -#' @importFrom dplyr mutate group_by across reframe arrange select pull any_of if_else as_tibble bind_cols -#' @importFrom rlang as_label -new_geom_data <- function(plot, x, y, ..., colour_missing, inherit.aes) { - if (!is.null(plot$mapping$colour) && isTRUE(colour_missing)) { - category_name <- as_label(plot$mapping$colour) - colour_unique <- unique(plot$data[[category_name]]) - } else { - category_name <- NULL - colour_unique <- "" - } - - # split the x-part and x-part, so that even `add_point(y = 1:4, x = 1:3)` is possible with expand.grid() - x_part <- plot$data |> - mutate(`_row_index` = seq_len(nrow(plot$data))) |> - # this also works if category is NULL: - group_by(across(category_name)) |> - reframe(x = {{ x }}, - `_row_index` = first(`_row_index`)) |> - arrange(`_row_index`) |> - select(-`_row_index`) - y_part <- plot$data |> - mutate(`_row_index` = seq_len(nrow(plot$data))) |> - # this also works if category is NULL: - group_by(across(category_name)) |> - reframe(y = {{ y }}, - `_row_index` = first(`_row_index`)) |> - arrange(`_row_index`) |> - select(-`_row_index`) - - if (NROW(x_part) == NROW(y_part)) { - new_df <- x_part |> - bind_cols(y_part |> select(-any_of(colnames(x_part)))) - } else if ("x" %in% colnames(x_part) && "y" %in% colnames(y_part)) { - new_df <- expand.grid(x = x_part$x, - y = y_part$y) |> - as_tibble() - category_name <- NULL - } else if ("x" %in% colnames(x_part)) { - new_df <- x_part - } else if ("y" %in% colnames(y_part)) { - new_df <- y_part - } else { - stop("Something went wrong - plot data could not be determined") - } - - has_category <- !is.null(category_name) && !isFALSE(inherit.aes) - has_x <- "x" %in% colnames(new_df) - has_y <- "y" %in% colnames(new_df) - - if (!has_x && !has_y) { - # just used e.g. `plot_object |> add_line()` - inherit.aes <- TRUE - x_name <- as_label(plot$mapping$x) - # has_x <- !identical(x_name, "NULL") - y_name <- as_label(plot$mapping$y) - # has_y <- !identical(y_name, "NULL") - new_df <- plot$data |> select(any_of(c(x_name, y_name))) - } - - if (is.null(inherit.aes)) { - # at this point, if we don't need to inherit, then make sure we don't - inherit.aes <- FALSE - } - - if (inherit.aes == FALSE && !has_x && has_y && NROW(plot$data) == NROW(new_df$y)) { - # add x to data - new_df <- new_df |> - bind_cols(plot$data |> - select(x = as_label(plot$mapping$x))) - has_x <- TRUE - } - if (inherit.aes == FALSE && !has_y && has_x && NROW(plot$data) == NROW(new_df$x)) { - # add y to data - new_df <- new_df |> - bind_cols(plot$data |> - select(y = as_label(plot$mapping$y))) - has_y <- TRUE - } - - # additional parameters - dots <- list(...) - dots <- dots[vapply(FUN.VALUE = logical(1), dots, function(x) !identical(x, NA_missing_))] - params <- list(inherit.aes = inherit.aes) - params <- c(params, dots) - if (has_category) { - params <- utils::modifyList(params, list(colour = NULL, fill = NULL)) - } - - out <- list(plot = plot, - has_category = has_category, - has_x = has_x, - has_y = has_y, - is_single_x = has_x && !has_y && (NROW(new_df) == length(colour_unique) || NROW(new_df) == 1), - is_single_y = has_y && !has_x && (NROW(new_df) == length(colour_unique) || NROW(new_df) == 1), - is_single_xy = has_y && has_x && (NROW(new_df) == length(colour_unique) || NROW(new_df) == 1), - plotdata_is_length_x = has_x && NROW(plot$data) == NROW(new_df$x), - plotdata_is_length_y = has_y && NROW(plot$data) == NROW(new_df$y), - params = params, - mapping = update_aes(x = if (has_x) "x" else as_label(plot$mapping$x), - y = if (has_y) "y" else as_label(plot$mapping$y), - group = 1), - data = if (inherit.aes) NULL else new_df, - new_df = new_df) - - if (!colour_missing && !has_category) { - out$params$colour <- list(...)$colour - } else if (has_category && !inherit.aes) { - out$mapping <- update_aes(out$mapping, colour = category_name) - } - - if (!is.null(out$params$colour)) { - out$params$colour <- colourpicker(out$params$colour) - } - if (!is.null(out$params$fill)) { - out$params$fill <- colourpicker(out$params$fill) - } - - return(out) -} - -#' @rdname add_type -#' @importFrom ggplot2 geom_line aes scale_linetype_manual -#' @param x,y aesthetic arguments -#' @param colour,colour_fill colour of the line or column, will be evaluated with [certestyle::colourpicker()]. If `colour_fill` is missing but `colour` is given, `colour_fill` will inherit the colour set with `colour`. -#' @details The function [add_line()] will add: -#' * [`geom_hline()`][ggplot2::geom_hline()] if only `y` is provided; -#' * [`geom_vline()`][ggplot2::geom_vline()] if only `x` is provided; -#' * [`geom_line()`][ggplot2::geom_line()] in all other cases. -#' @export -add_line <- function(plot, y = NULL, x = NULL, colour = getOption("plot2.colour", "ggplot2"), linetype, linewidth, ..., inherit.aes = NULL, move = 0, legend.value = NULL) { - if (!is.ggplot(plot)) { - stop("`plot` must be a ggplot2 model.", call. = FALSE) - } - if (missing(linetype)) { - linetype <- NA_missing_ - } - if (missing(linewidth)) { - linewidth <- NA_missing_ - } - geom_data <- new_geom_data(plot, x = {{ x }}, y = {{ y }}, - colour = colour, linetype = linetype, linewidth = linewidth, ..., - colour_missing = missing(colour), inherit.aes = inherit.aes) - - if (geom_data$has_y && !geom_data$has_x && !geom_data$plotdata_is_length_y) { - type <- "hline" - mapping <- update_aes(yintercept = "y", colour = geom_data$plot$mapping$colour) - geom_data$params$inherit.aes <- NULL - } else if (geom_data$has_x && !geom_data$has_y && !geom_data$plotdata_is_length_x) { - type <- "vline" - mapping <- update_aes(xintercept = "x", colour = geom_data$plot$mapping$colour) - geom_data$params$inherit.aes <- NULL - } else { - type <- "line" - mapping <- geom_data$mapping - } - - p <- add_type(plot = geom_data$plot, - type = type, - data = geom_data$data, - mapping = mapping, - params = geom_data$params, - move = move) - - if (!is.null(legend.value)) { - if (is.expression(validate_title(legend.value, markdown = TRUE))) { - label_fn <- md_to_expression - } else { - label_fn <- function(x) x - } - linetype <- ifelse(identical(linetype, NA_missing_), "solid", linetype) - p <- p + - geom_line(data = data.frame(x = c(Inf, Inf), y = c(Inf, Inf), group = c(legend.value, legend.value)), - mapping = aes(x = x, y = y, linetype = group, group = group), - colour = colourpicker(colour[1L]), - linewidth = validate_linewidth(geom_data$params$linewidth, type = "geom_line", type_backup = "geom_line"), - inherit.aes = FALSE) + - scale_linetype_manual(name = NULL, values = stats::setNames(linetype, legend.value), labels = label_fn) - } - - p -} - -#' @rdname add_type -#' @importFrom ggplot2 geom_point aes scale_shape_manual -#' @export -add_point <- function(plot, y = NULL, x = NULL, colour = getOption("plot2.colour", "ggplot2"), size, shape, ..., inherit.aes = NULL, move = 0, legend.value = NULL) { - if (!is.ggplot(plot)) { - stop("`plot` must be a ggplot2 model.", call. = FALSE) - } - if (missing(size)) { - size <- NA_missing_ - } - if (missing(shape)) { - shape <- NA_missing_ - } - geom_data <- new_geom_data(plot, x = {{ x }}, y = {{ y }}, - colour = colour, size = size, shape = shape, ..., - colour_missing = missing(colour), inherit.aes = inherit.aes) - - p <- add_type(plot = geom_data$plot, - type = "point", - data = geom_data$data, - mapping = geom_data$mapping, - params = geom_data$params, - move = move) - - if (!is.null(legend.value)) { - if (is.expression(validate_title(legend.value, markdown = TRUE))) { - label_fn <- md_to_expression - } else { - label_fn <- function(x) x - } - p <- p + - geom_point(data = data.frame(x = c(Inf, Inf), y = c(-Inf, -Inf), group = c(legend.value, legend.value)), - mapping = aes(x = x, y = y, shape = group, group = group), - colour = colourpicker(colour[1L]), - size = validate_size(geom_data$params$size, type = "geom_point", type_backup = "geom_point"), - inherit.aes = FALSE) + - scale_shape_manual(name = NULL, values = stats::setNames(16, legend.value), labels = label_fn) - } - - p -} - -#' @rdname add_type -#' @importFrom ggplot2 geom_line aes scale_linewidth_manual -#' @export -add_col <- function(plot, y = NULL, x = NULL, colour = getOption("plot2.colour", "ggplot2"), colour_fill, width, ..., inherit.aes = NULL, move = 0, legend.value = NULL) { - if (!is.ggplot(plot)) { - stop("`plot` must be a ggplot2 model.", call. = FALSE) - } - if (missing(colour_fill)) { - fill <- colour - } else { - fill <- colour_fill - } - if (missing(width)) { - width <- NA_missing_ - } - geom_data <- new_geom_data(plot, x = {{ x }}, y = {{ y }}, - colour = colour, fill = fill, width = width, ..., - colour_missing = missing(colour), inherit.aes = inherit.aes) - - p <- add_type(plot = geom_data$plot, - type = "column", - data = geom_data$data, - mapping = geom_data$mapping, - params = geom_data$params, - move = move) - - if (!is.null(legend.value)) { - if (is.expression(validate_title(legend.value, markdown = TRUE))) { - label_fn <- md_to_expression - } else { - label_fn <- function(x) x - } - p <- p + - geom_col(data = data.frame(x = c(Inf, Inf), y = c(Inf, Inf), group = c(legend.value, legend.value)), - mapping = aes(x = x, y = y, linewidth = group, group = group), - colour = colourpicker(colour[1L]), - fill = colourpicker(colour[1L]), - inherit.aes = FALSE) + - scale_linewidth_manual(name = NULL, values = stats::setNames(0.25, legend.value), labels = label_fn) - } - - p -} - -#' @rdname add_type -#' @param min,max minimum (lower) and maximum (upper) values of the error bars -#' @importFrom dplyr reframe -#' @importFrom ggplot2 aes -#' @importFrom rlang as_label -#' @importFrom certestyle colourpicker -#' @details -#' The function [add_errorbar()] only adds error bars to the `y` values, see *Examples*. -#' @export -add_errorbar <- function(plot, min, max, colour = getOption("plot2.colour", "ggplot2"), width = 0.5, ..., inherit.aes = FALSE, move = 0) { - if (!is.ggplot(plot)) { - stop("`plot` must be a ggplot2 model.", call. = FALSE) - } - - new_df <- plot$data |> - reframe(ymin = {{ min }}, - ymax = {{ max }}) - new_df$x <- plot$data[[as_label(plot$mapping$x)]] - - # build additional parameters - params <- list(inherit.aes = inherit.aes) - if (!missing(colour) || !isTRUE(inherit.aes) || !"colour" %in% names(plot$mapping)) { - params <- c(params, list(colour = colourpicker(colour))) - } - params <- c(params, list(width = width)) - if (length(list(...)) > 0) { - params <- c(params, list(...)) - } - - add_type(plot = plot, - type = "errorbar", - data = new_df, - mapping = aes(x = x, ymin = ymin, ymax = ymax), - params = params, - move = move) -} - -#' @rdname add_type -#' @param sf_data an 'sf' [data.frame], such as the outcome of [certegis::geocode()] -#' @param datalabels a column of `sf_data` to add as label below the points -#' @param datalabels.colour,datalabels.size,datalabels.angle,datalabels.font properties of `datalabels` -#' @param datalabels.nudge_y is `datalabels` is not `NULL`, the amount of vertical adjustment of the datalabels (positive value: more to the North, negative value: more to the South) -#' @importFrom dplyr mutate -#' @importFrom ggplot2 geom_sf geom_sf_text aes is.ggplot -#' @importFrom certestyle colourpicker -#' @export -add_sf <- function(plot, - sf_data, - colour = getOption("plot2.colour_sf", "grey50"), - colour_fill = getOption("plot2.colour_sf_fill", getOption("plot2.colour", "ggplot2")), - size = 2, - linewidth = 0.1, - datalabels = NULL, - datalabels.colour = "black", - datalabels.size = 3, - datalabels.angle = 0, - datalabels.font = getOption("plot2.font"), - datalabels.nudge_y = 2500, - ..., - inherit.aes = FALSE) { - - loadNamespace("sf") # will throw an error if not installed - - if (!is.ggplot(plot)) { - stop("`plot` must be a ggplot2 model.", call. = FALSE) - } - if (!"geometry" %in% colnames(plot$data)) { - stop("`plot` must be a ggplot2 model based on geographic data.", call. = FALSE) - } - - # force sf type - sf_data <- sf::st_as_sf(sf_data) - - crs <- c(plot = as.character(sf::st_crs(plot$data$geometry))[1], - add = as.character(sf::st_crs(sf_data))[1]) - if (n_distinct(crs) > 1) { - plot2_warning("The coordinate reference system (CRS) of `plot` and `sf_data` are different, transforming `sf_data` to ", crs[1]) - sf_data <- sf::st_transform(sf_data, crs = crs[1]) - } - crs <- crs[1] - - p <- plot + - geom_sf(data = sf_data, - inherit.aes = inherit.aes, - size = size, - linewidth = linewidth, - colour = colourpicker(colour), - fill = colourpicker(colour_fill), - ...) - - if (tryCatch(!is.null(datalabels), error = function(e) TRUE)) { - - if (abs(datalabels.nudge_y) > 0.25 && crs %unlike% "28992") { - plot2_message(font_blue(paste0("datalabels.nudge_y = ", datalabels.nudge_y)), - " might be very ", ifelse(datalabels.nudge_y < 0, "low", "high"), - " for the current coordinate reference system (", crs, ")") - } - - sf_data <- sf_data |> - mutate(`_var_datalabels` = {{ datalabels }}) - - datalabels.font <- suppressMessages(validate_font(datalabels.font)) - - p <- p + - geom_sf_text(aes(label = `_var_datalabels`), - data = sf_data, - inherit.aes = inherit.aes, - size = datalabels.size, - family = datalabels.font, - angle = datalabels.angle, - nudge_y = datalabels.nudge_y, - colour = colourpicker(colour), - fun.geometry = function(x) { - x[!sf::st_is_valid(x)] <- sf::st_point() - suppressWarnings(sf::st_point_on_surface(sf::st_zm(x))) - }) - } - p -} diff --git a/R/certe_scales.R b/R/certe_scales.R index f2781fc8..fb63bb96 100644 --- a/R/certe_scales.R +++ b/R/certe_scales.R @@ -22,7 +22,6 @@ #' These scales apply the colours of Certe, using the 'certestyle' package. #' @inheritParams ggplot2::scale_colour_gradientn #' @importFrom ggplot2 scale_colour_gradientn scale_colour_discrete scale_fill_discrete -#' @importFrom certestyle colourpicker #' @name scale_certe #' @rdname scale_certe #' @export @@ -33,8 +32,8 @@ scale_colour_certe_c <- function(..., guide = "colourbar", aesthetics = "colour") { scale_colour_gradientn(..., - colours = colourpicker(c("certeblauw0", "certegroen", - "certegeel", "certeroze")), + colours = get_colour(c("certeblauw0", "certegroen", + "certegeel", "certeroze")), values = values, space = space, na.value = na.value, @@ -55,8 +54,8 @@ scale_fill_certe_c <- function(..., guide = "colourbar", aesthetics = "fill") { scale_colour_gradientn(..., - colours = colourpicker(c("certeblauw0", "certegroen", - "certegeel", "certeroze")), + colours = get_colour(c("certeblauw0", "certegroen", + "certegeel", "certeroze")), values = values, space = space, na.value = na.value, @@ -65,10 +64,10 @@ scale_fill_certe_c <- function(..., } #' @rdname scale_certe -#' @param colour a Certe colour set: `"certe"`, `"certe2"`, `"certe3"`, etc. Will be evaluated with [certestyle::colourpicker()]. +#' @param colour a Certe colour set: `"certe"`, `"certe2"`, `"certe3"`, etc. Will be evaluated with [get_colour()]. #' @export scale_colour_certe_d <- function(colour = "certe") { - scale_colour_discrete(type = colourpicker(colour, 50)) + scale_colour_discrete(type = get_colour(colour, 50)) } #' @rdname scale_certe @@ -78,5 +77,5 @@ scale_color_certe_d <- scale_colour_certe_d #' @rdname scale_certe #' @export scale_fill_certe_d <- function(colour = "certe") { - scale_fill_discrete(type = colourpicker(colour, 50)) + scale_fill_discrete(type = get_colour(colour, 50)) } diff --git a/R/certeplot2-methods.R b/R/certeplot2-methods.R new file mode 100644 index 00000000..46bf74e2 --- /dev/null +++ b/R/certeplot2-methods.R @@ -0,0 +1,1958 @@ +# ===================================================================== # +# An R package by Certe: # +# https://github.com/certe-medical-epidemiology # +# # +# Licensed as GPL-v2.0. # +# # +# Developed at non-profit organisation Certe Medical Diagnostics & # +# Advice, department of Medical Epidemiology. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# ===================================================================== # + +#' Methods for [plot2()] +#' +#' These are the implemented methods for different S3 classes to be used in [plot2()]. Since they have an extensive list of arguments, they are placed here on a separate manual page. +#' @rdname plot2-extensions +#' @name plot2-extensions +#' @importFrom plot2 plot2 +#' @inheritParams plot2::plot2 +#' @details For antimicrobial resistance (AMR) data analysis, use the [`bug_drug_combinations()`][AMR::bug_drug_combinations()] or the [`sir_df()`][AMR::sir_df()] function from the `AMR` package on a data set with antibiograms. The result can be used as input for [plot2()]. +#' @param minimum minimum number of results, defaults to `30` +#' @param remove_intrinsic_resistant a [logical] to indicate that rows with 100% resistance must be removed from the data set before plotting +#' @param language language to be used for antibiotic names +#' @importFrom plot2 plot2 get_colour +#' @importFrom AMR ab_name as.sir +#' @importFrom dplyr filter select mutate +#' @importFrom tidyr pivot_longer +#' @importFrom certestyle dec_mark big_mark +#' @export +plot2.bug_drug_combinations <- function(.data, + x = ab, + y = value, + category = name, + facet = mo, + type = "column", + x.title = FALSE, + y.title = FALSE, + category.title = NULL, + title = NULL, + subtitle = NULL, + caption = NULL, + tag = NULL, + title.linelength = 60, + title.colour = getOption("plot2.colour_font_primary", "black"), + subtitle.linelength = 60, + subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), + na.replace = "", + na.rm = FALSE, + facet.position = "top", + facet.fill = NULL, + facet.bold = TRUE, + facet.italic = FALSE, + facet.size = 10, + facet.margin = 8, + facet.repeat_lbls_x = TRUE, + facet.repeat_lbls_y = TRUE, + facet.fixed_y = NULL, + facet.fixed_x = TRUE, + facet.drop = FALSE, + facet.nrow = NULL, + facet.relative = FALSE, + x.date_breaks = NULL, + x.date_labels = NULL, + x.date_remove_years = NULL, + category.focus = NULL, + colour = get_colour("certe_sir2", 7), + colour_fill = NULL, + colour_opacity = 0, + x.lbl_angle = ifelse(horizontal, 0, 90), + x.lbl_align = NULL, + x.lbl_italic = FALSE, + x.lbl_taxonomy = TRUE, + x.remove = FALSE, + x.position = "bottom", + x.max_items = Inf, + x.max_txt = "(rest, x%n)", + category.max_items = Inf, + category.max_txt = "(rest, x%n)", + facet.max_items = Inf, + facet.max_txt = "(rest, x%n)", + x.breaks = NULL, + x.n_breaks = NULL, + x.transform = "identity", + x.expand = NULL, + x.limits = NULL, + x.labels = NULL, + x.character = NULL, + x.drop = FALSE, + x.mic = FALSE, + x.zoom = FALSE, + y.remove = FALSE, + y.24h = FALSE, + y.age = FALSE, + y.scientific = NULL, + y.percent = FALSE, + y.percent_break = 0.1, + y.breaks = NULL, + y.n_breaks = NULL, + y.limits = NULL, + y.labels = NULL, + y.expand = NULL, + y.transform = "identity", + y.position = "left", + y.zoom = FALSE, + y_secondary = NULL, + y_secondary.type = type, + y_secondary.title = TRUE, + y_secondary.colour = "certeroze", + y_secondary.colour_fill = "certeroze6", + y_secondary.scientific = NULL, + y_secondary.percent = FALSE, + y_secondary.labels = NULL, + category.labels = NULL, + category.percent = FALSE, + category.breaks = NULL, + category.limits = NULL, + category.expand = 0, + category.midpoint = NULL, + category.transform = "identity", + category.date_breaks = NULL, + category.date_labels = NULL, + category.character = NULL, + x.sort = NULL, + category.sort = FALSE, + facet.sort = TRUE, + x.complete = NULL, + category.complete = NULL, + facet.complete = NULL, + datalabels = TRUE, + datalabels.round = ifelse(y.percent, 2, 1), + datalabels.format = "%n", + datalabels.colour = "grey25", + datalabels.colour_fill = NULL, + datalabels.size = (3 * text_factor), + datalabels.angle = 0, + datalabels.lineheight = 1.0, + decimal.mark = dec_mark(), + big.mark = big_mark(), + summarise_function = base::sum, + stacked = FALSE, + stackedpercent = TRUE, + horizontal = TRUE, + reverse = TRUE, + smooth = NULL, + smooth.method = NULL, + smooth.formula = NULL, + smooth.se = TRUE, + smooth.level = 0.95, + smooth.alpha = 0.25, + smooth.linewidth = 0.75, + smooth.linetype = 3, + smooth.colour = NULL, + size = NULL, + linetype = 1, + linewidth = NULL, + binwidth = NULL, + width = NULL, + jitter_seed = NA, + violin_scale = "count", + legend.position = NULL, + legend.title = NULL, # TRUE in numeric categories + legend.reverse = TRUE, + legend.barheight = 6, + legend.barwidth = 1.5, + legend.nbin = 300, + legend.italic = FALSE, + sankey.node_width = 0.15, + sankey.node_whitespace = 0.03, + sankey.alpha = 0.5, + sankey.remove_axes = NULL, + zoom = FALSE, + sep = " / ", + print = FALSE, + text_factor = 1, + font = getOption("plot2.font"), + theme = getOption("plot2.theme", "theme_minimal2"), + background = getOption("plot2.colour_background", "white"), + markdown = TRUE, + minimum = 30, + remove_intrinsic_resistant = TRUE, + language = "nl", + ...) { + + df <- .data + if (isTRUE(remove_intrinsic_resistant)) { + df <- df |> + filter(total != R) + } + df <- df |> + filter(total >= minimum) |> + select(-total) |> + mutate(ab = ab_name(ab, language = language)) |> + pivot_longer(-c(mo, ab)) |> + mutate(name = as.sir(name)) |> + filter(value != 0 | name %in% c("S", "I", "R")) + + plot2(.data = df, + x = {{ x }}, + y = {{ y }}, + category = {{ category }}, + facet = {{ facet }}, + type = type, + x.title = {{ x.title }}, + y.title = {{ y.title }}, + category.title = {{ category.title }}, + title = {{ title }}, + subtitle = {{ subtitle }}, + caption = {{ caption }}, + tag = {{ tag }}, + title.linelength = title.linelength, + title.colour = title.colour, + subtitle.linelength = subtitle.linelength, + subtitle.colour = subtitle.colour, + na.replace = na.replace, + na.rm = na.rm, + facet.position = facet.position, + facet.fill = facet.fill, + facet.bold = facet.bold, + facet.italic = facet.italic, + facet.size = facet.size, + facet.margin = facet.margin, + facet.repeat_lbls_x = facet.repeat_lbls_x, + facet.repeat_lbls_y = facet.repeat_lbls_y, + facet.fixed_y = facet.fixed_y, + facet.fixed_x = facet.fixed_x, + facet.drop = facet.drop, + facet.nrow = facet.nrow, + facet.relative = facet.relative, + x.date_breaks = x.date_breaks, + x.date_labels = x.date_labels, + x.date_remove_years = x.date_remove_years, + category.focus = category.focus, + colour = colour, + colour_fill = colour_fill, + colour_opacity = colour_opacity, + x.lbl_angle = x.lbl_angle, + x.lbl_align = x.lbl_align, + x.lbl_italic = x.lbl_italic, + x.lbl_taxonomy = x.lbl_taxonomy, + x.remove = x.remove, + x.position = x.position, + x.max_items = x.max_items, + x.max_txt = x.max_txt, + category.max_items = category.max_items, + category.max_txt = category.max_txt, + facet.max_items = facet.max_items, + facet.max_txt = facet.max_txt, + x.breaks = x.breaks, + x.n_breaks = x.n_breaks, + x.transform = x.transform, + x.expand = x.expand, + x.limits = x.limits, + x.labels = x.labels, + x.character = x.character, + x.drop = x.drop, + x.mic = x.mic, + x.zoom = x.zoom, + y.remove = y.remove, + y.24h = y.24h, + y.age = y.age, + y.scientific = y.scientific, + y.percent = y.percent, + y.percent_break = y.percent_break, + y.breaks = y.breaks, + y.n_breaks = y.n_breaks, + y.limits = y.limits, + y.labels = y.labels, + y.expand = y.expand, + y.transform = y.transform, + y.position = y.position, + y.zoom = y.zoom, + y_secondary = {{ y_secondary }}, + y_secondary.type = y_secondary.type, + y_secondary.title = {{ y_secondary.title }}, + y_secondary.colour = y_secondary.colour, + y_secondary.colour_fill = y_secondary.colour_fill, + y_secondary.scientific = y_secondary.scientific, + y_secondary.percent = y_secondary.percent, + y_secondary.labels = y_secondary.labels, + category.labels = category.labels, + category.percent = category.percent, + category.breaks = category.breaks, + category.limits = category.limits, + category.expand = category.expand, + category.midpoint = category.midpoint, + category.transform = category.transform, + category.date_breaks = category.date_breaks, + category.date_labels = category.date_labels, + category.character = category.character, + x.sort = x.sort, + category.sort = category.sort, + facet.sort = facet.sort, + x.complete = x.complete, + category.complete = category.complete, + facet.complete = facet.complete, + datalabels = {{ datalabels }}, + datalabels.round = datalabels.round, + datalabels.colour = datalabels.colour, + datalabels.format = datalabels.format, + datalabels.colour_fill = datalabels.colour_fill, + datalabels.size = datalabels.size, + datalabels.angle = datalabels.angle, + datalabels.lineheight = datalabels.lineheight, + decimal.mark = decimal.mark, + big.mark = big.mark, + summarise_function = summarise_function, + stacked = stacked, + stackedpercent = stackedpercent, + horizontal = horizontal, + reverse = reverse, + smooth = smooth, + smooth.method = smooth.method, + smooth.formula = smooth.formula, + smooth.se = smooth.se, + smooth.level = smooth.level, + smooth.alpha = smooth.alpha, + smooth.linewidth = smooth.linewidth, + smooth.linetype = smooth.linetype, + smooth.colour = smooth.colour, + size = size, + linetype = linetype, + linewidth = linewidth, + binwidth = binwidth, + width = width, + jitter_seed = jitter_seed, + violin_scale = violin_scale, + legend.position = legend.position, + legend.title = {{ legend.title }}, + legend.reverse = legend.reverse, + legend.barheight = legend.barheight, + legend.barwidth = legend.barwidth, + legend.nbin = legend.nbin, + legend.italic = legend.italic, + sankey.node_width = sankey.node_width, + sankey.node_whitespace = sankey.node_whitespace, + sankey.alpha = sankey.alpha, + sankey.remove_axes = sankey.remove_axes, + zoom = zoom, + sep = sep, + print = print, + text_factor = text_factor, + font = font, + theme = theme, + background = background, + markdown = markdown, + `_misses.x` = missing(x), + `_misses.y` = missing(y), + `_misses.category` = missing(category), + `_misses.facet` = missing(facet), + `_misses.datalabels` = missing(datalabels), + `_misses.colour_fill` = missing(colour_fill), + `_misses.x.title` = FALSE, + `_misses.y.title` = FALSE, + `_misses.title` = missing(title), + `_misses.subtitle` = missing(subtitle), + `_misses.tag` = missing(tag), + `_misses.caption` = missing(caption), + `_misses.y.percent` = missing(y.percent), + `_misses.y.percent_break` = missing(y.percent_break), + `_misses.x.zoom` = missing(x.zoom), + `_misses.x.max_items` = missing(x.max_items), + `_misses.facet.fixed_x` = missing(facet.fixed_x), + `_label.x` = deparse(substitute(x)), + `_label.y` = deparse(substitute(y)), + `_label.category` = deparse(substitute(category)), + `_label.facet` = deparse(substitute(facet)), + `_label.y_secondary` = deparse(substitute(y_secondary)), + `_summarise_fn_name` = deparse(substitute(summarise_function)), + `_misses.summarise_function` = missing(summarise_function), + ...) +} + +#' @rdname plot2-extensions +#' @importFrom ggplot2 aes facet_wrap geom_col ggplot labs position_dodge2 +#' @importFrom dplyr mutate +#' @importFrom plot2 plot2 get_colour +#' @export +#' @examples +#' +#' # AMR DATA ANALYSIS ---------------------------------------------------- +#' if (require("AMR")) { +#' example_isolates[, c("mo", "AMX", "AMC", "ward")] |> +#' antibiogram(mo_transform = "gramstain", +#' language = "nl") |> +#' plot2() +#' } +#' +#' if (require("AMR")) { +#' example_isolates[, c("mo", "AMX", "AMC", "ward")] |> +#' antibiogram(mo_transform = "gramstain", +#' language = "nl", +#' syndromic_group = "ward") |> +#' plot2() +#' } +plot2.antibiogram <- function(.data, + x = NULL, + y = NULL, + category = NULL, + facet = NULL, + type = NULL, + x.title = NULL, + y.title = NULL, + category.title = NULL, + title = NULL, + subtitle = NULL, + caption = NULL, + tag = NULL, + title.linelength = 60, + title.colour = getOption("plot2.colour_font_primary", "black"), + subtitle.linelength = 60, + subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), + na.replace = "", + na.rm = FALSE, + facet.position = "top", + facet.fill = NULL, + facet.bold = TRUE, + facet.italic = FALSE, + facet.size = 10, + facet.margin = 8, + facet.repeat_lbls_x = TRUE, + facet.repeat_lbls_y = TRUE, + facet.fixed_y = NULL, + facet.fixed_x = TRUE, + facet.drop = FALSE, + facet.nrow = NULL, + facet.relative = FALSE, + x.date_breaks = NULL, + x.date_labels = NULL, + x.date_remove_years = NULL, + category.focus = NULL, + colour = getOption("plot2.colour", "ggplot2"), + colour_fill = NULL, + colour_opacity = 0, + x.lbl_angle = 0, + x.lbl_align = NULL, + x.lbl_italic = FALSE, + x.lbl_taxonomy = FALSE, + x.remove = FALSE, + x.position = "bottom", + x.max_items = Inf, + x.max_txt = "(rest, x%n)", + category.max_items = Inf, + category.max_txt = "(rest, x%n)", + facet.max_items = Inf, + facet.max_txt = "(rest, x%n)", + x.breaks = NULL, + x.n_breaks = NULL, + x.transform = "identity", + x.expand = NULL, + x.limits = NULL, + x.labels = NULL, + x.character = NULL, + x.drop = FALSE, + x.mic = FALSE, + x.zoom = FALSE, + y.remove = FALSE, + y.24h = FALSE, + y.age = FALSE, + y.scientific = NULL, + y.percent = FALSE, + y.percent_break = 0.1, + y.breaks = NULL, + y.n_breaks = NULL, + y.limits = NULL, + y.labels = NULL, + y.expand = NULL, + y.transform = "identity", + y.position = "left", + y.zoom = FALSE, + y_secondary = NULL, + y_secondary.type = type, + y_secondary.title = TRUE, + y_secondary.colour = "certeroze", + y_secondary.colour_fill = "certeroze6", + y_secondary.scientific = NULL, + y_secondary.percent = FALSE, + y_secondary.labels = NULL, + category.labels = NULL, + category.percent = FALSE, + category.breaks = NULL, + category.limits = NULL, + category.expand = 0, + category.midpoint = NULL, + category.transform = "identity", + category.date_breaks = NULL, + category.date_labels = NULL, + category.character = NULL, + x.sort = NULL, + category.sort = TRUE, + facet.sort = TRUE, + x.complete = NULL, + category.complete = NULL, + facet.complete = NULL, + datalabels = TRUE, + datalabels.round = ifelse(y.percent, 2, 1), + datalabels.format = "%n", + datalabels.colour = "grey25", + datalabels.colour_fill = NULL, + datalabels.size = (3 * text_factor), + datalabels.angle = 0, + datalabels.lineheight = 1.0, + decimal.mark = dec_mark(), + big.mark = big_mark(), + summarise_function = base::sum, + stacked = FALSE, + stackedpercent = FALSE, + horizontal = FALSE, + reverse = horizontal, + smooth = NULL, + smooth.method = NULL, + smooth.formula = NULL, + smooth.se = TRUE, + smooth.level = 0.95, + smooth.alpha = 0.25, + smooth.linewidth = 0.75, + smooth.linetype = 3, + smooth.colour = NULL, + size = NULL, + linetype = 1, + linewidth = NULL, + binwidth = NULL, + width = NULL, + jitter_seed = NA, + violin_scale = "count", + legend.position = NULL, + legend.title = NULL, # will become TRUE in numeric categories if left NULL + legend.reverse = FALSE, + legend.barheight = 6, + legend.barwidth = 1.5, + legend.nbin = 300, + legend.italic = FALSE, + sankey.node_width = 0.15, + sankey.node_whitespace = 0.03, + sankey.alpha = 0.5, + sankey.remove_axes = NULL, + zoom = FALSE, + sep = " / ", + print = FALSE, + text_factor = 1, + font = getOption("plot2.font"), + theme = getOption("plot2.theme", "theme_minimal2"), + background = getOption("plot2.colour_background", "white"), + markdown = TRUE, + ...) { + + df <- attributes(.data)$long + + if ("syndromic_group" %in% colnames(df)) { + geom <- geom_col( + aes( + x = ab, + y = SI * 100, + fill = if ("syndromic_group" %in% colnames(df)) { + syndromic_group + } else { + NULL + } + ), + position = position_dodge2(preserve = "single")) + } else { + geom <- geom_col( + aes( + x = ab, + y = SI * 100, + ), + fill = get_colour(colour, length = 1), + position = position_dodge2(preserve = "single")) + } + + p <- ggplot(df) + + geom + + facet_wrap("mo") + + labs( + y = ifelse(isTRUE(attributes(.data)$combine_SI), "%SI", "%S"), + x = NULL, + fill = if ("syndromic_group" %in% colnames(df)) { + colnames(.data)[1] + } else { + NULL + } + ) + + validate_theme <- get("validate_theme", envir = asNamespace("plot2")) + theme <- validate_theme(theme = theme, + type = "geom_col", + background = background, + text_factor = text_factor, + font = font, + horizontal = FALSE, + x.remove = NULL, + y.remove = NULL, + x.lbl_angle = 0, + x.lbl_align = NULL, + x.lbl_italic = NULL, + facet.fill = NULL, + facet.bold = NULL, + facet.italic = NULL, + facet.size = 10, + facet.margin = 8, + legend.italic = NULL, + sankey.remove_axes = FALSE, + title.colour = title.colour, + subtitle.colour = subtitle.colour, + has_y_secondary = NULL, + has_category = NULL, + col_y_primary = NULL, + col_y_secondary = NULL) + + validate_y_scale <- get("validate_y_scale", envir = asNamespace("plot2")) + y_scale <- validate_y_scale(df = p$data |> mutate(`_var_y` = SI), + type = "geom_col", + y.24h = FALSE, + y.age = FALSE, + y.scientific = NULL, + y.breaks = NULL, + y.n_breaks = NULL, + y.expand = NULL, + y.labels = NULL, + y.limits = NULL, + y.percent = FALSE, + y.percent_break = 0.1, + misses_y.percent_break = TRUE, + y.position = "left", + y.transform = "identity", + y.zoom = FALSE, + stacked = FALSE, + stackedpercent = FALSE, + facet.fixed_y = FALSE, + decimal.mark = dec_mark(), + big.mark = big_mark(), + add_y_secondary = FALSE) + + p <- p + + theme + + scale_fill_certe_d(colour = colour) + + y_scale + + if (!missing(x.title)) p <- p + labs(x = validate_title(x.title, markdown = markdown)) + if (!missing(y.title)) p <- p + labs(y = validate_title(y.title, markdown = markdown)) + if (!missing(title)) p <- p + labs(title = validate_title(title, markdown = markdown, max_length = title.linelength)) + if (!missing(subtitle)) p <- p + labs(subtitle = validate_title(subtitle, markdown = markdown, max_length = subtitle.linelength)) + if (!missing(tag)) p <- p + labs(tag = validate_title(tag, markdown = markdown)) + if (!missing(caption)) p <- p + labs(caption = validate_title(caption, markdown = markdown)) + + if (isTRUE(print)) { + print(p) + } else { + p + } +} + +#' @rdname plot2-extensions +#' @importFrom plot2 plot2 get_colour +#' @export +plot2.sir_df <- function(.data, + x = NULL, + y = isolates, + category = interpretation, + facet = antibiotic, + type = "column", + x.title = TRUE, + y.title = FALSE, + category.title = NULL, + title = FALSE, + subtitle = NULL, + caption = NULL, + tag = NULL, + title.linelength = 60, + title.colour = getOption("plot2.colour_font_primary", "black"), + subtitle.linelength = 60, + subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), + na.replace = "", + na.rm = FALSE, + facet.position = "top", + facet.fill = NULL, + facet.bold = TRUE, + facet.italic = FALSE, + facet.size = 10, + facet.margin = 8, + facet.repeat_lbls_x = TRUE, + facet.repeat_lbls_y = TRUE, + facet.fixed_y = NULL, + facet.fixed_x = TRUE, + facet.drop = FALSE, + facet.nrow = NULL, + facet.relative = FALSE, + x.date_breaks = NULL, + x.date_labels = NULL, + x.date_remove_years = NULL, + category.focus = NULL, + colour = get_colour("certe_sir2", 5), + colour_fill = NULL, + colour_opacity = 0, + x.lbl_angle = 0, + x.lbl_align = NULL, + x.lbl_italic = FALSE, + x.lbl_taxonomy = TRUE, + x.remove = FALSE, + x.position = "bottom", + x.max_items = Inf, + x.max_txt = "(rest, x%n)", + category.max_items = Inf, + category.max_txt = "(rest, x%n)", + facet.max_items = Inf, + facet.max_txt = "(rest, x%n)", + x.breaks = NULL, + x.n_breaks = NULL, + x.transform = "identity", + x.expand = NULL, + x.limits = NULL, + x.labels = NULL, + x.character = NULL, + x.drop = FALSE, + x.mic = FALSE, + x.zoom = FALSE, + y.remove = FALSE, + y.24h = FALSE, + y.age = FALSE, + y.scientific = NULL, + y.percent = FALSE, + y.percent_break = 0.1, + y.breaks = NULL, + y.n_breaks = NULL, + y.limits = NULL, + y.labels = NULL, + y.expand = NULL, + y.transform = "identity", + y.position = "left", + y.zoom = FALSE, + y_secondary = NULL, + y_secondary.type = type, + y_secondary.title = TRUE, + y_secondary.colour = "certeroze", + y_secondary.colour_fill = "certeroze6", + y_secondary.scientific = NULL, + y_secondary.percent = FALSE, + y_secondary.labels = NULL, + category.labels = NULL, + category.percent = FALSE, + category.breaks = NULL, + category.limits = NULL, + category.expand = 0, + category.midpoint = NULL, + category.transform = "identity", + category.date_breaks = NULL, + category.date_labels = NULL, + category.character = NULL, + x.sort = NULL, + category.sort = FALSE, + facet.sort = TRUE, + x.complete = NULL, + category.complete = NULL, + facet.complete = NULL, + datalabels = TRUE, + datalabels.round = ifelse(y.percent, 2, 1), + datalabels.format = "%n", + datalabels.colour = "grey25", + datalabels.colour_fill = NULL, + datalabels.size = (3 * text_factor), + datalabels.angle = 0, + datalabels.lineheight = 1.0, + decimal.mark = dec_mark(), + big.mark = big_mark(), + summarise_function = base::sum, + stacked = FALSE, + stackedpercent = TRUE, + horizontal = FALSE, + reverse = TRUE, + smooth = NULL, + smooth.method = NULL, + smooth.formula = NULL, + smooth.se = TRUE, + smooth.level = 0.95, + smooth.alpha = 0.25, + smooth.linewidth = 0.75, + smooth.linetype = 3, + smooth.colour = NULL, + size = NULL, + linetype = 1, + linewidth = NULL, + binwidth = NULL, + width = NULL, + jitter_seed = NA, + violin_scale = "count", + legend.position = NULL, + legend.title = NULL, # TRUE in numeric categories + legend.reverse = FALSE, + legend.barheight = 6, + legend.barwidth = 1.5, + legend.nbin = 300, + legend.italic = FALSE, + sankey.node_width = 0.15, + sankey.node_whitespace = 0.03, + sankey.alpha = 0.5, + sankey.remove_axes = NULL, + zoom = FALSE, + sep = " / ", + print = FALSE, + text_factor = 1, + font = getOption("plot2.font"), + theme = getOption("plot2.theme", "theme_minimal2"), + background = getOption("plot2.colour_background", "white"), + markdown = TRUE, + ...) { + + if (!"isolates" %in% colnames(.data) && !is.integer(.data$value)) { + stop("isolate count not available, use AMR::sir_df() or AMR::count_df() before plotting", call. = FALSE) + } else if (is.integer(.data$value)) { + .data$isolates <- .data$value + } + + class(.data) <- class(.data)[class(.data) != "sir_df"] + + plot2(.data = .data, + x = {{ x }}, + y = {{ y }}, + category = {{ category }}, + facet = {{ facet }}, + type = type, + x.title = {{ x.title }}, + y.title = {{ y.title }}, + category.title = {{ category.title }}, + title = {{ title }}, + subtitle = {{ subtitle }}, + caption = {{ caption }}, + tag = {{ tag }}, + title.linelength = title.linelength, + title.colour = title.colour, + subtitle.linelength = subtitle.linelength, + subtitle.colour = subtitle.colour, + na.replace = na.replace, + na.rm = na.rm, + facet.position = facet.position, + facet.fill = facet.fill, + facet.bold = facet.bold, + facet.italic = facet.italic, + facet.size = facet.size, + facet.margin = facet.margin, + facet.repeat_lbls_x = facet.repeat_lbls_x, + facet.repeat_lbls_y = facet.repeat_lbls_y, + facet.fixed_y = facet.fixed_y, + facet.fixed_x = facet.fixed_x, + facet.drop = facet.drop, + facet.nrow = facet.nrow, + facet.relative = facet.relative, + x.date_breaks = x.date_breaks, + x.date_labels = x.date_labels, + x.date_remove_years = x.date_remove_years, + category.focus = category.focus, + colour = colour, + colour_fill = colour_fill, + colour_opacity = colour_opacity, + x.lbl_angle = x.lbl_angle, + x.lbl_align = x.lbl_align, + x.lbl_italic = x.lbl_italic, + x.lbl_taxonomy = x.lbl_taxonomy, + x.remove = x.remove, + x.position = x.position, + x.max_items = x.max_items, + x.max_txt = x.max_txt, + category.max_items = category.max_items, + category.max_txt = category.max_txt, + facet.max_items = facet.max_items, + facet.max_txt = facet.max_txt, + x.breaks = x.breaks, + x.n_breaks = x.n_breaks, + x.transform = x.transform, + x.expand = x.expand, + x.limits = x.limits, + x.labels = x.labels, + x.character = x.character, + x.drop = x.drop, + x.mic = x.mic, + x.zoom = x.zoom, + y.remove = y.remove, + y.24h = y.24h, + y.age = y.age, + y.scientific = y.scientific, + y.percent = y.percent, + y.percent_break = y.percent_break, + y.breaks = y.breaks, + y.n_breaks = y.n_breaks, + y.limits = y.limits, + y.labels = y.labels, + y.expand = y.expand, + y.transform = y.transform, + y.position = y.position, + y.zoom = y.zoom, + y_secondary = {{ y_secondary }}, + y_secondary.type = y_secondary.type, + y_secondary.title = {{ y_secondary.title }}, + y_secondary.colour = y_secondary.colour, + y_secondary.colour_fill = y_secondary.colour_fill, + y_secondary.scientific = y_secondary.scientific, + y_secondary.percent = y_secondary.percent, + y_secondary.labels = y_secondary.labels, + category.labels = category.labels, + category.percent = category.percent, + category.breaks = category.breaks, + category.limits = category.limits, + category.expand = category.expand, + category.midpoint = category.midpoint, + category.transform = category.transform, + category.date_breaks = category.date_breaks, + category.date_labels = category.date_labels, + category.character = category.character, + x.sort = x.sort, + category.sort = category.sort, + facet.sort = facet.sort, + x.complete = x.complete, + category.complete = category.complete, + facet.complete = facet.complete, + datalabels = {{ datalabels }}, + datalabels.round = datalabels.round, + datalabels.colour = datalabels.colour, + datalabels.format = datalabels.format, + datalabels.colour_fill = datalabels.colour_fill, + datalabels.size = datalabels.size, + datalabels.angle = datalabels.angle, + datalabels.lineheight = datalabels.lineheight, + decimal.mark = decimal.mark, + big.mark = big.mark, + summarise_function = summarise_function, + stacked = stacked, + stackedpercent = stackedpercent, + horizontal = horizontal, + reverse = reverse, + smooth = smooth, + smooth.method = smooth.method, + smooth.formula = smooth.formula, + smooth.se = smooth.se, + smooth.level = smooth.level, + smooth.alpha = smooth.alpha, + smooth.linewidth = smooth.linewidth, + smooth.linetype = smooth.linetype, + smooth.colour = smooth.colour, + size = size, + linetype = linetype, + linewidth = linewidth, + binwidth = binwidth, + width = width, + jitter_seed = jitter_seed, + violin_scale = violin_scale, + legend.position = legend.position, + legend.title = {{ legend.title }}, + legend.reverse = legend.reverse, + legend.barheight = legend.barheight, + legend.barwidth = legend.barwidth, + legend.nbin = legend.nbin, + legend.italic = legend.italic, + sankey.node_width = sankey.node_width, + sankey.node_whitespace = sankey.node_whitespace, + sankey.alpha = sankey.alpha, + sankey.remove_axes = sankey.remove_axes, + zoom = zoom, + sep = sep, + print = print, + text_factor = text_factor, + font = font, + theme = theme, + background = background, + markdown = markdown, + `_misses.x` = missing(x), + `_misses.y` = missing(y), + `_misses.category` = missing(category), + `_misses.facet` = missing(facet), + `_misses.datalabels` = missing(datalabels), + `_misses.colour_fill` = missing(colour_fill), + `_misses.x.title` = FALSE, + `_misses.y.title` = FALSE, + `_misses.title` = missing(title) && !isFALSE(title), + `_misses.subtitle` = missing(subtitle), + `_misses.tag` = missing(tag), + `_misses.caption` = missing(caption), + `_misses.y.percent` = missing(y.percent), + `_misses.y.percent_break` = missing(y.percent_break), + `_misses.x.zoom` = missing(x.zoom), + `_misses.x.max_items` = missing(x.max_items), + `_misses.facet.fixed_x` = missing(facet.fixed_x), + `_label.x` = deparse(substitute(x)), + `_label.y` = deparse(substitute(y)), + `_label.category` = deparse(substitute(category)), + `_label.facet` = deparse(substitute(facet)), + `_label.y_secondary` = deparse(substitute(y_secondary)), + `_summarise_fn_name` = deparse(substitute(summarise_function)), + `_misses.summarise_function` = missing(summarise_function), + ...) +} + +#' @rdname plot2-extensions +#' @importFrom ggplot2 geom_hline geom_point geom_line element_text theme +#' @importFrom plot2 plot2 get_colour +#' @details The QC-test can be acquired with [certestats::qc_test()]. It applies the Nelson QC rules for a vector of values. +#' @export +plot2.qc_test <- function(.data, + x = x, + y = y, + category = rule, + facet = NULL, + type = "point", + x.title = "Index", + y.title = "Value", + category.title = NULL, + title = paste0("QC Chart (", attributes(.data)$guideline, ")"), + subtitle = NULL, + caption = NULL, + tag = NULL, + title.linelength = 60, + title.colour = getOption("plot2.colour_font_primary", "black"), + subtitle.linelength = 60, + subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), + na.replace = "", + na.rm = FALSE, + facet.position = "top", + facet.fill = NULL, + facet.bold = TRUE, + facet.italic = FALSE, + facet.size = 10, + facet.margin = 8, + facet.repeat_lbls_x = TRUE, + facet.repeat_lbls_y = TRUE, + facet.fixed_y = NULL, + facet.fixed_x = TRUE, + facet.drop = FALSE, + facet.nrow = NULL, + facet.relative = FALSE, + x.date_breaks = NULL, + x.date_labels = NULL, + x.date_remove_years = NULL, + category.focus = NULL, + colour = get_colour(c("Observation" = "grey75", + "Rule 1" = "certeblauw", + "Rule 2" = "certegroen", + "Rule 3" = "certeroze", + "Rule 4" = "certegeel", + "Rule 5" = "certelila", + "Rule 6" = "certebruin", + "Rule 7" = "certeblauw2", + "Rule 8" = "certegroen2")), + colour_fill = NULL, + colour_opacity = 0, + x.lbl_angle = 0, + x.lbl_align = NULL, + x.lbl_italic = FALSE, + x.lbl_taxonomy = FALSE, + x.remove = FALSE, + x.position = "bottom", + x.max_items = Inf, + x.max_txt = "(rest, x%n)", + category.max_items = Inf, + category.max_txt = "(rest, x%n)", + facet.max_items = Inf, + facet.max_txt = "(rest, x%n)", + x.breaks = NULL, + x.n_breaks = NULL, + x.transform = "identity", + x.expand = NULL, + x.limits = NULL, + x.labels = NULL, + x.character = NULL, + x.drop = FALSE, + x.mic = FALSE, + x.zoom = TRUE, + y.remove = FALSE, + y.24h = FALSE, + y.age = FALSE, + y.scientific = NULL, + y.percent = FALSE, + y.percent_break = 0.1, + y.breaks = NULL, + y.n_breaks = NULL, + y.limits = NULL, + y.labels = NULL, + y.expand = NULL, + y.transform = "identity", + y.position = "left", + y.zoom = TRUE, + y_secondary = NULL, + y_secondary.type = type, + y_secondary.title = TRUE, + y_secondary.colour = "certeroze", + y_secondary.colour_fill = "certeroze6", + y_secondary.scientific = NULL, + y_secondary.percent = FALSE, + y_secondary.labels = NULL, + category.labels = NULL, + category.percent = FALSE, + category.breaks = NULL, + category.limits = NULL, + category.expand = 0, + category.midpoint = NULL, + category.transform = "identity", + category.date_breaks = NULL, + category.date_labels = NULL, + category.character = NULL, + x.sort = NULL, + category.sort = TRUE, + facet.sort = TRUE, + x.complete = NULL, + category.complete = NULL, + facet.complete = NULL, + datalabels = TRUE, + datalabels.round = ifelse(y.percent, 2, 1), + datalabels.format = "%n", + datalabels.colour = "grey25", + datalabels.colour_fill = NULL, + datalabels.size = (3 * text_factor), + datalabels.angle = 0, + datalabels.lineheight = 1.0, + decimal.mark = dec_mark(), + big.mark = big_mark(), + summarise_function = base::sum, + stacked = FALSE, + stackedpercent = FALSE, + horizontal = FALSE, + reverse = horizontal, + smooth = NULL, + smooth.method = NULL, + smooth.formula = NULL, + smooth.se = TRUE, + smooth.level = 0.95, + smooth.alpha = 0.25, + smooth.linewidth = 0.75, + smooth.linetype = 3, + smooth.colour = NULL, + size = 2, + linetype = 1, + linewidth = NULL, + binwidth = NULL, + width = NULL, + jitter_seed = NA, + violin_scale = "count", + legend.position = "right", + legend.title = NULL, # TRUE in numeric categories + legend.reverse = FALSE, + legend.barheight = 6, + legend.barwidth = 1.5, + legend.nbin = 300, + legend.italic = FALSE, + sankey.node_width = 0.15, + sankey.node_whitespace = 0.03, + sankey.alpha = 0.5, + sankey.remove_axes = NULL, + zoom = TRUE, + sep = " / ", + print = FALSE, + text_factor = 1, + font = getOption("plot2.font"), + theme = getOption("plot2.theme", "theme_minimal2"), + background = getOption("plot2.colour_background", "white"), + markdown = TRUE, + ...) { + + loadNamespace("certestats") # will throw an error if not installed + + att <- attributes(.data) + df <- data.frame(x = seq_len(length(att$values)), + y = att$values, + rule = "Observation", + shp = 4, + size = size, + stringsAsFactors = FALSE) + for (i in seq_len(length(.data))) { + if (length(.data[[i]]) > 0) { + # only add the first here + df_rule <- data.frame(x = .data[[i]], + y = att$values[.data[[i]]], + rule = paste0("Rule ", gsub("[^0-9]", "", names(.data)[i])), + shp = 13, + size = size * 1.5, + stringsAsFactors = FALSE) + df <- rbind(df, df_rule) + } + } + + df <- df[order(df$x, df$rule), , drop = FALSE] + + if (missing(caption)) { + # fill caption with rules + rules <- names(.data[unlist(lapply(.data, function(r) length(r) > 0))]) + rules <- as.integer(gsub("[^0-9]", "", rules)) + threshold <- att$threshold[rules] + caption <- "\n" + for (i in seq_len(length(rules))) { + rule <- paste0("Rule ", rules[i], ":") + caption <- c(caption, + paste(rule, certestats::qc_rule_text(rules[i], threshold[i]))) + } + caption <- paste0(caption, collapse = "\n") + } + + p <- plot2(.data = df, + x = x, + y = y, + category = category, + facet = facet, + type = "blank", + x.title = {{ x.title }}, + y.title = {{ y.title }}, + category.title = {{ category.title }}, + title = {{ title }}, + subtitle = {{ subtitle }}, + caption = {{ caption }}, + tag = {{ tag }}, + title.linelength = title.linelength, + title.colour = title.colour, + subtitle.linelength = subtitle.linelength, + subtitle.colour = subtitle.colour, + na.replace = na.replace, + na.rm = na.rm, + facet.position = facet.position, + facet.fill = facet.fill, + facet.bold = facet.bold, + facet.italic = facet.italic, + facet.size = facet.size, + facet.margin = facet.margin, + facet.repeat_lbls_x = facet.repeat_lbls_x, + facet.repeat_lbls_y = facet.repeat_lbls_y, + facet.fixed_y = facet.fixed_y, + facet.fixed_x = facet.fixed_x, + facet.drop = facet.drop, + facet.nrow = facet.nrow, + facet.relative = facet.relative, + x.date_breaks = x.date_breaks, + x.date_labels = x.date_labels, + x.date_remove_years = x.date_remove_years, + category.focus = category.focus, + colour = colour, + colour_fill = colour_fill, + colour_opacity = colour_opacity, + x.lbl_angle = x.lbl_angle, + x.lbl_align = x.lbl_align, + x.lbl_italic = x.lbl_italic, + x.lbl_taxonomy = x.lbl_taxonomy, + x.remove = x.remove, + x.position = x.position, + x.max_items = x.max_items, + x.max_txt = x.max_txt, + category.max_items = category.max_items, + category.max_txt = category.max_txt, + facet.max_items = facet.max_items, + facet.max_txt = facet.max_txt, + x.breaks = x.breaks, + x.n_breaks = x.n_breaks, + x.transform = x.transform, + x.expand = x.expand, + x.limits = x.limits, + x.labels = x.labels, + x.character = x.character, + x.drop = x.drop, + x.mic = x.mic, + x.zoom = x.zoom, + y.remove = y.remove, + y.24h = y.24h, + y.age = y.age, + y.scientific = y.scientific, + y.percent = y.percent, + y.percent_break = y.percent_break, + y.breaks = y.breaks, + y.n_breaks = y.n_breaks, + y.limits = y.limits, + y.labels = y.labels, + y.expand = y.expand, + y.transform = y.transform, + y.position = y.position, + y.zoom = y.zoom, + y_secondary = NULL, + y_secondary.type = NULL, + y_secondary.title = TRUE, + y_secondary.colour = NULL, + y_secondary.colour_fill = NULL, + y_secondary.scientific = NULL, + y_secondary.percent = NULL, + y_secondary.labels = NULL, + category.labels = category.labels, + category.percent = category.percent, + category.breaks = category.breaks, + category.limits = category.limits, + category.expand = category.expand, + category.midpoint = category.midpoint, + category.transform = category.transform, + category.date_breaks = category.date_breaks, + category.date_labels = category.date_labels, + category.character = category.character, + x.sort = x.sort, + category.sort = category.sort, + facet.sort = facet.sort, + x.complete = x.complete, + category.complete = category.complete, + facet.complete = facet.complete, + datalabels = {{ datalabels }}, + datalabels.round = datalabels.round, + datalabels.colour = datalabels.colour, + datalabels.format = datalabels.format, + datalabels.colour_fill = datalabels.colour_fill, + datalabels.size = datalabels.size, + datalabels.angle = datalabels.angle, + datalabels.lineheight = datalabels.lineheight, + decimal.mark = decimal.mark, + big.mark = big.mark, + summarise_function = summarise_function, + stacked = stacked, + stackedpercent = stackedpercent, + horizontal = horizontal, + reverse = reverse, + smooth = smooth, + smooth.method = smooth.method, + smooth.formula = smooth.formula, + smooth.se = smooth.se, + smooth.level = smooth.level, + smooth.alpha = smooth.alpha, + smooth.linewidth = smooth.linewidth, + smooth.linetype = smooth.linetype, + smooth.colour = smooth.colour, + size = size, + linetype = linetype, + linewidth = linewidth, + binwidth = binwidth, + width = width, + jitter_seed = jitter_seed, + violin_scale = violin_scale, + legend.position = legend.position, + legend.title = {{ legend.title }}, + legend.reverse = legend.reverse, + legend.barheight = legend.barheight, + legend.barwidth = legend.barwidth, + legend.nbin = legend.nbin, + legend.italic = legend.italic, + sankey.node_width = sankey.node_width, + sankey.node_whitespace = sankey.node_whitespace, + sankey.alpha = sankey.alpha, + sankey.remove_axes = sankey.remove_axes, + zoom = zoom, + sep = sep, + print = FALSE, + text_factor = text_factor, + font = font, + theme = theme, + background = background, + markdown = markdown, + `_misses.x` = FALSE, + `_misses.y` = FALSE, + `_misses.category` = FALSE, + `_misses.facet` = missing(facet), + `_misses.datalabels` = missing(datalabels), + `_misses.colour_fill` = missing(colour_fill), + `_misses.x.title` = FALSE, + `_misses.y.title` = FALSE, + `_misses.title` = FALSE, + `_misses.subtitle` = missing(subtitle), + `_misses.tag` = missing(tag), + `_misses.caption` = FALSE, + `_misses.y.percent` = missing(y.percent), + `_misses.y.percent_break` = missing(y.percent_break), + `_misses.x.zoom` = missing(x.zoom), + `_misses.x.max_items` = missing(x.max_items), + `_misses.facet.fixed_x` = missing(facet.fixed_x), + `_label.x` = deparse(substitute(x)), + `_label.y` = deparse(substitute(y)), + `_label.category` = deparse(substitute(category)), + `_label.facet` = deparse(substitute(facet)), + `_label.y_secondary` = deparse(substitute(y_secondary)), + `_summarise_fn_name` = deparse(substitute(summarise_function)), + `_misses.summarise_function` = missing(summarise_function), + ...) + + # left align the rule texts + p <- p + theme(plot.caption = element_text(hjust = 0)) + + # add reference lines + p <- p + + geom_hline(yintercept = mean(att$values), + colour = "black", linetype = 2, linewidth = linewidth) + + geom_hline(yintercept = mean(att$values) + stats::sd(att$values), + colour = "#61D04F", linetype = 2, linewidth = linewidth) + + geom_hline(yintercept = mean(att$values) - stats::sd(att$values), + colour = "#61D04F", linetype = 2, linewidth = linewidth) + + geom_hline(yintercept = mean(att$values) + 2 * stats::sd(att$values), + colour = "#F5C710", linetype = 2, linewidth = linewidth) + + geom_hline(yintercept = mean(att$values) - 2 * stats::sd(att$values), + colour = "#F5C710", linetype = 2, linewidth = linewidth) + + geom_hline(yintercept = mean(att$values) + 3 * stats::sd(att$values), + colour = "#DF536B", linetype = 2, linewidth = linewidth) + + geom_hline(yintercept = mean(att$values) - 3 * stats::sd(att$values), + colour = "#DF536B", linetype = 2, linewidth = linewidth) + + p <- p + + geom_point(shape = df$shp, size = df$size) + + # add lines for each rule found + for (i in seq_len(length(.data))) { + if (length(.data[[i]]) > 0) { + threshold <- att$threshold[i] + ind <- .data[[i]] + p <- p + + geom_point(data = data.frame(x = ind, + y = att$values[ind]), + mapping = aes(x = x, y = y), + inherit.aes = FALSE, + alpha = 0.33, + size = size * 2.5, + colour = colour[i + 1]) + if (threshold > 1) { + # print coloured lines and point for the rules + for (j in seq_len(length(ind))) { + ind_vector <- c(ind[j]:(ind[j] + threshold - 1)) + val <- att$values[ind_vector] + p <- p + + geom_line(data = data.frame(x = ind_vector, + y = val), + mapping = aes(x = x, y = y), + inherit.aes = FALSE, + linetype = linetype, + linewidth = linewidth, + colour = colour[i + 1]) + + geom_point(data = data.frame(x = ind_vector, + y = val), + mapping = aes(x = x, y = y), + inherit.aes = FALSE, + shape = 4, + size = size, + colour = colour[i + 1]) + } + } + } + } + if (isTRUE(print)) { + print(p) + } else { + p + } +} + +#' @rdname plot2-extensions +#' @importFrom dplyr group_by mutate ungroup summarise n_distinct `%>%` filter left_join +#' @importFrom ggplot2 geom_point aes unit +#' @importFrom plot2 add_type add_line plot2 get_colour +#' @importFrom certestyle format2 +#' @details The detection of [disease clusters](https://en.wikipedia.org/wiki/Disease_cluster) can be done using [certestats::early_warning_cluster()]. Use `size` to alter the size of the triangles that indicate clusters. +#' @export +#' @examples +#' +#' # DISEASE CLUSTERS ----------------------------------------------------- +#' cases <- data.frame(date = sample(seq(as.Date("2015-01-01"), +#' as.Date("2022-12-31"), +#' "1 day"), +#' size = 300), +#' patient = sample(LETTERS, size = 300, replace = TRUE)) +#' check <- certestats::early_warning_cluster(cases, +#' minimum_cases = 1, +#' threshold_percentile = 0.75) +#' +#' check |> plot2() +plot2.early_warning_cluster <- function(.data, + x = NULL, + y = NULL, + category = NULL, + facet = NULL, + type = "line", + x.title = ifelse(attributes(.data)$period_length_months == 12, "Maand in periode", "Week in periode"), + y.title = paste0("Cases (", attributes(.data)$moving_average_days, "-daags zwevend gemiddelde)"), + category.title = "Periode", + title = paste0(n_distinct(.data$clusters$cluster), " cluster", ifelse(n_distinct(.data$clusters$cluster) != 1, "s", "")), + subtitle = NULL, + caption = paste0("O.b.v. uitbijter-vrije geschiedenis (coeff = ", + format2(attributes(.data)$remove_outliers_coefficient), + ") met pct = ", + format2(attributes(.data)$threshold_percentile)), + tag = NULL, + title.linelength = 60, + title.colour = getOption("plot2.colour_font_primary", "black"), + subtitle.linelength = 60, + subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), + na.replace = "", + na.rm = FALSE, + facet.position = "top", + facet.fill = NULL, + facet.bold = TRUE, + facet.italic = FALSE, + facet.size = 10, + facet.margin = 8, + facet.repeat_lbls_x = TRUE, + facet.repeat_lbls_y = TRUE, + facet.fixed_y = NULL, + facet.fixed_x = TRUE, + facet.drop = FALSE, + facet.nrow = NULL, + facet.relative = FALSE, + x.date_breaks = "1 month", + x.date_labels = "mmm", + x.date_remove_years = FALSE, # has no impact anyway, see below at x.date_remove_years + category.focus = NULL, + colour = getOption("plot2.colour", "ggplot2"), + colour_fill = NULL, + colour_opacity = 0, + x.lbl_angle = 0, + x.lbl_align = NULL, + x.lbl_italic = FALSE, + x.lbl_taxonomy = FALSE, + x.remove = FALSE, + x.position = "bottom", + x.max_items = Inf, + x.max_txt = "(rest, x%n)", + category.max_items = Inf, + category.max_txt = "(rest, x%n)", + facet.max_items = Inf, + facet.max_txt = "(rest, x%n)", + x.breaks = seq(0, 9999, 14), + x.n_breaks = NULL, + x.transform = "identity", + x.expand = NULL, + x.limits = NULL, + x.labels = function(x) x / 7, + x.character = NULL, + x.drop = FALSE, + x.mic = FALSE, + x.zoom = FALSE, + y.remove = FALSE, + y.24h = FALSE, + y.age = FALSE, + y.scientific = NULL, + y.percent = FALSE, + y.percent_break = 0.1, + y.breaks = NULL, + y.n_breaks = NULL, + y.limits = NULL, + y.labels = NULL, + y.expand = NULL, + y.transform = "identity", + y.position = "left", + y.zoom = FALSE, + y_secondary = NULL, + y_secondary.type = type, + y_secondary.title = TRUE, + y_secondary.colour = "certeroze", + y_secondary.colour_fill = "certeroze6", + y_secondary.scientific = NULL, + y_secondary.percent = FALSE, + y_secondary.labels = NULL, + category.labels = md_to_expression, + category.percent = FALSE, + category.breaks = NULL, + category.limits = NULL, + category.expand = 0, + category.midpoint = NULL, + category.transform = "identity", + category.date_breaks = NULL, + category.date_labels = NULL, + category.character = TRUE, + x.sort = NULL, + category.sort = "asc", + facet.sort = TRUE, + x.complete = NULL, + category.complete = NULL, + facet.complete = NULL, + datalabels = TRUE, + datalabels.round = ifelse(y.percent, 2, 1), + datalabels.format = "%n", + datalabels.colour = "grey25", + datalabels.colour_fill = NULL, + datalabels.size = (2.5 * text_factor), + datalabels.angle = 0, + datalabels.lineheight = 1.0, + decimal.mark = dec_mark(), + big.mark = big_mark(), + summarise_function = base::sum, + stacked = FALSE, + stackedpercent = FALSE, + horizontal = FALSE, + reverse = horizontal, + smooth = NULL, + smooth.method = NULL, + smooth.formula = NULL, + smooth.se = TRUE, + smooth.level = 0.95, + smooth.alpha = 0.25, + smooth.linewidth = 0.75, + smooth.linetype = 3, + smooth.colour = NULL, + size = NULL, + linetype = 1, + linewidth = NULL, + binwidth = NULL, + width = NULL, + jitter_seed = NA, + violin_scale = "count", + legend.position = "right", + legend.title = NULL, # TRUE in numeric categories + legend.reverse = FALSE, + legend.barheight = 6, + legend.barwidth = 1.5, + legend.nbin = 300, + legend.italic = FALSE, + sankey.node_width = 0.15, + sankey.node_whitespace = 0.03, + sankey.alpha = 0.5, + sankey.remove_axes = NULL, + zoom = FALSE, + sep = " / ", + print = FALSE, + text_factor = 1, + font = getOption("plot2.font"), + theme = getOption("plot2.theme", "theme_minimal2"), + background = getOption("plot2.colour_background", "white"), + markdown = TRUE, + ...) { + loadNamespace("certestats") # will throw an error if not installed + + early_warning_object <- .data + + if (NROW(early_warning_object$details) == 0) { + # check if markdown is required + markdown <- validate_markdown(markdown, x.title, y.title, c(category.title, legend.title), title, subtitle, tag, caption) + plot2_warning("No observations, returning an empty plot") + validate_theme <- get("validate_theme", envir = asNamespace("plot2")) + p <- ggplot() + + validate_theme(theme = theme, + type = "", + background = background, + text_factor = text_factor, + font = font, + horizontal = horizontal, + x.remove = x.remove, + y.remove = y.remove, + x.lbl_angle = x.lbl_angle, + x.lbl_align = x.lbl_align, + x.lbl_italic = x.lbl_italic, + facet.fill = facet.fill, + facet.bold = facet.bold, + facet.italic = facet.italic, + facet.size = facet.size, + facet.margin = facet.margin, + legend.italic = legend.italic, + sankey.remove_axes = sankey.remove_axes, + title.colour = title.colour, + subtitle.colour = subtitle.colour, + has_y_secondary = FALSE, + col_y_primary = NULL, + col_y_secondary = NULL) + if (!missing(x.title)) p <- p + labs(x = validate_title(x.title, markdown = markdown)) + if (!missing(y.title)) p <- p + labs(y = validate_title(y.title, markdown = markdown)) + if (!missing(title)) p <- p + labs(title = validate_title(title, markdown = markdown, max_length = title.linelength)) + if (!missing(subtitle)) p <- p + labs(subtitle = validate_title(subtitle, markdown = markdown, max_length = subtitle.linelength)) + if (!missing(tag)) p <- p + labs(tag = validate_title(tag, markdown = markdown)) + if (!missing(caption)) p <- p + labs(caption = validate_title(caption, markdown = markdown)) + if (isTRUE(print)) { + print(p) + } else { + return(p) + } + } + + if (NROW(early_warning_object$clusters) == 0) { + if (attributes(early_warning_object)$period_length_months == 12) { + # plot as years + clusters <- data.frame(cluster = integer(0), xmin = Sys.Date()[0], xmax = Sys.Date()[0]) + } else { + # plot as days in period + clusters <- data.frame(cluster = integer(0), xmin = double(0), xmax = double(0)) + } + } else { + if (attributes(early_warning_object)$period_length_months == 12) { + # plot as years + clusters <- early_warning_object$clusters |> + left_join(early_warning_object$details |> + select(date, period_date), + by = "date") |> + group_by(cluster) |> + summarise(xmin = min(period_date, na.rm = TRUE), + xmax = max(period_date, na.rm = TRUE), + n_cases = sum(cases, na.rm = TRUE)) + } else { + # plot as days in period + clusters <- early_warning_object$clusters |> + group_by(cluster) |> + summarise(xmin = min(day_in_period, na.rm = TRUE), + xmax = max(day_in_period, na.rm = TRUE), + n_cases = sum(cases, na.rm = TRUE)) + } + } + + if (identical(colour, "certe")) { + colour <- c("certeblauw", get_colour("greyscale", n_distinct(early_warning_object$details$period) - 1)) + if (isTRUE(attributes(early_warning_object)$based_on_historic_maximum)) { + colour <- c(colour, "certeroze2") + } + } else { + # set number of colours needed + if (isTRUE(attributes(early_warning_object)$based_on_historic_maximum)) { + colour <- get_colour(colour, n_distinct(early_warning_object$details$period) + 1) + } else { + colour <- get_colour(colour, n_distinct(early_warning_object$details$period)) + } + } + + early_warning_object$details <- early_warning_object$details |> + group_by(period = abs(period)) |> + mutate(period_txt = paste0("**Periode ", abs(period), ":** ", format2(min(date), "d mmm \u2019yy"), " - ", format2(max(date), "d mmm \u2019yy"))) |> + ungroup() + + p <- early_warning_object$details |> + plot2(x = if (attributes(early_warning_object)$period_length_months == 12) period_date else day_in_period, + y = moving_avg, + category = period_txt, + # facet = {{facet}}, + type = type, + x.title = x.title, + y.title = y.title, + category.title = category.title, + title = title, + subtitle = subtitle, + caption = caption, + tag = tag, + title.linelength = title.linelength, + title.colour = title.colour, + subtitle.linelength = subtitle.linelength, + subtitle.colour = subtitle.colour, + na.replace = na.replace, + na.rm = na.rm, + facet.position = facet.position, + facet.fill = facet.fill, + facet.bold = facet.bold, + facet.italic = facet.italic, + facet.size = facet.size, + facet.margin = facet.margin, + facet.repeat_lbls_x = facet.repeat_lbls_x, + facet.repeat_lbls_y = facet.repeat_lbls_y, + facet.fixed_y = facet.fixed_y, + facet.fixed_x = facet.fixed_x, + facet.drop = facet.drop, + facet.nrow = facet.nrow, + facet.relative = facet.relative, + x.date_breaks = x.date_breaks, + x.date_labels = x.date_labels, + x.date_remove_years = FALSE, # otherwise the diease cluster years will be 1970 (as plot2() works like that in unify_years()) + category.focus = category.focus, + colour = colour, + colour_fill = colour_fill, + colour_opacity = colour_opacity, + x.lbl_angle = x.lbl_angle, + x.lbl_align = x.lbl_align, + x.lbl_italic = x.lbl_italic, + x.lbl_taxonomy = x.lbl_taxonomy, + x.remove = x.remove, + x.position = x.position, + x.max_items = x.max_items, + x.max_txt = x.max_txt, + category.max_items = category.max_items, + category.max_txt = category.max_txt, + facet.max_items = facet.max_items, + facet.max_txt = facet.max_txt, + x.breaks = x.breaks, + x.n_breaks = x.n_breaks, + x.transform = x.transform, + x.expand = x.expand, + x.limits = x.limits, + x.labels = x.labels, + x.character = x.character, + x.drop = x.drop, + x.mic = x.mic, + x.zoom = x.zoom, + y.remove = y.remove, + y.24h = y.24h, + y.age = y.age, + y.scientific = y.scientific, + y.percent = y.percent, + y.percent_break = y.percent_break, + y.breaks = y.breaks, + y.n_breaks = y.n_breaks, + y.limits = y.limits, + y.labels = y.labels, + y.expand = y.expand, + y.transform = y.transform, + y.position = y.position, + y.zoom = y.zoom, + y_secondary = y_secondary, + y_secondary.type = y_secondary.type, + y_secondary.title = y_secondary.title, + y_secondary.colour = y_secondary.colour, + y_secondary.colour_fill = y_secondary.colour_fill, + y_secondary.scientific = y_secondary.scientific, + y_secondary.percent = y_secondary.percent, + y_secondary.labels = y_secondary.labels, + category.labels = category.labels, + category.percent = category.percent, + category.breaks = category.breaks, + category.limits = category.limits, + category.expand = category.expand, + category.midpoint = category.midpoint, + category.transform = category.transform, + category.date_breaks = category.date_breaks, + category.date_labels = category.date_labels, + category.character = category.character, + x.sort = x.sort, + category.sort = category.sort, + facet.sort = facet.sort, + x.complete = x.complete, + category.complete = category.complete, + facet.complete = facet.complete, + datalabels = datalabels, + datalabels.round = datalabels.round, + datalabels.format = datalabels.format, + datalabels.colour = datalabels.colour, + datalabels.colour_fill = datalabels.colour_fill, + datalabels.size = datalabels.size, + datalabels.angle = datalabels.angle, + datalabels.lineheight = datalabels.lineheight, + decimal.mark = decimal.mark, + big.mark = big.mark, + summarise_function = summarise_function, + stacked = stacked, + stackedpercent = stackedpercent, + horizontal = horizontal, + reverse = reverse, + smooth = smooth, + smooth.method = smooth.method, + smooth.formula = smooth.formula, + smooth.se = smooth.se, + smooth.level = smooth.level, + smooth.alpha = smooth.alpha, + smooth.linewidth = smooth.linewidth, + smooth.linetype = smooth.linetype, + smooth.colour = smooth.colour, + # size = size, + linetype = linetype, + linewidth = linewidth, + binwidth = binwidth, + width = width, + jitter_seed = jitter_seed, + violin_scale = violin_scale, + legend.position = legend.position, + legend.title = legend.title, + legend.reverse = legend.reverse, + legend.barheight = legend.barheight, + legend.barwidth = legend.barwidth, + legend.nbin = legend.nbin, + legend.italic = legend.italic, + sankey.node_width = sankey.node_width, + sankey.node_whitespace = sankey.node_whitespace, + sankey.alpha = sankey.alpha, + sankey.remove_axes = sankey.remove_axes, + zoom = zoom, + sep = sep, + print = print, + text_factor = text_factor, + font = font, + theme = theme, + background = background, + markdown = markdown, + + `_misses.x` = FALSE, + `_misses.y` = FALSE, + `_misses.category` = FALSE, + `_misses.facet` = missing(facet), + `_misses.datalabels` = missing(datalabels), + `_misses.colour_fill` = missing(colour_fill), + `_misses.x.title` = FALSE, + `_misses.y.title` = FALSE, + `_misses.title` = FALSE, + `_misses.subtitle` = missing(subtitle), + `_misses.tag` = missing(tag), + `_misses.caption` = FALSE, + `_misses.y.percent` = missing(y.percent), + `_misses.y.percent_break` = missing(y.percent_break), + `_misses.x.zoom` = missing(x.zoom), + `_misses.x.max_items` = missing(x.max_items), + `_misses.facet.fixed_x` = missing(facet.fixed_x), + `_label.x` = deparse(substitute(x)), + `_label.y` = deparse(substitute(y)), + `_label.category` = deparse(substitute(category)), + `_label.facet` = deparse(substitute(facet)), + `_label.y_secondary` = deparse(substitute(y_secondary)), + `_summarise_fn_name` = deparse(substitute(summarise_function)), + `_misses.summarise_function` = missing(summarise_function), + ...) %>% + add_line(y = moving_avg, + data = .$data |> filter(period_txt %like% "Periode 0:"), + colour = colour[1], + linewidth = 0.6, + inherit.aes = FALSE) %>% + (function(x) { + if ("moving_avg_limit" %in% x$data) { + x |> add_line(y = moving_avg_limit, + colour = colour[1], + linetype = 2, + linewidth = 0.6, + inherit.aes = FALSE) + } else { + x + }})() |> + add_type(data = clusters, + type = "rect", + mapping = aes(xmin = xmin, + xmax = xmax, + ymin = 0, + ymax = max(early_warning_object$details$moving_avg, na.rm = TRUE) * 1.05), + fill = get_colour(colour[1]), + alpha = 0.1, + inherit.aes = FALSE) |> + move_layer(move = -99) |> + # arrow left to right (arrow head on the right) + add_type(data = clusters, + type = "segment", + mapping = aes(x = xmin, + xend = xmax, + y = max(early_warning_object$details$moving_avg, na.rm = TRUE) * 1.05, + yend = max(early_warning_object$details$moving_avg, na.rm = TRUE) * 1.05), + lineend = "round", + linejoin = "round", + arrow = grid::arrow(angle = 90, length = unit(2, "pt")), + colour = get_colour(colour[1]), + linewidth = 0.5, + inherit.aes = FALSE) |> + # arrow right to left (arrow head on the left) + add_type(data = clusters, + type = "segment", + mapping = aes(x = xmax, + xend = xmin, + y = max(early_warning_object$details$moving_avg, na.rm = TRUE) * 1.05, + yend = max(early_warning_object$details$moving_avg, na.rm = TRUE) * 1.05), + lineend = "round", + linejoin = "round", + arrow = grid::arrow(angle = 90, length = unit(2, "pt")), + colour = get_colour(colour[1]), + linewidth = 0.5, + inherit.aes = FALSE) |> + # arrow right to left (arrow head on the left) + add_type(data = clusters, + type = "text", + mapping = aes(label = paste0("N = ", n_cases), + x = xmax - (xmax - xmin) / 2, + y = max(early_warning_object$details$moving_avg, na.rm = TRUE) * 1.1), + colour = get_colour(colour[1]), + size = datalabels.size, + fontface = "bold", + inherit.aes = FALSE) + + if (isTRUE(attributes(early_warning_object)$based_on_historic_maximum)) { + p <- p |> + add_line(y = moving_avg_max, + data = p$data |> mutate(period_txt = "Maximum"), + linewidth = 0.5, + inherit.aes = FALSE) + } + + if (isTRUE(print)) { + print(p) + } else { + p + } +} diff --git a/R/data.R b/R/data.R deleted file mode 100644 index 66dd9fe5..00000000 --- a/R/data.R +++ /dev/null @@ -1,40 +0,0 @@ -# ===================================================================== # -# An R package by Certe: # -# https://github.com/certe-medical-epidemiology # -# # -# Licensed as GPL-v2.0. # -# # -# Developed at non-profit organisation Certe Medical Diagnostics & # -# Advice, department of Medical Epidemiology. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# ===================================================================== # - -#' Example Data Set with Admitted Patients -#' -#' An auto-generated data set containing fictitious patients admitted to hospitals. -#' @format A [tibble]/[data.frame] with `r format(nrow(admitted_patients), big.mark = ",")` observations and `r ncol(admitted_patients)` variables: -#' - `date`\cr date of hospital admission -#' - `patient_id`\cr ID of the patient (fictitious) -#' - `gender`\cr gender of the patient -#' - `age`\cr age of the patient -#' - `age_group`\cr age group of the age of the patient, generated with [AMR::age_groups()] -#' - `hospital`\cr ID of the hospital, from A to D -#' - `ward`\cr type of ward, either ICU or Non-ICU -"admitted_patients" - -#' Example Geography Data Set: the Netherlands -#' -#' A data set containing the geometies of the twelve provinces of the Netherlands, according to Statistics Netherlands (2021). -#' @format A [data.frame] with `r format(nrow(netherlands), big.mark = ",")` observations and `r ncol(netherlands)` variables: -#' - `province`\cr name of the Dutch province -#' - `area_km2`\cr area in square kilometres -#' - `geometry`\cr geometry of the province, of class `r paste0(class(netherlands$geometry), collapse = "/")` -"netherlands" diff --git a/R/get_plot_title.R b/R/get_plot_title.R deleted file mode 100644 index 03969bd1..00000000 --- a/R/get_plot_title.R +++ /dev/null @@ -1,158 +0,0 @@ -# ===================================================================== # -# An R package by Certe: # -# https://github.com/certe-medical-epidemiology # -# # -# Licensed as GPL-v2.0. # -# # -# Developed at non-profit organisation Certe Medical Diagnostics & # -# Advice, department of Medical Epidemiology. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# ===================================================================== # - -#' Get Plot Title -#' -#' Get the title of the plot, or a default value. If the title is not set in a plot, this function tries to generate one from the plot mapping. -#' @param plot a `ggplot2` plot -#' @param valid_filename a [logical] to indicate whether the returned value should be a valid filename, defaults to `TRUE` -#' @param default the default value, if a plot title is absent -#' @importFrom ggplot2 is.ggplot -#' @export -#' @examples -#' without_title <- plot2(mtcars) -#' with_title <- plot2(mtcars, title = "Plotting **mpg** vs. **cyl**!") -#' -#' # default is a guess: -#' get_plot_title(without_title) -#' get_plot_title(without_title, valid_filename = FALSE) -#' get_plot_title(with_title) -#' get_plot_title(with_title, valid_filename = FALSE) -#' -#' # unless 'default' is set (only affects plots without title): -#' get_plot_title(without_title, default = "title") -#' get_plot_title(with_title, default = "title") -get_plot_title <- function(plot, - valid_filename = TRUE, - default = NULL) { - - if (!is.ggplot(plot)) { - stop("`plot` must be a ggplot2 model.", call. = FALSE) - } - - current_title <- plot$labels$title - default_title <- get_default_title(plot = plot, default = NULL) - - if (identical(current_title, default_title)) { - if (!is.null(default) && !is.na(default)) { - title <- default - } else { - title <- current_title - } - } else { - title <- gsub("\"", "***", as.character(current_title)) |> - strsplit("***", fixed = TRUE) |> - unlist() - title <- title[which(title != "" & title != "paste(" & - title != ", italic(" & title != ", bold(" & title != ", bolditalic(" & - title != ")" & title != "), ")] - title <- gsub("_+", " ", concat(title)) |> - trimws() - if (title == "") { - title <- get_default_title(plot = plot, default = default) - } - } - - if (!is.null(title) && !is.na(title) && isTRUE(valid_filename)) { - title <- gsub("[ .]+", "_", - gsub("[?!|<>|:/\\*]", "", title)) |> - tolower() - } - - caption <- plot$labels$caption - if (!is.null(caption) && caption %like% "^[0-9a-f]+$") { - if (is.na(title)) { - title <- NULL - } - title <- trimws(paste(title, "-", caption)) - } - - title -} - -get_default_title <- function(plot, default) { - if (!is.null(default)) { - return(default) - } - - get_mapping <- function(plot) { - c(gsub("~", "", sapply(plot$mapping, deparse)), - gsub("~", "", sapply(plot$facet$params$facets, deparse))) - } - - - mapp <- get_mapping(plot) - # no nonsense argument names - mapp <- mapp[!mapp %in% c("x", "y")] - val <- unname(mapp[names(mapp) == "y"]) - - # generate txt of y axis - is_dutch <- Sys.getlocale() %like% "nl|dutch|nederlands" - txt_per <- ifelse(is_dutch, "per", "per") - txt_sep <- ifelse(is_dutch, "en", "and") - - val[tolower(val) %in% c("`n()`", "n", "count", "freq")] <- ifelse(is_dutch, "aantal", "count") - - val <- gsub(", ?na[.]rm ?= ?(T(RUE)?|F(ALSE)?)", "", val) - val <- gsub("^`(n_distinct|length\\(unique)\\(+(.*?)\\)+`$", - paste(ifelse(is_dutch, "unieke", "unique"), "\\2"), tolower(val)) - - val <- gsub("^`median\\(+(.*?)\\)+`$", - paste(ifelse(is_dutch, "mediane", "median"), "\\1"), tolower(val)) - - val <- gsub("^`mean\\(+(.*?)\\)+`$", - paste(ifelse(is_dutch, "gemiddelde", "mean"), "\\1"), tolower(val)) - - val <- gsub("^`min\\(+(.*?)\\)+`$", - paste(ifelse(is_dutch, "minimale", "minimum"), "\\1"), tolower(val)) - - val <- gsub("^`max\\(+(.*?)\\)+`$", - paste(ifelse(is_dutch, "maximale", "maximum"), "\\1"), tolower(val)) - - val <- gsub("[_.]", " ", val) - - if (length(val) > 0) { - val <- tolower(paste0(val, " ", txt_per, " ")) - substr(val, 1, 1) <- toupper(substr(val, 1, 1)) - } else { - val <- "" - } - - mapp <- tolower(unique(unname(mapp[!names(mapp) %in% c("y", "group")]))) - mapp <- gsub("(^`|`$)", "", mapp) - mapp <- gsub("[_.]", " ", mapp) - mapp <- gsub("c\\((.*?)\\)", "\\1", mapp) - mapp <- unlist(lapply(mapp, strsplit, ", ?"), use.names = FALSE) - - # don't create title if it contains nonsense such as functions - if (any(mapp %like% "[()]")) { - mapp <- character(0) - } - - if (length(mapp) >= 1 && length(val) > 0 && val != "") { - # transform to form: "x, y and z" - if (length(mapp) > 1) { - mapp <- paste(paste(mapp[seq_len(length(mapp) - 1)], collapse = ", "), - txt_sep, mapp[length(mapp)]) - } - paste0(val, mapp) - } else { - default - } -} diff --git a/R/labellers.R b/R/labellers.R deleted file mode 100644 index 0096c351..00000000 --- a/R/labellers.R +++ /dev/null @@ -1,65 +0,0 @@ -# ===================================================================== # -# An R package by Certe: # -# https://github.com/certe-medical-epidemiology # -# # -# Licensed as GPL-v2.0. # -# # -# Developed at non-profit organisation Certe Medical Diagnostics & # -# Advice, department of Medical Epidemiology. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# ===================================================================== # - -#' Label Euro currencies -#' -#' Format numbers as currency, rounding values to dollars or cents using a convenient heuristic. -#' @param x values -#' @inheritParams plot2 -#' @name labellers -#' @rdname labellers -#' @export -#' @examples -#' \dontrun{ -#' profit <- data.frame(group = LETTERS[1:4], -#' profit = runif(4, 10000, 25000)) -#' -#' profit |> -#' plot2(y.labels = euros, -#' datalabels = FALSE) -#' -#' profit |> -#' plot2(y.labels = euros, -#' datalabels.format = euros) -#' } -euros <- function(x, - big.mark = big_mark(), - decimal.mark = dec_mark(), - ...) { - if (identical(x, as.integer(x))) { - # no cents - trimws(paste0("\u20ac ", trimws(format(round(x, 0), decimal.mark = decimal.mark, big.mark = big.mark)))) - } else { - trimws(paste0("\u20ac ", trimws(format(round(x, 2), decimal.mark = decimal.mark, big.mark = big.mark, nsmall = 2)))) - } -} - -#' @rdname labellers -#' @export -dollars <- function(x, - big.mark = big_mark(), - decimal.mark = dec_mark(), - ...) { - if (identical(x, as.integer(x))) { - # no cents - trimws(paste0("$", trimws(format(round(x, 0), decimal.mark = decimal.mark, big.mark = big.mark)))) - } else { - trimws(paste0("$", trimws(format(round(x, 2), decimal.mark = decimal.mark, big.mark = big.mark, nsmall = 2)))) - } -} diff --git a/R/md_to_expression.R b/R/md_to_expression.R deleted file mode 100644 index 97655637..00000000 --- a/R/md_to_expression.R +++ /dev/null @@ -1,128 +0,0 @@ -# ===================================================================== # -# An R package by Certe: # -# https://github.com/certe-medical-epidemiology # -# # -# Licensed as GPL-v2.0. # -# # -# Developed at non-profit organisation Certe Medical Diagnostics & # -# Advice, department of Medical Epidemiology. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# ===================================================================== # - -#' Convert Markdown to Plotmath Expression -#' -#' This function converts common markdown language to an \R [plotmath][grDevices::plotmath] expression. [plot2()] uses this function internally to convert plot titles and axis titles. -#' @param x text to convert, only the first value will be evaluated -#' @details This function only supports common markdown (italic, bold, bold-italic, subscript, superscript), but also supports some additional functionalities for more advanced expressions using \R [plotmath][grDevices::plotmath]. Please see *Examples*. -#' -#' In [plot2()], this function can be also set to argument `category.labels` to print the data values as expressions: -#' - `plot2(..., category.labels = md_to_expression)` -#' @export -#' @return An [expression] if `x` is length 1, or a [list] of expressions otherwise -#' @examples -#' # use '*' for italics, not '_', to prevent conflicts with variable naming -#' md_to_expression("this is *italic* text, this is _not italic_ text") -#' -#' md_to_expression("this is **bold** text") -#' -#' md_to_expression("this is ***bold and italic*** text") -#' -#' # subscript and superscript can be done in HTML or markdown with curly brackets: -#' md_to_expression("this is somesubscripted text, this is also_{subscripted} text") -#' md_to_expression("this is somesuperscripted text, this is also^{superscripted} text") -#' -#' # use $...$ to use any plotmath expression as-is (see ?plotmath): -#' md_to_expression("text $omega$ text, $a[x]$") -#' -#' mtcars |> -#' plot2(mpg, hp, -#' title = "*These are* the **Greek** lower $omega$ and upper $Omega$", -#' x.title = "x_{mpg}", -#' y.title = "y_{hp}") -#' -#' mtcars |> -#' plot2(mpg, hp, -#' title = "$f[X](x)==frac(1, sigma*sqrt(2*pi))*plain(e)^{frac(-(x-mu)^2, 2*sigma^2)}$", -#' subtitle = "Some insane $widehat(plotmath)$ title") -md_to_expression <- function(x) { - x <- as.character(x) - - if (length(x) > 1) { - return(lapply(x, md_to_expression)) - } - - if (x %like% "^[$].+[$]$") { - # a full plotmath expression - return(parse(text = gsub("^[$](.+)[$]$", "\\1", x, perl = TRUE))) - } - x <- paste0("'", x, "'") - - # remove backticks - x <- gsub("`", "", x, fixed = TRUE) - - # translate ***bold-italic*** - while (x %like% "[*]{3}.+[*]{3}") { - x <- gsub("[*]{3}(.+?)[*]{3}", "', bolditalic('\\1'), '", x, perl = TRUE) - } - - # translate **bold** - while (x %like% "[*]{2}.+[*]{2}") { - x <- gsub("[*]{2}(.+?)[*]{2}", "', bold('\\1'), '", x, perl = TRUE) - } - - # translate *italic* - while (x %like% "[*].+[*]") { - x <- gsub("[*](.+?)[*]", "', italic('\\1'), '", x, perl = TRUE) - } - - # translate subscript - while (grepl("\\S+.+", x, ignore.case = FALSE)) { - x <- gsub("(\\S+?)(.+?)", "', \\1['\\2'], '", x, perl = TRUE) - } - - # translate superscript - while (grepl("\\S+.+", x, ignore.case = FALSE)) { - x <- gsub("(\\S+?)(.+?)", "', \\1^'\\2', '", x, perl = TRUE) - } - - # translate sub_{script} - while (grepl("\\S+_[{].+[}]", x, ignore.case = FALSE)) { - x <- gsub("(\\S+?)_[{](.+?)[}]", "', \\1['\\2'], '", x, perl = TRUE) - } - - # translate super^{script} - x <- gsub("\\^([a-zA-Z0-9,._-]+)", "^{\\1}", x) - while (grepl("\\S+\\^[{].+[}]", x, ignore.case = FALSE)) { - x <- gsub("(\\S+?)\\^[{](.+?)[}]+?", "\\1'^'\\2', '", x, perl = TRUE) - } - - # translate $plotmath$, such as $omega$ - while (x %like% "[$].+[$]") { - x <- gsub("[$](.+?)[$]", "', \\1, '", x, perl = TRUE) - } - - # clean up - x <- gsub("^', '?'?", "", x) - x <- gsub("^'', ", "", x) - x <- gsub(", ''$", "", x) - x <- gsub(", '$", "", x) - x <- gsub("''", "'", x, fixed = TRUE) - x <- gsub("), ', '^", ")^", x, fixed = TRUE) - x <- gsub(", '^", "^", x, fixed = TRUE) - x <- gsub("^, ", "", x) - - tryCatch(parse(text = paste0("paste(", x, ")")), - error = function(e) { - stop("This cannot be parsed by md_to_expression(): \"", x, - "\"\n\nFor more complex expressions, start and end with '$' to write in plotmath, or use parse(text = \"...\").", - call. = FALSE) - }) -} diff --git a/R/move_layer.R b/R/move_layer.R deleted file mode 100644 index 8efd1528..00000000 --- a/R/move_layer.R +++ /dev/null @@ -1,56 +0,0 @@ -# ===================================================================== # -# An R package by Certe: # -# https://github.com/certe-medical-epidemiology # -# # -# Licensed as GPL-v2.0. # -# # -# Developed at non-profit organisation Certe Medical Diagnostics & # -# Advice, department of Medical Epidemiology. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# ===================================================================== # - -#' Move a `ggplot` Layer -#' -#' Use this function to move a certain plot layer up or down. This function returns a `ggplot` object. -#' @param plot a `ggplot` object -#' @param move number of layers to move `layer` up or down -#' @param layer the layer to affect, defaults to top layer -#' @importFrom ggplot2 is.ggplot -#' @export -move_layer <- function(plot, move = -1, layer = length(plot$layers)) { - - if (!is.ggplot(plot)) { - stop("`plot` must be a ggplot2 model.", call. = FALSE) - } - - layers <- plot$layers - layers_backup <- layers - layer_old <- layer - layer_new <- max(1, layer + move) - - if (!layer_old %in% seq_len(length(layers))) { - stop("This plot contains only ", length(layers), " layers. Layer ", - layer_old, " does not exist.", call. = FALSE) - } - if (!layer_new %in% seq_len(length(layers))) { - stop("This plot contains only ", length(layers), " layers; layer ", - layer_old, " cannot be moved to position ", layer_new, ".", call. = FALSE) - } - - # new order - layer_old becomes layer_new and the rest moves along - layers[[layer_new]] <- layers[[layer_old]] - for (i in (layer_new + 1):length(layers)) { - layers[[i]] <- layers_backup[[i - 1]] - } - plot$layers <- layers - - plot -} diff --git a/R/plot2-methods.R b/R/plot2-methods.R deleted file mode 100644 index fecb1231..00000000 --- a/R/plot2-methods.R +++ /dev/null @@ -1,3711 +0,0 @@ -# ===================================================================== # -# An R package by Certe: # -# https://github.com/certe-medical-epidemiology # -# # -# Licensed as GPL-v2.0. # -# # -# Developed at non-profit organisation Certe Medical Diagnostics & # -# Advice, department of Medical Epidemiology. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# ===================================================================== # - -#' Methods for [plot2()] -#' -#' These are the implemented methods for different S3 classes to be used in [plot2()]. Since they have an extensive list of arguments, they are placed here on a separate manual page. -#' @rdname plot2-methods -#' @name plot2-methods -#' @inheritParams plot2 -#' @importFrom ggplot2 fortify -#' @importFrom dplyr count filter -#' @importFrom certestyle font_black font_blue -#' @export -plot2.default <- function(.data, - x = NULL, - y = NULL, - category = NULL, - facet = NULL, - type = NULL, - x.title = TRUE, - y.title = TRUE, - category.title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - tag = NULL, - title.linelength = 60, - title.colour = getOption("plot2.colour_font_primary", "black"), - subtitle.linelength = 60, - subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), - na.replace = "", - na.rm = FALSE, - facet.position = "top", - facet.fill = NULL, - facet.bold = TRUE, - facet.italic = FALSE, - facet.size = 10, - facet.margin = 8, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = TRUE, - facet.fixed_y = NULL, - facet.fixed_x = TRUE, - facet.drop = FALSE, - facet.nrow = NULL, - facet.relative = FALSE, - x.date_breaks = NULL, - x.date_labels = NULL, - x.date_remove_years = NULL, - category.focus = NULL, - colour = getOption("plot2.colour", "ggplot2"), - colour_fill = NULL, - colour_opacity = 0, - x.lbl_angle = 0, - x.lbl_align = NULL, - x.lbl_italic = FALSE, - x.lbl_taxonomy = FALSE, - x.remove = FALSE, - x.position = "bottom", - x.max_items = Inf, - x.max_txt = "(rest, x%n)", - category.max_items = Inf, - category.max_txt = "(rest, x%n)", - facet.max_items = Inf, - facet.max_txt = "(rest, x%n)", - x.breaks = NULL, - x.n_breaks = NULL, - x.transform = "identity", - x.expand = NULL, - x.limits = NULL, - x.labels = NULL, - x.character = NULL, - x.drop = FALSE, - x.mic = FALSE, - x.zoom = FALSE, - y.remove = FALSE, - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - y.breaks = NULL, - y.n_breaks = NULL, - y.limits = NULL, - y.labels = NULL, - y.expand = NULL, - y.transform = "identity", - y.position = "left", - y.zoom = FALSE, - y_secondary = NULL, - y_secondary.type = type, - y_secondary.title = TRUE, - y_secondary.colour = "certeroze", - y_secondary.colour_fill = "certeroze6", - y_secondary.scientific = NULL, - y_secondary.percent = FALSE, - y_secondary.labels = NULL, - category.labels = NULL, - category.percent = FALSE, - category.breaks = NULL, - category.limits = NULL, - category.expand = 0, - category.midpoint = NULL, - category.transform = "identity", - category.date_breaks = NULL, - category.date_labels = NULL, - category.character = NULL, - x.sort = NULL, - category.sort = TRUE, - facet.sort = TRUE, - x.complete = NULL, - category.complete = NULL, - facet.complete = NULL, - datalabels = TRUE, - datalabels.round = ifelse(y.percent, 2, 1), - datalabels.format = "%n", - datalabels.colour = "grey25", - datalabels.colour_fill = NULL, - datalabels.size = (3 * text_factor), - datalabels.angle = 0, - datalabels.lineheight = 1.0, - decimal.mark = dec_mark(), - big.mark = big_mark(), - summarise_function = base::sum, - stacked = FALSE, - stackedpercent = FALSE, - horizontal = FALSE, - reverse = horizontal, - smooth = NULL, - smooth.method = NULL, - smooth.formula = NULL, - smooth.se = TRUE, - smooth.level = 0.95, - smooth.alpha = 0.25, - smooth.linewidth = 0.75, - smooth.linetype = 3, - smooth.colour = NULL, - size = NULL, - linetype = 1, - linewidth = NULL, - binwidth = NULL, - width = NULL, - jitter_seed = NA, - violin_scale = "count", - legend.position = NULL, - legend.title = NULL, # TRUE in numeric categories - legend.reverse = FALSE, - legend.barheight = 6, - legend.barwidth = 1.5, - legend.nbin = 300, - legend.italic = FALSE, - sankey.node_width = 0.15, - sankey.node_whitespace = 0.03, - sankey.alpha = 0.5, - sankey.remove_axes = NULL, - zoom = FALSE, - sep = " / ", - print = FALSE, - text_factor = 1, - font = getOption("plot2.font"), - theme = getOption("plot2.theme", "theme_minimal2"), - background = getOption("plot2.colour_background", "white"), - markdown = TRUE, - ...) { - if (is.function(.data)) { - stop("`plot2()` does not yet support functions to be plotted", call. = FALSE) - } - - if (tryCatch(suppressWarnings(is.atomic(.data) && !is.table(.data) && !is.matrix(.data)), error = function(e) FALSE)) { - # an atomic vector, such as numeric, character, factor - y_deparse <- paste0(trimws(deparse(substitute(.data))), collapse = " ") - if (nchar(y_deparse) > 30) { - y_deparse <- "y" - } - if (missing(.data)) { - .data <- y - y_deparse <- "y" - } - if (is.character(.data) || is.factor(.data)) { - new_df <- as.data.frame(table(.data)) - colnames(new_df) <- c(y_deparse, "y") - new_df <- new_df |> filter(y != 0) - } else if (is.numeric(.data) && missing(y)) { - new_df <- data.frame(x = seq_len(length(.data)), - y = .data, stringsAsFactors = FALSE) - } else if (!is.numeric(.data) && missing(x)) { - new_df <- data.frame(x = .data, stringsAsFactors = FALSE) |> count(x, name = "y") - } - if (is.null(type)) { - type <- getOption("plot2.default_type", "geom_col") - } - - } else { - # not an atomic vector - # ggplot2's fortify() will try to make this a data.frame, - # so that plot2.data.frame() can be called - new_df <- tryCatch(fortify(.data), error = function(e) NULL) - if (is.null(new_df)) { - # then try to make a regular data.frame - new_df <- tryCatch(as.data.frame(.data, stringsAsFactors = FALSE), - error = function(e) NULL) - if (!is.data.frame(new_df)) { - stop("Unable to initialise plot2(): input class '", paste(class(.data), collapse = "/"), "' is unsupported", - call. = FALSE) - } - plot2_caution("Input class ", paste0("'", class(.data), "'", collapse = "/"), " was transformed using `as.data.frame()`") - if (inherits(.data, "table")) { - # if using `as.data.table()` on a `table`, the resulting count column with be "Freq" - plot2_message("Using ", font_blue("y = Freq"), font_black(" since `as.data.table()` on a `table` results in a 'Freq' column")) - y <- str2lang("Freq") - } - } - } - - plot2_exec(new_df, - x = {{ x }}, - y = {{ y }}, - category = {{ category }}, - facet = {{ facet }}, - type = type, - x.title = {{ x.title }}, - y.title = {{ y.title }}, - category.title = {{ category.title }}, - title = {{ title }}, - subtitle = {{ subtitle }}, - caption = {{ caption }}, - tag = {{ tag }}, - title.linelength = title.linelength, - title.colour = title.colour, - subtitle.linelength = subtitle.linelength, - subtitle.colour = subtitle.colour, - na.replace = na.replace, - na.rm = na.rm, - facet.position = facet.position, - facet.fill = facet.fill, - facet.bold = facet.bold, - facet.italic = facet.italic, - facet.size = facet.size, - facet.margin = facet.margin, - facet.repeat_lbls_x = facet.repeat_lbls_x, - facet.repeat_lbls_y = facet.repeat_lbls_y, - facet.fixed_y = facet.fixed_y, - facet.fixed_x = facet.fixed_x, - facet.drop = facet.drop, - facet.nrow = facet.nrow, - facet.relative = facet.relative, - x.date_breaks = x.date_breaks, - x.date_labels = x.date_labels, - x.date_remove_years = x.date_remove_years, - category.focus = category.focus, - colour = colour, - colour_fill = colour_fill, - colour_opacity = colour_opacity, - x.lbl_angle = x.lbl_angle, - x.lbl_align = x.lbl_align, - x.lbl_italic = x.lbl_italic, - x.lbl_taxonomy = x.lbl_taxonomy, - x.remove = x.remove, - x.position = x.position, - x.max_items = x.max_items, - x.max_txt = x.max_txt, - category.max_items = category.max_items, - category.max_txt = category.max_txt, - facet.max_items = facet.max_items, - facet.max_txt = facet.max_txt, - x.breaks = x.breaks, - x.n_breaks = x.n_breaks, - x.transform = x.transform, - x.expand = x.expand, - x.limits = x.limits, - x.labels = x.labels, - x.character = x.character, - x.drop = x.drop, - x.mic = x.mic, - x.zoom = x.zoom, - y.remove = y.remove, - y.24h = y.24h, - y.age = y.age, - y.scientific = y.scientific, - y.percent = y.percent, - y.percent_break = y.percent_break, - y.breaks = y.breaks, - y.n_breaks = y.n_breaks, - y.limits = y.limits, - y.labels = y.labels, - y.expand = y.expand, - y.transform = y.transform, - y.position = y.position, - y.zoom = y.zoom, - y_secondary = {{ y_secondary }}, - y_secondary.type = y_secondary.type, - y_secondary.title = {{ y_secondary.title }}, - y_secondary.colour = y_secondary.colour, - y_secondary.colour_fill = y_secondary.colour_fill, - y_secondary.scientific = y_secondary.scientific, - y_secondary.percent = y_secondary.percent, - y_secondary.labels = y_secondary.labels, - category.labels = category.labels, - category.percent = category.percent, - category.breaks = category.breaks, - category.limits = category.limits, - category.expand = category.expand, - category.midpoint = category.midpoint, - category.transform = category.transform, - category.date_breaks = category.date_breaks, - category.date_labels = category.date_labels, - category.character = category.character, - x.sort = x.sort, - category.sort = category.sort, - facet.sort = facet.sort, - x.complete = x.complete, - category.complete = category.complete, - facet.complete = facet.complete, - datalabels = {{ datalabels }}, - datalabels.round = datalabels.round, - datalabels.colour = datalabels.colour, - datalabels.format = datalabels.format, - datalabels.colour_fill = datalabels.colour_fill, - datalabels.size = datalabels.size, - datalabels.angle = datalabels.angle, - datalabels.lineheight = datalabels.lineheight, - decimal.mark = decimal.mark, - big.mark = big.mark, - summarise_function = summarise_function, - stacked = stacked, - stackedpercent = stackedpercent, - horizontal = horizontal, - reverse = reverse, - smooth = smooth, - smooth.method = smooth.method, - smooth.formula = smooth.formula, - smooth.se = smooth.se, - smooth.level = smooth.level, - smooth.alpha = smooth.alpha, - smooth.linewidth = smooth.linewidth, - smooth.linetype = smooth.linetype, - smooth.colour = smooth.colour, - size = size, - linetype = linetype, - linewidth = linewidth, - binwidth = binwidth, - width = width, - jitter_seed = jitter_seed, - violin_scale = violin_scale, - legend.position = legend.position, - legend.title = {{ legend.title }}, - legend.reverse = legend.reverse, - legend.barheight = legend.barheight, - legend.barwidth = legend.barwidth, - legend.nbin = legend.nbin, - legend.italic = legend.italic, - sankey.node_width = sankey.node_width, - sankey.node_whitespace = sankey.node_whitespace, - sankey.alpha = sankey.alpha, - sankey.remove_axes = sankey.remove_axes, - zoom = zoom, - sep = sep, - print = print, - text_factor = text_factor, - font = font, - theme = theme, - background = background, - markdown = markdown, - `_misses.x` = missing(x), - `_misses.y` = missing(y), - `_misses.category` = missing(category), - `_misses.facet` = missing(facet), - `_misses.datalabels` = missing(datalabels), - `_misses.colour_fill` = missing(colour_fill), - `_misses.x.title` = missing(x.title), - `_misses.y.title` = missing(y.title), - `_misses.title` = missing(title), - `_misses.subtitle` = missing(subtitle), - `_misses.tag` = missing(tag), - `_misses.caption` = missing(caption), - `_misses.y.percent` = missing(y.percent), - `_misses.y.percent_break` = missing(y.percent_break), - `_misses.x.zoom` = missing(x.zoom), - `_misses.x.max_items` = missing(x.max_items), - `_misses.facet.fixed_x` = missing(facet.fixed_x), - `_label.x` = deparse(substitute(x)), - `_label.y` = deparse(substitute(y)), - `_label.category` = deparse(substitute(category)), - `_label.facet` = deparse(substitute(facet)), - `_label.y_secondary` = deparse(substitute(y_secondary)), - `_summarise_fn_name` = deparse(substitute(summarise_function)), - `_misses.summarise_function` = missing(summarise_function), - ...) -} - -#' @rdname plot2-methods -#' @export -plot2.freq <- function(.data, - x = .data$item, - y = .data$count, - category = NULL, - facet = NULL, - type = NULL, - x.title = "Item", - y.title = "Count", - category.title = TRUE, - title = NULL, - subtitle = NULL, - caption = NULL, - tag = NULL, - title.linelength = 60, - title.colour = getOption("plot2.colour_font_primary", "black"), - subtitle.linelength = 60, - subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), - na.replace = "", - na.rm = FALSE, - facet.position = "top", - facet.fill = NULL, - facet.bold = TRUE, - facet.italic = FALSE, - facet.size = 10, - facet.margin = 8, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = TRUE, - facet.fixed_y = NULL, - facet.fixed_x = TRUE, - facet.drop = FALSE, - facet.nrow = NULL, - facet.relative = FALSE, - x.date_breaks = NULL, - x.date_labels = NULL, - x.date_remove_years = NULL, - category.focus = NULL, - colour = getOption("plot2.colour", "ggplot2"), - colour_fill = NULL, - colour_opacity = 0, - x.lbl_angle = 0, - x.lbl_align = NULL, - x.lbl_italic = FALSE, - x.lbl_taxonomy = FALSE, - x.remove = FALSE, - x.position = "bottom", - x.max_items = Inf, - x.max_txt = "(rest, x%n)", - category.max_items = Inf, - category.max_txt = "(rest, x%n)", - facet.max_items = Inf, - facet.max_txt = "(rest, x%n)", - x.breaks = NULL, - x.n_breaks = NULL, - x.transform = "identity", - x.expand = NULL, - x.limits = NULL, - x.labels = NULL, - x.character = NULL, - x.drop = FALSE, - x.mic = FALSE, - x.zoom = FALSE, - y.remove = FALSE, - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - y.breaks = NULL, - y.n_breaks = NULL, - y.limits = NULL, - y.labels = NULL, - y.expand = NULL, - y.transform = "identity", - y.position = "left", - y.zoom = FALSE, - y_secondary = NULL, - y_secondary.type = type, - y_secondary.title = TRUE, - y_secondary.colour = "certeroze", - y_secondary.colour_fill = "certeroze6", - y_secondary.scientific = NULL, - y_secondary.percent = FALSE, - y_secondary.labels = NULL, - category.labels = NULL, - category.percent = FALSE, - category.breaks = NULL, - category.limits = NULL, - category.expand = 0, - category.midpoint = NULL, - category.transform = "identity", - category.date_breaks = NULL, - category.date_labels = NULL, - category.character = NULL, - x.sort = "freq-desc", - category.sort = TRUE, - facet.sort = TRUE, - x.complete = NULL, - category.complete = NULL, - facet.complete = NULL, - datalabels = TRUE, - datalabels.round = ifelse(y.percent, 2, 1), - datalabels.format = "%n", - datalabels.colour = "grey25", - datalabels.colour_fill = NULL, - datalabels.size = (3 * text_factor), - datalabels.angle = 0, - datalabels.lineheight = 1.0, - decimal.mark = dec_mark(), - big.mark = big_mark(), - summarise_function = base::sum, - stacked = FALSE, - stackedpercent = FALSE, - horizontal = FALSE, - reverse = horizontal, - smooth = NULL, - smooth.method = NULL, - smooth.formula = NULL, - smooth.se = TRUE, - smooth.level = 0.95, - smooth.alpha = 0.25, - smooth.linewidth = 0.75, - smooth.linetype = 3, - smooth.colour = NULL, - size = NULL, - linetype = 1, - linewidth = NULL, - binwidth = NULL, - width = NULL, - jitter_seed = NA, - violin_scale = "count", - legend.position = NULL, - legend.title = NULL, # TRUE in numeric categories - legend.reverse = FALSE, - legend.barheight = 6, - legend.barwidth = 1.5, - legend.nbin = 300, - legend.italic = FALSE, - sankey.node_width = 0.15, - sankey.node_whitespace = 0.03, - sankey.alpha = 0.5, - sankey.remove_axes = NULL, - zoom = FALSE, - sep = " / ", - print = FALSE, - text_factor = 1, - font = getOption("plot2.font"), - theme = getOption("plot2.theme", "theme_minimal2"), - background = getOption("plot2.colour_background", "white"), - markdown = TRUE, - ...) { - plot2_exec(as.data.frame(.data, stringsAsFactors = FALSE)[, 1:2, drop = FALSE], - x = x, - y = y, - category = {{ category }}, - facet = {{ facet }}, - type = type, - x.title = {{ x.title }}, - y.title = {{ y.title }}, - category.title = {{ category.title }}, - title = {{ title }}, - subtitle = {{ subtitle }}, - caption = {{ caption }}, - tag = {{ tag }}, - title.linelength = title.linelength, - title.colour = title.colour, - subtitle.linelength = subtitle.linelength, - subtitle.colour = subtitle.colour, - na.replace = na.replace, - na.rm = na.rm, - facet.position = facet.position, - facet.fill = facet.fill, - facet.bold = facet.bold, - facet.italic = facet.italic, - facet.size = facet.size, - facet.margin = facet.margin, - facet.repeat_lbls_x = facet.repeat_lbls_x, - facet.repeat_lbls_y = facet.repeat_lbls_y, - facet.fixed_y = facet.fixed_y, - facet.fixed_x = facet.fixed_x, - facet.drop = facet.drop, - facet.nrow = facet.nrow, - facet.relative = facet.relative, - x.date_breaks = x.date_breaks, - x.date_labels = x.date_labels, - x.date_remove_years = x.date_remove_years, - category.focus = category.focus, - colour = colour, - colour_fill = colour_fill, - colour_opacity = colour_opacity, - x.lbl_angle = x.lbl_angle, - x.lbl_align = x.lbl_align, - x.lbl_italic = x.lbl_italic, - x.lbl_taxonomy = x.lbl_taxonomy, - x.remove = x.remove, - x.position = x.position, - x.max_items = x.max_items, - x.max_txt = x.max_txt, - category.max_items = category.max_items, - category.max_txt = category.max_txt, - facet.max_items = facet.max_items, - facet.max_txt = facet.max_txt, - x.breaks = x.breaks, - x.n_breaks = x.n_breaks, - x.transform = x.transform, - x.expand = x.expand, - x.limits = x.limits, - x.labels = x.labels, - x.character = x.character, - x.drop = x.drop, - x.mic = x.mic, - x.zoom = x.zoom, - y.remove = y.remove, - y.24h = y.24h, - y.age = y.age, - y.scientific = y.scientific, - y.percent = y.percent, - y.percent_break = y.percent_break, - y.breaks = y.breaks, - y.n_breaks = y.n_breaks, - y.limits = y.limits, - y.labels = y.labels, - y.expand = y.expand, - y.transform = y.transform, - y.position = y.position, - y.zoom = y.zoom, - y_secondary = {{ y_secondary }}, - y_secondary.type = y_secondary.type, - y_secondary.title = {{ y_secondary.title }}, - y_secondary.colour = y_secondary.colour, - y_secondary.colour_fill = y_secondary.colour_fill, - y_secondary.scientific = y_secondary.scientific, - y_secondary.percent = y_secondary.percent, - y_secondary.labels = y_secondary.labels, - category.labels = category.labels, - category.percent = category.percent, - category.breaks = category.breaks, - category.limits = category.limits, - category.expand = category.expand, - category.midpoint = category.midpoint, - category.transform = category.transform, - category.date_breaks = category.date_breaks, - category.date_labels = category.date_labels, - category.character = category.character, - x.sort = x.sort, - category.sort = category.sort, - facet.sort = facet.sort, - x.complete = x.complete, - category.complete = category.complete, - facet.complete = facet.complete, - datalabels = {{ datalabels }}, - datalabels.round = datalabels.round, - datalabels.colour = datalabels.colour, - datalabels.format = datalabels.format, - datalabels.colour_fill = datalabels.colour_fill, - datalabels.size = datalabels.size, - datalabels.angle = datalabels.angle, - datalabels.lineheight = datalabels.lineheight, - decimal.mark = decimal.mark, - big.mark = big.mark, - summarise_function = summarise_function, - stacked = stacked, - stackedpercent = stackedpercent, - horizontal = horizontal, - reverse = reverse, - smooth = smooth, - smooth.method = smooth.method, - smooth.formula = smooth.formula, - smooth.se = smooth.se, - smooth.level = smooth.level, - smooth.alpha = smooth.alpha, - smooth.linewidth = smooth.linewidth, - smooth.linetype = smooth.linetype, - smooth.colour = smooth.colour, - size = size, - linetype = linetype, - linewidth = linewidth, - binwidth = binwidth, - width = width, - jitter_seed = jitter_seed, - violin_scale = violin_scale, - legend.position = legend.position, - legend.title = {{ legend.title }}, - legend.reverse = legend.reverse, - legend.barheight = legend.barheight, - legend.barwidth = legend.barwidth, - legend.nbin = legend.nbin, - legend.italic = legend.italic, - sankey.node_width = sankey.node_width, - sankey.node_whitespace = sankey.node_whitespace, - sankey.alpha = sankey.alpha, - sankey.remove_axes = sankey.remove_axes, - zoom = zoom, - sep = sep, - print = print, - text_factor = text_factor, - font = font, - theme = theme, - background = background, - markdown = markdown, - `_misses.x` = missing(x), - `_misses.y` = missing(y), - `_misses.category` = missing(category), - `_misses.facet` = missing(facet), - `_misses.datalabels` = missing(datalabels), - `_misses.colour_fill` = missing(colour_fill), - `_misses.x.title` = missing(x.title), - `_misses.y.title` = missing(y.title), - `_misses.title` = missing(title), - `_misses.subtitle` = missing(subtitle), - `_misses.tag` = missing(tag), - `_misses.caption` = missing(caption), - `_misses.y.percent` = missing(y.percent), - `_misses.y.percent_break` = missing(y.percent_break), - `_misses.x.zoom` = missing(x.zoom), - `_misses.x.max_items` = missing(x.max_items), - `_misses.facet.fixed_x` = missing(facet.fixed_x), - `_label.x` = "item", - `_label.y` = "count", - `_label.category` = deparse(substitute(category)), - `_label.facet` = deparse(substitute(facet)), - `_label.y_secondary` = deparse(substitute(y_secondary)), - `_summarise_fn_name` = deparse(substitute(summarise_function)), - `_misses.summarise_function` = missing(summarise_function), - ...) -} - -#' @rdname plot2-methods -#' @details For geographic information system (GIS) analysis, use the `sf` package with a data set containing geometries. The result can be used as input for [plot2()]. -#' @param crs the coordinate reference system (CRS) to use. If this is not left blank, [sf::st_transform()] will be used to transform the geometric data to the new CRS. -#' @param datalabels.centroid a [logical] to indicate whether datalabels must be centred on the polygon (using [sf::st_centroid()], the default), or be placed on the 'best' spot on the surface (using [sf::st_point_on_surface()]) -#' @export -plot2.sf <- function(.data, - x = NULL, - y = NULL, - category = NULL, - facet = NULL, - type = NULL, - x.title = FALSE, - y.title = FALSE, - category.title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - tag = NULL, - title.linelength = 60, - title.colour = getOption("plot2.colour_font_primary", "black"), - subtitle.linelength = 60, - subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), - na.replace = "", - na.rm = FALSE, - facet.position = "top", - facet.fill = NULL, - facet.bold = TRUE, - facet.italic = FALSE, - facet.size = 10, - facet.margin = 8, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = TRUE, - facet.fixed_y = NULL, - facet.fixed_x = TRUE, - facet.drop = FALSE, - facet.nrow = NULL, - facet.relative = FALSE, - x.date_breaks = NULL, - x.date_labels = NULL, - x.date_remove_years = NULL, - category.focus = NULL, - colour = getOption("plot2.colour_sf", "grey50"), - colour_fill = getOption("plot2.colour_sf_fill", getOption("plot2.colour", "ggplot2")), - colour_opacity = 0, - x.lbl_angle = 0, - x.lbl_align = NULL, - x.lbl_italic = FALSE, - x.lbl_taxonomy = FALSE, - x.remove = FALSE, - x.position = "bottom", - x.max_items = Inf, - x.max_txt = "(rest, x%n)", - category.max_items = Inf, - category.max_txt = "(rest, x%n)", - facet.max_items = Inf, - facet.max_txt = "(rest, x%n)", - x.breaks = NULL, - x.n_breaks = NULL, - x.transform = "identity", - x.expand = 0, - x.limits = NULL, - x.labels = NULL, - x.character = NULL, - x.drop = FALSE, - x.mic = FALSE, - x.zoom = FALSE, - y.remove = FALSE, - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - y.breaks = NULL, - y.n_breaks = NULL, - y.limits = NULL, - y.labels = NULL, - y.expand = 0, - y.transform = "identity", - y.position = "left", - y.zoom = FALSE, - y_secondary = NULL, - y_secondary.type = type, - y_secondary.title = TRUE, - y_secondary.colour = "certeroze", - y_secondary.colour_fill = "certeroze6", - y_secondary.scientific = NULL, - y_secondary.percent = FALSE, - y_secondary.labels = NULL, - category.labels = NULL, - category.percent = FALSE, - category.breaks = NULL, - category.limits = NULL, - category.expand = 0, - category.midpoint = NULL, - category.transform = "identity", - category.date_breaks = NULL, - category.date_labels = NULL, - category.character = NULL, - x.sort = NULL, - category.sort = TRUE, - facet.sort = TRUE, - x.complete = NULL, - category.complete = NULL, - facet.complete = NULL, - datalabels = TRUE, - datalabels.round = ifelse(y.percent, 2, 1), - datalabels.format = NULL, - datalabels.colour = "black", - datalabels.colour_fill = NULL, - datalabels.size = (3 * text_factor), - datalabels.angle = 0, - datalabels.lineheight = 1.0, - decimal.mark = dec_mark(), - big.mark = big_mark(), - summarise_function = base::sum, - stacked = FALSE, - stackedpercent = FALSE, - horizontal = FALSE, - reverse = horizontal, - smooth = NULL, - smooth.method = NULL, - smooth.formula = NULL, - smooth.se = TRUE, - smooth.level = 0.95, - smooth.alpha = 0.25, - smooth.linewidth = 0.75, - smooth.linetype = 3, - smooth.colour = NULL, - size = NULL, - linetype = 1, - linewidth = NULL, - binwidth = NULL, - width = NULL, - jitter_seed = NA, - violin_scale = "count", - legend.position = "right", - legend.title = NULL, - legend.reverse = FALSE, - legend.barheight = 6, - legend.barwidth = 1.5, - legend.nbin = 300, - legend.italic = FALSE, - sankey.node_width = 0.15, - sankey.node_whitespace = 0.03, - sankey.alpha = 0.5, - sankey.remove_axes = NULL, - zoom = FALSE, - sep = " / ", - print = FALSE, - text_factor = 1, - font = getOption("plot2.font"), - theme = theme_minimal2(panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - panel.border = element_blank(), - plot.margin = unit(c(5, 5, 0, 0), units = "pt"), - axis.title = element_blank(), - axis.text = element_blank(), - axis.line = element_blank(), - axis.ticks = element_blank()), - background = getOption("plot2.colour_background", "white"), - markdown = TRUE, - crs = NULL, - datalabels.centroid = NULL, - ...) { - - loadNamespace("sf") # will throw an error if not installed - - if (!inherits(.data, "sf")) { - plot2_caution("Transforming plot data to an sf model using ", font_blue("sf::st_as_sf()")) - .data <- sf::st_as_sf(.data) - } - if (!is.null(crs)) { - .data <- sf::st_transform(.data, crs = crs) - } - - if (!is.null(x)) { - plot2_warning("In 'sf' plots, ", font_blue("x"), " will be ignored - did you mean ", font_blue("category"), "?") - } - if (!is.null(y)) { - plot2_warning("In 'sf' plots, ", font_blue("y"), " will be ignored - did you mean ", font_blue("category"), "?") - } - if (!missing(colour) && !identical(colour, "white")) { - plot2_message("In 'sf' plots, " , font_blue("colour"), " will set the borders, not the areas - did you mean ", font_blue(paste0("colour_fill = ", deparse(colour))), "?") - } - - df <- .data - df$x <- "" - df$y <- 0 - - plot2_exec(.data = df, - x = x, - y = y, - category = {{ category }}, - facet = {{ facet }}, - type = "sf", - x.title = {{ x.title }}, - y.title = {{ y.title }}, - category.title = {{ category.title }}, - title = {{ title }}, - subtitle = {{ subtitle }}, - caption = {{ caption }}, - tag = {{ tag }}, - title.linelength = title.linelength, - title.colour = title.colour, - subtitle.linelength = subtitle.linelength, - subtitle.colour = subtitle.colour, - na.replace = na.replace, - na.rm = na.rm, - facet.position = facet.position, - facet.fill = facet.fill, - facet.bold = facet.bold, - facet.italic = facet.italic, - facet.size = facet.size, - facet.margin = facet.margin, - facet.repeat_lbls_x = facet.repeat_lbls_x, - facet.repeat_lbls_y = facet.repeat_lbls_y, - facet.fixed_y = facet.fixed_y, - facet.fixed_x = facet.fixed_x, - facet.drop = facet.drop, - facet.nrow = facet.nrow, - facet.relative = facet.relative, - x.date_breaks = x.date_breaks, - x.date_labels = x.date_labels, - x.date_remove_years = x.date_remove_years, - category.focus = category.focus, - colour = colour, - colour_fill = colour_fill, - colour_opacity = colour_opacity, - x.lbl_angle = x.lbl_angle, - x.lbl_align = x.lbl_align, - x.lbl_italic = x.lbl_italic, - x.lbl_taxonomy = x.lbl_taxonomy, - x.remove = x.remove, - x.position = x.position, - x.max_items = x.max_items, - x.max_txt = x.max_txt, - category.max_items = category.max_items, - category.max_txt = category.max_txt, - facet.max_items = facet.max_items, - facet.max_txt = facet.max_txt, - x.breaks = x.breaks, - x.n_breaks = x.n_breaks, - x.transform = x.transform, - x.expand = x.expand, - x.limits = x.limits, - x.labels = x.labels, - x.character = x.character, - x.drop = x.drop, - x.mic = x.mic, - x.zoom = x.zoom, - y.remove = y.remove, - y.24h = y.24h, - y.age = y.age, - y.scientific = y.scientific, - y.percent = y.percent, - y.percent_break = y.percent_break, - y.breaks = y.breaks, - y.n_breaks = y.n_breaks, - y.limits = y.limits, - y.labels = y.labels, - y.expand = y.expand, - y.transform = y.transform, - y.position = y.position, - y.zoom = y.zoom, - y_secondary = NULL, - y_secondary.type = NULL, - y_secondary.title = TRUE, - y_secondary.colour = NULL, - y_secondary.colour_fill = NULL, - y_secondary.scientific = NULL, - y_secondary.percent = NULL, - y_secondary.labels = NULL, - category.labels = category.labels, - category.percent = category.percent, - category.breaks = category.breaks, - category.limits = category.limits, - category.expand = category.expand, - category.midpoint = category.midpoint, - category.transform = category.transform, - category.date_breaks = category.date_breaks, - category.date_labels = category.date_labels, - category.character = category.character, - x.sort = x.sort, - category.sort = category.sort, - facet.sort = facet.sort, - x.complete = x.complete, - category.complete = category.complete, - facet.complete = facet.complete, - datalabels = {{ datalabels }}, - datalabels.round = datalabels.round, - datalabels.colour = datalabels.colour, - datalabels.format = datalabels.format, - datalabels.colour_fill = datalabels.colour_fill, - datalabels.size = datalabels.size, - datalabels.angle = datalabels.angle, - datalabels.lineheight = datalabels.lineheight, - decimal.mark = decimal.mark, - big.mark = big.mark, - summarise_function = summarise_function, - stacked = stacked, - stackedpercent = stackedpercent, - horizontal = horizontal, - reverse = reverse, - smooth = smooth, - smooth.method = smooth.method, - smooth.formula = smooth.formula, - smooth.se = smooth.se, - smooth.level = smooth.level, - smooth.alpha = smooth.alpha, - smooth.linewidth = smooth.linewidth, - smooth.linetype = smooth.linetype, - smooth.colour = smooth.colour, - size = size, - linetype = linetype, - linewidth = linewidth, - binwidth = binwidth, - width = width, - jitter_seed = jitter_seed, - violin_scale = violin_scale, - legend.position = legend.position, - legend.title = {{ legend.title }}, - legend.reverse = legend.reverse, - legend.barheight = legend.barheight, - legend.barwidth = legend.barwidth, - legend.nbin = legend.nbin, - legend.italic = legend.italic, - sankey.node_width = sankey.node_width, - sankey.node_whitespace = sankey.node_whitespace, - sankey.alpha = sankey.alpha, - sankey.remove_axes = sankey.remove_axes, - zoom = zoom, - sep = sep, - print = print, - text_factor = text_factor, - font = font, - theme = theme, - background = background, - markdown = markdown, - `_misses.x` = FALSE, - `_misses.y` = FALSE, - `_misses.category` = missing(category), - `_misses.facet` = missing(facet), - `_misses.datalabels` = missing(datalabels), - `_misses.colour_fill` = missing(colour_fill), - `_misses.x.title` = missing(x.title), - `_misses.y.title` = missing(y.title), - `_misses.title` = missing(title), - `_misses.subtitle` = missing(subtitle), - `_misses.tag` = missing(tag), - `_misses.caption` = missing(caption), - `_misses.y.percent` = missing(y.percent), - `_misses.y.percent_break` = missing(y.percent_break), - `_misses.x.zoom` = missing(x.zoom), - `_misses.x.max_items` = missing(x.max_items), - `_misses.facet.fixed_x` = missing(facet.fixed_x), - `_label.x` = deparse(substitute(x)), - `_label.y` = deparse(substitute(y)), - `_label.category` = deparse(substitute(category)), - `_label.facet` = deparse(substitute(facet)), - `_summarise_fn_name` = deparse(substitute(summarise_function)), - `_misses.summarise_function` = missing(summarise_function), - `_sf.column` = attributes(.data)$sf_column, - `_datalabels.centroid` = datalabels.centroid, - ...) -} - -#' @rdname plot2-methods -#' @importFrom dplyr is_grouped_df ungroup -#' @export -plot2.data.frame <- function(.data, - x = NULL, - y = NULL, - category = NULL, - facet = NULL, - type = NULL, - x.title = TRUE, - y.title = TRUE, - category.title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - tag = NULL, - title.linelength = 60, - title.colour = getOption("plot2.colour_font_primary", "black"), - subtitle.linelength = 60, - subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), - na.replace = "", - na.rm = FALSE, - facet.position = "top", - facet.fill = NULL, - facet.bold = TRUE, - facet.italic = FALSE, - facet.size = 10, - facet.margin = 8, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = TRUE, - facet.fixed_y = NULL, - facet.fixed_x = TRUE, - facet.drop = FALSE, - facet.nrow = NULL, - facet.relative = FALSE, - x.date_breaks = NULL, - x.date_labels = NULL, - x.date_remove_years = NULL, - category.focus = NULL, - colour = getOption("plot2.colour", "ggplot2"), - colour_fill = NULL, - colour_opacity = 0, - x.lbl_angle = 0, - x.lbl_align = NULL, - x.lbl_italic = FALSE, - x.lbl_taxonomy = FALSE, - x.remove = FALSE, - x.position = "bottom", - x.max_items = Inf, - x.max_txt = "(rest, x%n)", - category.max_items = Inf, - category.max_txt = "(rest, x%n)", - facet.max_items = Inf, - facet.max_txt = "(rest, x%n)", - x.breaks = NULL, - x.n_breaks = NULL, - x.transform = "identity", - x.expand = NULL, - x.limits = NULL, - x.labels = NULL, - x.character = NULL, - x.drop = FALSE, - x.mic = FALSE, - x.zoom = FALSE, - y.remove = FALSE, - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - y.breaks = NULL, - y.n_breaks = NULL, - y.limits = NULL, - y.labels = NULL, - y.expand = NULL, - y.transform = "identity", - y.position = "left", - y.zoom = FALSE, - y_secondary = NULL, - y_secondary.type = type, - y_secondary.title = TRUE, - y_secondary.colour = "certeroze", - y_secondary.colour_fill = "certeroze6", - y_secondary.scientific = NULL, - y_secondary.percent = FALSE, - y_secondary.labels = NULL, - category.labels = NULL, - category.percent = FALSE, - category.breaks = NULL, - category.limits = NULL, - category.expand = 0, - category.midpoint = NULL, - category.transform = "identity", - category.date_breaks = NULL, - category.date_labels = NULL, - category.character = NULL, - x.sort = NULL, - category.sort = TRUE, - facet.sort = TRUE, - x.complete = NULL, - category.complete = NULL, - facet.complete = NULL, - datalabels = TRUE, - datalabels.round = ifelse(y.percent, 2, 1), - datalabels.format = "%n", - datalabels.colour = "grey25", - datalabels.colour_fill = NULL, - datalabels.size = (3 * text_factor), - datalabels.angle = 0, - datalabels.lineheight = 1.0, - decimal.mark = dec_mark(), - big.mark = big_mark(), - summarise_function = base::sum, - stacked = FALSE, - stackedpercent = FALSE, - horizontal = FALSE, - reverse = horizontal, - smooth = NULL, - smooth.method = NULL, - smooth.formula = NULL, - smooth.se = TRUE, - smooth.level = 0.95, - smooth.alpha = 0.25, - smooth.linewidth = 0.75, - smooth.linetype = 3, - smooth.colour = NULL, - size = NULL, - linetype = 1, - linewidth = NULL, - binwidth = NULL, - width = NULL, - jitter_seed = NA, - violin_scale = "count", - legend.position = NULL, - legend.title = NULL, # TRUE in numeric categories - legend.reverse = FALSE, - legend.barheight = 6, - legend.barwidth = 1.5, - legend.nbin = 300, - legend.italic = FALSE, - sankey.node_width = 0.15, - sankey.node_whitespace = 0.03, - sankey.alpha = 0.5, - sankey.remove_axes = NULL, - zoom = FALSE, - sep = " / ", - print = FALSE, - text_factor = 1, - font = getOption("plot2.font"), - theme = getOption("plot2.theme", "theme_minimal2"), - background = getOption("plot2.colour_background", "white"), - markdown = TRUE, - ...) { - - if (isTRUE(is_grouped_df(.data))) { - .data <- ungroup(.data) - } - - plot2_exec(.data = .data, - x = {{ x }}, - y = {{ y }}, - category = {{ category }}, - facet = {{ facet }}, - type = type, - x.title = {{ x.title }}, - y.title = {{ y.title }}, - category.title = {{ category.title }}, - title = {{ title }}, - subtitle = {{ subtitle }}, - caption = {{ caption }}, - tag = {{ tag }}, - title.linelength = title.linelength, - title.colour = title.colour, - subtitle.linelength = subtitle.linelength, - subtitle.colour = subtitle.colour, - na.replace = na.replace, - na.rm = na.rm, - facet.position = facet.position, - facet.fill = facet.fill, - facet.bold = facet.bold, - facet.italic = facet.italic, - facet.size = facet.size, - facet.margin = facet.margin, - facet.repeat_lbls_x = facet.repeat_lbls_x, - facet.repeat_lbls_y = facet.repeat_lbls_y, - facet.fixed_y = facet.fixed_y, - facet.fixed_x = facet.fixed_x, - facet.drop = facet.drop, - facet.nrow = facet.nrow, - facet.relative = facet.relative, - x.date_breaks = x.date_breaks, - x.date_labels = x.date_labels, - x.date_remove_years = x.date_remove_years, - category.focus = category.focus, - colour = colour, - colour_fill = colour_fill, - colour_opacity = colour_opacity, - x.lbl_angle = x.lbl_angle, - x.lbl_align = x.lbl_align, - x.lbl_italic = x.lbl_italic, - x.lbl_taxonomy = x.lbl_taxonomy, - x.remove = x.remove, - x.position = x.position, - x.max_items = x.max_items, - x.max_txt = x.max_txt, - category.max_items = category.max_items, - category.max_txt = category.max_txt, - facet.max_items = facet.max_items, - facet.max_txt = facet.max_txt, - x.breaks = x.breaks, - x.n_breaks = x.n_breaks, - x.transform = x.transform, - x.expand = x.expand, - x.limits = x.limits, - x.labels = x.labels, - x.character = x.character, - x.drop = x.drop, - x.mic = x.mic, - x.zoom = x.zoom, - y.remove = y.remove, - y.24h = y.24h, - y.age = y.age, - y.scientific = y.scientific, - y.percent = y.percent, - y.percent_break = y.percent_break, - y.breaks = y.breaks, - y.n_breaks = y.n_breaks, - y.limits = y.limits, - y.labels = y.labels, - y.expand = y.expand, - y.transform = y.transform, - y.position = y.position, - y.zoom = y.zoom, - y_secondary = {{ y_secondary }}, - y_secondary.type = y_secondary.type, - y_secondary.title = {{ y_secondary.title }}, - y_secondary.colour = y_secondary.colour, - y_secondary.colour_fill = y_secondary.colour_fill, - y_secondary.scientific = y_secondary.scientific, - y_secondary.percent = y_secondary.percent, - y_secondary.labels = y_secondary.labels, - category.labels = category.labels, - category.percent = category.percent, - category.breaks = category.breaks, - category.limits = category.limits, - category.expand = category.expand, - category.midpoint = category.midpoint, - category.transform = category.transform, - category.date_breaks = category.date_breaks, - category.date_labels = category.date_labels, - category.character = category.character, - x.sort = x.sort, - category.sort = category.sort, - facet.sort = facet.sort, - x.complete = x.complete, - category.complete = category.complete, - facet.complete = facet.complete, - datalabels = {{ datalabels }}, - datalabels.round = datalabels.round, - datalabels.colour = datalabels.colour, - datalabels.format = datalabels.format, - datalabels.colour_fill = datalabels.colour_fill, - datalabels.size = datalabels.size, - datalabels.angle = datalabels.angle, - datalabels.lineheight = datalabels.lineheight, - decimal.mark = decimal.mark, - big.mark = big.mark, - summarise_function = summarise_function, - stacked = stacked, - stackedpercent = stackedpercent, - horizontal = horizontal, - reverse = reverse, - smooth = smooth, - smooth.method = smooth.method, - smooth.formula = smooth.formula, - smooth.se = smooth.se, - smooth.level = smooth.level, - smooth.alpha = smooth.alpha, - smooth.linewidth = smooth.linewidth, - smooth.linetype = smooth.linetype, - smooth.colour = smooth.colour, - size = size, - linetype = linetype, - linewidth = linewidth, - binwidth = binwidth, - width = width, - jitter_seed = jitter_seed, - violin_scale = violin_scale, - legend.position = legend.position, - legend.title = {{ legend.title }}, - legend.reverse = legend.reverse, - legend.barheight = legend.barheight, - legend.barwidth = legend.barwidth, - legend.nbin = legend.nbin, - legend.italic = legend.italic, - sankey.node_width = sankey.node_width, - sankey.node_whitespace = sankey.node_whitespace, - sankey.alpha = sankey.alpha, - sankey.remove_axes = sankey.remove_axes, - zoom = zoom, - sep = sep, - print = print, - text_factor = text_factor, - font = font, - theme = theme, - background = background, - markdown = markdown, - `_misses.x` = missing(x), - `_misses.y` = missing(y), - `_misses.category` = missing(category), - `_misses.facet` = missing(facet), - `_misses.datalabels` = missing(datalabels), - `_misses.colour_fill` = missing(colour_fill), - `_misses.x.title` = missing(x.title), - `_misses.y.title` = missing(y.title), - `_misses.title` = missing(title), - `_misses.subtitle` = missing(subtitle), - `_misses.tag` = missing(tag), - `_misses.caption` = missing(caption), - `_misses.y.percent` = missing(y.percent), - `_misses.y.percent_break` = missing(y.percent_break), - `_misses.x.zoom` = missing(x.zoom), - `_misses.x.max_items` = missing(x.max_items), - `_misses.facet.fixed_x` = missing(facet.fixed_x), - `_label.x` = deparse(substitute(x)), - `_label.y` = deparse(substitute(y)), - `_label.category` = deparse(substitute(category)), - `_label.facet` = deparse(substitute(facet)), - `_label.y_secondary` = deparse(substitute(y_secondary)), - `_label.y_secondary` = deparse(substitute(y_secondary)), - `_summarise_fn_name` = deparse(substitute(summarise_function)), - `_misses.summarise_function` = missing(summarise_function), - ...) -} - -#' @rdname plot2-methods -#' @importFrom tidyr pivot_longer -#' @importFrom tibble rownames_to_column -#' @importFrom dplyr rename -#' @export -plot2.matrix <- function(.data, - x = NULL, - y = NULL, - category = NULL, - facet = NULL, - type = NULL, - x.title = FALSE, - y.title = FALSE, - category.title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - tag = NULL, - title.linelength = 60, - title.colour = getOption("plot2.colour_font_primary", "black"), - subtitle.linelength = 60, - subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), - na.replace = "", - na.rm = FALSE, - facet.position = "top", - facet.fill = NULL, - facet.bold = TRUE, - facet.italic = FALSE, - facet.size = 10, - facet.margin = 8, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = TRUE, - facet.fixed_y = NULL, - facet.fixed_x = TRUE, - facet.drop = FALSE, - facet.nrow = NULL, - facet.relative = FALSE, - x.date_breaks = NULL, - x.date_labels = NULL, - x.date_remove_years = NULL, - category.focus = NULL, - colour = getOption("plot2.colour", "ggplot2"), - colour_fill = NULL, - colour_opacity = 0, - x.lbl_angle = 0, - x.lbl_align = NULL, - x.lbl_italic = FALSE, - x.lbl_taxonomy = FALSE, - x.remove = FALSE, - x.position = "bottom", - x.max_items = Inf, - x.max_txt = "(rest, x%n)", - category.max_items = Inf, - category.max_txt = "(rest, x%n)", - facet.max_items = Inf, - facet.max_txt = "(rest, x%n)", - x.breaks = NULL, - x.n_breaks = NULL, - x.transform = "identity", - x.expand = NULL, - x.limits = NULL, - x.labels = NULL, - x.character = NULL, - x.drop = FALSE, - x.mic = FALSE, - x.zoom = FALSE, - y.remove = FALSE, - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - y.breaks = NULL, - y.n_breaks = NULL, - y.limits = NULL, - y.labels = NULL, - y.expand = NULL, - y.transform = "identity", - y.position = "left", - y.zoom = FALSE, - y_secondary = NULL, - y_secondary.type = type, - y_secondary.title = TRUE, - y_secondary.colour = "certeroze", - y_secondary.colour_fill = "certeroze6", - y_secondary.scientific = NULL, - y_secondary.percent = FALSE, - y_secondary.labels = NULL, - category.labels = NULL, - category.percent = FALSE, - category.breaks = NULL, - category.limits = NULL, - category.expand = 0, - category.midpoint = NULL, - category.transform = "identity", - category.date_breaks = NULL, - category.date_labels = NULL, - category.character = NULL, - x.sort = NULL, - category.sort = TRUE, - facet.sort = TRUE, - x.complete = NULL, - category.complete = NULL, - facet.complete = NULL, - datalabels = TRUE, - datalabels.round = ifelse(y.percent, 2, 1), - datalabels.format = "%n", - datalabels.colour = "grey25", - datalabels.colour_fill = NULL, - datalabels.size = (3 * text_factor), - datalabels.angle = 0, - datalabels.lineheight = 1.0, - decimal.mark = dec_mark(), - big.mark = big_mark(), - summarise_function = base::sum, - stacked = FALSE, - stackedpercent = FALSE, - horizontal = FALSE, - reverse = horizontal, - smooth = NULL, - smooth.method = NULL, - smooth.formula = NULL, - smooth.se = TRUE, - smooth.level = 0.95, - smooth.alpha = 0.25, - smooth.linewidth = 0.75, - smooth.linetype = 3, - smooth.colour = NULL, - size = NULL, - linetype = 1, - linewidth = NULL, - binwidth = NULL, - width = NULL, - jitter_seed = NA, - violin_scale = "count", - legend.position = NULL, - legend.title = NULL, # TRUE in numeric categories - legend.reverse = FALSE, - legend.barheight = 6, - legend.barwidth = 1.5, - legend.nbin = 300, - legend.italic = FALSE, - sankey.node_width = 0.15, - sankey.node_whitespace = 0.03, - sankey.alpha = 0.5, - sankey.remove_axes = NULL, - zoom = FALSE, - sep = " / ", - print = FALSE, - text_factor = 1, - font = getOption("plot2.font"), - theme = getOption("plot2.theme", "theme_minimal2"), - background = getOption("plot2.colour_background", "white"), - markdown = TRUE, - ...) { - - df <- .data |> - as.data.frame(stringsAsFactors = FALSE) - - if (is.null(type) && identical(rownames(df), colnames(df))) { - # rows and columns are identical, while the data are numeric - # this is the outcome of cor(), a correlation matrix - # assume type tile - plot2_message("Assuming ", font_blue("type = \"tile\""), - " since the matrix contains identical row and column names") - type <- "tile" - # make long format - df <- df |> - rownames_to_column(var = "rowname") |> - pivot_longer(-rowname, names_to = "y", values_to = "category") |> - rename(x = rowname) - } else if (!identical(rownames(df), as.character(seq_len(nrow(df))))) { - df <- df |> - rownames_to_column(var = "x") - } - - df |> - plot2_exec(x = x, - y = y, - category = category, - facet = NULL, - type = type, - x.title = {{ x.title }}, - y.title = {{ y.title }}, - category.title = {{ category.title }}, - title = {{ title }}, - subtitle = {{ subtitle }}, - caption = {{ caption }}, - tag = {{ tag }}, - title.linelength = title.linelength, - title.colour = title.colour, - subtitle.linelength = subtitle.linelength, - subtitle.colour = subtitle.colour, - na.replace = na.replace, - na.rm = na.rm, - facet.position = facet.position, - facet.fill = facet.fill, - facet.bold = facet.bold, - facet.italic = facet.italic, - facet.size = facet.size, - facet.margin = facet.margin, - facet.repeat_lbls_x = facet.repeat_lbls_x, - facet.repeat_lbls_y = facet.repeat_lbls_y, - facet.fixed_y = facet.fixed_y, - facet.fixed_x = facet.fixed_x, - facet.drop = facet.drop, - facet.nrow = facet.nrow, - facet.relative = facet.relative, - x.date_breaks = x.date_breaks, - x.date_labels = x.date_labels, - x.date_remove_years = x.date_remove_years, - category.focus = category.focus, - colour = colour, - colour_fill = colour_fill, - colour_opacity = colour_opacity, - x.lbl_angle = x.lbl_angle, - x.lbl_align = x.lbl_align, - x.lbl_italic = x.lbl_italic, - x.lbl_taxonomy = x.lbl_taxonomy, - x.remove = x.remove, - x.position = x.position, - x.max_items = x.max_items, - x.max_txt = x.max_txt, - category.max_items = category.max_items, - category.max_txt = category.max_txt, - facet.max_items = facet.max_items, - facet.max_txt = facet.max_txt, - x.breaks = x.breaks, - x.n_breaks = x.n_breaks, - x.transform = x.transform, - x.expand = x.expand, - x.limits = x.limits, - x.labels = x.labels, - x.character = x.character, - x.drop = x.drop, - x.mic = x.mic, - x.zoom = x.zoom, - y.remove = y.remove, - y.24h = y.24h, - y.age = y.age, - y.scientific = y.scientific, - y.percent = y.percent, - y.percent_break = y.percent_break, - y.breaks = y.breaks, - y.n_breaks = y.n_breaks, - y.limits = y.limits, - y.labels = y.labels, - y.expand = y.expand, - y.transform = y.transform, - y.position = y.position, - y.zoom = y.zoom, - y_secondary = {{ y_secondary }}, - y_secondary.type = y_secondary.type, - y_secondary.title = {{ y_secondary.title }}, - y_secondary.colour = y_secondary.colour, - y_secondary.colour_fill = y_secondary.colour_fill, - y_secondary.scientific = y_secondary.scientific, - y_secondary.percent = y_secondary.percent, - y_secondary.labels = y_secondary.labels, - category.labels = category.labels, - category.percent = category.percent, - category.breaks = category.breaks, - category.limits = category.limits, - category.expand = category.expand, - category.midpoint = category.midpoint, - category.transform = category.transform, - category.date_breaks = category.date_breaks, - category.date_labels = category.date_labels, - category.character = category.character, - x.sort = x.sort, - category.sort = category.sort, - facet.sort = facet.sort, - x.complete = x.complete, - category.complete = category.complete, - facet.complete = facet.complete, - datalabels = {{ datalabels }}, - datalabels.round = datalabels.round, - datalabels.colour = datalabels.colour, - datalabels.format = datalabels.format, - datalabels.colour_fill = datalabels.colour_fill, - datalabels.size = datalabels.size, - datalabels.angle = datalabels.angle, - datalabels.lineheight = datalabels.lineheight, - decimal.mark = decimal.mark, - big.mark = big.mark, - summarise_function = summarise_function, - stacked = stacked, - stackedpercent = stackedpercent, - horizontal = horizontal, - reverse = reverse, - smooth = smooth, - smooth.method = smooth.method, - smooth.formula = smooth.formula, - smooth.se = smooth.se, - smooth.level = smooth.level, - smooth.alpha = smooth.alpha, - smooth.linewidth = smooth.linewidth, - smooth.linetype = smooth.linetype, - smooth.colour = smooth.colour, - size = size, - linetype = linetype, - linewidth = linewidth, - binwidth = binwidth, - width = width, - jitter_seed = jitter_seed, - violin_scale = violin_scale, - legend.position = legend.position, - legend.title = {{ legend.title }}, - legend.reverse = legend.reverse, - legend.barheight = legend.barheight, - legend.barwidth = legend.barwidth, - legend.nbin = legend.nbin, - legend.italic = legend.italic, - sankey.node_width = sankey.node_width, - sankey.node_whitespace = sankey.node_whitespace, - sankey.alpha = sankey.alpha, - sankey.remove_axes = sankey.remove_axes, - zoom = zoom, - sep = sep, - print = print, - text_factor = text_factor, - font = font, - theme = theme, - background = background, - markdown = markdown, - `_misses.x` = missing(x), - `_misses.y` = missing(y), - `_misses.category` = missing(category), - `_misses.facet` = missing(facet), - `_misses.datalabels` = missing(datalabels), - `_misses.colour_fill` = missing(colour_fill), - `_misses.x.title` = missing(x.title), - `_misses.y.title` = missing(y.title), - `_misses.title` = missing(title), - `_misses.subtitle` = missing(subtitle), - `_misses.tag` = missing(tag), - `_misses.caption` = missing(caption), - `_misses.y.percent` = missing(y.percent), - `_misses.y.percent_break` = missing(y.percent_break), - `_misses.x.zoom` = missing(x.zoom), - `_misses.x.max_items` = missing(x.max_items), - `_misses.facet.fixed_x` = missing(facet.fixed_x), - `_label.x` = deparse(substitute(x)), - `_label.y` = deparse(substitute(y)), - `_label.category` = deparse(substitute(category)), - `_label.facet` = deparse(substitute(facet)), - `_label.y_secondary` = deparse(substitute(y_secondary)), - `_label.y_secondary` = deparse(substitute(y_secondary)), - `_summarise_fn_name` = deparse(substitute(summarise_function)), - `_misses.summarise_function` = missing(summarise_function), - ...) -} - -#' @rdname plot2-methods -#' @importFrom dplyr filter mutate select -#' @importFrom tidyr pivot_longer -#' @details For antimicrobial resistance (AMR) data analysis, use the [`bug_drug_combinations()`][AMR::bug_drug_combinations()] or the [`sir_df()`][AMR::sir_df()] function from the `AMR` package on a data set with antibiograms. The result can be used as input for [plot2()]. -#' @param minimum minimum number of results, defaults to `30` -#' @param remove_intrinsic_resistant a [logical] to indicate that rows with 100% resistance must be removed from the data set before plotting -#' @param language language to be used for antibiotic names -#' @export -plot2.bug_drug_combinations <- function(.data, - x = ab, - y = value, - category = name, - facet = mo, - type = "column", - x.title = FALSE, - y.title = FALSE, - category.title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - tag = NULL, - title.linelength = 60, - title.colour = getOption("plot2.colour_font_primary", "black"), - subtitle.linelength = 60, - subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), - na.replace = "", - na.rm = FALSE, - facet.position = "top", - facet.fill = NULL, - facet.bold = TRUE, - facet.italic = FALSE, - facet.size = 10, - facet.margin = 8, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = TRUE, - facet.fixed_y = NULL, - facet.fixed_x = TRUE, - facet.drop = FALSE, - facet.nrow = NULL, - facet.relative = FALSE, - x.date_breaks = NULL, - x.date_labels = NULL, - x.date_remove_years = NULL, - category.focus = NULL, - colour = "certe_sir2", - colour_fill = NULL, - colour_opacity = 0, - x.lbl_angle = ifelse(horizontal, 0, 90), - x.lbl_align = NULL, - x.lbl_italic = FALSE, - x.lbl_taxonomy = TRUE, - x.remove = FALSE, - x.position = "bottom", - x.max_items = Inf, - x.max_txt = "(rest, x%n)", - category.max_items = Inf, - category.max_txt = "(rest, x%n)", - facet.max_items = Inf, - facet.max_txt = "(rest, x%n)", - x.breaks = NULL, - x.n_breaks = NULL, - x.transform = "identity", - x.expand = NULL, - x.limits = NULL, - x.labels = NULL, - x.character = NULL, - x.drop = FALSE, - x.mic = FALSE, - x.zoom = FALSE, - y.remove = FALSE, - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - y.breaks = NULL, - y.n_breaks = NULL, - y.limits = NULL, - y.labels = NULL, - y.expand = NULL, - y.transform = "identity", - y.position = "left", - y.zoom = FALSE, - y_secondary = NULL, - y_secondary.type = type, - y_secondary.title = TRUE, - y_secondary.colour = "certeroze", - y_secondary.colour_fill = "certeroze6", - y_secondary.scientific = NULL, - y_secondary.percent = FALSE, - y_secondary.labels = NULL, - category.labels = NULL, - category.percent = FALSE, - category.breaks = NULL, - category.limits = NULL, - category.expand = 0, - category.midpoint = NULL, - category.transform = "identity", - category.date_breaks = NULL, - category.date_labels = NULL, - category.character = NULL, - x.sort = NULL, - category.sort = FALSE, - facet.sort = TRUE, - x.complete = NULL, - category.complete = NULL, - facet.complete = NULL, - datalabels = TRUE, - datalabels.round = ifelse(y.percent, 2, 1), - datalabels.format = "%n", - datalabels.colour = "grey25", - datalabels.colour_fill = NULL, - datalabels.size = (3 * text_factor), - datalabels.angle = 0, - datalabels.lineheight = 1.0, - decimal.mark = dec_mark(), - big.mark = big_mark(), - summarise_function = base::sum, - stacked = FALSE, - stackedpercent = TRUE, - horizontal = TRUE, - reverse = TRUE, - smooth = NULL, - smooth.method = NULL, - smooth.formula = NULL, - smooth.se = TRUE, - smooth.level = 0.95, - smooth.alpha = 0.25, - smooth.linewidth = 0.75, - smooth.linetype = 3, - smooth.colour = NULL, - size = NULL, - linetype = 1, - linewidth = NULL, - binwidth = NULL, - width = NULL, - jitter_seed = NA, - violin_scale = "count", - legend.position = NULL, - legend.title = NULL, # TRUE in numeric categories - legend.reverse = FALSE, - legend.barheight = 6, - legend.barwidth = 1.5, - legend.nbin = 300, - legend.italic = FALSE, - sankey.node_width = 0.15, - sankey.node_whitespace = 0.03, - sankey.alpha = 0.5, - sankey.remove_axes = NULL, - zoom = FALSE, - sep = " / ", - print = FALSE, - text_factor = 1, - font = getOption("plot2.font"), - theme = getOption("plot2.theme", "theme_minimal2"), - background = getOption("plot2.colour_background", "white"), - markdown = TRUE, - minimum = 30, - remove_intrinsic_resistant = TRUE, - language = "nl", - ...) { - - ab_name <- getExportedValue(name = "ab_name", ns = asNamespace("AMR")) - - df <- .data - if (isTRUE(remove_intrinsic_resistant)) { - df <- df |> - filter(total != R) - } - df <- df |> - filter(total >= minimum) |> - select(-total) |> - mutate(ab = ab_name(ab, language = language)) |> - pivot_longer(-c(mo, ab)) - df$name <- factor(df$name, levels = c("S", "I", "R"), ordered = TRUE) - - plot2_exec(.data = df, - x = {{ x }}, - y = {{ y }}, - category = {{ category }}, - facet = {{ facet }}, - type = type, - x.title = {{ x.title }}, - y.title = {{ y.title }}, - category.title = {{ category.title }}, - title = {{ title }}, - subtitle = {{ subtitle }}, - caption = {{ caption }}, - tag = {{ tag }}, - title.linelength = title.linelength, - title.colour = title.colour, - subtitle.linelength = subtitle.linelength, - subtitle.colour = subtitle.colour, - na.replace = na.replace, - na.rm = na.rm, - facet.position = facet.position, - facet.fill = facet.fill, - facet.bold = facet.bold, - facet.italic = facet.italic, - facet.size = facet.size, - facet.margin = facet.margin, - facet.repeat_lbls_x = facet.repeat_lbls_x, - facet.repeat_lbls_y = facet.repeat_lbls_y, - facet.fixed_y = facet.fixed_y, - facet.fixed_x = facet.fixed_x, - facet.drop = facet.drop, - facet.nrow = facet.nrow, - facet.relative = facet.relative, - x.date_breaks = x.date_breaks, - x.date_labels = x.date_labels, - x.date_remove_years = x.date_remove_years, - category.focus = category.focus, - colour = colour, - colour_fill = colour_fill, - colour_opacity = colour_opacity, - x.lbl_angle = x.lbl_angle, - x.lbl_align = x.lbl_align, - x.lbl_italic = x.lbl_italic, - x.lbl_taxonomy = x.lbl_taxonomy, - x.remove = x.remove, - x.position = x.position, - x.max_items = x.max_items, - x.max_txt = x.max_txt, - category.max_items = category.max_items, - category.max_txt = category.max_txt, - facet.max_items = facet.max_items, - facet.max_txt = facet.max_txt, - x.breaks = x.breaks, - x.n_breaks = x.n_breaks, - x.transform = x.transform, - x.expand = x.expand, - x.limits = x.limits, - x.labels = x.labels, - x.character = x.character, - x.drop = x.drop, - x.mic = x.mic, - x.zoom = x.zoom, - y.remove = y.remove, - y.24h = y.24h, - y.age = y.age, - y.scientific = y.scientific, - y.percent = y.percent, - y.percent_break = y.percent_break, - y.breaks = y.breaks, - y.n_breaks = y.n_breaks, - y.limits = y.limits, - y.labels = y.labels, - y.expand = y.expand, - y.transform = y.transform, - y.position = y.position, - y.zoom = y.zoom, - y_secondary = {{ y_secondary }}, - y_secondary.type = y_secondary.type, - y_secondary.title = {{ y_secondary.title }}, - y_secondary.colour = y_secondary.colour, - y_secondary.colour_fill = y_secondary.colour_fill, - y_secondary.scientific = y_secondary.scientific, - y_secondary.percent = y_secondary.percent, - y_secondary.labels = y_secondary.labels, - category.labels = category.labels, - category.percent = category.percent, - category.breaks = category.breaks, - category.limits = category.limits, - category.expand = category.expand, - category.midpoint = category.midpoint, - category.transform = category.transform, - category.date_breaks = category.date_breaks, - category.date_labels = category.date_labels, - category.character = category.character, - x.sort = x.sort, - category.sort = category.sort, - facet.sort = facet.sort, - x.complete = x.complete, - category.complete = category.complete, - facet.complete = facet.complete, - datalabels = {{ datalabels }}, - datalabels.round = datalabels.round, - datalabels.colour = datalabels.colour, - datalabels.format = datalabels.format, - datalabels.colour_fill = datalabels.colour_fill, - datalabels.size = datalabels.size, - datalabels.angle = datalabels.angle, - datalabels.lineheight = datalabels.lineheight, - decimal.mark = decimal.mark, - big.mark = big.mark, - summarise_function = summarise_function, - stacked = stacked, - stackedpercent = stackedpercent, - horizontal = horizontal, - reverse = reverse, - smooth = smooth, - smooth.method = smooth.method, - smooth.formula = smooth.formula, - smooth.se = smooth.se, - smooth.level = smooth.level, - smooth.alpha = smooth.alpha, - smooth.linewidth = smooth.linewidth, - smooth.linetype = smooth.linetype, - smooth.colour = smooth.colour, - size = size, - linetype = linetype, - linewidth = linewidth, - binwidth = binwidth, - width = width, - jitter_seed = jitter_seed, - violin_scale = violin_scale, - legend.position = legend.position, - legend.title = {{ legend.title }}, - legend.reverse = legend.reverse, - legend.barheight = legend.barheight, - legend.barwidth = legend.barwidth, - legend.nbin = legend.nbin, - legend.italic = legend.italic, - sankey.node_width = sankey.node_width, - sankey.node_whitespace = sankey.node_whitespace, - sankey.alpha = sankey.alpha, - sankey.remove_axes = sankey.remove_axes, - zoom = zoom, - sep = sep, - print = print, - text_factor = text_factor, - font = font, - theme = theme, - background = background, - markdown = markdown, - `_misses.x` = missing(x), - `_misses.y` = missing(y), - `_misses.category` = missing(category), - `_misses.facet` = missing(facet), - `_misses.datalabels` = missing(datalabels), - `_misses.colour_fill` = missing(colour_fill), - `_misses.x.title` = FALSE, - `_misses.y.title` = FALSE, - `_misses.title` = missing(title), - `_misses.subtitle` = missing(subtitle), - `_misses.tag` = missing(tag), - `_misses.caption` = missing(caption), - `_misses.y.percent` = missing(y.percent), - `_misses.y.percent_break` = missing(y.percent_break), - `_misses.x.zoom` = missing(x.zoom), - `_misses.x.max_items` = missing(x.max_items), - `_misses.facet.fixed_x` = missing(facet.fixed_x), - `_label.x` = deparse(substitute(x)), - `_label.y` = deparse(substitute(y)), - `_label.category` = deparse(substitute(category)), - `_label.facet` = deparse(substitute(facet)), - `_label.y_secondary` = deparse(substitute(y_secondary)), - `_summarise_fn_name` = deparse(substitute(summarise_function)), - `_misses.summarise_function` = missing(summarise_function), - ...) -} - -#' @rdname plot2-methods -#' @importFrom ggplot2 aes facet_wrap geom_col ggplot labs position_dodge2 -#' @importFrom dplyr mutate -#' @importFrom certestyle colourpicker dec_mark big_mark -#' @export -#' @examples -#' -#' # AMR DATA ANALYSIS ---------------------------------------------------- -#' if (require("AMR")) { -#' example_isolates[, c("mo", "AMX", "AMC", "ward")] |> -#' antibiogram(mo_transform = "gramstain", -#' language = "nl") |> -#' plot2() -#' } -#' -#' if (require("AMR")) { -#' example_isolates[, c("mo", "AMX", "AMC", "ward")] |> -#' antibiogram(mo_transform = "gramstain", -#' language = "nl", -#' syndromic_group = "ward") |> -#' plot2() -#' } -plot2.antibiogram <- function(.data, - x = NULL, - y = NULL, - category = NULL, - facet = NULL, - type = NULL, - x.title = NULL, - y.title = NULL, - category.title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - tag = NULL, - title.linelength = 60, - title.colour = getOption("plot2.colour_font_primary", "black"), - subtitle.linelength = 60, - subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), - na.replace = "", - na.rm = FALSE, - facet.position = "top", - facet.fill = NULL, - facet.bold = TRUE, - facet.italic = FALSE, - facet.size = 10, - facet.margin = 8, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = TRUE, - facet.fixed_y = NULL, - facet.fixed_x = TRUE, - facet.drop = FALSE, - facet.nrow = NULL, - facet.relative = FALSE, - x.date_breaks = NULL, - x.date_labels = NULL, - x.date_remove_years = NULL, - category.focus = NULL, - colour = getOption("plot2.colour", "ggplot2"), - colour_fill = NULL, - colour_opacity = 0, - x.lbl_angle = 0, - x.lbl_align = NULL, - x.lbl_italic = FALSE, - x.lbl_taxonomy = FALSE, - x.remove = FALSE, - x.position = "bottom", - x.max_items = Inf, - x.max_txt = "(rest, x%n)", - category.max_items = Inf, - category.max_txt = "(rest, x%n)", - facet.max_items = Inf, - facet.max_txt = "(rest, x%n)", - x.breaks = NULL, - x.n_breaks = NULL, - x.transform = "identity", - x.expand = NULL, - x.limits = NULL, - x.labels = NULL, - x.character = NULL, - x.drop = FALSE, - x.mic = FALSE, - x.zoom = FALSE, - y.remove = FALSE, - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - y.breaks = NULL, - y.n_breaks = NULL, - y.limits = NULL, - y.labels = NULL, - y.expand = NULL, - y.transform = "identity", - y.position = "left", - y.zoom = FALSE, - y_secondary = NULL, - y_secondary.type = type, - y_secondary.title = TRUE, - y_secondary.colour = "certeroze", - y_secondary.colour_fill = "certeroze6", - y_secondary.scientific = NULL, - y_secondary.percent = FALSE, - y_secondary.labels = NULL, - category.labels = NULL, - category.percent = FALSE, - category.breaks = NULL, - category.limits = NULL, - category.expand = 0, - category.midpoint = NULL, - category.transform = "identity", - category.date_breaks = NULL, - category.date_labels = NULL, - category.character = NULL, - x.sort = NULL, - category.sort = TRUE, - facet.sort = TRUE, - x.complete = NULL, - category.complete = NULL, - facet.complete = NULL, - datalabels = TRUE, - datalabels.round = ifelse(y.percent, 2, 1), - datalabels.format = "%n", - datalabels.colour = "grey25", - datalabels.colour_fill = NULL, - datalabels.size = (3 * text_factor), - datalabels.angle = 0, - datalabels.lineheight = 1.0, - decimal.mark = dec_mark(), - big.mark = big_mark(), - summarise_function = base::sum, - stacked = FALSE, - stackedpercent = FALSE, - horizontal = FALSE, - reverse = horizontal, - smooth = NULL, - smooth.method = NULL, - smooth.formula = NULL, - smooth.se = TRUE, - smooth.level = 0.95, - smooth.alpha = 0.25, - smooth.linewidth = 0.75, - smooth.linetype = 3, - smooth.colour = NULL, - size = NULL, - linetype = 1, - linewidth = NULL, - binwidth = NULL, - width = NULL, - jitter_seed = NA, - violin_scale = "count", - legend.position = NULL, - legend.title = NULL, # will become TRUE in numeric categories if left NULL - legend.reverse = FALSE, - legend.barheight = 6, - legend.barwidth = 1.5, - legend.nbin = 300, - legend.italic = FALSE, - sankey.node_width = 0.15, - sankey.node_whitespace = 0.03, - sankey.alpha = 0.5, - sankey.remove_axes = NULL, - zoom = FALSE, - sep = " / ", - print = FALSE, - text_factor = 1, - font = getOption("plot2.font"), - theme = getOption("plot2.theme", "theme_minimal2"), - background = getOption("plot2.colour_background", "white"), - markdown = TRUE, - ...) { - - df <- attributes(.data)$long - - if ("syndromic_group" %in% colnames(df)) { - geom <- geom_col( - aes( - x = ab, - y = SI * 100, - fill = if ("syndromic_group" %in% colnames(df)) { - syndromic_group - } else { - NULL - } - ), - position = position_dodge2(preserve = "single")) - } else { - geom <- geom_col( - aes( - x = ab, - y = SI * 100, - ), - fill = colourpicker(colour, length = 1), - position = position_dodge2(preserve = "single")) - } - - p <- ggplot(df) + - geom + - facet_wrap("mo") + - labs( - y = ifelse(isTRUE(attributes(.data)$combine_SI), "%SI", "%S"), - x = NULL, - fill = if ("syndromic_group" %in% colnames(df)) { - colnames(.data)[1] - } else { - NULL - } - ) - - theme <- validate_theme(theme = theme, - type = "geom_col", - background = background, - text_factor = text_factor, - font = font, - horizontal = FALSE, - x.remove = NULL, - y.remove = NULL, - x.lbl_angle = 0, - x.lbl_align = NULL, - x.lbl_italic = NULL, - facet.fill = NULL, - facet.bold = NULL, - facet.italic = NULL, - facet.size = 10, - facet.margin = 8, - legend.italic = NULL, - sankey.remove_axes = FALSE, - title.colour = title.colour, - subtitle.colour = subtitle.colour, - has_y_secondary = NULL, - has_category = NULL, - col_y_primary = NULL, - col_y_secondary = NULL) - - y_scale <- validate_y_scale(df = p$data |> mutate(`_var_y` = SI), - type = "geom_col", - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.breaks = NULL, - y.n_breaks = NULL, - y.expand = NULL, - y.labels = NULL, - y.limits = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - misses_y.percent_break = TRUE, - y.position = "left", - y.transform = "identity", - y.zoom = FALSE, - stacked = FALSE, - stackedpercent = FALSE, - facet.fixed_y = FALSE, - decimal.mark = dec_mark(), - big.mark = big_mark(), - add_y_secondary = FALSE) - - p <- p + - theme + - scale_fill_certe_d(colour = colour) + - y_scale - - if (!missing(x.title)) p <- p + labs(x = validate_title(x.title, markdown = markdown)) - if (!missing(y.title)) p <- p + labs(y = validate_title(y.title, markdown = markdown)) - if (!missing(title)) p <- p + labs(title = validate_title(title, markdown = markdown, max_length = title.linelength)) - if (!missing(subtitle)) p <- p + labs(subtitle = validate_title(subtitle, markdown = markdown, max_length = subtitle.linelength)) - if (!missing(tag)) p <- p + labs(tag = validate_title(tag, markdown = markdown)) - if (!missing(caption)) p <- p + labs(caption = validate_title(caption, markdown = markdown)) - - if (isTRUE(print)) { - print(p) - } else { - p - } -} - -#' @rdname plot2-methods -#' @export -plot2.sir_df <- function(.data, - x = NULL, - y = isolates, - category = interpretation, - facet = antibiotic, - type = "column", - x.title = TRUE, - y.title = FALSE, - category.title = NULL, - title = FALSE, - subtitle = NULL, - caption = NULL, - tag = NULL, - title.linelength = 60, - title.colour = getOption("plot2.colour_font_primary", "black"), - subtitle.linelength = 60, - subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), - na.replace = "", - na.rm = FALSE, - facet.position = "top", - facet.fill = NULL, - facet.bold = TRUE, - facet.italic = FALSE, - facet.size = 10, - facet.margin = 8, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = TRUE, - facet.fixed_y = NULL, - facet.fixed_x = TRUE, - facet.drop = FALSE, - facet.nrow = NULL, - facet.relative = FALSE, - x.date_breaks = NULL, - x.date_labels = NULL, - x.date_remove_years = NULL, - category.focus = NULL, - colour = "certe_sir2", - colour_fill = NULL, - colour_opacity = 0, - x.lbl_angle = 0, - x.lbl_align = NULL, - x.lbl_italic = FALSE, - x.lbl_taxonomy = TRUE, - x.remove = FALSE, - x.position = "bottom", - x.max_items = Inf, - x.max_txt = "(rest, x%n)", - category.max_items = Inf, - category.max_txt = "(rest, x%n)", - facet.max_items = Inf, - facet.max_txt = "(rest, x%n)", - x.breaks = NULL, - x.n_breaks = NULL, - x.transform = "identity", - x.expand = NULL, - x.limits = NULL, - x.labels = NULL, - x.character = NULL, - x.drop = FALSE, - x.mic = FALSE, - x.zoom = FALSE, - y.remove = FALSE, - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - y.breaks = NULL, - y.n_breaks = NULL, - y.limits = NULL, - y.labels = NULL, - y.expand = NULL, - y.transform = "identity", - y.position = "left", - y.zoom = FALSE, - y_secondary = NULL, - y_secondary.type = type, - y_secondary.title = TRUE, - y_secondary.colour = "certeroze", - y_secondary.colour_fill = "certeroze6", - y_secondary.scientific = NULL, - y_secondary.percent = FALSE, - y_secondary.labels = NULL, - category.labels = NULL, - category.percent = FALSE, - category.breaks = NULL, - category.limits = NULL, - category.expand = 0, - category.midpoint = NULL, - category.transform = "identity", - category.date_breaks = NULL, - category.date_labels = NULL, - category.character = NULL, - x.sort = NULL, - category.sort = FALSE, - facet.sort = TRUE, - x.complete = NULL, - category.complete = NULL, - facet.complete = NULL, - datalabels = TRUE, - datalabels.round = ifelse(y.percent, 2, 1), - datalabels.format = "%n", - datalabels.colour = "grey25", - datalabels.colour_fill = NULL, - datalabels.size = (3 * text_factor), - datalabels.angle = 0, - datalabels.lineheight = 1.0, - decimal.mark = dec_mark(), - big.mark = big_mark(), - summarise_function = base::sum, - stacked = FALSE, - stackedpercent = TRUE, - horizontal = FALSE, - reverse = TRUE, - smooth = NULL, - smooth.method = NULL, - smooth.formula = NULL, - smooth.se = TRUE, - smooth.level = 0.95, - smooth.alpha = 0.25, - smooth.linewidth = 0.75, - smooth.linetype = 3, - smooth.colour = NULL, - size = NULL, - linetype = 1, - linewidth = NULL, - binwidth = NULL, - width = NULL, - jitter_seed = NA, - violin_scale = "count", - legend.position = NULL, - legend.title = NULL, # TRUE in numeric categories - legend.reverse = FALSE, - legend.barheight = 6, - legend.barwidth = 1.5, - legend.nbin = 300, - legend.italic = FALSE, - sankey.node_width = 0.15, - sankey.node_whitespace = 0.03, - sankey.alpha = 0.5, - sankey.remove_axes = NULL, - zoom = FALSE, - sep = " / ", - print = FALSE, - text_factor = 1, - font = getOption("plot2.font"), - theme = getOption("plot2.theme", "theme_minimal2"), - background = getOption("plot2.colour_background", "white"), - markdown = TRUE, - ...) { - - if (!"isolates" %in% colnames(.data) && !is.integer(.data$value)) { - stop("isolate count not available, use AMR::sir_df() or AMR::count_df() before plotting", call. = FALSE) - } else if (is.integer(.data$value)) { - .data$isolates <- .data$value - } - - plot2_exec(.data = .data, - x = {{ x }}, - y = {{ y }}, - category = {{ category }}, - facet = {{ facet }}, - type = type, - x.title = {{ x.title }}, - y.title = {{ y.title }}, - category.title = {{ category.title }}, - title = {{ title }}, - subtitle = {{ subtitle }}, - caption = {{ caption }}, - tag = {{ tag }}, - title.linelength = title.linelength, - title.colour = title.colour, - subtitle.linelength = subtitle.linelength, - subtitle.colour = subtitle.colour, - na.replace = na.replace, - na.rm = na.rm, - facet.position = facet.position, - facet.fill = facet.fill, - facet.bold = facet.bold, - facet.italic = facet.italic, - facet.size = facet.size, - facet.margin = facet.margin, - facet.repeat_lbls_x = facet.repeat_lbls_x, - facet.repeat_lbls_y = facet.repeat_lbls_y, - facet.fixed_y = facet.fixed_y, - facet.fixed_x = facet.fixed_x, - facet.drop = facet.drop, - facet.nrow = facet.nrow, - facet.relative = facet.relative, - x.date_breaks = x.date_breaks, - x.date_labels = x.date_labels, - x.date_remove_years = x.date_remove_years, - category.focus = category.focus, - colour = colour, - colour_fill = colour_fill, - colour_opacity = colour_opacity, - x.lbl_angle = x.lbl_angle, - x.lbl_align = x.lbl_align, - x.lbl_italic = x.lbl_italic, - x.lbl_taxonomy = x.lbl_taxonomy, - x.remove = x.remove, - x.position = x.position, - x.max_items = x.max_items, - x.max_txt = x.max_txt, - category.max_items = category.max_items, - category.max_txt = category.max_txt, - facet.max_items = facet.max_items, - facet.max_txt = facet.max_txt, - x.breaks = x.breaks, - x.n_breaks = x.n_breaks, - x.transform = x.transform, - x.expand = x.expand, - x.limits = x.limits, - x.labels = x.labels, - x.character = x.character, - x.drop = x.drop, - x.mic = x.mic, - x.zoom = x.zoom, - y.remove = y.remove, - y.24h = y.24h, - y.age = y.age, - y.scientific = y.scientific, - y.percent = y.percent, - y.percent_break = y.percent_break, - y.breaks = y.breaks, - y.n_breaks = y.n_breaks, - y.limits = y.limits, - y.labels = y.labels, - y.expand = y.expand, - y.transform = y.transform, - y.position = y.position, - y.zoom = y.zoom, - y_secondary = {{ y_secondary }}, - y_secondary.type = y_secondary.type, - y_secondary.title = {{ y_secondary.title }}, - y_secondary.colour = y_secondary.colour, - y_secondary.colour_fill = y_secondary.colour_fill, - y_secondary.scientific = y_secondary.scientific, - y_secondary.percent = y_secondary.percent, - y_secondary.labels = y_secondary.labels, - category.labels = category.labels, - category.percent = category.percent, - category.breaks = category.breaks, - category.limits = category.limits, - category.expand = category.expand, - category.midpoint = category.midpoint, - category.transform = category.transform, - category.date_breaks = category.date_breaks, - category.date_labels = category.date_labels, - category.character = category.character, - x.sort = x.sort, - category.sort = category.sort, - facet.sort = facet.sort, - x.complete = x.complete, - category.complete = category.complete, - facet.complete = facet.complete, - datalabels = {{ datalabels }}, - datalabels.round = datalabels.round, - datalabels.colour = datalabels.colour, - datalabels.format = datalabels.format, - datalabels.colour_fill = datalabels.colour_fill, - datalabels.size = datalabels.size, - datalabels.angle = datalabels.angle, - datalabels.lineheight = datalabels.lineheight, - decimal.mark = decimal.mark, - big.mark = big.mark, - summarise_function = summarise_function, - stacked = stacked, - stackedpercent = stackedpercent, - horizontal = horizontal, - reverse = reverse, - smooth = smooth, - smooth.method = smooth.method, - smooth.formula = smooth.formula, - smooth.se = smooth.se, - smooth.level = smooth.level, - smooth.alpha = smooth.alpha, - smooth.linewidth = smooth.linewidth, - smooth.linetype = smooth.linetype, - smooth.colour = smooth.colour, - size = size, - linetype = linetype, - linewidth = linewidth, - binwidth = binwidth, - width = width, - jitter_seed = jitter_seed, - violin_scale = violin_scale, - legend.position = legend.position, - legend.title = {{ legend.title }}, - legend.reverse = legend.reverse, - legend.barheight = legend.barheight, - legend.barwidth = legend.barwidth, - legend.nbin = legend.nbin, - legend.italic = legend.italic, - sankey.node_width = sankey.node_width, - sankey.node_whitespace = sankey.node_whitespace, - sankey.alpha = sankey.alpha, - sankey.remove_axes = sankey.remove_axes, - zoom = zoom, - sep = sep, - print = print, - text_factor = text_factor, - font = font, - theme = theme, - background = background, - markdown = markdown, - `_misses.x` = missing(x), - `_misses.y` = missing(y), - `_misses.category` = missing(category), - `_misses.facet` = missing(facet), - `_misses.datalabels` = missing(datalabels), - `_misses.colour_fill` = missing(colour_fill), - `_misses.x.title` = FALSE, - `_misses.y.title` = FALSE, - `_misses.title` = missing(title) && !isFALSE(title), - `_misses.subtitle` = missing(subtitle), - `_misses.tag` = missing(tag), - `_misses.caption` = missing(caption), - `_misses.y.percent` = missing(y.percent), - `_misses.y.percent_break` = missing(y.percent_break), - `_misses.x.zoom` = missing(x.zoom), - `_misses.x.max_items` = missing(x.max_items), - `_misses.facet.fixed_x` = missing(facet.fixed_x), - `_label.x` = deparse(substitute(x)), - `_label.y` = deparse(substitute(y)), - `_label.category` = deparse(substitute(category)), - `_label.facet` = deparse(substitute(facet)), - `_label.y_secondary` = deparse(substitute(y_secondary)), - `_summarise_fn_name` = deparse(substitute(summarise_function)), - `_misses.summarise_function` = missing(summarise_function), - ...) -} - -#' @rdname plot2-methods -#' @importFrom ggplot2 geom_hline geom_point geom_line element_text -#' @importFrom certestyle colourpicker -#' @details The QC-test can be acquired with [certestats::qc_test()]. It applies the Nelson QC rules for a vector of values. -#' @export -plot2.qc_test <- function(.data, - x = x, - y = y, - category = rule, - facet = NULL, - type = "point", - x.title = "Index", - y.title = "Value", - category.title = NULL, - title = paste0("QC Chart (", attributes(.data)$guideline, ")"), - subtitle = NULL, - caption = NULL, - tag = NULL, - title.linelength = 60, - title.colour = getOption("plot2.colour_font_primary", "black"), - subtitle.linelength = 60, - subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), - na.replace = "", - na.rm = FALSE, - facet.position = "top", - facet.fill = NULL, - facet.bold = TRUE, - facet.italic = FALSE, - facet.size = 10, - facet.margin = 8, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = TRUE, - facet.fixed_y = NULL, - facet.fixed_x = TRUE, - facet.drop = FALSE, - facet.nrow = NULL, - facet.relative = FALSE, - x.date_breaks = NULL, - x.date_labels = NULL, - x.date_remove_years = NULL, - category.focus = NULL, - colour = colourpicker(c("Observation" = "grey75", - "Rule 1" = "certeblauw", - "Rule 2" = "certegroen", - "Rule 3" = "certeroze", - "Rule 4" = "certegeel", - "Rule 5" = "certelila", - "Rule 6" = "certebruin", - "Rule 7" = "certeblauw2", - "Rule 8" = "certegroen2")), - colour_fill = NULL, - colour_opacity = 0, - x.lbl_angle = 0, - x.lbl_align = NULL, - x.lbl_italic = FALSE, - x.lbl_taxonomy = FALSE, - x.remove = FALSE, - x.position = "bottom", - x.max_items = Inf, - x.max_txt = "(rest, x%n)", - category.max_items = Inf, - category.max_txt = "(rest, x%n)", - facet.max_items = Inf, - facet.max_txt = "(rest, x%n)", - x.breaks = NULL, - x.n_breaks = NULL, - x.transform = "identity", - x.expand = NULL, - x.limits = NULL, - x.labels = NULL, - x.character = NULL, - x.drop = FALSE, - x.mic = FALSE, - x.zoom = TRUE, - y.remove = FALSE, - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - y.breaks = NULL, - y.n_breaks = NULL, - y.limits = NULL, - y.labels = NULL, - y.expand = NULL, - y.transform = "identity", - y.position = "left", - y.zoom = TRUE, - y_secondary = NULL, - y_secondary.type = type, - y_secondary.title = TRUE, - y_secondary.colour = "certeroze", - y_secondary.colour_fill = "certeroze6", - y_secondary.scientific = NULL, - y_secondary.percent = FALSE, - y_secondary.labels = NULL, - category.labels = NULL, - category.percent = FALSE, - category.breaks = NULL, - category.limits = NULL, - category.expand = 0, - category.midpoint = NULL, - category.transform = "identity", - category.date_breaks = NULL, - category.date_labels = NULL, - category.character = NULL, - x.sort = NULL, - category.sort = TRUE, - facet.sort = TRUE, - x.complete = NULL, - category.complete = NULL, - facet.complete = NULL, - datalabels = TRUE, - datalabels.round = ifelse(y.percent, 2, 1), - datalabels.format = "%n", - datalabels.colour = "grey25", - datalabels.colour_fill = NULL, - datalabels.size = (3 * text_factor), - datalabels.angle = 0, - datalabels.lineheight = 1.0, - decimal.mark = dec_mark(), - big.mark = big_mark(), - summarise_function = base::sum, - stacked = FALSE, - stackedpercent = FALSE, - horizontal = FALSE, - reverse = horizontal, - smooth = NULL, - smooth.method = NULL, - smooth.formula = NULL, - smooth.se = TRUE, - smooth.level = 0.95, - smooth.alpha = 0.25, - smooth.linewidth = 0.75, - smooth.linetype = 3, - smooth.colour = NULL, - size = 2, - linetype = 1, - linewidth = NULL, - binwidth = NULL, - width = NULL, - jitter_seed = NA, - violin_scale = "count", - legend.position = "right", - legend.title = NULL, # TRUE in numeric categories - legend.reverse = FALSE, - legend.barheight = 6, - legend.barwidth = 1.5, - legend.nbin = 300, - legend.italic = FALSE, - sankey.node_width = 0.15, - sankey.node_whitespace = 0.03, - sankey.alpha = 0.5, - sankey.remove_axes = NULL, - zoom = TRUE, - sep = " / ", - print = FALSE, - text_factor = 1, - font = getOption("plot2.font"), - theme = getOption("plot2.theme", "theme_minimal2"), - background = getOption("plot2.colour_background", "white"), - markdown = TRUE, - ...) { - - loadNamespace("certestats") # will throw an error if not installed - - att <- attributes(.data) - df <- data.frame(x = seq_len(length(att$values)), - y = att$values, - rule = "Observation", - shp = 4, - size = size, - stringsAsFactors = FALSE) - for (i in seq_len(length(.data))) { - if (length(.data[[i]]) > 0) { - # only add the first here - df_rule <- data.frame(x = .data[[i]], - y = att$values[.data[[i]]], - rule = paste0("Rule ", gsub("[^0-9]", "", names(.data)[i])), - shp = 13, - size = size * 1.5, - stringsAsFactors = FALSE) - df <- rbind(df, df_rule) - } - } - - df <- df[order(df$x, df$rule), , drop = FALSE] - - if (missing(caption)) { - # fill caption with rules - rules <- names(.data[unlist(lapply(.data, function(r) length(r) > 0))]) - rules <- as.integer(gsub("[^0-9]", "", rules)) - threshold <- att$threshold[rules] - caption <- "\n" - for (i in seq_len(length(rules))) { - rule <- paste0("Rule ", rules[i], ":") - caption <- c(caption, - paste(rule, certestats::qc_rule_text(rules[i], threshold[i]))) - } - caption <- paste0(caption, collapse = "\n") - } - - p <- plot2_exec(.data = df, - x = {{ x }}, - y = {{ y }}, - category = {{ category }}, - facet = {{ facet }}, - type = "blank", - x.title = {{ x.title }}, - y.title = {{ y.title }}, - category.title = {{ category.title }}, - title = {{ title }}, - subtitle = {{ subtitle }}, - caption = {{ caption }}, - tag = {{ tag }}, - title.linelength = title.linelength, - title.colour = title.colour, - subtitle.linelength = subtitle.linelength, - subtitle.colour = subtitle.colour, - na.replace = na.replace, - na.rm = na.rm, - facet.position = facet.position, - facet.fill = facet.fill, - facet.bold = facet.bold, - facet.italic = facet.italic, - facet.size = facet.size, - facet.margin = facet.margin, - facet.repeat_lbls_x = facet.repeat_lbls_x, - facet.repeat_lbls_y = facet.repeat_lbls_y, - facet.fixed_y = facet.fixed_y, - facet.fixed_x = facet.fixed_x, - facet.drop = facet.drop, - facet.nrow = facet.nrow, - facet.relative = facet.relative, - x.date_breaks = x.date_breaks, - x.date_labels = x.date_labels, - x.date_remove_years = x.date_remove_years, - category.focus = category.focus, - colour = colour, - colour_fill = colour_fill, - colour_opacity = colour_opacity, - x.lbl_angle = x.lbl_angle, - x.lbl_align = x.lbl_align, - x.lbl_italic = x.lbl_italic, - x.lbl_taxonomy = x.lbl_taxonomy, - x.remove = x.remove, - x.position = x.position, - x.max_items = x.max_items, - x.max_txt = x.max_txt, - category.max_items = category.max_items, - category.max_txt = category.max_txt, - facet.max_items = facet.max_items, - facet.max_txt = facet.max_txt, - x.breaks = x.breaks, - x.n_breaks = x.n_breaks, - x.transform = x.transform, - x.expand = x.expand, - x.limits = x.limits, - x.labels = x.labels, - x.character = x.character, - x.drop = x.drop, - x.mic = x.mic, - x.zoom = x.zoom, - y.remove = y.remove, - y.24h = y.24h, - y.age = y.age, - y.scientific = y.scientific, - y.percent = y.percent, - y.percent_break = y.percent_break, - y.breaks = y.breaks, - y.n_breaks = y.n_breaks, - y.limits = y.limits, - y.labels = y.labels, - y.expand = y.expand, - y.transform = y.transform, - y.position = y.position, - y.zoom = y.zoom, - y_secondary = NULL, - y_secondary.type = NULL, - y_secondary.title = TRUE, - y_secondary.colour = NULL, - y_secondary.colour_fill = NULL, - y_secondary.scientific = NULL, - y_secondary.percent = NULL, - y_secondary.labels = NULL, - category.labels = category.labels, - category.percent = category.percent, - category.breaks = category.breaks, - category.limits = category.limits, - category.expand = category.expand, - category.midpoint = category.midpoint, - category.transform = category.transform, - category.date_breaks = category.date_breaks, - category.date_labels = category.date_labels, - category.character = category.character, - x.sort = x.sort, - category.sort = category.sort, - facet.sort = facet.sort, - x.complete = x.complete, - category.complete = category.complete, - facet.complete = facet.complete, - datalabels = {{ datalabels }}, - datalabels.round = datalabels.round, - datalabels.colour = datalabels.colour, - datalabels.format = datalabels.format, - datalabels.colour_fill = datalabels.colour_fill, - datalabels.size = datalabels.size, - datalabels.angle = datalabels.angle, - datalabels.lineheight = datalabels.lineheight, - decimal.mark = decimal.mark, - big.mark = big.mark, - summarise_function = summarise_function, - stacked = stacked, - stackedpercent = stackedpercent, - horizontal = horizontal, - reverse = reverse, - smooth = smooth, - smooth.method = smooth.method, - smooth.formula = smooth.formula, - smooth.se = smooth.se, - smooth.level = smooth.level, - smooth.alpha = smooth.alpha, - smooth.linewidth = smooth.linewidth, - smooth.linetype = smooth.linetype, - smooth.colour = smooth.colour, - size = size, - linetype = linetype, - linewidth = linewidth, - binwidth = binwidth, - width = width, - jitter_seed = jitter_seed, - violin_scale = violin_scale, - legend.position = legend.position, - legend.title = {{ legend.title }}, - legend.reverse = legend.reverse, - legend.barheight = legend.barheight, - legend.barwidth = legend.barwidth, - legend.nbin = legend.nbin, - legend.italic = legend.italic, - sankey.node_width = sankey.node_width, - sankey.node_whitespace = sankey.node_whitespace, - sankey.alpha = sankey.alpha, - sankey.remove_axes = sankey.remove_axes, - zoom = zoom, - sep = sep, - print = FALSE, - text_factor = text_factor, - font = font, - theme = theme, - background = background, - markdown = markdown, - `_misses.x` = FALSE, - `_misses.y` = FALSE, - `_misses.category` = FALSE, - `_misses.facet` = missing(facet), - `_misses.datalabels` = missing(datalabels), - `_misses.colour_fill` = missing(colour_fill), - `_misses.x.title` = FALSE, - `_misses.y.title` = FALSE, - `_misses.title` = FALSE, - `_misses.subtitle` = missing(subtitle), - `_misses.tag` = missing(tag), - `_misses.caption` = FALSE, - `_misses.y.percent` = missing(y.percent), - `_misses.y.percent_break` = missing(y.percent_break), - `_misses.x.zoom` = missing(x.zoom), - `_misses.x.max_items` = missing(x.max_items), - `_misses.facet.fixed_x` = missing(facet.fixed_x), - `_label.x` = deparse(substitute(x)), - `_label.y` = deparse(substitute(y)), - `_label.category` = deparse(substitute(category)), - `_label.facet` = deparse(substitute(facet)), - `_label.y_secondary` = deparse(substitute(y_secondary)), - `_summarise_fn_name` = deparse(substitute(summarise_function)), - `_misses.summarise_function` = missing(summarise_function), - ...) - - # left align the rule texts - p <- p + theme(plot.caption = element_text(hjust = 0)) - - # add reference lines - p <- p + - geom_hline(yintercept = mean(att$values), - colour = "black", linetype = 2, linewidth = linewidth) + - geom_hline(yintercept = mean(att$values) + stats::sd(att$values), - colour = "#61D04F", linetype = 2, linewidth = linewidth) + - geom_hline(yintercept = mean(att$values) - stats::sd(att$values), - colour = "#61D04F", linetype = 2, linewidth = linewidth) + - geom_hline(yintercept = mean(att$values) + 2 * stats::sd(att$values), - colour = "#F5C710", linetype = 2, linewidth = linewidth) + - geom_hline(yintercept = mean(att$values) - 2 * stats::sd(att$values), - colour = "#F5C710", linetype = 2, linewidth = linewidth) + - geom_hline(yintercept = mean(att$values) + 3 * stats::sd(att$values), - colour = "#DF536B", linetype = 2, linewidth = linewidth) + - geom_hline(yintercept = mean(att$values) - 3 * stats::sd(att$values), - colour = "#DF536B", linetype = 2, linewidth = linewidth) - - p <- p + - geom_point(shape = df$shp, size = df$size) - - # add lines for each rule found - for (i in seq_len(length(.data))) { - if (length(.data[[i]]) > 0) { - threshold <- att$threshold[i] - ind <- .data[[i]] - p <- p + - geom_point(data = data.frame(x = ind, - y = att$values[ind]), - mapping = update_aes(x = "x", y = "y"), - inherit.aes = FALSE, - alpha = 0.33, - size = size * 2.5, - colour = colour[i + 1]) - if (threshold > 1) { - # print coloured lines and point for the rules - for (j in seq_len(length(ind))) { - ind_vector <- c(ind[j]:(ind[j] + threshold - 1)) - val <- att$values[ind_vector] - p <- p + - geom_line(data = data.frame(x = ind_vector, - y = val), - mapping = update_aes(x = "x", y = "y"), - inherit.aes = FALSE, - linetype = linetype, - linewidth = linewidth, - colour = colour[i + 1]) + - geom_point(data = data.frame(x = ind_vector, - y = val), - mapping = update_aes(x = "x", y = "y"), - inherit.aes = FALSE, - shape = 4, - size = size, - colour = colour[i + 1]) - } - } - } - } - if (isTRUE(print)) { - print(p) - } else { - p - } -} - -#' @rdname plot2-methods -#' @importFrom dplyr group_by mutate ungroup summarise n_distinct `%>%` filter left_join -#' @importFrom ggplot2 geom_point aes -#' @importFrom certestyle colourpicker add_white format2 -#' @details The detection of [disease clusters](https://en.wikipedia.org/wiki/Disease_cluster) can be done using [certestats::early_warning_cluster()]. Use `size` to alter the size of the triangles that indicate clusters. -#' @export -#' @examples -#' -#' # DISEASE CLUSTERS ----------------------------------------------------- -#' cases <- data.frame(date = sample(seq(as.Date("2015-01-01"), -#' as.Date("2022-12-31"), -#' "1 day"), -#' size = 300), -#' patient = sample(LETTERS, size = 300, replace = TRUE)) -#' check <- certestats::early_warning_cluster(cases, -#' minimum_cases = 1, -#' threshold_percentile = 0.75) -#' -#' check |> plot2() -plot2.early_warning_cluster <- function(.data, - x = NULL, - y = NULL, - category = NULL, - facet = NULL, - type = "line", - x.title = ifelse(attributes(.data)$period_length_months == 12, "Maand in periode", "Week in periode"), - y.title = paste0("Cases (", attributes(.data)$moving_average_days, "-daags zwevend gemiddelde)"), - category.title = "Periode", - title = paste0(n_distinct(.data$clusters$cluster), " cluster", ifelse(n_distinct(.data$clusters$cluster) != 1, "s", "")), - subtitle = NULL, - caption = paste0("O.b.v. uitbijter-vrije geschiedenis (coeff = ", - format2(attributes(.data)$remove_outliers_coefficient), - ") met pct = ", - format2(attributes(.data)$threshold_percentile)), - tag = NULL, - title.linelength = 60, - title.colour = getOption("plot2.colour_font_primary", "black"), - subtitle.linelength = 60, - subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), - na.replace = "", - na.rm = FALSE, - facet.position = "top", - facet.fill = NULL, - facet.bold = TRUE, - facet.italic = FALSE, - facet.size = 10, - facet.margin = 8, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = TRUE, - facet.fixed_y = NULL, - facet.fixed_x = TRUE, - facet.drop = FALSE, - facet.nrow = NULL, - facet.relative = FALSE, - x.date_breaks = "1 month", - x.date_labels = "mmm", - x.date_remove_years = FALSE, # has no impact anyway, see below at x.date_remove_years - category.focus = NULL, - colour = getOption("plot2.colour", "ggplot2"), - colour_fill = NULL, - colour_opacity = 0, - x.lbl_angle = 0, - x.lbl_align = NULL, - x.lbl_italic = FALSE, - x.lbl_taxonomy = FALSE, - x.remove = FALSE, - x.position = "bottom", - x.max_items = Inf, - x.max_txt = "(rest, x%n)", - category.max_items = Inf, - category.max_txt = "(rest, x%n)", - facet.max_items = Inf, - facet.max_txt = "(rest, x%n)", - x.breaks = seq(0, 9999, 14), - x.n_breaks = NULL, - x.transform = "identity", - x.expand = NULL, - x.limits = NULL, - x.labels = function(x) x / 7, - x.character = NULL, - x.drop = FALSE, - x.mic = FALSE, - x.zoom = FALSE, - y.remove = FALSE, - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - y.breaks = NULL, - y.n_breaks = NULL, - y.limits = NULL, - y.labels = NULL, - y.expand = NULL, - y.transform = "identity", - y.position = "left", - y.zoom = FALSE, - y_secondary = NULL, - y_secondary.type = type, - y_secondary.title = TRUE, - y_secondary.colour = "certeroze", - y_secondary.colour_fill = "certeroze6", - y_secondary.scientific = NULL, - y_secondary.percent = FALSE, - y_secondary.labels = NULL, - category.labels = md_to_expression, - category.percent = FALSE, - category.breaks = NULL, - category.limits = NULL, - category.expand = 0, - category.midpoint = NULL, - category.transform = "identity", - category.date_breaks = NULL, - category.date_labels = NULL, - category.character = TRUE, - x.sort = NULL, - category.sort = "asc", - facet.sort = TRUE, - x.complete = NULL, - category.complete = NULL, - facet.complete = NULL, - datalabels = TRUE, - datalabels.round = ifelse(y.percent, 2, 1), - datalabels.format = "%n", - datalabels.colour = "grey25", - datalabels.colour_fill = NULL, - datalabels.size = (2.5 * text_factor), - datalabels.angle = 0, - datalabels.lineheight = 1.0, - decimal.mark = dec_mark(), - big.mark = big_mark(), - summarise_function = base::sum, - stacked = FALSE, - stackedpercent = FALSE, - horizontal = FALSE, - reverse = horizontal, - smooth = NULL, - smooth.method = NULL, - smooth.formula = NULL, - smooth.se = TRUE, - smooth.level = 0.95, - smooth.alpha = 0.25, - smooth.linewidth = 0.75, - smooth.linetype = 3, - smooth.colour = NULL, - size = NULL, - linetype = 1, - linewidth = NULL, - binwidth = NULL, - width = NULL, - jitter_seed = NA, - violin_scale = "count", - legend.position = "right", - legend.title = NULL, # TRUE in numeric categories - legend.reverse = FALSE, - legend.barheight = 6, - legend.barwidth = 1.5, - legend.nbin = 300, - legend.italic = FALSE, - sankey.node_width = 0.15, - sankey.node_whitespace = 0.03, - sankey.alpha = 0.5, - sankey.remove_axes = NULL, - zoom = FALSE, - sep = " / ", - print = FALSE, - text_factor = 1, - font = getOption("plot2.font"), - theme = getOption("plot2.theme", "theme_minimal2"), - background = getOption("plot2.colour_background", "white"), - markdown = TRUE, - ...) { - loadNamespace("certestats") # will throw an error if not installed - - early_warning_object <- .data - - if (NROW(early_warning_object$details) == 0) { - # check if markdown is required - markdown <- validate_markdown(markdown, x.title, y.title, c(category.title, legend.title), title, subtitle, tag, caption) - plot2_warning("No observations, returning an empty plot") - p <- ggplot() + - validate_theme(theme = theme, - type = "", - background = background, - text_factor = text_factor, - font = font, - horizontal = horizontal, - x.remove = x.remove, - y.remove = y.remove, - x.lbl_angle = x.lbl_angle, - x.lbl_align = x.lbl_align, - x.lbl_italic = x.lbl_italic, - facet.fill = facet.fill, - facet.bold = facet.bold, - facet.italic = facet.italic, - facet.size = facet.size, - facet.margin = facet.margin, - legend.italic = legend.italic, - sankey.remove_axes = sankey.remove_axes, - title.colour = title.colour, - subtitle.colour = subtitle.colour, - has_y_secondary = FALSE, - col_y_primary = NULL, - col_y_secondary = NULL) - if (!missing(x.title)) p <- p + labs(x = validate_title(x.title, markdown = markdown)) - if (!missing(y.title)) p <- p + labs(y = validate_title(y.title, markdown = markdown)) - if (!missing(title)) p <- p + labs(title = validate_title(title, markdown = markdown, max_length = title.linelength)) - if (!missing(subtitle)) p <- p + labs(subtitle = validate_title(subtitle, markdown = markdown, max_length = subtitle.linelength)) - if (!missing(tag)) p <- p + labs(tag = validate_title(tag, markdown = markdown)) - if (!missing(caption)) p <- p + labs(caption = validate_title(caption, markdown = markdown)) - if (isTRUE(print)) { - print(p) - } else { - return(p) - } - } - - if (NROW(early_warning_object$clusters) == 0) { - if (attributes(early_warning_object)$period_length_months == 12) { - # plot as years - clusters <- data.frame(cluster = integer(0), xmin = Sys.Date()[0], xmax = Sys.Date()[0]) - } else { - # plot as days in period - clusters <- data.frame(cluster = integer(0), xmin = double(0), xmax = double(0)) - } - } else { - if (attributes(early_warning_object)$period_length_months == 12) { - # plot as years - clusters <- early_warning_object$clusters |> - left_join(early_warning_object$details |> - select(date, period_date), - by = "date") |> - group_by(cluster) |> - summarise(xmin = min(period_date, na.rm = TRUE), - xmax = max(period_date, na.rm = TRUE), - n_cases = sum(cases, na.rm = TRUE)) - } else { - # plot as days in period - clusters <- early_warning_object$clusters |> - group_by(cluster) |> - summarise(xmin = min(day_in_period, na.rm = TRUE), - xmax = max(day_in_period, na.rm = TRUE), - n_cases = sum(cases, na.rm = TRUE)) - } - } - - if (identical(colour, "certe")) { - colour <- c("certeblauw", colourpicker("greyscale", n_distinct(early_warning_object$details$period) - 1)) - if (isTRUE(attributes(early_warning_object)$based_on_historic_maximum)) { - colour <- c(colour, "certeroze2") - } - } else { - # set number of colours needed - if (isTRUE(attributes(early_warning_object)$based_on_historic_maximum)) { - colour <- colourpicker(colour, n_distinct(early_warning_object$details$period) + 1) - } else { - colour <- colourpicker(colour, n_distinct(early_warning_object$details$period)) - } - } - - early_warning_object$details <- early_warning_object$details |> - group_by(period = abs(period)) |> - mutate(period_txt = paste0("**Periode ", abs(period), ":** ", format2(min(date), "d mmm \u2019yy"), " - ", format2(max(date), "d mmm \u2019yy"))) |> - ungroup() - - p <- early_warning_object$details |> - plot2(x = if (attributes(early_warning_object)$period_length_months == 12) period_date else day_in_period, - y = moving_avg, - category = period_txt, - # facet = {{facet}}, - type = type, - x.title = x.title, - y.title = y.title, - category.title = category.title, - title = title, - subtitle = subtitle, - caption = caption, - tag = tag, - title.linelength = title.linelength, - title.colour = title.colour, - subtitle.linelength = subtitle.linelength, - subtitle.colour = subtitle.colour, - na.replace = na.replace, - na.rm = na.rm, - facet.position = facet.position, - facet.fill = facet.fill, - facet.bold = facet.bold, - facet.italic = facet.italic, - facet.size = facet.size, - facet.margin = facet.margin, - facet.repeat_lbls_x = facet.repeat_lbls_x, - facet.repeat_lbls_y = facet.repeat_lbls_y, - facet.fixed_y = facet.fixed_y, - facet.fixed_x = facet.fixed_x, - facet.drop = facet.drop, - facet.nrow = facet.nrow, - facet.relative = facet.relative, - x.date_breaks = x.date_breaks, - x.date_labels = x.date_labels, - x.date_remove_years = FALSE, # otherwise the diease cluster years will be 1970 (as plot2() works like that in unify_years()) - category.focus = category.focus, - colour = colour, - colour_fill = colour_fill, - colour_opacity = colour_opacity, - x.lbl_angle = x.lbl_angle, - x.lbl_align = x.lbl_align, - x.lbl_italic = x.lbl_italic, - x.lbl_taxonomy = x.lbl_taxonomy, - x.remove = x.remove, - x.position = x.position, - x.max_items = x.max_items, - x.max_txt = x.max_txt, - category.max_items = category.max_items, - category.max_txt = category.max_txt, - facet.max_items = facet.max_items, - facet.max_txt = facet.max_txt, - x.breaks = x.breaks, - x.n_breaks = x.n_breaks, - x.transform = x.transform, - x.expand = x.expand, - x.limits = x.limits, - x.labels = x.labels, - x.character = x.character, - x.drop = x.drop, - x.mic = x.mic, - x.zoom = x.zoom, - y.remove = y.remove, - y.24h = y.24h, - y.age = y.age, - y.scientific = y.scientific, - y.percent = y.percent, - y.percent_break = y.percent_break, - y.breaks = y.breaks, - y.n_breaks = y.n_breaks, - y.limits = y.limits, - y.labels = y.labels, - y.expand = y.expand, - y.transform = y.transform, - y.position = y.position, - y.zoom = y.zoom, - y_secondary = y_secondary, - y_secondary.type = y_secondary.type, - y_secondary.title = y_secondary.title, - y_secondary.colour = y_secondary.colour, - y_secondary.colour_fill = y_secondary.colour_fill, - y_secondary.scientific = y_secondary.scientific, - y_secondary.percent = y_secondary.percent, - y_secondary.labels = y_secondary.labels, - category.labels = category.labels, - category.percent = category.percent, - category.breaks = category.breaks, - category.limits = category.limits, - category.expand = category.expand, - category.midpoint = category.midpoint, - category.transform = category.transform, - category.date_breaks = category.date_breaks, - category.date_labels = category.date_labels, - category.character = category.character, - x.sort = x.sort, - category.sort = category.sort, - facet.sort = facet.sort, - x.complete = x.complete, - category.complete = category.complete, - facet.complete = facet.complete, - datalabels = datalabels, - datalabels.round = datalabels.round, - datalabels.format = datalabels.format, - datalabels.colour = datalabels.colour, - datalabels.colour_fill = datalabels.colour_fill, - datalabels.size = datalabels.size, - datalabels.angle = datalabels.angle, - datalabels.lineheight = datalabels.lineheight, - decimal.mark = decimal.mark, - big.mark = big.mark, - summarise_function = summarise_function, - stacked = stacked, - stackedpercent = stackedpercent, - horizontal = horizontal, - reverse = reverse, - smooth = smooth, - smooth.method = smooth.method, - smooth.formula = smooth.formula, - smooth.se = smooth.se, - smooth.level = smooth.level, - smooth.alpha = smooth.alpha, - smooth.linewidth = smooth.linewidth, - smooth.linetype = smooth.linetype, - smooth.colour = smooth.colour, - # size = size, - linetype = linetype, - linewidth = linewidth, - binwidth = binwidth, - width = width, - jitter_seed = jitter_seed, - violin_scale = violin_scale, - legend.position = legend.position, - legend.title = legend.title, - legend.reverse = legend.reverse, - legend.barheight = legend.barheight, - legend.barwidth = legend.barwidth, - legend.nbin = legend.nbin, - legend.italic = legend.italic, - sankey.node_width = sankey.node_width, - sankey.node_whitespace = sankey.node_whitespace, - sankey.alpha = sankey.alpha, - sankey.remove_axes = sankey.remove_axes, - zoom = zoom, - sep = sep, - print = print, - text_factor = text_factor, - font = font, - theme = theme, - background = background, - markdown = markdown, - - `_misses.x` = FALSE, - `_misses.y` = FALSE, - `_misses.category` = FALSE, - `_misses.facet` = missing(facet), - `_misses.datalabels` = missing(datalabels), - `_misses.colour_fill` = missing(colour_fill), - `_misses.x.title` = FALSE, - `_misses.y.title` = FALSE, - `_misses.title` = FALSE, - `_misses.subtitle` = missing(subtitle), - `_misses.tag` = missing(tag), - `_misses.caption` = FALSE, - `_misses.y.percent` = missing(y.percent), - `_misses.y.percent_break` = missing(y.percent_break), - `_misses.x.zoom` = missing(x.zoom), - `_misses.x.max_items` = missing(x.max_items), - `_misses.facet.fixed_x` = missing(facet.fixed_x), - `_label.x` = deparse(substitute(x)), - `_label.y` = deparse(substitute(y)), - `_label.category` = deparse(substitute(category)), - `_label.facet` = deparse(substitute(facet)), - `_label.y_secondary` = deparse(substitute(y_secondary)), - `_summarise_fn_name` = deparse(substitute(summarise_function)), - `_misses.summarise_function` = missing(summarise_function), - ...) %>% - add_line(y = moving_avg, - data = .$data |> filter(period_txt %like% "Periode 0:"), - colour = colour[1], - linewidth = 0.6, - inherit.aes = FALSE) %>% - (function(x) { - if ("moving_avg_limit" %in% x$data) { - x |> add_line(y = moving_avg_limit, - colour = colour[1], - linetype = 2, - linewidth = 0.6, - inherit.aes = FALSE) - } else { - x - }})() |> - add_type(data = clusters, - type = "rect", - mapping = aes(xmin = xmin, - xmax = xmax, - ymin = 0, - ymax = max(early_warning_object$details$moving_avg, na.rm = TRUE) * 1.05), - fill = colourpicker(colour[1]), - alpha = 0.1, - inherit.aes = FALSE) |> - move_layer(move = -99) |> - # arrow left to right (arrow head on the right) - add_type(data = clusters, - type = "segment", - mapping = aes(x = xmin, - xend = xmax, - y = max(early_warning_object$details$moving_avg, na.rm = TRUE) * 1.05, - yend = max(early_warning_object$details$moving_avg, na.rm = TRUE) * 1.05), - lineend = "round", - linejoin = "round", - arrow = grid::arrow(angle = 90, length = unit(2, "pt")), - colour = colourpicker(colour[1]), - linewidth = 0.5, - inherit.aes = FALSE) |> - # arrow right to left (arrow head on the left) - add_type(data = clusters, - type = "segment", - mapping = aes(x = xmax, - xend = xmin, - y = max(early_warning_object$details$moving_avg, na.rm = TRUE) * 1.05, - yend = max(early_warning_object$details$moving_avg, na.rm = TRUE) * 1.05), - lineend = "round", - linejoin = "round", - arrow = grid::arrow(angle = 90, length = unit(2, "pt")), - colour = colourpicker(colour[1]), - linewidth = 0.5, - inherit.aes = FALSE) |> - # arrow right to left (arrow head on the left) - add_type(data = clusters, - type = "text", - mapping = aes(label = paste0("N = ", n_cases), - x = xmax - (xmax - xmin) / 2, - y = max(early_warning_object$details$moving_avg, na.rm = TRUE) * 1.1), - colour = colourpicker(colour[1]), - size = datalabels.size, - fontface = "bold", - inherit.aes = FALSE) - - if (isTRUE(attributes(early_warning_object)$based_on_historic_maximum)) { - p <- p |> - add_line(y = moving_avg_max, - data = p$data |> mutate(period_txt = "Maximum"), - linewidth = 0.5, - inherit.aes = FALSE) - } - - if (isTRUE(print)) { - print(p) - } else { - p - } -} diff --git a/R/plot2.R b/R/plot2.R deleted file mode 100644 index 96088f64..00000000 --- a/R/plot2.R +++ /dev/null @@ -1,1756 +0,0 @@ -# ===================================================================== # -# An R package by Certe: # -# https://github.com/certe-medical-epidemiology # -# # -# Licensed as GPL-v2.0. # -# # -# Developed at non-profit organisation Certe Medical Diagnostics & # -# Advice, department of Medical Epidemiology. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# ===================================================================== # - -#' Conveniently Create a New `ggplot` -#' -#' @description The [plot2()] function is a convenient wrapper around many [`ggplot2`][ggplot2::ggplot()] functions. By design, the `ggplot2` package requires users to use a lot of functions and manual settings, while the [plot2()] function does all the heavy lifting automatically and only requires users to define some arguments in one single function, greatly increases convenience. -#' -#' Moreover, [plot2()] allows for in-place calculation of `y`, all axes, and all axis labels, often preventing the need to use [group_by()], [count()], [mutate()], or [summarise()]. -#' -#' See [plot2-methods] for all implemented methods for different object classes. -#' @param .data data to plot -#' @param x plotting 'direction' for the x axis. This can be: -#' -#' - A single variable from `.data`, such as `x = column1` -#' -#' - A [function] to calculate over one or more variables from `.data`, such as `x = format(column1, "%Y")`, or `x = ifelse(column1 == "A", "Group A", "Other")` -#' -#' - Multiple variables from `.data`, such as `x = c(column1, column2, column2)`, or using [selection helpers][tidyselect::language] such as `x = where(is.character)` or `x = starts_with("var_")` *(only allowed and required for Sankey plots using `type = "sankey"`)* -#' @param y values to use for plotting along the y axis. This can be: -#' -#' - A single variable from `.data`, such as `y = column1` -#' -#' - Multiple variables from `.data`, such as `y = c(column1, column2)` or `y = c(name1 = column1, "name 2" = column2)`, or using [selection helpers][tidyselect::language] such as `y = where(is.double)` or `y = starts_with("var_")` *(multiple variables only allowed if `category` is not set)* -#' -#' - A [function] to calculate over `.data` returning a single value, such as `y = n()` for the row count, or based on other variables such as `y = n_distinct(person_id)`, `y = max(column1)`, or `y = median(column2) / column3` -#' -#' - A [function] to calculate over `.data` returning multiple values, such as `y = quantile(column1, c(0.25, 0.75))` or `y = range(age)` *(multiple values only allowed if `category` is not set)* -#' @param category,facet plotting 'direction' (`category` is called 'fill' and 'colour' in `ggplot2`). This can be: -#' -#' - A single variable from `.data`, such as `category = column1` -#' -#' - A [function] to calculate over one or more variables from `.data`, such as `category = median(column2) / column3`, or `facet = ifelse(column1 == "A", "Group A", "Other")` -#' -#' - Multiple variables from `.data`, such as `facet = c(column1, column2)` (use `sep` to control the separator character) -#' -#' - One or more variables from `.data` using [selection helpers][tidyselect::language], such as `category = where(is.double)` or `facet = starts_with("var_")` -#' -#' The `category` can also be a date or date/time (class `Date` or `POSIXt`). -#' -#' @param y_secondary values to use for plotting along the secondary y axis. This functionality is poorly supported by `ggplot2` and might give unexpected results. Setting the secondary y axis will set the colour to the axis titles. -#' @param y_secondary.colour,y_secondary.colour_fill colours to set for the secondary y axis, will be evaluated with [`colourpicker()`][certestyle::colourpicker()] -#' @param type,y_secondary.type type of visualisation to use. This can be: -#' -#' - A `ggplot2` geom name or their abbreviation such as `"col"` and `"point"`. All geoms are supported (including [`geom_blank()`][ggplot2::geom_blank()]). -#' -#' Full function names can be used (e.g., `"geom_histogram"`), but they can also be abbreviated (e.g., `"h"`, `"hist"`). The following geoms can be abbreviated by their first character: area (`"a"`), boxplot (`"b"`), column (`"c"`), histogram (`"h"`), jitter (`"j"`), line (`"l"`), point (`"p"`), ribbon (`"r"`), and violin (`"v"`). -#' -#' Please note: in `ggplot2`, 'bars' and 'columns' are equal, while it is common to many people that 'bars' are oriented horizontally and 'columns' are oriented vertically since Microsoft Excel has been using these terms this way for many years. For this reason, `type = "bar"` will set `type = "col"` and `horizontal = TRUE`. -#' -#' - One of these additional types: -#' -#' - `"barpercent"` (short: `"bp"`), which is effectively a shortcut to set `type = "col"` and `horizontal = TRUE` and `x.max_items = 10` and `x.sort = "freq-desc"` and `datalabels.format = "%n (%p)"`. -#' - `"linedot"` (short: `"ld"`), which sets `type = "line"` and adds two point geoms using [add_point()]; one with large white dots and one with smaller dots using the colours set in `colour`. This is essentially equal to base \R `plot(..., type = "b")` but with closed shapes. -#' - `"dumbbell"` (short: `"d"`), which sets `type = "point"` and `horizontal = TRUE`, and adds a line between the points (using [geom_segment()]). The line colour cannot be changed. This plot type is only possible when the `category` has two distinct values. -#' - `"sankey"` (short: `"s"`) creates a Sankey plots using `category` for the flows and requires `x` to contain multiple variables from `.data`. At default, it also sets `x.expand = c(0.05, 0.05)` and `y.limits = c(NA, NA)` and `y.expand = c(0.01, 0.01)`. The so-called 'nodes' (the 'blocks' with text) are considered the datalabels, so you can set the text size and colour of the nodes using `datalabels.size`, `datalabels.colour`, and `datalabels.colour_fill`. The transparency of the flows can be set using `sankey.alpha`, and the width of the nodes can be set using `sankey.node_width`. Sankey plots can also be flipped using `horizontal = TRUE`. -#' -#' - Left blank. In this case, the type will be determined automatically: `"boxplot"` if there is no x axis or if the length of unique values per x axis item is at least 3, `"point"` if both the y and x axes are numeric, and the [option][options()] `"plot2.default_type"` otherwise (which defaults to `"col"`). Use `type = "blank"` or `type = "geom_blank"` to *not* add a geom. -#' @param title,subtitle,caption,tag,x.title,y.title,category.title,legend.title,y_secondary.title a title to use. This can be: -#' -#' - A [character], which supports markdown by using [md_to_expression()] internally if `markdown = TRUE` (which is the default) -#' - A [function] to calculate over `.data`, such as `title = paste("Based on n =", n_distinct(person_id), "individuals")` or `subtitle = paste("Total rows:", n())`, see *Examples* -#' - An [expression], e.g. using `parse(text = "...")` -#' -#' The `category.title` defaults to `TRUE` if the legend items are numeric. -#' @param title.linelength maximum number of characters per line in the title, before a linebreak occurs -#' @param title.colour text colour of the title -#' @param subtitle.linelength maximum number of characters per line in the subtitle, before a linebreak occurs -#' @param subtitle.colour text colour of the subtitle -#' @param na.replace character to put in place of `NA` values if `na.rm = FALSE` -#' @param na.rm remove `NA` values from showing in the plot -#' @param facet.fixed_y a [logical] to indicate whether all y scales should have the same limits. Defaults to `TRUE` only if the [coefficient of variation][certestats::cv()] (sd divided by mean) of the maximum values of y is less than 15%. -#' @param facet.fixed_x a [logical] to indicate whether all x scales should have the same breaks. This acts like the inverse of `x.drop`. -#' @param facet.position,facet.fill,facet.bold,facet.italic,facet.size,facet.margin,facet.repeat_lbls_x,facet.repeat_lbls_y,facet.drop,facet.nrow,facet.relative additional settings for the plotting direction `facet` -#' @param x.date_breaks breaks to use when the x axis contains dates, will be determined automatically if left blank. This accepts values such as `"1 day"` and `"2 years"`. -#' @param x.date_labels labels to use when the x axis contains dates, will be determined automatically if left blank. This accepts 'Excel' date-language such as `"d mmmm yyyy"`. -#' @param x.date_remove_years a [logical] to indicate whether the years of all `x` values must be unified. This will set the years of all `x` values [to 1970](https://en.wikipedia.org/wiki/Unix_time) if the data does not contain a leap year, and to 1972 otherwise. This allows to plot years on the `category` while maintaining a date range on `x`. The default is `FALSE`, unless `category` contains all years present in `x`. -#' @param category.focus a value of `category` that should be highlighted, meaning that all other values in `category` will be greyed out. This can also be a numeric value between 1 and the length of unique values of `category`, e.g. `category.focus = 2` to focus on the second legend item. -#' @param colour colour(s) to set, will be evaluated with [`colourpicker()`][certestyle::colourpicker()] if set. This can also be one of the viridis colours with automatic implementation for any plot: `"viridis"`, `"magma"`, `"inferno"`, `"plasma"`, `"cividis"`, `"rocket"`, `"mako"` or `"turbo"`. Also, this can also be a named vector to match values of `category`, see *Examples*. Using a named vector can also be used to manually sort the values of `category`. -#' @param colour_fill colour(s) to be used for filling, will be determined automatically if left blank and will be evaluated with [`colourpicker()`][certestyle::colourpicker()] -#' @param colour_opacity amount of opacity for `colour`/`colour_fill` (0 = solid, 1 = transparent) -#' @param x.lbl_angle angle to use for the x axis in a counter-clockwise direction (i.e., a value of `90` will orient the axis labels from bottom to top, a value of `270` will orient the axis labels from top to bottom) -#' @param x.lbl_align alignment for the x axis between `0` (left aligned) and `1` (right aligned) -#' @param x.lbl_italic [logical] to indicate whether the x labels should in in *italics* -#' @param x.lbl_taxonomy a [logical] to transform all words of the `x` labels into italics that are in the [microorganisms][AMR::microorganisms] data set of the `AMR` package. This uses [md_to_expression()] internally and will set `x.labels` to parse expressions. -#' @param x.character a [logical] to indicate whether the values of the x axis should be forced to [character]. The default is `FALSE`, except for years (values between 2000 and 2050) and months (values from 1 to 12). -#' @param x.drop [logical] to indicate whether factor levels should be dropped -#' @param x.complete,category.complete,facet.complete a value to complete the data. This makes use of [tidyr::full_seq()] and [tidyr::complete()]. For example, using `x.complete = 0` will apply `data |> complete(full_seq(x, ...), fill = list(x = 0))`. Using value `TRUE` (e.g., `x.complete = TRUE`) is identical to using value `0`. -#' @param x.mic [logical] to indicate whether the x axis should be formatted as [MIC values][AMR::as.mic()], by dropping all factor levels and adding missing factors of 2 -#' @param x.remove,y.remove a [logical] to indicate whether the axis labels and title should be removed -#' @param y.24h a [logical] to indicate whether the y labels and breaks should be formatted as 24-hour sequences -#' @param y.age a [logical] to indicate whether the y labels and breaks should be formatted as ages in years -#' @param y.scientific,y_secondary.scientific a [logical] to indicate whether the y labels should be formatted in scientific notation, using [`format2_scientific()`][certestyle::format2_scientific()]. Defaults to `TRUE` only if the range of the y values spans more than `10e5`. -#' @param y.percent,y_secondary.percent a [logical] to indicate whether the y labels should be formatted as percentages -#' @param y.percent_break a value on which the y axis should have breaks -#' @param x.breaks,y.breaks a breaks function or numeric vector to use for the axis -#' @param x.n_breaks,y.n_breaks number of breaks, only useful if `x.breaks` cq. `y.breaks` is `NULL` -#' @param x.limits,y.limits limits to use for the axis, can be length 1 or 2. Use `NA` for the highest or lowest value in the data, e.g. `y.limits = c(0, NA)` to have the y scale start at zero. -#' @param x.labels,y.labels,y_secondary.labels a labels function or character vector to use for the axis -#' @param x.expand,y.expand [expansion][ggplot2::expansion] to use for the axis, can be length 1 or 2. `x.expand` defaults to 0.5 and `y.expand` defaults to `0.25`, except for sf objects (then both default to 0). -#' @param x.transform,y.transform,category.transform a transformation function to use, e.g. `"log2"`. This can be: `r paste0('\u0060"', sort(gsub("_trans$", "", ls(envir = asNamespace("scales"))[grepl("_trans$", ls(envir = asNamespace("scales")))])), '"\u0060', collapse = ", ")`. -#' @param x.position,y.position position of the axis -#' @param x.zoom,y.zoom a [logical] to indicate if the axis should be zoomed on the data, by setting `x.limits = c(NA, NA)` and `x.expand = 0` for the x axis, or `y.limits = c(NA, NA)` and `y.expand = 0` for the y axis -#' @param category.labels,category.percent,category.breaks,category.expand,category.midpoint settings for the plotting direction `category`. -#' @param category.limits limits to use for a numeric category, can be length 1 or 2. Use `NA` for the highest or lowest value in the data, e.g. `category.limits = c(0, NA)` to have the scale start at zero. -#' @param category.date_breaks breaks to use when the category contains dates, will be determined automatically if left blank. This will be passed on to [`seq.Date(by = ...)`][seq.Date()] and thus can be: a number, taken to be in days, or a character string containing one of "day", "week", "month", "quarter" or "year" (optionally preceded by an integer and a space, and/or followed by "s"). -#' @param category.date_labels labels to use when the category contains dates, will be determined automatically if left blank. This accepts 'Excel' date-language such as `"d mmmm yyyy"`. -#' @param category.character a [logical] to indicate whether the values of the category should be forced to [character]. The default is `FALSE`, except for years (values between 2000 and 2050) and months (values from 1 to 12). -#' @param x.max_items,category.max_items,facet.max_items number of maximum items to use, defaults to infinite. All other values will be grouped and summarised using the `summarise_function` function. **Please note:** the sorting will be applied first, allowing to e.g. plot the top *n* most frequent values of the x axis by combining `x.sort = "freq-desc"` with `x.max_items =` *n*. -#' @param x.max_txt,category.max_txt,facet.max_txt the text to use of values not included number of `*.max_items`. The placeholder `%n` will be replaced with the outcome of the `summarise_function` function, the placeholder `%p` will be replaced with the percentage. -#' @param x.sort,category.sort,facet.sort sorting of the plotting direction, defaults to `TRUE`, except for continuous values on the x axis (such as dates and numbers). Applying one of the sorting methods will transform the values to an ordered [factor], which `ggplot2` uses to orient the data. Valid values are: -#' -#' - A manual vector of values -#' - `TRUE`: sort [factor]s on their levels, otherwise sort ascending on alphabet, while maintaining numbers in the text (*numeric* sort) -#' - `FALSE`: sort according to the order in the data -#' - `NULL`: do not sort/transform at all -#' - `"asc"` or `"alpha"`: sort as `TRUE` -#' - `"desc"`: sort [factor]s on their [reversed][rev()] levels, otherwise sort descending on alphabet, while maintaining numbers in the text (*numeric* sort) -#' - `"order"` or `"inorder"`: sort as `FALSE` -#' - `"freq"` or `"freq-desc"`: sort descending according to the frequencies of `y` computed by `summarise_function` (highest value first) -#' - `"freq-asc"`: sort ascending according to the frequencies of `y` computed by `summarise_function` (lowest value first) -#' @param datalabels values to show as datalabels, see also `datalabels.format`. This can be: -#' -#' - Left blank. This will default to the values of `y` in column-type plots, or when plotting spatial 'sf' data, the values of the first column. It will print a maximum of 25 labels unless `datalabels = TRUE`. -#' - `TRUE` or `FALSE` to force or remove datalabels -#' - A function to calculate over `.data`, such as `datalabels = paste(round(column1), "\n", column2)` -#' @param datalabels.round number of digits to round the datalabels, applies to both `"%n"` and `"%p"` for replacement (see `datalabels.format`) -#' @param datalabels.format format to use for datalabels. This can be a function (such as [euros()]) or a text. For the text, `"%n"` will be replaced by the count number, and `"%p"` will be replaced by the percentage of the total count. Use `datalabels.format = NULL` to *not* transform the datalabels. -#' @param datalabels.colour,datalabels.colour_fill,datalabels.size,datalabels.angle,datalabels.lineheight settings for the datalabels -#' @param decimal.mark decimal mark, defaults to [dec_mark()] -#' @param big.mark thousands separator, defaults to [big_mark()] -#' @param summarise_function a [function] to use if the data has to be summarised, see *Examples*. This can also be `NULL`, which will be converted to `function(x) x`. -#' @param stacked a [logical] to indicate that values must be stacked -#' @param stackedpercent a [logical] to indicate that values must be 100% stacked -#' @param horizontal a [logical] to turn the plot 90 degrees using [`coord_flip()`][ggplot2::coord_flip()]. This option also updates some theme options, so that e.g., `x.lbl_italic` will still apply to the original x axis. -#' @param reverse a [logical] to reverse the *values* of `category`. Use `legend.reverse` to reverse the *legend* of `category`. -#' @param smooth a [logical] to add a smooth. In histograms, this will add the density count as an overlaying line (default: `TRUE`). In all other cases, a smooth will be added using [`geom_smooth()`][ggplot2::geom_smooth()] (default: `FALSE`). -#' @param smooth.method,smooth.formula,smooth.se,smooth.level,smooth.alpha,smooth.linewidth,smooth.linetype,smooth.colour settings for `smooth` -#' @param size size of the geom. Defaults to `2` for geoms [point][ggplot2::geom_point()] and [jitter][ggplot2::geom_jitter()], `5` for a dumbbell plots (using `type = "dumbbell"`), and to `0.75` otherwise. -#' @param linetype linetype of the geom, only suitable for geoms that draw lines. Defaults to 1. -#' @param linewidth linewidth of the geom, only suitable for geoms that draw lines. Defaults to: -#' - `0.5` for geoms that have no area (such as [line][ggplot2::geom_line()]), and for geoms [boxplot][ggplot2::geom_boxplot()]/[violin][ggplot2::geom_violin()] -#' - `0.1` for [sf][ggplot2::geom_sf()] -#' - `0.25` for geoms that are continous and have fills (such as [area][ggplot2::geom_area()]) -#' - `1.0` for dumbbell plots (using `type = "dumbbell"`) -#' - `0.5` otherwise (such as [histogram][ggplot2::geom_histogram()] and [area][ggplot2::geom_area()]) -#' @param binwidth width of bins (only useful for `geom = "histogram"`), can be specified as a numeric value or as a function that calculates width from `x`, see [`geom_histogram()`][ggplot2::geom_histogram()]. It defaults to approx. `diff(range(x))` divided by 12 to 22 based on the data. -#' @param width width of the geom. Defaults to `0.75` for geoms [boxplot][ggplot2::geom_boxplot()], [violin][ggplot2::geom_violin()] and [jitter][ggplot2::geom_jitter()], and to `0.5` otherwise. -#' @param jitter_seed seed (randomisation factor) to be set when using `type = "jitter"` -#' @param violin_scale scale to be set when using `type = "violin"`, can also be set to `"area"` -#' @param legend.position position of the legend, must be `"top"`, `"right"`, `"bottom"`, `"left"` or `"none"` (or `NA` or `NULL`), can be abbreviated. Defaults to `"right"` for numeric `category` values and 'sf' plots, and `"top"` otherwise. -#' @param legend.reverse,legend.barheight,legend.barwidth,legend.nbin,legend.italic other settings for the legend -#' @param sankey.node_width width of the vertical nodes in a Sankey plot (i.e., when `type = "sankey"`) -#' @param sankey.node_whitespace whitespace between the nodes -#' @param sankey.alpha alpha of the flows in a Sankey plot (i.e., when `type = "sankey"`) -#' @param sankey.remove_axes logical to indicate whether all axes must be removed in a Sankey plot (i.e., when `type = "sankey"`) -#' @param zoom a [logical] to indicate if the plot should be scaled to the data, i.e., not having the x and y axes to start at 0. This will set `x.zoom = TRUE` and `y.zoom = TRUE`. -#' @param sep separator character to use if multiple columns are given to either of the three directions: `x`, `category` and `facet`, e.g. `facet = c(column1, column2)` -#' @param print a [logical] to indicate if the result should be [printed][print()] instead of just returned -#' @param text_factor text factor to use, which will apply to all texts shown in the plot -#' @param font font (family) to use, can be set with `options(plot2.font = "...")`. Can be any installed system font or any of the > 1400 font names from [Google Fonts](https://fonts.google.com). -#' @param theme a valid `ggplot2` [theme][ggplot2::theme()] to apply, or `NULL` to use the default [`theme_grey()`][ggplot2::theme_grey()]. This argument accepts themes (e.g., `theme_bw()`), functions (e.g., `theme_bw`) and characters themes (e.g., `"theme_bw"`). The default is [theme_minimal2()], but can be set with `options(plot2.theme = "...")`. -#' @param background the background colour of the entire plot, can also be `NA` to remove it. Will be evaluated with [`colourpicker()`][certestyle::colourpicker()]. Only applies when `theme` is not `NULL`. -#' @param markdown a [logical] to turn all labels and titles into [plotmath] expressions, by converting common markdown language using the [md_to_expression()] function (defaults to `TRUE`) -#' @param ... any argument to give to the geom. This will override automatically-set settings for the geom. -#' @details The [plot2()] function is a convenient wrapper around many [`ggplot2`][ggplot2::ggplot()] functions such as [`ggplot()`][ggplot2::ggplot()], [`aes()`][ggplot2::aes()], [`geom_col()`][ggplot2::geom_col()], [`facet_wrap()`][ggplot2::facet_wrap()], [`labs()`][ggplot2::labs()], etc., and provides: -#' - Writing as few lines of codes as possible -#' - Easy plotting in three 'directions': `x` (the regular x axis), `category` (replaces 'fill' and 'colour') and `facet` -#' - Automatic setting of these 'directions' based on the input data -#' - Setting in-place calculations for all plotting directions and even `y` -#' - Easy way for sorting data in many ways (such as on alphabet, numeric value, frequency, original data order), by setting a single argument for the 'direction': `x.sort`, `category.sort` and `facet.sort` -#' - Easy limiting values, e.g. by setting `x.max_items = 5` or `category.max_items = 5` -#' - Markdown support for any title text, with any theme -#' - Integrated support for any Google Font and any installed system font -#' - An extra clean, minimalistic theme with a lot of whitespace (but without unnecessary margins) that is ideal for printing: `theme_minimal2()` -#' - Some conveniences from Microsoft Excel: -#' - The y axis starts at 0 if possible -#' - The y scale expands at the top to be better able to interpret all data points -#' - Date breaks can be written in a human-readable format (such as "d mmm yyyy") -#' - Labels with data values can easily be printed and are automatically determined -#' - Support for any `ggplot2` extension based on [ggplot2::fortify()] -#' -#' The `ggplot2` package in conjunction with the `tidyr`, `forcats` and `cleaner` packages can provide above functionalities, but the goal of the [plot2()] function is to generalise this into one function. The generic [plot2()] function currently has `r length(formals(plot2)) - 1` arguments, all with a default value. **Less typing, faster coding.** -#' @return a `ggplot` object -#' @importFrom ggplot2 ggplot labs -#' @export -#' @examples -#' options(plot2.colour = NULL, plot2.colour_sf_fill = NULL) -#' -#' head(iris) -#' -#' # no variables determined, so plot2() will try for itself - -#' # the type will be points since the first two variables are numeric -#' iris |> -#' plot2() -#' -#' # if x and y are set, no additional mapping will be set: -#' iris |> -#' plot2(Sepal.Width, Sepal.Length) -#' iris |> -#' plot2(Species, Sepal.Length) -#' -#' # the arguments are in this order: x, y, category, facet -#' iris |> -#' plot2(Sepal.Length, Sepal.Width, Petal.Length, Species) -#' -#' iris |> -#' plot2(Sepal.Length, Sepal.Width, Petal.Length, Species, -#' colour = "viridis") # set the viridis colours -#' -#' iris |> -#' plot2(Sepal.Length, Sepal.Width, Petal.Length, Species, -#' colour = c("white", "red", "black")) # set own colours -#' -#' # y can also be multiple (named) columns -#' iris |> -#' plot2(x = Sepal.Length, -#' y = c(Length = Petal.Length, Width = Petal.Width), -#' category.title = "Petal property") -#' iris |> -#' # with included selection helpers such as where(), starts_with(), etc.: -#' plot2(x = Species, y = where(is.double)) -#' -#' # support for secondary y axis -#' mtcars |> -#' plot2(x = mpg, -#' y = hp, -#' y_secondary = disp ^ 2, -#' y_secondary.scientific = TRUE, -#' title = "Secondary y axis sets colour to the axis titles") -#' -#' -#' admitted_patients -#' -#' # the arguments are in this order: x, y, category, facet -#' admitted_patients |> -#' plot2(hospital, age) -#' -#' admitted_patients |> -#' plot2(hospital, age, gender) -#' -#' admitted_patients |> -#' plot2(hospital, age, gender, ward) -#' -#' # or use any function for y -#' admitted_patients |> -#' plot2(hospital, median(age), gender, ward) -#' admitted_patients |> -#' plot2(hospital, n(), gender, ward) -#' -#' admitted_patients |> -#' plot2(x = hospital, -#' y = age, -#' category = gender, -#' colour = c("F" = "#3F681C", "M" = "#375E97"), -#' colour_fill = "#FFBB00AA", -#' linewidth = 1.25, -#' y.age = TRUE) -#' -#' admitted_patients |> -#' plot2(age, type = "hist") -#' -#' # even titles support calculations, including support for {glue} -#' admitted_patients |> -#' plot2(age, type = "hist", -#' title = paste("Based on n =", n_distinct(patient_id), "patients"), -#' subtitle = paste("Total rows:", n()), -#' caption = glue::glue("From {n_distinct(hospital)} hospitals"), -#' x.title = paste("Age ranging from", paste(range(age), collapse = " to "))) -#' -#' # the default type is column, datalabels are automatically -#' # set in non-continuous types: -#' admitted_patients |> -#' plot2(hospital, n(), gender) -#' -#' admitted_patients |> -#' plot2(hospital, n(), gender, -#' stacked = TRUE) -#' -#' admitted_patients |> -#' plot2(hospital, n(), gender, -#' stackedpercent = TRUE) -#' -#' # two categories might benefit from a dumbbell plot: -#' admitted_patients |> -#' plot2(hospital, median(age), gender, type = "dumbbell") -#' -#' # sort on any direction: -#' admitted_patients |> -#' plot2(hospital, n(), gender, -#' x.sort = "freq-asc", -#' stacked = TRUE) -#' -#' admitted_patients |> -#' plot2(hospital, n(), gender, -#' x.sort = c("B", "D", "A"), # missing values ("C") will be added -#' category.sort = "alpha-desc", -#' stacked = TRUE) -#' -#' # support for Sankey plots -#' Titanic |> # a table from base R -#' plot2(x = c(Age, Class, Survived), -#' category = Sex, -#' type = "sankey") -#' -#' # matrix support, such as for cor() -#' correlation_matrix <- cor(mtcars) -#' class(correlation_matrix) -#' head(correlation_matrix) -#' correlation_matrix |> -#' plot2() -#' -#' correlation_matrix |> -#' plot2(colour = c("certeblauw2", "white", "certeroze2"), -#' datalabels = TRUE, -#' category.title = "*r*-value", -#' title = "Correlation matrix") -#' -#' -#' # plot2() supports all S3 extensions available through -#' # ggplot2::fortify(), such as regression models: -#' lm(mpg ~ hp, data = mtcars) |> -#' plot2(x = mpg ^ -3, -#' y = hp ^ 2, -#' smooth = TRUE, -#' smooth.method = "lm", -#' smooth.formula = "y ~ log(x)", -#' title = "Titles/captions *support* **markdown**", -#' subtitle = "Axis titles contain the square notation: x^2") -#' -#' # plot2() also has various other S3 implementations: -#' -#' # QC plots, according to e.g. Nelson's Quality Control Rules -#' if (require("certestats", warn.conflicts = FALSE)) { -#' rnorm(250, mean = 10, sd = 1) |> -#' qc_test() |> -#' plot2() -#' } -#' -#' # sf objects (geographic plots, 'simple features') are also supported -#' if (require("sf")) { -#' netherlands |> -#' plot2(datalabels = paste0(province, "\n", round(area_km2))) -#' } -#' -#' # Antimicrobial resistance (AMR) data analysis -#' if (require("AMR")) { -#' options(AMR_locale = "nl") -#' -#' example_isolates[, c("mo", penicillins())] |> -#' bug_drug_combinations(FUN = mo_gramstain) |> -#' plot2(y.percent_break = 0.25) -#' } -#' if (require("AMR") & require("dplyr")) { -#' example_isolates |> -#' select(date, NIT, FOS, AMC) |> -#' group_by(year = format(date, "%Y")) |> -#' sir_df() |> -#' filter(year >= 2015) |> -#' plot2(datalabels = paste0(round(value * 100), "%\nn = ", isolates), -#' y.percent_break = 0.125) -#' } -#' -#' # # support for any font -#' # mtcars |> -#' # plot2(mpg, hp, font = "Rock Salt", -#' # title = "This plot uses a Google Font") -plot2 <- function(.data, - x = NULL, - y = NULL, - category = NULL, - facet = NULL, - type = NULL, - x.title = TRUE, - y.title = TRUE, - category.title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - tag = NULL, - title.linelength = 60, - title.colour = getOption("plot2.colour_font_primary", "black"), - subtitle.linelength = 60, - subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), - na.replace = "", - na.rm = FALSE, - facet.position = "top", - facet.fill = NULL, - facet.bold = TRUE, - facet.italic = FALSE, - facet.size = 10, - facet.margin = 8, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = TRUE, - facet.fixed_y = NULL, - facet.fixed_x = TRUE, - facet.drop = FALSE, - facet.nrow = NULL, - facet.relative = FALSE, - x.date_breaks = NULL, - x.date_labels = NULL, - x.date_remove_years = NULL, - category.focus = NULL, - colour = getOption("plot2.colour", "ggplot2"), - colour_fill = NULL, - colour_opacity = 0, - x.lbl_angle = 0, - x.lbl_align = NULL, - x.lbl_italic = FALSE, - x.lbl_taxonomy = FALSE, - x.remove = FALSE, - x.position = "bottom", - x.max_items = Inf, - x.max_txt = "(rest, x%n)", - category.max_items = Inf, - category.max_txt = "(rest, x%n)", - facet.max_items = Inf, - facet.max_txt = "(rest, x%n)", - x.breaks = NULL, - x.n_breaks = NULL, - x.transform = "identity", - x.expand = NULL, - x.limits = NULL, - x.labels = NULL, - x.character = NULL, - x.drop = FALSE, - x.mic = FALSE, - x.zoom = FALSE, - y.remove = FALSE, - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - y.breaks = NULL, - y.n_breaks = NULL, - y.limits = NULL, - y.labels = NULL, - y.expand = NULL, - y.transform = "identity", - y.position = "left", - y.zoom = FALSE, - y_secondary = NULL, - y_secondary.type = type, - y_secondary.title = TRUE, - y_secondary.colour = colour, - y_secondary.colour_fill = colour_fill, - y_secondary.scientific = NULL, - y_secondary.percent = FALSE, - y_secondary.labels = NULL, - category.labels = NULL, - category.percent = FALSE, - category.breaks = NULL, - category.limits = NULL, - category.expand = 0, - category.midpoint = NULL, - category.transform = "identity", - category.date_breaks = NULL, - category.date_labels = NULL, - category.character = NULL, - x.sort = NULL, - category.sort = TRUE, - facet.sort = TRUE, - x.complete = NULL, - category.complete = NULL, - facet.complete = NULL, - datalabels = TRUE, - datalabels.round = ifelse(y.percent, 2, 1), - datalabels.format = "%n", - datalabels.colour = "grey25", - datalabels.colour_fill = NULL, - datalabels.size = (3 * text_factor), - datalabels.angle = 0, - datalabels.lineheight = 1.0, - decimal.mark = dec_mark(), - big.mark = big_mark(), - summarise_function = base::sum, - stacked = FALSE, - stackedpercent = FALSE, - horizontal = FALSE, - reverse = horizontal, - smooth = NULL, - smooth.method = NULL, - smooth.formula = NULL, - smooth.se = TRUE, - smooth.level = 0.95, - smooth.alpha = 0.25, - smooth.linewidth = 0.75, - smooth.linetype = 3, - smooth.colour = NULL, - size = NULL, - linetype = 1, - linewidth = NULL, - binwidth = NULL, - width = NULL, - jitter_seed = NA, - violin_scale = "count", - legend.position = NULL, - legend.title = NULL, # will become TRUE in numeric categories if left NULL - legend.reverse = FALSE, - legend.barheight = 6, - legend.barwidth = 1.5, - legend.nbin = 300, - legend.italic = FALSE, - sankey.node_width = 0.15, - sankey.node_whitespace = 0.03, - sankey.alpha = 0.5, - sankey.remove_axes = NULL, - zoom = FALSE, - sep = " / ", - print = FALSE, - text_factor = 1, - font = getOption("plot2.font"), - theme = getOption("plot2.theme", "theme_minimal2"), - background = getOption("plot2.colour_background", "white"), - markdown = TRUE, - ...) { - - # no observations, return empty plot immediately - if (NROW(.data) == 0) { - # check if markdown is required - markdown <- validate_markdown(markdown, x.title, y.title, c(category.title, legend.title), title, subtitle, tag, caption) - plot2_warning("No observations, returning an empty plot") - p <- ggplot() + - validate_theme(theme = theme, - type = "", - background = background, - text_factor = text_factor, - font = font, - horizontal = horizontal, - x.remove = x.remove, - y.remove = y.remove, - x.lbl_angle = x.lbl_angle, - x.lbl_align = x.lbl_align, - x.lbl_italic = x.lbl_italic, - facet.fill = facet.fill, - facet.bold = facet.bold, - facet.italic = facet.italic, - facet.size = facet.size, - facet.margin = facet.margin, - legend.italic = legend.italic, - sankey.remove_axes = sankey.remove_axes, - title.colour = title.colour, - subtitle.colour = subtitle.colour, - has_y_secondary = FALSE, - col_y_primary = NULL, - col_y_secondary = NULL) - if (!missing(x.title)) p <- p + labs(x = validate_title(x.title, markdown = markdown)) - if (!missing(y.title)) p <- p + labs(y = validate_title(y.title, markdown = markdown)) - if (!missing(title)) p <- p + labs(title = validate_title(title, markdown = markdown, max_length = title.linelength)) - if (!missing(subtitle)) p <- p + labs(subtitle = validate_title(subtitle, markdown = markdown, max_length = subtitle.linelength)) - if (!missing(tag)) p <- p + labs(tag = validate_title(tag, markdown = markdown)) - if (!missing(caption)) p <- p + labs(caption = validate_title(caption, markdown = markdown)) - if (isTRUE(print)) { - print(p) - return(invisible()) - } else { - return(p) - } - } - - if (tryCatch(!inherits(.data, "sf") && - ((isTRUE("geometry" %in% colnames(.data)) && suppressWarnings(inherits(.data$geometry, "sfc"))) - || isTRUE(attributes(.data)$sf_column %in% colnames(.data))) && - "sf" %in% rownames(utils::installed.packages()), - error = function(e) FALSE)) { - # force calling plot2.sf() and its arguments, data will be transformed in that function: - UseMethod("plot2", object = structure(data.frame(), class = "sf")) - } else { - UseMethod("plot2") - } -} - -#' @importFrom dplyr mutate vars group_by across summarise select bind_cols filter as_tibble -#' @importFrom forcats fct_relabel -#' @importFrom ggplot2 ggplot aes labs stat_boxplot scale_colour_manual scale_fill_manual coord_flip geom_smooth geom_density guides guide_legend scale_x_discrete waiver ggplot_build after_stat scale_fill_continuous scale_fill_date scale_fill_datetime scale_fill_continuous scale_colour_date scale_colour_datetime scale_colour_continuous geom_segment -#' @importFrom tidyr pivot_longer -#' @importFrom certestyle format2 font_magenta font_black font_blue -#' @importFrom ggforce geom_parallel_sets geom_parallel_sets_axes geom_parallel_sets_labels -plot2_exec <- function(.data, - x, - y, - category, - facet, - type, - x.title, - y.title, - category.title, - title, - subtitle, - caption, - tag, - title.linelength, - title.colour, - subtitle.linelength, - subtitle.colour, - na.replace, - na.rm, - facet.position, - facet.fill, - facet.bold, - facet.italic, - facet.size, - facet.margin, - facet.repeat_lbls_x, - facet.repeat_lbls_y, - facet.fixed_y, - facet.fixed_x, - facet.drop, - facet.nrow, - facet.relative, - x.date_breaks, - x.date_labels, - x.date_remove_years, - category.focus, - colour, - colour_fill, - colour_opacity, - x.lbl_angle, - x.lbl_align, - x.lbl_italic, - x.lbl_taxonomy, - x.remove, - x.position, - x.max_items, - x.max_txt, - category.max_items, - category.max_txt, - facet.max_items, - facet.max_txt, - x.breaks, - x.n_breaks, - x.transform, - x.expand, - x.limits, - x.labels, - x.character, - x.drop, - x.mic, - x.zoom, - y.remove, - y.24h, - y.age, - y.scientific, - y.percent, - y.percent_break, - y.breaks, - y.n_breaks, - y.limits, - y.labels, - y.expand, - y.transform, - y.position, - y.zoom, - y_secondary, - y_secondary.type, - y_secondary.title, - y_secondary.colour, - y_secondary.colour_fill, - y_secondary.scientific, - y_secondary.percent, - y_secondary.labels, - category.labels, - category.percent, - category.breaks, - category.limits, - category.expand, - category.midpoint, - category.transform, - category.date_breaks, - category.date_labels, - category.character, - x.sort, - category.sort, - facet.sort, - x.complete, - category.complete, - facet.complete, - datalabels, - datalabels.round, - datalabels.colour, - datalabels.format, - datalabels.colour_fill, - datalabels.size, - datalabels.angle, - datalabels.lineheight, - decimal.mark, - big.mark, - summarise_function, - stacked, - stackedpercent, - horizontal, - reverse, - smooth, - smooth.method, - smooth.formula, - smooth.se, - smooth.level, - smooth.alpha, - smooth.linewidth, - smooth.linetype, - smooth.colour, - size, - linetype, - linewidth, - binwidth, - width, - jitter_seed, - violin_scale, - legend.position, - legend.title, - legend.reverse, - legend.barheight, - legend.barwidth, - legend.nbin, - legend.italic, - sankey.node_width, - sankey.node_whitespace, - sankey.alpha, - sankey.remove_axes, - zoom, - sep, - print, - text_factor, - font, - theme, - background, - markdown, - ...) { - - dots <- list(...) - dots_geom <- dots[names(dots) %unlike% "^_(label[.]|misses[.]|sf.column|summarise_fn_name|datalabels.centroid)"] - if (length(dots_geom) > 0) { - plot2_message(ifelse(length(dots_geom) == 1, - "This additional argument is given to the geom: ", - "These additional arguments are given to the geom: "), - paste0(font_blue(names(dots_geom), collapse = NULL), collapse = font_black(", "))) - } - - # record missing arguments ---- - misses_x <- isTRUE(dots$`_misses.x`) - misses_y <- isTRUE(dots$`_misses.y`) - misses_category <- isTRUE(dots$`_misses.category`) - misses_facet <- isTRUE(dots$`_misses.facet`) - misses_datalabels <- isTRUE(dots$`_misses.datalabels`) - misses_colour_fill <- isTRUE(dots$`_misses.colour_fill`) - misses_x.title <- isTRUE(dots$`_misses.x.title`) - misses_y.title <- isTRUE(dots$`_misses.y.title`) - misses_title <- isTRUE(dots$`_misses.title`) - misses_subtitle <- isTRUE(dots$`_misses.subtitle`) - misses_tag <- isTRUE(dots$`_misses.tag`) - misses_caption <- isTRUE(dots$`_misses.caption`) - misses_x.zoom <- isTRUE(dots$`_misses.x.zoom`) - misses_x.max_items <- isTRUE(dots$`_misses.x.max_items`) - misses_y.percent <- isTRUE(dots$`_misses.y.percent`) - misses_y.percent_break <- isTRUE(dots$`_misses.y.percent_break`) - misses_facet.fixed_x <- isTRUE(dots$`_misses.facet.fixed_x`) - misses_summarise_function <- isTRUE(dots$`_misses.summarise_function`) - - if (!misses_facet.fixed_x) { - x.drop <- !isTRUE(facet.fixed_x) - } - - # pre-validate types and set type shortcuts ---- - if (!is_empty(type) && !is.character(type)) { - stop("'type' must be a character", call. = FALSE) - } - if (!is.null(type)) { - type <- tolower(type[1L]) - type_backup <- type - if (type %like% "^(barpercent|bp)$") { - type_backup <- "barpercent" - if (misses_x.max_items) { - x.max_items <- 10 # instead of the default Inf - } - x.sort <- "freq-desc" - datalabels.format <- "%n (%p)" - type <- "col" - horizontal <- TRUE - } - if (type %like% "^(line.*dot|line.*point|dot.*line|point.*line|ld|lp|dl|pl)s?$") { - # set line for here, dots will be added in the end - type_backup <- "linedot" - type <- "line" - } - if (type %like% "^(dumbb?ell?|d|db)$") { - # set point for here, segments will be added in the end - type_backup <- "dumbbell" - type <- "point" - horizontal <- TRUE - } - if (type %like% "^(sankey|s)$") { - type <- "line" # this is to give the flows the right colour; a continuous geom without a fill - type_backup <- "sankey" - datalabels <- FALSE - if (is.null(x.expand)) { - x.expand <- c(0.05, 0.05) - } - if (is.null(y.limits)) { - y.limits <- c(NA, NA) - } - if (is.null(y.expand)) { - y.expand <- c(0.01, 0.01) - } - x.title = "" - } - if (type %like% "bar") { - type <- "col" - horizontal <- TRUE - } - } else { - type_backup <- "" - } - - set_plot2_env(x = dots$`_label.x`, - y = dots$`_label.y`, - category = dots$`_label.category`, - facet = dots$`_label.facet`, - y_secondary = dots$`_label.y_secondary`, - x_variable_names = tryCatch(.data |> select({{ x }}) |> colnames(), error = function(e) NULL)) - on.exit(clean_plot2_env()) - - # get titles based on raw data ---- - # compute contents of title arguments - title <- validate_title({{ title }}, markdown = isTRUE(markdown), df = .data, max_length = title.linelength) - subtitle <- validate_title({{ subtitle }}, markdown = isTRUE(markdown), df = .data, max_length = subtitle.linelength) - caption <- validate_title({{ caption }}, markdown = isTRUE(markdown), df = .data) - tag <- validate_title({{ tag }}, markdown = isTRUE(markdown), df = .data) - x.title <- validate_title({{ x.title }}, markdown = isTRUE(markdown), df = .data) - y.title <- validate_title({{ y.title }}, markdown = isTRUE(markdown), df = .data) - legend.title <- validate_title({{ legend.title }}, markdown = isTRUE(markdown), df = .data) - category.title <- validate_title({{ category.title }}, markdown = isTRUE(markdown), df = .data) - # category.title and legend.title both exist for convenience - legend.title <- if (is.null(category.title)) legend.title else category.title - if (tryCatch(!is.null(y_secondary), error = function(e) TRUE)) { - y_secondary.title <- validate_title({{ y_secondary.title }}, markdown = isTRUE(markdown), df = .data) - } - - if (is.null(summarise_function)) { - summarise_function <- function(x) x - dots$`_summarise_fn_name` <- "function(x) x" - } else if (!is.function(summarise_function)) { - stop("'summarise_function' must be a function") - } - dots$`_summarise_fn_name` <- gsub("^base::", "", dots$`_summarise_fn_name`) - - if (decimal.mark == big.mark) { - big.mark <- " " - } - - # prepare data ---- - # IMPORTANT: in this part, the data for mapping will be generated anonymously, e.g. as `_var_x` and `_var_category`; - # this is done for convenience - this is restored before returning the `ggplot` object in the end - df <- .data |> - # add the three directions, these functions also support tidyverse selections: `facet = where(is.character)` - add_direction(direction = {{ x }}, - var_name = "x", - var_label = dots$`_label.x`, - sep = sep) |> - add_direction(direction = {{ category }}, - var_name = "category", - var_label = dots$`_label.category`, - sep = sep) |> - add_direction(direction = {{ facet }}, - var_name = "facet", - var_label = dots$`_label.facet`, - sep = sep) |> - # add y (this will end in an ungrouped data.frame) - { function(.data) { - suppressWarnings( - y_select <- tryCatch((.data |> - # no tibbles, data.tables, sf, etc. objects: - as.data.frame(stringsAsFactors = FALSE) |> - select({{ y }})), - error = function(e) FALSE) - ) - - has_multiple_cols <- is.data.frame(y_select) && ncol(y_select) > 1 - if (isTRUE(has_multiple_cols)) { - # e.g. for: df |> plot2(y = c(var1, var2)) - if (has_category(.data)) { - # check if category was not already set - stop("if 'y' contains more than one variable, 'category' must not be set", call. = FALSE) - } - - if (isTRUE(misses_summarise_function)) { - summarise_function <<- function(x) x - dots$`_summarise_fn_name` <<- "function(x) x" - misses_summarise_function <<- FALSE - plot2_message("Assuming ", font_blue(paste0("summarise_function = ", dots$`_summarise_fn_name`))) - } - - new_df <- .data |> - # no tibbles, data.tables, sf, etc. objects: - as.data.frame(stringsAsFactors = FALSE) |> - bind_cols(y_select[, colnames(y_select)[which(!colnames(y_select) %in% colnames(.data))], drop = FALSE]) |> - pivot_longer(c(colnames(y_select), -matches("^_var_"), -get_x_name(.data)), names_to = "_var_category", values_to = "_var_y") |> - # apply summarise_function - group_by(across(c(plot2_env$x_variable_names, get_x_name(.data), get_category_name(.data), get_facet_name(.data), - matches("_var_(x|category|facet)")))) |> - summarise(`_var_y` = summarise_function(`_var_y`), - .groups = "drop") |> - mutate(y = `_var_y`, - category = `_var_category`) - - if (!dots$`_summarise_fn_name` %in% c("NULL", "function(x) x")) { - plot2_message("Summarising values using ", - font_blue(paste0("summarise_function = ", dots$`_summarise_fn_name`)), - ifelse(isTRUE(misses_summarise_function), - paste0(" (use ", font_blue("summarise_function = NULL"), font_black(" to prevent this)")), - "")) - } - - if (!any(plot2_env$mapping_y %like% new_df$category)) { - plot2_message("Using ", font_blue("y = c(", paste(unique(new_df$category), collapse = ", "), ")", collapse = NULL)) - } - plot2_env$mapping_y <- "y" - plot2_env$mapping_category <- "category" - if (is.null(y.title) || isTRUE(y.title)) { - # we just fabricated an y value, so remove the title if it says nothing (double arrow since we're in if()): - y.title <<- NULL - } - # return the data - new_df - } else { - - suppressWarnings( - tryCatch(y_precalc <- .data |> - # no tibbles, data.tables, sf, etc. objects: - as.data.frame(stringsAsFactors = FALSE) |> - summarise(val = {{ y }}), - error = function(e) stop(format_error(e), call. = FALSE)) - ) - y_precalc <- y_precalc$val # will be NULL if y is missing - - if (isTRUE(length(y_precalc) == 1)) { - # outcome of y is a single calculated value (by using e.g. mean(...) or n_distinct(...)), - # so calculate it over all groups that are available - # this will support e.g. `data |> plot2(y = n_distinct(id))` - suppressWarnings( - tryCatch(.data |> - group_by(across(c(plot2_env$x_variable_names, get_x_name(.data), get_category_name(.data), get_facet_name(.data), - matches("_var_(x|category|facet)")))) |> - summarise(`_var_y` = {{ y }}, - .groups = "drop"), - error = function(e) stop(format_error(e, replace = "_var_y", by = "y"), call. = FALSE)) - ) - - } else if (!has_category(.data) && - !is.null(y_precalc) && - length(y_precalc) != NROW(.data)) { - # outcome of y is a multi-length calculated value (by using e.g. range(...)), - # so calculate it over all groups that are available and add a category - # this will support e.g. `data |> plot2(y = range(age))` - if (is.null(category.labels)) { - plot2_caution("Categories were auto-generated since ", font_blue("y"), " is a vector - use ", font_blue("category.labels"), " to manually name them.") - } - plot2_env$mapping_category <- "category" - # take the first call or function from what was given to y - y_call <- as.character(str2lang(plot2_env$mapping_y))[1] - suppressWarnings( - tryCatch(.data |> - group_by(across(c(get_x_name(.data), get_facet_name(.data), - matches("_var_(x|facet)")))) |> - summarise(`_var_y` = {{ y }}, - `_var_category` = paste0(y_call, " (", seq_len(length(y_precalc)), ")"), - .groups = "drop"), - error = function(e) stop(format_error(e, replace = "_var_y", by = "y"), call. = FALSE)) - ) - - } else { - # don't recalculate, just add the calculated values to save time - # don't do as.data.frame() here - sf plots will lose their structure - suppressWarnings( - tryCatch(.data |> - mutate(`_var_y` = y_precalc), - error = function(e) stop(format_error(e, replace = "_var_y", by = "y"), call. = FALSE)) - ) - } - } - }}() |> - mutate(`_var_y_secondary` = {{ y_secondary }}) |> - mutate(`_var_datalabels` = {{ datalabels }}) |> - # this part will transform the data as needed - validate_data(misses_x = misses_x, - misses_category = misses_category, - decimal.mark = decimal.mark, - big.mark = big.mark, - y.percent = y.percent, - type = type, - type_backup = type_backup, - datalabels.round = datalabels.round, - datalabels.format = datalabels.format, - x.sort = x.sort, - category.sort = category.sort, - facet.sort = facet.sort, - x.complete = x.complete, - category.complete = category.complete, - facet.complete = facet.complete, - summarise_function = summarise_function, - summarise_fn_name = dots$`_summarise_fn_name`, - misses_summarise_function = misses_summarise_function, - horizontal = horizontal, - x.max_items = x.max_items, - x.max_txt = x.max_txt, - x.character = x.character, - x.drop = x.drop, - x.mic = x.mic, - x.date_remove_years = x.date_remove_years, - category.max_items = category.max_items, - category.max_txt = category.max_txt, - category.character = category.character, - facet.max_items = facet.max_items, - facet.max_txt = facet.max_txt, - na.rm = na.rm, - na.replace = na.replace, - ...) - - # apply taxonomic italics ---- - if (isTRUE(x.lbl_taxonomy) && isTRUE(markdown) && isTRUE("AMR" %in% rownames(utils::installed.packages()))) { - df <- validate_taxonomy(df) - if (all(get_x(df) %like% "^paste\\(")) { - # so x has taxonomic values - if (!is.null(x.labels)) { - plot2_warning("Ignoring ", font_blue("x.labels"), " since ", font_blue("x.lbl_taxonomy = TRUE")) - } - x.labels <- function(l) parse(text = l) - } - } - - # validate type ---- - type <- validate_type(type = type, df = df) # this will automatically determine the type if is.null(type) - if (geom_is_line_or_area(type) && type_backup != "linedot" && !is.null(size)) { - plot2_warning("'size' has been replaced with 'linewidth' for line/area types, assuming ", font_blue("linewidth = ", size, collapse = NULL)) - linewidth <- size - } - if (has_y_secondary(df)) { - y_secondary.type <- suppressMessages(validate_type(type = y_secondary.type, df = df)) - } - # transform data if not a continuous geom but group sizes are > 1 - if (any(group_sizes(df) > 1) && !geom_is_continuous(type) && type_backup != "sankey") { - if (identical(type_backup, "barpercent")) { - plot2_message("Summarising values for ", font_blue("type = \"barpercent\""), " using ", - font_blue(paste0("summarise_function = ", dots$`_summarise_fn_name`))) - } - df <- summarise_data(df = df, - summarise_function = summarise_function, - decimal.mark = decimal.mark, - big.mark = big.mark, - datalabels.round = datalabels.round, - datalabels.format = datalabels.format, - y.percent = y.percent) - } - - # various cleaning steps ---- - - if (isTRUE(zoom)) { - x.zoom <- TRUE - y.zoom <- TRUE - if (is.null(x.expand)) { - x.expand <- c(0.15, 0.15) - } - if (is.null(y.expand)) { - y.expand <- c(0.15, 0.15) - } - } - - # check if markdown is required - markdown <- validate_markdown(markdown, x.title, y.title, legend.title, title, subtitle, tag, caption, df) - - # remove datalabels in continuous geoms - if (has_datalabels(df) && isTRUE(misses_datalabels) && - (geom_is_continuous(type) | type %like% "path|line") && - !type %in% c("geom_sf", "geom_tile", "geom_raster", "geom_rect")) { - df <- df |> select(-`_var_datalabels`) - } - if (!isTRUE(misses_y) && geom_is_continuous_x(type)) { - plot2_message("Ignoring ", font_blue("y"), " for plot type ", font_blue(gsub("geom_", "", type))) - df$`_var_y` <- df$`_var_x` - } - - # remove x from sf geom - if (type == "geom_sf") { - df <- df |> select(-`_var_x`) - } - - # check requirements for Sankey plots - if (type_backup == "sankey") { - if (isTRUE(misses_x) || (.data |> select({{ x }}) |> NCOL()) < 2 ) { - stop("Sankey plots require an x axis of at least two variables", call. = FALSE) - } - if (!has_y(df)) { - stop("Sankey plots require `y`", call. = FALSE) - } - if (!has_category(df)) { - stop("Sankey plots require `category`, as that will indicate the flows", call. = FALSE) - } - } - - # keep only one of `stacked` and `stackedpercent` - if (isTRUE(stacked) && isTRUE(stackedpercent)) { - plot2_warning("Ignoring ", font_blue("stacked = TRUE"), ", since ", font_blue("stackedpercent = TRUE")) - stacked <- FALSE - } - - # set default size and width ---- - size <- validate_size(size = size, type = type, type_backup = type_backup) - width <- validate_width(width = width, type = type) - linewidth <- validate_linewidth(linewidth = linewidth, type = type, type_backup = type_backup) - - # generate colour vectors ---- - # keep original ggplot2 colours if they have not been set - if (type == "geom_sf") { - original_colours <- identical(colour_fill, "ggplot2") || is.null(colour_fill) - } else { - original_colours <- (is.null(colour) || identical(colour, "ggplot2")) && - (identical(colour_fill, "ggplot2") || (is.null(colour_fill) && (is.null(colour) || identical(colour, "ggplot2")))) - } - - if (has_category(df) && !is.null(category.focus)) { - category.focus <- category.focus[1L] - # check if value is actually in category - if (!category.focus %in% get_category(df) && !is.numeric(category.focus)) { - plot2_warning("Value \"", category.focus, "\" not found in ", font_blue("category")) - } else { - category_unique <- sort(unique(get_category(df))) - if (is.numeric(category.focus)) { - # support `category.focus = 3` to choose the third value - category.focus <- category_unique[category.focus] - } - cols <- rep(as.character(colourpicker("grey85")), length(category_unique)) - nms <- as.character(category_unique) - cols[which(nms == category.focus)] <- colourpicker(colour[1L]) - colour <- stats::setNames(cols, nms) - } - } - if (has_y_secondary(df)) { - y_secondary.colour <- colourpicker(y_secondary.colour)[1L] - y_secondary.colour_fill <- colourpicker(y_secondary.colour_fill)[1L] - } - # Note that this will be not be used if colour == "ggplot2" or colour_fill == "ggplot2" - cols <- validate_colour(df = df, - type = type, - type_backup = type_backup, - colour = colour, - colour_fill = colour_fill, - colour_opacity = colour_opacity, - misses_colour_fill = misses_colour_fill, - horizontal = horizontal) - - # generate mapping / aesthetics ---- - # IMPORTANT: in this part, the mapping will be generated anonymously, e.g. as `_var_x` and `_var_category`; - # this is done for convenience - this is restored before returning the `ggplot` object in the end - if (type != "geom_sf" && !geom_is_continuous_x(type)) { - # histograms etc. have a continuous x variable, so only set y if not a histogram-like - mapping <- aes(y = `_var_y`, group = 1) - } else { - mapping <- aes() - if (misses_x.zoom) { - # this also sets x.limits to c(NA, NA) for histograms in validate_x_scale() - x.zoom <- TRUE - x.expand <- 0 - } - } - if (has_x(df)) { - mapping <- utils::modifyList(mapping, aes(x = `_var_x`, - group = `_var_x`)) - } - if (has_category(df)) { - mapping <- utils::modifyList(mapping, aes(fill = `_var_category`, - colour = `_var_category`, - group = `_var_category`)) - if (type == "geom_sf") { - # no colour in sf's - mapping <- utils::modifyList(mapping, aes(colour = NULL)) - # # and set sf column - # mapping <- update_aes(mapping, geometry = dots$`_sf.column`) - } - } - if (geom_is_continuous(type) && !geom_is_line_or_area(type) && has_category(df)) { - # remove the group from the mapping - mapping <- utils::modifyList(mapping, aes(group = NULL)) - } - if ((geom_is_line_or_area(type) || geom_is_continuous_x(type) || geom_has_only_colour(type)) && !has_category(df)) { - # exception for line plots without colour/fill, force group = 1 - mapping <- utils::modifyList(mapping, aes(group = 1)) - } - # manual setting for Sankey plots - if (type_backup == "sankey") { - mapping <- aes(x = `_sankey_x`, - id = `_sankey_id`, - split = `_sankey_split`, - value = `_var_y`) - } - - # generate ggplot ---- - if (isTRUE(original_colours)) { - p <- ggplot(data = df, mapping = mapping) - } else { - p <- ggplot(data = df, mapping = mapping, colour = cols$colour, fill = cols$colour_fill) - } - - # generate geom ---- - if (type == "geom_boxplot") { - # first add the whiskers, the actual boxplot will be added with `generate_geom()` below - if (isTRUE(original_colours)) { - p <- p + - stat_boxplot(geom = "errorbar", - coef = 1.5, # 1.5 * IQR - width = width * ifelse(has_category(df), 1, 0.75), - linewidth = linewidth) - } else { - p <- p + - stat_boxplot(geom = "errorbar", - coef = 1.5, # 1.5 * IQR - width = width * ifelse(has_category(df), 1, 0.75), - linewidth = linewidth, - colour = cols$colour) - } - } - if (type_backup == "sankey") { - p <- p + - geom_parallel_sets(aes(fill = `_var_category`), - alpha = sankey.alpha, - # whitespace between nodes - sep = sankey.node_whitespace, - # width for flows, i.e., category - axis.width = sankey.node_width) + - geom_parallel_sets_axes(fill = colourpicker(datalabels.colour_fill[1]), - colour = colourpicker(datalabels.colour[1]), - # whitespace between nodes - sep = sankey.node_whitespace, - # width of nodes - axis.width = sankey.node_width) + - geom_parallel_sets_labels(colour = colourpicker(datalabels.colour[1]), - size = datalabels.size, - # whitespace between labels in nodes - sep = sankey.node_whitespace, - angle = ifelse(isTRUE(horizontal), 0, -90)) - if (is.null(sankey.remove_axes)) { - # make the default TRUE, but give message so users will know which argument to set - sankey.remove_axes <- TRUE - plot2_message("Assuming ", font_blue("sankey.remove_axes = TRUE")) - } - } else { - p <- p + - generate_geom(type = type, - df = df, - stacked = stacked, - stackedpercent = stackedpercent, - horizontal = horizontal, - width = width, - size = size, - linetype = linetype, - linewidth = linewidth, - reverse = reverse, - na.rm = na.rm, - violin_scale = violin_scale, - jitter_seed = jitter_seed, - binwidth = binwidth, - cols = cols, - original_colours = original_colours, - dots_geom = dots_geom) - - # add secondary y axis if available - if (has_y_secondary(df)) { - if (y_secondary.type == "geom_boxplot") { - # first add the whiskers - p <- p + - stat_boxplot(geom = "errorbar", - mapping = utils::modifyList(mapping, aes(y = `_var_y_secondary`)), - coef = 1.5, # 1.5 * IQR - width = width * ifelse(has_category(df), 1, 0.75), - lwd = size, - colour = y_secondary.colour) - } - p <- p + - generate_geom(type = y_secondary.type, - df = df, - stacked = stacked, - stackedpercent = stackedpercent, - horizontal = horizontal, - width = width, - size = size, - linetype = linetype, - linewidth = linewidth, - reverse = reverse, - na.rm = na.rm, - violin_scale = violin_scale, - jitter_seed = jitter_seed, - binwidth = binwidth, - cols = list(colour = y_secondary.colour, - colour_fill = y_secondary.colour_fill), - original_colours = original_colours, - dots_geom = dots_geom, - mapping = utils::modifyList(mapping, aes(y = `_var_y_secondary`))) - } - } - - if (is.null(smooth) && type == "geom_histogram") { - plot2_message("Assuming ", font_blue("smooth = TRUE"), " for ", font_blue("type = \"histogram\"")) - smooth <- TRUE - } - if (isTRUE(smooth)) { - if (is.null(smooth.colour)) { - smooth.colour <- cols$colour[1L] - has_smooth.colour <- FALSE - } else { - smooth.colour <- colourpicker(smooth.colour) - has_smooth.colour <- TRUE - } - if (type == "geom_histogram") { - # add a density count - set_binwidth <- p$layers[[1]]$stat_params$binwidth - p <- p + - do.call(geom_density, - c(list(mapping = aes(y = after_stat(count) * set_binwidth), - alpha = smooth.alpha, - linetype = smooth.linetype, - linewidth = smooth.linewidth, - na.rm = na.rm), - list(colour = smooth.colour)[(!has_category(df) | has_smooth.colour) & !isTRUE(original_colours)])) - } else { - # add smooth with geom_smooth() - p <- p + - do.call(geom_smooth, - c(list(mapping = utils::modifyList(mapping, aes(group = 1)), - formula = smooth.formula, - se = smooth.se, - method = smooth.method, - level = smooth.level, - alpha = smooth.alpha, - linetype = smooth.linetype, - linewidth = smooth.linewidth, - na.rm = na.rm), - list(colour = smooth.colour)[(!has_category(df) | has_smooth.colour) & !isTRUE(original_colours)], - list(fill = smooth.colour)[(!has_category(df) | has_smooth.colour) & !isTRUE(original_colours)])) - } - } - - # add axis labels ---- - p <- p + - labs(x = get_x_name(df), - y = get_y_name(df), - fill = get_category_name(df), - colour = get_category_name(df)) # will return NULL if not available, so always works - if (geom_is_continuous_x(type)) { - if (type %like% "density") { - p <- p + - labs(y = "Density") - if (misses_y.percent) { - y.percent <- TRUE - } - } else { - p <- p + - labs(y = "Frequency") - } - } - - # add the right scales ---- - font <- validate_font(font) - if (has_category(df) && (is.numeric(get_category(df)) || is_date(get_category(df)))) { - p <- p + - validate_category_scale(values = get_category(df), - type = type, - cols = cols, - category.labels = category.labels, - category.percent = category.percent, - category.breaks = category.breaks, - category.limits = category.limits, - category.expand = category.expand, - category.midpoint = category.midpoint, - category.transform = category.transform, - category.date_breaks = category.date_breaks, - category.date_labels = category.date_labels, - stackedpercent = stackedpercent, - legend.nbin = legend.nbin, - legend.barheight = legend.barheight, - legend.barwidth = legend.barwidth, - legend.reverse = legend.reverse, - legend.position = legend.position, - decimal.mark = decimal.mark, - big.mark = big.mark, - font = font, - colour_fill = colour_fill, - original_colours = original_colours) - } else if (type != "geom_sf") { - category_txt <- get_category(df) - if (is.null(category.labels) && - any(category_txt %like% "[*]+.+[*]+" | - category_txt %like% "[a-zA-Z0-9,.-]_[{].+[}]" | - category_txt %like% "[a-zA-Z0-9,.-] ?\\^ ?[{].+[}]" | - category_txt %like% "[a-zA-Z0-9,.-] ?\\^ ?[a-zA-Z0-9,._-]" | - category_txt %like% ".+" | - category_txt %like% ".+" | - category_txt %like% "[$]", na.rm = TRUE)) { - plot2_message("The ", font_blue("category"), " seems to contain markdown, assuming ", font_blue("category.labels = md_to_expression")) - category.labels <- md_to_expression - } - if (original_colours == TRUE) { - # these scale functions do not have 'values' set - p <- p + - scale_colour_discrete(labels = if (is.null(category.labels)) waiver() else category.labels, - limits = if (is.null(names(cols$colour))) { - NULL - } else { - # remove unneeded labels - base::force - }) + - scale_fill_discrete(labels = if (is.null(category.labels)) waiver() else category.labels, - limits = if (is.null(names(cols$colour))) { - NULL - } else { - # remove unneeded labels - base::force - }) - } else { - p <- p + - scale_colour_manual(values = cols$colour, - labels = if (is.null(category.labels)) waiver() else category.labels, - limits = if (is.null(names(cols$colour))) { - NULL - } else { - # remove unneeded labels - base::force - }) + - scale_fill_manual(values = cols$colour_fill, - labels = if (is.null(category.labels)) waiver() else category.labels, - limits = if (is.null(names(cols$colour))) { - NULL - } else { - # remove unneeded labels - base::force - }) - } - # hack the possibility to print values as expressions - if (identical(category.labels, md_to_expression)) { - if (geom_has_only_colour(type)) { - p$mapping <- utils::modifyList(p$mapping, aes(fill = NULL)) - } else { - p$mapping <- utils::modifyList(p$mapping, aes(colour = NULL)) - } - } - } - if (!type %in% c("geom_sf", "geom_tile", "geom_raster", "geom_rect")) { - if (has_x(df)) { - if (isTRUE(x.mic)) { - loadNamespace("AMR") # will throw an error if not installed - if ("scale_x_mic" %in% ls(envir = asNamespace("AMR"))) { - fn <- get("scale_x_mic", envir = asNamespace("AMR")) - p <- p + - fn(drop = x.drop, mic_range = x.limits) - } else { - plot2_caution("AMR::scale_x_mic() not found, update to latest AMR version or use `x.mic = FALSE`") - } - } else { - p <- p + - validate_x_scale(values = get_x(df), - x.date_breaks = x.date_breaks, - x.date_labels = x.date_labels, - x.breaks = x.breaks, - x.expand = x.expand, - x.labels = x.labels, - x.n_breaks = x.n_breaks, - x.limits = x.limits, - x.position = x.position, - x.transform = x.transform, - x.drop = x.drop, - x.zoom = x.zoom, - decimal.mark = decimal.mark, - big.mark = big.mark, - horizontal = horizontal, - type_backup = type_backup) - } - } else { - # no x - p <- p + - scale_x_discrete(labels = NULL, breaks = NULL, drop = x.drop) - } - if (has_y(df)) { - p_added_y <- p + - validate_y_scale(df = df, - type = type, - y.24h = y.24h, - y.age = y.age, - y.scientific = y.scientific, - y.breaks = y.breaks, - y.n_breaks = y.n_breaks, - y.expand = y.expand, - y.labels = y.labels, - y.limits = y.limits, - y.percent = y.percent, - y.percent_break = y.percent_break, - misses_y.percent_break = misses_y.percent_break, - y.position = y.position, - y.transform = y.transform, - y.zoom = y.zoom, - stacked = stacked, - stackedpercent = stackedpercent, - facet.fixed_y = facet.fixed_y, - decimal.mark = decimal.mark, - big.mark = big.mark, - add_y_secondary = FALSE) - } - if (has_y_secondary(df)) { - # add a secondary y axis - if (isTRUE(y_secondary.title)) { - y_secondary.title <- validate_title(get_y_secondary_name(df), markdown = isTRUE(markdown), df = df) - } - p <- p + - validate_y_scale(df = df, - type = type, - y.24h = y.24h, - y.age = y.age, - y.scientific = y.scientific, - y.breaks = y.breaks, - y.n_breaks = y.n_breaks, - y.expand = y.expand, - y.labels = y.labels, - y.limits = y.limits, - y.percent = y.percent, - y.percent_break = y.percent_break, - misses_y.percent_break = misses_y.percent_break, - y.position = y.position, - y.transform = y.transform, - y.zoom = y.zoom, - stacked = stacked, - stackedpercent = stackedpercent, - facet.fixed_y = facet.fixed_y, - decimal.mark = decimal.mark, - big.mark = big.mark, - add_y_secondary = TRUE, - # this get the breaks from the primary y axis (requires ggplot version >= 3.3.0): - y_secondary.breaks = ggplot_build(p_added_y)$layout$panel_params[[1]]$y$breaks, - # additional properties for secondary y axis: - y_secondary.title = y_secondary.title, - y_secondary.scientific = y_secondary.scientific, - y_secondary.percent = y_secondary.percent, - y_secondary.labels = y_secondary.labels, - markdown = markdown) - } else { - # add the y axis without secondary axis - p <- p_added_y - } - } - - # validate theme and add markdown support ---- - p <- p + - validate_theme(theme = theme, - type = type, - background = background, - text_factor = text_factor, - font = font, - horizontal = horizontal, - x.remove = x.remove, - y.remove = y.remove, - x.lbl_angle = x.lbl_angle, - x.lbl_align = x.lbl_align, - x.lbl_italic = x.lbl_italic, - facet.fill = facet.fill, - facet.bold = facet.bold, - facet.italic = facet.italic, - facet.size = facet.size, - facet.margin = facet.margin, - legend.italic = legend.italic, - title.colour = title.colour, - subtitle.colour = subtitle.colour, - has_y_secondary = has_y_secondary(df), - has_category = has_category(df), - col_y_primary = cols$colour[1L], - col_y_secondary = y_secondary.colour, - sankey.remove_axes = sankey.remove_axes) - - # add titles ---- - if (!misses_title) p <- p + labs(title = title) - if (!misses_subtitle) p <- p + labs(subtitle = subtitle) - if (!misses_tag) p <- p + labs(tag = tag) - if (!misses_caption) p <- p + labs(caption = caption) - - if (isTRUE(x.title)) { - x.title <- validate_title(get_x_name(df), markdown = isTRUE(markdown), df = df) - } - p <- p + labs(x = x.title) - - if (isTRUE(y.title)) { - y.title <- validate_title(get_y_name(df), markdown = isTRUE(markdown), df = df) - } - p <- p + labs(y = y.title) - - if (has_category(df)) { - # legend - if (is.null(legend.title) && data_is_numeric(get_category(df))) { - legend.title <- TRUE - } - if (isTRUE(legend.title)) { - legend.title <- validate_title(get_category_name(df), markdown = isTRUE(markdown), df = df) - } - if ("colour" %in% names(mapping)) { - p <- p + labs(colour = legend.title) - } - if ("fill" %in% names(mapping) || type_backup == "sankey") { - p <- p + labs(fill = legend.title) - } - if ("group" %in% names(mapping)) { - p <- p + labs(group = legend.title) - } - } - - # set legend ---- - if (is.null(legend.position)) { - if (has_category(df) && data_is_numeric(get_category(df))) { - legend.position <- "right" - } else { - legend.position <- "top" - } - } - legend.position <- validate_legend.position(legend.position) - p <- p + theme(legend.position = legend.position) - - if (!(has_category(df) && is.numeric(get_category(df)))) { - # only change this when there is no guide_colourbar(), see validate_category_scale() - if (!is.null(legend.reverse)) { - p <- p + - guides(fill = guide_legend(reverse = isTRUE(legend.reverse)), - colour = guide_legend(reverse = isTRUE(legend.reverse))) - } - if (isTRUE(horizontal)) { - if (legend.position %in% c("top", "bottom") && - validate_sorting(category.sort, horizontal = horizontal) %unlike% "freq") { - # reverse legend items when on top or bottom, but not when sorting is freq, freq-asc or freq-desc - p <- p + - guides(fill = guide_legend(reverse = TRUE), - colour = guide_legend(reverse = TRUE)) - } - } - } - - # set facet ---- - if (has_facet(df)) { - p <- p + - validate_facet(df = df, - type = type, - facet.repeat_lbls_x = facet.repeat_lbls_x, - facet.repeat_lbls_y = facet.repeat_lbls_y, - facet.relative = facet.relative, - facet.drop = facet.drop, - facet.nrow = facet.nrow, - facet.position = facet.position, - horizontal = horizontal) - } - - # set datalabels ---- - if (has_datalabels(df) && type != "geom_blank") { - p <- set_datalabels(p = p, - df = df, - type = type, - width = width, - stacked = stacked, - stackedpercent = stackedpercent, - datalabels.colour_fill = datalabels.colour_fill, - datalabels.colour = datalabels.colour, - datalabels.size = datalabels.size, - datalabels.angle = datalabels.angle, - datalabels.lineheight = datalabels.lineheight, - datalabels.centroid = dots$`_datalabels.centroid`, - font = font, - reverse = reverse, - horizontal = horizontal, - misses_datalabels = misses_datalabels, - markdown = markdown) - } - - # turn plot horizontal if required ---- - # up until this point, a lot has been done already for `horizontal`. - # such as switching some x and y axis properties of the theme - if (isTRUE(horizontal)) { - p <- p + coord_flip() - } - - # additional geoms for certain types ---- - # linedot - if (type_backup == "linedot") { - p <- p |> - add_point(colour = ifelse(!is.null(background), background, "white"), size = size * 5) |> - add_point(size = size * 2) - } - # dumbbell - if (type_backup == "dumbbell") { - if (!has_category(df) || n_distinct(get_category(df)) != 2) { - stop("Dumbbell plots can only be used if the category ", - ifelse(has_category(df), paste0("(", get_category_name(df), ") "), "") , - "is set with two distinct values", - ifelse(has_category(df), paste0(" - it now has ", digit_to_text(n_distinct(get_category(df))), "."), ""), - call. = FALSE) - } - dumbbell_segment <- df |> - group_by(across(c( - # x must get a name to be used in geom_segment(aes(...)) - x_axis = get_x_name(df), - # facet must not be named here so that it will be identical to the current facet name, - # which is required to make facets work with dumbbell plots - get_facet_name(df))), - .drop = FALSE) |> - summarise(y_min = suppressWarnings(min(`_var_y`, na.rm = TRUE)), - y_max = suppressWarnings(max(`_var_y`, na.rm = TRUE)), - .groups = "drop") |> - filter(!is.infinite(abs(y_min)) & !is.infinite(abs(y_max))) - - p <- p + - geom_segment(data = dumbbell_segment, - mapping = aes(x = x_axis, xend = x_axis, - y = y_min, yend = y_max), - linewidth = linewidth, - linetype = linetype, - colour = "grey80", - inherit.aes = FALSE) - # move the segment one layer down, so geom_point will be on top - p <- p |> - move_layer(layer = length(p$layers), move = -1) - } - - # restore mapping to original names ---- - # this will replace e.g. `_var_x` and `_var_category` in the mapping and remove them from the data - p <- restore_mapping(p = p, - df = df) - if (type_backup == "sankey") { - p$data <- p$data |> select(-get_x_name(df)) - } - # be sure to end with a tibble - the as_tibble() function also has some consistency checks built-in - # but only when it's nothing more than a data.frame without row names - if (identical(class(p$data), "data.frame") && identical(rownames(p$data), as.character(seq_len(nrow(p$data))))) { - p$data <- as_tibble(p$data) - } - - # return plot ---- - if (isTRUE(print)) { - print(p) - } else { - p - } -} diff --git a/R/plotly.R b/R/plotly.R deleted file mode 100644 index 557b90df..00000000 --- a/R/plotly.R +++ /dev/null @@ -1,76 +0,0 @@ -# ===================================================================== # -# An R package by Certe: # -# https://github.com/certe-medical-epidemiology # -# # -# Licensed as GPL-v2.0. # -# # -# Developed at non-profit organisation Certe Medical Diagnostics & # -# Advice, department of Medical Epidemiology. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# ===================================================================== # - -#' Create Interactive Plotly -#' -#' Transform a `ggplot2`/`plot2` object to an interactive plot using the [Plotly R Open Source Graphing Library](https://plotly.com/r/). -#' @param plot a `ggplot2` plot -#' @param ... -#' In case of [as_plotly()]: arguments to pass on to [`layout()`][plotly::layout()] to change the Plotly layout object -#' -#' In case of [plotly_style()]: arguments to pass on to [`style()`][plotly::style()] to change the Plotly style object -#' @importFrom ggplot2 is.ggplot -#' @rdname plotly -#' @export -#' @examples -#' mtcars |> -#' plot2(mpg, hp) |> -#' as_plotly() -#' -#' mtcars |> -#' plot2(mpg, hp) |> -#' as_plotly(dragmode = "pan") |> -#' plotly_style(marker.line.color = "red", -#' hoverinfo = "y") -#' -#' -#' \dontrun{ -#' # in the certetoolbox package, this: -#' mtcars |> -#' plot2(mpg, hp) |> -#' export_html("filename") -#' -#' # is short for: -#' mtcars |> -#' plot2(mpg, hp) |> -#' as_plotly() |> -#' htmltools::save_html("filename.html") -#' } -as_plotly <- function(plot, ...) { - if (!is.ggplot(plot)) { - stop("`plot` must be a ggplot2 model.", call. = FALSE) - } - if (!"plotly" %in% rownames(utils::installed.packages())) { - stop("This function requires the 'plotly' package - install it with install.packages(\"plotly\")", call. = FALSE) - } - - plotly::ggplotly(plot) |> - plotly::layout(...) -} - -#' @importFrom ggplot2 is.ggplot -#' @rdname plotly -#' @export -plotly_style <- function(plot, ...) { - if (is.ggplot(plot)) { - plot <- as_plotly(plot) - } - plot |> - plotly::style(...) -} diff --git a/R/theme_minimal2.R b/R/theme_minimal2.R deleted file mode 100644 index 55cf8dff..00000000 --- a/R/theme_minimal2.R +++ /dev/null @@ -1,106 +0,0 @@ -# ===================================================================== # -# An R package by Certe: # -# https://github.com/certe-medical-epidemiology # -# # -# Licensed as GPL-v2.0. # -# # -# Developed at non-profit organisation Certe Medical Diagnostics & # -# Advice, department of Medical Epidemiology. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# ===================================================================== # - -#' An Even More Minimal Theme -#' -#' This `ggplot2` theme provides even more white area and less clutter than [`theme_minimal()`][ggplot2::theme_minimal()]. -#' @param ... arguments passed on to [ggplot2::theme()] -#' @param colour_font_primary colour to set for the plot title and tag -#' @param colour_font_secondary colour to set for the plot subtitle and caption -#' @param colour_font_axis colour to set for the axis titles on both x and y -#' @param colour_background colour to set for the background -#' @importFrom ggplot2 element_text `%+replace%` theme_bw theme margin element_line element_blank unit element_rect -#' @importFrom certestyle colourpicker -#' @export -#' @examples -#' plot2(iris) -#' plot2(admitted_patients, x = hospital, category = gender) -#' -#' if (require("ggplot2")) { -#' ggplot(mtcars, aes(hp, mpg)) + -#' geom_point() -#' } -#' if (require("ggplot2")) { -#' ggplot(mtcars, aes(hp, mpg)) + -#' geom_point() + -#' theme_minimal2() -#' } -theme_minimal2 <- function(..., - colour_font_primary = getOption("plot2.colour_font_primary", "black"), - colour_font_secondary = getOption("plot2.colour_font_secondary", "grey35"), - colour_font_axis = getOption("plot2.colour_font_axis", "grey25"), - colour_background = getOption("plot2.colour_background", "white")) { - - colour_font_primary <- colourpicker(colour_font_primary, length = 1) - colour_font_secondary <- colourpicker(colour_font_secondary, length = 1) - colour_font_axis <- colourpicker(colour_font_axis, length = 1) - colour_background <- colourpicker(colour_background, length = 1) - - t <- theme_bw(base_size = 11) %+replace% - theme( - axis.text.x = element_text(margin = margin(3, 0, 0, 0)), - axis.title.x = element_text(margin = margin(14, 0, 0, 0), colour = colour_font_axis), - axis.title.y = element_text(margin = margin(0, 14, 0, 0), angle = 90, colour = colour_font_axis), - axis.ticks.y = element_blank(), - axis.ticks.x = element_line(linewidth = 0.75, colour = "grey75"), - axis.ticks.length = unit(2, "pt"), - legend.background = element_blank(), - legend.key = element_blank(), - legend.key.size = unit(11, "pt"), # squares and lines left to legend text - legend.text = element_text(size = unit(9, "pt"), # text itself - margin = margin(l = 1, r = 6, unit = "pt")), # left and right of text - legend.title = element_text(face = "bold", size = unit(10, "pt")), - panel.background = element_rect(fill = colour_background, linetype = 0), - panel.border = element_blank(), - panel.grid.major.x = element_blank(), - panel.grid.major.y = element_line(linewidth = 0.375, colour = "grey75"), - panel.grid.minor.x = element_blank(), - panel.grid.minor.y = element_line(linewidth = 0.25, colour = "grey85"), - axis.line = element_line(linewidth = 0.375, colour = "grey75"), - axis.line.y = element_blank(), - plot.margin = unit(c(5, 12, 5, 5), units = "pt"), - plot.background = element_rect(fill = colour_background, linetype = 0), - plot.subtitle = element_text(size = unit(11, "pt"), - hjust = 0.5, - colour = colour_font_secondary, - margin = margin(0, 0, 10, 0)), - plot.title = element_text(size = unit(13, "pt"), - hjust = 0.5, - colour = colour_font_primary, - margin = margin(0, 0, 10, 0)), - plot.caption = element_text(size = unit(10, "pt"), - hjust = 1, - colour = colour_font_secondary), - plot.tag = element_text(size = unit(14, "pt"), - hjust = 0, - colour = colour_font_primary, - margin = margin(0, 0, 0, 0), - face = "bold"), - strip.background = element_rect(colour = colour_background), - strip.switch.pad.wrap = unit(10, "pt"), - strip.placement = "outside", - complete = TRUE) - - if (length(list(...)) > 0) { - t <- t %+replace% - theme(...) - } - - t -} diff --git a/R/utils.R b/R/utils.R index 3cdca6a4..d51521a9 100644 --- a/R/utils.R +++ b/R/utils.R @@ -17,676 +17,32 @@ # useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # # ===================================================================== # -plot2_env <- new.env(hash = FALSE) - globalVariables(c(".", - "_new_title", - "_row_index", - "_sankey_id", - "_sankey_split", - "_sankey_x", - "_var_category", - "_var_datalabels", - "_var_facet", - "_var_x", - "_var_y", - "_var_y_secondary", "ab", - "antibiotic", + "antibiotic", "cases", "cluster", - "count", "day_in_period", - "geom", - "group", - "in_scope", "interpretation", "isolates", - "ma_5c", - "ma_5c_pct_outscope", - "max_ma_5c", + "md_to_expression", "mo", - "month_day", + "move_layer", "moving_avg", "moving_avg_limit", "moving_avg_max", - "n", "n_cases", "name", "period", "period_date", "period_txt", + "plot2_warning", "R", - "rowname", "SI", "syndromic_group", "total", + "validate_markdown", + "validate_title", "value", - "where", - "x", - "x_axis", "xmax", - "xmin", - "y_max", - "y_min", - "ymax", - "ymin", - "year")) - -#' @importFrom dplyr n -#' @export -dplyr::n - -#' @importFrom dplyr n_distinct -#' @export -dplyr::n_distinct - -#' @importFrom tidyselect everything -#' @export -tidyselect::everything - -#' @importFrom tidyselect starts_with -#' @export -tidyselect::starts_with - -#' @importFrom tidyselect ends_with -#' @export -tidyselect::ends_with - -#' @importFrom tidyselect matches -#' @export -tidyselect::matches - -#' @importFrom tidyselect where -#' @export -tidyselect::where - -#' @importFrom dplyr first -#' @export -dplyr::first - -#' @importFrom dplyr last -#' @export -dplyr::last - -#' @importFrom dplyr all_of -#' @export -dplyr::all_of - -#' @importFrom dplyr any_of -#' @export -dplyr::any_of - -#' @importFrom certestyle dec_mark -#' @export -certestyle::dec_mark - -#' @importFrom certestyle big_mark -#' @export -certestyle::big_mark - -#' @importFrom certestyle colourpicker -#' @export -certestyle::colourpicker - -#' @importFrom certestyle font_black font_blue font_magenta font_white font_bold -plot2_message <- function(..., print = interactive() | Sys.getenv("IN_PKGDOWN") != "", type = "info") { - # at default, only prints in interactive mode and for the website generation - if (isTRUE(print)) { - # get info icon - if (isTRUE(base::l10n_info()$`UTF-8`) && interactive()) { - # \u2139 is a symbol officially named 'information source' - icon <- "\u2139" - } else { - icon <- "i" - } - if (type == "info") { - fn <- font_black - icon <- font_blue(icon) - } else { - fn <- font_magenta - icon <- font_magenta("!") - } - msg <- paste0(fn(c(...), collapse = NULL), collapse = "") - if (type %in% c("info", "caution")) { - message(paste(icon, fn(msg))) - } else if (type == "warning") { - warning("\n", paste(icon, fn(msg)), call. = FALSE, immediate. = TRUE) - } - } -} - -plot2_caution <- function(..., print = interactive() | Sys.getenv("IN_PKGDOWN") != "") { - plot2_message(..., print = print, type = "caution") -} - -plot2_warning <- function(..., print = interactive() | Sys.getenv("IN_PKGDOWN") != "") { - plot2_message(..., print = print, type = "warning") -} - -requires_numeric_coercion <- function(x) { - !is.null(x) && mode(x) == "numeric" && !is.numeric(x) && !inherits(x, c("factor", "Date", "POSIXt")) -} - -summarise_variable <- function(df, var, sep) { - # combined with add_direction(), this will add support for multiple vars in one direction: - # e.g., `category = c(col1, col2)` - cols <- colnames(df) - old_vars <- cols[cols %like% paste0(var, "_")] - if (length(old_vars) == 0) { - return(df) - } else if (length(old_vars) > 1) { - new_var <- do.call(paste, c(df[old_vars], sep = sep)) - } else { - new_var <- df[, old_vars, drop = TRUE] - } - df <- df[, cols[!cols %in% old_vars], drop = FALSE] - df[, var] <- new_var - df -} - -#' @importFrom dplyr select mutate across -add_direction <- function(df, direction, var_name, var_label, sep) { - tryCatch({ - # this for using tidyverse selectors, such as `facet = where(is.character)` - selected_cols <- df |> - as.data.frame(stringsAsFactors = FALSE) |> # for sf data - select({{ direction }}) |> - colnames() - selected_cols <- selected_cols[selected_cols %unlike% "^_var_"] - if (length(selected_cols) > 1 && is.character(selected_cols) && !all(var_label %like% selected_cols)) { - # replace e.g. `facet = where(is.character)` with `facet = c(var1, var2, var3)` - # in labels for columns, but also in mapping - new_var_name <- paste0("c(", paste0(selected_cols, collapse = ", "), ")") - plot2_message("Using ", font_blue(paste0(var_name, " = ", new_var_name))) - if (var_name == "x") plot2_env$mapping_x <- new_var_name - if (var_name == "category") plot2_env$mapping_category <- new_var_name - if (var_name == "facet") plot2_env$mapping_facet <- new_var_name - var_label <- new_var_name - } - }, error = function(e) invisible()) - - df <- tryCatch({ - out <- df |> - mutate(`_var_` = {{ direction }}) - colnames(out)[colnames(out) == "_var_"] <- paste0("_var_", var_name) - out - }, error = function(e) { - # multiple columns selected - df |> - mutate(across({{ direction }}, .names = paste0("_var_", var_name, "_{col}"))) |> - summarise_variable(paste0("_var_", var_name), sep = sep) - }) - - # this adds the column again with the right label - var_label <- paste0(trimws(var_label), collapse = " ") - if (var_label != "NULL" && !var_label %in% colnames(df)) { - df$`_var_new` <- df[, paste0("_var_", var_name), drop = TRUE] - colnames(df)[colnames(df) == "_var_new"] <- var_label - } - - df -} - -#' @importFrom dplyr pull -get_column_name <- function(df, column_var) { - out <- vapply(FUN.VALUE = logical(1), df, function(col) { - identical(col, - df |> pull({{column_var}})) - }) - if (all(out[names(out) %unlike% "^_var_"] == FALSE)) { - # no column found, probably due to sorting (i.e., factors), try again with character comparison - out <- vapply(FUN.VALUE = logical(1), df, function(col) { - identical(col |> as.character(), - df |> pull({{column_var}}) |> as.character()) - }) - } - out <- names(out)[out & names(out) %unlike% "^_var_"][1L] - if (is.na(out)) { - return(NULL) - } - out -} - -get_x <- function(df, na.rm = FALSE) { - if (has_x(df)) { - out <- df$`_var_x` - if (isTRUE(na.rm)) { - out <- out[!is.na(out)] - } - out - } else { - NULL - } -} -get_x_name <- function(df) { - if (has_x(df)) { - if (!is.null(plot2_env$mapping_x) && plot2_env$mapping_x != "NULL" && plot2_env$mapping_x %in% colnames(df)) { - plot2_env$mapping_x - } else { - get_column_name(df, `_var_x`) - } - } else { - NULL - } -} -has_x <- function(df) { - "_var_x" %in% colnames(df) -} - -get_y <- function(df) { - if (has_y(df)) { - df$`_var_y` - } else { - NULL - } -} -get_y_name <- function(df) { - if (has_y(df)) { - if (!is.null(plot2_env$mapping_y) && plot2_env$mapping_y != "NULL" && plot2_env$mapping_y %in% colnames(df)) { - plot2_env$mapping_y - } else { - get_column_name(df, `_var_y`) - } - } else { - NULL - } -} -has_y <- function(df) { - "_var_y" %in% colnames(df) -} - -get_category <- function(df, na.rm = FALSE) { - if (has_category(df)) { - out <- df$`_var_category` - if (isTRUE(na.rm)) { - out <- out[!is.na(out)] - } - out - } else { - NULL - } -} -get_category_name <- function(df) { - if (has_category(df)) { - if (!is.null(plot2_env$mapping_category) && plot2_env$mapping_category != "NULL" && plot2_env$mapping_category %in% colnames(df)) { - plot2_env$mapping_category - } else { - get_column_name(df, `_var_category`) - } - } else { - NULL - } -} -has_category <- function(df) { - "_var_category" %in% colnames(df) -} - -get_facet <- function(df) { - if (has_facet(df)) { - df$`_var_facet` - } else { - NULL - } -} -get_facet_name <- function(df) { - if (has_facet(df)) { - if (!is.null(plot2_env$mapping_facet) && plot2_env$mapping_facet != "NULL" && plot2_env$mapping_facet %in% colnames(df)) { - plot2_env$mapping_facet - } else { - get_column_name(df, `_var_facet`) - } - } else { - NULL - } -} -has_facet <- function(df) { - "_var_facet" %in% colnames(df) -} - -get_y_secondary <- function(df) { - if (has_y_secondary(df)) { - df$`_var_y_secondary` - } else { - NULL - } -} -get_y_secondary_name <- function(df) { - if (has_y_secondary(df)) { - if (!is.null(plot2_env$mapping_y_secondary) && plot2_env$mapping_y_secondary != "NULL" && plot2_env$mapping_y_secondary %in% colnames(df)) { - plot2_env$mapping_y_secondary - } else { - get_column_name(df, `_var_y_secondary`) - } - } else { - NULL - } -} -has_y_secondary <- function(df) { - "_var_y_secondary" %in% colnames(df) -} - -get_datalabels <- function(df) { - if (has_datalabels(df)) { - df$`_var_datalabels` - } else { - NULL - } -} -has_datalabels <- function(df) { - "_var_datalabels" %in% colnames(df) -} - -#' @importFrom dplyr n_distinct -determine_date_breaks_labels <- function(x) { - rng <- range(x, na.rm = TRUE) - range_in_days <- as.double(difftime(rng[2], rng[1], units = "days")) - range_in_months <- diff(as.double(format(rng, "%m"))) + 1 - range_in_years <- diff(as.double(format(rng, "%Y"))) + 1 - if (range_in_days <= 2) { - range_in_hours <- as.double(difftime(rng[2], rng[1], units = "hours")) - range_in_minutes <- as.double(difftime(rng[2], rng[1], units = "mins")) - if (range_in_hours <= 1) { - if (range_in_minutes <= 10) { - out <- list(breaks = "1 min", - labels = "HH:MM") - } else if (range_in_minutes <= 30) { - out <- list(breaks = "5 min", - labels = "HH:MM") - } else { - out <- list(breaks = "10 min", - labels = "HH:MM") - } - } else if (range_in_hours <= 2) { - if (range_in_minutes <= 30) { - out <- list(breaks = "10 min", - labels = "HH:MM") - } else { - out <- list(breaks = "15 mins", - labels = "HH:MM") - } - } else if (range_in_hours <= 4) { - out <- list(breaks = "30 mins", - labels = "HH:MM") - } else if (range_in_hours <= 6) { - out <- list(breaks = "1 hour", - labels = "HH:MM") - } else if (range_in_hours <= 12) { - out <- list(breaks = "1 hour", - labels = "HH") - } else { - out <- list(breaks = "2 hours", - labels = "HH") - } - } else if (range_in_days <= 7) { - # 1 week - out <- list(breaks = "1 day", - labels = "ddd") - } else if (range_in_days <= 31) { - # 1 month - out <- list(breaks = "1 day", - labels = "d mmm") - } else if (range_in_days < 100 && range_in_months <= 3) { - # quarter - out <- list(breaks = "4 days", - labels = "d mmm") - } else if (range_in_days < 190 && range_in_months <= 6) { - # half year - out <- list(breaks = "2 weeks", - labels = "d mmm") - } else if (range_in_days <= 366 && range_in_years == 1) { - # year within 1 year - out <- list(breaks = "1 month", - labels = "mmm") - } else if (range_in_days <= 366 && range_in_years == 2) { - # max 1 year, but crossing 1 Jan - out <- list(breaks = "2 months", - labels = "mmm yyyy") - } else if (range_in_years == 2) { - out <- list(breaks = "3 months", - labels = "mmm yyyy") - } else if (range_in_years == 3) { - out <- list(breaks = "6 months", - labels = "mmm yyyy") - } else if (range_in_years <= 5) { - out <- list(breaks = "1 year", - labels = "mmm yyyy") - } else if (range_in_years < 10) { - out <- list(breaks = "1 year", - labels = "yyyy") - } else if (range_in_years < 25) { - out <- list(breaks = "2 years", - labels = "yyyy") - } else { - # even longer, all other cases - out <- list(breaks = "5 years", - labels = "yyyy") - } - out -} - -unify_years <- function(x, as_leap_year = NULL) { - if (is.null(as_leap_year)) { - as_leap_year <- any(x |> format() |> substr(6, 10) == "02-29", na.rm = TRUE) - } - if (inherits(x, "Date")) { - as.Date(paste0(ifelse(as_leap_year, "1972", "1970"), x |> format() |> substr(5, 10))) - } else { - as.POSIXct(paste0(ifelse(as_leap_year, "1972", "1970"), x |> format() |> substr(5, 99))) - } -} - -is_empty <- function(x) { - is.null(x) || isFALSE(x) || identical(x, "") || all(is.na(as.character(x))) -} - -geom_is_continuous <- function(geom) { - geom %in% c("geom_boxplot", "geom_violin", "geom_point", "geom_jitter", "geom_histogram", "geom_density", "geom_sf", "geom_line", "geom_area", "geom_ribbon", "geom_tile", "geom_raster", "geom_rect") -} -geom_is_continuous_x <- function(geom) { - geom %in% c("geom_histogram", "geom_density") -} -geom_is_line_or_area <- function(geom) { - geom %in% c("geom_line", "geom_hline", "geom_vline", "geom_path", "geom_qq_line", "geom_linerange", "geom_area", "geom_ribbon", "geom_tile", "geom_raster", "geom_rect") -} -geom_has_only_colour <- function(geom) { - geom %in% c("geom_point", "geom_jitter", "geom_line", "geom_hline", "geom_vline", - "geom_path", "geom_qq_line", "geom_linerange", "geom_pointrange") -} - -#' @importFrom dplyr group_by across group_size -group_sizes <- function(df) { - if (inherits(df, "sf")) { - nrow(df) - } else { - df |> - group_by(across(c(get_x_name(df), get_category_name(df), get_facet_name(df))), - .drop = FALSE) |> - group_size() - } -} - -# this replaces ggplot2::aes_string(), which was deprecated in 3.4.0 -#' @importFrom ggplot2 aes -#' @importFrom rlang is_quosure as_label new_quosure -update_aes <- function(current = aes(), ..., as_symbol = FALSE) { - mapping <- list(...) - caller_env <- parent.frame() - mapping <- lapply(mapping, function(x) { - if (tryCatch(is.null(x) || identical(x, "") || identical(x, "NULL"), error = function(e) FALSE)) { - # this will ultimately remove the aesthetic from the list, after running utils::modifyList() - return(NULL) - } - if (is_quosure(x)) { - # as regular text - x <- as_label(x) - } - if (isTRUE(as_symbol)) { - # this is required for restore_mapping() - x <- as.symbol(x) - } else { - # use str2lang() to get a `call` type: - x <- as.character(x) - if (x %unlike% "^[A-Za-z0-9]") { - x <- paste0("`", x, "`") - } - x <- str2lang(x) - } - new_quosure(x, env = caller_env) - }) - out <- structure(mapping, class = class(aes())) - utils::modifyList(current, out) -} - -restore_mapping <- function(p, df) { - # helper function - fn_new_mapping <- function(mapping, df) { - if (is.null(mapping)) { - return(mapping) - } - att <- attributes(mapping) - new_mapping <- lapply(mapping, - function(map) { - # deparse(map) has a value such as "~`_var_y`" - if (any(deparse(map) %like% "_var_x")) { - update_aes(x = get_x_name(df), as_symbol = TRUE)[[1]] - } else if (any(deparse(map) %like% "_var_y_secondary")) { - update_aes(x = get_y_secondary_name(df), as_symbol = TRUE)[[1]] - } else if (any(deparse(map) %like% "_var_y")) { - update_aes(x = get_y_name(df), as_symbol = TRUE)[[1]] - } else if (any(deparse(map) %like% "_var_category")) { - update_aes(x = get_category_name(df), as_symbol = TRUE)[[1]] - } else if (any(deparse(map) %like% "_var_facet")) { - update_aes(x = get_facet_name(df), as_symbol = TRUE)[[1]] - } else { - map - }}) - attributes(new_mapping) <- att - new_mapping - } - - # general plot mapping - p$mapping <- fn_new_mapping(mapping = p$mapping, df = df) - # mapping for each extra layer, such as geom_smooth() - for (i in seq_len(length(p$layers))) { - p$layers[[i]]$mapping <- fn_new_mapping(mapping = p$layers[[i]]$mapping, df = df) - } - - # facet mapping - if (has_facet(df)) { - p$facet$params$facets[[1]] <- update_aes(x = get_facet_name(df), as_symbol = TRUE)[[1]] - names(p$facet$params$facets)[1] <- get_facet_name(df) - # required for ggplot2::facet_grid(), which is used when facet.relative = TRUE: - if (length(p$facet$params$rows) > 0) { - p$facet$params$rows[[1]] <- update_aes(x = get_facet_name(df), as_symbol = TRUE)[[1]] - names(p$facet$params$rows)[1] <- get_facet_name(df) - } - if (length(p$facet$params$cols) > 0) { - p$facet$params$cols[[1]] <- update_aes(x = get_facet_name(df), as_symbol = TRUE)[[1]] - names(p$facet$params$cols)[1] <- get_facet_name(df) - } - } - - # now remove these anonymous`_var_*` columns from the data - p$data <- p$data[, colnames(p$data)[colnames(p$data) %unlike% "^_var_(x|y|category|facet)$"], drop = FALSE] - - # return the plot object - p -} - -set_plot2_env <- function(x = NULL, y = NULL, category = NULL, facet = NULL, y_secondary = NULL, x_variable_names = NULL) { - x <- paste0(trimws(x), collapse = " ") - y <- paste0(trimws(y), collapse = " ") - category <- paste0(category, collapse = " ") - facet <- paste0(facet, collapse = " ") - y_secondary <- paste0(y_secondary, collapse = " ") - if (!x %in% c("NULL", "") && is.null(plot2_env$mapping_x)) { - plot2_env$mapping_x <- x - } - if (!y %in% c("NULL", "") && is.null(plot2_env$mapping_y)) { - plot2_env$mapping_y <- y - } - if (!category %in% c("NULL", "") && is.null(plot2_env$mapping_category)) { - plot2_env$mapping_category <- category - } - if (!facet %in% c("NULL", "") && is.null(plot2_env$mapping_facet)) { - plot2_env$mapping_facet <- facet - } - if (!y_secondary %in% c("NULL", "") && is.null(plot2_env$mapping_y_secondary)) { - plot2_env$mapping_y_secondary <- y_secondary - } - plot2_env$x_variable_names <- x_variable_names -} -clean_plot2_env <- function() { - plot2_env$mapping_x <- NULL - plot2_env$mapping_y <- NULL - plot2_env$mapping_category <- NULL - plot2_env$mapping_facet <- NULL - plot2_env$mapping_y_secondary <- NULL - plot2_env$x_variable_names <- NULL - plot2_env$y_secondary_factor <- NULL -} - -sigfigs <- function(x) { - vapply(FUN.VALUE = double(1), x, function(val) { - frm <- format(val, scientific = FALSE) - if (frm %unlike% "[.]" | frm %like% "[.]0+$") { - 0 - } else if (frm %like% "[.]0") { - nchar(gsub(".*[.](0+).*$", "\\1", frm)) + 1 - } else { - nchar(gsub(".*[.]([0-9]+)$", "\\1", frm)) - } - }) -} - -is_date <- function(x) { - inherits(x, c("Date", "POSIXt")) -} - -data_is_numeric <- function(x) { - all(x %like% "^[0-9.,-]+(e[+][0-9.,-]+)?$", na.rm = TRUE) -} - -digit_to_text <- function(x) { - out <- switch(x, - "one", - "two", - "three", - "four", - "five", - "six", - "seven", - "eight", - "nine", - "ten") - if (is.null(out)) { - out <- as.character(x) - } - out -} - -#' @importFrom rlang cnd_message -#' @importFrom certestyle font_stripstyle -format_error <- function(e, replace = character(0), by = character(0)) { - if (inherits(e, "rlang_error")) { - txt <- cnd_message(e) - txt <- font_stripstyle(txt) - txt <- gsub(".*Caused by error[:](\n!)?", "", txt) - } else { - txt <- c(e$message, e$parent$message, e$parent$parent$message, e$parent$parent$parent$message, e$call) - } - txt <- txt[txt %unlike% "^Problem while"] - if (length(txt) == 0) { - # return original error - stop(e, call. = FALSE) - } - for (i in seq_len(length(replace))) { - txt <- gsub(replace[i], by[i], txt) - } - if (all(txt == "")) { - txt <- "Plot cannot be generated due to unknown error" - } - txt <- trimws(txt) - paste0(txt, collapse = "\n") -} + "xmin")) diff --git a/R/validate.R b/R/validate.R deleted file mode 100644 index 81ef1938..00000000 --- a/R/validate.R +++ /dev/null @@ -1,2856 +0,0 @@ -# ===================================================================== # -# An R package by Certe: # -# https://github.com/certe-medical-epidemiology # -# # -# Licensed as GPL-v2.0. # -# # -# Developed at non-profit organisation Certe Medical Diagnostics & # -# Advice, department of Medical Epidemiology. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# ===================================================================== # - -#' @importFrom certestyle font_blue font_black -#' @importFrom dplyr group_by across summarise n_distinct n -validate_type <- function(type, df = NULL) { - type.bak <- type - type_unset <- (is.null(type) || identical(type, "")) - if (type_unset && !is.null(df)) { - if (!has_x(df)) { - # only numeric values, make it a boxplot - type <- "geom_boxplot" - plot2_message("Using ", font_blue("type = \"", gsub("geom_", "", type), "\"", collapse = NULL), - font_black(" since there is no x axis")) - } else if (has_x(df) && is.numeric(get_x(df))) { - if (identical(get_x(df), get_y(df))) { - # both x and y are numeric - if they are equal then use histogram - # see plot_message below 'since the variable ... is the only numeric variable' - type <- "geom_histogram" - } else { - # make it points if x and y are both numeric - type <- "geom_point" - plot2_message("Using ", font_blue("type = \"", gsub("geom_", "", type), "\"", collapse = NULL), - font_black(" since both axes are numeric")) - } - } else { - # check if y has multiple values across groups, then make it boxplot - if (all(group_sizes(df) >= 3)) { - type <- "geom_boxplot" - plot2_message("Using ", font_blue("type = \"", gsub("geom_", "", type), "\"", collapse = NULL), - " since all groups in ", - paste0(font_blue(unique(c(get_x_name(df), get_category_name(df), get_facet_name(df))), - collapse = NULL), - collapse = font_black(" and ")), - " contain at least three values") - } else { - # otherwise: the default - type <- getOption("plot2.default_type", "geom_col") - if (!is.null(df) && has_x(df) && has_category(df) && n_distinct(get_category(df)) == 2) { - count_nrs <- df |> - group_by(across(c(get_x_name(df), get_category_name(df)))) |> - summarise(n = n()) - if (length(plot2_env$x_variable_names) > 1) { - plot2_message("To view the relation between multiple variables of ", font_blue("x"), ", a Sankey plot can be used (", - font_blue("type = \"sankey\""), " or ", font_blue("type = \"s\""), ")") - } else if (all(count_nrs$n, na.rm = TRUE) == 1) { - plot2_message("To compare single values in two categories (", font_blue(get_category_name(df)), "), a dumbbell plot can be used (", - font_blue("type = \"dumbbell\""), " or ", font_blue("type = \"d\""), ")") - } - } - } - } - } else if (type_unset && is.null(df)) { - return("") # for quick validation - } else { - if (length(type) > 1) { - plot2_warning(font_blue("type"), " can only be of length 1") - } - type <- trimws(tolower(type[1L])) - type <- gsub(".*::", "", type) # for `type = "ggplot2::geom_col()"` - type <- gsub("[^a-z0-9_]", "", type) - if (type == "a") type <- "area" - if (type == "b") type <- "boxplot" - if (type == "c") type <- "column" - if (type == "h") type <- "histogram" - if (type == "j") type <- "jitter" - if (type == "l") type <- "line" - if (type == "p") type <- "point" - if (type == "r") type <- "ribbon" - if (type == "v") type <- "violin" - if (type %like% "column") { # don't catch "bar" here - we consider that a horizontal "col" like Excel - type <- "col" - } - if (type %unlike% "^geom_") { - type <- paste0("geom_", type) - } - # replace 'points' etc. with 'point' etc. - type <- gsub("s$", "", type) - } - - valid_geoms <- ls(pattern = "^geom_", envir = asNamespace("ggplot2")) - if (!type %in% valid_geoms) { - if (any(valid_geoms %like% type)) { - type <- valid_geoms[valid_geoms %like% type][1L] - } else { - stop("plot type \"", type.bak, "\" is invalid since ggplot2::", type, "() does not exist", call. = FALSE) - } - } - type -} - -validate_legend.position <- function(legend.position) { - if (is.null(legend.position) || is.na(legend.position[1L])) { - legend.position <- "none" - } - legend.position <- trimws(tolower(legend.position[1L])) - legend.position <- gsub("^t$", "top", legend.position) - legend.position <- gsub("^r$", "right", legend.position) - legend.position <- gsub("^b$", "bottom", legend.position) - legend.position <- gsub("^l$", "left", legend.position) - - if (!legend.position %in% c("top", "right", "bottom", "left", "none")) { - stop("`legend.position` must be 'top', 'right', 'bottom', 'left' or 'none'", call. = FALSE) - } - legend.position -} - -#' @importFrom dplyr select pull mutate arrange across if_all cur_column filter distinct group_by summarise bind_rows -#' @importFrom tidyselect starts_with matches -#' @importFrom certestyle font_bold font_blue font_magenta font_black -validate_data <- function(df, - misses_x, - misses_category, - ...) { - dots <- list(...) - type <- validate_type(dots$type, df = NULL) # quick validation - - numeric_cols <- names(which(vapply(FUN.VALUE = logical(1), df, function(col) mode(col) == "numeric" & !inherits(col, c("Date", "POSIXTt", "factor"))))) - numeric_cols <- numeric_cols[numeric_cols %unlike% "^_var_"] - character_cols <- names(which(vapply(FUN.VALUE = logical(1), df, function(col) is.character(col) || is.factor(col)))) - character_cols <- character_cols[character_cols %unlike% "^_var_"] - non_numeric_cols <- names(which(vapply(FUN.VALUE = logical(1), df, function(col) mode(col) != "numeric" || inherits(col, c("Date", "POSIXTt", "factor"))))) - non_numeric_cols <- non_numeric_cols[non_numeric_cols %unlike% "^_var_"] - - if (!has_y(df) && "n" %in% numeric_cols && mode(df$n) == "numeric") { - # give preference to "n" for the y axis - plot2_message("Using ", font_blue("y = n")) - df <- df |> - mutate(`_var_y` = df |> pull(n)) - set_plot2_env(y = "n") - } - - if (!has_y(df)) { - # try to find numeric column for y - if (is.na(numeric_cols[1L])) { - stop("no numeric column found to use for y", call. = FALSE) - } - if (length(numeric_cols) > 1) { - # first check if there is also no x axis - if (!has_x(df)) { - # make x first numeric column and y second numeric column - plot2_message("Using ", font_blue("x = ", numeric_cols[1L], collapse = NULL)) - if (!geom_is_continuous_x(type)) { - # don't show when type for density geoms - y will not be used - plot2_message("Using ", font_blue("y = ", numeric_cols[2L], collapse = NULL)) - } - df <- df |> - mutate(`_var_x` = df |> pull(numeric_cols[1L]), - `_var_y` = df |> pull(numeric_cols[2L])) - set_plot2_env(x = numeric_cols[1L], y = numeric_cols[2L]) - } else { - if (!geom_is_continuous_x(type)) { - # don't show when type for density geoms - y will not be used - plot2_message("Using ", font_blue("y = ", numeric_cols[1L], collapse = NULL)) - } - df <- df |> - mutate(`_var_y` = df |> pull(numeric_cols[1L])) - set_plot2_env(y = numeric_cols[1L]) - } - } else { - # only one numeric column - if (geom_is_continuous_x(type)) { - if (!has_x(df)) { - plot2_message("Using ", font_blue("x = ", numeric_cols, collapse = NULL)) - df <- df |> - mutate(`_var_x` = df |> pull(numeric_cols)) - set_plot2_env(x = numeric_cols) - } - # don't show when type for density geoms - y will not be used - df <- df |> - mutate(`_var_y` = df |> pull(`_var_x`)) - } else if (!has_x(df) && type == "" && length(non_numeric_cols) == 0) { - # has no x and no y, make it a histogram - plot2_message("Using ", font_blue("x = ", numeric_cols, collapse = NULL)) - plot2_message("Assuming ", font_blue("type = \"histogram\""), - " since the data has only one numeric variable and no other variables") - type <- "geom_histogram" - df <- df |> - mutate(`_var_x` = df |> pull(numeric_cols), - `_var_y` = df |> pull(numeric_cols)) - set_plot2_env(x = numeric_cols, y = numeric_cols) - } else { - if (has_x(df) && get_x_name(df) == numeric_cols) { - if (type == "") { - plot2_message("Assuming ", font_blue("type = \"histogram\""), - " since the ", font_blue("x"), - " variable (", font_blue(get_x_name(df)), ") is the only numeric variable") - type <- "geom_histogram" - df <- df |> - mutate(`_var_y` = df |> pull(`_var_x`)) - } else { - stop("No variable found for y since the x variable (", get_x_name(df), - ") is the only numeric variable in the data set.\nDid you mean type = \"histogram\"?", call. = FALSE) - } - } else { - plot2_message("Using ", font_blue("y = ", numeric_cols, collapse = NULL)) - df <- df |> - mutate(`_var_y` = df |> pull(numeric_cols)) - set_plot2_env(y = numeric_cols) - } - } - } - } - - # this is required to plot e.g. difftime - # integers and doubles both return FALSE for requires_numeric_coercion() - if (has_y(df) && - (requires_numeric_coercion(get_y(df)) || - "AMR" %in% rownames(utils::installed.packages()) && AMR::is.mic(get_y(df)))) { - plot2_message(paste0("Coercing values of ", font_blue("y"), - font_black(" from class "), font_blue(paste(class(get_y(df)), collapse = "/")), - font_black(" to class "), font_blue("double"))) - df <- df |> - mutate(`_var_y` = as.double(`_var_y`)) - df[, get_y_name(df)] <- df$`_var_y` - } - if (has_x(df) && requires_numeric_coercion(get_x(df))) { - df <- df |> - mutate(`_var_x` = as.double(`_var_x`)) - df[, get_x_name(df)] <- df$`_var_x` - } - - if (misses_x && !has_x(df) && ncol(df) > 1) { - eligible_cols <- colnames(df)[colnames(df) %unlike% "^(y|_var_(x|y|category|facet|datalabels))$"] - # take first column if it's not used for y - if (identical(pull(df, 1), get_y(df))) { - x_col <- eligible_cols[2L] - } else { - x_col <- eligible_cols[1L] - } - plot2_message("Using ", font_blue("x = ", x_col, collapse = NULL)) - df <- df |> - mutate(`_var_x` = df |> pull(x_col)) - set_plot2_env(x = x_col) - } - - if (misses_x && misses_category && !has_category(df) && ncol(df) > 2 && type != "geom_sf") { - # category must only be used if factor or character - # and if x was also missing - cols <- vapply(FUN.VALUE = logical(1), - df, - function(col) { - (is.factor(col) || is.character(col)) & - !identical(get_y(df), col) & - !(has_x(df) && identical(get_x(df), col)) - }) - cols <- names(cols)[cols] - if (has_facet(df)) { - # remove columns that are already used for facet - cols <- cols[!cols %in% c("_var_facet", get_facet_name(df))] - } - if (length(cols) > 0) { - plot2_message("Using ", font_blue("category = ", cols[1L], collapse = NULL)) - df <- df |> - mutate(`_var_category` = df |> pull(cols[1L])) - set_plot2_env(category = cols[1L]) - } - } - if (type == "geom_sf" && misses_category && !has_category(df) && !is.na(numeric_cols[1L])) { - # try to take the first numeric column for 'sf' plots - plot2_message("Using ", font_blue("category = ", numeric_cols[1L], collapse = NULL)) - df <- df |> - mutate(`_var_category` = df |> pull(numeric_cols[1L])) - set_plot2_env(category = numeric_cols[1L]) - } - - # if given FALSE for a direction (e.g., category = FALSE), remove these columns - if (has_category(df) && all(get_category(df) == FALSE)) { - df <- df |> select(-`_var_category`) - plot2_env$mapping_category <- NULL - } - if (has_facet(df) && all(get_facet(df) == FALSE)) { - df <- df |> select(-`_var_facet`) - plot2_env$mapping_facet <- NULL - } - if (has_datalabels(df) && - (all(get_datalabels(df) == FALSE) || - (!is.null(dots$type) && dots$type != "sf" && - geom_is_continuous(suppressMessages(validate_type(dots$type, df))) && - isTRUE(!type %in% c("geom_tile", "geom_raster", "geom_rect"))))) { - # remove datalabels if `datalabels = FALSE`, or if the type now seems to be continuous - df <- df |> select(-`_var_datalabels`) - } - - # if the secondary y axis is not within the limits of the primary y axis, the primary axis will be transformed - # so store the factor in which they change, and transform the data accordingly - if (has_y_secondary(df)) { - max_primary <- max(get_y(df), na.rm = TRUE) - max_secondary <- max(get_y_secondary(df), na.rm = TRUE) - # if 15% difference, create own secondary y breaks - if (abs((max_secondary - max_primary) / max_secondary) >= 0.15) { - plot2_env$y_secondary_factor <- max_secondary / max_primary - df$`_var_y_secondary` <- df$`_var_y_secondary` / plot2_env$y_secondary_factor - } - } - - # add surrogate columns to df - if (has_x(df) && !is.null(plot2_env$mapping_x) && - !plot2_env$mapping_x %in% colnames(df) && plot2_env$mapping_x != "NULL") { - df$`_label_x` <- get_x(df) - colnames(df)[colnames(df) == "_label_x"] <- paste0(trimws(plot2_env$mapping_x), collapse = " ") - } - if (has_y(df) && !is.null(plot2_env$mapping_y) && - !plot2_env$mapping_y %in% colnames(df) && plot2_env$mapping_y != "NULL") { - df$`_label_y` <- get_y(df) - colnames(df)[colnames(df) == "_label_y"] <- paste0(trimws(plot2_env$mapping_y), collapse = " ") - } - if (has_category(df) && !is.null(plot2_env$mapping_category) && - !plot2_env$mapping_category %in% colnames(df) && plot2_env$mapping_category != "NULL") { - df$`_label_category` <- get_category(df) - colnames(df)[colnames(df) == "_label_category"] <- paste0(trimws(plot2_env$mapping_category), collapse = " ") - } - if (has_facet(df) && !is.null(plot2_env$mapping_facet) && - !plot2_env$mapping_facet %in% colnames(df) && plot2_env$mapping_facet != "NULL") { - df$`_label_facet` <- get_facet(df) - colnames(df)[colnames(df) == "_label_facet"] <- paste0(trimws(plot2_env$mapping_facet), collapse = " ") - } - if (has_y_secondary(df) && !is.null(plot2_env$mapping_y_secondary) && - !plot2_env$mapping_y_secondary %in% colnames(df) && plot2_env$mapping_y_secondary != "NULL") { - df$`_label_y_secondary` <- get_y_secondary(df) - colnames(df)[colnames(df) == "_label_y_secondary"] <- paste0(trimws(plot2_env$mapping_y_secondary), collapse = " ") - } - - if (has_datalabels(df)) { - if (all(get_datalabels(df) == TRUE)) { - # for when given: datalabels = TRUE, guess the results - if (type == "geom_sf") { - # take values from first character column in case of sf plots - if (!is.na(character_cols[1L])) { - plot2_message("Using ", font_blue("datalabels = ", character_cols[1L], collapse = NULL)) - df <- df |> mutate(`_var_datalabels` = df |> pull(character_cols[1L])) - } else { - plot2_warning("No suitable column found for ", font_blue("datalabels = TRUE")) - df <- df |> select(-`_var_datalabels`) - } - } else if (has_category(df) && type %in% c("geom_tile", "geom_raster", "geom_rect")) { - # take the values from the category column - df <- df |> mutate(`_var_datalabels` = `_var_category`) - } else { - # otherwise take values from the y column - df <- df |> mutate(`_var_datalabels` = `_var_y`) - } - } - # format datalabels - if (requires_numeric_coercion(get_datalabels(df))) { - # force double for e.g. difftime - df <- df |> - mutate(`_var_datalabels` = as.double(`_var_datalabels`)) - } - df <- df |> - mutate(`_var_datalabels` = format_datalabels(`_var_datalabels`, - datalabels.round = dots$datalabels.round, - datalabels.format = dots$datalabels.format, - decimal.mark = dots$decimal.mark, - big.mark = dots$big.mark, - y.percent = dots$y.percent)) - } - - # turn x to character if data seems to suggest so - if (has_x(df) &&!isTRUE(dots$x.character)) { - if (is.null(dots$x.character) && - is.numeric(get_x(df)) && - all(get_x(df, na.rm = TRUE) >= 2000) && - all(get_x(df, na.rm = TRUE) <= 2050)) { - plot2_message("Assuming ", font_blue("x.character = TRUE"), - " since the ", font_blue("x"), " labels seem to be years") - dots$x.character <- TRUE - } else if (is.null(dots$x.character) && - is.numeric(get_x(df)) && - (identical(sort(unique(get_x(df))), seq_len(12)) || - identical(sort(unique(get_x(df))), as.double(seq_len(12))))) { - plot2_message("Assuming ", font_blue("x.character = TRUE"), - " since the ", font_blue("x"), " labels seem to be months") - dots$x.character <- TRUE - } else if (is.numeric(get_x(df)) && - !type %in% c("", "geom_blank") && - !geom_is_continuous(type)) { - plot2_message("Using ", font_blue("x.character = TRUE"), - " for discrete plot type (", font_blue(type), ")", - " since ", font_blue(get_x_name(df)), " is numeric") - dots$x.character <- TRUE - } else if (is.numeric(get_x(df)) && - !is.null(dots$x.sort)) { - plot2_message("Using ", font_blue("x.character = TRUE"), - " since ", font_blue("x.sort"), " is set") - dots$x.character <- TRUE - } - } - if (isTRUE(dots$x.character)) { - df <- df |> - mutate(`_var_x` = as.character(`_var_x`)) - } - # turn category to character if data seems to suggest so - if (has_category(df) &&!isTRUE(dots$category.character)) { - if (is.null(dots$category.character) && - is.numeric(get_category(df)) && - all(get_category(df, na.rm = TRUE) >= 2000) && - all(get_category(df, na.rm = TRUE) <= 2050)) { - plot2_message("Assuming ", font_blue("category.character = TRUE"), - " since ", font_blue("category"), " seems to be years") - dots$category.character <- TRUE - } else if (is.null(dots$category.character) && - is.numeric(get_category(df)) && - (identical(sort(unique(get_category(df))), seq_len(12)) || - identical(sort(unique(get_category(df))), as.double(seq_len(12))))) { - plot2_message("Assuming ", font_blue("category.character = TRUE"), - " since ", font_blue("category"), " seems to be months") - dots$category.character <- TRUE - } else if (is.numeric(get_category(df)) && - is.null(dots$category.character) && - !geom_is_continuous(type)) { - type_prelim <- type - if (type_prelim == "") { - # get preliminary type - type_prelim <- tryCatch(suppressMessages(validate_type("", df = df)), error = function(e) "geom_col") - } - if (!geom_is_continuous(type_prelim)) { - plot2_message("Assuming ", font_blue("category.character = TRUE"), - " for discrete plot type (", font_blue(type_prelim), ")", - " since ", font_blue(get_category_name(df)), " is numeric") - dots$category.character <- TRUE - } - } - } - if (isTRUE(dots$category.character) && has_category(df)) { - df <- df |> - mutate(`_var_category` = as.character(`_var_category`)) - } - - # remove infinite values - if (has_y(df) && any(is.infinite(get_y(df)), na.rm = TRUE)) { - inf_values <- sum(is.infinite(get_y(df))) - df <- df |> filter(!is.infinite(`_var_y`)) - plot2_message("Removed ", inf_values, - " row", ifelse(inf_values > 1, "s", ""), - " with an infinite value of ", - font_blue("y"), - ifelse(get_y_name(df) != "y", - paste0(font_black(" ("), font_blue(get_y_name(df)), font_black(")")), - "")) - } - # replace int64 values - if (has_y(df) && inherits(get_y(df), "integer64")) { - df <- df |> - mutate(`_var_y` = as.integer(`_var_y`)) - df[, get_y_name(df)] <- df$`_var_y` - plot2_message("Replaced integer64 values of ", - font_blue("y"), - ifelse(get_y_name(df) != "y", - paste0(font_black(" ("), font_blue(get_y_name(df)), font_black(")")), - ""), - " with regular integers") - } - - # complete data - df <- df |> - complete_direction("x", has_x(df), dots$x.complete) |> - complete_direction("category", has_category(df), dots$category.complete) |> - complete_direction("facet", has_facet(df), dots$facet.complete) - - # remove or replace NAs - rows_with_NA <- df |> - select(c(get_x_name(df), get_category_name(df), get_facet_name(df), - matches("_var_(x|category|facet)"))) |> - stats::na.omit() |> - attributes() - rows_with_NA <- as.double(rows_with_NA$na.action) - if (length(rows_with_NA) > 0) { - # so some are NAs - if (isTRUE(dots$na.rm)) { - plot2_message("Removed ", length(rows_with_NA), - " row", ifelse(rows_with_NA > 1, "s", ""), - " since ", font_blue("na.rm = TRUE")) - df <- df[-rows_with_NA, , drop = FALSE] - } else { - # replace NAs - plot2_env$na_replaced <- 0 - plot2_env$na_replaced_vars <- character(0) - is_numeric <- function(x) { - mode(x) == "numeric" || is.numeric(x) || inherits(x, c("Date", "POSIXt")) - } - df <- df |> - mutate(across(c(get_x_name(df), get_category_name(df), get_facet_name(df), - matches("_var_(x|category|facet)")), - function(x) { - if (is.factor(x) && any(is.na(x))) { - # add as last factor level - levels(x) <- c(levels(x), dots$na.replace) - } - if ((!is_numeric(x) || is.factor(x)) && any(is.na(x))) { - plot2_env$na_replaced_vars <- c(plot2_env$na_replaced_vars, cur_column()) - plot2_env$na_replaced <- plot2_env$na_replaced + sum(is.na(x)) - x[is.na(x)] <- dots$na.replace - } - x - })) - if (plot2_env$na_replaced > 0) { - plot2_env$na_replaced_vars <- plot2_env$na_replaced_vars[plot2_env$na_replaced_vars %unlike% "^_var_"] - plot2_message("Replacing ", font_magenta("NA"), - " in column", ifelse(length(plot2_env$na_replaced_vars) > 1, "s ", " "), - paste(font_blue(plot2_env$na_replaced_vars, collapse = NULL), collapse = " and "), - " using ", font_blue(paste0("na.replace = \"", dots$na.replace, "\""))) - } - } - } - if (anyNA(df$`_var_y`)) { - plot2_warning(paste0("Unable to plot ", sum(is.na(df$`_var_y`)), - " value", ifelse(sum(is.na(df$`_var_y`)) > 1, "s", ""), - " where ", get_y_name(df), " = NA")) - df <- df |> - filter(!is.na(`_var_y`)) - } - - # check if years on x should be removed - if (is.null(dots$x.date_remove_years) && - has_category(df) && - has_x(df) && - inherits(get_x(df), c("Date", "POSIXt")) && - all(format(get_x(df), "%Y") == get_category(df), na.rm = TRUE)) { - plot2_message("Assuming ", font_blue("x.date_remove_years = TRUE"), - " since ", font_blue("category"), " contains the years of ", font_blue(get_x_name(df))) - dots$x.date_remove_years <- TRUE - } - if (isTRUE(dots$x.date_remove_years) && has_x(df) && inherits(get_x(df), c("Date", "POSIXt"))) { - df <- df |> mutate(`_var_x` = unify_years(get_x(df))) - df[, get_x_name(df)] <- df$`_var_x` - } - - # apply sorting - df.bak <- df - if (has_x(df) && type != "geom_sf") { - if (dots$type_backup != "sankey") { - if (is.null(dots$x.sort) && inherits(get_x(df), c("character", "factor"))) { - dots$x.sort <- TRUE - } - df <- df |> - mutate(`_var_x` = sort_data(values = get_x(df), - original_values = get_x(df.bak), - sort_method = dots$x.sort, - datapoints = get_y(df), - summarise_function = dots$summarise_function, - summarise_fn_name = dots$summarise_fn_name, - horizontal = dots$horizontal, - drop = dots$x.drop, - argument = "x.sort")) |> - arrange(across(`_var_x`)) - df[, get_x_name(df)] <- df$`_var_x` # required to keep sorting after summarising - } - } - if (has_category(df)) { - df <- df |> - mutate(`_var_category` = sort_data(values = get_category(df), - original_values = get_category(df.bak), - sort_method = dots$category.sort, - datapoints = get_y(df), - summarise_function = dots$summarise_function, - summarise_fn_name = dots$summarise_fn_name, - horizontal = dots$horizontal, - drop = TRUE, - argument = "category.sort")) - df[, get_category_name(df)] <- df$`_var_category` # required to keep sorting after summarising - } - if (has_facet(df)) { - df <- df |> - mutate(`_var_facet` = sort_data(values = get_facet(df), - original_values = get_facet(df.bak), - sort_method = dots$facet.sort, - datapoints = get_y(df), - summarise_function = dots$summarise_function, - summarise_fn_name = dots$summarise_fn_name, - horizontal = FALSE, # never reversely sort when horizontal - drop = TRUE, - argument = "facet.sort")) - df[, get_facet_name(df)] <- df$`_var_facet` # required to keep sorting after summarising - } - - # sankey plot reorganisation to be able to use {ggforce} later on - if (dots$type_backup == "sankey") { - x_names <- plot2_env$x_variable_names - df_new <- df |> - mutate(`_sankey_split` = df |> pull(x_names[1]) |> as.character(), - `_sankey_x` = x_names[1], - `_sankey_id` = seq_len(nrow(df))) - for (i in 2:length(x_names)) { - df_new <- df_new |> - bind_rows(df |> - mutate(`_sankey_split` = df |> pull(x_names[i]) |> as.character(), - `_sankey_x` = x_names[i], - `_sankey_id` = seq_len(nrow(df)))) - } - # make sure that order of x gets preserved - if (is.null(dots$x.sort)) { - dots$x.sort <- "inorder" - } - df_new$`_sankey_x` <- sort_data(values = df_new$`_sankey_x`, - original_values = df_new$`_sankey_x`, - sort_method = dots$x.sort, - datapoints = df_new$`_var_y`, - summarise_function = dots$summarise_function, - summarise_fn_name = dots$summarise_fn_name, - horizontal = dots$horizontal, - drop = dots$x.drop, - argument = "x.sort") - df <- df_new - } - - # very last part before setting max items - everything has been transformed as needed. - # are the data distinct, were tidyverse language selectors used in the right way? - type_validated <- suppressMessages(validate_type(dots$type, df)) - if ((!geom_is_continuous(type_validated) || geom_is_line_or_area(type_validated)) && - !is.null(dots$summarise_function) && - dots$type_backup != "sankey" && - (df |> select(starts_with("_var")) |> distinct() |> nrow()) < nrow(df)) { - y_name <- get_y_name(df) - df <- df |> - group_by(across(c(get_x_name(df), get_category_name(df), get_facet_name(df), - matches("_var_(x|category|facet)")))) |> - summarise(`_var_y` = dots$summarise_function(`_var_y`), - .groups = "drop") - df[, y_name] <- df$`_var_y` - - if (!dots$summarise_fn_name %in% c("summarise_function", "function(x) x")) { - plot2_warning("Values in ", font_blue("y"), " were not summarised, now using ", - font_blue(paste0("y = ", dots$summarise_fn_name, "(", get_y_name(df), ")")), " since ", - font_blue(paste0("summarise_function = ", dots$summarise_fn_name)), " was set.\n", - " When using a transformation function on ", font_blue("x"), - ifelse(has_category(df), paste0(" or ", font_blue("category")), ""), - ifelse(has_facet(df), paste0(" or ", font_blue("facet")), ""), - ", also use a summarising function on ", font_blue("y"), ".") - } - } - - if (type != "geom_sf") { - # apply limitations (have to been after sorting, e.g. on frequency) - df <- set_max_items(df = df, - y = get_y(df), - x = get_x_name(df), - x.max_items = dots$x.max_items, - x.max_txt = dots$x.max_txt, - category = get_category_name(df), - category.max_items = dots$category.max_items, - category.max_txt = dots$category.max_txt, - facet = get_facet_name(df), - facet.max_items = dots$facet.max_items, - facet.max_txt = dots$facet.max_txt, - horizontal = dots$horizontal, - summarise_function = dots$summarise_function, - decimal.mark = dots$decimal.mark, - big.mark = dots$big.mark, - datalabels.round = dots$datalabels.round, - datalabels.format = dots$datalabels.format, - y.percent = dots$y.percent) - # sort on x, important when piping plot2()'s after plot2()'s - if (has_x(df)) { - df <- df |> - arrange(across(`_var_x`)) - } - } - - # return output - df -} - -#' @importFrom dplyr mutate across -validate_taxonomy <- function(df) { - if (!has_x(df)) { - return(df) - } - suppressWarnings(requireNamespace("AMR", quietly = TRUE)) - taxonomic_nms <- unique(c(AMR::microorganisms$family, - AMR::microorganisms$genus, - AMR::microorganisms$species, - AMR::microorganisms$subspecies)) - make_taxonomy <- function(x, nms = taxonomic_nms) { - if (is.null(x)) { - return(NULL) - } - out <- vapply(FUN.VALUE = character(1), - X = strsplit(x, " "), - FUN = function(nm) { - if (!all(is.na(nm))) { - nm[nm %in% nms] <- paste0("*", nm[nm %in% nms], "*") - nm <- paste0(nm, collapse = " ") - nm <- gsub("(.*)([A-Z][.]) [*]([a-z]+)[*](.*)", "\\1*\\2 \\3*\\4", nm, perl = TRUE) - } else if (length(nm) == 0) { - # this is because of `strsplit("", " ")` - nm <- "" - } - nm - }, - USE.NAMES = FALSE) - out <- gsub("* *", " ", out, fixed = TRUE) - out - } - taxonomy_to_chr_expression <- function(x) { - with_taxonomy <- make_taxonomy(as.character(x)) - if (any(with_taxonomy %like% "[*].+[*]", na.rm = TRUE)) { - out <- vapply(with_taxonomy, - FUN.VALUE = character(1), - function(y) { - as.character(md_to_expression(y)) - }, - USE.NAMES = FALSE) - if (is.factor(x)) { - # take order of levels from original sorting, since e.g. `x.sort = "freq-desc"` may have been applied - factor(out, levels = out[match(levels(x), x)], ordered = is.ordered(x)) - } else { - out - } - } else { - # no taxonomic values found - x - } - } - df <- df |> - mutate(across(get_x_name(df), taxonomy_to_chr_expression)) - df$`_var_x` <- df[, get_x_name(df), drop = TRUE] - df -} - -#' @importFrom ggplot2 scale_x_discrete scale_x_date scale_x_datetime scale_x_continuous expansion waiver -#' @importFrom scales reverse_trans pretty_breaks -#' @importFrom cleaner format_datetime -#' @importFrom certestyle format2 -validate_x_scale <- function(values, - x.date_breaks, - x.date_labels, - x.breaks, - x.n_breaks, - x.expand, - x.labels, - x.limits, - x.position, - x.transform, - x.drop, - x.zoom, - decimal.mark, - big.mark, - horizontal, - type_backup) { - - if (isTRUE(x.zoom) && is.null(x.limits)) { - x.limits <- c(NA_real_, NA_real_) - if (is.null(x.expand)) { - # set default value to 0.5 - x.expand <- 0.5 - } - } - - set_x.expand <- !is.null(x.expand) - if (is.null(x.expand)) { - if (is.null(x.limits)) { - # set default value to 0.5 - x.expand <- 0.5 - } else { - if (!inherits(values, c("Date", "POSIXt"))) { - plot2_message("Assuming ", font_blue("x.expand = 0"), " since ", font_blue("x.limits"), " is set") - x.expand <- 0 - } else { - # dates - no need mention that x.expand is set to 0.5 - it's already the default - x.expand <- 0.5 - } - } - } - if (is.null(x.transform)) { - x.transform <- "identity" - } - - if (!is.null(x.limits)) { - if (length(x.limits) != 2) { - if (length(x.limits) == 1) { - x.limits <- rep(x.limits, 2) - } else { - stop("`x.limits` must be of length 1 or 2", call. = FALSE) - } - } - if (inherits(values, "Date")) { - x.limits <- as.Date(x.limits, origin = "1970-01-01") - } else if (inherits(values, "POSIXt")) { - x.limits <- as.POSIXct(x.limits, origin = "1970-01-01") - } - if (inherits(values, c("Date", "POSIXt"))) { - # edit limits so x.limits has one spare one at each side - x.limits[1] <- x.limits[1] - 1 - x.limits[2] <- x.limits[2] + 1 - # strip that extra ones from x.expand, so that all columns will plot - if (!is.function(x.expand)) { - x.expand <- x.expand - 1 - } - } - } - - if (!is.function(x.expand) && !set_x.expand) { - if (length(x.expand) == 1) { - x.expand <- c(x.expand, x.expand) - } - x.expand <- expansion(mult = ifelse(inherits(values, c("Date", "POSIXt")), 0.05, 0), - add = x.expand) - } - - if (inherits(values, c("Date", "POSIXt"))) { - auto_breaks_labels <- determine_date_breaks_labels(values) - if (is.null(x.date_breaks)) { - x.date_breaks <- auto_breaks_labels$breaks - plot2_message("Using ", font_blue("x.date_breaks = \"", x.date_breaks, "\"", collapse = ""), - " based on data") - } - if (is.null(x.date_labels)) { - x.date_labels <- auto_breaks_labels$labels - plot2_message("Using ", font_blue("x.date_labels = \"", x.date_labels, "\"", collapse = ""), - " based on data") - } - } - if (inherits(values, "Date")) { - scale_x_date(position = x.position, - date_breaks = x.date_breaks, - date_labels = format_datetime(x.date_labels), - expand = x.expand, - limits = x.limits, - labels = if (is.null(x.labels)) waiver() else x.labels) - } else if (inherits(values, "POSIXt")) { - scale_x_datetime(position = x.position, - date_breaks = x.date_breaks, - date_labels = format_datetime(x.date_labels), - expand = x.expand, - limits = x.limits, - labels = if (is.null(x.labels)) waiver() else x.labels) - } else { - if (!is.numeric(values)) { - scale_x_discrete(position = x.position, - drop = x.drop, - labels = if (is.null(x.labels)) waiver() else x.labels, - expand = if (set_x.expand) x.expand else waiver()) - } else { - if (x.transform == "identity" && isTRUE(horizontal)) { - x.transform <- reverse_trans() - } - if (is.null(x.limits)) { - x.limits <- c(ifelse(min(values) < 0, NA_real_, 0), NA_real_) - } - if (tryCatch(length(x.transform) == 1 && x.transform != "identity", error = function(x) FALSE)) { - # some transformations, such as log, do not allow 0 - x.limits[x.limits == 0] <- NA_real_ - } - if (is.null(x.labels)) { - x.labels <- function(x, dec_mark = decimal.mark, big_mark = big.mark, ...) { - format2(x, - round = max(2, sigfigs(diff(range(x, na.rm = TRUE))) + 1), - decimal.mark = dec_mark, - big.mark = big_mark) - } - } - breaks_fn <- function(values, x.breaks, x.n_breaks, waiver) { - if (!is.null(x.breaks)) { - x.breaks - } else if (all(values %% 1 == 0, na.rm = TRUE) && max(values, na.rm = TRUE) < 5) { - # whole numbers - only strip decimal numbers if total y range is low - function(x, ...) unique(floor(pretty(seq(0, (max(x, na.rm = TRUE) + 1) * 3)))) - } else { - pretty_breaks(n = ifelse(is.null(x.n_breaks), 5, x.n_breaks)) - } - } - - if (set_x.expand == FALSE) { - if (min(values, na.rm = TRUE) >= 0) { - x.expand <- expansion(mult = c(0.025, 0.05)) - } else { - x.expand <- expansion(mult = c(0.05, 0.05)) - } - } else if (length(x.expand) == 1) { - x.expand <- expansion(mult = c(x.expand, x.expand)) - } else if (length(x.expand) == 2) { - x.expand <- expansion(mult = x.expand) - } - scale_x_continuous(labels = x.labels, - breaks = breaks_fn(values = values, - x.breaks = x.breaks, - x.n_breaks = x.n_breaks, - waiver = waiver()), - n.breaks = x.n_breaks, - transform = x.transform, - position = x.position, - limits = x.limits, - expand = x.expand) - } - } -} - -#' @importFrom dplyr group_by across summarise -#' @importFrom ggplot2 waiver expansion scale_y_continuous sec_axis -#' @importFrom cleaner as.percentage -#' @importFrom scales pretty_breaks -#' @importFrom certestyle format2 format2_scientific -validate_y_scale <- function(df, - type, - y.24h, - y.age, - y.scientific, - y.breaks, - y.n_breaks, - y.expand, - y.labels, - y.limits, - y.percent, - y.percent_break, - misses_y.percent_break, - y.position, - y.transform, - y.zoom, - stacked, - stackedpercent, - facet.fixed_y, - decimal.mark, - big.mark, - add_y_secondary, - y_secondary.breaks = NULL, - y_secondary.title = NULL, - y_secondary.scientific = NULL, - y_secondary.percent = NULL, - y_secondary.labels = NULL, - markdown = NULL) { - if (isTRUE(y.zoom) && is.null(y.limits)) { - y.limits <- c(NA_real_, NA_real_) - if (is.null(y.expand)) { - y.expand <- c(0.25, 0.25) - } - } - if (is.null(y.transform)) { - y.transform <- "identity" - } - if (is.null(y.expand)) { - if (is.null(y.limits)) { - # set default value to 0.25 - y.expand <- 0.25 - } else { - plot2_message("Assuming ", font_blue("y.expand = 0"), " since ", font_blue("y.limits"), " is set") - y.expand <- 0 - } - } - if (!is.null(y.limits) && length(y.limits) != 2) { - if (length(y.limits) == 1) { - y.limits <- rep(y.limits, 2) - } else { - stop("`y.limits` must be of length 1 or 2", call. = FALSE) - } - } - - values <- get_y(df) - if (mode(values) != "numeric") { - stop("The y scale must be numeric for plot type '", gsub("geom_", "", type), "' (current y class: ", - paste0(class(values), collapse = "/"), ").", - call. = FALSE) - } - - if (is.null(facet.fixed_y) && is.null(y.limits) && has_facet(df) && !isTRUE(stackedpercent) && type != "geom_histogram") { - # determine if scales should be fixed - if CV_ymax < 15% then fix them: - # (this does not work for facetted histograms) - y_maxima <- df |> - group_by(across(get_facet_name(df))) |> - summarise(max = max(`_var_y`, na.rm = TRUE)) - if (!any(is.infinite(y_maxima$max), na.rm = TRUE)) { - coeff_of_variation <- stats::sd(y_maxima$max) / mean(y_maxima$max) - if (coeff_of_variation < 0.15) { - plot2_message("Assuming ", font_blue("facet.fixed_y = TRUE"), - " since the ", digit_to_text(nrow(y_maxima)), " ", - font_blue("y"), " scales are roughly equal") - facet.fixed_y <- TRUE - } - } - } - - breaks_fn <- function(values, waiver, - y.breaks, y.n_breaks, y.expand, stackedpercent, - y.age, y.percent, y.percent_break, y.24h, y.limits, - y.transform) { - data_min <- min(0, values, na.rm = TRUE) * - (1 + y.expand[length(y.expand)]) - data_max <- max(values, na.rm = TRUE) - if (!inherits(values, c("Date", "POSIXt"))) { - data_max <- data_max * (1 + y.expand[length(y.expand)]) - } - if (y.transform != "identity") { - if (!is.null(y.breaks)) { - plot2_warning("Ignoring ", font_blue("y.breaks"), " since ", - font_blue(paste0("y.transform = \"", y.transform, "\""))) - } - return(waiver) - } else if (!is.null(y.breaks)) { - y.breaks - } else if (isTRUE(y.age)) { - # no decimal numbers, generate max 12 labels - function(x, ...) { - seq(from = min(0, x, na.rm = TRUE), - to = min(120, max(x, na.rm = TRUE), na.rm = TRUE), - by = 10) - } - } else if (isTRUE(y.24h)) { - function(x, ...) { - seq(from = min(0, x, na.rm = TRUE), - to = max(x, na.rm = TRUE), - by = 24) - } - } else if (isTRUE(stackedpercent)) { - # special case of y.percent, where the y scale is always 0 to 1 - function(x, y_percent_break = y.percent_break, ...) { - seq(from = min(0, x, na.rm = TRUE), - to = max(x, na.rm = TRUE), - by = y_percent_break) - } - } else if (isTRUE(y.percent)) { - # calculate how many labels will be printed, keep around 10 - if (is.null(y.limits)) { - y.limits <- c(data_min, data_max) - } - labels_n <- (max(y.limits) - min(y.limits)) / y.percent_break - if (is.na(labels_n)) { - labels_n <- 10 - } - if (isTRUE(misses_y.percent_break) && as.integer(labels_n) > 10) { - y.percent_break <- round((max(y.limits, na.rm = TRUE) - min(y.limits, na.rm = TRUE)) / 10, 2) - plot2_message("Using ", font_blue("y.percent_break =", y.percent_break), - " (", y.percent_break * 100, "%) to keep a maximum of ~10 labels") - } - if (!all(is.na(y.limits)) && (y.percent_break >= max(y.limits, na.rm = TRUE) || labels_n <= 3)) { - y.percent_break.bak <- y.percent_break - y.percent_break <- max(y.limits, na.rm = TRUE) / 6.5 - allowed <- c(1e6 / 10 ^ c(1:18), 5e6 / 10 ^ c(1:18)) - y.percent_break <- allowed[which.min(abs(allowed - y.percent_break))] - plot2_message("Using ", font_blue("y.percent_break =", format(y.percent_break, scientific = FALSE)), - " since the original setting (", font_blue(y.percent_break.bak), ")", - " would yield too few labels") - } - function(x, ...) { - seq(from = min(0, x, na.rm = TRUE), - to = max(x, na.rm = TRUE), - by = y.percent_break) - } - - } else if (all(values %% 1 == 0, na.rm = TRUE) && data_max < 5) { - # whole numbers - only strip decimal numbers if total y range is low - function(x, ...) { - unique(floor(pretty(seq(0, (max(x, na.rm = TRUE) + 1) * 3)))) - } - } else { - pretty_breaks(n = ifelse(is.null(y.n_breaks), 5, y.n_breaks)) - } - } - - labels_fn <- function(values, waiver, - y.labels, - y.age, y.scientific, y.percent, y.24h, stackedpercent, - decimal.mark, big.mark) { - if (!is.null(y.labels)) { - y.labels - } else if (isTRUE(y.scientific)) { - format2_scientific - } else if (isTRUE(y.24h)) { - function(x, dec = decimal.mark, big = big.mark, ...) { - paste0(format2(x, decimal.mark = dec, big.mark = big), - ifelse(Sys.getlocale("LC_COLLATE") %like% "nl|dutch", "u (", "h ("), - x / 24, - "d)") - } - } else if (isTRUE(y.age)) { - function(x, dec = decimal.mark, big = big.mark, ...) { - paste0(format2(x, decimal.mark = dec, big.mark = big, round = 0), - ifelse(Sys.getlocale("LC_COLLATE") %like% "nl|dutch", " jr", " yrs")) - } - } else if (isTRUE(y.percent) || isTRUE(stackedpercent)) { - function(x, dec = decimal.mark, big = big.mark, ...) { - format2(as.percentage(x), round = max(1, sigfigs(x) - 2), decimal.mark = dec, big.mark = big) - } - } else { - function(x, dec = decimal.mark, big = big.mark, ...) { - is_scientific <- any(format(x) %like% "^(-?[0-9.]+e-?[0-9.]+)$", na.rm = TRUE) || - diff(range(values, na.rm = TRUE)) > 10e5 - non_unique <- length(unique(format2(x[!is.na(x)]))) < length(format2(x[!is.na(x)])) - if (isTRUE(non_unique) || (isTRUE(is_scientific) && is.null(y.scientific))) { - if (isTRUE(is_scientific)) { - plot2_message("Assuming ", font_blue("y.scientific = TRUE")) - } - # scientific notation or non-unique labels, use expression function from certestyle - format2_scientific(x, decimal.mark = dec, big.mark = big) - } else { - format2(x, decimal.mark = dec, big.mark = big) - } - } - } - } - - limits_fn <- function(values, y.limits, - y.expand, facet.fixed_y, y.age, y.transform, - df) { - min_value <- min(0, min(values, na.rm = TRUE)) - if (y.transform != "identity") { - # in certain transformations, such as log, 0 is not allowed - min_value <- NA_real_ - } - if (!is.null(y.limits)) { - y.limits[y.limits == 0] <- min_value - y.limits - } else if (isTRUE(y.age)) { - # so no function, but force a vector (y.expand is needed since it won't expand) - c(min_value, max(values, na.rm = TRUE) * (1 + y.expand)) - } else if (has_facet(df) && isTRUE(facet.fixed_y)) { - if (isTRUE(stacked)) { - # max has to be determined based per sum on the category level, so calculate sum of y over x and facet - max_y <- df |> - group_by(across(c(get_x_name(df), get_facet_name(df))), - .drop = FALSE) |> - summarise(maximum = sum(`_var_y`, na.rm = TRUE)) - c(min_value, max(max_y$maximum)) - } else { - if (type == "geom_histogram") { - plot2_warning("Maximum limit of ", font_blue("y"), " cannot be determined well in histograms when ", font_blue("facet.fixed_y = TRUE")) - } - # otherwise, return max per y - c(min_value, max(values, na.rm = TRUE)) - } - } else { - function(x, y_expand = y.expand, min_val = min_value, ...) c(min(min_val, x, na.rm = TRUE), max(x, na.rm = TRUE)) - } - } - - expand_fn <- function(values, y.expand, y.age, stackedpercent, y.limits, type_backup) { - if (is.function(y.expand)) { - y.expand - } else if (isTRUE(y.age) || isTRUE(stackedpercent)) { - expansion(mult = c(0, 0)) - } else { - y.expand.bak <- y.expand - if (length(y.expand) == 1) { - y.expand <- rep(y.expand, 2) - } - if (is.numeric(y.limits) && length(y.limits[!is.na(y.limits)]) == 2) { - expansion(mult = c(ifelse(any(values < 0) || is.na(y.limits[1L]), y.expand[1], 0), - ifelse(any(values > 0) || is.na(y.limits[2L]), y.expand[2], 0))) - } else { - # when y.limits is not numeric, but e.g. a function - expansion(mult = c(ifelse(any(values < 0) || length(y.expand.bak) == 2, y.expand[1], 0), - ifelse(any(values > 0) || length(y.expand.bak) == 2, y.expand[2], 0))) - } - } - } - - if (isTRUE(add_y_secondary)) { - # ggplot2::sec_axis() only supports a simple transformation function to determine the scale - # so determine it, based on the primary y axis - secondary_values <- get_y_secondary(df) - fun <- function(x) x - br <- y_secondary.breaks - if (!is.null(plot2_env$y_secondary_factor)) { - # we previously transformed this variable to stay within the range of the primary y axis, - # so now transform back for the labels and the breaks - secondary_values <- secondary_values * plot2_env$y_secondary_factor - fctr <- eval(plot2_env$y_secondary_factor) - fun <- function(x) x * fctr - br <- br * plot2_env$y_secondary_factor - } - sec_y <- sec_axis(transform = fun, - breaks = br, - labels = labels_fn(values = secondary_values, - waiver = waiver(), - y.labels = y_secondary.labels, - y.percent = y_secondary.percent, - y.age = FALSE, - y.24h = FALSE, - y.scientific = y_secondary.scientific, - stackedpercent = stackedpercent, - decimal.mark = decimal.mark, - big.mark = big.mark), - name = validate_title(y_secondary.title, markdown = markdown)) - } else { - sec_y <- waiver() - } - - limits_evaluated <- limits_fn(values = values, - y.limits, - y.expand = y.expand, - facet.fixed_y = facet.fixed_y, - y.age = y.age, - y.transform = y.transform, - df) - - scale_y_continuous( - breaks = breaks_fn(values = values, - waiver = waiver(), - y.breaks = y.breaks, - y.n_breaks = y.n_breaks, - y.expand = y.expand, - stackedpercent = stackedpercent, - y.age = y.age, - y.percent = y.percent, - y.percent_break = y.percent_break, - y.24h = y.24h, - y.limits = y.limits, - y.transform = y.transform), - n.breaks = y.n_breaks, - labels = labels_fn(values = values, - waiver = waiver(), - y.labels, - y.percent = y.percent, - y.age = y.age, - y.24h = y.24h, - y.scientific = y.scientific, - stackedpercent = stackedpercent, - decimal.mark = decimal.mark, - big.mark = big.mark), - limits = limits_evaluated, - expand = expand_fn(values = values, - y.expand = y.expand, - y.age = y.age, - stackedpercent = stackedpercent, - y.limits = limits_evaluated), - transform = y.transform, - position = y.position, - sec.axis = sec_y - ) -} - -#' @importFrom ggplot2 scale_colour_gradient2 scale_colour_gradient scale_colour_gradientn expansion guide_colourbar element_text -#' @importFrom certestyle format2 -#' @importFrom cleaner as.percentage -#' @importFrom scales pretty_breaks -validate_category_scale <- function(values, - type, - cols, - category.labels, - category.percent, - category.breaks, - category.limits, - category.expand, - category.midpoint, - category.transform, - category.date_breaks, - category.date_labels, - stackedpercent, - legend.nbin, - legend.barheight, - legend.barwidth, - legend.reverse, - legend.position, - decimal.mark, - big.mark, - font, - colour_fill, - original_colours, - ...) { - # only for a numeric and date category scale - - if (is.null(category.transform)) { - category.transform <- "identity" - } - if (is.null(legend.position)) { - legend.position <- "right" - } else { - legend.position <- validate_legend.position(legend.position) - } - - labels_fn <- function(values, category.labels, category.percent, category.date_labels, stackedpercent, decimal.mark, big.mark) { - if (!is.null(category.labels)) { - category.labels - } else if (isTRUE(category.percent) || isTRUE(stackedpercent)) { - function(x, dec = decimal.mark, big = big.mark, ...) format2(as.percentage(x), decimal.mark = dec, big.mark = big) - } else if (is_date(values)) { - if (is.null(category.date_labels)) { - lbls <- determine_date_breaks_labels(values)$labels - plot2_message("Assuming ", font_blue("category.date_labels = \"", lbls, "\"", collapse = "")) - } else { - lbls <- category.date_labels - } - function(x, format = lbls, ...) format2(as.Date(as.numeric(x), origin = "1970-01-01"), format = format) - } else { - function(x, dec = decimal.mark, big = big.mark, ...) format2(x, decimal.mark = dec, big.mark = big) - } - } - breaks_fn <- function(values, category.breaks, category.percent, category.transform, category.date_breaks, waiver) { - if (category.transform != "identity") { - if (!is.null(category.breaks)) { - plot2_warning("Ignoring ", font_blue("category.breaks"), " since ", - font_blue(paste0("category.transform = \"", category.transform, "\""))) - } - return(waiver) - } else if (!is.null(category.breaks)) { - if (is_date(values) && is.null(category.date_breaks)) { - plot2_warning("Setting ", font_blue("category.breaks"), " is not useful for dates. Did you mean ", font_blue("category.date_breaks"), "?") - } - category.breaks - } else if (isTRUE(category.percent)) { - if (max(c(1, values), na.rm = TRUE) == 1) { - seq(0, 1, 0.25) - } else { - # print 5 labels nicely - pretty_breaks(n = 5) - } - } else if (is_date(values)) { - if (is.null(category.date_breaks)) { - breaks <- determine_date_breaks_labels(values)$breaks - plot2_message("Assuming ", font_blue("category.date_breaks = \"", breaks, "\"", collapse = "")) - } else { - breaks <- category.date_breaks - } - seq.Date(from = min(values, na.rm = TRUE), - to = max(values, na.rm = TRUE), - by = breaks) - # pretty_breaks(n = 5)(values) - } else if (all(values %% 1 == 0, na.rm = TRUE) && max(values, na.rm = TRUE) < 5) { - # whole numbers - only strip decimal numbers if total y range is low - if (diff(range(values, na.rm = TRUE)) < 5 && 0 %in% values[!is.na(values)]) { - sort(unique(values[!is.na(values)])) - } else { - function(x, ...) unique(floor(pretty(seq(0, (max(x, na.rm = TRUE) + 1) * 3)))) - } - } else { - # print 5 labels nicely - pretty_breaks(n = 5) - } - } - limits_fn <- function(values, category.limits, category.percent, category.transform, category.date_breaks, waiver) { - if (category.transform != "identity") { - # in certain transformations, such as log, 0 is not allowed - if (!is.null(category.limits)) { - plot2_warning("Ignoring ", font_blue("category.limits"), " since ", - font_blue(paste0("category.transform = \"", category.transform, "\""))) - } - c(NA_real_, NA_real_) - } else if (!is.null(category.limits)) { - category.limits - } else if (isTRUE(category.percent)) { - function(x, ...) c(min(0, x, na.rm = TRUE), max(1, x, na.rm = TRUE)) - } else if (is_date(values)) { - # for dates, take the outer range - c(min(values, na.rm = TRUE) - 1, max(values, na.rm = TRUE) + 1) - } else { - # now determine if we should start at zero: - # x will be the lower and upper limit - if zero under lower minus fifth of upper then start at zero - upper <- max(values, na.rm = TRUE) - lower <- min(values, na.rm = TRUE) - # round upper to significance of lower - new_upper <- max(upper, round(upper, digits = nchar(lower) * -1)) - # but only if within a 5th of the scale - if (upper / new_upper >= 0.8) { - upper <- new_upper - } - # and set lower to 0 if need be - if (lower >= 0 && lower - (upper / 5) < 0) { - lower <- 0 - } - # check if negative lower should be equal to upper - if (lower < 0 && lower / (upper * -1) >= 0.8) { - lower <- upper * -1 - } - c(lower, upper) - } - } - - if (is.numeric(category.expand)) { - category.expand <- expansion(mult = c(0, category.expand)) - } - - if (geom_has_only_colour(type) || identical(cols$colour, cols$colour_fill)) { - aest <- c("colour", "fill") - cols_category <- cols$colour - } else { - aest <- "fill" - cols_category <- cols$colour_fill - } - - # general arguments for any scale function below (they are called with do.call()) - args <- list(aesthetics = aest, - na.value = "white", - guide = guide_colourbar(ticks = FALSE, - draw.ulim = TRUE, - draw.llim = TRUE, - reverse = isTRUE(legend.reverse), - nbin = legend.nbin, - barheight = ifelse(legend.position %in% c("top", "bottom"), - legend.barwidth, - legend.barheight), - barwidth = ifelse(legend.position %in% c("top", "bottom"), - legend.barheight, - legend.barwidth)), - labels = labels_fn(values = values, - category.labels = category.labels, - category.percent = category.percent, - category.date_labels = category.date_labels, - stackedpercent = stackedpercent, - decimal.mark = decimal.mark, - big.mark = big.mark), - breaks = breaks_fn(values = values, - category.breaks = category.breaks, - category.percent = category.percent, - category.transform = category.transform, - category.date_breaks = category.date_breaks, - waiver = waiver()), - limits = limits_fn(values = values, - category.limits = category.limits, - category.percent = category.percent, - category.transform = category.transform, - category.date_breaks = category.date_breaks), - transform = category.transform) - - if (isTRUE(original_colours)) { - # original ggplot2 colours chosen, so just return scale without setting manual colours - return(do.call(scale_colour_gradient, args = args)) - } - - if (length(cols_category) == 1) { - if (is.na(cols_category) || cols_category %like% "[A-F0-9]{6}00$") { - # invisible, so don't return a scale in which colours are manually set, just the rest of the options - do.call(scale_colour_gradient, - args = args) - } else { - # 1 colour, start with white - if (!identical(colour_fill, "ggplot2") && !is.null(colour_fill)) { - plot2_message("Adding white to the ", font_blue("category"), - " scale - set two colours to ", font_blue("colour_fill"), - " to prevent this.") - } - do.call(scale_colour_gradient, - args = c(list(low = "white", - high = cols_category), - args)) - } - - } else if (length(cols_category) == 2) { - # 2 colours, low and high - do.call(scale_colour_gradient, - args = c(list(low = cols_category[1], - high = cols_category[2]), - args)) - - } else if (length(cols_category) == 3) { - # 3 colours, so low, mid (set as vector name) and high - if (!is.null(category.midpoint)) { - mid_point <- as.double(category.midpoint) - } else { - # default to the middle of the set limits - if (is.function(args$limits)) { - rng <- args$limits(values) - } else { - rng <- args$limits - } - mid_point <- sum(rng) / 2 - plot2_message("Using ", font_blue("category.midpoint =", round(mid_point, 2)), - ifelse(isTRUE(category.percent), - paste0(" (", format2(as.percentage(mid_point)), ", "), - " ("), - "the current ", font_blue("category"), " scale centre)") - } - do.call(scale_colour_gradient2, - args = c(list(low = cols_category[1], - mid = cols_category[2], - high = cols_category[3], - midpoint = mid_point), - args)) - - } else { - # more than 3 colours, create own divergent scale - # this can also be because one of the viridis colours was set with `colour` and/or `colour_fill` - do.call(scale_colour_gradientn, - args = c(list(colours = cols_category), - args)) - } -} - -#' @importFrom ggplot2 position_stack position_fill position_dodge2 position_jitter -#' @importFrom certestyle font_blue font_black -generate_geom <- function(type, - df, - stacked, - stackedpercent, - horizontal, - width, - size, - linetype, - linewidth, - reverse, - na.rm, - violin_scale, - jitter_seed, - binwidth, - cols, - original_colours = original_colours, - dots_geom, - mapping = NULL) { - - if (type == "geom_col") { - type <- "geom_bar" - } - geom_fn <- getExportedValue(name = type, ns = asNamespace("ggplot2")) - - # set position - if (isTRUE(stacked)) { - position <- position_stack(reverse = reverse) - } else if (isTRUE(stackedpercent)) { - position <- position_fill(reverse = reverse) - } else { - # small whitespace between columns: - position <- position_dodge2(width = width * 1.05, preserve = "single") - } - - set_arguments <- function(..., dots = dots_geom) { - arguments <- c(...) - c(arguments[!names(arguments) %in% names(dots)], dots) - } - - # set geoms - do.call() applies all arguments to the geom_fn function - if (type == "geom_bar") { - do.call(geom_fn, - args = set_arguments(list(width = width, - stat = "identity", - position = position, - na.rm = na.rm), - list(colour = cols$colour)[!has_category(df) & !isTRUE(original_colours)], - list(fill = cols$colour_fill)[!has_category(df) & !isTRUE(original_colours)], - list(mapping = mapping)[!is.null(mapping)])) - - } else if (type == "geom_area") { - do.call(geom_fn, - args = set_arguments(list(linetype = linetype, - linewidth = linewidth, - stat = "identity", - position = position, - na.rm = na.rm), - list(colour = cols$colour)[!has_category(df) & !isTRUE(original_colours)], - list(fill = cols$colour_fill)[!has_category(df) & !isTRUE(original_colours)], - list(mapping = mapping)[!is.null(mapping)])) - - } else if (type %in% c("geom_line", "geom_path")) { - do.call(geom_fn, - args = set_arguments(list(lineend = "round", - linetype = linetype, - linewidth = linewidth, - na.rm = na.rm), - list(colour = cols$colour)[!has_category(df) & !isTRUE(original_colours)], - list(mapping = mapping)[!is.null(mapping)])) - - } else if (type == "geom_point") { - do.call(geom_fn, - args = set_arguments(list(size = size, - na.rm = na.rm), - list(colour = cols$colour)[!has_category(df) & !isTRUE(original_colours)], - list(mapping = mapping)[!is.null(mapping)])) - - } else if (type == "geom_jitter") { - do.call(geom_fn, - args = set_arguments(list(size = size, - position = position_jitter(seed = jitter_seed), - na.rm = na.rm), - list(colour = cols$colour)[!has_category(df) & !isTRUE(original_colours)], - list(mapping = mapping)[!is.null(mapping)])) - - } else if (type == "geom_boxplot") { - do.call(geom_fn, - args = set_arguments(list(outlier.size = size * 3, - outlier.alpha = 0.75, - width = width, - linewidth = linewidth, # line width of whole box - fatten = ifelse(linewidth < 1, 1.5, linewidth + 0.5), # factor to make median thicker compared to lwd - na.rm = na.rm), - list(colour = cols$colour)[!has_category(df) & !isTRUE(original_colours)], - list(fill = cols$colour_fill)[!has_category(df) & !isTRUE(original_colours)], - list(fill = "white")[has_category(df) & isTRUE(original_colours)], - list(mapping = mapping)[!is.null(mapping)])) - - } else if (type == "geom_violin") { - do.call(geom_fn, - args = set_arguments(list(width = width, - linewidth = linewidth, # line width, of whole violin - scale = violin_scale, - trim = TRUE, - draw_quantiles = c(0.25, 0.5, 0.75), - na.rm = na.rm), - list(colour = cols$colour)[!has_category(df) & !isTRUE(original_colours)], - list(fill = cols$colour_fill)[!has_category(df) & !isTRUE(original_colours)], - list(fill = "white")[has_category(df) & isTRUE(original_colours)], - list(mapping = mapping)[!is.null(mapping)])) - - } else if (type == "geom_histogram") { - if (is.null(binwidth)) { - # this will be the default binwidth: the difference in the range, divided by 12 to 22. - values <- get_x(df) - values <- values[!is.infinite(values)] - binwidth <- as.double(diff(range(values, na.rm = TRUE))) / (12 + min(10, length(unique(values)) / 20)) - if (binwidth < 0.01) { - # do not round - } else if (binwidth < 1) { - binwidth <- round(binwidth, 3) - } else if (binwidth > 10) { - binwidth <- round(binwidth, 0) - } else { - binwidth <- round(binwidth, 1) - } - plot2_message("Using ", font_blue("binwidth =", format(binwidth, scientific = FALSE)), " based on data") - } - do.call(geom_fn, - args = set_arguments(list(linetype = linetype, - linewidth = linewidth, - binwidth = binwidth, - na.rm = na.rm), - list(colour = cols$colour)[!has_category(df) & !isTRUE(original_colours)], - list(fill = cols$colour_fill)[!has_category(df) & !isTRUE(original_colours)], - list(mapping = mapping)[!is.null(mapping)])) - - } else if (type == "geom_density") { - do.call(geom_fn, - args = set_arguments(list(linetype = linetype, - linewidth = linewidth, - na.rm = na.rm), - list(colour = cols$colour)[!has_category(df) & !isTRUE(original_colours)], - list(fill = cols$colour_fill)[!has_category(df) & !isTRUE(original_colours)], - list(mapping = mapping)[!is.null(mapping)])) - - } else if (type == "geom_sf") { - do.call(geom_fn, - args = set_arguments(list(linetype = linetype, - linewidth = linewidth, - na.rm = na.rm), - list(colour = cols$colour)[length(cols$colour) == 1 & !isTRUE(original_colours)], - list(fill = cols$colour_fill)[!has_category(df) & !isTRUE(original_colours)])) - - } else if (type == "geom_blank") { - do.call(geom_fn, - args = set_arguments(list(na.rm = na.rm))) - - } else if (type == "geom_tile") { - do.call(geom_fn, - args = set_arguments(list(linetype = linetype, - linewidth = linewidth, - na.rm = na.rm))) - - } else if (type == "geom_raster") { - do.call(geom_fn, - args = set_arguments(list(na.rm = na.rm))) - - } else { - # try to put some arguments into the requested geom - plot2_warning(font_blue("type = \"", type, "\"", collapse = ""), " is currently only loosely supported") - do.call(geom_fn, - args = set_arguments(list(width = width, - size = size, - na.rm = na.rm), - list(colour = cols$colour)[!has_category(df) & !isTRUE(original_colours)], - list(fill = cols$colour_fill)[!has_category(df) & !isTRUE(original_colours)], - list(mapping = mapping)[!is.null(mapping)])) - } -} - -#' @importFrom certestyle colourpicker add_white -validate_colour <- function(df, - type, - type_backup, - colour, - colour_fill, - colour_opacity, - misses_colour_fill, - horizontal) { - - if (is.numeric(get_category(df)) || is_date(get_category(df))) { - viridis_colours <- c("viridis", "magma", "inferno", "plasma", "cividis", "rocket", "mako", "turbo") - colour.bak <- colour - # this is for validate_category_scale() - if (length(colour) == 1 && !is.na(colour)) { - if (colour == "certe") { - # divergent Certe scale - colour <- colourpicker(c("certeblauw0", "certegroen", "certegeel", "certeroze"), - opacity = colour_opacity) - } else if (colour %like% "certe([1-6]+)$") { - # take Certe colours - colour <- colourpicker(colour, 4, opacity = colour_opacity) - } else if (colour %in% viridis_colours) { - # generate viridis colour - colour <- colourpicker(colour, 5, opacity = colour_opacity) - } else { - colour <- colourpicker(colour, opacity = colour_opacity) - } - } else { - colour <- colourpicker(colour, opacity = colour_opacity) - } - - if (is.null(colour_fill) || identical(colour.bak, colour_fill)) { - colour_fill <- colour - } else { - if (length(colour_fill) == 1 && !is.na(colour_fill)) { - if (colour_fill == "certe") { - # divergent Certe scale - colour_fill <- colourpicker(c("certeblauw0", "certegroen", "certegeel", "certeroze"), - opacity = colour_opacity) - } else if (colour_fill %like% "certe([1-6]+)$") { - # take Certe colours - colour_fill <- colourpicker(colour_fill, 4, opacity = colour_opacity) - } else if (colour_fill %in% viridis_colours) { - # generate viridis colour - colour_fill <- colourpicker(colour_fill, 5, opacity = colour_opacity) - } else { - colour_fill <- colourpicker(colour_fill, opacity = colour_opacity) - } - } else { - colour_fill <- colourpicker(colour_fill, opacity = colour_opacity) - } - } - return(list(colour = colour, - colour_fill = colour_fill)) - } - - if (geom_is_continuous(type) && !geom_has_only_colour(type) && is.null(colour_fill) && any(colour %like% "certe")) { - # exception for Certe: "certeblauw" (colour) -> "certeblauw6" (colour_fill) - colour_fill <- as.character(colourpicker(colour, opacity = colour_opacity)) - if (type == "geom_sf") { - colour_fill[colour %like% "certe[a-z]*"] <- paste0(colour[colour %like% "certe[a-z]*"], "3") - } else { - colour_fill[colour %like% "certe[a-z]*"] <- paste0(colour[colour %like% "certe[a-z]*"], "6") - } - } - if (isTRUE(misses_colour_fill) && is.null(colour_fill) && !geom_is_continuous(type)) { - colour_fill <- colour - } - - if (!has_category(df)) { - # has no category - if (has_x(df) && length(unique(get_x(df))) != length(colour)) { - # take only the first - colour <- colour[1] - colour_fill <- colour_fill[1] - # take the official ggplot2 colour - if (identical(colour, "ggplot2")) { - colour <- "#595959" - } - if (identical(colour_fill, "ggplot2")) { - colour_fill <- "#595959" - } - } - colour <- colourpicker(colour, opacity = colour_opacity) - if (geom_is_continuous(type) && is.null(colour_fill)) { - # specific treatment for continuous geoms (such as boxplots/violins/histograms/...) - # note: for "certe" there is an exception earlier in this function - colour_fill <- add_white(colour, white = 0.75) - } else { - colour_fill <- colourpicker(colour_fill, opacity = colour_opacity) - } - - } else { - # has also category, and it's not numeric - n_unique <- length(unique(get_category(df))) - colour <- colourpicker(colour, - length = ifelse(length(colour) == 1, n_unique, 1), - opacity = colour_opacity) - if (geom_is_continuous(type) && is.null(colour_fill) && type_backup != "sankey") { - # specific treatment for continuous geoms (such as boxplots/violins/histograms/...) - # but not for Sankey plots - they have sankey.alpha - # note: for "certe" there is an exception earlier in this function - colour_fill <- add_white(colour, white = 0.75) - } else { - colour_fill <- colourpicker(colour_fill, - length = ifelse(length(colour_fill) == 1, n_unique, 1), - opacity = colour_opacity) - } - - if (isTRUE(horizontal)) { - colour <- rev(colour) - colour_fill <- rev(colour_fill) - } - - if (length(colour) > 1 && length(colour_fill) == 1) { - colour_fill <- colour - } - - # expand the range - df_nonempty <- df |> - filter(!is.na(`_var_category`) & !is.na(`_var_y`)) - if (has_x(df)) { - df_nonempty <- df_nonempty |> - filter(!is.na(`_var_x`)) - } - if (has_facet(df)) { - df_nonempty <- df_nonempty |> - filter(!is.na(`_var_facet`)) - } - # TODO this very hacky... since ggplot2 3.4.0 manual values in scale_*_manual work differently - grp_sizes <- group_sizes(df_nonempty) - grp_sizes <- grp_sizes[grp_sizes != 0] - n_categories <- length(grp_sizes) - if (any(grp_sizes > 1, na.rm = TRUE) && n_categories * n_distinct(get_category(df)) < nrow(df)) { - if (length(colour) < n_categories) { - # expand colour for all categories, except when all colours were named - colour <- c(colour, rep(colour, n_categories)[seq_len(n_categories - length(colour))]) - } - if (length(colour_fill) < n_categories) { - # expand colour_fill for all categories, except when all colours were named - colour_fill <- c(colour_fill, rep(colour_fill, n_categories)[seq_len(n_categories - length(colour_fill))]) - # remove empty groups - colour_fill <- colour_fill[grp_sizes != 0] - } - } - } - - if (type == "geom_sf" && !has_category(df)) { - colour_fill <- colour_fill[1] - } - - list(colour = colourpicker(colour), - colour_fill = colourpicker(colour_fill)) -} - -validate_size <- function(size, type, type_backup) { - if (is.null(size)) { - if (type_backup == "dumbbell") { - size <- 5 - } else if (type %in% c("geom_point", "geom_jitter")) { - size <- 2 - } else { - size <- 0.75 - } - } - size -} - -validate_width <- function(width, type) { - if (is.null(width)) { - if (type %in% c("geom_boxplot", "geom_violin", "geom_jitter")) { - width <- 0.75 - } else { - width <- 0.5 - } - } - width -} - -validate_linewidth <- function(linewidth, type, type_backup) { - if (is.null(linewidth)) { - if (type == "geom_sf") { - linewidth <- 0.1 - } else if (type %in% c("geom_boxplot", "geom_violin")) { - linewidth <- 0.5 - } else if (type_backup == "dumbbell") { - linewidth <- 1 - } else if (geom_is_continuous(type) && !geom_has_only_colour(type)) { - linewidth <- 0.25 - } else { - linewidth <- 0.5 - } - } - linewidth -} - -validate_markdown <- function(markdown, - x.title, - y.title, - legend.title, - title, - subtitle, - tag, - caption, - df = NULL) { - if (!is.null(markdown)) { - return(isTRUE(markdown)) - } - if (!is.null(df)) { - df_titles <- c(get_x_name(df), - get_y_name(df), - get_category_name(df), - get_facet_name(df), - get_datalabels(df)) - } else { - df_titles <- NULL - } - txt <- paste(c(tryCatch(as.character(x.title), error = function(e) ""), - tryCatch(as.character(y.title), error = function(e) ""), - tryCatch(as.character(legend.title), error = function(e) ""), - tryCatch(as.character(title), error = function(e) ""), - tryCatch(as.character(subtitle), error = function(e) ""), - tryCatch(as.character(tag), error = function(e) ""), - tryCatch(as.character(caption), error = function(e) ""), - tryCatch(as.character(df_titles), error = function(e) "")), - collapse = "") - out <- txt %like% "(\\^|[_*].+[_*])" - if (isTRUE(out)) { - plot2_message("Assuming ", font_blue("markdown = TRUE")) - } - out -} - -#' @importFrom dplyr mutate pull first -validate_title <- function(x, markdown, df = NULL, max_length = NULL) { - if (isTRUE(try(is_empty(x), silent = TRUE))) { - x <- NULL - } - suppressWarnings( - if (isTRUE(try(is.expression(x), silent = TRUE)) || - isTRUE(try(is.null(x), silent = TRUE)) || - isTRUE(try(isTRUE(x), silent = TRUE))) { - return(x) - } - ) - - # support for calculations, e.g. `title = paste("Total number =", n(), "rows")` - if (!is.null(df)) { - out <- tryCatch( - suppressWarnings( - df |> - # no tibbles, data.tables, sf, etc. objects: - as.data.frame(stringsAsFactors = FALSE) |> - mutate(`_new_title` = {{ x }}) |> - pull(`_new_title`) |> - unique() |> - first() - ), error = function(e) { - warning(format_error(e, - replace = c("`_new_title = ", "`_new_title`"), - by = c("`", "A title")), - call. = FALSE) - NULL - }) - if (is.null(out)) { - out <- "" - } - } else { - out <- concat(as.character(x)) - } - - out <- gsub("
", "\n", out, fixed = TRUE) - out_plain <- gsub("[^a-zA-Z0-9,. .-]", "", out) - - if (isTRUE(markdown)) { - # support mathematical characters - out <- gsub("!=", "\u2260", out, fixed = TRUE) - out <- gsub("<=", "\u2264", out, fixed = TRUE) - out <- gsub(">=", "\u2265", out, fixed = TRUE) - } - - # support for markdown - if (isTRUE(markdown) && - (isTRUE(out %like% "[*]+.+[*]+") - || isTRUE(out %like% "[a-zA-Z0-9,.-]_[{].+[}]") - || isTRUE(out %like% "[a-zA-Z0-9,.-] ?\\^ ?[{].+[}]") - || isTRUE(out %like% "[a-zA-Z0-9,.-] ?\\^ ?[a-zA-Z0-9,._-]") - || isTRUE(out %like% ".+") - || isTRUE(out %like% ".+") - || isTRUE(out %like% "[$]"))) { - out <- md_to_expression(out) - } - - # support overly lengthy titles - if (!is.null(max_length) && isTRUE(nchar(out_plain) > as.double(max_length))) { - if (is.expression(out)) { - x_deparsed <- trimws(deparse(substitute(x))) - x_deparsed <- x_deparsed[!x_deparsed %in% c("{", "}")] - plot2_warning("Multiple lines in ", font_blue(x_deparsed), - " cannot be set since it is an expression (does it contain markdown characters?)") - } else { - out <- gsub("
", "\n", out, fixed = TRUE) - out <- paste(strwrap(x = out, width = max_length), - collapse = "\n") - } - } - - out -} - -#' @importFrom ggplot2 theme_grey element_blank margin rel -#' @importFrom certestyle colourpicker -validate_theme <- function(theme, - type, - background, - text_factor, - font, - horizontal, - x.remove, - y.remove, - x.lbl_angle, - x.lbl_align, - x.lbl_italic, - facet.fill, - facet.bold, - facet.italic, - facet.size, - facet.margin, - legend.italic, - title.colour, - subtitle.colour, - has_y_secondary, - has_category, - col_y_primary, - col_y_secondary, - sankey.remove_axes) { - - if (!is.null(theme)) { - if (is.character(theme)) { - theme.bak <- theme - if (theme == "ggplot2") { - theme <- "ggplot2::theme_grey()" - } - # for `theme = "theme_bw"` and `theme = "theme_bw()"` - theme <- tryCatch(eval(parse(text = theme)), error = function(e) NULL) - if (is.null(theme)) { - # try again with prefix `ggplot2::` - theme <- tryCatch(eval(parse(text = paste0("ggplot2::", theme.bak))), error = function(e) NULL) - } - if (is.null(theme)) { - stop("unknown theme: ", theme.bak, call. = FALSE) - } - } - if (is.function(theme)) { - # for `theme = theme_bw` - theme <- theme() - } - if (!inherits(theme, "theme")) { - plot2_warning("No valid ggplot2 theme, using ", font_blue("theme = ggplot2::theme_grey()")) - theme <- NULL - } - } - - orginally_empty <- is_empty(theme) - if (isTRUE(orginally_empty)) { - # turn to default ggplot2 theme, so we can at least - # add all theme options set as arguments, like x.lbl_angle - theme <- theme_grey() - } - - # set other properties to theme, that are set in plot2(...) - if (!isTRUE(orginally_empty) && !is.null(background)) { - theme$panel.background <- element_rect(fill = colourpicker(background), - colour = theme$panel.background$colour, - linewidth = theme$panel.background$linewidth, - linetype = theme$panel.background$linetype) - theme$plot.background <- element_rect(fill = colourpicker(background), - colour = theme$plot.background$colour, - linewidth = theme$plot.background$linewidth, - linetype = theme$plot.background$linetype) - } - if (isTRUE(horizontal)) { - if (isTRUE(x.lbl_italic)) { - theme$axis.text.y$face <- "italic" - } - if (isTRUE(x.remove)) { - theme$axis.text.y <- element_blank() - } - if (isTRUE(y.remove)) { - theme$axis.text.x <- element_blank() - } - } else { - if (isTRUE(x.lbl_italic)) { - theme$axis.text.x$face <- "italic" - } - if (isTRUE(x.remove)) { - theme$axis.text.x <- element_blank() - } - if (isTRUE(y.remove)) { - theme$axis.text.y <- element_blank() - } - } - - if (isTRUE(has_y_secondary) && !isTRUE(has_category)) { - # set colour of geoms to title texts - theme$axis.title.y$colour <- col_y_primary - theme$axis.title.y$face <- "bold" - theme$axis.title.y.right$colour <- col_y_secondary - theme$axis.title.y.right$face <- "bold" - } - - theme$axis.text.x$angle <- x.lbl_angle - if (is.null(x.lbl_align) && x.lbl_angle != 0) { - # determine the better alignment - if (abs(x.lbl_angle) %in% c(0:10, 171:190, 351:360)) { - x.lbl_align <- 0.5 # centre - } - if (abs(x.lbl_angle) %in% 191:350) { - x.lbl_align <- 0 # left - } - if (abs(x.lbl_angle) %in% 11:170) { - x.lbl_align <- 1 # right - } - if (x.lbl_angle < 0) { - x.lbl_align <- 1 - x.lbl_align - } - } - if (!is.null(x.lbl_align)) { - theme$axis.text.x$hjust <- x.lbl_align - } - - if (isTRUE(legend.italic)) { - theme$legend.text$face <- "italic" - } - - if (!is.null(title.colour)) { - theme$plot.title$colour <- colourpicker(title.colour) - } - if (!is.null(subtitle.colour)) { - theme$plot.subtitle$colour <- colourpicker(subtitle.colour) - } - # facet - theme$strip.background$fill <- facet.fill - if (isTRUE(facet.bold) && isTRUE(facet.italic)) { - theme$strip.text$face <- "bold.italic" - } else if (isTRUE(facet.bold)) { - theme$strip.text$face <- "bold" - } else if (isTRUE(facet.italic)) { - theme$strip.text$face <- "italic" - } else { - theme$strip.text$face <- "plain" - } - theme$strip.text$margin <- margin(t = facet.margin, b = facet.margin / 2) - theme$strip.text$size <- unit(facet.size, "pt") - - # set the font family and font size, taking text_factor into account - attr_bak <- attributes(theme) - base_size <- theme$text$size - theme <- lapply(theme, function(el) { - if (inherits(el, "element_text")) { - el$family <- font - if (text_factor != 1 && !is.null(el$size) && is.numeric(el$size)) { - if (inherits(el$size, "rel")) { - # in theme_minimal2, these are the x and y axis labels, not their titles - # in thme_bw, a lot of element have class 'rel' - el$size <- base_size * text_factor * as.double(el$size) - } else { - el$size <- base_size * text_factor * (as.double(el$size) / base_size) - } - } - } - el - }) - attributes(theme) <- attr_bak # restore class and all other attributes - - # special case for tile-like types, remove axis line and add raster - if (type %in% c("geom_tile", "geom_raster", "geom_rect")) { - theme$axis.line.x <- theme$axis.line.y - theme$panel.grid.major.x <- theme$panel.grid.major.y - theme$panel.grid.minor.x <- theme$panel.grid.minor.y - } - - # if horizontal, all x and y grid lines etc. should be exchanged - if (isTRUE(horizontal)) { - theme.bak <- theme - theme$panel.grid.major.x <- theme$panel.grid.major.y - theme$panel.grid.major.y <- theme.bak$panel.grid.major.x - theme$panel.grid.minor.x <- theme$panel.grid.minor.y - theme$panel.grid.minor.y <- theme.bak$panel.grid.minor.x - theme$axis.ticks.x <- theme$axis.ticks.y - theme$axis.ticks.y <- theme.bak$axis.ticks.x - theme$axis.line.x <- theme$axis.line.y - theme$axis.line.y <- theme.bak$axis.line.x - } - - # for Sankey plots, remove axes if indicated - if (isTRUE(sankey.remove_axes)) { - theme$axis.line <- element_blank() - theme$panel.grid.major <- element_blank() - theme$panel.grid.minor <- element_blank() - theme$axis.ticks <- element_blank() - if (isTRUE(horizontal)) { - theme$axis.text.x <- element_blank() - } else { - theme$axis.text.y <- element_blank() - } - theme$axis.title <- element_blank() - } - - # return the theme - return(theme) -} - -#' @importFrom ggplot2 facet_grid facet_wrap -validate_facet <- function(df, - type, - facet.repeat_lbls_x, - facet.repeat_lbls_y, - facet.relative, - facet.drop, - facet.nrow, - facet.position, - horizontal) { - scales <- "fixed" - if (isTRUE(facet.repeat_lbls_x) && isTRUE(facet.repeat_lbls_y)) { - scales <- "free" - } else if (isTRUE(facet.repeat_lbls_y)) { - scales <- "free_y" - if (isTRUE(horizontal)) { - scales <- "free_x" - } - } else if (isTRUE(facet.repeat_lbls_x)) { - scales <- "free_x" - if (isTRUE(horizontal)) { - scales <- "free_y" - } - } - - if (type == "geom_sf") { - # force fixes scales, otherwise throws an error: coord_sf doesn't support free scales - scales <- "fixed" - } - - if (any(is.na(get_facet(df)))) { - # 'drop' means dropping of factor levels. If this is FALSE and the columns contains NA, this throws an error: - # Error in scale_apply(layer_data, x_vars, "train", SCALE_X, x_scales) - facet.drop <- TRUE - } - if (isTRUE(facet.relative)) { - if (facet.position == "top") { - switch <- "y" - } else { - switch <- "x" - } - if (is.null(facet.nrow) || facet.nrow == 1) { - return(facet_grid(cols = vars(`_var_facet`), - space = scales, # <- this makes the facet.relative happen - drop = facet.drop, - scales = scales, - switch = switch)) - } else { - plot2_warning("When using ", font_blue("facet.relative = TRUE"), ", the number of columns cannot be > 1 when ", - font_blue("facet.nrow"), " is larger than 1") - return(facet_grid(rows = vars(`_var_facet`), - space = scales, - drop = facet.drop, - scales = scales, - switch = switch)) - } - } else { - return(facet_wrap("`_var_facet`", - scales = scales, - strip.position = facet.position, - drop = facet.drop, - nrow = facet.nrow)) - } -} - -#' @importFrom ggplot2 geom_text geom_label geom_sf_label geom_sf_text aes position_fill position_stack position_dodge2 -#' @importFrom certestyle colourpicker -set_datalabels <- function(p, - df, - type, - width, - stacked, - stackedpercent, - datalabels.colour_fill, - datalabels.colour, - datalabels.size, - datalabels.angle, - datalabels.lineheight, - datalabels.centroid, - font, - reverse, - horizontal, - misses_datalabels, - markdown) { - - if (isTRUE(misses_datalabels) && nrow(df) > 25) { - plot2_caution("Omitting printing of ", nrow(df), " datalabels - use ", - font_blue("datalabels = TRUE"), " to force printing") - return(p) - } - - is_sf <- (type == "geom_sf") - is_tile <- (type %in% c("geom_tile", "geom_raster", "geom_rect")) - - if (is.null(datalabels.colour_fill)) { - if (isTRUE(is_tile)) { - datalabels.colour_fill <- NA - } else { - # try to get from current theme - datalabels.colour_fill <- p$theme$panel.background$fill - if (is.null(datalabels.colour_fill)) { - # still NULL, then make fill invisible (NA) - datalabels.colour_fill <- NA - } - } - } - - if (!isTRUE(stacked) && !isTRUE(stackedpercent) && !isTRUE(is_sf) && !isTRUE(is_tile)) { - datalabels.colour_fill <- colourpicker(datalabels.colour_fill, opacity = 0.4) # 40% transparency - } else { - datalabels.colour_fill <- colourpicker(datalabels.colour_fill, opacity = 0.75) # 75% transparency - } - datalabels.colour <- colourpicker(datalabels.colour) - - # set label and text offsets (does not apply to sf and tile plots) - text_horizontal <- 0.5 - text_vertical <- -0.75 - label_horizontal <- 0.5 - label_vertical <- -0.1 - if (isTRUE(horizontal) || datalabels.angle == 90) { - text_horizontal <- -0.25 - text_vertical <- 0.5 - label_horizontal <- -0.1 - label_vertical <- 0.5 - } - - # set positioning function - if (isTRUE(stackedpercent)) { - position_fn <- position_fill(reverse = reverse, vjust = 0.5) - } else if (isTRUE(stacked)) { - position_fn <- position_stack(reverse = reverse, vjust = 0.5) - } else { - position_fn <- position_dodge2(width = width, preserve = "single") - } - - original_values <- p$data$`_var_datalabels` - - if (!isTRUE(is_sf)) { - geom_label_fn <- geom_label - geom_text_fn <- geom_text - geometry_fix_fn <- NULL - } else { - geom_label_fn <- geom_sf_label - geom_text_fn <- geom_sf_text - # these functions from the 'sf' package fix invalid geometries - st_is_valid <- getExportedValue(name = "st_is_valid", ns = asNamespace("sf")) - st_point <- getExportedValue(name = "st_point", ns = asNamespace("sf")) - st_centroid <- getExportedValue(name = "st_centroid", ns = asNamespace("sf")) - st_point_on_surface <- getExportedValue(name = "st_point_on_surface", ns = asNamespace("sf")) - st_zm <- getExportedValue(name = "st_zm", ns = asNamespace("sf")) - if (is.null(datalabels.centroid)) { - plot2_message("Assuming ", font_blue("datalabels.centroid = TRUE"), ". Set to FALSE for a point-on-surface placing of datalabels.") - datalabels.centroid <- TRUE - } - if (isTRUE(datalabels.centroid)) { - geometry_fix_fn <- function(x) { - x[!st_is_valid(x)] <- st_point() - suppressWarnings(st_centroid(st_zm(x))) - } - } else { - geometry_fix_fn <- function(x) { - x[!st_is_valid(x)] <- st_point() - suppressWarnings(st_point_on_surface(st_zm(x))) - } - } - } - - # generate the datalabels - p <- p + - # set background label - do.call(geom_label_fn, - args = c(list(mapping = aes(label = ifelse(is.na(original_values), - NA_character_, - paste0(original_values, - strrep("-", ceiling(nchar(original_values) * 0.33))))), - colour = NA, - fill = datalabels.colour_fill, - size = datalabels.size, - family = font, - angle = datalabels.angle, - lineheight = datalabels.lineheight, - na.rm = TRUE), - # only when there's a category: - list(position = position_fn)[has_category(df) & !isTRUE(is_sf)], - # only when not stacked at all: - list(label.padding = unit(0.25, "lines"))[!isTRUE(stacked) & !isTRUE(stackedpercent) & !isTRUE(is_sf) & !isTRUE(is_tile)], - list(label.r = unit(0, "lines"))[!isTRUE(stacked) & !isTRUE(stackedpercent) & !isTRUE(is_sf) & !isTRUE(is_tile)], - list(vjust = label_vertical)[!isTRUE(stacked) & !isTRUE(stackedpercent) & !isTRUE(is_sf) & !isTRUE(is_tile)], - list(hjust = label_horizontal)[!isTRUE(stacked) & !isTRUE(stackedpercent) & !isTRUE(is_sf) & !isTRUE(is_tile)], - # only when stackedpercent: - list(vjust = 0.5)[isTRUE(stackedpercent) || isTRUE(is_sf) || isTRUE(is_tile)], - list(hjust = 0.5)[isTRUE(stackedpercent) || isTRUE(is_sf) || isTRUE(is_tile)], - # only when sf: - list(fun.geometry = geometry_fix_fn)[isTRUE(is_sf)])) + - # set text - do.call(geom_text_fn, - args = c(list(mapping = aes(label = `_var_datalabels`), - colour = datalabels.colour, - size = datalabels.size * ifelse(isTRUE(markdown) & isTRUE(is_sf), 1.05, 1), - family = font, - angle = datalabels.angle, - lineheight = datalabels.lineheight, - na.rm = TRUE), - # only when there's a category: - list(position = position_fn)[has_category(df) & !isTRUE(is_sf) & !isTRUE(is_tile)], - # only when not stacked at all: - list(vjust = text_vertical)[!isTRUE(stacked) & !isTRUE(stackedpercent) & !isTRUE(is_sf) & !isTRUE(is_tile)], - list(hjust = text_horizontal)[!isTRUE(stacked) & !isTRUE(stackedpercent) & !isTRUE(is_sf) & !isTRUE(is_tile)], - # only when stackedpercent: - list(vjust = 0.5)[isTRUE(stackedpercent) || isTRUE(is_sf) || isTRUE(is_tile)], - list(hjust = 0.5)[isTRUE(stackedpercent) || isTRUE(is_sf) || isTRUE(is_tile)], - # only when sf: - list(fun.geometry = geometry_fix_fn)[isTRUE(is_sf)])) - - if (!isTRUE(stacked) && !isTRUE(stackedpercent) && !isTRUE(is_sf) && !isTRUE(is_tile)) { - # move label layer to back + 1; - # this will make the labels only interfere with plot lines, - # not with the data (such as columns) - layer_n <- seq_len(length(p$layers)) - layer_label <- length(layer_n) - 1 - layer_others <- layer_n[-layer_label] - p$layers <- p$layers[c(layer_label, layer_others)] - } - - p -} - -validate_font <- function(font) { - if (is_empty(font)) { - # no font set, so return empty string to use default - return("") - } - required_pkg <- c("showtext", "showtextdb", "sysfonts") - misses_pkg <- !required_pkg %in% rownames(utils::installed.packages()) - if (any(misses_pkg)) { - plot2_warning("Package ", paste0("'", required_pkg[misses_pkg], "'", collapse = " and "), - " not installed, ignoring ", font_blue("font = \"", font, "\"", collapse = "")) - return("") - } - - # enable showtext - showtext::showtext_auto(enable = TRUE) - - if (isTRUE(getOption("knitr.in.progress")) && - !identical(Sys.getenv("IN_PKGDOWN"), "true")) { - # if in knitr (R Markdown) set the right DPI for this plot according to current chunk setting - showtext::showtext_opts(dpi = knitr::opts_current$get("dpi")) - } - - font.bak <- font - font <- trimws(tolower(font)[1L]) - if (font %in% tolower(sysfonts::font_families())) { - # this is for previously activated fonts, or fonts installed from Google Fonts - return(sysfonts::font_families()[tolower(sysfonts::font_families()) == font]) - } - - # get font files from system - if (is.null(plot2_env$fonts)) { - # so it only runs the first time - plot2_env$fonts <- sysfonts::font_files() - } - fonts <- plot2_env$fonts[which(tolower(plot2_env$fonts$family) == trimws(tolower(font)[1L])), , drop = FALSE] - - if (NROW(fonts) == 0) { - # font does not exist yet - try to download from Google Fonts - tryCatch({ - plot2_message("Downloading font ", font_blue(paste0("\033]8;;https://fonts.google.com/specimen/", gsub(" ", "+", font.bak), "\a", font.bak, "\033]8;;\a")), " from Google Fonts") - font_urls <- showtextdb::google_fonts(font.bak) - # install and register using showtextdb - suppressMessages(showtextdb::font_install(font_urls, quiet = TRUE)) - showtextdb::load_showtext_fonts() - }, error = function(e) invisible()) - - } else if (!fonts$family[1L] %in% sysfonts::font_families()) { - # helper function for adding fonts - set_if_not_null <- function(type) { - fonts$fullpath <- paste(fonts$path, fonts$file, sep = "/") - fonts$plainface <- gsub(" +", "", trimws(tolower(fonts$face))) - font <- fonts[which(fonts$plainface == type), "fullpath", drop = TRUE] - if (length(font) == 0) { - NULL - } else { - font - } - } - # still has to be 'registered' with sysfonts, so do it - sysfonts::font_add(family = fonts$family[1L], - regular = set_if_not_null("regular"), - bold = set_if_not_null("bold"), - italic = set_if_not_null("italic"), - bolditalic = set_if_not_null("bolditalic")) - } - - # return the font if it is available - if (font %in% tolower(sysfonts::font_families())) { - return(sysfonts::font_families()[tolower(sysfonts::font_families()) == font]) - } else { - plot2_warning("Ignoring unknown font family \"", font.bak, "\"") - return("") - } -} - -#' @importFrom tidyr complete full_seq -complete_direction <- function(df, direction, has_direction, filler) { - if (has_direction && !is.null(filler) && !isFALSE(filler)) { - direction_data <- df[[paste0("_var_", direction)]] - if (isTRUE(filler)) { - filler <- 0 - } - fill_list <- list(`_var_y` = filler, - y_name = filler) - names(fill_list)[2] <- get_y_name(df) - if (!inherits(direction_data, c("Date", "POSIXt")) && is.double(direction_data)) { - # determine significance - sig <- max(sigfigs(diff(direction_data)), na.rm = TRUE) - period <- 1 / 10 ^ sig - } else { - period <- 1 - } - if (direction == "x") { - df <- df |> - complete(`_var_x` = full_seq(direction_data, period = period), fill = fill_list) - df[, get_x_name(df)] <- df$`_var_x` - } else if (direction == "category") { - df <- df |> - complete(`_var_category` = full_seq(direction_data, period = period), fill = fill_list) - df[, get_category_name(df)] <- df$`_var_category` - } else if (direction == "facet") { - df <- df |> - complete(`_var_facet` = full_seq(direction_data, period = period), fill = fill_list) - df[, get_facet_name(df)] <- df$`_var_facet` - } - } - df -} - -validate_sorting <- function(sort_method, horizontal) { - if (is.null(sort_method)) { - return(sort_method) - } - if (length(sort_method) > 1) { - # is a vector of values - return("manual") - } - sort_method <- tolower(sort_method[1L]) - sort_method <- gsub("[^a-z-]+", "", sort_method) - sort_method <- gsub("true", "asc", sort_method) # when sort_method = TRUE - sort_method <- gsub("false", "inorder", sort_method) # when sort_method = FALSE - sort_method <- gsub("^order", "inorder", sort_method) - sort_method <- gsub("asc[a-z]+", "asc", sort_method) - sort_method <- gsub("desc[a-z]+", "desc", sort_method) - if (sort_method %like% "freq$") { - sort_method <- paste0(sort_method, "-desc") - } - if (isTRUE(horizontal)) { - # reverse asc and desc - sort_method <- gsub("asc", "asc2", sort_method) - sort_method <- gsub("desc", "asc", sort_method) - sort_method <- gsub("asc2", "desc", sort_method) - } - sort_method -} - -#' @importFrom forcats fct_inorder fct_reorder -#' @importFrom stringr str_sort -#' @importFrom certestyle font_blue -sort_data <- function(values, - original_values, # required for sort = FALSE, should be according to original values - sort_method, - datapoints, - summarise_function, - summarise_fn_name, - horizontal, - drop, - argument) { - if (is.null(sort_method) || - is.numeric(values) || - is_date(values) || - ((isTRUE(sort_method) && is.factor(values) && !isTRUE(horizontal)))) { - # don't sort at all - return(values) - } - - # set up sort_method - sort_method.bak <- sort_method - sort_method <- validate_sorting(sort_method = sort_method, horizontal = horizontal) - if (sort_method != "manual") { - # 'manual' is because of a manually set vector of values - sort_method.bak <- sort_method.bak[1L] - } - - # manually set values - if (sort_method == "manual") { - values <- as.character(values) - sort_method.bak <- as.character(sort_method.bak) - lvls <- union(sort_method.bak, values[!values %in% sort_method.bak]) - if (isTRUE(horizontal)) { - lvls <- rev(lvls) - } - return(factor(values, levels = lvls, ordered = TRUE)) - } - - # factors get a special treatment - they are sorted on their levels - if (is.factor(values)) { - if (sort_method %in% c("alpha", "alpha-asc", "asc")) { - if (isTRUE(horizontal)) { - lvls <- rev(levels(values)) - } else { - lvls <- levels(values) - } - return(factor(as.character(values), - levels = lvls, - ordered = is.ordered(values))) - } else if (sort_method %in% c("alpha-desc", "desc")) { - if (isTRUE(horizontal)) { - lvls <- levels(values) - } else { - lvls <- rev(levels(values)) - } - return(factor(as.character(values), - levels = lvls, - ordered = is.ordered(values))) - } - } - if (!isTRUE(drop)) { - levels <- levels(values) - } - - # force characters - values <- as.character(values) - - # start the sorting - numeric_sort <- any(values %like% "[0-9]", na.rm = TRUE) - if (sort_method %in% c("alpha", "alpha-asc", "asc")) { - # alphabetical, or ascending - out <- factor(values, - levels = str_sort(unique(values), - numeric = numeric_sort)) - } else if (sort_method %in% c("alpha-desc", "desc")) { - out <- factor(values, - levels = str_sort(unique(values), - numeric = numeric_sort, - decreasing = TRUE)) - } else if (sort_method == "inorder") { - out <- factor(as.character(values), - levels = levels(fct_inorder(as.character(original_values)))) - } else if (sort_method %in% c("freq-asc", "infreq-asc")) { - if (n_distinct(values) < length(values)) { - plot2_message("Applying ", font_blue(paste0(argument, " = \"", sort_method, "\"")), " using ", - font_blue(paste0("summarise_function = ", summarise_fn_name))) - } - out <- fct_reorder(.f = as.character(values), - .x = datapoints, - .fun = summarise_function, - .desc = FALSE) - } else if (sort_method %in% c("freq-desc", "infreq-desc")) { - if (n_distinct(values) < length(values)) { - plot2_message("Applying ", font_blue(paste0(argument, " = \"", sort_method, "\"")), " using ", - font_blue(paste0("summarise_function = ", summarise_fn_name))) - } - out <- fct_reorder(.f = as.character(values), - .x = datapoints, - .fun = summarise_function, - .desc = TRUE) - } else { - stop("invalid sorting option: '", sort_method.bak, "'", call. = FALSE) - } - - if (!isTRUE(drop) && !is.null(levels)) { - levels(out) <- c(levels(out), sort(levels[!levels %in% levels(out)])) - } - - out -} - -#' @importFrom forcats fct_relevel -#' @importFrom dplyr group_by across group_size mutate summarise -#' @importFrom certestyle font_blue font_magenta format2 -set_max_items <- function(df, - y, - x, - x.max_items, - x.max_txt, - category, - category.max_items, - category.max_txt, - facet, - facet.max_items, - facet.max_txt, - horizontal, - summarise_function, - decimal.mark, - big.mark, - datalabels.round, - datalabels.format, - y.percent) { - if (is.infinite(x.max_items) && is.infinite(category.max_items) && is.infinite(facet.max_items)) { - return(df) - } - if (is.null(x) && is.null(category) && is.null(facet)) { - return(df) - } - - # helper function - set_max <- function(values, n_max, txt, horizontal) { - if (is.null(n_max) || is.infinite(n_max)) { - return(values) - } - if (!is.factor(values)) { - plot2_warning("Setting ", font_blue("*.max_items"), " only works when values are a character or (sorted) factor, not ", font_magenta(paste0(class(values), collapse = "/"))) - return(values) - } - if (n_max < length(levels(values))) { - if (isTRUE(horizontal)) { - lvls_remove <- rev(levels(values))[c(n_max:length(levels(values)))] - } else { - lvls_remove <- levels(values)[c(n_max:length(levels(values)))] - } - lvls_remove <- lvls_remove[order(-nchar(lvls_remove))] - value_new <- gsub("%n", format2(length(lvls_remove)), txt, fixed = TRUE) - pct <- format2(length(values[values %in% lvls_remove]) / length(values), percent = TRUE) - value_new <- gsub("%p", pct, value_new, fixed = TRUE) - # add new factor level - levels(values) <- c(levels(values), value_new) - # replace all values that must be removed - values[as.character(values) %in% lvls_remove] <- value_new - # drop unused factor levels - values <- droplevels(values) - # set new level to last place, taking into account 'horizontal' - if (isTRUE(horizontal)) { - values <- fct_relevel(values, value_new, after = 0) - } else { - values <- fct_relevel(values, value_new, after = Inf) - } - } - values - } - - # set new factor levels - if (!is.null(x)) { - df[, x] <- set_max(values = get_x(df), - n_max = x.max_items, - txt = x.max_txt, - horizontal = horizontal) - df$`_var_x` <- df[, x, drop = TRUE] - } - if (!is.null(category)) { - df[, category] <- set_max(values = get_category(df), - n_max = category.max_items, - txt = category.max_txt, - horizontal = horizontal) - df$`_var_category` <- df[, category, drop = TRUE] - } - if (!is.null(facet)) { - df[, facet] <- set_max(values = get_facet(df), - n_max = facet.max_items, - txt = facet.max_txt, - horizontal = FALSE) - df$`_var_facet` <- df[, facet, drop = TRUE] - } - - if (all(group_sizes(df) == 1)) { - # summarise again - df <- summarise_data(df = df, - summarise_function = summarise_function, - decimal.mark = decimal.mark, - big.mark = big.mark, - datalabels.round = datalabels.round, - datalabels.format = datalabels.format, - y.percent = y.percent) - } - df - -} - -#' @importFrom dplyr mutate group_by across all_of summarise -summarise_data <- function(df, - summarise_function, - decimal.mark, - big.mark, - datalabels.round, - datalabels.format, - y.percent) { - x <- get_x_name(df) - y <- get_y_name(df) - category <- get_category_name(df) - facet <- get_facet_name(df) - has_datalbls <- has_datalabels(df) - summ_fn <- function(x, fn = summarise_function, ...) { - # alter summarise_function to remove NAs - out <- fn(x, ...) - out[!is.na(out)] - } - df <- df |> - mutate(n = get_y(df)) |> - group_by(across(all_of(c(x, category, facet)))) |> - summarise(n = summ_fn(n), - .groups = "drop") - colnames(df)[colnames(df) == "n"] <- y - df$`_var_y` <- df[, y, drop = TRUE] - if (!is.null(x)) df$`_var_x` <- df[, x, drop = TRUE] - if (!is.null(category)) df$`_var_category` <- df[, category, drop = TRUE] - if (!is.null(facet)) df$`_var_facet` <- df[, facet, drop = TRUE] - if (isTRUE(has_datalbls)) { - df <- df |> - mutate(`_var_datalabels` = format_datalabels(`_var_y`, - datalabels.round = datalabels.round, - datalabels.format = datalabels.format, - decimal.mark = decimal.mark, - big.mark = big.mark, - y.percent = y.percent)) - } - df -} - -#' @importFrom certestyle format2 font_blue -#' @importFrom dplyr n_distinct -format_datalabels <- function(datalabels, - datalabels.round, - datalabels.format, - decimal.mark, - big.mark, - y.percent) { - datalabels[as.character(datalabels) %in% c("", "0")] <- NA - datalabels_out <- datalabels - - if (is.function(datalabels.format)) { - return(datalabels.format(datalabels_out)) - } - - if (isTRUE(y.percent)) { - if (!is.null(datalabels.format)) { - datalabels_out <- trimws(format2(datalabels, - round = datalabels.round, - decimal.mark = decimal.mark, - big.mark = big.mark, - percent = TRUE)) - if (datalabels.round == eval(formals(plot2)$datalabels.round) && n_distinct(datalabels) > n_distinct(datalabels_out)) { - # formals() get the default value, so that's why it's in this if() - plot2_message("Use ", font_blue("datalabels.round"), " to edit the rounding of datalabels") - } - if (datalabels.format != "%n") { - plot2_message("Ignoring ", font_blue("datalabels.format = \"", datalabels.format, "\"", collapse = NULL), - " since ", font_blue("y.percent = TRUE")) - } - } - } else if (!is.null(datalabels.format) && - mode(datalabels) == "numeric" && - !inherits(datalabels, c("factor", "Date", "POSIXt"))) { - datalabels <- as.double(datalabels) - datalabels_out <- rep(datalabels.format, length(datalabels_out)) - if (datalabels.format %like% "%p") { - datalabels_p <- trimws(format2(datalabels / sum(datalabels, na.rm = TRUE), - round = datalabels.round, - decimal.mark = decimal.mark, - big.mark = big.mark, - percent = TRUE)) - datalabels_out <- mapply(gsub, - x = datalabels_out, - pattern = "%p", - replacement = datalabels_p, - USE.NAMES = FALSE) - } - if (datalabels.format %like% "%n") { - datalabels_n <- trimws(format2(datalabels, - decimal.mark = decimal.mark, - big.mark = big.mark, - round = datalabels.round, - force_decimals = FALSE)) - datalabels_out <- mapply(gsub, - x = datalabels_out, - pattern = "%n", - replacement = datalabels_n, - USE.NAMES = FALSE) - } - } - datalabels_out -} diff --git a/R/zzz.R b/R/zzz.R new file mode 100644 index 00000000..3b61fa20 --- /dev/null +++ b/R/zzz.R @@ -0,0 +1,50 @@ +# ===================================================================== # +# An R package by Certe: # +# https://github.com/certe-medical-epidemiology # +# # +# Licensed as GPL-v2.0. # +# # +# Developed at non-profit organisation Certe Medical Diagnostics & # +# Advice, department of Medical Epidemiology. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# ===================================================================== # + +#' @importFrom plot2 register_colour +#' @importFrom certestyle certe.colours +.onLoad <- function(libname, pkgname) { + suppressMessages( + register_colour(certe.colours) + ) + suppressMessages( + register_colour(certe = c("certeblauw", "certegroen", "certeroze", "certegeel", "certelila", "certebruin", + "certeblauw3", "certegroen3", "certeroze3", "certegeel3", "certelila3", "certebruin3", + "certeblauw5", "certegroen5", "certeroze5", "certegeel5", "certelila5", "certebruin5"), + certe2 = c("certeblauw2", "certegroen2", "certeroze2", "certegeel2", "certelila2", "certebruin2", + "certeblauw4", "certegroen4", "certeroze4", "certegeel4", "certelila4", "certebruin4", + "certeblauw6", "certegroen6", "certeroze6", "certegeel6", "certelila6", "certebruin6"), + certe3 = c("certeblauw3", "certegroen3", "certeroze3", "certegeel3", "certelila3", "certebruin3", + "certeblauw5", "certegroen5", "certeroze5", "certegeel5", "certelila5", "certebruin5"), + certe_sir = c(S = "certegroen", SI = "certegroen", SDD = "certegeel", I = "certegeel", IR = "certeroze", R = "certeroze", N = "grey50"), + certe_sir2 = c(S = "certegroen2", SI = "certegroen2", SDD = "certegeel2", I = "certegeel2", IR = "certeroze2", R = "certeroze2", N = "grey50")) + ) + + options(plot2.colour = "certe", + plot2.colour_font_secondary = "certeblauw") +} + +.onUnload <- function(libpath) { + if (identical(getOption("plot2.colour"), "certe")) { + options(plot2.colour = NULL) + } + if (identical(getOption("plot2.colour_font_secondary"), "certeblauw")) { + options(plot2.colour_font_secondary = NULL) + } +} diff --git a/data-raw/generation_admitted_patients.R b/data-raw/generation_admitted_patients.R deleted file mode 100644 index 1488ad21..00000000 --- a/data-raw/generation_admitted_patients.R +++ /dev/null @@ -1,48 +0,0 @@ -# ===================================================================== # -# An R package by Certe: # -# https://github.com/certe-medical-epidemiology # -# # -# Licensed as GPL-v2.0. # -# # -# Developed at non-profit organisation Certe Medical Diagnostics & # -# Advice, department of Medical Epidemiology. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# ===================================================================== # - -library(dplyr) -admitted_patients <- AMR::example_isolates |> - group_by(patient_id) |> - filter(n() < 3) |> - ungroup() |> - transmute(date, - patient_id, - gender, - age, - age_group = AMR::age_groups(age), - hospital = hospital_id, - ward = ifelse(ward_icu, "ICU", "Non-ICU")) |> - slice_sample(n = 250) - -ind <- double(nrow(admitted_patients)) -j <- 1 -for (pat in unique(admitted_patients$patient_id)) { - ind[which(admitted_patients$patient_id == pat)] <- j - j <- j + 1 -} -admitted_patients$patient_id <- ind -admitted_patients <- admitted_patients |> - arrange(date, patient_id) - -# for the vignette, make 2014 wide in ggplot2 syntax -admitted_patients[which(format(admitted_patients$date, "%Y") == "2014" & - admitted_patients$ward == "ICU"), "data"] <- as.Date("2013-02-25") - -usethis::use_data(admitted_patients, internal = FALSE, overwrite = TRUE, version = 2, compress = "xz") diff --git a/data/admitted_patients.rda b/data/admitted_patients.rda deleted file mode 100644 index 3a01c79d18d7f5751b145122766546862989e35c..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1752 zcmV;}1}FLbH+ooF0004LBHlIv03iV!0000G&sfahH~a>gT>vQ&2UJ%gRpOV=m zRDP>5`RovF}xo-IRFgu&3B)&Ut4rA`=}QfXA{-^OqN1?v)?L zhn>uf*9>tN`*#)M2H1&+#l@O$V@fttgg^qDV9an9@J^M<%)?- z(;cDU0EE1jc=tQzdh_Es2`c6mhj|n0`AXh%OxyW%)stiVkD~3U6&>AdsTr#WD#x(K zGH{0a6}rn%w-}gSF~!KwoD?e@*Tqlaf~l2*$U@6rn8 zcg+B68rp*=+l6cTw~eU1-8`3vehEGO_Xg_DN)(O4vaUG(dVa^8T7>&=bqzgDGn;+N zan}x<7qK!pINDs89~?@TvMNGgtdesWH^Ww_7zz((wGLYxDE^-+9D0^QH}1m!mqfo8 zdeS1a+6wmjUV3I583kH)b}{3KtH%!b?vjrA$ATpV-82+;3zg-%=x+DGJ1wORgSAxa zmwDzK@8nY9(!Rjr?~6_KlPCBhM?wvbxleJR?qHG}UP^8i*vC1$@t4k~eR|!?mHE=6 z*gubGq3FG`B_|9WCJ$o^ZkjHS@5-IDpHo%BEDY@qm@u@&x^~qW)mT?GnEVxjo|Vsr zGY@=UHnEOycaR73Vm%&axi0M`(zEfzi%^`0wH(m$7uT~Y9kY=vX7I_r1pf@f zz66x!FdR2!pM!Azd57hgaNeBB=XK$?6JZistx7OjOstBuZ>HE6DYUg~Ql47TyF73% zeDXquz`W`Bc;@C`l%YuYTpPWB`A);X&-z_NTQYhU_flyYZCqTLiudQeABkwq26w%Y zfJ~;J{`g}`xgfCu_J=2i@i`kYhxLwF0!3Q^&9G__Ww(h?1=`o%-3yt@y9#8mzUDQ0 zo)_K_9|dv$mH}ejLgvPXcuI=8<6YVft_|F2V9fi)lRbS}@^cW4%tKJ~K`J2mnVo)S z;}ayiNjA%S#qB9c=w$!qp%_Lc#<;U|CeQpYs*Xd#x??@JfU_5;D0Ve*u8kO?8gpBYs;Qlm za#0})K6a6YmM34iYRbWrwfdm2a13}DiVMP|N*CBV{0N@$DmNVM8f&Z1_pgT@SvqYI zkgn~iSO#SyLx?P7ju;^yRTe@XKm<3vzWb@9=}DTjpG`H0X#T|2zd}yTbdA@nJuokp zaowhkU?3F){2dSDVcyh8_ku9C`rkE;?8b$WdF_t-p}f66&T>^o4LBfh_ra9P3r`-v zF&gvzXt9v}L5{oyL+_uLsHi(PPJPg$F5f?H$DnDPZdoWk_n;I#9E*x1O8Ad4ktay9 zJnOUb0mi>?pDsVmTcs!?71MOq+sW>zX0upoSXHgxHM}gjLq!bi30n{CijB8cLXFtv6LS82el+H(g#dNmB>Y4nr{or!|tE=1?%qI$%uT$aU%(|mOnWh;)wrVku7M_o3 zmWVY+x!VWwQZ%l-rrlm(^&1Fo5KNb-6iFaO)?Mty5@-p}cyQz=Em@?mqTCciL=zsV z=(H3N>biNDf{jqZC~u|Os8yD;LEC~}oMY|#do`CD05>2AtSP>%3Ycl~KHD8~{pl2! u1L2Q0w%CpXU@E3=0001ZtN-%=0kRGKZvX&w;6PhGFb#_W000000a;q>bYIK> diff --git a/data/netherlands.rda b/data/netherlands.rda deleted file mode 100644 index 0254932b7db9176f2761c6e6d8fcf345d1e4ac88..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 163460 zcmV)lK%c)tT4*^jL0KkKS$fMDApphufB*mg|NsC0|NsC0|NsC0|NsC0|NsC0|NsC0 z|NsC0|Nr5~|9pVn!1H>0=eiW!`+MFk^*h|{-t+6b>pu0}o!ahgw3BVyy}fs}+ivK0 zHP2n__j+TueS7bH-Z^)6o%Eqs-e3nszRmy!`wl<{KmY~a;2q|227n#x2S5Nl000NR zzyJWffB*-!000B-zyJVtzyJ@n4uGCoB>+5_Mw@-B@2=TfceiHt<=WGid&=I?QL^uE zcGtb$&QW`lx}Dpa*RiYK^S!&yr@fXA?(J=EoR>!TXJ>(SZo3z}^4;6Zw`#pbId`_b zr?!sVu3K8Wx!$^n?a9|yam|-^d$rEq_OD|%b*;|sYoIk+Q@3{OoNVLTIL6-Y+J|-C z%gbdtM0+L9dNtD*TbQd>778e$_T-+ikmCV)gG% zuNF1frf(fO#>tgk7JBO?9o{nAy;Ks>b^@-h@vnIDbb2^Pir=%}mfdRad(QWFz2lo6?z-;X*DZIuy7kdJd)?QwO%H$o0012T03O^ucKaN6 zZu0fIyRhXw>(kea_qTiAZhgJ-`=33P>%Q}N-ul`->C=mMtGl;t>+f&3Jp1eJ%kFO@ z*SB%Cc{LAXS9`9S*wwXewRYB7B)e%j-s92fz24`&ZNlE_c`o+LyS?s*PFmWsO46y_ zu5G&Qdx5o`p1gZr*4~BFb+f(g-sEoF=WX8YE;fo%uaTVZ(ciXPPB1vd&hfdnWJm2-LCHIim6)c zb>5v%TJu{~yE`e{)3DIy|+`-d&1SZk9OPFZS8bf-EVu$i5ZUAtV< zGskmu>2tStu`SEJ+tt$Y)wf==%{y(q?_HYp?d#p%7kh95jUHCo=my>0++6N<+uZZV zuXCvE2KTu2=sLOF^b2(-yL-Lwcz{ph-&XkA&Q4uvzRoq>&gs&t+uW>YTf5zPT6?=qR=t{D z+1R|j-E((z+iiMo>$bODuI?Re-8-vZ+oR67-kdvls!q$S4$pU9-t5`dXSZzceSPnJ z?dfZGoT}CzTWx*5cimYl-S+pR^ zZDnl-XB)KKvt7GKH#57PR_3kJXS;go>K=lp+jH(K4OKE48UO$Q011->!fB>VmgG?hPO*GMf34j0uzyJUMfuLm3piBS&14fKSNHtWzAkY8+00A^$Mwli5 z000000000K^vRGk#M4a~02&%o@&h2zrh$_tnlxz1rbb4Z8f4JOP-?1p38p513{5a2 zMuDIKpa7VRCPs{tWMWg=GGL5`h9GEZp`%8PF*F(g10XPlgFs?wiJ)nqG6sR8Ln;ka z@&Nz>000Sy$%xZKMvVr5G&BPs&@|8hG%^haLqKQ&plHa^p`g*BshSM~O#o!jX`ll` zMt~4Vlt@N^002w?m`n+iO*FwY#9=TArV)_S2x4HFH89gn4Ky&CGHIcsO$LUV88p*F z36o7QCQS`801TQm$TXRVZh=9g2thSOV`;IB9NfS`4FM}nfD|Z9w15?96{a+$BE-cs zpupVRXfZn^Su!;w4R<|I);YDTZ7k)Y0z-7J+Z%3uYyX(Na`iB9J)J?<!W=rEBXNJ%75XB4D~AtHPP#sJupVjD@Zu`p_W zle2@I5I}*YLZj`byDpkCMSTL>`8|$S7giC^IW0*F zyLrmD#Gv8l*#0(c{it%N(xeB`d2;yAfm9#u>nF5A-0lKhKex2Npo0@<5|NgN2Gky5QF-m zd=eob!84AAaGD-!w|ursOYS?% z5dc@k2;6grDK`lko%(NJ+6+?=KH9^(08v9tdMI>O7r{?3?HWl>c@#oz2f;zx#j+P2%sozC~ z=FKwG3>wc}`4#cIa)h2x8Th@)mFbD`4Mtz^eGSR4rla5|<^N#Wg-Acy>Y2YSkAgx- zxp8qH6c-=VXn=|K_|P$(goOh%c(Vnq*ocqysS}c)kV$);2_}zqMYE%~q4EN@91#)J z(c2xkbCE{#wl2OLU9Iql8SUtgqvXgwH>@u)py?H?V4Z&Q^)vS!-@nM4Xks!KR4Cyb zi#GoA@1Aj+vND|{Rg0G#tFst67OGN#4$pj`e8$kwoOfT=2|uXM@a?Qtgg#Gn3HjYu z{!3w`ET`mD{iZWCT_C?`ttNmR6Rl0M%;N$(X;Ma#_>QFR@6p$p#$p!@-xI+*y<(Vv zG?iIf2cLBv<-5OfX4j>8dz6|EGQLrq(Bf=7iySawb^bvREda!OC4br$BZ|)^7d?in zyknF#;m(?~1k|@{xDp(G2&`%evc7m+blG>^Nxz}cXuYyp&Eo&J8g_yY1$!x*b^5Hv zSRCBf&ooLCOr-`eoJsOn=|qLoEYYxYdxVu z$_WfH(m)qhiWhW80mJyonewcO!Q=}a}!lKrr072pL*rw=pi@Y<+=Xd@u zbc<^8rlrV-dmle8%v>>muZajlLJ+}#F{>;G69F_xS@%@g`ip|YiLw9BMkU0#5st?U zaGf3*E3*Mey^f-Tp*PMK!G?GE6N5pmhu|}%f(5}~wh3-}nO>K$on2sfNUf2l;>%WC{4BLoqdBjlL_WQX;q~8zz@ggN z-BLv5=BNf!T%q>qcznt;#qCa5)2;_y=R363L@I!?TTy-#hx^nBJdT*B3nCG>K8-4x z6??Jd0F+*n?&%$%djC5ZbjeZr0KA#{ipvvrvv-{_yP9GQ1t=~Vg=K&gMsxUs5?i`( zUo*Q|R~xH+-0)O5z7XRFxEi9vDD7M-B+A9ij>0YfgSz?aqZ%*&tyGj%Zv>+cDVoEA zg;kz_4Re3dKD)Irc(1oc8u5gCu;kohG!P#50$P9*Nq^2Ffq&B}wFY#nFGDp|FXUW) z)4}VsKFoVB_oF0{%&?EQK2kTI6Xw9NA&|cU`9kn#=aEFBEnR4+r#ls8jkJcx8ZiW? z9cHYgzK8TQRA0w2D_u8s7`}MYS|+OA`PN^gb(Jl*s4;gv>0XiLtbuvIuDfb7e}=s(u8&CIKu^%4?36R z!7xlO>y|p2m;r(n=%-QY?+RRCG%*h=ng?C-%F?wLkf6+{$;A)7_q^V_Op;{DyrjKi ztj-heVOh{&RtwirU^zxxUp#=^4;{fNUR|m4LVRyJV9a_`#`jkkr40vyTs-5$0iW?V zOZb%ZtW(B9sSUMTujBB8v*BM{e!L`-d6@F0ULW)FeO8UOL*bK{N2VRFS)K5g{jCbV3>SRReVau zZl?KP4&e^gCVkFM#?+8l#|(7&@RGDPL%o)P>htuYmK4x+pf(QRx|x=|HQ@pSt;^`QwO-rM!u{xo}hrNn2?zN>d_cJd-|kG}#O zaXYN5mu>2NW&yV7IJcM|dM+F2#uByTNK!0vA5T;^6kZ@^q6rA(y71`ta;V?`GlG;s z4T=Clq=oSQxHA}HUjK^IE^4^f^Ovl_m>_@#8x+O}N3!KA5w~`xgoSElE2QIaF8Z^; zuJG(%MGA;^KZlBJ@ofQ*@{d!d(#EtuUw9?HLKv5M;08hTB5u`|F`&4ILDjJO=Ll1U zngwBv?5Yt6jkttA9mOEjrEDh@ssrygDR4b}_1M`OP@jmB@{~O4j84GAz*6--{TTyu zmUq%nrQ24YuVI@rY2%WOw&&7!y~Iq*RgtO{@bB!C<@kfdZ^-tqiHvYx41!$ou{w~1 z$Jy@?jML|TJgvu&gy0~`<>U0#j~ip4#EhU`{c348SK2W3Q#7KZiy_~RFnz(Lyjxe) zZk!*8UolTxn5K?7s4^-dTShKe;OWl;z_=zyheKm@1>;D;KMgblMmbt~NMw-|UEd#k;Fqy^SQM^>mCj68R@Zqk|3ZV? zIx6hUjKn7|r4HDcwLMuM@k2e~E&psS3A}`x^r-nt9si28W9TRB998hUVw<7l+C#I3 zBVgu%nyYtg=p|hI*CF&mm(@XSYsJl1utDe`hk;=(i6y8psziW?4-Ae2aGndqh#F3B z6*zM6VYlJ;P&;!Y7>Ikm0Dw zh9JQ9eqwhds2;ZM5`moqx2&2{_J+css%?QRYUwyZ zIn*z(#~k|>-P9q?+OG7KW^ZJ0smF;AIRjP?f+&abid6LEZjyaDZ~}-Nh}AKn+=cI} z`*qM;YLCMv4*tQ%#UsU0-8hYYI3o@zh=*pGoKuzIdxAa>!!&qrf?v+^+nuzs4Lb_n z%wXkMv1TNAP^`7Wj-{xE*)otyBt}YzVCr8lV~1sL#OxrS)US<@cM#dNN{O<;Who*; z#Ympo>fBlsa2xcPwa*}=?s?YIs56AaEar5$s1(j>g5!1}gBD{ZZNZ?H@Sy@wo3AE$ zU~cI(OK7QbdVgucnU79fmEQ8XSR-daEHDb3vKu{DYnK33%X)0P=pVm=T=ioW2-6QJ&i4jwH002{A-0-+Q!P+eoo)-QLimoF8Y;kBLLrw35N>Fd%9u4aAn zq$(9qL^!X5Qm2rDW{r)F&PcBama(0ZUU3nZ(&UXv6UVTuc6o`7-LHO^oZCKpeV>%& zvF!Vgy??G4R>tR!8}Qe2+(d(sN*J$>c666hckbt3V+6@iS(dSABjiFMU@Am%y%!wF)B7x#4(1=a>?|TS4sOD$!|fIM<0r`^RzXq!h>T zUL@V~yzVd5Ne>JP#jcJ$KOq<2=i`r0?A1-FYUVk_uJNiQJVcaK4Rl|0%?6=u!yfqQ zO|Y<{lLzM28D#bRHBr7evx&%yo0ar-9_T0EM?rTEQZ;CB$iRfz&%4+Q3%99WpB=!# z3nzf>r)ROlUGCAwOI!>Pj=&w4HvtP$5$(O8!u;%zF!RKN!98FkhAxc6BmUF27F7=2 z4N7w%jI^CbYugISW5T8jvC%uiILjsAR?__ROno17s@;cr;2N)DW_8(@t!^N=O7b94)A`?6Y>lBmZ=m*|XjE^95q z0+nE5Nh39aAK5eJI~NJ=V?SMR(mSV%2;w6!-a!mNVGGD)^C|PSD9OzzSmz=L89a}p zpL9Lqm4cA4IO3RLr1}vDuHZ$69r^`p`?NP()?8B0>8mA@gM`e&*L=ElR z=hS=f7)$Z!RNr9Qx&b_Rca|qyWkCKS&wfD-|Hr=gZcq}2H?EI4wgMa3R~XnMo;+f{ z&`)6tTp*G&)J{TkRS~A_GAIf(apH~nQdR_R0PebJ@?FEU172|UN%OZByqddUHA|v58H1E8#=v4BB?ol9rRmNn`nVHr+LRYU z10Zv=g=~uZl3t1U;)x&7SymUH*`@?lt^w2Yg=R> z;O>GrK_;5(&q-e}3rF>oXTd87I8679XtRldOu)g>5*5r%k5BD0-Wwy}Mz1Gs7?)1N zsE{}@7RIxZV{|-%I8RC#JPuQZ7pB(@s=P1bl}2n(rmwQ>b;mWtOiO2QiAl&a< zErL6?WDEYxhA?MTV;P=rqfI2|#6b+ZN3o~b847=4%z;A36IL)`8pC4JlnzZkqO>Or zx(&+266Um6pRL>)8w3W%+$oO5CXIl83*yea$w$a+M$wPEd<=I7AbORRy=iBl+-7`2 zh}}%{6r^VT=U#|~tR~&N@MIF*Ay4cO0oYh}LZ)~sjbWzG_*@QwVMa$uKsiA&H`*4@ zi`>2Mooel^Ap?QPGng1dbR21mYHD+Toc->M7=M{cV@#rqLgcwJBIoAm$3LV7X0%i( zGez@{!dsd|!@%H&x=|g$+2{NGeog;#+<*1lo_p3!2?*pGoY6uX7eC-m*KdsTVi?z9 z`iTN)90bv29l)41V;()mP7 zRy)JfzjjU{FA@EA|ER|yQ&6&VR|4MZJaKa-81wUH}THBAlaX&K+qrv+sB!K4U6mvTfMOL^#}s= z9C~qB$q2y3$Mt+dyu2D&*y`+mqnR#)0XGt4eF#Q>9>h+c+yASFK8+L`_os;oji8z1 ziFhsTkS-bj=5b(CxFQGbLcv{d?`K3RqXe0-k4fNP-!p|m!Nh<$Uct7Ll{?lILLshz zBn23{r@`|FoPsIHvXX|N=j-|K5?$(s3tCQ|jyPDKfgF_~t3w!f*%#h)Kkat5 zMNIXu0Rse9eG$I!!=5+FCf2=))9%27dMPhY6&485;jWbFZ-YyHxxmowDv7V`4{7XT zm9?9q=sXI4%lp~bEa(*Z#rs|ccR8~$+UTx0)F|7KjZS{p&rF_^=k8==5C75 zHhM0I2oQnH7G(2G>;#ffCMJ5)szBj(E!D`zd=2kR8`=*Ukk~o1mDxCvl=*yPUIOnX z?*)3t9Do_rx+wYy0eq?s?RdkETdX$i3m%Gehv%1**5LK;m5;rXCP zzN!C*zoxwSi*8{lvsK$i@7A1-*Y8bkP%VS~@({ZwP&7dfpTaO*fx28KpS#z2Au|*K zkb%DU!kEHZs|Zfu#mxH!uw}=>H{oq3bNwq&yKB#vOuOrF;fhER=!r~kB)u-MvWH~r zKn{U#?y^?&9mZzb8}QfstRXJ8We0Ywj__OBs$|cW*x(ab9bW%hH=YrzfuPav@bGrZkS|EgdaqY)PC2r-85is)LBw6va4@u z!^^S@7c_Ojn@WALsooY6i+M3ppf#3j^v_&bX@qg8-FI3Kcp1{N>7e=;dj2BofH&A2 zLq>3T9&~taf{0ymd?Ru?1J#TwID!3ayT=Nc9tujowzRUjsJQoMUUfe}z(_@%2<&QO zd1Mw7`85p4V)e#Y-jS$(?wVh8oI&9CO(Ik+_~==~y2$>B!tF*uA^mwqt1@)lZZJ!;(Q- zYsVTiVTTG{86@7$v3SvU;Lgf$%M)lmhf~RrxV-362;F2O2>27EZ;w_kd+kliRX!i< z#-KZ8qGdX@1G$woyqYe^EBO;&WeZkK;UGfsV)Ti=6pzVbLnP=6V_YKJO^(&xq3bkNET_&kks_4E~&MUy)3#19EN8^RPR!UeA{m z@u*6~;A|#A{NQ|)B<6$& z>WHa)XOzjctEUudEVR$eC8BC9M>(HMMENc3-=yiR4W@q^F2dC`4x?J^45%mEMN0fTsx>sc zw%}qrsKWNxOM6V8A}?;FOa{ao1H|74=xFPvhtd~Y@v)v9=E)Eqse#?n+d`Kw3ixNTfaS2!!K`XH$*8;c~ zMj~bZhY@5{JXRsbXiJY}nM?*b$nADdY)E|p2Rfd|rWZAXY_+z+y4)a5)q|!7$4%iM zm~K2R3Y8Z7eOkxf(OBD@4Iy!*J{JRyNoc|}xmD-&64xT!D)mP8{8|>{UH-wQ5ecUg zI)93o?0O~gO0RLRI;2R*=Ogz{_eyBVq2p-eKm?&sRxZXUUJc@H~r zJtbMDqVQ}C;Gj{j7s8Dx5p^z@6O1iI4#)TO+mkxS&r0TuI1#XLvA;#2^V5AMy|^=W zwpIv<0yg}@35FDDJBB73u9ih3Z#=1=P&8S=E+}nDti5%C`I1jst}-swuC16?I_=TW z$>=#R))SHU;7RP<+r>VR-o{DIGv_a4W4ggmHlW<-_K8mMt7FPBMtDdXfvv)XEDMjh zQhE$W;#>X@+c^azz*J|tD{v)7ARH990teIkpRrOs2=~X}zwrPZST!^*z4fqpGslE= zvI=UBnlh>r!Xk~2KwZ10@#g~k8M#s?Bphi}YQC=iJ9gV1HmOWHlxGN}X$yBT`5BWULNiNOlk#SB(#B)QAX6XS8VaaU)8ZFp*yLxsJy|lDmN`hlon^yfmW}YNyL_S27i0=ReZ<9n zowP}*DWEZEB5HCb@%07!>S`*_YSr?K+DUhymQG2tCVyBXn?)`{54%RNt=oO`D&J;P7p4#k=ct`w^-s7HotuX zIcRiwg1OLECmPWSUhHxdg_J?W1Joa;wr> zy$caeA;>A)k@$I3}QbY{3menE+M=6bxUg-&#siKjerGXm>l%IV{@bY`+F z`3LK?a>t|9kd2e|T0g175J;zW(M9qO6rWo`<*=3;{WKhSo2aUWX=eY3`vYYy2H4beXqu=%^JR&#hSnt(ll5C zC?g7v^o={eRv_3_3e<^XGm)u%;pfELCO z0mvVc5ntc2O!7N+T1~_F@=6N3&OZWUE)-s2+>mEHMng2JA0vzv;AukOGn5m19B*73 zfiG4kJn05YvYctj>mcgEHnxhFr?~-_NE-!kNeCALYWl>Ep1xPL96^20=LB{|?>K0+ zGVJi&n>IOdnDV3jEJp z$9y<>bk~l)L{*wPK86(ALDxJe!;I*s8Y_b*)lv|vj*|CskZrcd9OX(MQT0Zke*5LS zOFhSdXGG3O%g6c1`YNQtvdbsg1q^4SY|4^#8seNz%a6Rr{KL~_aqCAoJCR)Hf1#AgMpBSpcKBhs{0 zNqYt!xQbJM>0r1KxQUhe*CQEbFb-Ur$|BSs~v!}Xclo0Gh@%dgH)_#fHE$-Gc z&tky6C$|C0WYEH(_JcV-#4pXG<0j(bI%zwa74U3A8ZR}oLzz=Al7Gatm~fr9ZB8Q^4mSt z^Do-nmrkDL?OFIam#7T@*I3awGar3~Q64sV1klN-Aq@TI?b6NeV9>n4&|U^+zCNl? zeTG$q@tKB=jjj>du+g!8PJZbAWrjn!z?-Qpuf|O7b7Lct%m=44jlY<*45cupJduQo zJ!%csW)2fYO1TqVEFH~i)paFaNc;2Pxb6E#CibcY8RC^;I|ABX-_#dZ=^8eqG6&${ zy3)^)Cxy50&|yhFMA$G$(iD{B;)NHeqd>6@UocGC16zkEPu>%Ybop-2(?%w@+Pda! z0q9J^|3=iB5FbkY5~wE4!FoW8<+}Um(XFjEQvv)XvA-J%nSpCx@iIOhM@k z^7rx4u;IST_K)Wm{#2z}Hg;Bg2{v~VIh*dzgO@9%|M;9aEcaQ_v-26oos5}j^$7}X zmN>X5ECUL?5Q0JBS)Y9$?-b$R{qD|_Ei0ihM1{C!rokV0*UZA8*CpMD-?Jjt6{=ZC zjOTp{|KyWIpI(@PuPL{ayg1}mU4i`*;7d;;wH--bC6y)X(;;&h9Jh?bLM&}i>(IAt z9HVm-k?ckvn^krr;@&_{U*0ncIT}Z9ZwOxIQVL64RtBc3LC(8lT3XZvdXXB&v~H?3 zU}y5sT}FazbJ6B>L<;&b6f^sQ99Ny>Lgx;841)>Q7%`GFrFBt;!O~3)c15q_LR7(` zx>ATbhOqsFb*!NevZxmWqLnH0UJg$qA|>yjFYL&%Eprg7&n)LKcG)Yxgd7(!fuhJ= zXKy>JY`U*I(C@warVMk4Rbhv5J_}5cKi5AUf<)~WCzx#$Z$6{d zFVxQrLkMqu62a>J)`8_LIpcre*f15o^FjG(XgXg`1(|EIX|u&^zs?+~Fsv|aFNUas zoY70a5DcB!Ri!WNuQXq0ZuD7Fygu#Lht^jiRHtB~K7IDZE+_VlDV3MGWu>nyephi5 zSzh8mD{U^2eXAAY*&wLA>#kLyXPz~ki%Dz;a>K{y!)=d%$}lHcPI2AnIIp5w1kNs-JdQ_G7WB;4{_0s;yz}+7Eea8E}mz$M}H_(SdD|V z-naAFN^jc+L}E81Sr@Pvv@GL{KQZB%?6hR2p;j|+6*elQ`USuKyv$svn;&x5jsAEN z3zXIHdd45FVk-jz7_`k24=l=L6qDgS{2`RFS} zBFME+*+*3P2geBUMuYzh?*4KND+~j$iwT1|{D>G=%)-EeEOYOL3!)?CQ^ zQZ5&yKooBR57>P~$W(!gV8wf|!Jrx`hx-dG`V5j>B>z{H>5+*i;^zV#l-FXv_?x3`g^8qL|5ZmR-z>aMMEQ zY|u(|WFztDBRxBfBn)m0gud3kqc4b%M=zxy=ULw$*#&5@-ibcprKaCTjr1;v$;OZK zyRr9OjL(Si=ilDond7jgoz+@EowY|Xh{d(^WFRVR4@%v#ke@VC7^*mEUwNaw$bhHa zaS{dhUD3~FK}tJl+c27ao`M5Y^g)toTr5Oi`4##BDh~<>>>l3SK`GI|Zm&9Hyq0KZ zRL_{!MmzZKa#G%2XLWw(ws;K8*{U_v=@vNJ&Nb#ZP*L5rod!GOs_4-Xiq0wU8A)|_ zUdyt96`x0*;)mE0(;c>UpyVirKBmE5iE7HLBqI%PdnmP{AVHK{jG&?`g>dD#e#r2w zA5<`Tmm}mAUr2lgFAC5!iBxNhm352UrD|?rs#tClq0C*8EB!vg9|E`5<#&LkAq%6d zNd63!j>X}9a)rRoz;Q3M=?YUk5{5^`?)rtoQ$Bs>CZKs3X{phvD1=SD^`b97%vC-^ zHQ-8*D;b09W$cNO|FqA($IXvu{u8K4NdH+eFbn)!%-^n6fLlKa{ z_p*14Qsg5t{I-iDqzqg}msIi%74}0)*z+#X!$bPdNj^3zt6h5z4g}>$j^uNLF3c`$ zA(t_wT5I8JqH`Flf5cA*gm-3iWxG!%$6rJCrR*QHVj}K7t?5~RXHxrqo;$J8%abdz zQJ+-xZCFRvlVxDMN{uE|_r95M@8)|#!;6s<;-d>9$pNbCn9FmNXU5mmb-#p{x_l$V z#YR-u^mGaNGW(A>@|Oe9t^Koy`?4p}DZxMHm)Hpz69`4SLptKPv_EaEcN9uD5POD0 zod?N9V3?Vkf?kyOOlQ|%l^j%nsxCaDbaZtg_Qk?HL=E{zSP(pCUPt3d!&ty&#o$h3By5X%2wSOS_|x zeNaJF+5BFlp-O3OF$58k{KAKZUG#48z= zHohCs{rw2K79YUM_2w6=c7)vliBC@U0LHRGn7m928Z~5QmCX;6>+{5wCc6^?R-|9e z;QV4iZ5lmxevGA3i11o33|?vT5G?Bep0OSPz$wf)j(XCfj3-^;pX0hTR9VCK2u4#g zMUeZcWG)*%x&#%e+QICS)y$?7roxjJy@bK$r*+Ovp4+1y@7*DQWp1ECCNhfuR%^8c zeBLJ-MXPk*@Q+%AN7*ED#=aAk=#pA_@)o(9yNup8Rdsf;u01@3Z(*bM=A=RLk3H*9 z2^VBFPkwi6QKR~Wa%i*OV|&4asiY9A6+Il7Mt0UOC-Ae;37};HqH6nji0GOR8G0!o z7{)fnlyx2v0dU%APfA~#kV5uHdb7qn=E5|E4_nsCmBU&^jG808C?}douZ5$0Nhba% znMnMZab#1Xr`5$MW>|E?i4^|Q4xH&oTia+cX@@7gg+gkuJljWn%zIXrk$GbN*pAA@6&51O!^J(QM`KC+saGpt@aT5*W| z4V@}W>jOs7pBQqwpojx}%0vM)Kmbv5s7N5Xc)D>A_)DKX3+JtG<}hd-y?K$G{QqFO zD=cj#ecWch7}h4T3;CU0+Dr_&qOgcD0RBOq2m)i|lhNpu7)O)ZV6Ef{A*-3yj ze({u&R+Sx#iZObuv9Sd(;6oY?cUI1LBbYqLa&8NXz(b0rHSG&W)i9Xy0dJrg+KiB5KgOw|@&W-3j z!>^MV$@>?kHH%`m=SW7o#Dt40GV{~RlbHFxWlX7fwTZ7`_P8it>kL0P=aB2#rcQ07 zIIj4@;>^XK18M7!E|cmYKjxQ2!$s`Czm^w2Gs7*7CH+_;uFs)}@f|U*+-RWAAvrDzvF zlY*ev=*7D7vA_CKtTc_;q=9x%fcyqs_e3BSftv;x+C(HTbh^NeyB8>GlKH`cJGP4* z?gdlr;7Wa8g{P=N){HG9PyVrr~3vh4wSslrItZXs?)gm;WI z>^{qUB&!U?uv%Nx1wEy#d{!!}yfc`<{8`uQU>4!3h|y+YlOM3ra2=o8*hn8s12X2> z`8|UX*6Zv!N29J;t^S>#%+bd3W z!=RPg=O_KtIcpx>Nf@LrC^Hs5*_sjKFWndBV{=}nXKBg&GCP`$v_VgI#)Ce>=vL$N z8Vh?!Q*1j%c-FJ&lH$eMG%sb7Y%~L0Czfc$G<^d~+Qo1h*^LxpszNSq-f|%w9h=|r zRJP`k(A8mD2Tf}5*EF+0gHY81@nx8@<5v&6`^t5<0;IrkB~J;Vy?2j zF=m*TmN{6Bb`N`1C0jAIOx*$2|kb+2`$Jz|(vp;rcl)%}nw2>J^2TLy{X z!!3Qbl3V$(s7x#74C$mxw=$85Xx!So;zglha-+a`7`Xcy3IhYhYtk4TE161>CHk=w zkFglEBQ|9QJhP>P=onI3I73vnkw6%ay0AgdwasBxE-+~`d^m+b*LPQjipSxRLu!TC; zMD`CTPY4dZo^!4Z7AM|4_KqnzX>%FtAArWImzc z%$XDn3{AR-@543B$&Adjc#j8wKbaR)Iq2+c3`+xK#l#u{VEYk;;h^VbAXaXB*O4EK z$N1YXepB@rbFbxS^IZ+2{QFErF65?LS>G`IvydW^JsS^yB?1<3YY^@YVqG1JVp*YF zS~K=iJ@N6zY6g!r^;W3+n5g3{&}T^k_%r)`Ig5jq|3Zr&=*4n;=8vb7Zt~^lhIWQQP3IY8v)$54F((2OOUnq z_rZ{wdju-|#SZdz4|;kq9Y1;d$gxdQp1+?t=?Z%`^}E^s8QbL0PkcBPT+v6-`#&~A z**}Q5HIo`wTz0ZexxawRj0*Q{;_0PdOIN0rwS_f;yR+$KCGA;JDt^Z^`Is+>iesy@ zJBNwJr-Kdey9qq(2R_C3J)1a|_~KNc@$}?cOQlykEvSCpp7kQ94=C5dGR!lS*1_KW zSj9AZ4Dr{O3*2I=7pOlgu?D@LV@Gt)v-l!MvlyyPD$@+JMa!9lB%utlwKUE9OPgtm zu}zmDE)|*~qxBlemH0^7Fgz9_gfUbYey?Npz*WA25LSkO@R)u5!8%vv6(na^#H_3g zc=9YpBYg=TxY9*|>6m`ZTb2|7uGOW*cjk?wIgfP1e$vKT;RibRG(r(-;oBtmx=2S5 zYo%qRU|Seln7B<{2cc*$qYn|BHUZs@Amop>8Y*2z3P4y!VOWrVEgoYnUCbr-H6ZRR zSFz(?vhYr%&D$}f-_?oJLofW$W(SLE_At+|&++vg?5h6J?TkM?-6BGk@3}L$lb&^R zHwdON9dk)inhqoBS~Iwu2zF#dB97=rBF;oPX*U zZo0!A9h?_8x>He^AefZS0BP!JJlVu;EsMS&x&+@a_FKY2Ju^PADDPn&A(B=tXlL3CQ z#Srwnzsvv^}A_l)|&48Zmw%7Tk?}ll=nurgI*JxJkk-0 zXX?=m4uPsmnrnvF-qQ0KOMmTJCeQ5K$Ra`J#&j4c6?|gHZy@V;UDTGRRj9&U@Ap9@ zS?TOunaeV>*#PKW6!;1c@JbrtuBD5j9R-1hcUPNg&cplY;5-qmNcx;?6_W&d@>Soe z&YhGomKGK^Dd#;$&B}uu(eOTne-YcNfknOSt4Fm zgE=L!?3&#SL5dnYVW6V^kQxRU-!_6s$M%n@WP?|sn-+@mTs9qxTBa99E7K>2;Dg() z5HIV82)Q!{?-kh=35!}Y6g00d3^aEG#O2)vCfixqfyrhZRY!pGFY6!de9pN{!yg|}*B zOJ+2D44fJNnbP}^UfMU#Xm@6VQ?7}z^$mT!+zDvExE5i~kFMyT-i*AocW0sM$QR>L z0y){z63LfRF{8cSBCgSl9!z4LXH?09@ENu5zB@#sxv)Ahu4T&TNwaGnGH__Sw6raJ zEpeEuwK6bX#XylGFu=xS;;1whA%=_KgQRFamUHabjcC|a#+D(49~%d(c|IXi-f^ab z>S11GO@)zx&YIJ(kt&k~O(%?jF`&+VL>FTiLKi8eFk&tSWQw@YnEWS6J=_E$jMBL? zNXg*uO)p`uRh$MN-1xSgmd0U(V0-L7HkYQrurhcvd_N56V_Mh3%CipPpvsK}Cn`mi zi|2g+CqUT0kjQG%*PpD*5&`xwC!E+4)?TX~1gKOIqmt3hVzRT;V%9UeX>n+T751#{ zaT$|#hAb;fd@~QwonI8g%wN;{hLK4cN%|xQhA^fKK}cm)h6L>40a|Fgj4Q6hGp%TW zhm173A%{57A8Q4-Vq6w%^-=I0G*U()ipU<*_#h@fP37yP2bs`7Y&Y?!8bzU`bPagN zb9p36;xTi>6+mdh{?G)BC%f1|gna`%L5L^~7p95}D@-hm@gH{5DK6IURJf*-`#gbh zXWYt(!hvF$?^X@;h^ptix%8q8RbCE>h4|LO>b>X;=>Ktr>5Il`d2j4~Q|8;?L82MU z`XL70_M=*%nC4T)gItcG$RrHu#tyCdH?J# zeUyA@0vAu}kh-hc22y_u3x^?EnqR}P@<R`^ztP-uQK%_ROf=iLbtV($`Q{gpz3|)<%p&@<3YH<0oYnaAskyJNO1)47H*}ubl_M$|Vjn$TW{LAqca6u!I{K z*q%ExK)SvuJdnf{!rLO*cF=>vW|(NHweAnb-oom7ctCd}4I4t&GkU^Cfb1I5_7Ssx zE&c7}IJpP`w0+E1mMXZyn$D%$D@Hm+LC}4rwo;D8RTy}qI3CZgNP_sv&zeAXy*d0y zmq^fUnpl&rwu9@+?|5DS_fgjU}jli892(jS<$8Ud_GKunAOg6 zYK1e!v`!Y*yIVXS_{4UsN~%;@I#MNF3oA@j_LqZ(gOh%Rv0?1bqb9|uFXRXKFr*LX zXMDo4GKj;pcMtXvR?A_GgsABG1RCyg0Lrsa&c6`{9B4h39zfS<&ry{DhJ0$Q&%9@i zRD!b3t=CKJ7zhW*iMXVKAe+c%21qUk4V9Y;U>|dYwM^BjQ=Ri8PVtzfERo)ja zQoxgRmsVH`6Mvi96#7BhV)OYVE2QRK>Z7A8h5+J&KhhYS4)*grL6eejORm_Um~7u+ zUIoDSeTf3X@*QyqER4g?u6!R#*EAxs(lu;8HoSeOwIa<7oMq9ai`~ZSI~LiZ3*gE% zB)v#4k)CrFKHmtQ4SILm%!=e!&hAc`tMghAef|+6*3J21u7s#f@UjG%~9T!=jQB1=*-}Mzr`SKc-@sf3NHJ{izbbF;gv*(p_kp%1{IxK4|Lq{sM4xv$Fj}c$xDL`6Aw!PYTNik#a%g3O+NXOCDS#2 zE0C9h(e|~}QOpF0xH7BpK`_t2a^xT}oH#r|tcLCnQRHc47PcBu&Y3CyCQ{Vb{LTjw zIpMDAAYX3Ed|xq86Am7CS@4pa|Ikq6=ovgdOwH~>RsI^Dz~1X77uFl0om}wJNNRg- z`e7`uK&OKRaIx=I#Vv+c?Xo$8LV?&V^vYnMsBiOsXca&AZOI)<6pKq zI-R5k<5DZqR2f1q5QBv!+>lUKE~JYP&GX}1h_JcyJO;mpXdg)R?NR=dA17#6;aV7C zX(#U>uFSo%vcl+dVIs4OGDdSrFrU=O2}?c>Qt;2jnxy663lPmy3+Bpj>`Y&mG`D%P zc1@U*p}WnJnH7kUW7)77M9aq^`E32Z-du`&JwV7B3HMw4ot(8sxA}U>))j*(Cv`Tt zkHQ~x{wG5oC5@ow@lOB$TDTQnZa4bk&}M#H`hjqtU_Q?W&EkpCK*hrLip7ULAGHa{PFA>aUTBtI(C#vWvFr?NpZD7d#n!)l z7I)Rj#7<2h2V&#!LS~RlJT?Lg_~%F`|mrdJ^)9^dic|&x}^0 zTC{=iTk_HwXP=_LxGbOT$oX2k_(T>)W9ViZz~)RW-XtRY%N)v&s@!mhn)(9;p6F2N zOVl$i;83V*W?cs-=KP*tTAWX#0AgVDH(%3@0tjI`GKk9?4Wj~(&=O7hlj%zF?-_m1 zWiYmnxgHj)?~*D#ZVVGur$J=lHooq{UjLl7$==hWh0fSyU0dNgJ4KDY4n&Y%P97>_ z0)8`g#1ow?sx0&kyrsLpizNE5p(QB8V@Iuf z_PWVeQo<-X;zYleUPc@2kqGFrAft8AN?{F64McB=1f3zH*n&$7OMx#`xP= zti!tWu)rh{1_4rIyMk$mzg zQmdtR^D=!*%=03+f|M$RwprE9vq5Ny zDWT5HWqQ2OEQW!SGhqzd-FQJZzoajF=!r0;4z+1}&CtSaNyF?$>x+%jnmeYnBhjn% zf|ud}RD3}dzs0VRc#`4Cmg(|{@|jbo?=secKlybkP1I;{z6|!H9ORksLEnXhQqk%> zDIqD`X>|ko5lerRS>3@HJC||T8o=!Kq-(_=i9M?A^e|37o17wg zGbsceDMV3|Yv&s7+2RbdnvxCZ&CcVwkoz6Y_J@6CJ(683I--tcitqWj#S?01zIPH- zzDP$LQq7B?pP2LA5@Jw7-JY$da?8%^WgXsXYAT z(6n3~;)H&Z8NtzpijR8-(8*5<53urh>s?p`~SzXgCZI*{H#x!wsw}d6;UQ6#B_X9zi$V}D6ND&MVzp3SgG7%@~5vIz%gY|`?6>(gL2qEu6?1lhbZwBuo zIl)fRu6TnS-q&1P3PsGnY5f4ghx_gW9>f_X<4^)iV11jSM7Je4t4M-)eo^vY^Y|%3 zzCUuHW$BWXW1H~FJ?XJ?M=!&gGi=1Z_R2=!WzCc~P8nvoGVk5Xr>GuOhlfQV;@cx! zKFC3qtd;v2Q)4nbQGqtUXv#r*PW&KK&9)4{Z^)lKMVu1hoA|J;!%87~H^iEwix447 zmS+Mq0njrCj97+s!#7_>0xyu1t4^G1Hf}TQ#xGA}1`f8d0TVV|a9i|SXwGy_j+E98 z4-nk{&(su6n&y z4sSHc$NxBC=<%c^V?#U$4`L)d&uExiY@RV9pZ3u>KlsnrNeT0rU4;Y044*!Df3?RA zr1j^B@Q;V%z!~dY?t=?J7G|K42822StY*Ndp4nCF=hRIJ7NM|Df>LJifzbYn&ZkcL}*^x^aOJost*;yf{9gkQ||8KM1L#e*40Y>(@nO zO=0^}>9>eF&lZ>ijHo&x|4=}N*cTn14vVJ;;ojo|_L=%;^A#5~W3q!x8eHM)XBMJm zly!&~#e%$6b6mOiCadKLi@ed0TY{Uhj=Tb`tg23;sG716iQpRcM& zY<9H87QF62Gz150*Mb%n+)3kRead&NDH=i*tsJulP1vKfKpO%BW~0G2o}`TK0Z^tn zru^^K7`v1m>3ITy3>uhTkU1eu{o83HogOZ^%%$PF@QD5V@bG&I58}QyQTVQ-?eEAgIN}%aZcs39FwlaYElNFGl z9FC?WrRm_KU18^mdYIM_#xpK`O_if~?MNw+)OL=HbuV9Tjs}3n#++pxgPaMVSR}?9 zOJH7-)Oev~m)$-9P@%b|<2-4A~99;?!+ruk`26;_!iEdTFY0}4fSN%Mg<8^Q>-D_V;aO%2

7bAQJj*9iBB3 zVFpODjrI z-f^Cg*62ct zz}8R;d8)S>OObdfN6gGc?LK0_d+mWc$$g=i7SCi^p;ChU#r(kB_morvUT2;BB+v@X zr+7>wx=7a9OVoZIpcf(M6U zoLD6Y4Yd()gXXSS%iNxOv27w_wcx75iO4BT2+*mV(hcaH!CPP^w0#s?Uv5-}Z3`q6 zd4qkHcq%NBcY=h;br{K>v*D7B?f<^}LgDlIJ`Q?GRQ8-$CF&6qRV67q*-S zOgUcPg5VN@sUNV6|%$~8#ZunQ!1k8&+4He^SrxT+S6b7y+5f&hwWriu9Bm+B43 zrBr~;vI1gmlgPck;!KE0fYwPUuxERkQe@XE6zv6~;&7paEIeZrXGysuw1undVC$EV zU?=USMqkZbVwMlh*%geO1;A83O4yI^OjGR~L0}UL!;jd?MbHQ(S0vo zAHu+ndL2dIZ2!Elpj^IEE`FJqwL~1(o!(Sv^da>PpnH9XTOA;rD~CL<%Q!S20d&eG z8n}iq?uEteWyWL3O~5Rb1P?Xh;AaJ4Hx^t%Xa98+>qHpB7kyM=&&v`aY(zgL9|!(h zN?K}2lKYM2&^V(8kSRk62qCm@ALJQ6yALiE^gE4r=;4YxofT_sPEN3oLf2e~#WZ1B772 zr%WsIMBRtF#5R|lA3-*ySXGaEpGDWywpPniBiSzm_LA}Dr z?WS*-Wx;|{fT2g3M$S!g;!`=}MIBKGO8}DSW96}Bff$$QX6JtUN zG%kkXQFmCxmJUioKd-fk#^J!8Vf~ZLaWuirUmgNs2XA`~<7G4XklI1#yAzRD>!8gadGH+5bp&;9bVO1- zzX!eG!DV#2u0zfUC}KJVdqvx)zZa(e?*Sh}5(uMZTw5THN4$+~aAZ6W;k%EGp;t}3 z;&>Z=-7dhsAI{+o`%yQ`QH*O{W|X;@)$h#~qBjN-|>L!wKKVuEmlkVE$2ipXbU znUjZtPr_z3fx1OpD%qfnJi7I4AB;LpL756#RsgoH^H%=~Giz71nL7ySE1&<7YV3!^i zp!9=^$1U_1vlz5BMyWvu*Csa*sxo=OZTiZT4ndHM_NyghWBlGxr4sOcK|RA(c*Y_z z%LWSACOSMXmsHGR((p%&pp|H5CzU%wvy?e#E!f8gA-qtfgj8}~Ie`eL;tC;!30CwU zp^rQYtk603wH}Kv0=>v0h8koq_u=6<+M;m&0?XF&am&suJt8D{Rvv-Ert&5{kMSi( zc3VQ*IE|mesggD{M$HLw{)aH`FlrQs=~H;`@fUJOnK1K3nboKH1MG}CcPv2uN45+! z7({w{0rb2)K~97G12t8msK*zqZ||pHjjjxohWjoHe?1fC(BI#dE3#v^b9(UvdmYuucR*bDs=lmB?12)q; zPCT?X8$E-$axmcSatU$hd75#HK2_r+Qu)!86$j{0CfG*C1+$}Z>I8%$Q@!@e-hI@* z0K*#?b;^!ld2ZtlXj~q2m9ToiSePXf%iUp&pn;L^G7S58;L`-XN$YT2Zo>wLzFOx; zXUxg}k9H9?hO((n^7Q?{Wzv9(QX2+FcW<6saIa*$N2VP>^N!awU!q39MwjN&{T z(vf;Ven3rUUf*0ejbew0S1W+F5J37aNIgs=2AK79MIq9MP^RZ&_`b{+ zR_i(g{Pa3`QR)4dCmlIsbAKx?w}-98=v62bLF$hNTd#;6`BcJz>phV&l}v-t!q z?|jpai^GL##2gn~NF!>-GmX0yiVQMR=kVuZGClq|F7*n)WBz$Q%cv!=iT4Jfz;s8v zVfTf=*EkRV!-u(TY(ru18oV6GVUP-=AaBGc!sJ_YZc*QbOTgLL2l__U&eaG=Hl+!J zYtEz-4zgTZiq%p+96kFLD7+Xz^i@y_Ctc-? zocyAvO1HN$bYwb%_zs3L+T#kk3j?gpDUV=igHR{CWQ;$cf&T&pAc2AIV`q{8%}XsW z&Yi|u1eehQzS)2T$OZ_gaLAA&EX!iJM8*0Ww5)$f+j*cRVoV6+yRyRG`3!P``P(tr zmlr;baD0+ni{g#AxSPj?*0quR?ea+oF$IVWq8yg90+w;zWrHI>Ww&#`Y4;X!Jnfw3 z_G|(@DzM2jfwn6+G-8Lppq`w5a5^EaZqbhK7&L`p^n;Q>&bTih!N$4+#H?~A0Y6tG zY3YN86R#C?L9W-!d?pKsSy`Zf6B;idn0(+J4~R>W!WbaHv9Q)Q2chGI=em6s3=UBY zbUQW?AiHnn`46bS8&%HnajQU_X{;gj&{7EmJSmZYKv2I{KPh|&!O=??IzgI%X^0Mi z>7=&(-nmE?24eS3{;WvfcD#4daX!!TmUmXE7P5noawJkZ>wXu^*gHv{Bz-?0IMuvY z2&2~?_odPV8y<$*e*jlk_>V5~Y=`-zQR9bk^}!L%Vm%vARtEM(aO*mR5hN<4U{Pc| z9L?0AiJgJfc=~k)Q0Ny6p!6|Un8E@Rn&nq*^}X(x<}HrXwyggP0+pw)@*Mm$R|NUo zn2J;?1v46MlV~rhz-KBxzcsJ zSneT4UeT~pOZasGgi{Q?(oU36UMx7{Fiwp$?&T7ohNrz0owVSGqb0MZz@u|c470u8 zoxoU9MtL0`i~eUw#BMHT>2K7;&LYEkt=Wff#U`X-DKJYNMUya23S|Ik^P~&A!NuOl zdJ5g34&m79S_8vNG!R@`Dd>D$(lx@%+%tvft>ofB z+KG`yKb}k9VK5ZDLYkxf@)sfMp$k;nT5Hv^Y}~TJpgl zCShM7xrOzTGY?vCyiZp&bqg;BD>nC@6 ztcbw(8Yqj#j<8?OsYgK^FoHTR1Fonzh@+emW>Vc(^uloMs-H6s(sd1`_hEB&I>J3f za%SOhX$f82@69EG7m&b4avFxkzdV*H3ka8SRPmAxMTo`_gNZh4SZo!6qOep{T^)bN zTfZ~R;3G5#-ycs$!mu%ErLbo`g578_49g?IemOLD6fbDWD-MD zMKM9y1bfATv4nF8wqE)mVI8R!CX!uV^9yFg0lt|8n`UQJ%OY^rZ>vP9$z8B^m#G zIxIG%rupKYP2WQ+;ldocic!BEmHGR*HnWw#g52UZGKrrhYrDG|0f2YM*i!~Byz48W z0w=N{c9O_3V3o8JSdkeLTnuDIocLsVzU`3SS&Pt|4RlbOroKgD8UM;#k|G|afxvX0 zH5759XfM%pSq#Qb;17u*xb_>`@+Rb0c6}$P;x3U+46pPb)KWb{+l8B|qka zfx^y*7Mt+0ZB$w((x>u{ur@2|fHV*=9!V=Xp$z!M^bO#QPs%va@M11}e9em*Jsoh_ zr}r@&h!s}A{1`Ki8N>OGdM&d;m6>)yh}+2;df_ZR1aniDV|4~|*wAYd9%Z}QqwpEH z;oxK%$@L7r#OU~R5?aG>H@3%0!PC5bSR@GCJ-Y&@{9)-VN*fyR)LlNr9)2!8$AF#k zqRsYYN}<-nFWCSP>d>R^#MpmBG)A)?jo0ZY8i^xOnmFGfG$6^AF54hK@<%W`nRf_+ z;ua{uG^8Q%yc2oQb2KIfOV~<+V?p|Y%GByI=U;|#ZP53MWE%UEpQ($FNN}3;>TE_f zE=`^-sBI7j+k+rpIWf&U?BDHFQ`*z2n+}k#{p>-D(cG#FOycx(c>lqWxe_>Ak(*l^ zjZHv=rY$XRwk`%utcGE&%!SLKcW3W}b$#MlzGx~U?S$#Lm9=xI3gRGM7N&u#K8S8X zKDg)%_6uYMts^6z(de6`Ols*43KCw#Srb3WspxU~;k5<;GIsQ~4lvVfpo=B;kX6n>EM6!Wen9&K|cb(|2BTK1E%u z2vm|j0ME8gpG@Q$!=sr%b;_b7C?y6uV7^$-z7_&%KLr`ccX9!iXg6jAz&2NJV9tIH zpt3XN!Y*&3TwFBqhuC8jjEH1BVY5&+r>4WkD7Z&>n2Y`CE94PVNXr#7dXmQz((iv0 zCcl#a5Ga8WV2I6s%lLw)lLP=$H*64DDGnUy%V^2j#hB$t(by9N;KWmGAJ=C86yCsE z1hJ$$Gihkd=DxXJuQOrR6zXYI{r-Hv2o|w*HvBL5iihPl;~btn$VL}3f zbJfTZ+9@23(jmx&HC^eX&gwK|k)9vbGHm7?41%XO`HYcDD|AvT=deuqqOd5Gg0llW zp=aa}4Z#bo!7iRaadOxd<^e#8IErA9z!gXO3m0b*c$AfKeY9b(?EZ8<3kR__NG638WzU#0V)Z<5 zR0tpE!rh6rm*7z;a_D2DcE5|Y8biR#O!_U&VdKCWQ-TIifp3x=I8OX&*y9bj$_!id zY(z7|0>MFW8JQ_XH}(UCN&XNw2!88nU+CtGHFykr{C!eB2lD6p5E-X+;k=>LQZ}<1>A6M^4qypa(;1K86>s19uK6FWeV4s`>EBHwGzBb`>^hBIRVv0 zJS!W?{_A`iPT&@K9w8t;vtef9L?Z?fud4;LO^5J9T=BuMymV3q>A3v?Rm?sqUQMbq zTj9F5{I{*lej!6N;APx+6Xk;ye(S$L()m-QJ#kzx)TBOGeva<14ZX7}wH0r{weILt zv|g%WQnkHi@2W3`Fs}=6+8#89Ew%=i`2RP!QA_=izF{br8$BP%&y59mm{!>jIz31T zU&%wgeYY#mZAl4QKt-j>s;PWEA2CR#nkmCz#tJGb+c|G-sVDBfH!Mg*#TF_I5c@zR zKHc@7-$d}Dq{@pRVHt?sNT9ADuGYrt=lp6Zh)l!MeRl#JA-!o!M3ffVCkVe@8zILf$%knrUG2)5y^9-VI_v;3g1ykH8ivI!^jZcbi zwnc-z2oECwvS=O1ZiN_x12QE^K+Tfyi2)hYQ_dUX!-`MhXua>Ul0>QA1E9d>*!Q_y zA92X{O{$9~Th*|b8w~4$AG580G*oqI7ex491sQ|(NR{I$PRZE+P4vclfXRLagMc~# z52rVLe;Ox4yx{j06ec%A&P~;QXtW*v_!ABUHNjYO!q?PjE0@Kb1g?VYGyuj2mRqh_ z=F2F}>|N8=G@+e^kwq!p9?)pM{z+M{@TOR^HKOn>hc?6 z?k@+pdIB0__Mg!;zw;u)fahEB$%cXp!?~hZ^Rle)ov`%o{lq8*h)#{25dugzNB*eZ zosKJWtL#Oc2ceBtJ}=l26oMldEQz>FIkLXfEdgZEBT0@a0nr)J_tp|1tRa5b#JqZl z-iFQ!@W5&_yb<&ZX!|yj8R6EKfH^@=f%Na*G?(Kc!6Hb%X0LboIye))ItAr+^<&-$Z}^bvX#J64<79eg;tBSv z4}+h77hQ1pi)PtEahwI|vMSv#CP3KYR$%v;Sha)C1(9!5t)rYTxQXy zZq1j&QxYQT$^TE8NKXr9ITi$o?t z`2h@6)0rhvuzUpx|A7|vE_-cppt%$d&SFGF8wGvp@b}|Tl`scup0V`>1%k*U3Csl; z3Lelwn_G!-9pQ5YN1PsY$91f)+!C#fYiT?u5gId!B0Sc4JRy=FNWRh&$AWQYonn7$ zvn>M#FyT1`;zQOkn_;ZB2AW~ibqfC5+grNoqE{i>y-x3sdIZ!(&-dM*r1c>hQcVI# zhuq?`Y*u2?hISJLOQ0-y0?ho!?|MmlK$c@wwffu7BHp4^`DN}<+U@6@5~$raAnL#?o?=v)gr0!kUq176vb&t zVw6`>zf`b^pX+{3$~>NSc;xi{v%uykTir~gmh$ku33x06naz`}!yg4fiNzdz5e$4T zfne_-ZGx@())#tXhwVBCL9N(>plHyD+MML$M&L@+eXV;1kata|2t5_h9p&6hciha^ zopiGPxQq4hD@fm3RRVnJi^^K!MAcYB3AfRNDjNr2&G{c_DydCsis1+mH}Dfk3>#4Y z844dq0LaDc%nmD`g>>Zf;MKP6x9*98y)eymy8_ZW0L_CQty|ZEtYR8*Nf@|nkn^Oe z2N@Q0Y#u_uHA9UronIM1K@kx&iI?Oc{Olkp{!1Qjcc<5Al7p3sfI1S+9>Djw;#z_e z9>e&ydo@8nR_}5$+Fw5}+99amX|>q6$0XjX@}21l9QAZGe0HKC0~k@v#(W0igmlID zN`(SSIBx@e7aK7hj0GEIdle2+bMzhIj~t;Blys#{@jNG_h;aF%D~<)-Ji*$RN>ps% zu3b=waU<2C2)L_&w&0F;h9;XryinIz*8^7(;B)?#mpekq-iIi`=1QvJ3azqsrQ?MO z6(Fehe1Rvb^x(tMN%W(Rz^XEPH3%^+?ireyhakW9uClTS?6jMK+UHeBsJKy12R#4! zIG2GSOM?L5>2Wr^9Fnfj1kDfTy53<-rgE^(Xk~>sO077jhH?56*ruoJOs#*3S4=C`_3_gEb^9)oG| z|3ls!FaB=t+P3v*%`#xYaZPXg*03D7AeLM>oY(&O$#Hj0g@p!X>T!YK#R-v*>M}QL zcSr>;E_gbap&SA)WFWQg2MfIhmH^4nOzWd?=0Ye?NuF?AYxL7;*xDkZqDNxHBO9uM zM1k6?5=l;h5&@m8zn88YxLHB`TCFJdehd z5QDZyqd#P>V>;RDXYPWuzBXG`=PthAAa|5UH2LqCh|L-JCE^JYq^D#UM$^eJ|4KnZ zNHo5l*b}{-*^O3#PxHzjVFs6i4Y9A=97139ONjUv!#~J9dRBv1WL5`I#1F@Awr}N0 z=$pWfNv$`Axk=kcD<;{U$PKSNtV5}fAk-6GHl{ z{IArGS%}Eg+6mBNVddcCx!Hvw*9EmI&naO_tFbZ6>bv#=1kxi^Na+NMjnW{)5+AeA z(-pw8R0vMSOrm5JVIB3@HKRSBkxZ8wJAz1H0u`#&KYi=WcxD--+DNgr2HiTN50CZL zoRy|rumMnkGM`)Zp#PJI51PT37@@1i2&RC7&Kk_Sb%C%SQ2fHfrytfg;H5Ei@dWmG z8S5obi>w4`&`+8?8*H>UB3ONd+S>YMoi{f@qV!9RtdPJ%3Nf(M-@?6kR$k61qL7qo zf<|e)z41yhpyu(xj4)xz+8AfNB37~SgGXNJlNaiVgZczSZofJ( zAb>eSLl2T?ZQq(4$dZYRIr?5=Wh##0uXJG6daW47nyx$7rqYT&V@!$-8ooKXt&lG~ zQ!tJDsPcZ1fA;EZQUZ725WHN$Q*lT)!Vih4H9oT5qa4e$){aa)MJ}L>8@bM4NMJ}R z^;rvC8ObZgJDZge1#_E_7Hkes{Fx?*5z@?<+vfO`s{-O@CXo_nscWO>{D)OGpv@(d zPI;eHG=w{KxPY1XJYX7#`>~n5!OBRh@9!sye^cy_*!V61YOTa@8@QG5J(sb>HY6oM z5gtio5L zIkPCJmxIxxT33Zjc=6i|_YLsAS526U20umy`sbDYDg$uya2t>MBK6O`R3ye6M=CKAJdxCIt!r?;gIGr5q(_`jil%*`*siLRRFN?$dUe9 z4-Eu_C!iLB_}mS5psT+t<`|%5H86!SqRr3TeP@m$u1Pin|L7;s8^hvrLcB-^hoNPf zDQPc}`&?nfnmBdkMre~5v=&kP47dIfdb-_#BQ7@gtd#No?n@)6Jk-!};$C~2`?NJ- z;2rTGgB-I59+VaVQ%gc^DPkAHO<)x6eg@p;68L4x8GCEqljVHHLFS+%HbM9rJah`X zsOwqG#QGJV9a3$>9Ehq3Ts0ziRXV3k`MmqtC(^XwfW`FS4_0D|Jswktt`)3w!L?5O zM%ryf=Kngb>upoS`0sa+$pY{?4YcPbg3|a}17Od&AVNhkH7yD@A&OwScqEHBK8!)) zC~ZBGeNA!6@DMS(Ip&_E*=a&oqP~Vah?Re^o~v_ZX$OK*a)epqopCINQDF!b1D5#7 zE8npt=20X&EFx?ilreVLd%)E^?hgd`anY8F9~ z3>qbdncH9e{|MHAMNu`5bUz5b#&tOjc-9 z^FsEfdRJUTqeO*%Xh45;809ds4ngW;EzziAF9Hm;DHk2zS|q{O;eX1<{?YywW z`Q129au^SuIIPM}z-!AdjO?R2Kt+d=!}aWO)1(P7i{mW$;T5rj#XVrrvkc{37FL}U zM5owrI{XTM7&+^$;1b4WGE>)$bk!fi?tI;PuQ5kgrck<1q%j8}wG)mC#1O^DaDk`l zs0U=!fsQfFOe;mp7Z2Q5jdJ|-3Mmj1SqsI@qMa2_os=^xm?_Ek*MH%iey{k=3(~{W zUgi=|k{upS>K+6ma733YtBizi%5ahWIYk*qPU(4Cjw1OaMm-Rd9HOnKM66o(f>~n& znkf>5xth)%k-+g^gEJr^*?3)3%*dGH);;+@>ZEEbrx@;bTo$6!W{(*ogWo(U6u2>y z#}|XNRzyFmy<8JJJad6bmvRzpq!2NkRK9b+ow~cB*NGKxhA~P)pB=u6%rCeHWa?BB zkCBt;W)czM6Sg)=kv2q|Txi2Gp9?N_Ugm^6ji1aq!ucU~dJCHwEBIY7OU9dqk+|?d zg3?-y63N@`1W38xgk^?-bE66kGIpp_r$fs-Dk7OIkiPc^aOc(fvYfiQVn~eK@pv#c zL@nOf5MHeG)>aiNf&6_uB2-vrNSSF1rNvli2W==Nv%e+@^S;r34Q{ezfBkknp-HT< z1)6Br_D=#s5Nq13Xk@T_-h^TwcWY78L3xdoVdz|-aFo< zp?WzXIoX^s-g1W`KYX;2|9TFA6hJl`HL1TWl+47&on?aE- zGlEmai@mE`9S=-+b|@0w14^AOdVp&uBRDGQWN!hgBTM=$&+s={N!Vu3xDo-sk{7GZn_ih za59#ShAxcJXyV*ayyapetOp_WL2a-#Kil)tO&oYy7ffDH^*EA8;+zwVc35SAp}ga2HnpPFS`m_Kv5pNj!Xz7zN{RAq;Xpfi1Rfp^G<}s zH8#EMJDuKs^?C!{vcdNCOwf+swULN)$Jg@$g5;aYtr&wgoYWit3B%-Sr&x-==qs3? zr*Yka>mZ0JXU9jeg1GVL6ZWgX>wUugcdWEl$sC%x8qocCGzVUaB7*nPA-6I9B=?6< zIeV~6efY%MdBc41j;R9DZ}HdyI4KICsXtZvvCa@`TT-5DsxBWt)5QOo{u;NVFfqoE zMG+1imHtdCsYU^a9Rnb9SsaLqovWaEJ8PQpHCo-K1~Cd(UP?rHh@{*Cr!d3iJpd-> zaZ5KUQC)boacX0cQe?TFQ80S<7SmtjVMSH8-ep_FHbX=@NErkc(QmuZ{w&mE*gxH!7YUGu8${$C|DLqK~BYjLO1pai3c~0#!5mE#DHLIjS^Lhg9{D>NbcBU zdT4s5gTcKXgVq|M-WhC59*|*+`fwCChx~VCY9Z$}^dR%_!Tu@{K})tMN?o6UVOBkV)HwLnzc{sxj!h-tizPuj7#Q%D zeTX>g12wW78De=ukf8Tyau-K$cCpkbbAV&pU^OH%#K`8|zA;nh^taZ<&%RgnPVnR> z@kym*sqXB94H&Q=oa;0&tn0&TRQq~#iaf!@GD6N*U@?n(Ce5VADBACi;J)8$v8NfD zB%Ye>xT(Koh#Bxu%@~mW2LfAw$RCLhSVJm{uF^}4(2jB$d{Bli?)DmES@_oXRiIP_ zt(Eea|A&ZOz#iEK2SL^dZV}~1yeCkq^ntGVD@eQY?h|_df#X|VpJRIz*|oL7Fh}TNeT)t_T9X$@c8iKhI>H1)_dJO!i^AXJk>MriP8M8{KMvS zdVJC#{kZrC9;42ZmRFb<`P`uF9m);%PCTJW^S&KnF|U2Zy)OonQ=J?{`e*|$MsJfS zOd|^sS{!KW{S$)b!v_dZ_62C}M0+xGHzOjI&UFz`BOcRbNqasieg-eDx-?|qWeSMl z>KyWi#<4k+Ul_DINXjFGt0MJ9;YuU^dYQ z>~3pg{Dz;7*OeM|%2v!6cOg)@CIVe>92-Pn(40PX1l13_z}MeCmMXVgIJ2C6Z+9dwEgdHB;L=pSmIj*aB;Ai8X_itRl8i`$tfM25$kC1f zGeFG0*2UV5A>&eplkNA9IzAjRPVATyFH`?2LCXih1uC^R`|uNa*@0gY0d<}PcCvL8 zsQ3Sv0oQsDxR{(BuhnR;1^EuM=~mIDG<{1{KtoV~6a!340L1 zBySdGAwZLc$XhJIjjmHF4p&G>Y;fuO!MyuMZH!I$P`{_cGfDnG&33_=eq)?>oo zbLOtu_^T>2VayV~H?d1@a15DV2btaFD0(-s;Ooow!kI2H)(`ztVJ9jb=}$Rf{BI%` z3%N>8t9fHdcBRiy+$rtYDI$N1R6|dhCtIABPAtOv%!L-C>LbiN?QhzeHLyaN{(5=_9mB`{*8=p6A1 zy1({P0a=2;{NLx;NC@vh&B^FEgU$j;hM>t(Qo{!M@hgV*bRa`%9@RRz;>R;~@AfJb z1vDM(_M6NH9wGzKHqico4!XDc5KjMkXyTUXd-~nbw{4?7ijqEVhL1h`qQw+5C z6m%U_5d#Jc_l@EImN*c7$zZ!=Iu7z7=+cljFm&RDhRcXji%Go=xakQQ{|RNJKiSXQ1`-1(T^k+SO%UX_b|r%xT6ly+5S+ok&OQ4H z0?T9`Ry*Lr6sd)A;a}8tg-t<5a@gM;ffk0yIOWnSM-n5LA2$f>pw5NVd%-7(A+kg6 zH|P`xZ#;OQYT7pytDj(wCH7r$q5kS@L;3jr-q6J&c||P;G)Um;$6IisW2P|pA(H1% zEI8=`vH~B*6wJ%eD{a>TrXygE<94nG!P$&r2imZC`aQ3rze&u4-|Ra?>f4%bhg&w^TV`>?VIqYzMV zZvNYl-Z|2Nr%C-4gvUJ!vYmy&{(kEREaiFbw<8?UVrIZflOW{%dZYcT$DK4kIeI?>aefL z)S&!|@oBwJ9ZU6C?*R9PmBWp9`O!@(I{kaW1Q&4<26v@)I}#IQtcsHz8O-O;A-+*W zR%(n*4mh2pofqBsOI`A#kzcLKYr26o)M4?wrmX1ii1V5in5m@D+*T zAlmSj-F`Y?dxwWSZC9@?j78c~4gi@baNK|ibMsI~-?SdR!6a1q?xf34=B>Dd`nKok z!NLdbP6`yd1w`sn*1)09kn>011T+1-!zQO@pC~a;F_takweQh14IdKZ7K;xt;MNF@ z8TpX3FEOy3iPe3BjEr&5*mGp;ZE~UXD9fZlXWj_Vabd0ab7E`P40PfuvzWWsWf1of zZ%v!q#Zb)vJp8|n3oug+)U*-~Z_wsS2!7^bx5%6@bb22@E8Cj=K@@OZu<)6{Y-k-1 zmIHIG(UE_DO~|6i=fF1!4qShq+S7|+oA+ClRH?U|_fxn%8={>fa07Jz%#U<#0pQ98 zPYr_Wz$5Nwa%%&Vq-;i?X{|}V7MbLGujven~gBlmz_(q zao#^$uD@n&hc>L_&T@=ZfIAk-T2y4}e(H+fmYi;|JI=kG~qp zEJ>&GfZ!U5RSl<6H-KDG^ti6k<@Z#0Cb$J1!UO7IWuLGA4v=e)ED239XrS0MXcUQ< zx`MEAz;rrcxs-jK6MBN~W|3^1k$fLwVb+0+B7biF>!Z{D>^>k_rZx(Sqa`!2moik^ z?WNL1<`5E-H+gW15?!%Pk)ORbY_A8zV4_DNlK#QV7ibs{(Fo4J>oZ+liU^M!CRx?gg{etp?7qJ#KgP8%b>aXtX)Fi!7gCy2YIjxA#$OVXF z)HxfQ<4W&nOt8Gt1#fFy4h+sc2ycaTLWPF}yG2q~XA2L$6iuehNQ%X9D!`LX%R+wl z?FS)*osFPtKNAJz4#_#e$%&JBv$2F)T2qbHWIWe!{r;QK0j2)nhFf zD_4TpuLaaWy%VRlGLRSxHy8WOy?W9}fKSy1xeXXAzk}~$utR89Na};z)3EGsa}` z+&ZAU_7BDa5ulR(4gsdQ(i@DFE6B=py+n6c1_Many-=e}ZbHcTDW!^xz=|$@%e>yn z;r%+$`3F}Tb{F@X&7UFx#z}#i{pl(GMWqpMzVS`LHy$j z8UW4|%BTrpf4prwk}75%g}oT5S0h-J`+Ek`mzrdw#m3}HhccDz-@$14#qq0JjQF0D zst~R{F6b5ugI626^Wf-b>#N~b(EQQtlMR6a*gD~Qbjd(n=z;N-n4+4u>M zL-gufoUK2x_f!5sC16os&#@j!k|5JVxc!VUj4XoyR0*MaGETo904AuAAy^y6I8s@ovHPcbw80ntx6$d0P*A^aYdnA^Y@40KP}6ijXyytV zxx+Jcr`Y`VG7JG`@)vs(%d-k294|kV8{Tv(1^e#md4*Y!b%8HH`7p&<@5yFA;0eS2 z+zlHJW zpY_@qn}3CXI1qPa=CuFZHcfZ|J*DQSA5E!r7zk`1gdOdQ2{O9n55R(4iMSb@>7HUx zk?dMZ9-}WNEClO@c6XtV-DoXq!byW>AITrj2LTjJ^w+RiM#yB(Q=`wB@g?ED&p)|Z z4{eAp_T$4GD*7Tt2*O9kiC|{zdW8Ktql`y?#)5$NYwWPbm!817en~7F1tP-KZ1IwZ zUVi=1xw^p?bu4i2Y!5$?K)m4%o4t6{-U`%VHfWxS*JUs*f5FqbIXPbV0^!oEkAK&v zqY_a6x%(s`j7&0uVgHsltK-4JoVzY7(%*>=B8!k+9DeK3G)Pg>%{86(M-F3QvJz}KRw5xVJY4Fody}Pm&+qqV*CiuZ?qbpE@gvr(kf?td6u}E?X-o&Ta86;xLWi=1z zs>Ae{ro@OX<=3E-VF1Fd7fH+b6$5hKAeEEI`%7~7G{`~ooL_c3)uFy4HSF=IV!ab| z{WueAGdy@By{wQXOOb=n1_AG7laLWybWpmwwn%U>xL}Y+61eM%uQ1>7n-sszODY=- z_^e?(?mAW0s$Nckx&e|~5IF@RwEo`5be>cU7HKQP+qr=Ni_GMV;RtNRbF>MK%f=Nl z<~VAil3X+Y0w+DOfvBOotT5*Z&LpsF@uL~W*M)dsY*o5qNSyjnEgMz}t$~nhlMI@J z7#&ZVnNsEycEMp(F7WSrPAUJWg>r@?9hRt1os3Zq!|?N*Y5xgWJwICqF1|^QF_D5c zNv1_PB)NEwrxd9BC=&azSs$E*f^9y1Q1u`&B1JxvY7uaCTdrMtUnD$SMk3?N@4rt8 ziZL}p9;wLCD~<%il3MQP8Emd#H}NljWWf(wKcMfL36703hIk_u5@zNoXO03voTGi$ zK?!-x-L&px-F_zA5NwCt{$%FijBtkTBYigDcFhIf1&O=3g8=*ovf>P%dGuO= zi5Q;iMWHu&zTH)@bd_l9&0BF%yz0V+@QB?nv;U2cMg+sfQ;W z(&>o9RV*$#dRaa}FQT1IP!xl}ystWfobU}wv&wNsD!;_UH&DNHOd`XXOdW%E>Ix*k zSITt4_IyBx?{wTJ)fTI`&J&M1LZ`!jLOsxDKLExy+*a~qhaMl!A~ieprWwZWOyc)~ z8OFtbjrW2S1D_BmsQmOU3#Y>KQQME$Fnu#6VEoI{$CBL`*fZ^IREiGPW68=uJjl{J z8&T9EGmsoLPe)V4anUn!Co)K32#tGJS?5BGDn$y0z)R($5JJ6P$|!0rLHI)h6|H6v z(6;r)U*)J%>_u8)EqD9$IrL%}BR&W$J{Y88q7z)9vpq_cE|4ig+*%bdLfn~O4ioco z`OoFG50I(yYn}f{6Pl7`)2$$_OpzY1xLHY05+Ihrowe>LLL!XOy&LxO9?^K>_)&}n zr&J?4J^=^4>bu{h#`}MCndU{6U9{WT@w*A3S+_ZO(|0>8(!*wA%t!g((5Z)^f6!}1 zlJ?a)S`GWN|sMx&80~sLuxEhk(c;K?E!6<}SQw*(}97)Mn?Sj}ri|9ux5=n5l_C zX`8E+_(V`r;(eb1R)6R}zzAx>BH8B1J4}yDRX|#&%zzTw#}SIJg>U-@R3oL_^mG*z zf~;PaF0>c7?lsLJxh%_|{#=(Sq7Xld&ZwS)FCR-W2N;rfxx!;X4zvqdP)kQ3w2By+?|nts zlzD)dmCi4ZXZwdb7*4~E=r`K5rAGRM9S^H}W?wEm6&DI2&|&4TAT4^fC-tb34hKE> za8V}~gyurgd@ZKThVL5k^82~!bvz1U#^38PI3T>397Ye#1`h+^8ZTMRf!DKB-K^60 zjEk=%Lw(Kve}km@FwGA(728NN(VIi{KszcNa+4waaS&YG`uJ#8AV^dtKL&5amEvUJ z)Pt*nY4uya>TOLH&7^yn3GAsDJ@cD?SVn3nKS7vtU4I}Kzg z%GEAgVBe*n>7{ECM+a(OUP{M=9gc{4OGP}S$cz<_dTv`tSe~Hb89aC>`05wKuEuKNnHwcbeo?gE!|#eQ0f8N6B0hN!2_bL7+1}TUg8Fk2)c2_ezkyO@Y#= zPDFLzBZNiIvnl}FEdf>)Hb$A_{^DAWXlQt9A}ZWO%3F4029h(TJvs;cNs7NcQI*dt0G{B4b#Lgzt>V+j@<^SuSfQtVfJ|!5kCUZ zgej;7Y8O&7VN;CLTX-M_YetpTPlh&dE048vu3q_i;NQyQ@N_a~{TuYDL1xbYjOEY_ zn76)J+0B6~w3-2`$~HzdLZ2oD@=gk?)9$6Y*sUQm=>CEvSesXkq`ynP9*~vCYN!xn zt`p8{)Uz-v?jwgCLcn8m!T3ycxe`FC!E<8+ihdkuqDP}Jzhg3Z_zt_K!DuA}z_?W} zRf`NvTYDw7f!x4{Y1F0c%wYF0xuIicz#Sn)elX`p5KpyKhyiahC6UfIX+5U`CJ3L$ zq*?|b{3p$Oc61~K6^Uk+BAv}d`RrPMN!;ZI{I%7ZzbgW+GY5Fe3pEPBp}iZi7?bx` z=Lg3sVIRyjKv0S*Gl3rM3m%&ztRxHo{Nlv_gUT@6@P}+iFbI?#=>m~NU)=;8r(0ZT zZDyY8ng0YPodwBuGH*kC85&!(9xR{#t>j;&>eItkigjx8qoK9yqx6XF&+hwWQ)-Uw?W<9jf zw@0(?{{Cl}(U@gN$fD@q9iQ&Je2>h%p1FOWmDmMVIGFLwf9q(z@1jm#zVnB?vCox! z$H2sFcb{^aURGCWdS0F($YQvp@O3nI<##1%zRe6IYDw;yS!*?Zds`-9mV-~a<{84; zEfd9Ee0py~4?b<^)@8gX*RxDzIf=qc)chCs6|FYMvvt!)+j>2pIKR$4ymSNeXH8py0xWt=ROF^$UWXFC6p!h%G+VSuJ_!sqrM*FYTD@FCL7sb zT4cWbZKmT4*mbaGWT}4L>|%L7S$pjFtQEJeAN+t(2;yogONl1y0YINGwTjBJ=J;Ix z83f@U_D^>BI8kd>{9c(pj~bGUxO+tCI&P`$Om} z-nSol(_@YM?Tbz)iR!`o_u%sZ{^QaepxM3wI^Ba7ZQtgT|UsC&D%eAo#%VJp08GNGSS?=#dzEAJAWSD z(S_;m>$_-e_h@Q*Vy9=RtEunc`j@ZmCsMr)pV-Dfy_8ETh1p0fnm(lYw72g%Ed70= zBk})h*?D{l-0S&*|Hvpd^_Y?}7Oy+hTbCVV4>FviTSD%dUueGXA9TeHlx=d&|54n= z(<13+z$W3|Wc9o5Fl7D3(USg8W&Vmy`J`)We;TG?`+T1LJp-{6naSkLrXuDzsb{VE z_<1J^2aMgs!_k_1=Eq#&X?6E|MRV&)yV|B790Zx>(+9?pu5yG%9g-<^Gvacx|*aZ!~9nET^p z!pXUiJanM+p?Er2mh*|IkJmr5wg$R0l|6=JB#-7u`8xkM?wZ)7OMkjR<6vKAS}5sC zb!54vc5Po3&h^JbU0L4qFu8-rEWOXxPqBGE@X<5es%(|&-brxdn(-WL9j+oBec9+Y z(6W4nL(`1tgtlf2yL7t#obOx1tnbN^xVPH;m`|0BX|x{I@(9r-CT7ai&`BhJvTwWP zlFir84!^Ag_tKRn>R(b{m-idT@oYS7nk(#QQ^3qc#lilO6j+uu98}MZ&E+CuVRkS4 zMGa>>2AfCgjpOnZmB(W_Q5D<1m+j8xg6Q1d!!jbOWZ%EM-TrXr zs9T;`A}If;M)A{EI)CDqHY>6!dIkrIF8DqV4PC!4V}YHM_>ZZoNtbuLw5F(_@uwz5 zxba+DE`Pm$PntjR?BuJcqiDQKNkMHo&+L8EPnXBzBAd&mfx(it!Bj!@R&%f^xjY#k zVojbosz%|`zoRYeURRUtr+#ic+y1K@?USXN)OW7b^UENwY=~!osk3^;X;N;g9>U&U z*TP93!=uN4h`-__5yw-Lvir=>z-)P@aqO_2cb=1f@=G7vMMWWS^WJ&)+l(yh+jl}x z=Nuc&G^#WQ29>_I2F8lYt?w&JI=Z8c-G zBv>8~?_G&9HISUi_wfHyK} z73K+Tx>w+APkI!!BPOPz5wlTit$wT|xNPHgi>R_=omcgZura{d_y3`hT4ywzPx~#X zkmxAejp;nN!aTBN?mrb9{zg(ZKfmY8c+<$3RdleoUR}9F*s-YnesS*PE!8_ztly|T z(f0j%g=h7A`@3f2UbP$BBopQCn0gma&sINLcn%S~2R(68iLC2<=;Ki&*1$6)swIZ=n7h9aeI zWskvE8m1qWzOGkyO6@8BR!sOV|Ky4eGKX!gc3Vpg4np#_Q0H{`t0LMvFVa)E}_yWRmun zJri$!Ynv9`J>)&w2cL_#qNPLZO1ggBSve%{^mjR9-)?Zh8{R-+ea(S)Fm9mu(I)@J zH{7HgxVNVk)YMg6}y&oI+j;NcQbBZA|q$fni0vLJk(qA9vAOuzwdgd0;x*e z`%TBm_sm9(X+M=~{zxgRWsZK5UN<$Pc~|#0l=Wn*C4D3)FOjsnV#n^@UNE+ktvZh~3dWD>L`8s(X#m zm_i;pH=%ONz~N zvo69$_QI#?=_!(5xp|M2pKDRzDVzIMpCM-0iT(abepMfrT-qLP**1rF+pRRqkL>80 z`*fy{IC7{BmVQaS8#QeSG&FV2kC`pd?`b+wzKP%3>Vmp^Ef+9a6Eytli5th4(?K!wW0tVIA(a`fb&|*UXRVUDiz3drVso_dOGr#rwEs zt*M+U7SoJSRqxxD-*`G0*WbPwH(UY~x;A^PvICZ8osGgpM>i&vS=sQG*9@aKTSUiz zsSeEH`&EkTsvdGHqW;bJA3<{wTAaYedS>!p zk;a831a-C0UEv!}8PampG7^!E?Jqu@d$R?e<~&cR2$w~ij@~y*4KgPxrR|aR93#nb zi66J)c8_Kledk_iUcb(YTX1T8W=$qk*6Ib_ArJY)i9@rDl!PG>lZTgu|0|tCFh}l< zaJ{$fotfHWZ2eMZo<|4oWVsyO_LV`uLFdY2WLc}YrKc{H@W*sYop1i<pL|Bc;K7C&~l*=E#OR}A2)o; zT5}hoYSqxq@j?53d1k70Ch11zHTqxFBk5C}*RKOd^%{@Avpdmx+M3;&n;C1}N1_|x z^r}vi_D!{rb^3a%ecKqn3FqLv^an#KcZAQ7uXzxO$lU6n$M8SeND=hf`|IOSXAi{6 zoTTMf)!<0naP0kpd1pPsA9aBp3f2dg|_2scYbTeOA+;$eCUH7e9 z$%_iF!^1;#1FS1!2;&?2_^SRfoZ9>WUM5;+s#0N5A9Uql^t@st>DHEST!EnGqDEns z*ue=b>bpYObX>O2{Ar~DBYbpisnQaGC*OuRMRKn`eYuZcW{l_J-sU=qgZAq({>8&E zduYWr(NXd8UnBpCO>OmzW+Qm!qY1u~Vob_~XQhiuy6E|~nrhHxHlBRiepM>p9U9?Q z2X2ajH}8*F>ZoQ+xu1&9vUot5Rwr8LO#8ogq!?Z;T~R?ijZ{8k9({V*`z z59Aw;%gF(I`AYzFU3!dk_D8!W)tEJlJ(fet8J5-yw7w}fE`aNFyUlmwAAJ!0C$=fg zYKX_^2wDH)ON&^@oKiXW^=SWNMJ$ks1dxiQx`HVEBR53<71mthVn)NS$F9w#|GVUA z;1?UGmNC9@ZCMVg#@)|bJ-vK)rnyh0zIw06@K@m0vI&@>j2GLOfRA1^VaM1ybjY^c zBUl_ST%U0GC#Oh@-lv2jWqPV*+m3YF(hMDLu&~oSjA{}*BU>3G<5Typ>dHw+-EFs4 z;TK+qV#_qG4LiO=H~k>VQ%q^yJ!_Yv>z;6!(|5?(kGkeh=PEA7WU&7QcydIHlKoL7 zSu6AZ<+Ss2Y340eZMjaD7ZHI(-j2CxLTS9{=U>G4-MW9|%`7!m>E8+=wO5i*silH; z_iHo$w+otF9nVo=-l&x=KDmR}D8TBKicilVS&3lq+_Dtg@lJ9Jxz`yIu>k1J3QmPT zp-PEgzcEEB^KkJ_wHbn4ed*G@rb2ouAl9Q8$4j99Le2DVUADI^9Fkt>q*7|;M7wbs zW9d}1_7pYV53eaF*nQOgp((2%`%}7yw_00H5766o&}HW&tMZUVBLM4E*CL%Pw=uP| zCtpZ(sPVHWrgJor6lLGhRFpy@Hc<}OmBPs$*xIXK5nPTY+1qwqBlm|}X63l7VVGut z!KcLNIAHvay)61qG_Xl4E!&q>O6&YPY!}2@B8tE?T&o`gctl(Dn}JwEi9Jg9j<(?YF``I@;17g!MDcoOY89ydg&Buo=7a% zR;%vE2(~k1E*`eM%lh>g#eZ1VosaS6+x3q|YnpbG7vvMmTk}&<$*UHF7qm&dK>5xcL<)mZsoIDzDrsrKuv5s}8lz$S%1Wb$3OS z%+YJG8}-(!&T-$SI#y?r3}kg@v!sr;p6hZvtqt8NMh9xgUPhvQj&D*(o;D^F+QzMN z2%STu9}{eHt0B;Cw=nN_w@lXC@xO_F!zI5Nu4^UHWYjNUt%e_OLd6&d{f-t9bSuka z&HqZ|*xp?R4jOdXCbOd%@7AGII7Bwa$f@2gR5$k3D;M5uHk+5cyTv+^n(tK2V-4B7 zOhwZ{@+ae-Qj!~FUFlewl@NuSJF%2eWZcQd*Q;y-?U^Se?8~?#cE}y3L5HDWdnl7 z;sEv{jB#R)~mrML`zLI)%AS{{I_DmY{8gS#l!K4Zls%-*o(+rX~2k+__-aL zaJ-U93|*S*l{#vk+hlp7#&eGhzEO119d+9dgvzUPOj=>RnKLH4^iD(TxqTbFC~kR9 zZpynramBla+0Q_VnCmZR0vAs&y+3UNi3{Fy>jUoR?Yx3P9H;$2dFufxp$?fzGbk2s z0aRI;RLgCC{rPN+kgaum zPv%#algTSZ&aU%^-)gjXyY}L?f za-AP(ehC)MGV-Fu3;~ux>oGZ#8D4S?vF4+cE^J+DN91U-GQW3U+%p^AFPq|OXun#VKI7aBGr(r`1UECzay?)Jx z;_~~!s7uwhZ*yX0g`Qxdr^xuwQtdas82NN?lM)zNx0apC5_dINs61XL*(II@|NC5N z70bD%ZbzixAU%0* zvBb=0GMv*)I~N4QcFlL?a@{kjU3_m`+VLh*EGgY*|6R;1H!n3(l~N~Fbm1xzMxLSq z9%DTgO%kKIZsQEGv?`>P2^1a?&7ygSC6^~n6ZYJs zuzxvNcQT@@3sA+zQo2bs>cKu2HM8xO8y9uDDK+`o$B@|Eiu6dTH?E3g$`!Y0|E$5r z!RvH1il)-$a4svn|C7x_rNWG{*t9bH`-@IBPb0?-!gsw}jBJ=(jf3kM>)-4;^Uzb40ibz43^I+8<1C8J6|!ZO|bC=IH$V=Tn zb>b)YH4-w0S9^S<-+s09UPR-eVawq*L(9&y+Y{Q(5%%sZ^Wpb-Zu97^YGra@SnvC; zP;Qu*992&(YA(j^M^3{l0X@ozg1(jtKNFI0gGlbBCv}6z+vVFKS4J(l;3Hl$>Tzae zdQlO+;nb^xW3jYIpvYmIsx8kcyQJ-L%*Wv>ue`zDcb zH)PY2YHjY&`yA9nR;flyImu@K&-j!%!A#y}p>NJxf1Ww#3)%GqmKCO#OUTEw{{=F9 z?3ZP(m7}iq?LFUJX?Nu_!?^cxuc8>0v(U~PLyVkzt+Zz|Lw-YO(e~ip!xF}?&YUq= zSy3@pa&Q`5$%3W{M1qE z>dW~OY2ADU%ByIz3^QM;o?Rz+(W2RfO$vPeXu7g8NOai=ca{=r8yMWx-CqBfJl3)m zFf3^AnBNUY7*+2W(%yZ*_#({hrrz2!P8h}C)EOw>wBaqQeQoMru4+55YD*I#WWpoEywySey5U-R}aYVSnL2&|iC6{HwK-#}5 zv2QQyR|>upfN_Oa=`i!mYVtd}F5<*&JNdc>*$H?YOI^cU$Nq8JF!FKU&-wS_GVsDKszcwxvRzFEY-~Mad$SB@dq%wqlJ~_GQ|7Y zl?I=^sv^93=@WDrRYXl4!aJKzsysezBH4aRl_VBwJZW#$ak?$pNA7WV6-?NWnx3oNx95VYd6iFV47*uJ;Wl2ZbK{Tr$iz8W((o(D z-_}&E8COcOQH^O^PGZ4lt1L?cW|!UDxQx8&D{PYaT$=f_ak(tX^BL*YF$NrC)4dU+ zs-ldkcgD#rov>ukU_0$*W0TFF$|;EIUo62aJ7l&=AifluztV-Sp;P}P-E9APCWdc` zy*oo^JC;$d;Q61#_!UbJC|=AW+xalNXDE_Bvu&>2<1R5D zke^cmp!|Myn%_N<^oMC{+x+b|4pnRCnN;kJo)3a8?aPxJEaamP@m1+@Q^u3ULE`X# z9QWLs=*SC&Wk}KjHDG^~la7c+=v!6^vqE*o&N30CE zcYj*7fzyKlZ;1x29stII%cp+T@JhbQKF*OxIggq|_hMh^aa%UfSYQMDZ#2Gl^VNzy z&~|K|PsE?iYO${9w)kmJ^|q_4uR10D>c3xX)x(2=UF&1Id&gMpoRM6^nW*il$ZDGZ ztiSgq*^gf?Ka+xjY^M%FGV)%}^D5yLc@~SY+^25g9@2hA{?8vl9{J}<0}I7Q_D3Oq zj_Q23@TZsin|7v6cTfI2=*4~B#f#^wzbfL0dHaomj-mN?Idq+el?*xg9y@(3_5?Kb zjRFVc^y8ANVAy@h_o(3$CsNCwfrj-HUYBvo>3BA0bfsEx>H2uC3Ju5jvLw!Wm{%iJ zdXSKh&S==bdp3gY*=ub4k zZsAv~D!+yB^VNCcEt0A4E=$0EZhD#{8cqzhd*;I#-s!ccdG%~_`96nTl9m!?Q>>EP zo{_)$tkLTq!v%Wsm$=WBv9R&xdR$c(n5wyYU25NlYNskDv5y9gtF;Q}8p(B$iR!F} zxB4D0w0M|n%~{a3n>v(e+b9<1%$KgOFB&gzr#oS3={E12<4SySllZAG`W_Tr3|K9! zCg!1YmS3gmH+9IRX4+{zP(@zgJYN+|LceC%+?i$RYFPwAf z+`2ZAo(Q?t$@Y!@QZ^;eYjsgk1kYsNQ-Qp?bo%w9CJVJ@ISQ@0tp4usp`g``)pR^*Jwpl{r>7y)=2M{;~$Cq>cRd zXH#o)eU3_Yc3V!4B>n$vw&RSU*NV?+u3)h;>U2>^<$DpIY0E?=>@Ao2YO*-2&h$#p(%#z@UoVYsuQus0k@P?Cs5&>YM||YoicBAUi6|U) zN*l7V6j0AHpHxMvY+ES5l8~m|mXA|I%0Mrg*kqE@Vy11?^*mkrl5CU{y6k-fc{F;Z z&Yx7bME*uR?v@1Hwll2?$;`iJ?m1_Uk3FS25^8%CB->4eGv`ql!;i6(vniHl;86<-F5nx86hq4&DhkLV36IrNmMD)2XZUwT_(13$i&&`vs3>Oyo5C^ z18U_FEN5Jgv5zc=%K;|P)QQP%_pg0BJ5*;FiN#PZ_FYX_GomA^9ax?z7;qy&0HruOmTvn-OJFh-n_tH8aDGk*-46rpM}Q zt+O0V^c39G`o~;}V)_32HxrD0(ulkH*g;m;Z)=w~h?;@X|-;IP&oz zr$hGqvyd#RdT$@QJ!Y@Y^nH|;>SUOXtflG``Rz$$Tp!j|vhJmj^L|q;zBp;zx@MJG zM0E@_yYd&acCtL`S>s1Ji(FgdL-TKl2C=kO-Y-o;sTIO|G2u053;RkxyD z`fTSKaJg9(cb%7gjGw)XJ#AM5CeISmV^2t{p_B5@~7yUzpbHm@s3n@SuJZBc{WMrrq6%phfUVXEYJMO zblRWH=XQtpZ-egD${{|xC!ELPW+Ol4r9%_;bdcQZXKm5WBcGY?@k5t3dmLYjO5*l^ zPq`@m30FTU_%du!^*2`0Yv;$zI4>l$R1NV}GYV+!qxsYox^J3`x}$QoOuKP>{;o-5 zdpSm$H2!FLz2BmZQtW(+Ok~gc{t$Qj>*IQ8ar@dwhB!-RKacVB-UOuIV!g7fW^J~U!+y|D;rSP_f)9}r#B!>lR%9$@|iCFc^2ThXN9XV4+kmq<=mdW$SukcBFnpsYq zoqEJUy`*Y+KlnohlfC31SVb`OY@V^7;ARHMmc1TPmMD8QBY&kGqjPKJXLeQ#MZ&E3 zbKToK5BQaE{E8>?cAI66vhSw1Z!k|8g7Q_|77ZliR7)}E9LsUaD1P!SoKEcf5u%jY zb?fik=U9qDEW7p4f3ab&FOz6gQ8AWzNjEfwclEvZ9y-D6qTs^pUg`2lXW|W}u20E> zqliv%k1@h8+eL(4FQ1*~>UsUXB!mN+efO)3rfHJu$dSKXg%kF53$D`+%PT0iO(#y9gyyB0H#$6%<*gYM*@%DL)zQX9nfXsn_PfW`1R<PT zF3P7a_(oP{=-7LX#RcJLuCp<=J93X6zm*r#Ls9Nvd^KXzk$*%u=_wXbkx)s?Y>Xuk-UdbC{b8NY9YNFiHZ5A*s00{IR`;KfXt84V5i+5T-(!cIo+LN8|3rv&l_fdpUiLV`=yV@J;EVHHeGWRqd z`U`J)Z>xXpuTr1t?zuuwyiAw;w-VOR=+WolO4Kv8V{~e3TE7gcPjh1PTLbbz#R*d8 za9SKDiMAO=ck#)QZdaT~WNW5jPH$9y5iWUmXL(#8Zl@?l_mFNj(1uS$$9r6l@%HDM zJE%kHxcPO3L%fVeSuKJ@Q#h*#oXl?NZUx5wVBq&KRZJ4*;C7xzTN{sSK$UQ{7jdcV zwmjz?)AHp8ywZI<-Ez0Xc5zv5sIuB(x`sxT?c(WMu37J#RvLpCK1R=*g4Djdo{zp~ zZEU>~bkkz@7|)EKNmij8+BL_5%36=d^zB0j_r$3XRgz=m>W#4@kuzG2oozO}9nxs` zq2i*gpmrf?6ycpE49J}GNw{3*yHtykirl+&qRYSKh9VbsYNg7as!j%JFnthBbrRv4z(UNqHi>i?PF49(Ym*A{g{PV&|M*_}R$c>3{t=9RJn zFp2%}UFbV9tIWmGZK(YPg74SzViI+D^^<^HENZ+~tv{OFq51mj67SZ=D2;ww!E3hA zoxRF6Rm>{-vy-nV;vo~tZvT!UsCq0dD9*;PqU$Q{IK-#WS=Hp)a@Pd+yDBQZi}@?J z%At>eH;=NIZD@_9<9!*&F4({ESCjtp^o}RL@IP%al*Vbh|8sIoZt9ckmyhlx&b5~h z(Kmf_=hb7)4O71p?kUx?{{g_JWAck9BAwH2!=Qr(c(#Cidsu14`Og?p7MH_(BTdh7 zWEp*X@5bx9Sbh7PfjrA^=&oPoe3>)TyHhw;EUSf-!}qf4Q}kY@($J?|Z`{`T#n5mc zWm5b5cEy|nN}NZRSm*T(lxO*3Puq5n-<|t3)vb{vK)Za4Dr=P#Y8F$y9EZB?bB9m& z2Gx}O-1oUP?#*m3ne*wXejcwR@_g@R?xS=0<>%!kC1}#YzH1iwR~g0ZnK^5SfJb1i zesdnibs3Z){l{kaXWQCXp`g}!7LtEyt?mU7 zD(km4kMD0NrkULaHuRLG%Ui8gr{UDz*J?^dR4Eh%Z3-Bes< zoLcdWRo3F^!mRUHXxTe?z76=w>RVz3zRz+ z_~QX5_%y>dJ`ynJGTm4jEv!|nVz=DUid5F6LRd6joUB`Yl(oHHPom`Wv%*YKu`KZC zmK;*M@&-vv_C^zH4y$HgZ;saYp1H9F#q!dE+efIU}tfR#*E~G_@ve7nEPNIoKPsUy*&4|6ln+ zpsNS=HIro9I@#AVe&#OlsqY}5klYT!ok3JOZXs@x@-gk2=W3%?^&xGT2VQ_`FqDSH$%2T>6Px}clPb8ev-|s(rE^+ zxF4RuDJYu%Ia#ke5!U8V;Zp;qS-THQ`ddFjMz8we!r(eot}Z#rFKgmXFSnENka?}E za52p7`Cniav{2Q%NfgGLtt5Re@U5qp^EIAawgwtygieU8s#m2=7qIJ8*fq!r%@tm= zsHp1;L;qA+%>u!vJcxd|XvRYR3!WXpp0AYogs&yR=fZnFJwC zg@WoR+f(iV&HuaNc4xaA1M-9LGMIg$glu?wqs=6uiUetyE&B!4oz zg>Kg&&s&Vb>ELPWWX7sjIaB%b(mLFE$i>o?AVh_4?B?w(B@r>&_>m zikk)K^i>@0J?EC{-Y3&|eA7qEl(faW){Gjc<@|OBnzhsZ&fktUv@g+g5H0&q6CF@)*RoS^5WwF z?bGv}nV4At9GZ_&fqxPawb@|bE0|U~aTYJ4;Q-B>?udMJ;2av_K6yXfSZDK=?eEcf zZaZDTfmLWnbNK4!|GR5_H4m|;7Xis3%PFfa6F}&-?;&!bUzz(t_maDNoDZ6vb}6StTpN9`*%_+eLiD(8AB;ZWEcRQ>PUXG`Q~Nt zuf50hdP`LnJH{Hn1I4j(D*Re+vIA|jyjCawhsEjr@kR!{RN?RU-dZ~hqnW~8heP<& z!}09c6!0eAY(LNV*gBIZEj{xMY9zG4c{F-T8H#pqzNl*X40fGA!HOfG-$~jbez&{v z*QGNm=cDl!&miP*_3ece5)+G{d5$ET*?0Aib{0^(=Kzt z6@$jIsyDuwF)guJuhQ3HH@D^?%EWTbXnB|^z6QMo)kno_mLi*Lg^$I>zh0NFdytXH zg4<(FzSSH2n%U3s5)pd*2`aAwYD0XouOjQycw1W^)%T1)e)U7ZRoL~p(8(uCrVh)M zBu>|l#KtXX!AEXsmRWhP3+l%n$dBTZjBkeFp~vV;pLn>GNcOUoFfxKV-mYT@`RdG2d&SRC|w}pQQtmV+FCQzR$!>+et{| zd)7ItUWvM&Aylfe^L@wlW2JXzzwYyVk4|uXOeZS66zi|v89Mdy{;yJ-YW|z&JC}!n zJ0D+@)woz;P@AHPxRq-AzD>Tm)Y~VPhEKFeLhv!H9TB57KkwTvi4I0IasJLq%lVXo zn1A)v#xBr$pEg?+c&^PVgzYPhCo|FL6Fh0vemjBm&cJZ4kvo~B+@r1JJQY1D{i|!2 zQC8(GNyMcdy$**bOP$D1$Y)@TMshc#wCNc5uQgfCx{1#|l3wXGDO#QAr4@-?#VH8nd|4sql(>l20j((rYQyvlg`FlWDdS#w#c4Q!EJBaxeU= z2U>lfC(ql`je^36JAYyNu<$rh>$b5}EuO*;%n%))=7ft6MGmdcF11LrPBXDDe~Cfs z=~pVKa6S#Pg^%XciZ~Yh1j$RDVjUkUCOE!94%4>L%lX_&_O(^92>*Ro(VmmLh4>T; zX#(24iaXYZlT4L}PIjb4Zy-bwsN5{Xt=2XDQ*cFW-JmKA8%Y zkX~;Ln`$m&$s@H&w&<)?qb3TXnFZ8(`}o&wcWo&ZH2Kz!J@=Lp%?U`ET+4Z8&Oz3c zs)Qa+Rgw)rEz^`v{Be~KsYgL~;(Pv#IZ+3&?cwghD|6*!iDi%?bB@W6@nXKotJ*N=5 zZF}<$CSuAggQeaf6z0v3E&>r*FZGVYp{0DK4V*6h+AF=NLbIW&_TQ(^#^B`T_4$2@2VZa5C;GB$ z1&VH2cl4=LTRHU0oz9nA-mI>$9ivl!r*aqJ*iv|ARIyw668t{(_=Pf@yjR_&?zD}P@vTRi1+W{*2{^q<;J zh<$|hvim`a|{+UIVesB~v)UMzhCj-vObHZmQ>FVi=+M zxEoz}nPS7rcv#P+`o5+YO!=Q8PYI7!GA^xto0gz=-DdDV6Hr_zSJeP-wA#p3|Bd)%_KEeFqj1QOk&J(xW+5r^7>+ zNyR7jkdTP*qu$wH_}kX>bV*1L-eq5%rIz<9X+__hV#E5Bvuu`x+eCq!{jUG zSDRVzOFH=*ZK>tBuB9<;oZvKaod!QiGXX&C3z&js6Kqfuz}vvV+c1nbbI_;jLCUkxixa46>UJ$toC+NtvBDWCfZ-EC?n znnD9BLuEB)os++oUHWe(`$dNix-mzRibSwv->=gY;5Nba z67T;UV;-HH55vP#Yp6NRZMMVPtVl3?nNnZ=GJ72c-s;mtnkH|8ugpm_irC3oIWkeW zuzJVh%PPGjw8YG=#rJC$Osy9{`s1icmUV8Hy=ax_I{9e%d%XO_<}~CTH@T-^tGlUF zx8&db+u{SxwShM}@+G69$wI#A9{T@WVJxmaO$!MG{l%kJo+!RYr&{Q<6OmqN=P~_M znEUWNcDwf(9j3|FRTTF*Lzn%-x?UXBQxnJ`{#Yc}6|>%_jU2}_iK4Sx!#9Gsp^TOz zhn<6?iCaZ-@Yyipm-O{oB7FMTddxiE=DndU*?iZZyU4HM(LTL8PRlOt=X;K+-o13L zzA7xn&Y5N*cGm4-xb~%j(jRcw_iXl5?$&$|KR>Z|uXIa{5zdcXq}GCzhTC)d$~FFL zKrykjUd{7W3HJ3rek>>6ocFsL_kXa>Sm^}eRQA8!XuX*{H|%`rD+@>x%BOa0=lGxT zvks)(;_a{M?AKxb+=L4SFFMa_Mnq;$u_vqQ9VbBdzUxH zp<8CM;O)0ie1!uGNdZD-iP`~O7R|h>?T@@gV`5Kwdr|L*b_%@H)VrSMFJFwscuVVf zB~sXK-;=_k>7eZ zHYjwix+!aBt~vTd(REnro@A)0+TAa}@GCy!``jgSJuxtz=)l0KQKs^DdeMcThGl6HAqvFRFx6v^ ze#PX8?b&MeloFeM_do`?c5o z=udBc+S;(P6_-ERALiSsxYnUSR>xlMUbMQHj6u5jD$0~`i1BmcntPThICg4Q%3Vt; zH0RVZeB4EOInA}d^kH9E&n-_sM!c$b_)kvQQ@!@1ZL0Ey?mgJstaOc zy*@}S+P_gAo)LbM76w}-Da+%1t0VSpzhA`Jr&KmwRxjB~Js_aYT^|jX=(i(JmUy1p zwN%h~vNaMKWi&NUOWc8nYxLKXsf_LhqF(anfbg=x#@cJNiFQsZ=AWQX^F!C-r|2qSzwR{5yl)qK{&D|S9uU#yG z>T=R+y!t~H!NjhD<;Nl~V&{M8GWWSZ`RH+yDy+~p9uYX{Utav4@#Ch!gsjYnbe%J? z`^l1F`943KleTe8hIPYdT{VoKiPT6zmG*qipl=Ggq&b%F8c%DN>+Dhpi-m-#A5&Ky zaXXt4L_Xx%+`Jo#J$hOV^n3rJeo-&!6YIW!IQQ`D913U3;of_ZDh19OE0s2B9^J4BXtzHhQv0rSri;3I{Rsd z6{WW|ZCb3_b~PVvR!7LjP@69yS|_UaYfJ9X8qP8#rM#)M!;Wi_)Bc&N($!xU;?@~QE5>NxHj zr<;UFn6O#bp^d6N>RD0u+AGj)gPT@lg`9o&U0lKM^zv$DT zv28eUcg8xtN4PO9=KiYGJQQMHv&pre^{m*r!9*zV_`4JZ%yY;H?5tW#{8k7wl%_+1hw-T7q?u46|ajY`>3(nFAo#cEp4oUkKI?R|NG)uLDXw<|P2*DEpV z6QMY6@&YkY5|yg*bSlP7w@mH%8in(7JXMlABt_&cEVrZ%e4W7u#2%mOwBHQn9*JYS zvuxR$KIYO;BDZN*KiBl|-vTr$MOI_g&`EiU&mHLOGNmBFt5jL5Z(+C3&g|cA_k1+- z^bL=)5$-LnxQM&)iv20moGlS~1I{#OFWocBFl^$zESdaJm?KZjR~hf??lEaJ(>&Uz z{p3Tm*QWPgLw(alafZj|^R1H{pOk#bX+u`HiSOEfQZ1tYR>?(HE`<*Q{D8e2xU%<;3{kusY+2$IqZyNiKYqPonv1Ro2*XFo)xi8}1O%9jA3h_k2 zUbxCKy(4?%i+;HEjdLs7I?IJ*wyqY87>$uBA%`;}-{*W5qfRf>3wBGBQE-xfdlV~$mnz9$^5-uKTKKP9u3xJ3 z(cgKu&2EFWb4l`87%SJGqi@~QQ8tyM^03RCjS(Wa9gY%8e(DI@W*vo-P3_Hn?!lFy z%YsU*>uIyOl&H-lhb;g8%6Mc+i@Q7FJ38Dk6EZnTHc+&iGp^fOJ8cZzNtm-Pess_l zO%jU*OQw5jRsJ`o9xanR)rRK9D5#$X1A$Fj5ZZ#b3FpHt;PT=q+5a4anUq*L(*N;F zh1*g;mix?^dSGuv<+~{>-d?!pE=wAW1_ETzA?1UWENvQ)z zDs#9miJ{IW_0-`@1s7*CB> zc}FtVxkn{k`q#r1sa|{BZ$;;<_0Nm8E+GGLIom#C*vClJ$E5*6dalf}QZoaeSmfq>$;AXemAt*n3YJ18|(Mgxa zi-l~{pFLOD4p29+>duC};%?O}g=|WtlXRT)!7)aGvJi}OC5rTsW1{`qGY zDF39`NH)f*v>JPsWp9;Yv+!$^v6^Yyr}P%!y$X{j7j#$N7VEu!o5nFczlgb#RPHJq zU4>Uy?*6^Z_8km0_UaO4-1NtID{^c(F9J1{t3%&LC#8SpazNaCZ_a*L#^qirwux#cWz?6=GHp_l=XNWGT0^4kq!CuY?1%7 z^Zk9|IfjbFbRMK5SFKA9Yub2(sxfC|4)U9;>tZ%K18WS{my(sWO^rjFGd4zd0?*N{ zF8pOOOC8y8YWb}7>HTQvB9yC1VXBk$)A0@1r3{e}(QLbYB=cx>O|NUt#~p@QoW;_= z-jzH>blUW4YzXRiXI+?dBROL7pu~Htv}!O*Fbw*% zYulJgE#NW!C?jDtE4@pdi-ud}SNKZkvbgk3w(9gp-J9N#in+5YF((l{BP${~<|buS z`&Hu{{QG3^O%zFKixh@wUHP%0N7ned+@Z-SZ8$*OZnL(-*xa{VcKKqaQd>j3DA^RO zVxPuKbIm&chDko*Z1&?WzHWimxn|9K-fhuSYel4XFRWl+V9R6LuPG%lv?l*VkQd^9 zzqh_~?EEBi+;lnfnE2mLhi*p-eA~a2-!l_ywbR%(3c1m5GWKPykyZZ(jXV}&BE2(T zPpHbikqemzK(om9%4`YxROBmjY`Uf!*XNGDT%`9Ozh}g}SMkco!CCBX6RB@rYZ#d8 z6ta~mgXD=ex;WXjO~~S(e#qTV&ua22%EJJ|r1VRYT;+P>?kDHu4&EKXH-K-<*v5Jl ze{^>a23FGVI%=hra1L)rTA#LUc};~eX!&^N;qV%D>M> zHT4GdSY$SgBG2`$pDiiRpGAv3DBzLGn~g=?ey+z-M}>1TD%QjD7UU0u?DCJywCUFv zmEDJWMXQddG?eaL*efa)^+>2--;q<1^xIHrCzV&_ay2xf`rFr-m(J0h;yDAy3uI0p z^saLvabyGqjjCtV`f$fDEZCXBvRj%G3MUUljMnlyF*~s1ieldL75B)8P}|55oM2 z&kV1Ym52G|J#m)htdHC`{M)OMH)Y3oico2Y8>G&)$=r-~p1jnrhfh$;2Vsg%rj{{D zIS!e~*39n$y+4m-qx+=N(P~qE=D2No`K1W8cGb%(oQ;W1EU*05O`XgjO104Y=vx*sobnv={j<3x|IR_>k@;6?)nC$;wnulD^F8)}`#atb!JzuOGyi()A}>NZD=f_C`PV0y&Q=ULDR*;gn5@i9&PNSs01x z`G}{TvXlohO}&;R=oi+~y7eG34=%{q9V#6nnxyI9ADs~N5R`qxk9%H%=CwQ&@1`cc zu2}N3C;YSAkBHEzFme$b(#JLzjSXC3k+wzil(t$WX_U;S61(|^rQ_S=mP#6OS*V{2 zMcSrvFAk#+r|h#9@MNW9pJ6BlJ-2Ckv`#$5nmPe$okgZgi)s~VR%e~0xejDWo+Mi3Kl!Rjc@0!i9)xGGd9eCSz zb@t*b9kM4=8cF|>SFe5CA(a04aM@X}>wHH%(+`obpJMrSbkoND%)1L~Z40dxIgi0D zsNoqMEhoP@$ZeX@S&T@;Q?`ugkYp>M`$>CQ*i^%{S9v=K6&r^r& z_Y{dxCxXoG!($^*{Ido0K5IkpG9p(Pp!~Vik4RsoKkav30PvzI?w_@BX*HCvf45t6 z8thf$1j_pxHni;~wtfx)<1W_+OlE$|Jm}%>kvzSdL>|e>M+@kKp0cdcyW<-NDTuM1 z$wkkCB6p~zoOWHMb=Rb}1wG%EX`KNTb#|mIwH7)O)r^)n{1tZt|KgW59M*W{MWhVn zy64u}%d$PALa$6^0To5flLy_!fr;mOfoc{k()q5-vHf~18xkvG5&|A7$4gMrV9U}E zWsXq9wawZ5p{22ml@4#H_n#_YYEKVtVnEsyuz-t|Jt|cPZf`xBX>4P=h3ssH+aD_S ztSppbnheo7Wr?4-akB1j5Sl1u`Un*&r`qdkK`ZBB*7v?8do-&1t3{EcO}Sa7H@W(c zy96HLH@O)z2 zlPUl2ES$m>e%mC3Q43O?%7@L#6v)Liu8@(p{D^jNf7pb%dZI3W8KjDLQdc&>ygLz z)MqJZa>ogvf^Y4;_ZBwWBorPuf02G>!}UdcRMFW(A84G@@A)2dm7voJ*5p=1T&i@C zZs%uuN`F)j3 zw??=Y66t;ti}I%O-rtoi)?VAv^6%ullB}+P<93mLW=KWN{k$gA&3$V}CMAii_NMNf zw~xay7W#Lpp&##kD}+_{mh!l2%CM=K3HV*6y=I(UvtifA`m%cqxA$Qqlfs`qQL1Bq zv%Baa=PNqPrI%qlVy4?ROkTik4Q3go{V9druA8+yR4-n3xVcVqeKqA;B9<{f{nd;l znKpuLy-Uy2IY;`XNzFhwGWPq^DmU~!XU%r5W@8+@yA_g>x$-NXapKm=m(G&+HIHGf z%ii#8@fAh(v)w*_ZW%l0b074@Qw1-j&OfDQtVE(!zfXM#k!$|RzoI+FU{6IvR*vW3 zPR!%LRG^>rIsS5=7`6|2?%zFnq^w7qgNEuu<$sy`FfgsLcyC%OBC8)Sms0##Zuz>V zB8r6*_?FX=F)irG>dfoRCCTXCV`_8>^5(px37V4ZQhGY3(3i#K@mht(*Z-Lh3iEU% zq>0z@?pHT`lj=I`KRS}?$NF)s^WnGnr`cQ&bwsz@zIfhPOrZRiTzv_5Un*W`<^BB~t}@0Mefw?1)V>z0*YGCX?nc!P zA)Y72@N&9Zth%SSd#-*J^E7tY_j#S^<79tf9d-t`ZvX8v(8maN{#h2K^F?Sv9F~X< zLwgcWMMeIU@q*JbzPtVSzUzKu79_EXrghAy-TIupl!BuVLqOA0ZxY2vfyk`;|7Yf$ z&_*Ik@3K-hz^V7Ibi;!=`Ts}TtarI#*Pn6d=kmAq-QPr-K196!v6QUK_i1iki!FL0 zdUu!-PA=XM`S93=60cU>a8R^_dBcK(OY7gVotU!%>J zO0CK=z_dWQ$#*-VXIIXX(8e_2Vf>Ksy%4fgIcC0V7z*CS86UH}rG)}&Yepw%(E*uf z(6nfER)zL^I|Cv4qI`;7<+?P*$Ik8FuW+X_Nbd3s2$VtV8_q8?-!+D8_THU6Q@l1< zh=me!&=!OyG|8D^Xec8+|8lO0T$q>4lb9lycGG7S#+8Ttno1UAnS1^Btfq)8D83Em z#h%MYok^M*M?RT^2R5hyy?j6oyOtyone?zWtVtg;#Yl2^5#cMx;3)j)JC`7 z;>a!Anl$mHe77w>7*%zUURj9~eOVuJck{aSIKR4NaaE)9?Cs$q8cUq6jxQD(AsRk# z5WcP!atnK_{amVl72_@HD%U=yb9Eup`!8lD;zymiL2!)Hs+qd;mk2l8jUSF?MF-lm zd5O5iyf8zqwR_T1e$nDTP<*ZzV(NIWa9Ntlq_Dj@F}u~NZ>`S_a*j)pCogCDMc?q8 z51p22rrSMHp7X1hil>;4C&C9_Kc;)XmB{t)-I}cAE&cmwpK3-m#xzT$=KQXWn)mv1 z`jfkGS#_<7?yzCves0PkFtBMg(}%A zY`Ikz!Z5*kzUNu$RKpHN+k9&{x8%k|0^cx{|T|hBio%Mz_@1*zN)TslVEuB z|NbkZL8E=Tb7<~YdVGcP`Gmxo*AD3rDQn_>jVcvfuxYWOjpcN`+nsweBMu3Dm1e#w_Qn^@wWE8_|5*|Kf& zeTeu--aCI1Q8bgp50R`fKDiuxNK)nEYK|lzpiYRQ#?{7Tco&Zkt2FYn=E(P4(<*KE z$r5S5PmkU=x^r7M@ohSvjW|QtrtKb}s?chx5Vt+)H0kaoi*3^XIQabbaeK?a;Z1Dt zF|p1mW!5#6n7`47%k;!}e)Dslx>0OcCpw#bJFW2mGq&ZHDtheo%j{W zT6H+dz0+;h6>V}Qh7^V$K_tUnw5i{>Zhtqs;Qx@GFZ62^J~y>^4lQZBrTo=cZyzBm zc($c1XJ)&YfjU*1&H{CMHQeDs;h&(GbGU3IWXmer#$UfL)Le@%ct4Mx!J086x`&`x zd*>NNWRgWA@hqw`^B3A~HcFe-^s4$W>RL)w9%I#0zxkCEEgM|2d2TaHoFe|Zc(dK# zFx4z5&cU`ux8@WuRqk#1DEv9u+L@iZLfY53c%o?Rsh(s-uSh3BMx&b6MtwH#8^dOS zC3LWBmfx{Bf?Ofq(1B9D7-a2Tv-AqEgl1EYQ7Y=YSwyTt7|!7JIXgwa>Ypp2MnlX< zs?4gtK&g#+G_@8-XO~N|{(n{T9#tx~dcRk#Z*x=VPbz8(uBW_8No8z zDwk6hzU=47a%{`Ep1C?QOsf`j)L$N&mazLV@|$Q=*;#XEYjNLssT0ei^iOzc(cw5ryrM7WCa>-$YwbsE-L()Dp#nzNk?M?o+oGq3&FFE4WNhn6Z^J=b?P#P~~xOFuaTl?F*YY!^z*UDKYdlpO8 zC*366K+?IUK7XqT9bZLtwo=Xk!HNxa9o(g&4l0J*V#W6EC$0}l6$m)q z4I4CP$$-C5Kr82|GR@p$<}N?egX&XVU!r>bfUIh;0bY_{99YSuf>BS6q* zc~!QW!D5$LTi;72rwnhh<6u5B_vK-Hw6*T|6?f^TUo^dMNy@6k@~ZvmZ;pf4#c|Kt z^4;0icHZQyupK!c(|HNG(r?~XTEuO1%M`x4WSMl3{w5cCiY@~9iu3+0g64^&r~a%Z zP}O;`GWwn$0s2dt!pgDloW+`-9NI6qF55yX>x}#fD(?jAA<{l+!3E2x*r#(Dp)oafDT#!2gs zullt{aCfwFvsr$-G zeB+&x%x51chV4D7e&hdhp5hGS5SdasM*hX&=Wc0xSL5|B4ZN6J1iINt-!ksb9t{$m zqm4UJSm@#M$G%(7vfymj_YVFgDPxJDy#@Xr z4}*AH?)$D?Wa^ogT`BB)_G0M2Dk)4eewe?!rxQ#J=cDY-mZxV*4C}z)&F$^xNJ&xq zQdT@>8rY@gXmNH~u-7a51idT-);`2fhU@x!FkVXmCxu7#K-S^3nSAgaX)TrMbG8{e z=Ooty=6dKqM0umO*WFe}s&#Obe^)DsZCcHWf^)hs%F#`HlCcR#bHyz+w7i~B?%pa{ zo*gaeA+zGC$;6^;&S&eL;rr$&T8Y|rSd>4!=tzwyWD*F7_ct5mtIS`iQVgF2xoSVc zdFVZ@yg2Vf(`9F@@h&R>%FWRRF74lKTWn@Q3zI_^b5k6YQJ6b{^{s z!pYjVERx(3i-mq&S0#sy9XY!LNXcQ=+YL|q-bJ$vUEH%j815@WZJjwac`fo9nHO4= za5a|NwDPqG+e;jO;r*`)x8>DGchysN>z{0HZ1J6TIuC~^d&zlE2s9#dzgV(xTT1tP^}}oJ8aMcV}`+eUGKZ!`%`Nk9&{L=XG(ET97H9KZ-{7 zKQ8$|HtN^AOX+FQxcf77*Ou?Km0YfUM6+cxJ#Q~=MQ|%Qm#Nvxvr71hiTd)kyE4%Z zc7?p9aQ7HIuGd7*#W2&R_rhS2lSy>HF>=U%nhQlGpE%5yobH&GLyF@UdUHpunKUB` z@n&a2+=FZFD~f3^nXNn>)j_-NBuh)2Y=>aWy;O77nQZYM$+v3O-;4cy&+S%qFxSRx z;Cp&zo<>P*)uxqfW|qKiDQA3k%W)s*&+Ic)+ygbj!;x=q;#u8Z52 zv3Uz3>z(-~b#}y6C^HS~^# z1(n;*!$NTT(1e3-w6)y$=%m~<2cWK zs%@9XcUe8QTZc8`iH624i;_(CQSiiB9bP712VHbzb4PRRP0+KEq>=E^Ek98xeUd8a zVo=*T9X1O+%>LxQrlIND6%`o)Q?HEUy-MhpTqn1tL0nwWKuD2D=>5FyP8-4KtZ%bC znywRsj%xkCgP$p`8C1G6*uF$e8aL)ICO>Z#Dc?W#O8>Q8EZ50KKIY$k%{c47R6k^r zv??>yjvldQgRH}|OZu-uPchtzuEIb2tGWG{DAe#85NkEuJH(4zUw$_|_cLofxbMH; zK79?2NhL<;@5SoMTJ(Fe9d02fQ7yIOww{!t;AD8m`gpOd+XhUBf>13s>Lj7vItk{o z|5;y^t8Ay*l{>S4>$SO%bywBw{xg`_{FZR&w6oS(ye9iyNHT?fQujG-yNphLoDMb% z(O>(ni^Nj#e9esG4JUoS9|smv(GTvE6TLvOeL&;=QCItaUwR=<^6B{E+wc4*X zGELi!Di3-;&gQ$*5Z@BO`i7>z7WJ?3B(c(vcikx2$X;!y)>-;L>%F?IY_+5c%uP3a zdxi3x@K{DeDz&)THzX^YTH3~W3*K=GPsRN{GTXUPx0f67JCDqlZCAGZQhG$??03$Y z2|)7k2++2y$!gDZ2sQN7~H&9z5Np2ahiTi&NwzVHE zYj^6jI;rmLa$|hEB8Fj=yOds3ze9?n&V1i!>COIf=c%8$35LtByZoj}dddc~n2*9j zRR1APYQHL{23ze!`}joRo^aS@BKzORHHjKsImpR-zvZ%(iJxi3n=NZC4I7Cq zYxVo5IZVs5_bq-@uBy&^ZFeh1&1v`f7;c18UwUBE$9CMGhe6?o-pl45K%Q!&qNnmR z{jbX2?UNK+m;;?A!d;%{+jS-G)Nrxx=ca2ND^n)&c}rziP)XhGJFN!~b!=gR&5^8z zeW%ugDt@;MYUsCg^V~h1fq?3Lv(#i6&nq7}ADz0F%n%6x?_Ed#%I`nxJbZRNq zuvC37(y`Dysz2{R9lr{9MmoOhIRluSfS*-%)5l?A>^$HaqNv6x^iv&@aOn6SygLfn z%+9a9&f-Dh--dJF?RGdh5>v7jm%S(!aqKf2nVa3>xTFeM+9Qf0|NQ1EANSpj?2|J_oOVfh1+JvUK zh?i8N#f5i&XLSyf3bQ%8uk`t{F9bkFe!*yaNhv{yTYA1PXoUQQLcz2hvHxsFw`i{R z*gE+-#uIxxW9*b2m%n|m`OyXAs2aWjW}j$Vb}SN8kc-8Bx_CI8HUz`&2i){az?D!l z7LT%A*lkH4NlkuvNub3JlF=5K^(-7(lsnLOAPh?N3EV@smn`{suxFM8EfD zv8dao_;Ht0p=GWR7sB_y#MLk>|5wgt?`xU;Y|ppL6m7Gmabg!O)V(Vmb6 zES#_YbA<-csDDEJo<`Vh_hGA!$@f_xPdG9uQ;7~Jd-2FO9XE&7q)cEyUgbs`#Me`# z*H=IP2?Of@_*)xmzKj%L=axk4mbDC1Ku4GhR_|_mt8Q!v?x%&%w7fXyd?Y4!)JMrO zvd<)-+`6Si-J+)4(tIGJostt~a6eilez|!Gk-ceF)~+GJY8vAF?hG@dTX|!##o=eI z7;*l=kTS%nj`RG`m5CRZOReK+0bZYOj>xJhO~et6&B)SP8QHq}V0$>x?!tGK`RW&^ zPyceL!kwlg49w}@F?2av*p*KNVLs+Jjd)pm*@)1fI}sig-_SXxdJ3DghVx7*>w=J~ z;|tLuYlI&GVEadt3e6NPygyxB1g17%&a>c_vv62Ac71Xvp?c$3ZVU+(f+YN&0RS^X z#gyc*z6!Z`k=DAZXJ1AYpx(izNzOjLm+~N!hfyKtD-JrZG{F{|A!jykoF<+v9G30} zjTp=_iMXPmoFm5Nz+aD`=?*^>7kvnkua&dP1x^XZcxD0;l-fBFiot(jhlLu!)v>Xo zNyNtGJ|)|7Q02%|djV}QXKmo5tIBz4L~PYAdV%;b5A3kw4Um~@8o#2xcgiEnHcpL> zBy;~$#Ekh2mW zjoQ}Rgou;(*CA!VeM7XP>71s{{82#y4L!RAtH0J-_%wOv(~RMpjKKX+|lh0AK2k3iaF|he{vDZ`1L)TttnD8-EiE(BeUHT5*0%Ik3TDB{R z*^q1IyfNf<= zK`S2zgUD6-c6=7%ucew{ss?|LLVSB;(EnM38LpZkWS5Z?t)C%Jcq%U8vDhG`onCrb zoKPab+x47#q>GyhL2aV25uQXYn-Uba3)XuDf_xIN8Fhl58;!jmfbjuf^1MpaLBC0A zMr42A!|)NW%#LQ;Dv~y_s_gm56a|uz8QYkdDxG%eAmzB};joT^=sB-Pk!A?ucR`P> z9ju1W%Kw&y$2!cscD%oRbMx@C`!JoRrXkN2sBZ#l6oz&cM0Y(TRDjbR8ivAYkXgRG3=QF}3~JYJ3s#-wLb_UNL1 zKBEnQfjZj-cRCd?R_B1bVE@)JVI%QP^xBh~d?Lya4jOQs_y+@#=YxwEh7)UuzJd-x zQKD2$Fao}U9!ZO)%xe}vh9+#IM1Z+2UzDj1&56!ll*>_N5@-nUHiufPwB{>U3^Dv@ z;VU2$3?WyA{eBw%rvF(0h}qM2d;;XXh$4Z)vPqrUmhR++mo}hpK^BF@8DqJ|LWdMC zWQxB7n6m>tA;L*2Hb-Fv&{>8cl`hcZqaqsdguWrAjc)jdK$ahHgs3#DQo*pl8YK z>`ILRO6210_|vpMod$gt9r%sxVd}Jd44#jt(0a!~95Un?b|%n2)5?)LjZMVR&RA6@ zUWWQnldB*r^be+ct8RX2xNgTCa#nW=8_Tik9R-Z?1CzmcwT}EZo%19%@e_G3_IW3j z3~$HChCgxbe~%gB3LJlBb*0#d^?M`;ZE>=#^1Fe*LO@$`5CnR(He&{QRh1X^x$J9uM?Y-97-A^e={9 zg1BVYIWhV7g=6?p!6TV?C`m4mrRtw+47Zrx%3yUus{4*40iSSnvepWxMs)+^kf_#m zS1663k>&NCtLwv!?lY$W%sWfUI(D3xsKvNZxQ*+A#^D0+WB3AE(;+k-EAc<%l&r91 z#gnViRfIqCGe0AGZr{cSL**>O)*v?(gZqqt%u%vdHMUoLel1Lt!7!4qDO^b_uT>8SUwynK1AQZP7}9Jf$SUa=vP*En82_@XwDE~acR zJ-eK00hd!uGM4e+$r2^4FD^J>uRvCXygQD_KZZZx=(0t?H`3AhanFx+&+i%4IRX8+ zWr`8=94I-1PMqBDZlArv~T)`UC4`h32cP&dx&2Zv%VXzcid7Yd5hPy-<(JZ!_jf>9Qm zx51Ms;b6GzdjmKkJ_$noO(qE-AV~k*nlxmJVX`lLHx<~A1v(H&t3zh>QYOLw(H~fC z#o1A-q>4D7z+wzU9Yor9EG~DW%jv%a^8Fh4h9KFGgy_8z%qFwdP1~OjRZfL9>X$ys z9(^pWkUIXsYRsA1nQ995I;Q-@+ z93Jjv7D+fgm*LgLStPd?Sd?I#uA4jZQo3gHSNon z=mYUra#Cl{iSX`(fNLEDVxx9C&P4k`UVe5X4?|bhYuULL>QXi*oxfI2z@%xDD2$fBhUoieK4KVLmE?VKlO(! zfWMz2?h@3Ez1zbBT}g{R%!t)xMFjoCNS*%L#{TYYuoM>86x-*ag@z146dq9>{1+i| zWOJng5IZ(1D9EaJh}H~6;n-s8+zDmO&u!+(#hC1-x$snpJ<$5jz<{-uE@H3licAj&Kc53_?oOW*id zc?wdD-KVVteb=aiV{J64se!gfXEZu@PT<;e0h=1lIJJAN&KoeVNYxuZ=e1!9>kYMp zvlby*Y(4QA2BA>p`5e61;y%x2AI;eIy^B4_{-E8hM{pdEg~_Avz88`!R9#ybvB$h* zbvMPSx*^Zpd9n5|baGnhX_|7@?Z;EJ zQD*ouPc2qg&jn9P0r#$j*dK?v9?}m)+-0a3vhZ;6P|hfKU8qLOb0qD6Ms*MsLcp<+ z;rc01T(o%Nx`Og*1(oSYf{rMQi`p=2ER{k%ufeJrLAr2H&tpgzZ``YwKN!`$o|(QE z=56h%;RHZKN_Go`vB0Azqe5~%pyAXjD0&~3wFA4@#~oR!t|}n>c#Y6S>V5aJ;cg|K zoK@@tMz1G$oH30ULj1_}M!tC5I2+8WS}~&J24QHfr`3#zW5GN>6N^?|X1~68(R5ho5rdGvNDw#hXdieoPo|WKE+w8Z>mK2B>^kwBfPUtQzJ(6A{g& zGq;3xI@lCj65P)j*liHQ%wcY7(l$F{z<11zYsJX7V?pI#dp9R8!JRr~yG3-seiv$J zR8H?%FN!H6Fkh_&rO=(el(f*2!a6ZKD$xmWZ77>5 z!t#SHu)g4PvE?W3HK)vj(gJKfzP4=P(79H4Gr)$Cn-{J&@_2fmu6!`-mG>o6Kz|OH zk6?&f{sd295cAq#xOVax?x?WI)$4@Hcd7oEMQH;kq##KaKV*I7KA=5d&cflE&R}x} zvIdEUO#O&97@mH7DLA0O3Js{P8jwe~`b)Vu*~I=gOSK*bO~3g3;F}i3{ahjhRWf+P zoDU~Wbt1wbypj0< z*_te%79%SX#9G|;nEvxTFaQG$upj^wb{jSYjevgx7U_YLVNzl_#vdyK+hu*OxuU`B z!rU#uOo$ zk*n)QX`=kqW|;^!t#H~3gB4wx-E18z0bE8>Mq7+52WfI0>MvJEeJpg2Pir-K8$7z%Brf_P>h4p+&N?#=rG&cOw|VnMiQ zvr^$HSdiEO`!FzU0NgPP4AKR4Vx=)7{$L4hng9-{X$p$afbp70R-uARp%@6}G=8H5 zg^L-*>3R4m}Z576mv1k}f0zx*UNDaFH=-NQKh6n?wuaJ^UC^QvDfooU+ z*))Q>z$wiL1Xoy;Gzl990Yn-Ma}SY#u?+}B_-I{oNK;G@PBbE%#4Ec&G}NO&Dr-pb zShbBIQ`nN)G>`3s<6M@5>|#hZqe55akQT9>+drYIOAwAz5)NZ6gINXwHm0q#H$LIZ%(6&PtGw+vpR4}zZpJeGOvNdci~5ltCE7?2vKAPXY}MPQJnVgy!L2rBI) zjjIbl(2#sjaCLFLud`_K&Y$`mr&9X<}hBnJ0@2~h-q$GRu31*tKTtq zKFjFq`%gl<)6i^Pxh(sPu(u)P)m9~d#8{ahMusN7Z+)>#W|h}9y{+)k_N`? zak;^-2gJF`{ffQc9=q~cIK@wY2*bl^7Ul_e?Fn$0Eg$egKm}Qd7HOo8Lq4X3zw%%J z3wz(NKIR};rjVA!fE`m2*s&yo=VuLxf6W5Uut=UXAr)36g^*~n4R*{&5{UpMnjcQY zry5^-K@1Y!F(q*^@PSIwLgq3Vy=XsX1$B!E#DRXz0;sV7uS`jChK)l2+As+m>jV|1 zu?#u^iF1yq!F-Nwh+4tnnoFx`0yd*S7eRtV(?DIAmmFp(q>n^qlxYicz+1+W+3z3@ zouqqh2q|_*0O@2pgdrPNfV8j*a{#NcB|m63En&0pfE5L# zEi(ibh9#?Dl^AF^tP(X{Bne#F0c)BNk5PaJ^W4G&2kquU5-d#`VUw%?Hsvl7F8QJa zjMEZS#t99IzQIimB)Zl%BzcTWuVFswNL`abKQ+W8b)(ua57mgfvV)n8NW_)hi$2i3 z&r$?&$@XZ-8r}^faiq)eIn(#&s$R*v5w7(p|67dV)fQKd`2G@4tJNM07=f<|6)_)0 zG@FO9?>;aU7xORYSQ&-5VELOSpVT8uEk{Gu3=YdcgB$YY5!v(&Z!JBZOfY{MAlx0T zqB749dDv#_+(_1JRj4RZQl&zV02twC0+3N{;|m*B%_T?-l|!nRqFJWH>i-%OpitZjp16!TPTHeB&7yhwd&=(x!@Aj2n16+S z^m|6iGqk0i7^iZz41)UBz=9VTIoB>#r4y0q1EdROC5vwpyJ4{V4nSEMHl~y(CWuws z@N+}P4>00?-v`%|of-W{C)l!EUQLroDe|~Ub!`yz@e|(8(om1cxo8$Num_l6gJ00- zVmvc%`MjNTN;(svh3D*w$W4uY`B4oJ$9UrUsvld-;9{SpQ9o|Vv~(xJfcX1TW0#jL zhk4NQh;G4~kU7w<1+3l%AJ}ea9*|&MXC=i~d0r%m;UCqAh!KBnShbnETf7Ak^}F?P#vJh&{~X$HW~ORjLY)0RgU!zx=A{}L8+`x z*wMbmWqL>3Jhbu*4M3pEk{%$BgYFciC=L-A@)@1E^||tkSi%z!1=0_A9rh zxm~zE3bk{4F_jOd{gjM-XJ-B4K~6q80V@owyC-u^zbJA$U5=+2biowRzZ1}-_zJ=| zLDCI?b%zjRuw_Tzj6jC$Gd4m5J_|*?Ew4*f^PL@C4T!B^lSQMgsWE4@a+FxgN#h5u zJiwonmz(!RiZnMk&2i7Kt*`~hK8Dc%PCTRNN!xLY$S`c$2YVVGFY&=<}WGax{~u-_1%HWB-QkxUg?|> zYa&=89@-;SrTKTna_g7_g!mSnF+Ni%2L1N$gbBeys`DxPOMLy3M#j44!gX|m<`QTL zUDJ!ftP;XIeLm}pw}mIiI^6(rt z4na{iX@3|aRO=Ds%#Ek6-y}4BabnXH5#!9_VI`)| z9GKfc0>p^eI3^M?0r56OF!PR(|-*fPJpI#~S00CN?a13_3b zIg}=-oL1#gwBYHXC>z7-X8j{UWCdJ@$>Gd33a)LX#v+a%N3{zYE*eZ_`|-&5IqEvW zNuQsg(beQ+@R0+*?b(h*Xr16xhNj{3hvhK|p|Sfd_fUpFw!Xmq^(~NTNAVOK#GaKF zi-dv%B(kSTBeh@PI-j&_CN%k2DXIc@;fLg=e*4J<{91d~uk!#sed#J0Q?RA;0h0TI z4Wl0%Nh(S%^ABFK8TAaQ;Qk!c0Q?-)KcV=gjn-k@N?rBiS&+y!UB~k=cgKVoSXH(H z;^;cnz}lA2oQNp!WTH@)*A(cT( zAfx0AL9s9?hV!eXHz4`Yq)?n~2#=vb8G|OPSRsi@=r?gq`0nMSBMVBvwg|<~b|#9( z1=|-8JXVtRhnQ8-@9CN$iCV6IPznv=SBrrsBRDzjX7cxS6-L-wM2)1~_|pR5K{#-t z9uIZVH7(0N!t}su2BE&V8-X3i2F#yglG*L~dob5mS=(VSJH!H0z$x4&{T}pu4WN3O z1`81T4_|??ooMi)ETJnJ?M%A_^Fj{AWpl97bwws)*gViofj6F;BRjjTl0x@#cX(v} zUqiR8)b}gH&BY3{yf%_T&zk%h*fp8@@Js21O7&9&8pixc`Ky>BNAih?f&#j*i9w&+`ae}kEL;jE1~aEK5F-WMAY&>R8a|MwHJMX8(KzRf zf8#!~<06oc8M7Im1r6|z}4N}-s11-1o4wBpagsEdn^&U9)L zLp4FGcF$;M5A>&$fd}6$t0Me$Ef9gG1MT!!nBstyQSI%2hI6M;xxJ z!7nv^3-TEV9qP6+Ni_KrMLWb zLp&eEV+QpcNe6pnaN3G@`$)``W~(La|6`0*4j!)(TGxuOuaO&^aJD>&g$7~3<*KaI z6+Ij#(MBgR&R{b!w+5jVT#X2fjPU$mPz{$T!gsvG!n0R`Tf8hyP3$m-L&0FppkxYl z7$##xb*RqPW&B+ba*P%F+l+rQB0xtEO@7Q7w{jyQKyXmsaD$0J#5laNL$@m7M|h-E z6ub_b{{q*w(|53q~P!|kIp>)-I{xv_eBAo2(F}9(25%s^b$&7W%=RM|D zA!}?&2vH#Mwf@b@A>#yg2H2-cbcI`JP4?&VSquH?7v>}<)(g_(z7f?X*<3Hc$nFOV zRZ;{y0{CHxL7dF6VL-h3Ocz;(zK}UwFW_zDB}1eqX2a(qMHF))T_+?~H|SRm6+%*c zg^2sFCEEabS zf*{vw&E`UE6NcuY0D1nWZM2ez0I;ASkWJHn!5c!nZAkWEg-9YLYIp(|HqEaa^@kqM zYMh|HFDOB@3)9_ROA*cdASd`8&eU(PyI1S4E<9u3M`F-q5S~m#X47aR#1lrygj+F^LDQDml5rntTTX}7A&0lF(CslYL-S4eV1kHX4#SEahWI&k zUN{?sP(Y!Qi$Xfz_L`i?hw*p>`D-%~n#3?+RmzQt07bn%^SC=YLshku^kMcY z#eq=VXSgSM0rOM2Dqsr?x==_jeFl_@4*|RLViacyQywh?+H!Bz7>HBimj{D&!}&-m z8$Lr(zNbzGJQJhJ+Y4~J?o2FTZX3ofpzoDC3j}Yd$h!zN_c2bN7di@l8XN=&Hc25V zXb8z+v*F+Ivx-7=5IOIrjC7+CexpW!iH__1jK&W*`wh*Q;gXapYq4RSsVr1g(y(OD zsFHe5G-Qf0KZINbJ^=p}A6a6$FBS9+DI6nxyI$@4(J;c@4XjmuLQYk9GJGz;GstRl zx6XTHy=DLRF_MNA@AFm}CKsL#npIKf4&tT)Efxjsr_f3XVjSC}*63CCT;b5dZ{pT?Hax;4NbLO#Nl9n> zt+0fi!!^^AEdPM)E`@>adl&;mDz0_D51L4^-AD)Fx-v(fe&~etcwxeFkLBQp(H0K0 zA<%7>5q)(1=hx9f7L4z~{|}E{xj}@{se07!iE;1`LL(gAhJeU=>aGQ#aHJH%>db%L zI@UKo%pjN&*}#=#Ara821boAXtVtvg@kO=G6Qm*J8rVw{iFqrso*?(CQryIN!J;(j zn=}ia4&Y|<0&p>CC`hW#*QvGsO6ClM;g4;NZaDiR~unE(a_4a#UN+k4F%g z&JQ9?9G7sbsCv??6Ld$y>r~(m--JO9SmA>TNNYh3{w6jK^k9dA-ibsG{iC?6Elzdy z6_(JbLNWM%FR;E?D4Q*i(e^i=3~Xj^UC%hx|JpW52vG(D+Xnc43BwTEyh7xY?NDp& z*$1F)Y^tL>MzsQ%jnF4b#4mC#GeK#n$-G1Jj@r&ue-PYwnAqJ0$jv!tm05Z#noJVBIE zlF5Y5Lf^^^?mQ|t>Z6C!tg8(nj-paV^dQo3Or#v?QR+0*=Naq^$GfaCdYlia5CtCS zFO-6=cr=zB;Gh`2s-kBff?z9&`(D@8L{Zyij>aK^VaxsUKTKW@0D7)_ac54i8(w%b zWp<8I@3dPn7AE^`M;J5=Zr+5X=qFkn0WUhI1@A90BO9;H21udwQS@PhZ$^WS==QGy zVhT`g@&!RVITGDwaC#1vo0`I2_Z&T72^E2{A1Ij)83428?yd0Buc|w~VG*y(qR2;f zOQs~)ZwC9!=j099hIdaqGGIO@*7r&M!SN?ow{{0fULjl-ZCETAG!?0kY=taQIap~K zm?F?NP{}Q`$ancaQud(r&GA>Koo|7oJ-$Qbdmd8`Gj;~_C99b&1O8*)MHlI2CAB4=|zfL$&pq#~ELiYq5 zUNAuU+T+7nk(|zr3WHfrIs<@Q9)z*z2c|+Ro)wIOZiUcQUahtkbGlyhAwb$$q4@Jq z>w71*tDP_!uC*|_NSBFUDV=z#k0%Lu)U1Bpr_k3?{UM&Vn-3xA8rxOLkNw~S2;W<&B!U36MDh!S3zwhUV zXNhY0Llk-O4^2-iC`Lc<5-KRvwpa0CtQ!xTC}8z&_VG#OeN9V+-gbVMq}FQTp~1hh z!|WU3v-A*0!XbM|9Bsms(YN7HU3>7sZ@?%F{JElQlMlhpJsYmF(%gZLAT3jl@;Qi_1w9bF^Mep}8>rZF6ht5U(O+xRgK&*w09#U%MUXCJc!5 zG95zq#(?z7qkL#=%`}ydBUT}FUB}3RjdgGlolLn`C^KnxQj4;=x^{9 zgZp&At`_GZg2nNU^$0KEFi12-ax7;G(&Mr3vf}cxT54X~0nGbq8OTrA^G1Z`t74&l z*#KpJwr1pu@PV@R8I5R5rH)0<*5dxV{pI!qP3BS{oi-gYvl};vMvI~&{9MoJJSh4~ zd~J+|`le=Y2labnAR^C+F+8y}-YaNsu_tGoXht_Hp6YVzc6l@*W#%y&@FC$$M)XqU zTS>l+%3j_z0_t2IDQgZTqs$;x9#Ojod|yi!GAH$wy9Hw`Q2Dm~O5$yX31HUh()q#2 zrfm)1`c$cNMogxjE?Pf8F;sK6m{?i)FwYPetO*M}4-?N}fIXeBnH$rKt7)|7eW)!7&fn@9 zje35-a$&(y!A=+&2VCEQVQrK)=WX1l!HFl5pG(8P1;ZyyZv}lc%UM8)m+2%4hJ|uqmJEaTr~Y_g<1*fDjc}a3p_8H(nmV?}tjnWY zx9{SvrG-~s<^3Nn^Pm_t%iJp}cfUr){u=Wlq@M1&W7p_HzI!Icb7Mb!P zNX!hhqCuwU&qCqjua%YuJy=B$6!5KXn9hKxH9EU#`4c9CwZ1YP-L|*7`EHXI=ot^p z4^S^vR=G<8;XWRWn8#qj6LE_LrOjIN3~(tl}o7+6sm}=P-{U>Y=73%WcTam2hWF(h$HOA zXi?Iyc9ur()Q$r$lXwX9gB>7%I>AqfQ#3#d@%xBY1tvQ44C}ddGV9%42AsXMa#on{ zWR49wCIxN(R2!fXfsS}H!bUHWEiPk-D?u^ad<2p_PKFX=9qhXr3UyFy@17h6YO}04 z*f&CfmH2+Cfk1#j`0Q)Oe&~DsWrh=xA>QP2UHIihE!7XuZmbh!^uN~LnzBnM#|k_# zI1>t4l?h1!Gtpehl~}_r*RD9BIB7Ol9;a5ZMFa5*k$Nt>KR*!s3&SC32y75g^eh_$ z;>HbbJh1F{o9tyS0?`9!>keaA(i6908Ja=z9M)&cnxC1LZO;t9f1mVBJ5n+o%0d6y%mHGyC%w811y z5zPd7FUc#|OUh^z`v#xjDa!UVK{~0EA6a;$?|_*-k<*+S@|~0UjIp>YD^pA1HIvKa zaJAz4q-%|V8%SpWOrNflDEogtccsH2mUNcRD7;ldj}hnQ)*^@a+$svA1<8Pp0xfL* z+bP#-K-*F7hIZJ0h4eBXG981(0_B12KpXqnz7GaBh$_RT!jBy8!Kkh_V6+V6iTMU- z!lq5)o}G|DVi6v1V!Je-dr7g6{|+*g720~+#UnoU5E#^sLs112cCf^{!YAScsP6&a;leO~DcZA0#-L z8?Aydz!`r+O7D=spp}PAUB8cQHOOUJl{RN>fTiq*6Jl!+y^m4{!)#k~oQuPW0*l51 z6|H-&4o?g$s?{DdzS~cDG^Z~eByUE?I4nyk3d)2mv;jwYqfc@6k}e#9UJ)TSLMTiy z_>}EURr^bY=0KHyUxk#IvaKARbwRad_X!@%hs10Zw8uN4oMST$7i&`@mx65xqk1Qo zThum4{@lYbp+3frLGShhlY&s~#IT7}Jw#Daj^fe8eZFCz3V{-B(BQ~_yEB!rDIRPZ zl^=5OTp0GdqYg5TBT9tprxwT@pBj#?euG+GV1cksY1@aaio&@e>}LryZ>HdTv;JCv zgj$F|47ce4a4YhOX>lUYEQW%IO3*SeXDIc?uiwa@N*B9;&dAlZX1xqLI{Qymq|fLY z$j*2qAI3=Nr%&vT;L;J;&0Hd~;F0#L3!JQd9!eOx58e^{VGqG0z%uu}?g6zRncPtp zg**{K3}0uJTB0ms4@nu;wwnFev8=*B5u@Kgg9^?rwTCbJWX`qG5`&x!#_0c(&uX2I zRCwkS+;neI)^g{rLnagdtR5x3@;)}D;6%_gp;8E0Lp7vgX1@*M7jX1pE13f>gzloh zoLarZ0-?$__)qgs1uFPZ{`}t!2C(w#4{Z=i8wkFt&_J5?6Y(mrjOuxx7p^h(kW7_c+ZEFV)b+atfJAMk`@ zH@|)!M)ob9rxZg_Qj}$+L+!3=W$qBizlJwR%EPJcP_fpp;jcXf(Z5M<2U=ge8%I7v zExOW|-DiM9n8@)5U#;jE>=n+Z_!&WsZQE`Pe@2pUjMxWMV1UQ${>QIXCaiL6&i()2fNOau4`@bC zUnpn0L)r45qYXqEf5t$R<)(xGuWJZR4zI9m#mh^>vN@N2cyoT&vVf@nYs27m64OfH z*rXhn;Nkuf6vGS97DZ5*=WgOmqt}Q&Q2UKx!*6xiJF5+%*p=yp_{%f-VK-L1FY&cT z*jpTz4`AqyQFtr(7O7v%$ElEUj-OjoUjhN)z;+Ln1UW}<)wk^7dDz&KE5Bq?wl!35 zS5PuTFo_f&C8L7){Hs>3W%UoKfMg5UlaaHP>v<1H`r4QgV+Y*6Ll2uxfNO)!d7l4$ zpqk(@KVx#!CcvZ!+wu4VXt5(Z8X$5o>CBW&J)BBvOb+4NhsV-6gkYn2pJTjU5MAVA2u1VB0 z8@q!E>?6N@FcugH#)UdaVXpJa)61)8z6;D@Od1s$>EOW&gddILi?;(jCo=p;#_a?o zzltBlKtuhHhkbbeg-mwVcdiHrq1H6^MzXp}`i@R@6t(<-h!u|}B0HLA>%-b_m2>)% z`%xU1aXflLTJc#AGl*#Mzb4)9Oksa~7qw^Ybu5x!fgBON-Kq^A2uKxC{5Y7H z(cA~UNuXoKe)#(7*Tc`aW$c3&Fp64N*Q!%{SxWPVtSHk_1T3M2)*Sn(*+=Mk>0fRHnZRUUi>hC@R;@b??sZIJhhC%>$h!M?}2$}2DpTVIF%x|%#4 zB=HRxGmd<$ZH-Er+Gvn=t3;Wv`*zFLiz*A` z#j#-2R0#+Qk4hm=CkPWyvuIy(7aA zON5+Q!C~8W=CryDymR|i#Sml|LfMIlbls@V2g)E>y)YzZ;Y;KzO?#WOhXoQ<8|pnR}Je|#APfO;o`JBIfq_R1ef zE72_sFptT&2{3akyT5LFAecxb$%6XgIe`)*%YhQAKPUqx&-<&5`v}0=RNri-WWawm zN%6_O`;33__J$C8Gsn|_vUwIOswD-x#xS5|)lYG&rW!J^%8K#X!35w`h?j)&j>+3W zfM8hV%F+(#fhsWC87##}{0E^?N{o0Mh2-@TC&|7waF?q?d(jMo4&#Z#27?$SVifhn zf7W`ozmetLq5`tXqjv~du|wQ$vG<0tt7tZ%5WE2ZAdZafVV*bc5%kUosD^1bX#Jdc zY-ClpzOOORX;&)z@y6UT$Pj8GZsaN%0(TvNvW|-$O-0w!`bU=WK<{}RFm~L~4fcwf z)VBZ59PhV)m#_+Ec=67sOiupCQ&zlv>rxUIxJieopO_*CO~J+JhPF{MhXDkaMy2DJ z;;D*NoxcT`=jsSY8DV@SiOPYzZn>A-EbO%Uq4S&_vq2kAP_rF(PPJv?nd%0c4H$dj zqD6?WuO(?q+%CiWNcvGV{{34k;=d51i+viuS0d$SB>uHxcT2$f3=)97alD>s&FB6( zkKtn;hA3X8_ffY%-95NPalg+kBDiZcuLeuC{LfRo+K2Mb!zpC3unU#}aBpRY@NFwK z<%2rbn#4C`c!bhS4(@fC+=3RTz5=%)6cx%;_g`t8xLuXt`^sqZ6ih4B;Ns4m2B?bxFw#|qeJhpI4qAi|NLEec|Ba1s&Sfivx2 zLggJF@Jg(sYEH#o3Ga+<`(u`N{OF5jMMpS0Q(S5$nVyVQV4GI;3j!VzvbJE99X2k` zs6e2T4hb@xu}A+n$3q0XZFlH(RjdM7$qj-~JZg%l?2+i5W9`Y`Dy3+)n}gL;)+p#< z?fDJv1?!k}?rx>gzuuA4><4hxG`eIoPv}S`G+Y9pKzn`0Moue4BVw)zr7Y?85}2+Q z@B>cgZmC*nNP!J&5(FnxP5EnW^v@%U7Q(rhGTf31tu-g z#6P5S(T3l049kVDMu(kX5Ff<9a?rI%80&3txk)v^m8MDA)~!}o4^3K>wECtoCX4^0 zfh0u>+um^$?~au_)84pK4;?({KK$~G9Rzm5j~qb7Xj&}6xHWA_5#Nt9tw3GW4vfUw z`7Q*Bzq$+|#{GpCMzc-Se~E+o4myvAiQY-ZSk>3Z9G(&b42JCCVOp70yIiPplm*ah?MOmnDNe%gFp4J- zhCqE8(*T$-CLnh{LX;7j6NWdytv>V4CV!140I1wlUtH0SYYlrk42;`+z{r`x3D}0rLW-e4K7o{FSi{?>bq14z z5Y5wbowXY)vwlj}zFd_fVjyBIMhOYnFG|e|aZ&T@T$x=#3&yM|kR8J<31+~$Prv!y)FL}bSmD2p54_l_ zXnU$^Ywq^=G&|^trvW!-Y|^e5Daa72kAxUM>s{xr)Hf{W?R^8q7U7y?7Mf zVQ$&MFebP{#IGkHkI}o;TljQI-7!1_QnU@bu|5{;JYrww4YEt|sch$ZCY53OL1Ex{ zWDb@FKsnQL^6^6CkM#=7Bb z6^+y8lO+037KTto6_~9hd#4biJb6+l&m`vTpl2zEY0&b}S;zvn?=J^`2}8-(xY{2a zIbJk|eQ`-!&ND$TpABHzac}60H&A-;g7G`D3C|`35}Qi!CF2Cg{b@$TEq43>X#JmM zNK(YsIvz0<0I;@gR-1ZqaL8c?>~%UFkue&s)S@3UT7O)ONw+Qc>#J<86BMZHbz%fM zXvfn<{_QJx2oHLjrr;JF@9B~w?9qV+!6AQ-5yxBs0=i}c6Nwok{&Cho->NCYxtL#l z;JSrAZ%lbr!%_p_tUYDkvxRmAQbi-nbc!-L7vgmpq)yGn5ejKJ%O9T2O=i4t7Qs3g zfwJoDFEiY*hpgPx9b!6Sd1qv@7J`_hbm)dY5-0K3&?yf{t2R*xqg_#r>|sK>HfK0U zN$1B9Q0L@Kd&Ay)-wra^#u-Ehb&p3sAB#zy z7c{vqW$=t^aIaj1N$-Ec)z9Fx@M#KE_`GQ%EmZ2J`LmY4D?JBK95rd(1ITgD8v~dQ z@J8tM906jR>R!}#x_#pwO)6zN1~wzcGI^~OMGuA(zBUa*{^a}X5}iE|wg!UWhfZWm zeV)%jE`U5(UamTv(BWTOmvGvAEx2Zs!&!Yys8C5fWaKo3?N`=uY->{U$PlJ|oHb#mf?ak! zV9`~pJ@D^KMR8!d&kH79BeDq4cVE*)9Zm5T8_%1`yk5oZO*3^wl}31&l@~6wTu73l zT-3*Tb(H0NTrRrdsUv@d_*Iw;YCpc1;*4J)If-z%3z%y5zhNtFyl*!TwS5MW%GK&} zt+TaRl$wTGMrhTD?oU;XC^QJbYU2u-F6{&OMmSw> zT%O-YxfT%+tlSdXQSGVb^Ko-Cq4!9zeMR&|2hQhMQjUh(KyQL&E$Z1wyG{VcBU)bR zj362>NP`yrf4o`!mtRH5}b9W=OTr=eq?)-It}Semvb4d96wQZojU6eCL< zS3xH5*J-OCW`z`>?zx_#q+SW2YFU@?1unPY3Is_#79RsBidnnc(^%%j7G0(abYB=X z;Db;( zDn9|rt>gg444nEzK^jzcva}pf2jh;#yu#K5>& zaUB~r!Yyc0trG%2voqiyz|2oL^i<+8p^kF+k1m@Nu3RfOtlNyEo|o$4OQ}af^nhAI zc>=f`3w@=XJg-1gOzl>Rd=xE%=@FtL1!3UqPP=w7U7g}&8p|oK!G3S+CL)w|x?4T& zc~fBm6ylt32K-Z35IFs)*SHPjE^^f{n9-E`Y)NrCG;UM?H9*S0w2JTZeDtB)(oh?; zR|`<`3iiizK?Hc9j?NvD^VY>k-F(Hv0HYYDHU{Mr^H^Qsbj#eS95|?q1sGA9B^4R| zuDVDNa055du@1}A1b2~5BOxxgyKXsRe;TwD)y#)%zGoE=*Y_eKMsF`I|7I9`hWhK3 zZaRWh3v&6h6LuC12-g7+Tg}7Yj9P#Z_ zqzN-*IB9E=@IGqO%>ecn1XlQc165~mc^td(P=a0umN}Y3YP$q3;yb}`Fer|O)ccOj zcaS0uAJVSg3m3ImX^~0mc7uxf#ztuN;muBSnmXF^Qj0 zhb$;I!Mv;U0Cf=nl%CXiH|k~e|J`JNdj#ONA9UzxXI~83&tUVvldT*@1_L5}&_MnI z(Fc@VTEP{T6m!{1!*@f8IUiIv=@To(Fk_$o=7Tm@a1KCMN-VICD_mgArb$05(u;w zcLj%dn5(atsTxDJoBS8K2Bsa1b#?-Ppoj3Fuye#;eFw>vElxU?_HiMSZ;E<1gbbMv z7qje{JQMOyt%F)y!fN6Wc&Dx(z69BZOe;t&jUzV z`K^5B6{=SR!jkRzX=3zuf0^z14Muj1=%a?pkJ)($DU~i)+@U9uF!yOJr`xEgF9wFt zwQn7lZjJ7e4YkHY%UWE%>>VC`-H_EEEU;vOsOdTG@_4sSPoRbvtdC#!pkopu-;x(8 zL6_fZ5B`_evV6fuZ}K_Fi{Ge4o<T5u3sx-=Z7?H1DMM zNg&*L{6S&2nilb5Ap)CaPp1CG_b)GYLltHsy)Z*JaOs|o1_vKy2(WvFF&hw!=NA3k zkoaTq!f)^|!ve@eaU3kejF{shZgx@vYZG@3PtI+6H>EB>Pu%EE^Bh^NHL=*w(|9(OJmzG`Db0CG*q zb^V_qlSBrAKA6J%9*@2zGFid27_Hia{L%QSgF4Zg7l57U?9l{J{HMuH2B5q}*nVzj zLbJZ0J<#P8QfTxm?|El79e%JZ6M~&uu97S@zF8#}deP!RS8#R-O^ZjEEatIknmpW} zpRM3?7!`Kte}kY<3Fx}-}~bJ8RnsGIp+HM zMvT;Av)U+ZuX&MX>dPDkV1~ior?D%i^xOpb3hZwTL$|Roc}28Gfkgp;+->ga`orO! zQPDgLRbmY6K&>mA$Id`=KeL+m7T{X$STdip%X>!T5V zUkxUUk~U&-^mNv;-72+HvVhG}#SxNn18pdx|HN1`qU_5=evQ<0#sbkLp*mkYaRyBM zH^n8@jDh?idi#pL7&y^~5A-S!N|F9m!8P63nI7?`_#sQkTdVR?@$VCpkwepdN@WYf z;ke5XyaOdt&dxC{aW5FER!@99A^Qjs6y5~d?$1Po2(>z zx}E4w+}E#n}`Xg;g)8%1DSjl-(0~G+0NQmyO1b5*4`rqnhLJWii z-4BGeqiQ;v9zTfu+)~s6`uJCeJQKR`Q?oq{Qo6w7>_j*>^o#`(HFsY>~+7jGPY)i(*Yyl&8 zvCbeboo#kuzkRqK*l6%*K58jFd<@0e2&49u&5$rWT)ri6nJJ^~@6rnDQE3y>xVv2krLU_AGbhi#2T-T>&>81Lr2pn@#lqJ7IJor zhpuTg^Gm0wIGSU2sMa=AWTE>`E!c_0hy!;z5weHJALtOIs;g{{zLM8TuKDyol}V;l zq$DudM{BQSsTd@aR^A1M@(9(Vi(_;+Arl9*=<ypW*u7RhJNhu*a=QQzkOVdO3~162c%bK?t=I)m)UC%pFx@AOF3NmI;li1ad#33 zcq#_L2HuEWZu3L+;}C`1c1evQHA{~c!N#A9Id8T>j-p;iM`&ROjl@s9#*I-5#D#(v zjnx7!(hzTN>x))%7&)&-fpp=DNYoQt_=7?Nl$;B|J#w;|!CBosXYQTIb1D7$*0hU; zyDyx-BSaJ`Tq34_0La7CyBBeW&MA47J6VY{d{&jgS@l}X3Mp>@#c$yT3NwXI7fq+o zg9r7@EaH1r8Dh9pT}6Bag(y{}kB{z#oT>dP&h}iECWJqxr#N(B3-wSN>Yo8ip#D#t z_C^J2$UX++Aw_0{@ge(CrT0wcnE;Z(_b~_~^!BWcjCDsw<1@hC@T}L3;Xg~mtVi*w zp~2c#fdFjkag>Gz$c*%EkGdL?3v*2z0r|!ZL}v-+0$7iMj$=$-CjEG4i2h+Z)q#KK z0|+DR?AGoxPbO*l&`dx#E&m^RYVm{e0%P~9HOLd%sAzM@`SMH7pi~Yi^(GR$migbja>kX=z!V6u3!zduNrhp! z=-HTwraeH55MMZ;m^<;kIM<(;_Sf?Q7`0pEL-#!$^#^4=6I_Gve2*>4ipt#%!yR9K zNGJ|X5zX(@#w^AlaH_g$Ovg8b#*fTCwPtrqC~-ydQPLBFeRD|*953U+nIYjjAQgPz z*yBttJ&**%IHdP0?LAA4?M}~o%yl(Ho6|!;c_&(ABC`kjvDI#`Xg$nc z1$LVuP|DUh`KG$?nBZ$O0kwH~%&@OV5lf0tH|b91gqVK?MBwAW3h=7m>+i~3urVHY zU==r}HK2?8#G@(LNxo1oR&p9sOz?Z^oP4Ry^6Kg@bPHz>Y_Aaq-kT0s$l zH(FZgy$JOnMeusW7_ch`VzTfQt)ApgJ2p_@@bNzS!=@Bvw&#Id_6@ij;X75Ov*5_! zohKJ$9wbp|ySWReJ0}x$9th5ihu@4HAtZ7m6@-|e|4NWafUgz^ZlT!A7eaDpc2$v< zA^Ajzgf_scEu(IC90Bjd_5;y!l~FC7)XEs2t^!8$7?$sQZt2Vs@XuQXAS1n3P+^YaPFCarl@RZ;r~-UTm*S z7Y4_sOIoC)r!qJiR(KYV&0(??+$sgvUyFyi975R4&kn$kj6w^T`wjOTsEYK=c@hEI z@nC>J?hJ}Ub`=dopuQDBh%*y$b3BmH9mYUHL6M8;{9E=0l7D6}=TKx5Q~yH=1S?n? zQ_Y{KjDH`pM`|CXXTMA^+nZs&wT1aE59d_nq>P;)+hSK7^k$ zIURsuQY`i{$H3x3e#>`uRy+cAIr{A0!t$)=@IEZ{8RMGfV(WG=DEp>{;hcmc&J7i%4k7?ek46^*?A)k11_tt>I7O@Uy5}u%j#ufJ^6|VDxScTu zoH4^$ksRqZmVA)Ql5v8EWh4WpT}o{yXs= zu#XQ|xeXxx7?Pb72ZKHCj{%dIav7}EdfinSiwO@6N1wM)yK*j>S=_0^h4{z-Ym2kAx&|n57LC~!rOCx&F5uKH2;_pnul%a924Q-=2KHVWY z?9>mJu#i9>;>PWLPEvTTo|PKHXIDiCFZ8ioeA5T^0`<|b&}7~2o&k`3#edOS&lCj< zAXlbC>*_8YLDi{-F~W+7mpL-SAaB-YaSsJH_rz^PpngN?@5-i#k@>*%gWl!tT-CDy z5%AEty?HJhFJ#7@4yNKUpeE)*38!_=YU90+jFQ?*E-cF(}=g_A>8 z_2r*sP}BwAfLsa3QD#Wt5Tv?8H+e6n+)2~fky%9^u;Vld_VVtKyX9j;6$f}O!CLS; zIbEH)6T<~@KVWJnHsxR6$_ch?0np)KV)0AQ^n*R#;KO7uoLZ{<+|5COvz;GSk>ZeA zuJ8}QG^}YtHdMK$w*gUMP<8m-yzTy7WCzW(^feE0BQRZWNN@*#T#sA~0*8WZKVj{(jOR z$^O%V0Zj2VH|AKB273G8gU*UvDhEZi>wdqg3OT5qV;vn|F5E9YF#~KgX*gpx7vRRT zqu@1h1*!zXiy-7gZ|?3or9mE3fSK^fIsSt9fqPBxCax4sO%Q~B>Zp8hhdFH;zZ4qI zAd4_`Ra@5$f4b5?{I&@!B7r++)-;vpi9ygDOAz_rE}De!^!8r`0HE=nu_%5}=3n=D zpvpBq+kS*V$(i%HJ+{m8#fkjx#!%!*alv(BW6oT`%NRO>#G8{Jq~2Ee7L*!Q;1l^{ z8z>l^T0@tu7`!QZ_(D)iVQpCKZW0ox$d0O@k?l+Tw8XL1 zj>q_C+xrrtXgP|81w#rUP{%fw3`#h*Ue9{Qunkq zc5sjvbslfz?w1?qadybYz5B7K#HW%t!OBCv9{^Bdds0>+zZ5}t%G=vkpR#bn6@jQs zV918iz!S4~zvsBNxQwd*w6uemv9!erngE44S6D#p;OaurWY~wjysioOD0*D}4J@gF|M(_?Wz?Zsa~uX`rm>EL{ueLuY?|o> zk((kV!7oT~7=tuy-*6inki?OidU2!0#61UA7Xu^hPHaDPDlM7$0z2LeW%#{25+I&; zYbF)R!&*d}6u0)A&GtOYccYjmm=KUF=^u4N(qT#V-N<`~Vw^dP{s3~qW5tmkXg-IB zNxIRu{$wzQ@cATLXi~j)sEw$=+yWg$yyz0yf*c)UvC)tT5N6?32AQG`qP)FSYNtN# z;l?L=)rDJG4Lz^1BK(T0d?ExrCjkgKCJl|QJV9zALq@3ML7rIf(5}*WZlpY($(15? zXDyRn4}%~rK@Pygt+(;zMRf!w0uh*r2Yn-n_CzP*{Y-eYnpANZ^#j&R!fY#*P@; zN`BHGHRchhu8Ljbp_6C9MgGqncgI@*BA!%xuYrKW!e%0`!-DX+ znO;P(jE5N#u$Po7^8+BH(L1&a zT#@NLU^;t?3dl0`;0<+&^8^qR>v0=ebkaGlWN zUd-gW4wk8yO#inv66IU}EAh76uXV#Ciphrx0BZO-tX}zmtlsmAfG0t|TpFh4Uevyc z$#Ka^@9A~bvk^dW6!aJJ^Js#PUtm;&K;dNz(>?~lCjc&&hdF!k(4K%&lDGcXRI7}0 z1Sj{_LN(gc`je!08XVk}X>YR=2PmE=A9ctQLo7(^h#%PMap{Mt_gG;`mk-7Jf2&$o z)Hooc`y5dw>_ETyyc{f0vxJ<`>6Jd>9&pDaKH1NTPiH_3tou)!>E?&o$VST2aPtfr zu~;p4Aj5;uag4^di)7)pAfX_uA7M8V=o>D^FTKysY6M(Y@1=hjqJVO%q=JU(AaH5v z_8akj3VW!1rDYf~oYy$tEF-1V>l{a}eFkPXY2@16%}2%(Ef!~q4T%9Cp>TE6kW9&; zt=_GdJr9EE0PNwL54@mXnSbwWT_Byekl@(h zf-Xf=cxSpFu#+`EC^weoj8eUmU7bmyc+|H(nsVQ;>EQp<*No>%qqm3>)zJN8n^(Yu zCO9jy9fnw7)iLp&UVodB+kV03Yh9d?nf#H)ejvIQ`#LYY9rsO;M%r?R$G?~+M8|-x zb5C|BY$VR{FOHHfRs}b($LOCj4;#qfv-R6X0LG-nc=NcRa&)QxJ$X^3B_LtVjmhc` zt0VAB{{P>?^xsN4kklOqpQ5vz3P+m}7COp<8OR@KLWq)L`&cL>=^@A0zt#<*agh}i zwHi|FfLwevp_0K8z_9X=9Gic*S{tqv#KX>wuOnDuo?oqw$OMs7bLDdv*^Lb!@ItyR zfFiROJmDC~SA*wKE5N^&9eVRr;EWqP4771$1he$@Qa*Y1p@dlA@Xf+7XgL8kW!igp zVyE(r4ev97(RYQYJ81{g7~R8^=x*lyRq+al$xJaC{V?{~>U0N=#OiOEgdEOJzq{{> z(Fr~|A;G6#aa2aJZWv&Y%YX*;4YmH-7gi+Atx#6w26WBjs@GRp6RbY~r20Z1Bhp~6 zv1rJb`e;2yI*uIbB_J`P=)z+bw-{&gvvz1d)UkMJ4I{h*6{wG!>2^lb zsRuIE^k*J11f40trH(eM&a$SqbzSi&Wvpr+19(#V+VO2$s9x3u+3>xn(g%(kiSD?i z)TN?LkQ6NLS@tIt2+e*0_{}~ny&ACNnTXGW|z(W2V^F zkPABHusRD+TYuyxCA4-hG?RgU> zBj>MyK6>?~&wD{PEUi&Uci|tqO56BEn4`%JKNU3)kt`NDvpDMjr{)9fB_0EMK$B4G za;_SJ@~6}>im>0`Ngc)$DHNHrwM-YFo<7s@MoXTg+YF_EmuI*S+PC`T2vNVQNH@2N zSDJniZ9wZL^2k0dtbfNNP<)oQ!_s$T^U2wu$uIS9(FLK(Ewv6ybB%hz?WU)!5b+Yk zj9Ey6dqKJMc95~)T9OKI%b79LzT_)NkjS+{6@_=d4jnk7ZMXN=Gwz|@M7``|u(C#P zUs*%9_Ya~8+3x>{JT+3Wo-2_28C=eLf;4V}Ov2dG)e64rk^fgh=Ys<@DFdDz7sCAW zed&JqIEW$7tJLjDbyXqLS@^)y>ue<(xbyeJ5Hc@_-XX-b(6H_d$)k#b{p$QV2yK-q ze<6H_;RY8V)tapP+-@nyV>`n&NOeOGa3r_2^5#CfK^kS`UOeM(QVHUaWDkpkqmSFdtYab0?`r`|MGH9V}oqBTf{{)dLEv$r(3^9knh%n5? z80qektn8#<_j`r&2COn32PW2b zTvP}$ENvkWwAPIhTt%?BDtx8$OM2~gMN~7t)XZFiLboMAjTf~t@7J%qXAk_6>wN(v z3UWmq%&zwwi}$P6;Nd0WhA`wbv23tBOQU}IPCqf`(lN#k9M$XrBj^l9n%$7l7ty=I za|KEZths|v#OypUz7GhpWomoe)q0Vlb0Hkwf0VY#PSBAY0ow8rZR-M#YsVDFR{gPx zmE1@ubeFV&Nc4^o+=mukpulqjh|nHktkDsL^l+Ku=G?9NMclCEKz$saH)tmRTU`N| zDA#@N%@v%TK)7)Uba9;+zbjr4^4V+wr? zo0UzGaBSa0sRFF)$E!d<7q2sF(%&&oG9}^lwHE%gD+9Fy)J1JtMyrxY-f%X)gN#^W z5N)mc_gsQp*sLCW4Umss!_SDJ6QX6sy{+{7sk-LrF64sI-z}!&22sB7HMzr|l zh7Jc{ryhdQa)*w#!#Xi7Im7Vi5o4o-M78uF|6FosJE34W)WU}5J=%2`adMIgC`Z+( z)CRD5`x|STz1I-d=4g8Rc{;r)&;`NJMJ6A*p~#G4(ar{+prztgQQU9EO~Iu}7KBU7 z2|>zF&zR;8-%&uO7aRplLf3oCv*;;}xt)><%w#d7_OnvQ@MY52@J{8@+hKYkB^?BQP)LzXp~ZXz#w{pQ}C@ zPujT{)LBR}JBWMU{+hq7m~z3r_0Y%hWbEkg8hZ@JyWwx8cdv^V^r5RkPlB3!VF)9O z-%>7+x~P=YZXLSAJAY(4Es@rcv15?|T0456+J3XGQawZ7f4K2J{04aR_vyocGuyi7 zQH{!cfJ)0r62Oxv$MT?TZ_&=$BZQY9T>L*)4`=2uHu3H4@@kDjm?PC#uuUbsbO)4a zHPE}0uFj70ycSPCZk2j}yq59jdVa~I_XqOqLO*S%*o`#?nBpEPO25)fc=YNMiMgyW zWy@xCK*@*PVL8&1r^x(tCw?pPNviw&#N~5b<9XRgqU3#lzQeRFV5inc-;p>=W!NFq zqd?nih{J0d!~V^py%@h+IwoT82UUaHzDUEVPT8`o`Q`Y+J#2u`AJ4x|_EOJ@{;he} z|JUC}ninRWuSh^}#(siiISW9c6a+T|Uc-HP!xS;ej7>?y>g*3*z{Ba|70(32wVa1a z3vnPqFx-anwzcOzzjbvOl5!h7ko?T)#0LZa2`oioC>TBrHwNp^(M90Im)m<+?0A*5 zfle)4KK3eE?UARm1A1aT*L(B8_#h=$=`aQTZaB?6*1T9zHkdxw`+Rt12fD#g5s09A zp(95)5K|t9XKHQoX{>@w8+^(Zyjb46nf5nOH-r0L=5X@;)lcIpgcPW%0SRtt)pfykAtdhPs%b=ST=m@y8li;wL4a+FSP&hqx2QOrEb zjCUQ7%`@i7K>I0J+l?I92N?OpHU}|pR#$C+^uj!&vD)g%*!hR3Q;n-Ody(RDRDx@| z_TOZ+MFeo@LJKj0de+9y&cq#S&p{w#!53s{DN)FAb*MJ2*dikg*czb`V$c+3GN2k; zx|O&>gBObwI;Zq$g2@ib3;4b8S5eb=RR67auQcjXq(A84JSuzu;3109Sc@u=MR(gE zx`Aa~)B8i8eDee0%CSd!v$+|^4#{p`3)39w(xKuY-BU}o$%z>r(5ap3^kM^xOKZz* zO;Ng-*&pCq-t}*b8rXjG=IQ%Hy&*6sfrHO){H;1_R!@Im23$s@e7NyJ1?0@lLiHgA--iuxKYSQu2ITqZs|^#ZK^V-z~V-XFQ zH=F(#zQ2$qVe%u*?!Lq}dTeRxmxFO`W4)^2xegdkkrxf-XsC+R)=uLXXxt7$*jdx- z=E}b(hv8-PobFbK!y?!D-%pVLv1X&TAwcCbI$1+Y{|Jy5XuWS7GydCXf)^N+G|lGEl?03 zan0jbf*wN7X#AYmi>H=)!|=_624zX5fpulUHJ;+U&m8DGmXBy(LH`Zl@rh4=;l`uS z`{~|~bI2_O&~>oG>OHQ^c*~}32At-&bMA1sEZx6`bQgyGal#scs6Ec&D9Na*e9}BM z8bH*Pb>HkBy@Lm%f__NSUgO3LTA<7Wfe5z~RC-Qy*>LlBU^W{-osKo^P}qBx1mIyQ zM^rU8lDstqaJxJ*V5uUplsgj@sF*4Ftv=)pC{y%>ADpxnR`IULnL2*fe8Tr%L*MX>3LjAdlUH|LmbH?=o z9iKvS77LBI8+aTLek%CN^`Ap;i+K-+Vf2Z{k!YhT2AxN(t2BWNGhv zM?(l)g>=PjAAA9`t7Sl{4!r}zhFmUKY__Jd?UPb={PTH!qY(NNi54^p;h8qRjceVx zS|u23J-X@5jp`K0$Pc1hEK->FLqn)+JzzxbaQOWkoyydmR4}6Cgt%9-4aCHa z!H238_l|FX@yfvDd4i)^Itc2;_Z`CTc@9mSx6P5=TZA|<oEpwB-#*`Xt*km0Wd#p!`zU`iW~ zF{79I;s!eyFhz5A*oZBMu2d}H(vcbHsVqyPxn5VyomZ&R{pSO#w@<2``>38w?cvd*tB@f;;#>fUq!Vrdt5WGTylWjM&JIcBT^#sm!h@4 z&#r%-8F5wy%4{Q83u6#a9DsK`+G_nEHYWovvROQsjUbXhHN}71v($wmj)OB{wl%Hs zTtMW~GbU;5M|4Jqt^m}NGYGK3(D9m~*@pRyufn94C%Nqy<%Qr#(M{b9g!o^_9e`4~ zl^DN^i@z|A^5?o=@tSiu-*A84Hly?pajC%I$7ZgHIq|}&Lj~TB__B-^3L*D%7Z^`` zcnGWz#M|J<6+_sopbf8YJVJfMNTwRv_`1b`e^_qKxz`!Nr{-5htUqUbBS;y%ss2XF z8Zc!E=kY=giHsw!Yx3WR%L~Ial^%m-`9EPbyHuj6cqS%CPiv&QM;B0;qZ>r6B~x|H z)}8J(LN?5hVrUA^!*hmCio83#ObyUcwdkU+6pWdXsReV+gVTo(Sca+^y%}ky>l;M> zZw^{yGPw4In6~ccaLP!IIB^bwbZUlGuD{~K%p>Wj^a4T;fI2PBhWknNT{d`eE*(7@p~8X0fxg4K}hNK1{A)Z?5W@Ie@@rJn9ZRDlwUv zwUdMymctG-X%~}PpAXgZC3=@LqhK+cnS@B7F8+tK+5 zP%|~AiS;jKi4^M_3ovjfZKW_i+cN?sZP?^&8mzp=fZ6g^se!pvtJl4;30KG|vt_(- z7yO_anFa^U`=QL~_KMDkZ5TZW!Fn}vtBa%s4zPM1I&VQwX1C2U_mJCTda$9i7QVl>7ts^uxe zSPwCA#?@75GSv>W7BMj3>ZW;kF#KVf7f*kZ^8O3{QRS}GJP84tv-rp^hCuT0Tzo-F zq0R>l3m60&a{!34xje2z%N9VchZBOF>lvTBL!50uDqlV5vuKJ5NY5V&uf;g&e0 zOQ#H%Z~kc3;UW`YJ0ahheI79b{;ZdvE>nwYEx05SPfwDCR?7sco9?TEh)%Wz1}K8- zy$u>&;k-H+sfG@IhID$c)gzWg$S5A3@1Q#$K)kp+)Mzl-H2q2?G3^{HCNHr2pxTJ* zzo>f{4Sa0Gw*B7N=>wCktX(u9^f@!)TziA(EAS8n1Q7Hm*P_eg zp*aIS-3(xqxbWCf|>{HTywTJt_6Jqmtu;J2v1ReOu zl_h#WlO3i>N^NvDPm%C5$b-;Bu*QTAF#L9jAE#x6t(V71#p84nmZ%N_Q|5N`HI(I; ziBOjCa*s=_F|0PO=FcnA?A00;WBKR6GZU*(i}pS7?%w!Je+G4=a6$mv-S#CW`y%-A ztB@m0-Cb;KJ)%kSrfH`Xtw9N$=UJ{;~a#WzsDdty# z>v8ciXEHOIu{InIw1w{F>Bg=r5j7yAgv{hP1>z)!sItD9d~{#E^-_U7)7_fan%FIc zfr_)+IZ)wh1D&OLyq1st)DL<)oh=mGlOCw_K7^4fOZk#by8Y1bwpHy{JuDvuJW&nW zGdTTq#uJ6c8E&J0%5vRhfZsV|0Dn#ww|vF4oFx-{L$dPQbLhpF_Cn{wQdmqV=+A3m zdm^8zC7?IscT6)YAcrZ5jEJPzT#}f5T11!-<25+Ye`JG2Q56Gwho3-y4*W67M4|qX z7s+D;V}8yec_X?BYzlpjF+GL?Hh&PmMh*yV{t!0kR-ly2zL(H9k>IQ4*TQ>$LT}QB z-$k@8AVM*!C~*Fhqrr(FBgCB?2K*U5QiAK8yJ6@Xu(!E#oX#be-NR}&;`!@!8)lrK ze>|%%>@rTvCpRB~*%bK{dvPXvH00}6;{+%8kWVfJj&Ks{TpzOrWq_d{jGQpk)7R6f z5o!skc3B>C+P{co-0Ye`i^Ko3q$;8nW&`UOIY%`DzK$glY1~&Lw3#(}k?G0}L@|{* zg4T^bIYw2$r6?vi#Cu5LBZsnPuwo#YxAXOh{VJ#C+F6wEk-rerx_E2-gdMIpm!RqU z7@cDSP&mkRJX3En(fY5Dt%6LB5kH&$#DHtsE{$?ruXVf2#O2E*w>4FG|B4 ztBJ}%`9JMsbHQwL!8tTS=c&Nk9EUFs#D#1nCSZVw4J-z5kVt~B`1pDkC$y{&sfRv zc;HR067G8fCStp6aC^`D1t+8u1&DGf*2P)tck$sty&QPNr!_QD6iU5v=8@^)2MT&& zAUf?8^8U(ezrh;Nql(k)i&^d2@~Q+BbJp5>*vsYE;D>E(RY3KZzrBGD3)Ip#mj4!J z7g(Isfh3}zXkm`)2iUF~v-a)xwI_7RlicVxw%{9J=mpTuBg^M%f^A0NdsC$JrO+-i zMda*wgs5d*l)DfZRISy0tyC{E2|>}D*-vakNaO!}{u&DCPYF-cK2&EwHc-l`b**4z z;H$(8ZjEF=Xd~R@3MR&igmEe3izz+pCp1_Wxr{;5GT? z>XQV+y0H)r6x6iovI`QK1WW8$aHxYD++@HAdb0-ZBu6yh20g%yF|Ua9h8_84b?X+4 zJ5FcXbW0lzpv%dj-sc?de9E*BAf}^@7mNn2p>sci6B*28zl4OuR$A=$KZ~1QT(~Id>D)L&fqT*dJxT=2M4mHdOjhJqtrRx;pScZCfYi{k^xDo*LA` z_?33wslTf4fv70+cc36f!#$ecHdwuZ&S*Tk4@3wEPwbo36Zu@y!nw%eq=9;7|<0xD6m$3f*C+1)>~zxFZ6?m%81OGSH3e zu>WM-W6nSAb`zk|>a47To*Ci+=zD$kr*g(<8)^m?_3FvRQF`o+uGCJCOFa#$cZCuC z%2j(BKkC{Hz9OY!2B3{5Wz-T5&44J0(Kgh$;Z4gc7(3Y<9qs;g2XO- z2n8z`)Dbm(@ipO#A|mfuNirlljhi5{UkWe)>`ahY*b*8VI9E)e0+7t9C_J4B2LrUCUXD*p)9X2$W*u#)*(gIA^|yY|5*Ky?S~MT+kjL7?ek1jNBE$SivFyC^2d zj*%Q8j6VEv1Sm7QsS`YJaPJMc^#*Y&C{e7w%Lw%vSXDkmW58+5QX1(@jej{An!U=H zZcu`GDo67~cme&Wu>Oa3WEmEnIg~S4Q#t{^S1IA7L_LtAbiER&8OnE zfB(H9sD8LegkkI%Am7-hrVa=ceJ&~Lao}wqfZ54ge+{GggOba|Q-k%~et4JWO86Gn z^Bb2)@`X_?cT2rEn{EVzomT_q$`plDpDLbuS+m=fFnAo`45rHQy1X}<0N5vDCPoN72gyf}{Y~E$=p}pK z45n!)WK#05P`f!s1O0?CyUJ(%;piCGuuQ7K1rQz+Id24XMn#q>zYp z7tn1`Ut=TDzg5lr(6@S2g^En}!-mbv{E=REq7NgNwhdb7wbwwzd|0+7-6s6$oi8`X z4`FYT7D^BVr+qQq&eeC_w5JXYK6b-$P0llV7(_#Od}D0;Ay|+#*}p@r3T^MxD0d%C zGswaZE8(QDMQah?p4pmQzLpg2?66!*%UOO8;lAOq{O_n6Y>j%S_qD7SkbxW(s28Kp z_Lr_J=bjAz_g>zK{1M z8A%7sgE76vMh1Xm)gJmOC4F&bKIr#Uj2R)1ZmU*Bu65C-Wyb*^? zgvWOqM~C%`@O`Q4FsNjUQV(icFNcmriOEf*pfRHsWMjPZr5Xn=6GNulXIzGYf0Wg^ z9%H8V?EKfIlXhV55S6-^)dGb0rT^;q<&j6Pu@V1WLVi=R|bQ3~TWbye4%#$C`w3_9Jb z?2y*-cac=GB!S_bfHLqGA_LZcsLwMs4MS*fc9imNbH3{nt9;m$m6mQrbhj+e{sb=( zmC_|*Jp*^epvi(3mCWMPcP=7&v0AD^Y;*zG+>Gcn%_cv1DaW~S928D6j9N?ZCCZ@P zh>{NHVfIrd0WHVwobd+wP@y^1vBqC8CFbJTTMge?j=qoD3mhGg!o_P?c@Sa$J>Rd8 z@I7{$^DOVSi%C7?_X3b9O-HWttYoZ5@zM0DobY9t5JTV=!K-XL&_~^|yyVuki%Lnn z?l0bQPlda^VDS$b7iwVWBYEn%9HXp1`S~j+Q`f6FLT~9*^q~2{5Fa>_h?470so>eN zMnuOeXoQk5uSpk$!OVXSNQ7>sWrt^t^8^?zSScb!_Utno(MimI)Dcl_poT($x-<8I z8{0i`2ym+pWQAUXOtIR>H*yri?Q7?7#y5|tU0kD3WNdC%nn}axCHYwMjUfS}{zU4T z$s0&9BSdI15zW4#;_^&OC1p^tTR4w^J46Shu_MM?woYvzc;xP@IX zaIL2rZt>7SQNuA<4B2MIm>|_kmFNU7a*7P1>6Iqi*sF62(gU>;>F9K_BbWagBM;v^0%Cxgu%_0WjwbEKTXym$G?!z zZhhX*!!GtNjf@i^{YfLu{)_A*%b4pmpQjf|^xP*qieMX7K%D7=j2dPLb-O4p8s; zcjmHVSAk(_9tXeMFGC#c4(|{}?Zf-Dmw!iwtkl;)yG{%T3&Zed1=4@f4H_t}7lfU* z^_1pe3}vr!H|!ot%Y3=6>9fX-T6aZ4$bluM6n^`mnGc)o44_~g16)wkKT4P18KZG} z3qH>_jX_I*5Tu6aVemOW-xGwV7JX=fI#EfeR^YIr zqi>9t9Us4QxtxuYm65Bia4Oy<&%y4-xS|F7A|Or|@qr017Dtpyq=kH8L&PZRdGkF$ z;57S0QrjSOwoTU%2qw=c2tE^*9(ap&O!wB;yfY%wEp!ArMvYp)>+QLOP>DLk8o7nN6_Ams|NB| zbOe_P3{-c0FU01)BVi=9G;RU-hoRMHX+SoODW=jns3?74sa9G2367^>HCKCQl5m+I zaml{jz@e^xE$6jZIGGiph}=PV$2*e-XpOc+Jo@#OdeZ8dgt=hVhH!0$a82Oo!y)UQ zkDyi73()^d1RM3x_7r))6OhV*LXW8zvnUN_GYllmFAXf3)017I^ZU#AESWm01vDWat$64&Wcj@LJ7p@iFfnRs8BFuHL(=*CFo1*935HbVh4R zn{&@Au!r&ztK4ictaWB8fFjxq&u}boMKXWb$OFr9*KC`#q2`_py9&$Sep^0)X*6#Ok)6Xnq6Y|7%h#Mu?u_-tqs5EjoQPweZ$& zWb=^E^-(Eaa6{R#K!T2BpsFgnMK|5x~&i%v0yxMJ77Xe^7J#aTct){j<@=Z z@|G5ec3gf=Vm&l6wSUNda$-6Wc1*=72?^(L^NRNxFW)`{2qnI27>Xc4^MHabtqR*Y zgXi`L5`+2`n9CSx*TZap9W}t0vJ@Oa$E;Be1#!CM5%q8m?3UFnRQ7ADJE~g{Ih=K6 z=|5~4qfaI@6qeLxKvB5QuBX1C`9#CxCkz||pjFy?7gAfrZI~%0L%fZh(AUWwu^-2o zf}Pn3H;cD&`TP`Vdz`lgjT+~Q;C}AG_{|-J!1OtG1Cc60&6J4YNvoFZ4T0xv%P4tG!^~@1MpHnG8G# zC$te4RwtnREj<-h4T_EKfb5hLMN2u1FvzQ%#p_lMr9m-5*`n+gRBk`gR|58I7LP_? z;Tf`queYM*`UGgH3qOTO_L$J9?plPP(h)DGv(qm&y(;5~-0}7dMjluCA|%%BL|+V{ z2=J@l5l4w*i*N}V1lbM{`UqqdQ2%lsMxg6r0-4dvM?z#vf>V|~NlsgTx*;8+ z>fV@OgKWXV>730&{E4opl|Cl9-3-Il)HivtL5lrMB8>#Qy7>8i*P}b-z05Y;hyX^L z)tpM*j%c|cKgQD@6DWuf5)o2S9Vtg`od^0enLY8rkBDZL1$?6-_ql-NQCUxYtHaem z*C{>A%@XUJdBLiw+zv>P?x;~i*!9RY>>&ejL_Ps4G7@OXG6X;CS;R1xWZ4VSA~xk7 zL0NtR$Bny|@^6`gG=6+M`M);@kNcel(DLkhfvbfJtHpND*Cwc7!Zmpx|)E0@korh6pQc#V!sI%iy$wdlY}5ZY4Z*Q2#)! z>V*sUCdeii!q6wzN$|jUSbhmKAAvL(o^u7?T~K2M9ZKbc_ioowTcip-gv-?w@cLgk z)VTQxto&n7AH9_2e#G{1lpR?Dqb8$$Ei4OrM#i3iSqsUZE+{_s#qSS!a$>5^Z(W;w zGSW55o=odI{#x%EJvD<+6y`BRZQO&~(8Y6JA;si&BxnN_o^?|evs(jMPRXlAFS+y` z1Xn^1WAE$CR6G0C@>8e-DCCJFEj^(X<&xtSs9;kv;eK7NV{V%bIqu_VHOPSyx$3p8 zuQro@H~v_&{K{!6BF-vfVi?=QD3R;;#-G$b;#G3LGrDs`{78HsP&CaLPp!4bW31?2 zB0-bGD}(bb4v}OX2JzK+<%rtELX1u5DA~k}=+ZQvk&kW-uWTEZW%|^{db|vB?FCK* z0RWXv*^(pJSaG<$f`cr+ksDsD&urowdTIS(exz1jS}?cKvPe62OJEPUHwh8t>RQ{x z{vHfr$1$AXCk&C9*95cpMMm>$Fyhr!eTCfOGK4_Lz$ImP@xekCE>pd=9U!MCFX+jt z?bCL}_@JhXRau75ou@w71zxff=bW3O73svcQ(1jN6+F~?N2aLuv%C3@3Px(L{8Ok= z?snVCT?9Vh)slhJj8DL@k3Qp@WCQXcp(&~um~;d?fcopeL!(qd<=EKtlNi(2Y?OyDSbB-4dRqg+t45+7E8PG#U|Sb`W@pT?S6Zo4WXx@mpPy zfbVH>UGRygmm+2+IGYcWU~xh8FFGLm$%$UIrO?lxqNBoDGY~y|A+e{t8|w;aHf`BijKKC@0tZv1VT-Ns3&BCG8w_zQa@)9Y8H;)+-@pv zodIHLaPYsv4wDDbU@p{4ri?Is6*vu=maN6_n0e9>e$^Q@zLSq7>ZM%2g;!gx&-JBv zePUm!?Hm&Ue1(;~c*|z~qdIjVJ$(>s z=c4h;>(IeWPm*L$4zmIbzkt?4r6aoFX*?DrHCQed*lA&1{jZ%g(Nlavu7#A+@FuAVe+0aoy?!1jlXh z$!!58C&k9k(CQ}q`i$`^+W)`fg@wt}siD11n_l*fwhW)C0&aWrx!P;ErR63k=Kn?h zWXBjyj&;!Sg`qAs-PJ4}De?kT$2)2*MMXb_wO_(2$+r{BwFd9^(hk2;J$3w^AntG> zE=S@ahul5=u;iEdq?<}0Y-;xaW`Ac{Osc)4HODI`bC$|DbVO07VgNhg~uv>{Yen zh4Ff0xY&M_=(_9D&$v5r-ah3V0=pzTvkF;+p|i#Bb3}004+k#{{Q>L5IMe(B)m))o z8%+HztC*Gmo%rU)HFv?#Ldh=2Y#QhY_>H;x?aVFHuh|~v2@QxQj)Qt11R~g91qxhX z#1+&O0a*rQy}P&|62IE!vW$Q3Xwj(onAW%scdDd$C476VI`x3za;_Cv@XFBF#tbpW z?wW{~!DAvgT)9bvft4;RKG%jy%g8{aZb$=cb>o`d(eOP*!K1Pa0K_{P=Ny`F@ES9M zaS>ISRu+eL^E1mKxnx_F8ztb8$mzYIp#%M9-JvbSNF;R=)v^$%+=BZsnpDrx)i{+U~RAtQ{px<8jmZ1*cfzT1`NEmE<+ zSGWE!KnZ636A1}UyP+NX>Q%wKMvWxFXq}ung80K;9C|>+m{Ld(1J~UNo<#b4S`V&X z+)2;c1oO;i>MQF|YZw}oHcK#qM)=;p9OEC97>2;G=%+YVj8nmYA^U$kc@-&u>nIVH z%+-UQNc`Xj?`IJ+5rro-wvf#idB#|c;$Sri?)I?xgm}6L5Jt>*KxRn4RqALYe(AWGhw%U~SJAq88|xd1>70AIBX>XzVUj z{bEZ}*N@#Vnk<*U>5iY6dp5M8Xv0|BPEkn3_q)*zAqsR&tHqQK(17WxfvJIKu*9>l z#x~spi)OZiU7(B zX1w^C@?g)WeDA+FFtE*-4yC7fN3`#TAqW={wJzD9j_`yBVfW4s*ohY)+mD>d~mS~C#4JydLzm4fw2-}AW8MmcazbgLqi z;%9=tIqBb<`~8PR3ShUKEdBdzB!TPE-l)I(jv6DX81&)DK!ZR>b!{Rys4|CKxpKw> zkm5Rh*7`3j@qOL=q477;<#eE&4P+EsTOdASk~%@TL_+KBgh}AcH#PLI!s&w$EKz8% zp2KPnI8F%X)*#DtIs>z0yGZ167CE=PQv?Y8VZ%@jl<_Ki%XOu}?c~#AJ9ZPCeUL`j z)`yAwpJ@2gB}B*N2E~wX@YpsGS*T`EUvy#WMa)%hs0~i~uUGx>=iaN2l!u+QOC7Bn z)=V8gg!~9K2||=(ZU!UM0B55?oV2VMvC%lh{FJ7DI4$pE|7>_+vAoFkz&(#L`i*nK zV6-@$rca;b!w)0Z1Z*cBgw+t@j*u=g2cvTLelU-rM=~MrDI8*|A)O?SOd)c8+Y7jR zBR&4E`lR;#qWn>hQ!}LIF@g9Tb3t?*Lm zglhqhiiso9F}prOnFV*jwaio;ZOxxl$6Rii#?WWCE()6uoCez*Iblx6Ez6IO(narG zY<9L8yM_SyJhKiZVnepxSQTp9u|%3X?uRzd;LCX*5c19QmvbAwmI;ZMkbx2Sa)=Gp zvZJW?%-*#0i5tJJ5p5zPCwe1c;hhM!_-H`kf`~ZLI^w60>NOhnWHWR^U@5>KPeA&I zZve09jH-L8&$J7r-CZg{hdL)W9|bt`$Ah7ZG=Ypf0pI4Kt%2(dMmA})*r?MQVk0V7Gz1Xb*JL_#+;U zl?T5QsV{3Kh^t4)2*bdnWbPdXndI@_+R!iqg+T{wAOf)PBAPO2O;QP91qa> zMXWJQe~JB$g%3)tzMlMAqWb2UH3X*k$Z-f#)3k9%yOClr+KsupQND^tWU*c;6kiWc zgb?}gOdL_%82F<+egT++Cs3KR7s4n_@Ae-neb{2~oL@kRc@Q$KLcBytoiU-;aQ_SVe(urZVw( z2a}I3<0+&$*G=K%P==wjh5BvBOtuFANK2spITx_#_$DTlhBQF{_`N~|Ghd$w+yk`H z7-1+BI}C!G>CqBVdukTgdKyh=^6}h51`^=`c)m#(-y@~73_9K!4r5o8 zOHiq8(MK8Ci3$e_G!_{S;D|=uJ#a~l0s$4=XPW|{e8g6N956je+@j07mwA;gB3d{u zGlw%P2^grZ(2EwD>Hiq73)b~Jna>!@4>^!?YzaCoiV#3N#kvcuJCIzk$4*ZRI@TTi zE6!#T+V8sA<{^6rk0q+z|4u|ue&mMn-4~>}ZUm|=zbYkw{*kZYggk?pZ%AA)f-w+? z8;`nwO(VVMXG(}Ar%()WW`)nI1yjc33#WWKv_s3wMII3D2#UX%;)Lzn5)-hb@fds) z;ml2s+zGM|I$nZ*^{Cu@y9_bAh@8=$+6!bd-o(AOZwPSCk)iFw6nYNh?9#d8tB?(# zx_Da+<8L;((k*PX{}HOnGc)LP1A{8D#q- zrUc)kxD};$OZVD81H(H(5!Sxc({xOAmCxYI(bToC!O<9Crz$(9n1qEZTGHfzIuv7<2QpaxInXA8=7*1 zxIj-EVc^6aK+pdATzlcQs||&6=O4~^HEvXF@;uhTeN@01vu8+WJqd1)aZw~*8iFAb zPrBj?57#0(Dmz~?TW5jpjiyKb7GRyNSRC>8w1$eDVUIjR2eL;n0btQq*dOE&Hpd(} zOT$j|?t>y}uv(`4WWI%89+|BteCN0(J(Gg))P3jbV+Z)$T+tlR`lQeNN+&PfZ(NXT z9|}NrFM8CBUqFp{m!KUqa;94DA?NL;MP2`g+;aMeEYj<-@h&1d;KcTiHNVJPa~0W203_QxF50++_rE`2fg*;4%GR(@$i$> zde}Ev6+?ff^?bw*OJK(m-&5P}B~+Hf^*SA3j~jhbvUVne1k)h+s@cB%+J_+EJ;FtN zcu8RH$HA3rug*BzKaDwHt*}f!^@y|}hXd}naXh9%jS3(^=Pfgi- z=ulKKtWWX&D&pQq`-n~jd~=Ypdknp93{-10?eVPB`0kEU&7~FyP>9qx+Q451)$aQX z&N;{;aH+-(v4YC5+km z9gHd{Md|gP$JO*q2ux&T&xk-8g)H>FwH(9GO7=GDcs8Socpe5w%1)i#`9;Da!;XGb zAIFG|I+G_&vj*0c9Lyk;bl%nN6p7GHhVp?HOP0L@=esYp+*p7G2V!;a% zXJ(9i3wAF4Q*(dM#*WhI@?Yrq++~qJpI`CT5O@=!gkFv)_l02oH$$W&uKx&%gDdjF zxhi-RZ-p>!1U<8C^nPxlUyq2)!9F{+u3jQpjgR`G9GeMJP@C*y7^rwEBq0Gz&i=2 zEY1b!mr2N>jEX!nt)Z6eGWE7pdj`vK`3z%YVP93)C~h*2W8xV{Da0+rkC`P6$Z9R~ z-kh!#3wDs|jLg5kAGy}R+~13V%Z!uDVTT4X{@T_Ju(BMy{(y)%pl*`W(k9ggRZS;yAUJC`x(^o7iXf7 z6@EMnbRT_jKHpx%!Xem#E$})SAqh6rIEgT_i&pAvm3-i=jReHc+C#mOmM^6u@-I38 zX!-;yUo3jt`7iW{-hW>>9f$M6>XlA0q}lR0M56}@F7SJgydoknLcFdU6okM+3CtQQ zdaIs9KWOWp@5ynSmmhdA_VTBBM<{+1b|_UtmsR@<346$%eFTL^sIDaZ`V0t;K5$4{ z{l#?hDgjiH(WB^lYo!BW0R^}F5!Pvj(Ixf)}WK>a4~sl%3Z%n0RN zc?RrCXiV+LU!Q}SGikiif8`g@Te?~LMNCNkg>c8-O-{r6eF^bR&Nt(&%Vm~DT-^i% zue#P4wm%sacnq-f!Ziyu)jxp9H%!2%Yi9rV6D&adT*#8Pq&_^4AKFn=7GbePUp53m z6%w(Q$7~0?4I0L}esQ|08;khpX&B&H3@XU-T%CnDb}OXEH;}O8h8Yoh4I85jhn%2B zP!*l+KxCIy>BGca9kKi|#NN&4yi8rhnjFfBu0TqEL>qXyYVpk;@jCazQ+?TKiKNe# zDu8wrYuwT2ud5HZ5SM5F_#6#&ssT-Ah^Qr5x8>Z-*@z&EaQ}w@FxOk{UwqmJ!7aNc zTkGm{%Vnna8!GIMWmcB032Kw$)UW2Va%+OBTSnk*Ug^SW?rXoZaVzxc9(|l`k zs?`MN&7+>Q&fiH%PR&o zd?x?;X7S?L;|GD!4qh_~;U~bO5?iJcFbdd1z!v;RR!l5255RRBG-Ht5C3)Ucq?hD) zzHdzu2bM)$r+l4?|(NZ=-tzWq_4DKueEo5X#fGxCYMz+SrYdh0+kG z_9P18ZO8d3n?tLl%NxruiJO8n(P#lj$Pw5yGO$>0@Mx8sS65K_Q}7d&H|B!MCh~nK zSqk|ryv{4}9O3?!#oQej7F8+`j)7E>G64(oO&;Pk`WTV7=fQB`*eGxV0i`g}b@W3D zwEnPAkYz6GkL}&SQfx(qq6ec2D>34g#qS!Hi$qzs;DYVc*-zza9d1tJ)`s5zs3%4q z`EoC$2QAtWpq`>o|5DvRim$l5=XyVV^dN=aJUf6TSJOIT=Ir^od< zHzBB=9$kMWgX1ss*A#_i&XB4_LR+g~m?&eHp z0s#Z-vpYR+4lzq?ncu@xSfXYZP5Kqot9c&|7_S_~ow)n^I#^f3;RSNAW?VuR9*e+! z+Lmk%88& z{dBLW@LMGLY8qX4Q;^0XRHPYQ_;U@0jsyX3VZF&Kk=np=o`E;0?tJ0CzB3)jPjQ)5 zTf7^YPLpA>>OkQM2#`>)C?vK1#FIXq0H(J%D|s!>N2kBxx^lzzWb&79zlf0{Ev0dX zU;aSMt4M>^1^5Hq#S=zIQI1V!&BE^dFpa)_+D)-{LEjt(D1RcIc0jVZm{aJ96l(c2 zLYh?HGGIC01Br9-BvbB;G#fYz-z8p!bsm6q+ubR6};d17Lh!Ig(6zGv2d1 z4sYhPCp7;g{}mp?q1O!?r9iNqbj-pohD;EZEUpqfp2kqr)6++eOdDT*YUh! z*i0p?JDcI1DAf@T2O(gN4ZZ7a;qVS;H^l6!J)J)^dU2X`Ei1#rMpnr(!w%4Wz6EHv zt3yeuW-rm9LYgA0rVw*b8(~O}4QtArFa% zf;HP?=HaGO=rspIjU$!GQU&!{GtYak-xk2N@}fi6K4SicqopyiNvs_M6V=iq=_B`j ztc2Ld;Al4Goc-w^G`Ch`hwr~Z@Rx-ME#*&iFgS9i8$mTfIeDfxMzO5em(h|IqnnC# zYDjg0C`bn=SwR32ZCDuzenlY^3Iuz<-2td@fD5_idd!ZPMs5O3{GP}Xwoz>Q!Wfo` zBS~$?miye7A8PKcJdP|;Fxn4dfT9JU0cJZboYl)2j;H7>5$aP<~K@gzcx&|g6{ z3~+=G*)F#W3J+tTkm=F8{>E^4G8ex7JYpuUeOPY>TT#LbWXJZFaCEk&*&wloB7^Yr zlxcHwumri!=hbjn6^%XVTmxDVO*sG>oRmSBssDSVA9S|5h^?G3$aA{p!^hDCD~?yd z8lY^*e2uoAq>B{0gJxl9Awn;^k$MsH{=OlAJ6$Q!LAK{1M|k~d)u8E z^A$VSsXLqTKi@xHLPUWd-FZmD1m~Q!a_nkYF}4NA;zW>QA&=HRF1UDx6f1Ev1H?Sk z@2T+zI`;wYJovqobO~ahSA>l

i=Lhb};H#N}_wa1{jv6R#v+EiR)BA(lkSX}~Cw zozY9^+%z*DuW6JA(kFfMaZovKK}vf1Po9CfCMW`*$RnJ|NwWnOak6vzk}?S>^XJ3H zbfosQ)Z{yXJ3&nH$JA`1&Y23u_ytoKokY1tre21gL>1rO;cLDda4=B?q`apTHDgoW zu>?4CpNk>Wl`PeS4{^!7Lk?1?rUxhEbp>=fL!F)sg`VIM;Kmpe)2yK;a5aBB?QEPW zeXaGE2)V&}7{Q8X@3iR|y=BUpmOj+5&`&>8`2m-;VNi-nsyN+zsK>}A9S%hE5WH&! z`?D+L(cL=|%o(UjFKSB@NcP+*;g}C(CH&Z}IRY9X3Zs&xEU2}k5=Q|h4e0Ii!{<(S zRv0P^FYMcp(*M3ZMqTaT@uDgQo3KB_6zQP_%>;^ASd9f7^hQ`a!ldgS@wP!v*inp) znH)C6$nFA_!%o`TR*`D&>?clJG*)8G*@AOPtg$5Rw!Sm16A28&FMK7EdyWuygS(5e zs$#T7?$FrGZVZYtYD8h1Qd{^=*TZ`dX$?ru_Mh9m+EhHEmUW}o_O$w5?NlC}DlHv9 zh~?3PQiIr-gs`+br6)+yAMFx$c(XdZ=|VYKJ@&OMTF9rDF_2MV>_dFXzei;o&{_4h zzvTlCKv2uwx%z-^NWAv#AV&ThW(ZB z{|5(ZyPs0nSmvd-%jJ_cQ8A-tHC2aNEB4FWUxQ6OjAE|c!B0P>W!pcHA?K$bNr12- zy#l;_u13BGVeTkG22@X&>bczaUq`qwxyWUS)f=b$2O)nl@lqB{>^Qn8UZKW8BjL#g zzSZBDwy&KF*VIOO{&(@Z&xQ&wwf66$t%$J}%&QU?a>MC@uEvvDW@`Ep_X=UKRymNy zb*$O@T;vf!W*QJJJ+yR>>AwrF`*-@6=tJ^XT*5~ znA&2HlMWAM&5vKvf@sXQ3Uv}SxI$Pv_m1HWG9#a2`m>%F6<+aurYk-k`(^#ldDG8g z)rH(O6hA|@(GE$|Ck614UXo`h3+baPUFc(epIi>|zt~N3V!=0k_&{{vtP})yR=t8i z_I5aR+6T1kNM*TI$6}8eLGj>O=R-p_eGkU0DKPcvEvl72ow@bc<+}To4@~gZNq%k= zf53TkBo}5G?ZfOP=?zh#EsMi>3yND5yBfsd6ddX=jt4$^q4*jU4q*Y?#RkKP-NTe{ z6iuvTMI30vxAS*jN!P_4z@&Jy+wt~|3I3*qUL;OOGw5ckuV{p2!M7N*fr3K8D9N(Kd$k;zi3CYT`1Y? zmpySc^=K{4f$3_P-vR8l`D@jnMfvdGtT zEYya=iC)D}-QI2_{C}+W%<&1sNcgnHXVn=c9CE{1C&T$2EcqDiz_E(A;I{*;~i3I^|wnL{bzQC z(Q_wQ7)1Y6ZZAhrpo^Ts)8?r4f6>gSw04t$LBr}VSsAdi9Zp}|?}uolb&SZRsSWvZ zcZ!&G<>2QQMmUM88~mGi_tkTqzL;Rp!?*m@9@x0=Sp$w_Hewby_az+tr-IRkc}$mL zYqA|f#%XUo4Ii%=bbMY~vRh(WA<_%hWwj#iI!{EJ$GAbU5I%6=JXIf~J zxlK2H05w`UYc;hM!ARSvi~0(+E;?G!e6Zk)oIN|15hfvH(uR+Ys$x6gNL7$F=XW-26t^}(e()quq_DspjBvXKf4Y(iQN*x) zU2~BKJcM4q?KShN5HOy`(ikR(3?juGBz8F)-yGz=?zW|uPMvX8;{=W&5#g-hMYKHg zM`}&AAaG>nPm9(H0BGDciSTzXPMXQfyEJ5Xldt2fQ+DT{!q=G%G#009z}gIQz9B$X zh-jHVP&a1@o)1%1*pc;DCvA{Hp_cBRs=IVhUkGGws8t05ed_IFXehr$C@QvMltNX5 zULjMyfvKMUmN!UI@C0#qVl0$TDcQGuI+eW%)bZR6Z*#2M*>#e8{qqaos)T|npL>H zgLd14V^kr+l^(snLF9R|&~coCeP2@=(@p>vR_VVKqZf$LLMC$A>730VWY}I50=}4i z4Qcytmf4j}i4G{=bVUVWuO*3laO&h8hDi0Ncw*8F(B1^`-l^k=Vd~e|RniafMr2(` zO*Q)Ser!>lz;}venblp1?wJN_L(=W^V5C#X2;q5xS%8a`(bb%}!-il3EqQ4l^Z7LLU5E3SM(g#VBPx zN(`mIz|3Sf@GFDRL_vm8$cGP~!Iir@bd{Aroza)|)UfGI1CoYm=;>>nXFyv%){Y3@ z-A-e27^a06;-udZnYNP{P=mgz`C7aUafYOdz{ABL`n`-)1VHsAU_r`%=o_3&imNOS7^C@!MzW$XCEksOw>HhLbQbXFOz|M+zIYhFyt0^@r|_rcB5#uv(LaQ*431Gc$Wj=vrZ+NttRl&j5FT|`+9c~b9FdhbP>m!v+=-fPUX?j5Y z7|(Mpo;<8APpG6*))sF?_$deBcpLHo1Lx6^7*jApmL+pz2u$6fFfJRo*A`#=8#nvBqf*pje1Gb?9SCgqVWPl65*% zr(Bz$n8X(kwj+AVl@(OpvT55k+`-=$*eob>IZ+H1yDr^yPj{i-fLwBEL`#S3clDACGkDtYfu-X_HZ_P zArK8B)y>rBsQY=B7Y&%XN>>u9uD4WkSsNWUh(`aobz~U>gA@H;Qe|k(6k_;&21Z8?!2V2mEyJX%aE*ZdN=G$Y_X!|9s{$Uj`(zXT ze}qjrnFhF<0Sem2HvrIO#r=*bQhX8g7Ios{Fad=wkv$7!aPjP}*3r#)wrfJ;L+Id{ zoxWIMO%!}63d30nu)fKDv#Gzx<(CdetUoy$!3k?&)(c|gp4B1!RQOp}k+#Qh1vGT# z1(0jP^m0*H=Zo#O%7&KDmh!cC=B;p8I5Wi>3RZFUd}JIU*RN^7j2l=$ROI-`o!uKP7y96P|5kDmM&B zav5;-*C^=9I-7#~{>lOJo2~weNtceem`>)x5qZQ$LDi3-v}?!x8+) z2j|(%!k+JV-KutI|DR1ki(nu&!$0sn5dT+=bV?lV$zl_32)*SOb+pAI72UMvrvPOWM$n9mH4rZ2&@Yk;v{KjhDgC|2N+v5j zgUV-lE!_qFEej?KSlQaulKcm&tE)jgI{L#igR7oG6#~M4M)`kxqZEjjZuKcsiI_~& zSWjMM3-7Mw$0wEP0s(JB_ep()Y+3_>QXPVp@p&15W3Tc|N#%uVLO<7ddez%;6Pld% zTzCG#ub3qKb!ZA^qA5>9jjd1M@PG{1_8CoVlv2l%E9=;}s^;%2ORtdiS^_O6b8q07 zcS7xk3NJdKfcX;ZJW+jDweGWCK=wxguJyzKmZb*OOK%vYEY9ahHB9|K7>etkqp{ussSZt2bt5E88AF-LCO z`6uCA=*WWZ5+KyuyehD#(iWrCMPS{xaN!`XDIItI1syvRseO=WKLbQL9S})~TsXwm z%=%l6i29J*30Pk@an0(bi~f=)0H{;E6%SQ8FMjCf*!CKW@0$kZ$WDx367@dhMV+#O zF~wNd^1(y8|481CYF9j#BqZ-JR;nP5cTc=I;nPk2Mw^7>?Lwv2cR3CO(iwuD+#X9! zl^;r2arM_^`c#Lp&hR~9>Dp)aOM%alAiAFZG*0;8iE*gM#=cd=a!vHol?sK?jO&u) z{m@yP3g+cWtjDY_nijdW*i3^!SJ2gnC+P9}Yw9BA$BJWimM3T1ie7KJ??>tenq~jL zS{6v|%cdZ8;&AV2hTEVexxZ|;|HjAI_Vid%bBySv(`rbyxI_8vIxyLR097`b^ZcU; zpZlvFWiMK%J&^9OJ79;CIL*=l?6`Uaht1?J6Aq7ZQ&~a6^sCXE1(x680;?e?YnCe1 zCz7`|2zA!QHMLp9>wzvH@#M{Z-_@-Bj6a-_3L+q>kXkHzu z6)c{8)wry3ymD{*Ur~-Fe4f+xOq&wF&B9)$Rs{r$h$57ScxIfjWeYj~99FEcGm^Af`CX1XlgI}DUAZ2D~?B+!Zt zgXnwC=8SNMAU$F{YND7bulL{y1Yl2`EJ(@AUy`5;Z)w+|EJqd*eXzhu;%*XsN+~;z)B25SyCBZ&X6|LGU;H1w)K|p|OwmoJV1;5T~Kxo)$+(tU6`uQn5oSa+>dW> zun>=0y+e4EE&*MAi2cD^f}s5c2iB=@6^!cC2AGx#1HbQFn!sao{<`~OzJer$(;(YYZ2UXAhelRqw{T`$HVpQ-~%U5RgbGf%NhS)sNGj7{_R z;zQF`HgTh5mn?Fp{uGZbKYl?z$Uj~+Km=mAWe9u5qAi09&oI#F-;8AcqK^F!*ZgTn zmt?iR1^8`I^JZk*5YBo027BcL6d_kz-mxml`bFL!G`jL z>W9F`98_V~F83+*!Kit~f0;ViT>Y*6mUO3!G3-ic&P z5v;(66i`%s^)neg4Fy`v4m|=jRq@}(XsW$mV-S6GG8uDH)A?$9Kj-3WiCc=i3K0m_Ul0(g)@=qRx<$yt0FvI1DBQlp6{HKlr$eN@g@v_CNyT`XK^z zqG5L}K|#IV%*^I@O$Lfb&y2ztK~4j}aq9QehPZ*6@~I`w3&jf5$PE|#vXW>8UG+Ti z9cj++Z3L@eQ0@i%LOInyb6iGP_woPl-wHFpjSTh(yw^tyJp%55cyw|0>B6))yhk1) z13S^l9wrL)jx++WDh{O9!u_tTn+a* zIBs{Ft{r)gN#zyw2v{Z&fz}t=uP&S)Qbk+n!e*JloH{4`8>!Fa&7b|`MA5SEky zDJ!2VyK|^)8nL6PSj>^OcsL$DUYo$1s^=0D?STLjL44N=JAUq>oKS$zuUPLHb@x?i zc8T~pZrQ6|-r?%YYxhWghob_&st_5+#azud&6*1_cOu-GWX**fz^&4NHNgz? z(&`O81E|Q{u6xg^>-M<{{^mn#>!H)MbdO$+IvV091C!So7J!5!@(`t!o8vCybT4+_ z>~Ep_{fS|Lf_Lju_1aX+_nJ{zkh1EZw09s?`@NkF#0+v8w>IZ!YT-If|b{VclAE3z}LQ=(1dXfPcVLw zLA;~+kE1V|6Br&|wJsc%vvu6Tf%-s~5FXq&bj6UM9R~CB3`xL27ic)EI5q&EzwcA$>D7d9E|11DXlQwa0WVS2xVu`RPIpQ&@W_<4+7Kd zJ+@_|Cb*q{8aU!~k3B~sG79AN)Xm+Im{J2lP&o^DNx!Q4Pk+~G z)>Y-{3it?TTFLY}K@fcp`rY1O`x(_ZhA@{41SBanTCMdI6S+7;|@~yQQ;&N4<*v_5-f}Q zGp>#%`V=A9TJ}S0&jOMl5=TYf^MUPl)8So2-iOzWN$#mP@F_tY`L2-Md0)1JcafP0 zz6uqv?IOO0w~XTra2?SaF2x2T*p7)|eq*cT?=AY{>Z#OK86G8XbI>1ugh->Cl`{+i1RDHCx!9Z(oroug z^$4W+A|)uBFr(oH`)^QmRF?HxY`j53`%k3W9%RG9Y7bo#Hr3S^2&pE%`8^zN)5D8N zlJu~e4M*aF#1@eiNM2z{(0hk2ctMm;xF;RAbN{mEaVDux7^?_{bN^e#ykF5oO1uk7 z!LaQ`J%zpRkMhIA<4nght>1Q6%&;Ch^mqFaA8lPTKsVgiVBb9;E;IyQK%I)ph#H6Z z@8<6zYp{|vVSI9<7ufRfJW@?GQ>5(yq6p4XyDw)O@-Hixw@`rm3iQp(MwJbrn?{qR zci0xA={l+@64k(wHvSTr+x~7xv$VJV5h4!sb{w8yW^R$@#r);k*%kjrBMaKzn>qmc%?6GDK)+ZBp z*SWVv?;?Lifa7`yu{6*GIfK%fo`~Y*BE)+1T|~RT8w)au6o+G`KxviD@oEL+}Abhvh-qOJPD|D~8tizhBJhfvPpjw(u+?R=>hb5VRD8$OMhj;Py zPs8tVPq8ZB=(!7OVD0(Ogps#U75dCXur00yI5ClJZ)^u0G2Ynu1E8tM){c5T;LUL8IO~50#p>_BR{SoaZ;zF35}P6G{f$F|nuRS5)PUt*Z96~o zPhj2M9q_Tr3JG}7ud}!v3GMjn-lNf6EKwJ?KuxirJkE^hDfumbn9zcOem$l{ITrDw z?+}b!r>;pHb-#X^8jm23TKut^2fo5j(8=TVbhoqX;^j`VkmxPo^^f=NS7lO!OKq%HX$AZYbzX&C^sLzoPL4)}zGF-0+ z?Z{bzv19SvCSAI$>>=TFf3+y|mgTVW=1dueIJ(XKfwvfpJ}~~)7c*rIkJl99|2U)_ zRrry|Fz`Vkcw193XQmwiSi4PM z_2WM^U=@6J$bkoT9xOWg0+4YJ(Agf{SS^CUOV&M*Jn~AxP~-eYCk9_5jzJx3t^ala zj3yAH7mR<{<|-(5Nfg6%0_}UUt#<|fV_|kT(JR{d`7rR}87T{KIBJ_N{I$T)GHb+u z-s~Z<3VHeSpVbFJ;Tw%Wf4L$7q9S$w7GP~gMlh?W8lciI#=aEnjlK9|pD`|`>?wmA z&(d)6;lg{YIAZ!6&=*a#svpNqST;Q@M09 z_g!u#cq|c~Td8&C!Sre#g!6e1Mzt1W5@lS;sLTh$I-Kr?q_l&jT{Ftk-|wST&s)6} zxfqs}-UXVddHI{>oQPyur=ios{te~&sZ_TF|-P`C`KVg`tZCg@qZ@F z0O(rRVmyihgRZ>uly{j3V5?ruyt9Nb#bRP>8eZh=2WWMAr}7Iz?PvQUAE-*egDWmo z)*K5@%L>Y%REjV+gB0}dB)H)+wa_kxEThT8gtYLTG>)5W>o{f+k3>vV?{IkM2wmWp z&N@sIhg#fDc$c)r&wOJS~+G&}6S%wggO$Dq+^{mhbkPU#8; z;HDBpTfBvf;9T_9#&$#jh5mu;SHng6zoY27L**n-?}N(Bc3~`<{;4K1(H0^=E2@gs zkMOkgkU<}eCn4-d5ciuc*7zg(tmP@YT@Xa*X&cn(?w;lOlCanG{1`nWoDqSTaMW_| z2%aMOAMhhoMW)d`?>oK0n|85YbQ=t1_To<@i0@X(suSVzpdXY0 zk1Y5ickL6QkREkXXp~N`$9Oj^gp1a)*y>!wCxvsCIU_b$BAmKFhlS`_6M*ze)X=!C zExLI~SHSHCgRlFS`|b-_f&2SA}00(mg0CMqd= zK$HF)&>|a#PSTUqGA@C3D0KvmKP}1-yhq2Tp}M=Hef@rtuqz*6W8!OcC` zWjVkPy1%Gl-SZESR4V+Q{bWXeG^XD*Lf7?7ezw-=6`nGP_@VqlP%>-(j8}>6)ZWG- z1&HSbRp#q}Y)$7Y&e~#QZ^bV!#6THG0cgNj!-eE6eL}!s{~DP=r@?}hVjlh7c+P_P zbiI0k{9Slj2vz%(9A;HC#oqmOw&tub|LL82Z=4-z8EI4=DyLo6_u2|po~^}ri` z3cbt`Mhq~4C`IMF&6F=Xo_Ry9x^4wZICI{1WEP{A1>w(W`rE;1ec&K`j0?9`aE79Z zT`RnWHtqTcw~ZGwgq!==e$XxlZ2%xnl+INFH+L=@9guVB10u{CYaDDxyjNK7cy91+gL8{#E;>lBMp#;^crV5%H;$a5nzO#k`knL$vP&8_WjWM1 zq8Y!O()8vTxc{+786YnAs{-E{OdGWD#hl0}g`5!2H$fZ}nh&3$c51drQUnp`w=qTN zHWSWcXl)`qbm;A93AFBt2$wZ_FOz*ijChKIBsO3@UHuGThMbZouJh2(NbPSgJf>o><)8t(*cScVSRmc0#HKI?@-)QiKqoaC%I{E&ubRdt|5@RfwkIT#?u7+{N# zhZj|%Xs$+7Ju~uzIovSrQ}D?Xa6sl0><5d#bGH_Zz<0zQ2v6dLJ>`m$dm61hYv}OU z=Rj8A$%Vo45Rttk?s?tFo_629Iw*1fqfi&HFOtBzl|d>_I&gfkPTGwDEEVZ!i6cO$ zCC2(Vdk&tL4Ab9C;PD{>zw106@sf6g>?ATNtW9J`!i^7m92{y*!c((`#2PdG&jeBN z=g-KuXqIDb=w;<(1(9pVvJZWIr(;IRUc;fmKTX-;{dF)2)dop01d1eAi*I|1J7h_M z1&}*oo*KKH-mMY+YAh2nxwMxR0r$KcWIl%j^x(&fZF!O)q=D&r)jVP8P#6Y|r@jnO zB7S1ClJOGlRj^(r0W}RpVPA0$ZSSC$fnqGVFMZ0}6cyw8R&i{9!dyx%d=--9IR^Ry& zB0@R7}^42GnDZMx~Q`RR`9 zZ;Fa7uytuQcW};mz^%ZV3y3dJ;?aWlH}U;JUlOR&QwJX5xCc_It0!=Dak7FMGclYP zme8O1r>@Vdifqx+7XNzb_fH^+87h%s^zLT@@YKoxtsh-z!SbO-! zS`x24kCt?2f!369zAi+1wFvU{0ImWohxAR@8RxTH!;s-kO^OVb_OECZtNkv;8a7CC{3zj3xm45eUm+;{1NJQf}^ZlKPpy01g0DCK_5*+Hg+@iUAh_fhH#8H|1RWW4$| zXDe;a@P`>u@#v*?`=nqJJz*UoAuGbzyLlpMKeWLfF%6tbj(F&YJx>7lC0+JEE-4`D z9s`!^ur3js>Iy8DeRHA%?qZBhA3MQ;PwD5JrB35~sN;aX8Du^qR zfcwJlJ$I25T?JM}*HUX#;{%ta`W2L1GG>1eY1a0edzUm}`$d$^#jR#9e>6D) z&NT>bXt#I-di+}CLegR7T&EwLR3Yhw9rJ#0XT#*(?}Ni)2g7J@Dp+#gkhNG>M^o{W zp%Pc7fL!>38nh87f{RJ)46*W}+$P13#YMlhh@DD=pDS45A(^bks|-&rgki`7!rh8@ z8SFR22n{K0Tp*Mw3mK6W1+rA^s)f;YiTh23@_EnM3p)|^q6*t7`PxA##SNZ~ZO?Sl zLs;wO?uFnl^E2nmf;ZY7G$O^Ymr5pyI&fu}l8RFB}r-}Mk?FgC!* zIjU{D8sCtI=SGRpTtxLfbY|vpoE_1O!AaV9#^oeL!6xoiR121}!W>N$llF`GLr`Mn_J}T|9?5HIR9x!?Zt!7h z+`fG){G#HK=)WaF*o>H6@|ClOCmF$fzz#w4#+%@>ep1nB3b3H$zlqdk9OLrPOXCB+ z!j<%-II0#qz_EC0nMn2yObROzO}&N`c+8ElUT*<_U}b1aGn~q|ISt`#bbMY+et`9T zO|goEWw@m;W3!c5CV()n(jyWzgfCm*m0q^QeI5CE)XwExNs*QdDSr!r-E2%X^2J!p zY$xcjth5#-)PI3S&SQUM5jM^;ejYpEo~EEJuDFPsb0!HyhgwUxTzEf}B6lBCPs5hT zEc4|SIWz*)bef-y6fA%(4#qkGd3bvEVmLu>=gqB(0no8JwZ#2Zd6QrYxR4+tj2)t2=IiS+0Aw{B*r^9HH#!%lljTYjB z_6@gxCRU>u`hc|%%2!bW&N6dk3_=0qAu;Psy@M`z5jHE=Oe&D>_?8qc+@Kpq=^Mip z7!aakpXVuu`+;zJV*H;jAG{o@aUs2wPu`V%R%r2f!n~Nr4)KF;)D;=^>148c3IML# zX+B%1$oN@XC34*izy^&gMsI&6by4<%WQqA!*z`7EQz088mODeq}1-@0d2@ zL^sG<`++Vfb|~7j$Y*qSN-LUn4Ujd63k;KrF={>q{%P5$LjK3_Y%?X!O=#8UiTG&JlB?bNT@I|4sU7c6>S)P6M!ssK-inEUJ`LjY9&1P*{wV9{Dr&P86 zYhn@njkwNw#adIDM0TTqIJ_-lio^mi4;UE<+$RHUU~lj zaA(cijlaAJr=}K)x@w6(814Uug7yB0$JJNUjDwyrzM}4&DS^S$a zf55ri$yo@8wR;u)a#{Fk8z7f24y^dgOMIhKaYZppzDDcadXxiD!M+yJXc}6}5I+IUdH=`YDsjAPx#G20G3+17&ZxEFpy1X-O zj?6dpBQ`5?0T4QFFfNzFixrGhJm{JS54~f`E!K;m@|PMR z`GT?wuuILbZGm$(w}6mvZHkjct$AnWL2cZMLk+p^k-ZAAtiXqGpW(y7TiiqA_`iAh z2H4Twg#L}2FIE)(L(EA5u#R-_&Q~ZdMev~+!u{lHi!+5FNcZKBkO~Gq?NDUW@PG1> z49L(+(6o;Ev_lRwco2(_rP=&Q?)yi$4%-y>4mS|ZaHr~cP4fA-MfBZtKhVmkB@N}j zaE)z}zhyd!j&LGs(UBazc{}bGw07w{nS>lkvXkz}xCiZ_b3LBNX}* z1XhpDp6uv49r%nkR@W}8v2fxEKnBvSz&qPG$h_TgU_w0o=zRuyJFf&6=QZ!hQvOInN< zcgQ;!(~EEc5gc-<7UAE=-tndhyod1|SEcjmnTe3U`E=Y5%jgmgBCqqb4jJz%4?G2N za@}f*H-(?h+iYT}Qmj}5N9`e#E4BB=jzgeV`c~P^!-;Th5abrqL&br|h<)h%|65!A z4UO04#^F*nDu;RQvpyVaVZa-g>xR>}irh;Wc5+qi+; zv#)}n*U|>NQA6%{u!9a(p;t&HXb0?`F4q`wVi?Tj|5hJ2(I!<@_2~aeU^iHv~jF{Tegy)aJwvh0J_fp2Y zID5wMbgqO|W^%0t(-fu03PmGFG{irO;`UDP;2=D+HB#ME2q+VS_?-|hEr9lQL6Om~f!Yh=b?ssaPv zSp2G>(g(?1sA~+4<0c6C7v;Uq@@^F&Ug8iR$YB)TLd4;)M07P$%D#B~7E=kvB$N+RMvi!8K?Q+VTo?^MK$QK0+HwUg z`r9ZH8$**<$i#pb{4>f>s%jZp23_5JJ8}b;X){ywsH_b6B(je9aMWpK0)?C6eMd_O zh>;S^7t@h=~yT z0;|{xhk&;29WQT=NBHQ+hT0*zgCD5s4Y1=n@Pp_&Z>H}fftj6h839P)5%wfX2UI!1 zQW1);!+h(pR^j86hr}?(@Vq7Ci6J)B1ADO28HTgfH(iN|>jS zg?ni^hey~iwu4DIC}?@zg$sk{y#0`|4H!u^mnAER7U2m)qxgo~mhqiQhKneny$oqjQWGYX=xAuJ-xl)n+S z;*vCYfkC|x0OB+B7eC}SfX7{K85bJOf5}3OU4H@LF)b>EYmJ)cSt!6UTO}E=WxJ>! z!7Rvkkek+^pS(YAfhP_bj8#CnzbrD{@mFI!EjYU@9H|7StFKW+Ugr;e{}aO>QP7XW z7((P}lzuFk?rhZUUq9G=eiElC-{J~B0z7~)icvPEYKW0Z0fAhN`4N^82qUl$>g z=!ea7jcSPYn8^r2#7}s>m{E|kafFP+raz{PL=aZ8*>xMik;E_-! zC!it%R_-J+AKfW-_JX^GtdkfpOGLOb_XZZunwY#$s|CG(e;3e&=T zh2P7BBU~x$Nl636=_hEPr)I4uI_C420S<6hpava6*^LvmouHL|nD( z6T9odcEjJ`Wlx6DR(Tn1LocK$_F%Fq5W67CsK(w&{qup?ec^3yqFL=rS@IPnz8y|Y z9H)l~4iPqPu;QS&VrbAtS`KDYj^r3t-P~ zUF~iO>VYhJEJ6J+O0qNaUcsBn9{J-DcTYTu;Obr)@qP9R13lzEXPfpi2yZweZy_u% z)PmEX|D}SS(HA=e5~JHshRF%U|H4?~-{%Flm+l;U6mK0efrZqU&56{8%i%63m&b{r z@Xkbqb7JX)KdAbH8^G`Ul!z3-zQ44q+1|@LJB?kGa{s_5kc19zJVbd0Wy^Q(*vHwr!_oV}|Cxd_*xntIE*wgl_d5`=f~xq(VEcxOKdPt6wr z@i9>lA$eQFAB`=4frH9tY!$+>sZWFSW3piJ>SkO)qQe=V8BNDhlBYi-GnZfxt>{6q zm51~Z`nLmJgP!=51&Y*Q;u_pR5nT^tezJk+P?Nyx4t;lBQ{`a%Vo96qiVvk}kQC`dA1xH5`6{2)a#k9?=3||;S zbbuWXic1SrmigR66KClD0WEb$yo!>KKWps_Dc@nVEEp%I+m&G~&fCu4-Tc2)K{d@w%>pLn zw4HTvk54G7&(DX?7vxUlhMyNS>;dW`W8M87q)*wGI5UDcVOXHr+xqR^6d&Bcg4g2V zyI~8uVjkzZ>i$8%>B}LWeyL_LRV}thto8q9kQ9pw+Fw{F$=H4x#yoQ`q2N0-{J z(S{vdxGD8Rtq0l^Amhkv6x@L9L)*l7#e{-(=pz&efLa5W!LQ2$0u|Ckz@h|$CDp@s+AV5 z2Z`=@FH*!Q4=cnSxcQ&gT*%f%lb(UY-k@~@hN19z6efog7SX&6;9Ko5gwTz>KAalU zV~)uOX}(v}&EhKeVX`C~&k;nuUcw{zCv^mnUTzOBVPI7KvmM`WuF@ku(SwdV14MhA zdJkmks7VKk5a|C{tBfkJWXJXvN6a#8S9GNvs0|F9llx~lv&nxk_J(G+v>VX;51{X+ z%HOr$k_Q50uFD=Dy__9*NPMhkCkaabl_GtcaK%$p(qfG&?$@u%Y1Jo`a|gP2x$?ox zZL%E={C|oT&6d^woOFZ>1@vfa8hHHh#nVQ9YVQjQ!TI=`z!|E~n33x&m{VqYJ|q5U z&spfy3bW_n-}B$5*TuRFQR54^7{PWYig1Vx`PO!%1kIUnTjnBry#=(Pnkvi8r3uMt z4fr{GaDvgz-aK;k7f)(PjZI?5_Z%#JS76CrS*wzRx=Qf|#hosOLzh%?s_rItfOJlLct;A` zst1O+siPsb-e9yzOI6em$uaslwLKELNWiW^N1OH z!XLgP23`6~SIt3qge`t%(RZgrc!IjCDEhGn9;DlR_H(E;Fj@4Gy%O$S!9nWc`>{3w zHs0Xb=i4z43O#BXs#NU>iNM}V?03*K0Qq3Zk<}yG0*O-$!X=}%Wms}~Sj@V8`d{ME zdw;HUG+&%1-2XA~qP*3h&tEj)ly@(HmvK0(isWZ^ zf3PNwQu^fwk1{1U{{IIwdV-9XHw7!0I>0WVw=PI@4GW3s>Ni9i76_f&=nCvX%kLE- zpRt8Arzmm-)-{6TZq(w-f|oy5Fk*Z}^FNnqjUHz%B?e4WXAW85CLD>erMqk8UUlLv zq!F)A@&2q`(H0@yn=)PLpJqr4jZtOE)g63MHZ9lf2gG;AVm^g8piWWvWHdXB>ZVXR z?d(@ivKRz~5aR69w?y=;F!bpPG=lm| zJ~ka0r(qu;W6KCS7Jd-yoNr@J`l$p(Ng`shc1;HJy2p7Q@1H5(@`J7OO9kQX!;9D7 z1Ko+CEF%?rnl?)Ovo63hT;vE6s)cpuQt~e{U$GgHfL1stlujVa%Kz0TuU&5^_6H~8 zf+pbsd9;lEyGYwb&K`ciT5lFVo5afBqcc9==}jMGZ7R59{|3J}RAEYr|9lEiz^Nr~ zvI!T)!#Gs~Z=U$0Ir{BB#BuD}0pi}0v=PK%DA#$|ttTU9R-!jwf5um?IzFhKT%O#4V31~HumO}KHmCeoCYAxgMf!`vd++hF1L>(QvuNhDt0e28% zOQE^qcCbShGAZEc1#o{BOfcLZ+Um`xe&82aNGCB0Pd7tAo!IQ-<-!h zF~z|ANz#Olo0e(4Ou^YQZE5-_ktJF~G0ZuBM7ckxqUPjMRkf*Z3rVAJW zSrJ>A))hvMlka}9vb<)p`#wvVn}P+q7gcbx6&DEE1o#4IB(wPdPqxHQZOE6105*h49Y9# z_|!=zp+htXBSrG-rOy1%nO4gxF!#(DOVQwFUdxzshBn8$S}c0*6MY(GQ-MHbIV4#@%NS@o__3I$RJ6&SRW zXGKBda5N8>ym0Ib4XArn2E$OH(Td@!3%x3i0P>)S3g&y4Af~xKX{@lezqt8kdQ?EO zjD2L7CGTO;UIasmQCBy^#S1@YP-hVY+JDf^%=rd?hBQpVM5r!Iod%-H!DLM5a7x+; zn?xk0yM&u#^a@0NkDHV7|WDH8BI7LR7@oPP%z7( zjY2lfEQzW9m(g|64izN$wv8w4Mv0*xGwwBY{AI*&Mw51*=6(&zwhaPxq+XRB(sR|b zd-9F0m?O3_2k02R5P%|`Nzn6Q0{=Wx3V*4cuZ>|+>zeMA!MY^$wLn_*a%t-AJ$%tN zNsOsk^(Iv;>;i*qG)Ab1R6U2nVUMe{92*0d}{)A^Bm9_RW}52*D&! z(GCihtqRc@vy4|18+c(pJaE5{nw6@7Db|dD!5Sa2H#nnvZ4;Ho(36Bg)&!6UF*7vu zQMMeJuMxCB%5eMNSwN>Q)uWL^WPTE!Qh2W+FY z@?jeuepo~U@VU}6L)Bz$yQm-mo{udvXhJpd3n7+c#uQDiYC+Hb6QIxW{|s(l9&CD3 zQnxRk2?-&ID!~wi?)e~nr3wsvR9P{+ZPO?ivVm+V+XlwzLp3&H5SM8_Th+Z1a{t#r z)T>$4*6P7DCN@8mc7yBw=v`Zv(Y!4w6>+ih1sPjnz&9Pj?#8YGr3hV`nOL)tG?cOm z#-$vYUE(9A-VAr2`m;hRCBfyacFezEOfYoveP!Iap~CH_GXzOSut3Q@Y*F7UcPAJ1 znm4Ryove*@-{5Nx6xiTL*4u4|s5>O8GL>ep_~5`Ust%~KwKDO#0$YbpVg!Sck6?q) zE2?qK?%?*q6hx;969BsN0C)UOwU+V>j==K)chd4$6>EM|R~~mCY8GR%DZ8VxJPi4Y z|3t9oUCiwV9spPk_(-mZyf%+M@WfJjE}js2tJcIe11OAnI62VyP7;eue>ijybvtG) zEy<+c6l(v0?5JD9C7?j#EyQS;q;W0V%A8~!p)0Sp;>YDZv)6~ZP@@hj==WJS5Xl0U zcG+J~oXrF3Js_#R*Oa_q+A+)AEEye_G{=5%e*?#avKqFAa)01Ahw}*iwCxD~l+oSHtWIMWvQ$?g>2)qa>r!J!}#RiHnsdC`}#5uOO8ud+T@a z(+TB&U#O#69`$rM2=(xN8>cZvRzhK{c^JPTw(mv6tsflV{Y}ywte@DAzvs4s)Dc3{ zstb4m&@Cd`!8onac1*skc_zMe7ng~-&+TcchIAq-m6Utv%vvR|S^#Xl)~W<3zRPHr zI*&KWP2?mQnE8FY4DR^z`hVPL-PB+_mXD8c8*+*q`S}k6MhecPBO6kc^=H14abD8{2V`o-2^`7r8sONIXw=(919T~D^OE2!v z^OT*ZMtG{ZASktb2bFfs#!qZ+^N$t-=&=$XAx7$c8512rj(?I1x%P?LA7{ zkq{TZW^^N{v<-3x&BK8$*Bo$2RA_B@f&hgzfEwvAOAY6C#rlr~YgE7SluLBGd{8EUCqc%}S_lsKL6~Y_d_+fR5yYB}#%R{~ptdla7 z_BaFHM|t~+eMsguLFSxTQ4K+>@Ct@MW8L@*Z^MX6zocZ+AU?s+TI=3-V%*hyB|eiJ zzZ&pyLcetdkdLolhIx2WZG-1H^z^nYUpyDCPg4$`($p=?P=ghh*N>sxf)^Qq(uYhp z%x=c+391>lQ66lS#x%Q;PitrHi@?Aeu4fuWxLWnAD=R0^R1-xoIUuWbFM$<7$878w zV1ag_iz(X-Wt=JkYTVFa1P^6OS7*Udp@ubof6EEeCEbpFDi}kcC*d0h6V2uC%kaY> zo1}&eJ7Bb*q13w#6yVZzgMEfxKLf|dGkS`;kQlWuCxILl^glSH2C7l<5{twU`tDeE z;#3VqeCdZfli+EVBf`>S88sB-K&*7xD-JY|Xw`su34Hy0!wGq^xGTmL>#`9haYrM9 z(hYs;HLD&CVNVgI;YBz1k2{Jwx1(l$coe{#dI>rf@4qcQ#RhQHoH}< zijL5Qp%{=~j0wFff&vf^xquD(s71veQP>(yNw;>?3QLI^ew z0bk~7iNJ2F4KL7bT{x~X_|(YksKt#54aolm0a%?A9Ue8z&A}TEh-(Id7eLP_JD$=J z(YhUPxTYRJ#%)`7Ds#C^KQNX{;K4=YV~_K5Y8C}z#c9v%(Bmv2h)zLKcIr&T%Che+ z#?jPS223m+QSiGbfVZ@*!;fm=v{Txb5F^!yFoFMiua)<`h;>hoJyWTN6xwT7SHiq^ z{@Fd1b|M32#P*Ja$?Qn3vK-w-M1l1^{sx{yW9zKLh^)Sx#D0Sg(ozEBC+Zk66K^X* z2?(EY3`ul{O`&4gr4(ozIYzPgV}O62hABy~cLO$R){zZne86d6pJ_89J^6@nylrSzin6%wNQ^x|WGBcLsa*>8QrnkRg_ypWMzLK`OpRsVzah{~z=+8SDz zHPWJXqSj|b2l&r>4J^VYr;sNxe%!8G=(D$AH+)OKqZrId{n9R$cVev^JGWPITr{ot z!9iT$A4;gmn?A*T-1w^#g1<#r;C0-bIzLm39w}!E5Z%w-PP80036If6F30i~9po^l zBRA%Se;bhYW0i!d3!u^XjLZ%9{f-zPEdhO>4@w-}+%vFA14Bf?;M}tFJ4B)0Ea;vn zzosb1%cCT#QVoVMYL$ttIET`2!U+in0k+I1JhFQaSo>&qL$)Ei1AoDzlwdI`6dg|< z2AA^Vk|)Gv@pxXU;4^(Q5T?Tb+0!MAaREb&ZXNl4@lq13x;u@I%+Cz^pk#*G4@~}2 z5(szB?}zeXAIYKElsa)ZOlE61omJqkg+PmpvsOIIZ^H|d3k5L$RAvxn-MhMBSEX`yfUQ> z$^z>yeG3pZHwWtj(`p_wNz0h;If9m-F_?!rA^!J|T!=Rgz0(-{+c+nj zU~czS`laD_-(avoDM zhLD&F{yy!^?2b(gFDs}e9)$^TtUAzd(G%g&n_338%Ll8w*uW5-R|u%T4JughUGyg4 z>IadUNUmpYyfLEZJA+kR8&3iE1w?ji4lexw|)?SqKTqEReFkm=o+iczpf z!}RGrW6yFOM*6`M+WfRX7*GDnxBvF%>w5f2ph3^r)1>1+?hV zKRO`Ys}~pGKaf^1G`I}__&#~~Q)*tB#lm2#)z2|v==aodPAw{q|6yquIpOqgPX{pT zuW0SA4ameJun~yd9&^Jm9G3X|G@bEX>o+QtSjb>+eQR$SN7B@0WyKb8>$;){x#P2G zTG9_x*uX;wyiOBE%2f^U%#A z*D)+FX!he)v#_XGMGKm+bY!iMPa5q^nhU-NT4g|@3uOm#1UZJi#bP)wf6flUy*e`bicvQQ08+RK%HK|g@d;kgxVNr+5-6<9;xV}H~?bo|H zt5k44Aya^LD~~sC$-7C;65@nh8wT;s7i+^w80SQA-g(tB$VOS=k;2#K-I^Mef@T=- zBhnkq?~+FJdignpYc-cQvO7Vwlv*Qr;P!Xh{sb6hv3pw%k3aU#XG*3{*kxnLLWL0(tV6pa=Nhfps9uT0Eu61RxpTvh5F_+4Dji9Eg} zM<0@G6lQ_EHvcVj{;R%I?zn67w9aZoWLW9jf}%7Kq7X(M-R{gth9c&H2se|+U`0C~ z%7EvmtHgK&-_qf3VH`S(=GGPKEi9h4aQq4uR-sYLCSh(8wj%$ zDEMvn2nT!Bn1MS|qpDajC4uFtSA8#LhUm}@~1A-WD8|`Mj?8(9WcQ%Xd zF%uZ08;S0`?@#}jOnh0WM_$u>`hek2L@tP{?@uJ`XL^g_ePx4CeOS?t`&E9H1?T{d zE=z|qAYEHm){cNcZQ9T;(HDHsbTdR1E>+r+$$q)7)kb$<3S%sBP?I{O#O<)dQWht$ zCR=(lA%P%pmtv}Vh1U;c<`OyRKG0g2Ob4Ng+U-b_rwu2iriB(fh5D|ZseYKC`e&WW zlU_pd1g+0d5fUM&Vd!%FK9F7!0&Dyk?#;Ff&ieiMk#3(9Kkjn`tZD(ux?U<2QipUd zg(h$#hA*?~H*fbLFTiluASH%K_V2;o?Uo!fAx%PxdJ$SM&t%vFQW4~|pIl%ClhUF_ zNVqYN(_KP@g|%q*2l@=y?3y7%{~c8u!u~jXn7`BwM-GQ^S=%4gEkAf{;sfdCWwicC zFH@DG*DoBkd%q;$nc3;v41r)h;^nn~8$bq0&Bn9lqaqzaYSUa2pqvhG91pCB<(T+v_Kd|)|kX{_aU`r*6Hf5Rlz_@+_kw$KB zx4$i{9mymb*yD0kbkyDN6Cgg&qSP04_IXY&vqO#hM9Qy4ukyuE`e zjh-XXKSL=I=LrJ(o$RltR&p{6O`suPNGjWGb;J01a%4ivVH7i{;EEFaFhem-rM&fo z#$=bL*#9^2R$^x`76T#>NAWJ)4*kJO=Iwy-zMX3XO$0v0)?ocPo59%uV9ZT>fzg%; z^D1oC&Wx|ipDZ_NH1dPZ#2k)^iWvLM)o<@`qslNzho6^^B!8(rZ?-CQk z^YJs8>B!bTEunOxJ_m+@IDqE!X``%K0>R*@*B8XK`lcAg(=o7tE*CFH(&W*MAd4Tr z=TQZSw;n`(JpLJfE8lc7V~t+-c^@&oHv=*yDC+$@juNIH_n6K+JiC2TdUS+s7YA~^ zOW4dsJOutp<~kFov0%x6r|0TjzQftpgZ{W$^)K7_ zTzm_k#z>m8LE5|yza_F2lw(KWtT6M4A-?6vUW%Ys@ER*+MiY`@eo)_Wt|U5%a5AKB zWtRfs%T4bGi_#$>#&-KmG%O9^Lrs&8HTqMaqtC+=2L41Z1B`T(x>GqfeZ=s6Sa#bKdzbOgrfRajWyx+-9B1sFdo{P6c7rmygESKZC?B=(@B$E8Y9X zrgxb`*&nVcafqn=l)^-j7eN_qTB9M78Vf7;wf6f2c2|IE+;wQhiWLbZ4_IEf3OA*R z+9eHr@%V^8l`~Kkw;>F4(5M%>ZUp!jfRAsjQz*%ylUIa<95bx}PHG>q)FR6U77dD~ zpRoJ`j_2nfEM&$(2Nh929GdiB#2#AS55%ZzGg&;@+`(gB6pMo_81<+J49;j?Fyka> za~uJ1zUqn4JzQZ!m!~_r=eM?P!Yx*?US;?cK{Z@2YKEYr4dw=Tqt%tW{_!|^8&lCs zPmFA{A~cSA63Z(6^_*NN@3oRkSFI!wb9D(HQJ1A$+!b z(eH_fJ~uU^N^R5nhDg>w@W#lGI8ZARDk4Jr=N|KH#)SqZ#CA2y1c;EMH30==Zhx!4 z20c!+uRO}*`}Wibto88Ej-a_-Nvnow@xkrmljg3GsnZJF3E|PM z#4iuVBA0-!M0LcNm}6KA`gJCvIC!1M#WNxV8`+tSo$&sxs1%=I=Q=<*m?ZlC9KobG z)#-)b5K0c-7Q-$s8^6H}+*C#TPJ96GTXSRIw?K;wW>ZBXH>5K=cGyJ0GIOY$vXy{v zM1HBgN-T?{mO|isHZvgz)Rb6cY`$W_M{TBh7SLc>yB_H4;t(`5T@Km2|!`m z=&d;oY(-wcOqK{MB9t(WGk#LwNFtZi4<9AbVH@q^JC3+c1lT2x zCr=I91S}0$HSg93kV?dMM6qHUsDPN}0DG(WhI?@|(u9Oa&kW{LI)Vj<%-*rvS%cw2 zzPItX;e)aC7~TG|0wuj#cuEEd)dNOOC@z=CE74z6K5{*=Ft3;m57Be;qo{P}+-yA_ z#QR}?EBaGLXM@zC&$5Aw&mWk(%-4;|MTvrd7f$-PL|4*bTjf?%| z5z1`c#6N(TD=sGUq~C+q<;GBHZ+2KxZj>1I+XUI8KyK~`O8iy3_Ph}K5z`5aHXjV!-SqiUG;@GRfNDGdSUB~(ktrz=;x^i=gyyB*y zfrT;r!9IBh@HK-No|>}gVJUt-+<|NOP7vedpNC`1H9r0^!2+OYy7XCio0J+^sU3}l zQL9v|pfbe1v(%VVPoKQAO34)eb!d)NuES z@k>xFovNGyyUD&7`vX4^TL@d`mJ;PROf+cD;U;2ivhsv?84GO#I?LF$Vi$*IQH&J= zmQ`-=(pSrvBlF3%eT&h>eWT!b9_rjpX8Te!QQ{uNwKv3qC|d)6pxsu53k>q`qXEI@CG$?!CD(W8muM1!VncA&d>~yGj6UR z(ulmu13B=-rCWUUd%Qgv*JrQqhw7jlF&Y?9Sb9@W9cI{sE{cbBFUIB{hC<&<0(jCWT=^+GW9N5 z%IR$!B87A!350KRQ8yCo5|ajD6JNYjEZC{zi?^~Y&K4wZNDN#TaOMs{T|;2bdvqKD zM)Wvyuv;(D+EWEPyurMy`tnTN!Vo_1pr!_GZR)CQ|iLXn;W7C1|ytt7#XZw zg5hA{Eaneb!(IfagR)&MLrCeWc!yjwVb8JLp5MoRfWHhVvdW%Y@n~2#Ah+A7l?Eo- zj6mE>n=T_%x&w2-l!6mZWyMzN8e@DXb13*c;Sh70MVDX_40p3{`cJy&62o980h`ok zy){&?xN?aIF72ozB|Bqz9YVRgkEY_p zxZaWbw$5#NMw4X*r#kaVxq%7^&~%;$b|h3A7DI}GCOu0J8|l8c#@XAhoi)n$JcZpl zUM)E0v$2e)y?X%(+*V~}Hrcc64%a{&jgy|fM~|-6QuXiImZ(;OA-zoRf=j`~5Jt?j z7H43t5|HM?6A!|^7N=(LI>_}a#iRBJ4`0o|Hfr+8PTHkOM=A6|e=eu3x@L?ywI+-A zX$M{67tG(GGQ^onJjn?d?DlPmCwscs4u1R>E1UTEtck5m;96_!ut{^>n59#8%2+mc zLV=pWy=j$-j?%Lq9)M2+g|ggSj;>#?Sa#AX-y6WWWeJ7L!$PpLycy23+5* z>DlBXsb?;H=VnI*eS}c9_ePw)tV@la`UNOL^#Bc%K^g(^5vn0g>j z?j0US-*!4P+R?j^e%FX4gmmua`RY5ePdm=+qv*lh3+$nAv02!p_%UGD#sf2f*TnK| zhk0h6_+Quj*pGmt2#0=vcf;H$VOZURjIfY9Ln@cuX+=6#!N;rl1^~E<9ffFb93{~_ zEdgEYwZxj+18q>LL9L)BIR*m6oIryb)|9j=aR1M$4)9C0MzUsB1qN3Q&#ln%;D$3b zur|$spBWQ4gFi16$F++H!}`k1nlam_lg-FR$PDPY*oI0@@SFHVkH!TbvrHiAQ3jk; zLZK6?4wH$xH>+Hrq69t{1T4?q0c%3vDa&jT75IjNfQ-WBQn5xC2B;#I7L;n-{x z$Lw~iLy)qhbTgx_lGoAk9V&f^;+`NHAV2GV=`E}x&+pUar`=306@(Bq0)D>0OwkZt zve0jU*#~t-g^t43CnUUYQV&VT=#&;QD09!(wRFi3#VT*=nzJZ`ciTOv2k(AN%K^4< zuY4+j?;dr=#Vxj#`mj_6)vo7Pc|* zCGUe5JcYeAt~$;h4yfQzG&|WUe}>=d*93oMJ;RO4{x}P9&{v78p70s(Z8Pl~ zRTrjGmwG&VVYL;lc$hQWQxHYLaFFb>caRZiYr9a@e^(gcxP0_g2G^6$igI+gaI$$` z1ny0|O?r`gK+=>dis9arZWx!iMym%9Rc(gz74dv+0eQzpsn*fDbQM!vRp9%6&^c;p zcfoGF&`nj5w+U(TcR9u%ROEIb*K89p=7}*c11fb%gnm z=F>#p_qkeTtYih%?{BD>~L?|6sdo`OA0r zdfs&gNPwG*8XVEE9wwXGWWPZDUp_2&L_lhMaYRC9eH-v&d~jP2)gkHf1=ptlwf}F* zEX<~+2!+eUQ7M`>$3ECx-{^}%u!m2cZj$qWzW%}}zuDhkQrVDSJ&ffbtG^xb@s1gF z12<|Kmqe<-^~eXFcIEEVoZDn%&EUGt_vAm1kjHUOVZ^c05MP?}UYI7+G!#=RV*KNq z`VUpxmPJi*3N0^eD(+q7t@Z@4V|ood&du-WFr-}4 zmxy=*tIBIPpTUj840?NK+hDmIJ%V4}2&s=Ck63i8AcL`ZZ-BevVsYDHo2A`%Hw7AF zDt1&qR*_%}Y9N1OYQwT>U{aSEVuyL(4qSS1v_+76=9n%Wwu<;<_4(p#mIFoFF1bW; ziX+@c{Y8_8A39Ls?Fx24XpZ63shXJvy1-OXA)`1gG|5i|U8y)DeuhI+Aiz1L48y*i z`FqTeaIUKy;WhOLMqQJ;!GE2`cxYNxa4e(pT`AlxQ ze5fHqUQjf@j2-Ld8jn&AS}@Im4savY{ecLL`A=yqDvAmu8Q5{9vDgq5P?^K=AJ-k{ ziP6;G|KN3}nhunXG<`JlqAxAlL(DQ^`u6o1+GkHCX32)6{2^j6owY(Z(8Qv4XlZb@ zTh>e-G{1VI?4y<&|98|gw@)=mqC0SnPOR!KLK3D%?|={YDp#~=0@KRILZ^zh{kzV-t_!8dlpQ_awtRxh4q!b1CCrWPa5MIlwd&^`$@GKYNn6=Y+`m7%Tfx z&Pb~@7$%FG_o+J&f&Ux}(bEdY(<%eY(GIvPZv*Yw-G_QZV+;^SW;-xa4}nnJMrRi` z@7?(n(o=gw2jFNiX#L|6Xzm3?7qMg&_YtFhyH-1rpzE6d4aE?{Oc`^VqWtkFz{~E7 zbDby&*(w@2gbuOiBWxv?Ks9bu6nyMTd`%;Qk%^Dz{RvU@$QJM#hOqay4_!i|@%ExI zS^0@pXrOWXdNpBxfmAjQZE{~^b2!1(1w$y)f=d)afHC{j8{*j%p)rkyII|M|VU8yE zw!G`8lJc?%L^(6r&6Z<4#ju!N7(lEea*E%X>x8rL(rB9arQeHvX{98G${gTTh)23d{*Sc*&;QQTq<{oC* z-+EX!4Fm#obB;Xv#_zIk4bY&S1u$O75wXkY+_nyIUH3_qJ07Tj_f=7G1Q`=t$9tzv z<|3(g`c;QGJLjckv6VNx%3j3f4k)5z4MUnH1Z7j32FJc_8jLTp18`r^HIUOvyNGR& z2c_WPM@djwNY;KRrRK_Wjx8Ps7sae9OmpyF+iZ=O{+7#2EEA!|(Bv*e^v4XgsB0BDl@zCWdR@Oz)veFy!b^ymmb=`_KC8*ZkP!EkMlU{ z8~8y1E#80355ZkVIUuT?5HH`cjG+jD@Gpdv;zt32CV3-; z0$q4c3bb674adD~BD@U{fIR{5B496rO%a0;*b-JKe4n>5SaV$b%3%MfzW9^Z(o!L? zwhfP1yR0_0BQ-CIUCSRWKPAPEp0;dmS6n*yGSQvj?8a3gp~FHutC{I zXXmsj8HK%LR4*dE$_szwNgOB)eg3Fh^da4%87)R@(zZDU^1|Vz#F91f6}K4pE}+Zl zPZ!wAdxMc zev%B1&0o%N)EeV*HiPTnG1p}$xxg z`wZ{Kq&L^8*ZC2m-AF|oosSr7?WWP1H<|kM<}o6J2lz*;ohZO2CGr^46^~JPz>ke( zO@;Em`mkYoq*RqV4wuF-z>OI|mysB^Mxz}XN* zL@N2*Owd5g=wm`)K#VwFPW&T$C?NOL&P^)8)mngs<)YZ)Lp*DY*ZOu60ZHGN<#{mQCVrEwhjRnA{S%y3JOkiYd76b%~+LVHm3kx z(j_T15d4E3Ch@`~8;HQpF<}MX!pk;*PL4*;gJ@OyG#$54=^uP60_ zj8YFxv2%U;blF3)PjC8ms=-#Y_eF-|;N?x=HxWUfbb2*(x1$>Jm1_E=U;O*p?>WIQ zld$5p&{u0gF5;%4IPHTpw+RVruNEctoBVBxp)A=Gc6^QhYMNss98H%48PXJRh1>v} zzXZMvL*u@$c@-zonYJTCb`%0TiQxNG%7y<$CD!L1_Bg^PDtL7nLv=^z_?n%8-$HqZ}C_BVzqAQZC% zd$H0lQOO-ZoGJe4ApR ziRuoRBTHk-ylxg1QY`q?P5a$LEPrpv6ot}APspIJx99KLE|ty5e%@A(MUx11K~K*t zX0ylQL1GuIm09L)%oqy9Lj>=0^iLV-+b$uPK_I>4|J9V(QJd3z>9>GSE2Ji$pz$ar z9d#~cfrPhh=ri@hpu`wxA_>WTPR@2VreSC8a`~Agz1&OfdxLga3h}iz zK=jal?8=J1{D^_t6b&SaJ}c_@+KFrmVk3c*PV_cmVNf+id2MXLBShEvK zUehEpX6qS6yWDOdTSZ%jc!Xpern0z*>7mIES`tzy+u+vc##WD$>YuAw-IitSG+<*O zU81&bcmUpS$npG(n8aTnh9S8VSsQV+l&J(@UGy45>6CfPYdP+Mnd~>WDa&)P4~F5K5B?C!sZPxur?ll4QjDi?^|()rbNJ9f&$2Zh&w&N;J!K(=zN*dI7<%2(HpSULQpF5D*KBi?IzmZ1WVrp zHCmgrs9zJe`H5wHQo8~&-&71i9g(%@+Lyxek_zy{ppYkuu!vvS>1H*Uwrj^P9&l8L zr9${8;rLvu0ZV+*g5k6Fg93GuE zL%X3KY>Cp2r3Q4^)`c%u_1Dc(vS>{X!~J<8!?B;uVQ+4toPm6i4Z-ZhUC8yeDv4t1 zmw4+wMi`dQmU;zK60?!iZMg*}(5Opq&GQOSs2lfZ?#FO#Yj(>impVYKPMhTVjYa6tD@9H`-@B;ojZ8Aj9inFYBx4xH?+4~w1=zZ1M-YJ9b z+$fVVd>#GLw~M^mtLG!G?n?*ZXdGqq0;1{v7=hKe-Zcg>=E5^_wU3bb1z{YW{lrDB z4O4{N+TH=diY+_SuamwxMi-I2>?QzW6+wy+%64c5Vq+%P{hn*EdCyyh1G_Q}JeY4t zCa^WjbEy{23jRrXK?*f8TT&t4b0!Crse^Dk4NyTBz7(Wy2W&JS z_&GHJ$mbOPr{c)!rMDA$qbG~R6qi++!gxfBr=oBpf#i#VP6VV5z^&G?fah+u!11FT zwA7zQl@(oN(fsiFL1R^H8yPpFORmdjp~BI{2y1?>D~-{ZS(^!V;o>#`(fkpm^}XO~ zIa6Wavq=R{NcXniSc|5FmlvFaBdJKcVI(&u3r)7jV!I7SrPoAV!?y2+@W2@B*_)YW z3GoErt2p!Z$iy^)Dy-m-26%4etO_P!G#mBh2R*du$U@lX&!wCSX5v%kpCC`>Xu?c_ z2MZ9h?F9=MtWI3d9a;aQ{`&rd!aliAU7La92wOre!3{4(x3#&0O>rhbn4DPG)?R4( z<9?5Xi+b}&-9_JXe-r5n_#$a`E3q;?pPnt4>*0Q_zcgT*b9Ew`zASzNzT`by>}&E* z5B4J9M6_|g2=)IUu5L62n9w90?7km@FkiV|Da_`8rY?pRFi;iSL4Zq+2oIy^YD;h~ zLpnywhDOCOR<*+EvD4sjk+^aO-yfKaB{(n!DE!iH{NkH_n7l=O1Q?$l!9pQKXRxaB z#Nfl&y~6||C{i6=S3oB=GF-CcwP&8p;Y^ps9G9YoF!A}YH8I*eAGnGIQ5$dL_l4A` zEg$a$jyF8uvJ*#Uqp1QdZ>st2XJ-+i33b!w<=!E3uD_;|93oy0C_v6I@{0)0?^v+o1R(DuKLkr86v*8esAchxzys=H7VY2eD#L zyDJt7`v@5|h2Tf>=twzk^@o~I3OjJnILezwec@O~ckKwTHEVFighrHY7+-ZH!Is(> zdBr`FWCrwB2D!w*wj=q}44~4??l#f8ey$o#%-i{1Vh{sFhKMxCN7p*Q$08?&R}ZYO za}X2fI;Mzed@-!-m@xrk$S)gEG`afx%fsn{FL3&o!1E}m_@*`zayr`M;8Y0Rwu}7= zwMl@$?Vt)Cy;&p7M|p0{N&w27<&95)87CS%Dlp)I69&-6>E&jxFH&glfUeq=wG7 z=k6xd`HB=Ley32GtQNwkLm43_lA&?xbm18_&<G>P z3_P40%x3z0z0wARpXk?~mr@DD0tw*slkZ4$0wY!VCPmE6F%%GgPJ^vAL)PbuTiupZ zn?Q}9*-8$EWr^b!0{sWylSF3q450!sNaCvw_KIthD)?0x4dcofMnKv7`)CtuM>usZ z5=Kv?7ekN?19Uu2vCZc#^!O;ouVhf*NhlOE5!(MSd=s@5<;)yl6^W|^ALZ!%6`6*T zHRB2|AV^DsP-nK(eYVj}dZogK|F~GHCS?SZ2#;<|4rt9KlAu~BxKPUmA|Q)&c*FR> z3;q17XIHuspR*UcybM>db#?Hkw;A)raXR9oJAIyZ5|{||M6>rQ!aX#2R zpQR!ACb+LQ9HohSWmjx}a?BGXHUgb@Pr zzfl}ZwM+1wFj3h;G351y>b?o_lFrq%2j8}J6XF~JFyfMIv~u2D1B(k7YZ#!A?}}36_e;#n?!Cj;Q(g$|Y2_;% z8espNoC0;v>q^`&wey1U;_PpWhPrS{v__mrQFzsq-Cq{p@^Fw32G%tI9<3%!5JN^a zX~?`8L6oI#S2x5pFUV<*FvB_4VYhhMAG%A6N71Xi7a{16AW7S4h%_ ztuQRZ)eqY!n1u7g2a5)1 z z&P8ERiwnSF8k|T0H8dTJ|0ESRWPSnUEMy&v4_83Awn6-ohRSV2cFR~9$bkHScNh(5 z2*-U=lj#m`;(RMTorkGQ_jD!`qp)8)`o?fT{yZqLJ2+bjd$~|3$?0}(~#|l*+{YXzKRKPGuB3ktQ^at9MNb} z+`6PldVg3o1PN=m*x`9G*^Me+Ni8WOQGHe~(S-#y!H-2}EOJ8cxN!tf=832?;NROH zp)SBXSEM-H7<^6K_dmIVxA@b$LWqQ9Bs-__Y{W4Bk9H$2wy4|}I)gSJaiEV5SZxEu zbt6Mk2spTL_6~5_1#=~X1B`${uzAA-$Q)ty^#X&ba1Q)WFGFxx$slG9;}Mv7wdjdt zEQ4M|gXPdTc3lttuky&%2o0u4J+aedYA~z`V-8vPl6qVO?t|@Ult6Fp8W=B`T0I5f zS@NprhcI1Gj)odOsJ>L`-iq8)G=IIzS5lq1241rbnh+^Bnc)V<+%B)p!?1#E&tNG7 zjp0y?1~teT40b8QMG!0rbDzeoS?kqk-?!eHkDSiM)jjuEF)@pP)cji2xpDAY{F1zd z{TWj*p7wKRqoV!rLr=*M<2D@p(Q2c)C>Y2%p{l!NW0b<>d%1P-nx!@l?n*@jCn=8XvjC_PzWf3SBb^XOU@u#Y zVFEtlBptC?kVByIB%|jYt30_rVS1#Q0**EI_%eLG4}b!Rr9DDd3(5yUhHMwmovokGXoIWw09D1|b<( zdl!+jCX|Vxl{zAW*yvl5*9o4ts@bwWs+aO*m#9~=S#F`W^bLbpw9FwIw}=lE7=rF& z){UBZvJAK|Lq%R($4#Lfw_1iQ)ldV5HD-)KJ_HXt@%gSad>L*wHi7%?o(pg@+Q_l?n7Xbh$+viqLg0&QE6+tUGU1pq{ci3>s4K7p z2eQ$5S>+5LTbCS&O+kRQxU4MY%w;4!)8u$!VBIYsqA8X&5iOuz?M#nvQ^X+O@yE<7 z8yxoaL_RnuWqv1qz>#sS;=L8U?M2PJKwyX>KSmffc;tpM{`Y`R_1}jNX}}qeVX6nL zafoIUS3_^YmN4>e?qD@-b&*Rf*?|{`z>g=TBtNw{uxKwCVYK+Nxu8!62Kv^=As+^ z8%z!@U~0%Lj|Nz1ONu5;oB6C4okoj9`ZFWd z5$jW!v5$~@8jcnT+#}Tl5^m*%BTyv)*mh80>h?xKq+N#UV{UepE_C^4gjZutX^p#G zo?Qh2M;~DVtxYCa!N3I0;7gbr8q+O$lceb zD>1W#WKVNbW^Q2)3-|NCO4~LP!QHt7w#PFI6h4CVeJ(O_<43j=eo}x{3BUOA;)b+>M zF3s;zuXTo6UnU zKBzj)SM@Mz0=ZE{zH=j-3QUMmRu<<)tI`34?@alTIhgGF6qWK5lqxW|>d(Q98}2 zno{z!?&zti{dWTZEL9bRc!V|n9|dT$(WB3{L55o;EJO?HM$|}c6zAEDr}B!<7N~3l zO|%eYtil58MuyYNQ+3IL+VUsh!vS5!-M~4O1^px>0wad!CWTA-3`XlP5=3AgaG)z^ z^TfXfpgi#pjs@Fc%*p`zt3Qc&)ftp!TKsMva@tHO-`tO29=m7a?PGR0AfKF^ z<0LEtnhvvvDSd&sNXK#9G*s_1{lK8_px0XrXNWJzZJ|Bm^0aqu)i)ie`kOtu!B_%g zIwCW0PQd#ubapn3h(>WvCkDfRXSNHpLTaoa5N(J-2C{p7hj2w|4+SY>IX|Ff8b4t& zu5dG2h`^G7(v7&21?f-Pfr+o2P}Cv{IS?hkT@S=bR3ck;;(?H2McY7q0v9na=4bbe zMbClErhG?ZK%!l-7XfHXW6>r=0I(lYeP$nA_Hx!* zLW)x5-PObp=7>~~cKqL%OlM_{1AGR>o~d$tkxCp!#9!{hxKkA)G`|DwE=#lJolL4O zo6{3}_@6^?JJ(7KQ{;J1ra{c`u-$qV3p5to`&vAZDjIAX*a-*hpf1ERL>vghEG>2V zupG%^hU&4>RS*bwOzk8P=+_IX8Kn3W<_qU=`Py%~%45C+zdA1lS(iRHJBG0ymDnYp zII={)=nBSN($}8|q(cy{P>jbq94-P?)k9COhMA7*s)fdm8j&<2d0@_?hvZ*dT!;_nB zzZ%p-T)H7XI`MUzpvto6&5h~ZRdDZWddNgoJG`t1D zASY=%s;X--7}@u2O#y}6kkc1v`_Zfl1Jbd zMsreMBY1pb^iNBV>^((haC4h@Emo@ynVZqLEdATs_yR z5e>;sEF-AWAO_MF4}+m61uAP`>>b{xd9F&rU}SjBeel5FYC-VOB|-=i0Jw5u*hyyl zI(bdtzGYC3obT;gcAmvB@Mj5+k7UP|A{{uR`h+wCTK-Ufe=r81h9IeSC2symOEu;@ z@qt@D)dG_aPZc&QIC6RJ{lSKRYnp7-KspG*JUJRs0kFbJk5?y*7DKx=4PsoP59y-- z*baJrL7H>#VAz6Vbe<7l<>JcsZD~IuK}v})rcptU$$Z8UDLglwMo9BaJM4|_Ql9{1Zva4u1#oO1of-3akl)l)Ji06YlHM^ zL!@wYhM$T)`g7!wdNVdIM$vEivHQsm*XNwNcTPP)*BY7ZnPu4J7?;FJZs%VNL1@vZt z3_-sTgLFF}mgsiPJ+k?mZmHAW+^gaMgbAz;!8~-82#e=B>hMr^3WC9$d?q@zz`2m@ zu#RMHwk6Y$UhTRK(fBbKIe4hlBY(VpErPV7d!bOQj|pQR84Hg>UXR=&^yA0TpZbj- zx#V@$v?fjUPSRzwM_PLTiO}*#<}se@~`LLhcjgkncPkWt8jzhU0~_k4FnTer}PfSYh8 zxSC1<_TY-+uY}JNqmaf8`J;Fc8zTduu!bd~Egu8qDCka~?U!ajr3CD2N|*dBCKkMw zC~4x)7}9wC@35);NPYgdeTN8t)1z@wrwVCT=H};~5DFXu41-A(Ec9X7ipcUOLDOao zUzlmqSFdaf{K^GSyq4kmT@^j6Zb&$ri!s!qu&*r11~_1)<7lbisBngHub!ugIvDE$ zu{|yudItp!Zy-WnOfG!0#^Qo-IR9RDU&-QzzXIn6f?4CE#ce!H%+Fie9xt?)q`lS; z;Fkh#GT8FXTN3i7*sk>pmul`_+{lg->0eC1aRRszK~@B)Ux*UXt6I_{@gxW(g1g(J z7ML)2BYn&Jp+hPp6ZHJoy{rrhm037JTt5P*(tC6?yx3Hp1%urluz(vg4tp`O(M8h( z(|PvW_e;+tA9ffjV<3Sh^I)_&?p1>oJ6wmHjo^v&{s>CzdGq>Xx(RIo-1=CJ1v(F1 z=iz^i#S+6kG#VLP4c)*b5dBMXR*kZh(Sn7BC|25p!dGjD1*-OS=1hOGzhH2%GBS$c zNylp1j_2EIHgA-yTsLCFZA$Pb+z!d}dvS$YVOb#tB(AWBdeBe3c%lI>xar?72b%$^ zdRyBYPYJNkkMsxLA_1N9Kr9idv5Arr(yhmdwh zCOGbWXgb044y{5!`1Zx2IiS`URd^*r61*rT;I4&b~>CUALqm*yFiK!bky6y^qZFM)5+x&4B+$7P5)Df5c1V@`nPN!3~aEO)czLJLFhir=B(p-)p zvVMb%5^W-OhmSOU25`%o1z*0^j^IhzYdSJ>AKE=OYq;BjUk4oFOR*d7De+L8fyI)Z z&u{SJd3x2{X3lg{2SQJ(Evxc_g9K*8cma*gOUCIdQz_Zf&j`!$W z3~3pdVIUgrf%5E`8rISyTqAN1UrCKAYfoRT%t&7qd=o3-kbKGoI)Gt2*obf7`2Blp zK2YjDVpi|HWk{O7=u~J`T1a+KDMAX)?W>FB#C15iXr{n{30 z@WW`&j&u@@9W#(i^MFSJE8@dN`}l+3lXJ@nz6F^gZbLEt#CVRu+ja&?tcL(*B-T*I z4mp-184lFv(}7$fG=;EcJm?f78Jo#%P$1MN-z_-}S(7wZw(6LGwm z=49bVh#iA4G=S6)dZUw|d40Pw!fF_Pa+jh}Q{!6&`{H_RP>>d?46>faTg)kw$@0cK z)~a-Walf>uK_K=TPN+82Mf(Xi3Cn(Kp>Y03Rcp-Bt*Q(|U#GP`3Vq-e0#!H5r>I@f zfLf@2%^!+PGz-U(PHK8zb(n6Gv(Y!BUj!Y0D3Fktxt=4^@jnL9&7$K+bg|-xMO|oE zJPaPcb>6a;1(9)hoyJ%f-`gv+{CeGrA6(|sQgf-R$wQ)7wTEBe+hG(&l%*q|h-kBbvSg(->RE$|Q2XZug^k=u*ALVW*cyIwOln|}e# zc*Y2#fBUzoO()nz|plB+Cx9YVP2{py*7ydDFSx7 zL8CR`fONdF<|Yqx0-$$BwvL-Er z7lH`jd3`t0Q>2ql#dID^RYy3av;#{8r~SIr&T?it%2?}iu7mcBm)#23>nv^$t21Ch zapJ=nU?zZgCYWm8ucCnyC5xdWgAw9)l+2$B2pkY|Qpc5!z4+nI2Qc zgM4VSo2Sf_KFt(wYakHNS?qVBNce)=jKc z@UAu3*2kC#JA8N(XgM&ZQB}$ND_=do*i0kFVKs!K6lOaElA=sx`tzQl>aXSA<3xjY=rh>`)}BGV-*Iqii-+*%P=AEK0AQp%U^Mg)zjjpzWY5kq>TNpPHk`#PQF1(Fdj{byy3A=t zq6E^)0PjrGFciYjvg#&9YJB&4{uRRPIotaaKzd#ikuiP68ga^MGO58^De!R1h-Ro* zfO2b4*NpLkdq3MBnSCDI@TqZn3vk<@{BFs*%>@RpZZ4{;Y)67K zS;6tR21iiE;FjDjM@tPaNEXSM%YqvLh|)!Z-2ngBQ1jnh^ms1eAP<8nwIN;pF$t-x-hc!M;?{cs5IWFi7 z#4w1-|J<|2_z*(7dD)x#wSx8(`+s5fC!!{qi(|*2e6`x{8s8G$Fuk_8&b)%6GGXYf z_B%}FkVzOW8r{fSGh4J9hmoZOUy)u6u{>Lc6bmCnF+(Z(~oF|3ykHred7w zvtAb+0c#DZ<3tIFcOR%_jOB$ImHc+3VtV?=zM_RF+%yh`_Ef^flw%Bf-SUJkC&ViQ zqeU~&w64M3+9eW&Ncefx0TFS&=)QFN{YiRZ0_xD;EM53k;g6u8$1dg(dxBg^RM$p}NyU6#56W za^g`Syl7Oz6!MYW$sv+E{+wMIBfXa||y`l|< zEH{UPOfLE_%5(YsqfxU+W43#av1ExhcHl!8zd3 zBswD8VI=2=>QbUhZHTZIc7(-vFVeOKy5C~GG{M>t0en>yu$B%ZlwQ{s5A2}c8gzm# zWM9O{Sep6)GObb)G#8Or8-gPsK~OS6P{EzH2%xfLdrx%13J^{@AI7NSRs*e!O;PNY z2qS76LUA^5?lp~p{nzxj#8-@j7h!$n{@mdig5%kOF*E=m%s(&FIAVe9h%>L&{EM;4 zrY~{r7O>o#iTZ^tN8ViQ53m_sHz2)oJREWf7RKXJQZt z7T_1+NP8{=$Y2)d$xkyv6Ca?B92TO8SDgD@xhBT2M-e2JZD>8+PY~gB4QqUH1CMmM zl6E#Bh;0UCXjSL3HtzBgL9$OMM($J{R!HO|$hyW8jmO{g8nXR5vApNDPJ}hU2sfJ zc{f$PNggwR)E0ybnr0Rh34Cy9taaOh>-FW#7u-0=R&>S{t4d^eko~jxWm0+mi10J%X0C|!u zORIlbvl3!qc|w`4V9p@0{CnN}X@1MQmg(g2L%1prpORUUHUD}Nj0=~qaqw{#V3FoH znCy=j&PV?NH<1NHq#^THPIFJb&hBqeDZOW3*yk>xJDiBdeyqfR@T7C5Dt43Hd$fF~ zoi^f?=!Sj9?dHND@L-lR74yRA#N35MSDJgNozLLa;%bb@L7>t9XNVBJuL=yTpMlTA zPSQvaZ9-?PJDeRF4Dr_C4_Lh(9ohXpeq%48%SX??dn4~3^G(s3gv2$P9Tb2^w0}oB zKjhm|4d;XwVE*GGQ#!;sj0Y&_o|2?z5B5Ti#B%}?#x(%I_@}ZY^3GSY1-Mr>9U{w% zQtK%mOjr25!o@Qt;sH{;!$CAK;6s)9rDMDbNm0uq3dpDl5SJi2 zBn_yC7m3$%1^9)dXs8#}EyIN{*lH_9cq3prVct_7mN}}-pP_wmjw)7J$E( zO@NRgPXsG%oe;133$8eT-mR#w!oz9*hnV0V3Im)g*{Zi7urdpUNw6>z>~6n#uK>Fp zpD~4V(~nDIgWWt{p$2Gzv}{x^nro2Ws-)It%(xCwaD^HBBn<{LsVvLovYUXqY(b2}<1n;=}G%KS<0f z9^1V4NQc+m&zo<)H-pnh8Zt#6RrVSEsffY9wRqd)dWBBxNGA<0Ab1AQ8q0h)&{EUk zR6E1TeB72VHm%eH`B2f7+28XwDb*hU>M7`nV-eG62mJ-SgEHP7IJOum_9YT<7pye7 z(nMkM9@IVe-to;%815Z-%*$Z$w=GTmBc({_k5mA9-%j2~li)%P@Sb7r^>@)&XA;_; zgd-xrkN%Bu7yV_O&SG2!F0;PUeFQDcFA_)Vw(&Mtu(TSpt1uK*1r?9D*VS zTHi^q8!^XwrD3HoETa)-N#nMg(b5=MVz5MXzd0ob(~}_pD9q}bg!Q`8k>wz;6(#2F z9>)|_g3+h!58^kjGA>p8uI?s-E9n2jDV1(I*vu%GY31x56XnH;QS1a5HI1Nr9#BvU zNVCM1o$N2Jj@ZvEFdX6f(!~0xDJ`U7&XZA0*Q#@dhl`r%1mV zeBzNC0X>8!#;Jr+^rFFW(A9Ry_~&r8}UU!x#>_R^^}2)DdhH#BYNj;NRSS z3iu|X^+WYuFQJ7%`?Q3a0Hi(xVvY8=o9MzAkfIBU(kanVVe1AM$C>ngbXZYwxT%2` zAyt{cE)CAq7@-Fl(^Toyibo8eaQj?lW)3Ap|Hv}Vjr6;dN$lj_=X9zY!T4Yv_RWH3 z6Ek;UB;JF&wOxr`x6T}|ie+d`5R(j`W!fstzMmiQ!jJh}c#hPD5T`|o8Mqwc-rJeV zNPLusxx{Pnxe$5U5#70xt2zbvQ`!NnbxL+6DwH{D_`XjbIm$~_c2GJ8(UwzXg=W+h znvU|bs(DL&+^igm0^4$-cG9uk9FyId zI00?24@dkn>_qJW&_QP7&a%k64W>Sj)aQrpx}zb-aDeC6K9mSbBdZ`>emS}d6gmht zaw@}Du@)tlyJEYKN)HT=eZA2POvvYcTG~5BU}Fkk*m^O>k9^!a`~fwIBenDewk#0% zJX?_{*=Dea&f~Krlxoe~ONQ*wNYbK;8xUhHJ^83dPiM=`hdjRxVL+yz{dY-Eo(m%I zCxoAW^pXq^TDH+?{b*NobLEK-($;Cvj)+omK_Suv5CpIRsXQ>FEI*pEMBMqI%q9Ya zMbWFvDhETloqv}w&P;!4lFRSm`4M$$Gl0nu8pI>-M)5fqOUz`vDKP!vK?3PTikR^J zrw?aNm=iL#h8p-d!f~i22aQ+H_);I8h5FxG6x1bo8?U<{l9Lc*NEI41!Hfe>eyISSQbm>T(oAu$LqCYiknB2H=@TzxuO z-PKzM!7?<%-m$twwd9y~5wYJP%pa);?-4rXnnQ738mbu-r#cVrVo9ixTp>Z;4LGF| zt!oKWip3=Z;XyXVsLB4N$NZEvg_&uAp4YeBpi_MAwza+8jD8_NuihL=99ooE+j&Eja;z4vP9iO?{KEPWW|K~*43Hv;ZRtlcU2=rrq^y| z6hESZv^T0z4NBK$hFp}TJ~|P)MupUR6%CT8@DS&?Y z+D@p85uLoypRe|u6y%S=i41p;Td{9_5p7rg6Qh6>i*2x1+)atf-%m|D^-C)*J+*_X z=Rd8PTkc)n1mV|6Fc-q0=KXL1D(c`zwkCldIjV$>`M`dES2t%Nj+yQ!sO+ zk`yszSA>XlE9np%jlE6~>-%hvzu;YeW$iPyw?VCoD;PP(0`SZH$u}aBHo^*j-&f*X zt00^6kqOF;@(if4`UyK68)yQsgg|n9VlUC!59wge)nNgqF3Q{S2mN8BMx2hzt^cqGzow2efXj`-RtuYZp|_Zhp& zHR%3WJmhf#4}pZhAwSo{A7r|bIGtMB_>y2VH-foSJWM8y?;O9$nlpsx#b1A?%Plge zypsgt_i*}oNcm|k0>Y>Bz6zO1iJwq9N~c#%%%aU6<#vC&eGwL70CO>WIMLtxk& z;-$RJ-XaLFLc5GEt^~s2VD_9*9~bY2aS~JCQ>PTjBE>up2}sJx>V7MjxAQKVFI1A= zaAn__vJ7G1c(SZ{B40IdgDH!>ox{3E^OGFlTQPCvp$>y+b!iJhiRS`VLSHo`=fIGE z)@}zX0jNSjgi&_hsLeBS#WY~@6V3)+*5Tc_;BtzfmVC&d`Rr!+7=Fvzfduy|)N+#q z?+k+IZnl3?`VtHh(~$goj88^f#<_Y^K-uhcA=`)eJA$4lXdiWJQ5-cwDEHirnA&j8 zHg~Fea$%xFP8^3fGeQ?A2o^>Y@114m>=~-5q)NT?|ILP$3HzX{t^^LD)DK`>pA(Dp z+6NJQB}X{^&g-A?m=YeAV7o9Ie}9j7fICq}7|BM|8jW^aR+^wEOE0 zeqPR+wWf^9JlsZLM#J9X%s^Oo9%|W$f`d2i(D{8UFNcF^D*U?T--8Udwm}O&o5#Mc zCulCC2z-IOZCqcSHsw&$a1~**&S8^v7yFJsF69e33;)O>z$g4>a}u<&T_G!|b~VQ1 zzdj8iIq)GMJ44!Q!KT(iQu==1LX{$JPvKZvnQgRZZ_bAQBuH8nL(Sm$j=STFu$>)m zxdHvCsi4?hWC&n@F%#q38#FuFg^V0L#U(MOD9i;8{S?Sije?l_;@>yGXW^jnLgG4A z(aGmkj7f?}`mT1CbYN zA9vmzC+J#~fKD9V)>m*cHVMdi_(JlC-25_;jz3iiydtoUCc)FEd#}$0k6TsS550Ym z_s%Y^+qcmw0H)kuB0o#Ug248~B9aKW#Bzt2WnLwevmwfZuXh+u{=&lq-!W{s%e?9M zdBcDTtVk6M0bGy0Rh;0?@766FyW-Uqk~>)EJ8K0tDKbk}kf_4pSkEgDhX8vvam$5&WKZi@B9q ze|Ry+0FGu#4@Vt?kont6Gc$!3MWa$X0qzg)$w+Iop+oo}eFU?G!x2m||HJ&`ta}v= z5F;L28;jx(gh8*UBN3bx^-RRjMsk2&!YOs;m8w?b$Q^O$cx#syzYuj>T0Y|J>U?8s zzC*mW#>Gg8O~QD+dzTdOedIFFYmaJY8Uzf0Q#q14v54)75*+~(R5EmR14 zjYeZtpDX#TdlJ=2>U2=6C=S2OM2rw0@V@B<54e6S=ODvk$gd!N?S(AmtY%NPway97 zb4U$nfx->W2;6Vj|FS&cT=SGF_|HWt!402LYUpfb^%4C7N8*k6RHws)D==Kh&BTztdY()vh!IsMZ70{u2M3+` zB4(C0?19713_}Q4Bq0X$Q(D7>6A=aU3V-)Bs4(U_X{!%TSEh>53>nKLEOW|L5r#k< z%9j?WV!p}w;7`rFJP!wAJpF%Et$PR;5tKko?(0T{y7@(vi-H#l{Qjh!e z4FN&1K_TFUJE?UES_(oaOF{<*2sgCFbc9ep8&0xK|3h_`xmZ?YrIu%0`WuQ#<^{(*I;7G0C`eSJ zcfiu|)}x3Qed+Sh4=pf!e6&ii<3@QOSU-&{htzJuXQn9Pr00CEIz1s&`egSd3D{BC zkBD}&|DTlDLf&#V!~EM4+ANwN{6RVhxMUO#W@r>5ke#h911Oi1e!Ot|IDG6HdTsTgu#wv@pTB#My20lgJFk=z&aC zC2GKGC59K+Dy19%h1ja`c4 zo!wt>7Q+qu3TNo9=r*!@xuC@E;IvAKY`k-Z_>oa9DS7Smh^&Q2h*`HqT(K3|-}Oa~^b(+fDlLaH}r~5!K68!sCN8V~oxhOAU=vw@sx#)Z`g;#>p2B z#H|6Lv%W0)e9ug$r`r^MYj5Ji@tv-iE)W4we;vQPbNat?>%J-hnE%RhWTq??Va>;x z;IO`!C>4Unxul_C{}8(EWeF%Md6J@)Mwrw6R@mp za3llX<7>T$fn|y<6|xg)LtPmD!bfm3%-^JOI57m1=o@Hk%}y4=_Cv#P{j+FY1?2}3 zijF45U3iT=<9F$v??_9881~@Ru|lNUiDl1NUDNM^e3g7C!a@1dEBm+AmPl;PMuwt` z=t!sAwigGb3_LkuNHEul3-`LeS3~Q9A({wXnTnq^+kMs}xoH}ISk-lrmiZ@Hcl*7L z@Jti5hOToMLoV@KcN~3*uR}-mDe?aiiVJ^7-NDMRkwYj__E2fMD<5~*SBV} zF*k7|q8}f(hV?+=@r+ksiM3f!bH)s2;Hjru-qN~?9wp0t5p~4GzOSp>L8Dv6L^2iv zt4qx*E-^S{(sF$0X?*VE==^u5lt0kx5r9=Z5+4|(DuHxIzamC z>~(QJ^!SI`w#Kh6CKKECbk3`;YK8fKkvJL*m9a$LgaUxb#ha-Q66epe3%a(rjT~Wl! zf5(RDiV;j;--K^SJE5^Qr=sq{8CRS4K=0G>__tm{g@wDp&H4oB#4yCvkO^uVR{FDF zp|(P?J)Bgah8UQ|h3WABfzH9mRh?fsFs%k7;OKA=1lS^G!G6`nHD>QQACq);2f+%G z#FoJL3hhB@&Wx&T>Jt>?1jaQ0DGkPWZz8GHBpV28H0rM+&(s_kIT5L*sXyftYXim_ z2ToYhP=#4h)Os;+~C%;~zlX|ucP`l|-hq_Zoe$2(Jpzq@UrOJ`c`ulv2%0i|eDtXQiN(Nia zMSOTGO%Ajg#lwm^VQe`Mho=x>8((#UXz(qU*GUVE6Efl$kZOmg1o&{lb&Ea<`~2>nQutIMd$3)}7qMp|L46c>JCSp3aqA>7mxG#zlK!FLuI^Z#e4y(TS59f*HBMhS+OO6(E@H zuA~rE`3$JLF`>z9NL|O6>pbpRuiK-C1Zfq@REVT47&Skza`35VM`*$DT@|e~UEzsZ zGN@IdbpVZSj8e^vu}fe;7s^u!?mZHjI%505u9iDwJV{k~#qB`=S7hVSb%qPn@in1W zaG%**#wZO(T)WUr@^=dvX-QXhkpN z8e_nZ40G@j5kuM4QL&VB2E)h4a?^wKIQ+I;l=fJ7wdx69QQz@sk!ytndn6|@2ziOlCh8Vjj{-rH)m(PNXDe<} zntms23?|!ABx-Q(vIBn`?fC-eNaNHpHWi@%Xp>koQ>bJ$L%TFTdhh-|ag3-0+-AN$ z08=_xj^r!jV@Amo%a;eiV(c0s1r!z2oD<0hUOdF7^L+gLmlN2~FnY{bKE(fZZOOm` z{7IL-ndnocLuW*45na|gmYBPG3!)T$=+lqS^f$BCTfXJh6 zZCrb(PrO%-qr=D(A>{(Bw_lEHf1CG1&s{jjFrcP6Fc~47PIhHE!>6#|FOrDz_MuJ8 z{^SSisAh&MIE~+@9x*icfJ<4!V3gyCISw#JGFy^RV7znxi-(gy&ecp?L8rY@e4u|B z_N+FGyuhcIt)h^+(!&|R8fNgU{6R`D+C>BfH<(Whz?%$$EMhu*r+r8MRUdk)x?P36 zhWdN!2hxB#{Vg_p`O(K>d^U{H=J$iTQbgfF2(Lu}_=+wiwD&jcGW?zja?_aWF3~~P z#q*81JO+a-QN0_yb5!SV<=CiV6QU}Rs_pBbKVbbyeYaraocNq4U^5i)kERg-#oNe$ z)bN7>BH!WEZfjnK;8qG+5=B}%UwqZckFR2Ub(yt{;ScEmv7QUC)0O>A^I|FYkXAJQ z{HQjTB6zqb-d=a^(48O)hG6wXY97Ldz-Or8o(fCN1767=$yzwGsJ0D`LHNrodSF!r zmb2fF!G_29^$kHYEB(mIgxEC+wA>{Tt_p$NG6#lJJMCbrV~|vPUk$~Ou3mW>1H=iA zrAFeR>=J~{x2p$YdU+MSQ{|#SUv4%g0t@=5a|4)H1`Lfh=V_QyPdNfM+EULGjSG1@Y-0_rL?$8LDU=yXHa z*$7H3qYPUmLyvW^Y$Lq}OQRvOPJ}VcGT+i>XnyJG&;j6xgIsSHZcB@`lA=^I73FS| z)Caw2Y&&E03=Y&Zt7Up9IS_qx2m{b=WmSji79z*JwZ=&~cZct4n`}x!gezH4XAta3 z*-TG(^eome>5#u0y0+@rr4hkRga=^eSc7)J)|9GvBsv8|)&a!M+<+B$C;XT5%WkUzE%1Hl=6_he!gv=hB0E|ucvV41Leo^rU zBX+3;m>Mbui@jMmIbqR3UfFQ$J3`R7p|c7N^ux1ErSPX{or~881MUjv5J#d~<1rwWn&=qmb*6i7oFT_STOlIzU+1_w!xXkQq1~o2Jl2 zK=#TE@w4F=ad=*A^w%5T%^doB5<;G4+~Q**N1Tk+bh8H-Y9D8Z=1Jn`!&Xf_79 z0n6C&26#eE8~;V8hl`?EK)vD!kd&(F_7~DQnNNeO`?kP~EEQuXKhS-L;~#VG0A#+A z=dkQ)7KXiYJYAgu3JhFDb4j+@&+qUuDF&jZC!lwDK`YSAJfQSirg=B9m}U<|8>c8w z%m)o(M`GfLkwt`Y|9f6(wKk7!pd(vq42CG->Fz`zQ4sQ95vYJ+F#C2esaPjpF~ZPW z=xk38Rtg+xU0Y?08RgAgO6ge`UOyWyjVG60|TOy9?rw$ zl~7z0oM8Mu>*X=wZSq@$JVWV6)d!d0r!RUeyqS%Z_x97f$0kl8jkb6F{EV69@($z$ z$8w7jYs#ANK^P>MGIzbDI9H&hIVaN))fzP!3awYY0R`tHjC1-LTd#RG!UFRTV!|x%jmva;g(yR8uqv3p z^$vUvMcc!#1Ac0D;i!M`$8e;y;fL!GkJzp_Sl^p7qwz6C-N0PAwKnR1=d*LM7(3#~ zdMtN8i+5a5;BpR03W(vpkzp2D%)xA4l#W*I?0sj?&0-7pt<>!&8HgiRn=l}4V3$5H z{gV!a7?U{ta3DCtKvR8JF8?PX&Ny1AM=2y0Irbc4-8lcPsFd{`x7;b`0CE)P2C0P5 z{8A9WNav90hQffwjA?B>!?nY%Bod+Oi`BE5z>JlOpUnL0@K5^c+66`_nh}#m+E9`=Lx4Ny7tK!JV&e zbcIn%9_BjJKcHwdGY7IiXlPufN#|q2eL;zMAPW%hplOgqK|EAUZ2amVf#Gx39EVn* z&U6)$_q8vo|ItzZHm~3<)-$2bT?h9R9zp(#3geKrxN?tkP$$RFOk<)8GJPafN&5zs z-CxmHFejd=q7I1gJH(0;})5+J})AV}qW1d6ZY3^o!B@1bdA8}nFAuh&h?Odeya zqM*(hyk;zqqU+uk*NyVz4?bTG7>^p3Qa`6jRlK@dJ&>~e)gJ|#L@lNo`cSvg-I6hb}RA?m*q#;pHJk5CVu{0G}K7qzd(h8wM%26E2 z*c!D5Nf2BVt#0QNsvse^k_KRcJ&9XxsB&l(N2ru-w-Swu*(Jv`7uz+{SOL%WvK_q*ucUpO81q5h&2gej<_c(PK9ui8Jy7& zEh8;8=m81x5N2Yic4R0V+k$A>klyIis#z4*moMzL`7ytw~>>-i62&~1JSG^xS>bhLtQ3C=i?^5OP(KLw)DLG~Cp z*A=YbXsi!_*wWUWrL?;TyZZZ@470M}f{D;oX$%_rGRl)183V6K5vtgGVP-t(1y#G4 zij)fP>S+U>E;vF3-gNM;4t~~KwGr5zYm6(lQXD0U^Ys&FR?4qnk-iZJ{~1d$Gt&}h zhyIZy6Blm%HzLxFd2T|KPN}&+1aU~3C2h}nr#=2{bnbvSN+8lxhT(Y4H`l=(Y$?*sHJqfMc0krYk7HLJZbpYXnbhFb z^9yMxIxGkV(fMO>+j$9KsM!jqPtjjbA@bWtr-~kTapT)NTT+$A(O>;59x_isT{8;7uhBsN0Vu0Da7_x76E8eidggUeyDS1Bet~>6dd=gw!sbs7;mR{|2l; zldMfldG&kk8?FcN@sLy}3>eOB?)k&3Sg!G#M3|)5gdE0SM_YLjzx^WyvLS^Mm70y^1*-7FQ;riry`W+*bLe9pN68w zlsQ9Yf(0zS-@n9aUxmCgSw8zh@#xm+&6CGfKq;!U9S7nRUJd7#75@n#FgP&3OXpX& zYndSjF#$W8*BF#PNlYC)0J&y628RO840UL_ec2Gk%G3^=#ps7l&6Ccj^N$<1nxlu z!ObkKelz%tV(MUf#hVVJqqI+hmMoX=lI`n!114lAZ~h}cX_^-QlTtPm$4LJKci910 z3nf>8q*Y^suzo$AfsQ^|frI3ZxV;5?xN1-ut^8v!f~V`08{bD8g(Ql7XoXlZj2#Uu z2PTgaIUwQv)q0X{FHfx>>ls4FNi%vE%!rY;7DB`;p0xhaJL%X1fS~f%`f@9yOcc49 zl;p$aNY611{O{d8FwFCL2HIsTb1pn0p`bLi%C%;3!~BW+k%4x=?*|nk%Ho9v3|$df ztkGk~vzBPz%o4Ib{j|+Zp1jtNH$pjK$DNnm?RZn}GSTe^=c|U6LPl2|Y+Cb>(c?M} zB0}YZSlHhHR;GtgsJ83>pBJei)^=n%nM&D zkb*VVUO`Y=5()}v`Gv(_2R41%Xn}@@*h-@*;HU&X zu;yus(e$>9U=R;ppGbS>G{bhNM95pQ#v!JhY+!p2b+}FO5Dh-m!5B_BQDbrqk0Kp- zw*SaSU3X^tYbvH5zk*WFC+pQFo}&t5D7*)|`%%qN8?DJ+fBodD2rxJw!10J8sIb$g znsl|pa7i}m+PsH_R6n(1);RITI6=+^+nYolo<~{-N2C>E#1CUaH_2oqM6h01W8B7j z!9m9h;~X5?PIAo`AParM+kxApdG={-2)akF5ZERXH~O^ztD4|tjqr$3YIVqOuos~% zF_h5`=l%yqu&pmlO`z}>h)9N!Ksl7v~pVH(Wvyl#2q%?w9f=^OtNX2>C?@P@rH4qwUaE>C|ZpsNS6w^9h*VghK-6|Dg=fv`ZmmWp*F}edbz}wd{CMHGPn0CQ1z^?}CJ~1_gqG{?Be<3=8x|A85 z@5gVvfEVt6zTwdFQeGMe%QwFXxXy{TdsGSii(T)$nDYdPaqBJ?zW~`Yyq4bsVN@*a z9i(M_dotnG-aCX<0Fc0b8XpK6+aUR|z4>+!uIqoh?&q*hv&15fSaIPBfwLHTtnI1W z%fU>EzufWED5ZE|P#K?!_*}tYEkRH$%RS%tGWe={E2cWXIH5`v$Dh{)4v2OkSBC2X99-OHA{5Lql5g&(=y>RI0E3< zFolp;$G-lyQN@GcXB2bD^t@)&ydCVDhfdd z#Y1C=c_cQ49{Z%-H6^91#EPLRfl{3PD8W1>_GRr_{R5sDNBCD%g;(4pt4~8-`?e#X z$2#YWbIEZ|d;NP0+Ig;>GuMVmH3 zJI7#Pm27E=3*)6?B5*r%gTsr;l7}-?93PBOLIi|6^~oGy)%dQ&`)3K(56CwkvimcQ zE2aVKE;}KSPJAZyluHhX$#d(@hb;`Ik05#a+lLYB32-HX!HuAfuM2lHIQTtO`N0C> z3o=Iw-N~f=cy|8^XaN!?c?>^qIJ`hR^rrl`Fr?#yet}JBU?{7qkqBZ(mc}(1McL=3 z4B#{gJuIGMWVnsPsR5ycRo%oE(KP1I|@;6+z`Xp%D1b#tvtABM^M5Y_Fmdg3sxy4%A&W`UR=Fg|6!b7FtkyVo_ldFJ zs*Z_KhoHfS5c%`e*sfipgIZ7_mE;|f=77C}=Kq>Gv-R;wyDo`loyyz+RWtq^f?*0@ zylOD7SO%!>95ZbxsFC4kluhqig*q5d@apY_geh?<(kp!qT%GpS0LXN&b?88#s1fRg zJwcc`Lx52Z9YO4tDn4X~1t&OF-)ujM8=Ok@vP$fFT^KyCMqNLLVo+4nRE-OgIyxc@$>BnSG->)y^d4=eE>Fkht=oKHR{BQn;rc`VW=3+;^--Ey$8W zEyxBU9|zEA#XwBw&^g%NFE~RUs*z5jY&gg0yEkg)HQdlDgnoD!ITYpLY#P zh@+5%#4dPu}J4Z{M+u%RG62TY+D8~vHbeyT$FJ6pB62@^c% zeqe&|ZBM~#;Rrq=PjU$k$18_vrh=;!TBaOKkimH_L9x0Fj18X?4Oo1^+ZX(5BA&gf zoq~Gc$gdenvM|kTQds$7)U!X=+^yXMO3~Xd+~7$v&N5?t>H-kv2Gd7==sbpe3xMaZ zMQ~Id)xu5r2B=ClnC%SuNKA;gA!C}pf-z7N{+UjJo~7eEP$O>l;M`IDm%6uDDROJd z)#2c1n+Smkcdb??i}6eIXf-|o-q@N8vKi5Xc-eGeM9yuHfV#fJ1}p?~G2F=%a|Ibg z{&q6z-F?pZ6q03w~OCJtg z4(uxvGEx330|2JOg*`hWXc685;hg4tKYc0=QmMf!8c0V{WJosBj=JA~PCWkuGyCj7 zXn@U{uk*<1jNceLLZ2NzKy19az(_Bz_vcnd$o@d;pm_2MOwjNP+58H-$|`D^FWmB8 z^W*ZcZh;AoPG39p_=oo@tv@G8P5?pR)rleI{sgO@ca+RaosQI|K(WF|qZ>TG9Ehz6 z_ex)aboLP0l?2cYXE$^jHYz5`fu)wmz|0&=Q!)G;C|~Uc2tY9B{B&11FWfxXelsFAxI2yKZsi{-p3xFOI!=c!ZX>F$p zKT8up+Cl;Nu>OYr0NqmcE;0kY3O_8v+d*4t7cFAgY_64piLwg(SZ~JN1r|z^6AzahBSh2nN|gEsSFr zi7Z>;adtH-EIJ_oz2w#8VX1=5}!*mI^Dm&wl#Yc?WBicU{3;oP*5kx6atIERpf@`X|vIJ2YCm1 zmzb5AVS~XCpTQn&BheQ!lS7K?#WR3c?g$m7zV=lb%G6>>$dAX5(a{y4y^ zo)f~-1;!OKLkFnc2j_$=ljaE?TE<=xjWY^^S7+@LT;#_=nhuzY!x;6IqRL!9t~Kd| z0q)hnM62fC%2pW;u%jCc7^p54%`)c)QKcWvhAgmN;;4e)Qcyk^_%%-J;hf1lF^*Wt zc7qW03?XA^9oXpyFmtft4dgv=%~GDx&u*Vf8ONZ~oJy#=+?NN7X7EBQP$4E+`qxsA z!R&RI+VRA#VCily5ls~m)7ot}-q}+>TYisg?pga@;Rr|Gv~3BVZ$X79)APo1%j}q^4kkbVBP$&Y$<0<82dw=mD$KW=p7&U z82f3z!C1ExDE$N?$V@DdM$O}clH+^a?b@A>hLyrtS%!qv6`Y-yj_$2*L4dDmFOKO- z*_G@~{GAL=IJ)$r@JDzvdn70h1X6zbmbn*hjCo@W7=;>NeJG3vP5!|!$HOieGptF- z$ltXrmah)_vBuAi2+Vaj!$%HxN*}^sDH4;ap7sv7qz7}&2d7_bvWwaqomMFtPu_FT zy$=eo-gWYk^G+zbu(4SOwS%q@;TltI6nN8|Gho*-N|qOlH7kunFrpr=qXyu66)?Lx zIJr3elNx!5*_RaTP^z^!s>-+N`JITflLfKD-3O_!rl2akM@YNWlBwBPKIt+pbpibE z3zjk%W73G=$6vL#-3|TNgs#Dg>*=yn-0NTPulrZUy~2+Td{KK0CXyB0L&9?#oGXQC zoX@*S<>0=`&@p!91;=hIZ10ie2kWlXLP4oiRQ&P|g?QzP@t3EgfzoS8mN^$^LuU9X b`o^z3u~E$s>H(0Gr~WSFig2MI^_DO~$+fru diff --git a/man/add_mapping.Rd b/man/add_mapping.Rd deleted file mode 100644 index 8197ab96..00000000 --- a/man/add_mapping.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/add_mapping.R -\name{add_mapping} -\alias{add_mapping} -\title{Add Additional Mapping} -\usage{ -add_mapping(plot, ...) -} -\arguments{ -\item{plot}{a \code{ggplot2} plot} - -\item{...}{arguments passed on to \code{\link[ggplot2:aes]{ggplot2::aes()}}} -} -\description{ -This function can be used to adjust the mapping of a plot. -} -\examples{ -p <- iris |> plot2(Sepal.Length, Sepal.Width, Species, zoom = TRUE) -p - -p |> add_mapping(shape = Species) -} diff --git a/man/add_type.Rd b/man/add_type.Rd deleted file mode 100644 index bf4c34e2..00000000 --- a/man/add_type.Rd +++ /dev/null @@ -1,251 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/add_type.R -\name{add_type} -\alias{add_type} -\alias{add_line} -\alias{add_point} -\alias{add_col} -\alias{add_errorbar} -\alias{add_sf} -\title{Add Plot Element} -\usage{ -add_type(plot, type = NULL, mapping = aes(), ..., data = NULL, move = 0) - -add_line( - plot, - y = NULL, - x = NULL, - colour = getOption("plot2.colour", "ggplot2"), - linetype, - linewidth, - ..., - inherit.aes = NULL, - move = 0, - legend.value = NULL -) - -add_point( - plot, - y = NULL, - x = NULL, - colour = getOption("plot2.colour", "ggplot2"), - size, - shape, - ..., - inherit.aes = NULL, - move = 0, - legend.value = NULL -) - -add_col( - plot, - y = NULL, - x = NULL, - colour = getOption("plot2.colour", "ggplot2"), - colour_fill, - width, - ..., - inherit.aes = NULL, - move = 0, - legend.value = NULL -) - -add_errorbar( - plot, - min, - max, - colour = getOption("plot2.colour", "ggplot2"), - width = 0.5, - ..., - inherit.aes = FALSE, - move = 0 -) - -add_sf( - plot, - sf_data, - colour = getOption("plot2.colour_sf", "grey50"), - colour_fill = getOption("plot2.colour_sf_fill", getOption("plot2.colour", "ggplot2")), - size = 2, - linewidth = 0.1, - datalabels = NULL, - datalabels.colour = "black", - datalabels.size = 3, - datalabels.angle = 0, - datalabels.font = getOption("plot2.font"), - datalabels.nudge_y = 2500, - ..., - inherit.aes = FALSE -) -} -\arguments{ -\item{plot}{a \code{ggplot2} plot} - -\item{type}{a \code{ggplot2} geom name, all geoms are supported. Full function names can be used (e.g., \code{"geom_line"}), but they can also be abbreviated (e.g., \code{"l"}, \code{"line"}). These geoms can be abbreviated by their first character: area (\code{"a"}), boxplot (\code{"b"}), column (\code{"c"}), histogram (\code{"h"}), jitter (\code{"j"}), line (\code{"l"}), point (\code{"p"}), ribbon (\code{"r"}), violin (\code{"v"}).} - -\item{mapping}{a mapping created with \code{\link[ggplot2:aes]{aes()}} to pass on to the geom} - -\item{data}{data to use in mapping} - -\item{move}{number of layers to move the newly added geom down, e.g., \code{move = 1} will place the newly added geom down 1 layer, thus directly under the highest layer} - -\item{x, y}{aesthetic arguments} - -\item{colour, colour_fill}{colour of the line or column, will be evaluated with \code{\link[certestyle:colourpicker]{certestyle::colourpicker()}}. If \code{colour_fill} is missing but \code{colour} is given, \code{colour_fill} will inherit the colour set with \code{colour}.} - -\item{linetype, linewidth, shape, size, width, ...}{arguments passed on to the geom} - -\item{inherit.aes}{a \link{logical} to indicate whether the default aesthetics should be inherited, rather than combining with them} - -\item{legend.value}{text to show in an additional legend that will be created. Since \code{ggplot2} does not actually support this, it may give some false-positive warnings or messages, such as "Removed 1 row containing missing values or values outside the scale range".} - -\item{min, max}{minimum (lower) and maximum (upper) values of the error bars} - -\item{sf_data}{an 'sf' \link{data.frame}, such as the outcome of \code{\link[certegis:geocoding]{certegis::geocode()}}} - -\item{datalabels}{a column of \code{sf_data} to add as label below the points} - -\item{datalabels.colour, datalabels.size, datalabels.angle, datalabels.font}{properties of \code{datalabels}} - -\item{datalabels.nudge_y}{is \code{datalabels} is not \code{NULL}, the amount of vertical adjustment of the datalabels (positive value: more to the North, negative value: more to the South)} -} -\value{ -a \code{ggplot} object -} -\description{ -Quickly and conveniently add a new 'geom' to an existing \code{plot2}/\code{ggplot} model. Like \code{\link[=plot2]{plot2()}}, these functions support tidy evaluation, meaning that variables can be unquoted. Better yet, they can contain any function with any output length, or any vector. They can be added using the pipe (new base \R's \verb{|>} or tidyverse's \verb{\%>\%}). -} -\details{ -The function \code{\link[=add_line]{add_line()}} will add: -\itemize{ -\item \code{\link[ggplot2:geom_abline]{geom_hline()}} if only \code{y} is provided; -\item \code{\link[ggplot2:geom_abline]{geom_vline()}} if only \code{x} is provided; -\item \code{\link[ggplot2:geom_path]{geom_line()}} in all other cases. -} - -The function \code{\link[=add_errorbar]{add_errorbar()}} only adds error bars to the \code{y} values, see \emph{Examples}. -} -\examples{ -head(iris) - -p <- iris |> - plot2(x = Sepal.Length, - y = Sepal.Width, - category = Species, - zoom = TRUE) -p - -# if not specifying x or y, current plot data are taken -p |> add_line() - -# single values for add_line() will plot 'hline' or 'vline' -# even considering the `category` if set -p |> - add_line(y = mean(Sepal.Width)) - -# set `colour` to ignore existing colours -# and use `legend.value` to add a legend -p |> - add_line(y = mean(Sepal.Width), - colour = "red", - legend.value = "Average") - -p |> - add_line(x = mean(Sepal.Length)) |> - add_line(y = mean(Sepal.Width)) - -p |> - add_point(x = median(Sepal.Length), - y = median(Sepal.Width), - shape = 13, - size = 25, - show.legend = FALSE) - -# multiple values will just plot multiple lines -p |> - add_line(y = fivenum(Sepal.Width), - colour = "blue", - legend.value = "Tukey's Numbers") - -p |> - add_line(y = quantile(Sepal.Width, c(0.25, 0.5, 0.75)), - colour = c("red", "black", "red"), - linewidth = 1) - -# use move to move the new layer down -p |> - add_point(size = 5, - colour = "lightpink", - move = -1) - -# providing x and y will just plot the points as new data, -p |> - add_point(y = 2:4, - x = 5:7, - colour = "red", - size = 5) -# even with expanded grid if x and y are not of the same length -p |> - add_point(y = 2:4, - x = 5:8, - colour = "red", - size = 5) - -# any mathematical transformation of current values is supported -df <- data.frame(var_1 = c(1:100), - var_2 = rnorm(100, 100, 25)) -df |> - plot2() |> - add_line(y = mean(var_2), - linetype = 3, - legend.value = "Average") |> - add_col(y = var_2 / 5, - width = 0.25, - colour = "blue", - legend.value = "This *is* **some** symbol: $beta$") - -# plotting error bars was never easier -if (require("dplyr", warn.conflicts = FALSE)) { - df2 <- df |> - as_tibble() |> - slice(1:25) |> - filter(var_1 <= 50) |> - mutate(error1 = var_2 * 0.9, - error2 = var_2 * 1.1) - - print(df2) - - df2 |> - plot2(type = "col", datalabels = FALSE, alpha = 0.25, width = 0.75) |> - # add the error bars, simply by referencing the lower and upper values - add_errorbar(error1, error2) -} - -if (require("certestats", warn.conflicts = FALSE)) { - df |> - plot2() |> - add_line(y = ewma(var_2, 0.75), - colour = "certeroze", - linewidth = 1) -} - -if (require("certegis")) { - hospitals <- geocode(c("Martini Ziekenhuis", - "Medisch Centrum Leeuwarden", - "Tjongerschans Heerenveen", - "Treant Emmen")) - geo_gemeenten |> - crop_certe() |> - plot2(datalabels = FALSE, - category.title = "Inhabitants", - colour_fill = c("white", "certeblauw2")) |> - add_sf(hospitals, - colour = "certeroze", - datalabels = place) |> - add_sf(geo_provincies |> crop_certe(), - colour_fill = NA, - colour = "certeblauw", - linetype = 2, - linewidth = 0.5) -} -} diff --git a/man/admitted_patients.Rd b/man/admitted_patients.Rd deleted file mode 100644 index d08a6ad9..00000000 --- a/man/admitted_patients.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{admitted_patients} -\alias{admitted_patients} -\title{Example Data Set with Admitted Patients} -\format{ -A \link{tibble}/\link{data.frame} with 250 observations and 7 variables: -\itemize{ -\item \code{date}\cr date of hospital admission -\item \code{patient_id}\cr ID of the patient (fictitious) -\item \code{gender}\cr gender of the patient -\item \code{age}\cr age of the patient -\item \code{age_group}\cr age group of the age of the patient, generated with \code{\link[AMR:age_groups]{AMR::age_groups()}} -\item \code{hospital}\cr ID of the hospital, from A to D -\item \code{ward}\cr type of ward, either ICU or Non-ICU -} -} -\usage{ -admitted_patients -} -\description{ -An auto-generated data set containing fictitious patients admitted to hospitals. -} -\keyword{datasets} diff --git a/man/certeplot2-package.Rd b/man/certeplot2-package.Rd index 8cc5d066..6b0afb3d 100644 --- a/man/certeplot2-package.Rd +++ b/man/certeplot2-package.Rd @@ -6,7 +6,7 @@ \alias{certeplot2-package} \title{certeplot2: A Certe R Package for Convenient Plotting} \description{ -A Certe R Package for fast and convenient plotting, by providing wrappers around 'tidyverse' packages such as 'ggplot2', while also providing plotting in the Certe organisational style. This package is part of the 'certedata' universe. +A Certe R Package for fast and convenient plotting based on 'plot2', by providing wrappers around 'tidyverse' packages such as 'ggplot2', while also providing plotting in the Certe organisational style. This package is part of the 'certedata' universe. } \seealso{ Useful links: diff --git a/man/get_plot_title.Rd b/man/get_plot_title.Rd deleted file mode 100644 index f8794df3..00000000 --- a/man/get_plot_title.Rd +++ /dev/null @@ -1,32 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_plot_title.R -\name{get_plot_title} -\alias{get_plot_title} -\title{Get Plot Title} -\usage{ -get_plot_title(plot, valid_filename = TRUE, default = NULL) -} -\arguments{ -\item{plot}{a \code{ggplot2} plot} - -\item{valid_filename}{a \link{logical} to indicate whether the returned value should be a valid filename, defaults to \code{TRUE}} - -\item{default}{the default value, if a plot title is absent} -} -\description{ -Get the title of the plot, or a default value. If the title is not set in a plot, this function tries to generate one from the plot mapping. -} -\examples{ -without_title <- plot2(mtcars) -with_title <- plot2(mtcars, title = "Plotting **mpg** vs. **cyl**!") - -# default is a guess: -get_plot_title(without_title) -get_plot_title(without_title, valid_filename = FALSE) -get_plot_title(with_title) -get_plot_title(with_title, valid_filename = FALSE) - -# unless 'default' is set (only affects plots without title): -get_plot_title(without_title, default = "title") -get_plot_title(with_title, default = "title") -} diff --git a/man/labellers.Rd b/man/labellers.Rd deleted file mode 100644 index d7ba9e84..00000000 --- a/man/labellers.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/labellers.R -\name{labellers} -\alias{labellers} -\alias{euros} -\alias{dollars} -\title{Label Euro currencies} -\usage{ -euros(x, big.mark = big_mark(), decimal.mark = dec_mark(), ...) - -dollars(x, big.mark = big_mark(), decimal.mark = dec_mark(), ...) -} -\arguments{ -\item{x}{values} - -\item{big.mark}{thousands separator, defaults to \code{\link[=big_mark]{big_mark()}}} - -\item{decimal.mark}{decimal mark, defaults to \code{\link[=dec_mark]{dec_mark()}}} - -\item{...}{any argument to give to the geom. This will override automatically-set settings for the geom.} -} -\description{ -Format numbers as currency, rounding values to dollars or cents using a convenient heuristic. -} -\examples{ -\dontrun{ -profit <- data.frame(group = LETTERS[1:4], - profit = runif(4, 10000, 25000)) - -profit |> - plot2(y.labels = euros, - datalabels = FALSE) - -profit |> - plot2(y.labels = euros, - datalabels.format = euros) -} -} diff --git a/man/md_to_expression.Rd b/man/md_to_expression.Rd deleted file mode 100644 index db5abcbb..00000000 --- a/man/md_to_expression.Rd +++ /dev/null @@ -1,51 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/md_to_expression.R -\name{md_to_expression} -\alias{md_to_expression} -\title{Convert Markdown to Plotmath Expression} -\usage{ -md_to_expression(x) -} -\arguments{ -\item{x}{text to convert, only the first value will be evaluated} -} -\value{ -An \link{expression} if \code{x} is length 1, or a \link{list} of expressions otherwise -} -\description{ -This function converts common markdown language to an \R \link[grDevices:plotmath]{plotmath} expression. \code{\link[=plot2]{plot2()}} uses this function internally to convert plot titles and axis titles. -} -\details{ -This function only supports common markdown (italic, bold, bold-italic, subscript, superscript), but also supports some additional functionalities for more advanced expressions using \R \link[grDevices:plotmath]{plotmath}. Please see \emph{Examples}. - -In \code{\link[=plot2]{plot2()}}, this function can be also set to argument \code{category.labels} to print the data values as expressions: -\itemize{ -\item \code{plot2(..., category.labels = md_to_expression)} -} -} -\examples{ -# use '*' for italics, not '_', to prevent conflicts with variable naming -md_to_expression("this is *italic* text, this is _not italic_ text") - -md_to_expression("this is **bold** text") - -md_to_expression("this is ***bold and italic*** text") - -# subscript and superscript can be done in HTML or markdown with curly brackets: -md_to_expression("this is somesubscripted text, this is also_{subscripted} text") -md_to_expression("this is somesuperscripted text, this is also^{superscripted} text") - -# use $...$ to use any plotmath expression as-is (see ?plotmath): -md_to_expression("text $omega$ text, $a[x]$") - -mtcars |> - plot2(mpg, hp, - title = "*These are* the **Greek** lower $omega$ and upper $Omega$", - x.title = "x_{mpg}", - y.title = "y_{hp}") - -mtcars |> - plot2(mpg, hp, - title = "$f[X](x)==frac(1, sigma*sqrt(2*pi))*plain(e)^{frac(-(x-mu)^2, 2*sigma^2)}$", - subtitle = "Some insane $widehat(plotmath)$ title") -} diff --git a/man/move_layer.Rd b/man/move_layer.Rd deleted file mode 100644 index 917ee284..00000000 --- a/man/move_layer.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/move_layer.R -\name{move_layer} -\alias{move_layer} -\title{Move a \code{ggplot} Layer} -\usage{ -move_layer(plot, move = -1, layer = length(plot$layers)) -} -\arguments{ -\item{plot}{a \code{ggplot} object} - -\item{move}{number of layers to move \code{layer} up or down} - -\item{layer}{the layer to affect, defaults to top layer} -} -\description{ -Use this function to move a certain plot layer up or down. This function returns a \code{ggplot} object. -} diff --git a/man/netherlands.Rd b/man/netherlands.Rd deleted file mode 100644 index 90c8956f..00000000 --- a/man/netherlands.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{netherlands} -\alias{netherlands} -\title{Example Geography Data Set: the Netherlands} -\format{ -A \link{data.frame} with 12 observations and 3 variables: -\itemize{ -\item \code{province}\cr name of the Dutch province -\item \code{area_km2}\cr area in square kilometres -\item \code{geometry}\cr geometry of the province, of class sfc_MULTIPOLYGON/sfc -} -} -\usage{ -netherlands -} -\description{ -A data set containing the geometies of the twelve provinces of the Netherlands, according to Statistics Netherlands (2021). -} -\keyword{datasets} diff --git a/man/plot2-methods.Rd b/man/plot2-extensions.Rd similarity index 65% rename from man/plot2-methods.Rd rename to man/plot2-extensions.Rd index 30c68512..5612fbe0 100644 --- a/man/plot2-methods.Rd +++ b/man/plot2-extensions.Rd @@ -1,12 +1,7 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot2-methods.R -\name{plot2-methods} -\alias{plot2-methods} -\alias{plot2.default} -\alias{plot2.freq} -\alias{plot2.sf} -\alias{plot2.data.frame} -\alias{plot2.matrix} +% Please edit documentation in R/certeplot2-methods.R +\name{plot2-extensions} +\alias{plot2-extensions} \alias{plot2.bug_drug_combinations} \alias{plot2.antibiogram} \alias{plot2.sir_df} @@ -14,776 +9,6 @@ \alias{plot2.early_warning_cluster} \title{Methods for \code{\link[=plot2]{plot2()}}} \usage{ -\method{plot2}{default}( - .data, - x = NULL, - y = NULL, - category = NULL, - facet = NULL, - type = NULL, - x.title = TRUE, - y.title = TRUE, - category.title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - tag = NULL, - title.linelength = 60, - title.colour = getOption("plot2.colour_font_primary", "black"), - subtitle.linelength = 60, - subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), - na.replace = "", - na.rm = FALSE, - facet.position = "top", - facet.fill = NULL, - facet.bold = TRUE, - facet.italic = FALSE, - facet.size = 10, - facet.margin = 8, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = TRUE, - facet.fixed_y = NULL, - facet.fixed_x = TRUE, - facet.drop = FALSE, - facet.nrow = NULL, - facet.relative = FALSE, - x.date_breaks = NULL, - x.date_labels = NULL, - x.date_remove_years = NULL, - category.focus = NULL, - colour = getOption("plot2.colour", "ggplot2"), - colour_fill = NULL, - colour_opacity = 0, - x.lbl_angle = 0, - x.lbl_align = NULL, - x.lbl_italic = FALSE, - x.lbl_taxonomy = FALSE, - x.remove = FALSE, - x.position = "bottom", - x.max_items = Inf, - x.max_txt = "(rest, x\%n)", - category.max_items = Inf, - category.max_txt = "(rest, x\%n)", - facet.max_items = Inf, - facet.max_txt = "(rest, x\%n)", - x.breaks = NULL, - x.n_breaks = NULL, - x.transform = "identity", - x.expand = NULL, - x.limits = NULL, - x.labels = NULL, - x.character = NULL, - x.drop = FALSE, - x.mic = FALSE, - x.zoom = FALSE, - y.remove = FALSE, - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - y.breaks = NULL, - y.n_breaks = NULL, - y.limits = NULL, - y.labels = NULL, - y.expand = NULL, - y.transform = "identity", - y.position = "left", - y.zoom = FALSE, - y_secondary = NULL, - y_secondary.type = type, - y_secondary.title = TRUE, - y_secondary.colour = "certeroze", - y_secondary.colour_fill = "certeroze6", - y_secondary.scientific = NULL, - y_secondary.percent = FALSE, - y_secondary.labels = NULL, - category.labels = NULL, - category.percent = FALSE, - category.breaks = NULL, - category.limits = NULL, - category.expand = 0, - category.midpoint = NULL, - category.transform = "identity", - category.date_breaks = NULL, - category.date_labels = NULL, - category.character = NULL, - x.sort = NULL, - category.sort = TRUE, - facet.sort = TRUE, - x.complete = NULL, - category.complete = NULL, - facet.complete = NULL, - datalabels = TRUE, - datalabels.round = ifelse(y.percent, 2, 1), - datalabels.format = "\%n", - datalabels.colour = "grey25", - datalabels.colour_fill = NULL, - datalabels.size = (3 * text_factor), - datalabels.angle = 0, - datalabels.lineheight = 1, - decimal.mark = dec_mark(), - big.mark = big_mark(), - summarise_function = base::sum, - stacked = FALSE, - stackedpercent = FALSE, - horizontal = FALSE, - reverse = horizontal, - smooth = NULL, - smooth.method = NULL, - smooth.formula = NULL, - smooth.se = TRUE, - smooth.level = 0.95, - smooth.alpha = 0.25, - smooth.linewidth = 0.75, - smooth.linetype = 3, - smooth.colour = NULL, - size = NULL, - linetype = 1, - linewidth = NULL, - binwidth = NULL, - width = NULL, - jitter_seed = NA, - violin_scale = "count", - legend.position = NULL, - legend.title = NULL, - legend.reverse = FALSE, - legend.barheight = 6, - legend.barwidth = 1.5, - legend.nbin = 300, - legend.italic = FALSE, - sankey.node_width = 0.15, - sankey.node_whitespace = 0.03, - sankey.alpha = 0.5, - sankey.remove_axes = NULL, - zoom = FALSE, - sep = " / ", - print = FALSE, - text_factor = 1, - font = getOption("plot2.font"), - theme = getOption("plot2.theme", "theme_minimal2"), - background = getOption("plot2.colour_background", "white"), - markdown = TRUE, - ... -) - -\method{plot2}{freq}( - .data, - x = .data$item, - y = .data$count, - category = NULL, - facet = NULL, - type = NULL, - x.title = "Item", - y.title = "Count", - category.title = TRUE, - title = NULL, - subtitle = NULL, - caption = NULL, - tag = NULL, - title.linelength = 60, - title.colour = getOption("plot2.colour_font_primary", "black"), - subtitle.linelength = 60, - subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), - na.replace = "", - na.rm = FALSE, - facet.position = "top", - facet.fill = NULL, - facet.bold = TRUE, - facet.italic = FALSE, - facet.size = 10, - facet.margin = 8, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = TRUE, - facet.fixed_y = NULL, - facet.fixed_x = TRUE, - facet.drop = FALSE, - facet.nrow = NULL, - facet.relative = FALSE, - x.date_breaks = NULL, - x.date_labels = NULL, - x.date_remove_years = NULL, - category.focus = NULL, - colour = getOption("plot2.colour", "ggplot2"), - colour_fill = NULL, - colour_opacity = 0, - x.lbl_angle = 0, - x.lbl_align = NULL, - x.lbl_italic = FALSE, - x.lbl_taxonomy = FALSE, - x.remove = FALSE, - x.position = "bottom", - x.max_items = Inf, - x.max_txt = "(rest, x\%n)", - category.max_items = Inf, - category.max_txt = "(rest, x\%n)", - facet.max_items = Inf, - facet.max_txt = "(rest, x\%n)", - x.breaks = NULL, - x.n_breaks = NULL, - x.transform = "identity", - x.expand = NULL, - x.limits = NULL, - x.labels = NULL, - x.character = NULL, - x.drop = FALSE, - x.mic = FALSE, - x.zoom = FALSE, - y.remove = FALSE, - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - y.breaks = NULL, - y.n_breaks = NULL, - y.limits = NULL, - y.labels = NULL, - y.expand = NULL, - y.transform = "identity", - y.position = "left", - y.zoom = FALSE, - y_secondary = NULL, - y_secondary.type = type, - y_secondary.title = TRUE, - y_secondary.colour = "certeroze", - y_secondary.colour_fill = "certeroze6", - y_secondary.scientific = NULL, - y_secondary.percent = FALSE, - y_secondary.labels = NULL, - category.labels = NULL, - category.percent = FALSE, - category.breaks = NULL, - category.limits = NULL, - category.expand = 0, - category.midpoint = NULL, - category.transform = "identity", - category.date_breaks = NULL, - category.date_labels = NULL, - category.character = NULL, - x.sort = "freq-desc", - category.sort = TRUE, - facet.sort = TRUE, - x.complete = NULL, - category.complete = NULL, - facet.complete = NULL, - datalabels = TRUE, - datalabels.round = ifelse(y.percent, 2, 1), - datalabels.format = "\%n", - datalabels.colour = "grey25", - datalabels.colour_fill = NULL, - datalabels.size = (3 * text_factor), - datalabels.angle = 0, - datalabels.lineheight = 1, - decimal.mark = dec_mark(), - big.mark = big_mark(), - summarise_function = base::sum, - stacked = FALSE, - stackedpercent = FALSE, - horizontal = FALSE, - reverse = horizontal, - smooth = NULL, - smooth.method = NULL, - smooth.formula = NULL, - smooth.se = TRUE, - smooth.level = 0.95, - smooth.alpha = 0.25, - smooth.linewidth = 0.75, - smooth.linetype = 3, - smooth.colour = NULL, - size = NULL, - linetype = 1, - linewidth = NULL, - binwidth = NULL, - width = NULL, - jitter_seed = NA, - violin_scale = "count", - legend.position = NULL, - legend.title = NULL, - legend.reverse = FALSE, - legend.barheight = 6, - legend.barwidth = 1.5, - legend.nbin = 300, - legend.italic = FALSE, - sankey.node_width = 0.15, - sankey.node_whitespace = 0.03, - sankey.alpha = 0.5, - sankey.remove_axes = NULL, - zoom = FALSE, - sep = " / ", - print = FALSE, - text_factor = 1, - font = getOption("plot2.font"), - theme = getOption("plot2.theme", "theme_minimal2"), - background = getOption("plot2.colour_background", "white"), - markdown = TRUE, - ... -) - -\method{plot2}{sf}( - .data, - x = NULL, - y = NULL, - category = NULL, - facet = NULL, - type = NULL, - x.title = FALSE, - y.title = FALSE, - category.title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - tag = NULL, - title.linelength = 60, - title.colour = getOption("plot2.colour_font_primary", "black"), - subtitle.linelength = 60, - subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), - na.replace = "", - na.rm = FALSE, - facet.position = "top", - facet.fill = NULL, - facet.bold = TRUE, - facet.italic = FALSE, - facet.size = 10, - facet.margin = 8, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = TRUE, - facet.fixed_y = NULL, - facet.fixed_x = TRUE, - facet.drop = FALSE, - facet.nrow = NULL, - facet.relative = FALSE, - x.date_breaks = NULL, - x.date_labels = NULL, - x.date_remove_years = NULL, - category.focus = NULL, - colour = getOption("plot2.colour_sf", "grey50"), - colour_fill = getOption("plot2.colour_sf_fill", getOption("plot2.colour", "ggplot2")), - colour_opacity = 0, - x.lbl_angle = 0, - x.lbl_align = NULL, - x.lbl_italic = FALSE, - x.lbl_taxonomy = FALSE, - x.remove = FALSE, - x.position = "bottom", - x.max_items = Inf, - x.max_txt = "(rest, x\%n)", - category.max_items = Inf, - category.max_txt = "(rest, x\%n)", - facet.max_items = Inf, - facet.max_txt = "(rest, x\%n)", - x.breaks = NULL, - x.n_breaks = NULL, - x.transform = "identity", - x.expand = 0, - x.limits = NULL, - x.labels = NULL, - x.character = NULL, - x.drop = FALSE, - x.mic = FALSE, - x.zoom = FALSE, - y.remove = FALSE, - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - y.breaks = NULL, - y.n_breaks = NULL, - y.limits = NULL, - y.labels = NULL, - y.expand = 0, - y.transform = "identity", - y.position = "left", - y.zoom = FALSE, - y_secondary = NULL, - y_secondary.type = type, - y_secondary.title = TRUE, - y_secondary.colour = "certeroze", - y_secondary.colour_fill = "certeroze6", - y_secondary.scientific = NULL, - y_secondary.percent = FALSE, - y_secondary.labels = NULL, - category.labels = NULL, - category.percent = FALSE, - category.breaks = NULL, - category.limits = NULL, - category.expand = 0, - category.midpoint = NULL, - category.transform = "identity", - category.date_breaks = NULL, - category.date_labels = NULL, - category.character = NULL, - x.sort = NULL, - category.sort = TRUE, - facet.sort = TRUE, - x.complete = NULL, - category.complete = NULL, - facet.complete = NULL, - datalabels = TRUE, - datalabels.round = ifelse(y.percent, 2, 1), - datalabels.format = NULL, - datalabels.colour = "black", - datalabels.colour_fill = NULL, - datalabels.size = (3 * text_factor), - datalabels.angle = 0, - datalabels.lineheight = 1, - decimal.mark = dec_mark(), - big.mark = big_mark(), - summarise_function = base::sum, - stacked = FALSE, - stackedpercent = FALSE, - horizontal = FALSE, - reverse = horizontal, - smooth = NULL, - smooth.method = NULL, - smooth.formula = NULL, - smooth.se = TRUE, - smooth.level = 0.95, - smooth.alpha = 0.25, - smooth.linewidth = 0.75, - smooth.linetype = 3, - smooth.colour = NULL, - size = NULL, - linetype = 1, - linewidth = NULL, - binwidth = NULL, - width = NULL, - jitter_seed = NA, - violin_scale = "count", - legend.position = "right", - legend.title = NULL, - legend.reverse = FALSE, - legend.barheight = 6, - legend.barwidth = 1.5, - legend.nbin = 300, - legend.italic = FALSE, - sankey.node_width = 0.15, - sankey.node_whitespace = 0.03, - sankey.alpha = 0.5, - sankey.remove_axes = NULL, - zoom = FALSE, - sep = " / ", - print = FALSE, - text_factor = 1, - font = getOption("plot2.font"), - theme = theme_minimal2(panel.grid.major = element_blank(), panel.grid.minor = - element_blank(), panel.border = element_blank(), plot.margin = unit(c(5, 5, 0, 0), - units = "pt"), axis.title = element_blank(), axis.text = element_blank(), axis.line = - element_blank(), axis.ticks = element_blank()), - background = getOption("plot2.colour_background", "white"), - markdown = TRUE, - crs = NULL, - datalabels.centroid = NULL, - ... -) - -\method{plot2}{data.frame}( - .data, - x = NULL, - y = NULL, - category = NULL, - facet = NULL, - type = NULL, - x.title = TRUE, - y.title = TRUE, - category.title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - tag = NULL, - title.linelength = 60, - title.colour = getOption("plot2.colour_font_primary", "black"), - subtitle.linelength = 60, - subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), - na.replace = "", - na.rm = FALSE, - facet.position = "top", - facet.fill = NULL, - facet.bold = TRUE, - facet.italic = FALSE, - facet.size = 10, - facet.margin = 8, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = TRUE, - facet.fixed_y = NULL, - facet.fixed_x = TRUE, - facet.drop = FALSE, - facet.nrow = NULL, - facet.relative = FALSE, - x.date_breaks = NULL, - x.date_labels = NULL, - x.date_remove_years = NULL, - category.focus = NULL, - colour = getOption("plot2.colour", "ggplot2"), - colour_fill = NULL, - colour_opacity = 0, - x.lbl_angle = 0, - x.lbl_align = NULL, - x.lbl_italic = FALSE, - x.lbl_taxonomy = FALSE, - x.remove = FALSE, - x.position = "bottom", - x.max_items = Inf, - x.max_txt = "(rest, x\%n)", - category.max_items = Inf, - category.max_txt = "(rest, x\%n)", - facet.max_items = Inf, - facet.max_txt = "(rest, x\%n)", - x.breaks = NULL, - x.n_breaks = NULL, - x.transform = "identity", - x.expand = NULL, - x.limits = NULL, - x.labels = NULL, - x.character = NULL, - x.drop = FALSE, - x.mic = FALSE, - x.zoom = FALSE, - y.remove = FALSE, - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - y.breaks = NULL, - y.n_breaks = NULL, - y.limits = NULL, - y.labels = NULL, - y.expand = NULL, - y.transform = "identity", - y.position = "left", - y.zoom = FALSE, - y_secondary = NULL, - y_secondary.type = type, - y_secondary.title = TRUE, - y_secondary.colour = "certeroze", - y_secondary.colour_fill = "certeroze6", - y_secondary.scientific = NULL, - y_secondary.percent = FALSE, - y_secondary.labels = NULL, - category.labels = NULL, - category.percent = FALSE, - category.breaks = NULL, - category.limits = NULL, - category.expand = 0, - category.midpoint = NULL, - category.transform = "identity", - category.date_breaks = NULL, - category.date_labels = NULL, - category.character = NULL, - x.sort = NULL, - category.sort = TRUE, - facet.sort = TRUE, - x.complete = NULL, - category.complete = NULL, - facet.complete = NULL, - datalabels = TRUE, - datalabels.round = ifelse(y.percent, 2, 1), - datalabels.format = "\%n", - datalabels.colour = "grey25", - datalabels.colour_fill = NULL, - datalabels.size = (3 * text_factor), - datalabels.angle = 0, - datalabels.lineheight = 1, - decimal.mark = dec_mark(), - big.mark = big_mark(), - summarise_function = base::sum, - stacked = FALSE, - stackedpercent = FALSE, - horizontal = FALSE, - reverse = horizontal, - smooth = NULL, - smooth.method = NULL, - smooth.formula = NULL, - smooth.se = TRUE, - smooth.level = 0.95, - smooth.alpha = 0.25, - smooth.linewidth = 0.75, - smooth.linetype = 3, - smooth.colour = NULL, - size = NULL, - linetype = 1, - linewidth = NULL, - binwidth = NULL, - width = NULL, - jitter_seed = NA, - violin_scale = "count", - legend.position = NULL, - legend.title = NULL, - legend.reverse = FALSE, - legend.barheight = 6, - legend.barwidth = 1.5, - legend.nbin = 300, - legend.italic = FALSE, - sankey.node_width = 0.15, - sankey.node_whitespace = 0.03, - sankey.alpha = 0.5, - sankey.remove_axes = NULL, - zoom = FALSE, - sep = " / ", - print = FALSE, - text_factor = 1, - font = getOption("plot2.font"), - theme = getOption("plot2.theme", "theme_minimal2"), - background = getOption("plot2.colour_background", "white"), - markdown = TRUE, - ... -) - -\method{plot2}{matrix}( - .data, - x = NULL, - y = NULL, - category = NULL, - facet = NULL, - type = NULL, - x.title = FALSE, - y.title = FALSE, - category.title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - tag = NULL, - title.linelength = 60, - title.colour = getOption("plot2.colour_font_primary", "black"), - subtitle.linelength = 60, - subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), - na.replace = "", - na.rm = FALSE, - facet.position = "top", - facet.fill = NULL, - facet.bold = TRUE, - facet.italic = FALSE, - facet.size = 10, - facet.margin = 8, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = TRUE, - facet.fixed_y = NULL, - facet.fixed_x = TRUE, - facet.drop = FALSE, - facet.nrow = NULL, - facet.relative = FALSE, - x.date_breaks = NULL, - x.date_labels = NULL, - x.date_remove_years = NULL, - category.focus = NULL, - colour = getOption("plot2.colour", "ggplot2"), - colour_fill = NULL, - colour_opacity = 0, - x.lbl_angle = 0, - x.lbl_align = NULL, - x.lbl_italic = FALSE, - x.lbl_taxonomy = FALSE, - x.remove = FALSE, - x.position = "bottom", - x.max_items = Inf, - x.max_txt = "(rest, x\%n)", - category.max_items = Inf, - category.max_txt = "(rest, x\%n)", - facet.max_items = Inf, - facet.max_txt = "(rest, x\%n)", - x.breaks = NULL, - x.n_breaks = NULL, - x.transform = "identity", - x.expand = NULL, - x.limits = NULL, - x.labels = NULL, - x.character = NULL, - x.drop = FALSE, - x.mic = FALSE, - x.zoom = FALSE, - y.remove = FALSE, - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - y.breaks = NULL, - y.n_breaks = NULL, - y.limits = NULL, - y.labels = NULL, - y.expand = NULL, - y.transform = "identity", - y.position = "left", - y.zoom = FALSE, - y_secondary = NULL, - y_secondary.type = type, - y_secondary.title = TRUE, - y_secondary.colour = "certeroze", - y_secondary.colour_fill = "certeroze6", - y_secondary.scientific = NULL, - y_secondary.percent = FALSE, - y_secondary.labels = NULL, - category.labels = NULL, - category.percent = FALSE, - category.breaks = NULL, - category.limits = NULL, - category.expand = 0, - category.midpoint = NULL, - category.transform = "identity", - category.date_breaks = NULL, - category.date_labels = NULL, - category.character = NULL, - x.sort = NULL, - category.sort = TRUE, - facet.sort = TRUE, - x.complete = NULL, - category.complete = NULL, - facet.complete = NULL, - datalabels = TRUE, - datalabels.round = ifelse(y.percent, 2, 1), - datalabels.format = "\%n", - datalabels.colour = "grey25", - datalabels.colour_fill = NULL, - datalabels.size = (3 * text_factor), - datalabels.angle = 0, - datalabels.lineheight = 1, - decimal.mark = dec_mark(), - big.mark = big_mark(), - summarise_function = base::sum, - stacked = FALSE, - stackedpercent = FALSE, - horizontal = FALSE, - reverse = horizontal, - smooth = NULL, - smooth.method = NULL, - smooth.formula = NULL, - smooth.se = TRUE, - smooth.level = 0.95, - smooth.alpha = 0.25, - smooth.linewidth = 0.75, - smooth.linetype = 3, - smooth.colour = NULL, - size = NULL, - linetype = 1, - linewidth = NULL, - binwidth = NULL, - width = NULL, - jitter_seed = NA, - violin_scale = "count", - legend.position = NULL, - legend.title = NULL, - legend.reverse = FALSE, - legend.barheight = 6, - legend.barwidth = 1.5, - legend.nbin = 300, - legend.italic = FALSE, - sankey.node_width = 0.15, - sankey.node_whitespace = 0.03, - sankey.alpha = 0.5, - sankey.remove_axes = NULL, - zoom = FALSE, - sep = " / ", - print = FALSE, - text_factor = 1, - font = getOption("plot2.font"), - theme = getOption("plot2.theme", "theme_minimal2"), - background = getOption("plot2.colour_background", "white"), - markdown = TRUE, - ... -) - \method{plot2}{bug_drug_combinations}( .data, x = ab, @@ -821,7 +46,7 @@ x.date_labels = NULL, x.date_remove_years = NULL, category.focus = NULL, - colour = "certe_sir2", + colour = get_colour("certe_sir2", 7), colour_fill = NULL, colour_opacity = 0, x.lbl_angle = ifelse(horizontal, 0, 90), @@ -917,7 +142,7 @@ violin_scale = "count", legend.position = NULL, legend.title = NULL, - legend.reverse = FALSE, + legend.reverse = TRUE, legend.barheight = 6, legend.barwidth = 1.5, legend.nbin = 300, @@ -1130,7 +355,7 @@ x.date_labels = NULL, x.date_remove_years = NULL, category.focus = NULL, - colour = "certe_sir2", + colour = get_colour("certe_sir2", 5), colour_fill = NULL, colour_opacity = 0, x.lbl_angle = 0, @@ -1283,7 +508,7 @@ x.date_labels = NULL, x.date_remove_years = NULL, category.focus = NULL, - colour = colourpicker(c(Observation = "grey75", `Rule 1` = "certeblauw", `Rule 2` = + colour = get_colour(c(Observation = "grey75", `Rule 1` = "certeblauw", `Rule 2` = "certegroen", `Rule 3` = "certeroze", `Rule 4` = "certegeel", `Rule 5` = "certelila", `Rule 6` = "certebruin", `Rule 7` = "certeblauw2", `Rule 8` = "certegroen2")), colour_fill = NULL, @@ -1597,7 +822,7 @@ Please note: in \code{ggplot2}, 'bars' and 'columns' are equal, while it is comm \item One of these additional types: \itemize{ \item \code{"barpercent"} (short: \code{"bp"}), which is effectively a shortcut to set \code{type = "col"} and \code{horizontal = TRUE} and \code{x.max_items = 10} and \code{x.sort = "freq-desc"} and \code{datalabels.format = "\%n (\%p)"}. -\item \code{"linedot"} (short: \code{"ld"}), which sets \code{type = "line"} and adds two point geoms using \code{\link[=add_point]{add_point()}}; one with large white dots and one with smaller dots using the colours set in \code{colour}. This is essentially equal to base \R \code{plot(..., type = "b")} but with closed shapes. +\item \code{"linedot"} (short: \code{"ld"}), which sets \code{type = "line"} and adds two point geoms using \code{\link[plot2:add_point]{add_point()}}; one with large white dots and one with smaller dots using the colours set in \code{colour}. This is essentially equal to base \R \code{plot(..., type = "b")} but with closed shapes. \item \code{"dumbbell"} (short: \code{"d"}), which sets \code{type = "point"} and \code{horizontal = TRUE}, and adds a line between the points (using \code{\link[=geom_segment]{geom_segment()}}). The line colour cannot be changed. This plot type is only possible when the \code{category} has two distinct values. \item \code{"sankey"} (short: \code{"s"}) creates a Sankey plots using \code{category} for the flows and requires \code{x} to contain multiple variables from \code{.data}. At default, it also sets \code{x.expand = c(0.05, 0.05)} and \code{y.limits = c(NA, NA)} and \code{y.expand = c(0.01, 0.01)}. The so-called 'nodes' (the 'blocks' with text) are considered the datalabels, so you can set the text size and colour of the nodes using \code{datalabels.size}, \code{datalabels.colour}, and \code{datalabels.colour_fill}. The transparency of the flows can be set using \code{sankey.alpha}, and the width of the nodes can be set using \code{sankey.node_width}. Sankey plots can also be flipped using \code{horizontal = TRUE}. } @@ -1606,7 +831,7 @@ Please note: in \code{ggplot2}, 'bars' and 'columns' are equal, while it is comm \item{title, subtitle, caption, tag, x.title, y.title, category.title, legend.title, y_secondary.title}{a title to use. This can be: \itemize{ -\item A \link{character}, which supports markdown by using \code{\link[=md_to_expression]{md_to_expression()}} internally if \code{markdown = TRUE} (which is the default) +\item A \link{character}, which supports markdown by using \code{\link[plot2:md_to_expression]{md_to_expression()}} internally if \code{markdown = TRUE} (which is the default) \item A \link{function} to calculate over \code{.data}, such as \code{title = paste("Based on n =", n_distinct(person_id), "individuals")} or \code{subtitle = paste("Total rows:", n())}, see \emph{Examples} \item An \link{expression}, e.g. using \code{parse(text = "...")} } @@ -1627,7 +852,7 @@ The \code{category.title} defaults to \code{TRUE} if the legend items are numeri \item{facet.position, facet.fill, facet.bold, facet.italic, facet.size, facet.margin, facet.repeat_lbls_x, facet.repeat_lbls_y, facet.drop, facet.nrow, facet.relative}{additional settings for the plotting direction \code{facet}} -\item{facet.fixed_y}{a \link{logical} to indicate whether all y scales should have the same limits. Defaults to \code{TRUE} only if the \link[certestats:distribution_metrics]{coefficient of variation} (sd divided by mean) of the maximum values of y is less than 15\%.} +\item{facet.fixed_y}{a \link{logical} to indicate whether all y scales should have the same limits. Defaults to \code{TRUE} only if the coefficient of variation (standard deviation divided by mean) of the maximum values of y is less than 25\%.} \item{facet.fixed_x}{a \link{logical} to indicate whether all x scales should have the same breaks. This acts like the inverse of \code{x.drop}.} @@ -1639,9 +864,9 @@ The \code{category.title} defaults to \code{TRUE} if the legend items are numeri \item{category.focus}{a value of \code{category} that should be highlighted, meaning that all other values in \code{category} will be greyed out. This can also be a numeric value between 1 and the length of unique values of \code{category}, e.g. \code{category.focus = 2} to focus on the second legend item.} -\item{colour}{colour(s) to set, will be evaluated with \code{\link[certestyle:colourpicker]{colourpicker()}} if set. This can also be one of the viridis colours with automatic implementation for any plot: \code{"viridis"}, \code{"magma"}, \code{"inferno"}, \code{"plasma"}, \code{"cividis"}, \code{"rocket"}, \code{"mako"} or \code{"turbo"}. Also, this can also be a named vector to match values of \code{category}, see \emph{Examples}. Using a named vector can also be used to manually sort the values of \code{category}.} +\item{colour}{get_colour(s) to set, will be evaluated with \code{\link[plot2:get_colour]{get_colour()}} if set. This can also be one of the viridis colours with automatic implementation for any plot: \code{"viridis"}, \code{"magma"}, \code{"inferno"}, \code{"plasma"}, \code{"cividis"}, \code{"rocket"}, \code{"mako"} or \code{"turbo"}. Also, this can also be a named vector to match values of \code{category}, see \emph{Examples}. Using a named vector can also be used to manually sort the values of \code{category}.} -\item{colour_fill}{colour(s) to be used for filling, will be determined automatically if left blank and will be evaluated with \code{\link[certestyle:colourpicker]{colourpicker()}}} +\item{colour_fill}{get_colour(s) to be used for filling, will be determined automatically if left blank and will be evaluated with \code{\link[plot2:get_colour]{get_colour()}}} \item{colour_opacity}{amount of opacity for \code{colour}/\code{colour_fill} (0 = solid, 1 = transparent)} @@ -1651,7 +876,7 @@ The \code{category.title} defaults to \code{TRUE} if the legend items are numeri \item{x.lbl_italic}{\link{logical} to indicate whether the x labels should in in \emph{italics}} -\item{x.lbl_taxonomy}{a \link{logical} to transform all words of the \code{x} labels into italics that are in the \link[AMR:microorganisms]{microorganisms} data set of the \code{AMR} package. This uses \code{\link[=md_to_expression]{md_to_expression()}} internally and will set \code{x.labels} to parse expressions.} +\item{x.lbl_taxonomy}{a \link{logical} to transform all words of the \code{x} labels into italics that are in the \link[AMR:microorganisms]{microorganisms} data set of the \code{AMR} package. This uses \code{\link[plot2:md_to_expression]{md_to_expression()}} internally and will set \code{x.labels} to parse expressions.} \item{x.remove, y.remove}{a \link{logical} to indicate whether the axis labels and title should be removed} @@ -1685,7 +910,7 @@ The \code{category.title} defaults to \code{TRUE} if the legend items are numeri \item{y.age}{a \link{logical} to indicate whether the y labels and breaks should be formatted as ages in years} -\item{y.scientific, y_secondary.scientific}{a \link{logical} to indicate whether the y labels should be formatted in scientific notation, using \code{\link[certestyle:format2]{format2_scientific()}}. Defaults to \code{TRUE} only if the range of the y values spans more than \code{10e5}.} +\item{y.scientific, y_secondary.scientific}{a \link{logical} to indicate whether the y labels should be formatted in scientific notation. Defaults to \code{TRUE} only if the range of the y values spans more than \code{10e5}.} \item{y.percent, y_secondary.percent}{a \link{logical} to indicate whether the y labels should be formatted as percentages} @@ -1693,7 +918,7 @@ The \code{category.title} defaults to \code{TRUE} if the legend items are numeri \item{y_secondary}{values to use for plotting along the secondary y axis. This functionality is poorly supported by \code{ggplot2} and might give unexpected results. Setting the secondary y axis will set the colour to the axis titles.} -\item{y_secondary.colour, y_secondary.colour_fill}{colours to set for the secondary y axis, will be evaluated with \code{\link[certestyle:colourpicker]{colourpicker()}}} +\item{y_secondary.colour, y_secondary.colour_fill}{colours to set for the secondary y axis, will be evaluated with \code{\link[plot2:get_colour]{get_colour()}}} \item{category.labels, category.percent, category.breaks, category.expand, category.midpoint}{settings for the plotting direction \code{category}.} @@ -1724,18 +949,18 @@ The \code{category.title} defaults to \code{TRUE} if the legend items are numeri \itemize{ \item Left blank. This will default to the values of \code{y} in column-type plots, or when plotting spatial 'sf' data, the values of the first column. It will print a maximum of 25 labels unless \code{datalabels = TRUE}. \item \code{TRUE} or \code{FALSE} to force or remove datalabels -\item A function to calculate over \code{.data}, such as \code{datalabels = paste(round(column1), "\\n", column2)} +\item A function to calculate over \code{.data}, such as \code{datalabels = paste(round(column1), "\n", column2)} }} \item{datalabels.round}{number of digits to round the datalabels, applies to both \code{"\%n"} and \code{"\%p"} for replacement (see \code{datalabels.format})} -\item{datalabels.format}{format to use for datalabels. This can be a function (such as \code{\link[=euros]{euros()}}) or a text. For the text, \code{"\%n"} will be replaced by the count number, and \code{"\%p"} will be replaced by the percentage of the total count. Use \code{datalabels.format = NULL} to \emph{not} transform the datalabels.} +\item{datalabels.format}{format to use for datalabels. This can be a function (such as \code{\link[plot2:euros]{euros()}}) or a text. For the text, \code{"\%n"} will be replaced by the count number, and \code{"\%p"} will be replaced by the percentage of the total count. Use \code{datalabels.format = NULL} to \emph{not} transform the datalabels.} \item{datalabels.colour, datalabels.colour_fill, datalabels.size, datalabels.angle, datalabels.lineheight}{settings for the datalabels} -\item{decimal.mark}{decimal mark, defaults to \code{\link[=dec_mark]{dec_mark()}}} +\item{decimal.mark}{decimal mark, defaults to \code{\link[plot2:dec_mark]{dec_mark()}}} -\item{big.mark}{thousands separator, defaults to \code{\link[=big_mark]{big_mark()}}} +\item{big.mark}{thousands separator, defaults to \code{\link[plot2:big_mark]{big_mark()}}} \item{summarise_function}{a \link{function} to use if the data has to be summarised, see \emph{Examples}. This can also be \code{NULL}, which will be converted to \code{function(x) x}.} @@ -1792,32 +1017,26 @@ The \code{category.title} defaults to \code{TRUE} if the legend items are numeri \item{text_factor}{text factor to use, which will apply to all texts shown in the plot} -\item{font}{font (family) to use, can be set with \code{options(plot2.font = "...")}. Can be any installed system font or any of the > 1400 font names from \href{https://fonts.google.com}{Google Fonts}.} - -\item{theme}{a valid \code{ggplot2} \link[ggplot2:theme]{theme} to apply, or \code{NULL} to use the default \code{\link[ggplot2:ggtheme]{theme_grey()}}. This argument accepts themes (e.g., \code{theme_bw()}), functions (e.g., \code{theme_bw}) and characters themes (e.g., \code{"theme_bw"}). The default is \code{\link[=theme_minimal2]{theme_minimal2()}}, but can be set with \code{options(plot2.theme = "...")}.} - -\item{background}{the background colour of the entire plot, can also be \code{NA} to remove it. Will be evaluated with \code{\link[certestyle:colourpicker]{colourpicker()}}. Only applies when \code{theme} is not \code{NULL}.} - -\item{markdown}{a \link{logical} to turn all labels and titles into \link{plotmath} expressions, by converting common markdown language using the \code{\link[=md_to_expression]{md_to_expression()}} function (defaults to \code{TRUE})} +\item{font}{font (family) to use, can be set with \code{options(plot2.font = "...")}. Can be any installed system font or any of the > 1400 font names from \href{https://fonts.google.com}{Google Fonts}. When using custom fonts in R Markdown, be sure to set the chunk option \code{fig.showtext = TRUE}, otherwise an informative error will be generated.} -\item{...}{any argument to give to the geom. This will override automatically-set settings for the geom.} +\item{theme}{a valid \code{ggplot2} \link[ggplot2:theme]{theme} to apply, or \code{NULL} to use the default \code{\link[ggplot2:ggtheme]{theme_grey()}}. This argument accepts themes (e.g., \code{theme_bw()}), functions (e.g., \code{theme_bw}) and characters themes (e.g., \code{"theme_bw"}). The default is \code{\link[plot2:theme_minimal2]{theme_minimal2()}}, but can be set with \code{options(plot2.theme = "...")}.} -\item{crs}{the coordinate reference system (CRS) to use. If this is not left blank, \code{\link[sf:st_transform]{sf::st_transform()}} will be used to transform the geometric data to the new CRS.} +\item{background}{the background colour of the entire plot, can also be \code{NA} to remove it. Will be evaluated with \code{\link[plot2:get_colour]{get_colour()}}. Only applies when \code{theme} is not \code{NULL}.} -\item{datalabels.centroid}{a \link{logical} to indicate whether datalabels must be centred on the polygon (using \code{\link[sf:geos_unary]{sf::st_centroid()}}, the default), or be placed on the 'best' spot on the surface (using \code{\link[sf:geos_unary]{sf::st_point_on_surface()}})} +\item{markdown}{a \link{logical} to turn all labels and titles into \link{plotmath} expressions, by converting common markdown language using the \code{\link[plot2:md_to_expression]{md_to_expression()}} function (defaults to \code{TRUE})} \item{minimum}{minimum number of results, defaults to \code{30}} \item{remove_intrinsic_resistant}{a \link{logical} to indicate that rows with 100\% resistance must be removed from the data set before plotting} \item{language}{language to be used for antibiotic names} + +\item{...}{any argument to give to the geom. This will override automatically-set settings for the geom.} } \description{ These are the implemented methods for different S3 classes to be used in \code{\link[=plot2]{plot2()}}. Since they have an extensive list of arguments, they are placed here on a separate manual page. } \details{ -For geographic information system (GIS) analysis, use the \code{sf} package with a data set containing geometries. The result can be used as input for \code{\link[=plot2]{plot2()}}. - For antimicrobial resistance (AMR) data analysis, use the \code{\link[AMR:bug_drug_combinations]{bug_drug_combinations()}} or the \code{\link[AMR:proportion]{sir_df()}} function from the \code{AMR} package on a data set with antibiograms. The result can be used as input for \code{\link[=plot2]{plot2()}}. The QC-test can be acquired with \code{\link[certestats:qc_rules]{certestats::qc_test()}}. It applies the Nelson QC rules for a vector of values. diff --git a/man/plot2.Rd b/man/plot2.Rd deleted file mode 100644 index 4e211973..00000000 --- a/man/plot2.Rd +++ /dev/null @@ -1,618 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot2.R -\name{plot2} -\alias{plot2} -\title{Conveniently Create a New \code{ggplot}} -\usage{ -plot2( - .data, - x = NULL, - y = NULL, - category = NULL, - facet = NULL, - type = NULL, - x.title = TRUE, - y.title = TRUE, - category.title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - tag = NULL, - title.linelength = 60, - title.colour = getOption("plot2.colour_font_primary", "black"), - subtitle.linelength = 60, - subtitle.colour = getOption("plot2.colour_font_secondary", "grey35"), - na.replace = "", - na.rm = FALSE, - facet.position = "top", - facet.fill = NULL, - facet.bold = TRUE, - facet.italic = FALSE, - facet.size = 10, - facet.margin = 8, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = TRUE, - facet.fixed_y = NULL, - facet.fixed_x = TRUE, - facet.drop = FALSE, - facet.nrow = NULL, - facet.relative = FALSE, - x.date_breaks = NULL, - x.date_labels = NULL, - x.date_remove_years = NULL, - category.focus = NULL, - colour = getOption("plot2.colour", "ggplot2"), - colour_fill = NULL, - colour_opacity = 0, - x.lbl_angle = 0, - x.lbl_align = NULL, - x.lbl_italic = FALSE, - x.lbl_taxonomy = FALSE, - x.remove = FALSE, - x.position = "bottom", - x.max_items = Inf, - x.max_txt = "(rest, x\%n)", - category.max_items = Inf, - category.max_txt = "(rest, x\%n)", - facet.max_items = Inf, - facet.max_txt = "(rest, x\%n)", - x.breaks = NULL, - x.n_breaks = NULL, - x.transform = "identity", - x.expand = NULL, - x.limits = NULL, - x.labels = NULL, - x.character = NULL, - x.drop = FALSE, - x.mic = FALSE, - x.zoom = FALSE, - y.remove = FALSE, - y.24h = FALSE, - y.age = FALSE, - y.scientific = NULL, - y.percent = FALSE, - y.percent_break = 0.1, - y.breaks = NULL, - y.n_breaks = NULL, - y.limits = NULL, - y.labels = NULL, - y.expand = NULL, - y.transform = "identity", - y.position = "left", - y.zoom = FALSE, - y_secondary = NULL, - y_secondary.type = type, - y_secondary.title = TRUE, - y_secondary.colour = colour, - y_secondary.colour_fill = colour_fill, - y_secondary.scientific = NULL, - y_secondary.percent = FALSE, - y_secondary.labels = NULL, - category.labels = NULL, - category.percent = FALSE, - category.breaks = NULL, - category.limits = NULL, - category.expand = 0, - category.midpoint = NULL, - category.transform = "identity", - category.date_breaks = NULL, - category.date_labels = NULL, - category.character = NULL, - x.sort = NULL, - category.sort = TRUE, - facet.sort = TRUE, - x.complete = NULL, - category.complete = NULL, - facet.complete = NULL, - datalabels = TRUE, - datalabels.round = ifelse(y.percent, 2, 1), - datalabels.format = "\%n", - datalabels.colour = "grey25", - datalabels.colour_fill = NULL, - datalabels.size = (3 * text_factor), - datalabels.angle = 0, - datalabels.lineheight = 1, - decimal.mark = dec_mark(), - big.mark = big_mark(), - summarise_function = base::sum, - stacked = FALSE, - stackedpercent = FALSE, - horizontal = FALSE, - reverse = horizontal, - smooth = NULL, - smooth.method = NULL, - smooth.formula = NULL, - smooth.se = TRUE, - smooth.level = 0.95, - smooth.alpha = 0.25, - smooth.linewidth = 0.75, - smooth.linetype = 3, - smooth.colour = NULL, - size = NULL, - linetype = 1, - linewidth = NULL, - binwidth = NULL, - width = NULL, - jitter_seed = NA, - violin_scale = "count", - legend.position = NULL, - legend.title = NULL, - legend.reverse = FALSE, - legend.barheight = 6, - legend.barwidth = 1.5, - legend.nbin = 300, - legend.italic = FALSE, - sankey.node_width = 0.15, - sankey.node_whitespace = 0.03, - sankey.alpha = 0.5, - sankey.remove_axes = NULL, - zoom = FALSE, - sep = " / ", - print = FALSE, - text_factor = 1, - font = getOption("plot2.font"), - theme = getOption("plot2.theme", "theme_minimal2"), - background = getOption("plot2.colour_background", "white"), - markdown = TRUE, - ... -) -} -\arguments{ -\item{.data}{data to plot} - -\item{x}{plotting 'direction' for the x axis. This can be: -\itemize{ -\item A single variable from \code{.data}, such as \code{x = column1} -\item A \link{function} to calculate over one or more variables from \code{.data}, such as \code{x = format(column1, "\%Y")}, or \code{x = ifelse(column1 == "A", "Group A", "Other")} -\item Multiple variables from \code{.data}, such as \code{x = c(column1, column2, column2)}, or using \link[tidyselect:language]{selection helpers} such as \code{x = where(is.character)} or \code{x = starts_with("var_")} \emph{(only allowed and required for Sankey plots using \code{type = "sankey"})} -}} - -\item{y}{values to use for plotting along the y axis. This can be: -\itemize{ -\item A single variable from \code{.data}, such as \code{y = column1} -\item Multiple variables from \code{.data}, such as \code{y = c(column1, column2)} or \code{y = c(name1 = column1, "name 2" = column2)}, or using \link[tidyselect:language]{selection helpers} such as \code{y = where(is.double)} or \code{y = starts_with("var_")} \emph{(multiple variables only allowed if \code{category} is not set)} -\item A \link{function} to calculate over \code{.data} returning a single value, such as \code{y = n()} for the row count, or based on other variables such as \code{y = n_distinct(person_id)}, \code{y = max(column1)}, or \code{y = median(column2) / column3} -\item A \link{function} to calculate over \code{.data} returning multiple values, such as \code{y = quantile(column1, c(0.25, 0.75))} or \code{y = range(age)} \emph{(multiple values only allowed if \code{category} is not set)} -}} - -\item{category, facet}{plotting 'direction' (\code{category} is called 'fill' and 'colour' in \code{ggplot2}). This can be: -\itemize{ -\item A single variable from \code{.data}, such as \code{category = column1} -\item A \link{function} to calculate over one or more variables from \code{.data}, such as \code{category = median(column2) / column3}, or \code{facet = ifelse(column1 == "A", "Group A", "Other")} -\item Multiple variables from \code{.data}, such as \code{facet = c(column1, column2)} (use \code{sep} to control the separator character) -\item One or more variables from \code{.data} using \link[tidyselect:language]{selection helpers}, such as \code{category = where(is.double)} or \code{facet = starts_with("var_")} -} - -The \code{category} can also be a date or date/time (class \code{Date} or \code{POSIXt}).} - -\item{type, y_secondary.type}{type of visualisation to use. This can be: -\itemize{ -\item A \code{ggplot2} geom name or their abbreviation such as \code{"col"} and \code{"point"}. All geoms are supported (including \code{\link[ggplot2:geom_blank]{geom_blank()}}). - -Full function names can be used (e.g., \code{"geom_histogram"}), but they can also be abbreviated (e.g., \code{"h"}, \code{"hist"}). The following geoms can be abbreviated by their first character: area (\code{"a"}), boxplot (\code{"b"}), column (\code{"c"}), histogram (\code{"h"}), jitter (\code{"j"}), line (\code{"l"}), point (\code{"p"}), ribbon (\code{"r"}), and violin (\code{"v"}). - -Please note: in \code{ggplot2}, 'bars' and 'columns' are equal, while it is common to many people that 'bars' are oriented horizontally and 'columns' are oriented vertically since Microsoft Excel has been using these terms this way for many years. For this reason, \code{type = "bar"} will set \code{type = "col"} and \code{horizontal = TRUE}. -\item One of these additional types: -\itemize{ -\item \code{"barpercent"} (short: \code{"bp"}), which is effectively a shortcut to set \code{type = "col"} and \code{horizontal = TRUE} and \code{x.max_items = 10} and \code{x.sort = "freq-desc"} and \code{datalabels.format = "\%n (\%p)"}. -\item \code{"linedot"} (short: \code{"ld"}), which sets \code{type = "line"} and adds two point geoms using \code{\link[=add_point]{add_point()}}; one with large white dots and one with smaller dots using the colours set in \code{colour}. This is essentially equal to base \R \code{plot(..., type = "b")} but with closed shapes. -\item \code{"dumbbell"} (short: \code{"d"}), which sets \code{type = "point"} and \code{horizontal = TRUE}, and adds a line between the points (using \code{\link[=geom_segment]{geom_segment()}}). The line colour cannot be changed. This plot type is only possible when the \code{category} has two distinct values. -\item \code{"sankey"} (short: \code{"s"}) creates a Sankey plots using \code{category} for the flows and requires \code{x} to contain multiple variables from \code{.data}. At default, it also sets \code{x.expand = c(0.05, 0.05)} and \code{y.limits = c(NA, NA)} and \code{y.expand = c(0.01, 0.01)}. The so-called 'nodes' (the 'blocks' with text) are considered the datalabels, so you can set the text size and colour of the nodes using \code{datalabels.size}, \code{datalabels.colour}, and \code{datalabels.colour_fill}. The transparency of the flows can be set using \code{sankey.alpha}, and the width of the nodes can be set using \code{sankey.node_width}. Sankey plots can also be flipped using \code{horizontal = TRUE}. -} -\item Left blank. In this case, the type will be determined automatically: \code{"boxplot"} if there is no x axis or if the length of unique values per x axis item is at least 3, \code{"point"} if both the y and x axes are numeric, and the \link[=options]{option} \code{"plot2.default_type"} otherwise (which defaults to \code{"col"}). Use \code{type = "blank"} or \code{type = "geom_blank"} to \emph{not} add a geom. -}} - -\item{title, subtitle, caption, tag, x.title, y.title, category.title, legend.title, y_secondary.title}{a title to use. This can be: -\itemize{ -\item A \link{character}, which supports markdown by using \code{\link[=md_to_expression]{md_to_expression()}} internally if \code{markdown = TRUE} (which is the default) -\item A \link{function} to calculate over \code{.data}, such as \code{title = paste("Based on n =", n_distinct(person_id), "individuals")} or \code{subtitle = paste("Total rows:", n())}, see \emph{Examples} -\item An \link{expression}, e.g. using \code{parse(text = "...")} -} - -The \code{category.title} defaults to \code{TRUE} if the legend items are numeric.} - -\item{title.linelength}{maximum number of characters per line in the title, before a linebreak occurs} - -\item{title.colour}{text colour of the title} - -\item{subtitle.linelength}{maximum number of characters per line in the subtitle, before a linebreak occurs} - -\item{subtitle.colour}{text colour of the subtitle} - -\item{na.replace}{character to put in place of \code{NA} values if \code{na.rm = FALSE}} - -\item{na.rm}{remove \code{NA} values from showing in the plot} - -\item{facet.position, facet.fill, facet.bold, facet.italic, facet.size, facet.margin, facet.repeat_lbls_x, facet.repeat_lbls_y, facet.drop, facet.nrow, facet.relative}{additional settings for the plotting direction \code{facet}} - -\item{facet.fixed_y}{a \link{logical} to indicate whether all y scales should have the same limits. Defaults to \code{TRUE} only if the \link[certestats:distribution_metrics]{coefficient of variation} (sd divided by mean) of the maximum values of y is less than 15\%.} - -\item{facet.fixed_x}{a \link{logical} to indicate whether all x scales should have the same breaks. This acts like the inverse of \code{x.drop}.} - -\item{x.date_breaks}{breaks to use when the x axis contains dates, will be determined automatically if left blank. This accepts values such as \code{"1 day"} and \code{"2 years"}.} - -\item{x.date_labels}{labels to use when the x axis contains dates, will be determined automatically if left blank. This accepts 'Excel' date-language such as \code{"d mmmm yyyy"}.} - -\item{x.date_remove_years}{a \link{logical} to indicate whether the years of all \code{x} values must be unified. This will set the years of all \code{x} values \href{https://en.wikipedia.org/wiki/Unix_time}{to 1970} if the data does not contain a leap year, and to 1972 otherwise. This allows to plot years on the \code{category} while maintaining a date range on \code{x}. The default is \code{FALSE}, unless \code{category} contains all years present in \code{x}.} - -\item{category.focus}{a value of \code{category} that should be highlighted, meaning that all other values in \code{category} will be greyed out. This can also be a numeric value between 1 and the length of unique values of \code{category}, e.g. \code{category.focus = 2} to focus on the second legend item.} - -\item{colour}{colour(s) to set, will be evaluated with \code{\link[certestyle:colourpicker]{colourpicker()}} if set. This can also be one of the viridis colours with automatic implementation for any plot: \code{"viridis"}, \code{"magma"}, \code{"inferno"}, \code{"plasma"}, \code{"cividis"}, \code{"rocket"}, \code{"mako"} or \code{"turbo"}. Also, this can also be a named vector to match values of \code{category}, see \emph{Examples}. Using a named vector can also be used to manually sort the values of \code{category}.} - -\item{colour_fill}{colour(s) to be used for filling, will be determined automatically if left blank and will be evaluated with \code{\link[certestyle:colourpicker]{colourpicker()}}} - -\item{colour_opacity}{amount of opacity for \code{colour}/\code{colour_fill} (0 = solid, 1 = transparent)} - -\item{x.lbl_angle}{angle to use for the x axis in a counter-clockwise direction (i.e., a value of \code{90} will orient the axis labels from bottom to top, a value of \code{270} will orient the axis labels from top to bottom)} - -\item{x.lbl_align}{alignment for the x axis between \code{0} (left aligned) and \code{1} (right aligned)} - -\item{x.lbl_italic}{\link{logical} to indicate whether the x labels should in in \emph{italics}} - -\item{x.lbl_taxonomy}{a \link{logical} to transform all words of the \code{x} labels into italics that are in the \link[AMR:microorganisms]{microorganisms} data set of the \code{AMR} package. This uses \code{\link[=md_to_expression]{md_to_expression()}} internally and will set \code{x.labels} to parse expressions.} - -\item{x.remove, y.remove}{a \link{logical} to indicate whether the axis labels and title should be removed} - -\item{x.position, y.position}{position of the axis} - -\item{x.max_items, category.max_items, facet.max_items}{number of maximum items to use, defaults to infinite. All other values will be grouped and summarised using the \code{summarise_function} function. \strong{Please note:} the sorting will be applied first, allowing to e.g. plot the top \emph{n} most frequent values of the x axis by combining \code{x.sort = "freq-desc"} with \verb{x.max_items =} \emph{n}.} - -\item{x.max_txt, category.max_txt, facet.max_txt}{the text to use of values not included number of \verb{*.max_items}. The placeholder \verb{\%n} will be replaced with the outcome of the \code{summarise_function} function, the placeholder \verb{\%p} will be replaced with the percentage.} - -\item{x.breaks, y.breaks}{a breaks function or numeric vector to use for the axis} - -\item{x.n_breaks, y.n_breaks}{number of breaks, only useful if \code{x.breaks} cq. \code{y.breaks} is \code{NULL}} - -\item{x.transform, y.transform, category.transform}{a transformation function to use, e.g. \code{"log2"}. This can be: \code{"asinh"}, \code{"asn"}, \code{"atanh"}, \code{"boxcox"}, \code{"compose"}, \code{"date"}, \code{"exp"}, \code{"hms"}, \code{"identity"}, \code{"log"}, \code{"log10"}, \code{"log1p"}, \code{"log2"}, \code{"logit"}, \code{"modulus"}, \code{"probability"}, \code{"probit"}, \code{"pseudo_log"}, \code{"reciprocal"}, \code{"reverse"}, \code{"sqrt"}, \code{"time"}, \code{"timespan"}, \code{"yj"}.} - -\item{x.expand, y.expand}{\link[ggplot2:expansion]{expansion} to use for the axis, can be length 1 or 2. \code{x.expand} defaults to 0.5 and \code{y.expand} defaults to \code{0.25}, except for sf objects (then both default to 0).} - -\item{x.limits, y.limits}{limits to use for the axis, can be length 1 or 2. Use \code{NA} for the highest or lowest value in the data, e.g. \code{y.limits = c(0, NA)} to have the y scale start at zero.} - -\item{x.labels, y.labels, y_secondary.labels}{a labels function or character vector to use for the axis} - -\item{x.character}{a \link{logical} to indicate whether the values of the x axis should be forced to \link{character}. The default is \code{FALSE}, except for years (values between 2000 and 2050) and months (values from 1 to 12).} - -\item{x.drop}{\link{logical} to indicate whether factor levels should be dropped} - -\item{x.mic}{\link{logical} to indicate whether the x axis should be formatted as \link[AMR:as.mic]{MIC values}, by dropping all factor levels and adding missing factors of 2} - -\item{x.zoom, y.zoom}{a \link{logical} to indicate if the axis should be zoomed on the data, by setting \code{x.limits = c(NA, NA)} and \code{x.expand = 0} for the x axis, or \code{y.limits = c(NA, NA)} and \code{y.expand = 0} for the y axis} - -\item{y.24h}{a \link{logical} to indicate whether the y labels and breaks should be formatted as 24-hour sequences} - -\item{y.age}{a \link{logical} to indicate whether the y labels and breaks should be formatted as ages in years} - -\item{y.scientific, y_secondary.scientific}{a \link{logical} to indicate whether the y labels should be formatted in scientific notation, using \code{\link[certestyle:format2]{format2_scientific()}}. Defaults to \code{TRUE} only if the range of the y values spans more than \code{10e5}.} - -\item{y.percent, y_secondary.percent}{a \link{logical} to indicate whether the y labels should be formatted as percentages} - -\item{y.percent_break}{a value on which the y axis should have breaks} - -\item{y_secondary}{values to use for plotting along the secondary y axis. This functionality is poorly supported by \code{ggplot2} and might give unexpected results. Setting the secondary y axis will set the colour to the axis titles.} - -\item{y_secondary.colour, y_secondary.colour_fill}{colours to set for the secondary y axis, will be evaluated with \code{\link[certestyle:colourpicker]{colourpicker()}}} - -\item{category.labels, category.percent, category.breaks, category.expand, category.midpoint}{settings for the plotting direction \code{category}.} - -\item{category.limits}{limits to use for a numeric category, can be length 1 or 2. Use \code{NA} for the highest or lowest value in the data, e.g. \code{category.limits = c(0, NA)} to have the scale start at zero.} - -\item{category.date_breaks}{breaks to use when the category contains dates, will be determined automatically if left blank. This will be passed on to \code{\link[=seq.Date]{seq.Date(by = ...)}} and thus can be: a number, taken to be in days, or a character string containing one of "day", "week", "month", "quarter" or "year" (optionally preceded by an integer and a space, and/or followed by "s").} - -\item{category.date_labels}{labels to use when the category contains dates, will be determined automatically if left blank. This accepts 'Excel' date-language such as \code{"d mmmm yyyy"}.} - -\item{category.character}{a \link{logical} to indicate whether the values of the category should be forced to \link{character}. The default is \code{FALSE}, except for years (values between 2000 and 2050) and months (values from 1 to 12).} - -\item{x.sort, category.sort, facet.sort}{sorting of the plotting direction, defaults to \code{TRUE}, except for continuous values on the x axis (such as dates and numbers). Applying one of the sorting methods will transform the values to an ordered \link{factor}, which \code{ggplot2} uses to orient the data. Valid values are: -\itemize{ -\item A manual vector of values -\item \code{TRUE}: sort \link{factor}s on their levels, otherwise sort ascending on alphabet, while maintaining numbers in the text (\emph{numeric} sort) -\item \code{FALSE}: sort according to the order in the data -\item \code{NULL}: do not sort/transform at all -\item \code{"asc"} or \code{"alpha"}: sort as \code{TRUE} -\item \code{"desc"}: sort \link{factor}s on their \link[=rev]{reversed} levels, otherwise sort descending on alphabet, while maintaining numbers in the text (\emph{numeric} sort) -\item \code{"order"} or \code{"inorder"}: sort as \code{FALSE} -\item \code{"freq"} or \code{"freq-desc"}: sort descending according to the frequencies of \code{y} computed by \code{summarise_function} (highest value first) -\item \code{"freq-asc"}: sort ascending according to the frequencies of \code{y} computed by \code{summarise_function} (lowest value first) -}} - -\item{x.complete, category.complete, facet.complete}{a value to complete the data. This makes use of \code{\link[tidyr:full_seq]{tidyr::full_seq()}} and \code{\link[tidyr:complete]{tidyr::complete()}}. For example, using \code{x.complete = 0} will apply \code{data |> complete(full_seq(x, ...), fill = list(x = 0))}. Using value \code{TRUE} (e.g., \code{x.complete = TRUE}) is identical to using value \code{0}.} - -\item{datalabels}{values to show as datalabels, see also \code{datalabels.format}. This can be: -\itemize{ -\item Left blank. This will default to the values of \code{y} in column-type plots, or when plotting spatial 'sf' data, the values of the first column. It will print a maximum of 25 labels unless \code{datalabels = TRUE}. -\item \code{TRUE} or \code{FALSE} to force or remove datalabels -\item A function to calculate over \code{.data}, such as \code{datalabels = paste(round(column1), "\\n", column2)} -}} - -\item{datalabels.round}{number of digits to round the datalabels, applies to both \code{"\%n"} and \code{"\%p"} for replacement (see \code{datalabels.format})} - -\item{datalabels.format}{format to use for datalabels. This can be a function (such as \code{\link[=euros]{euros()}}) or a text. For the text, \code{"\%n"} will be replaced by the count number, and \code{"\%p"} will be replaced by the percentage of the total count. Use \code{datalabels.format = NULL} to \emph{not} transform the datalabels.} - -\item{datalabels.colour, datalabels.colour_fill, datalabels.size, datalabels.angle, datalabels.lineheight}{settings for the datalabels} - -\item{decimal.mark}{decimal mark, defaults to \code{\link[=dec_mark]{dec_mark()}}} - -\item{big.mark}{thousands separator, defaults to \code{\link[=big_mark]{big_mark()}}} - -\item{summarise_function}{a \link{function} to use if the data has to be summarised, see \emph{Examples}. This can also be \code{NULL}, which will be converted to \code{function(x) x}.} - -\item{stacked}{a \link{logical} to indicate that values must be stacked} - -\item{stackedpercent}{a \link{logical} to indicate that values must be 100\% stacked} - -\item{horizontal}{a \link{logical} to turn the plot 90 degrees using \code{\link[ggplot2:coord_flip]{coord_flip()}}. This option also updates some theme options, so that e.g., \code{x.lbl_italic} will still apply to the original x axis.} - -\item{reverse}{a \link{logical} to reverse the \emph{values} of \code{category}. Use \code{legend.reverse} to reverse the \emph{legend} of \code{category}.} - -\item{smooth}{a \link{logical} to add a smooth. In histograms, this will add the density count as an overlaying line (default: \code{TRUE}). In all other cases, a smooth will be added using \code{\link[ggplot2:geom_smooth]{geom_smooth()}} (default: \code{FALSE}).} - -\item{smooth.method, smooth.formula, smooth.se, smooth.level, smooth.alpha, smooth.linewidth, smooth.linetype, smooth.colour}{settings for \code{smooth}} - -\item{size}{size of the geom. Defaults to \code{2} for geoms \link[ggplot2:geom_point]{point} and \link[ggplot2:geom_jitter]{jitter}, \code{5} for a dumbbell plots (using \code{type = "dumbbell"}), and to \code{0.75} otherwise.} - -\item{linetype}{linetype of the geom, only suitable for geoms that draw lines. Defaults to 1.} - -\item{linewidth}{linewidth of the geom, only suitable for geoms that draw lines. Defaults to: -\itemize{ -\item \code{0.5} for geoms that have no area (such as \link[ggplot2:geom_path]{line}), and for geoms \link[ggplot2:geom_boxplot]{boxplot}/\link[ggplot2:geom_violin]{violin} -\item \code{0.1} for \link[ggplot2:ggsf]{sf} -\item \code{0.25} for geoms that are continous and have fills (such as \link[ggplot2:geom_ribbon]{area}) -\item \code{1.0} for dumbbell plots (using \code{type = "dumbbell"}) -\item \code{0.5} otherwise (such as \link[ggplot2:geom_histogram]{histogram} and \link[ggplot2:geom_ribbon]{area}) -}} - -\item{binwidth}{width of bins (only useful for \code{geom = "histogram"}), can be specified as a numeric value or as a function that calculates width from \code{x}, see \code{\link[ggplot2:geom_histogram]{geom_histogram()}}. It defaults to approx. \code{diff(range(x))} divided by 12 to 22 based on the data.} - -\item{width}{width of the geom. Defaults to \code{0.75} for geoms \link[ggplot2:geom_boxplot]{boxplot}, \link[ggplot2:geom_violin]{violin} and \link[ggplot2:geom_jitter]{jitter}, and to \code{0.5} otherwise.} - -\item{jitter_seed}{seed (randomisation factor) to be set when using \code{type = "jitter"}} - -\item{violin_scale}{scale to be set when using \code{type = "violin"}, can also be set to \code{"area"}} - -\item{legend.position}{position of the legend, must be \code{"top"}, \code{"right"}, \code{"bottom"}, \code{"left"} or \code{"none"} (or \code{NA} or \code{NULL}), can be abbreviated. Defaults to \code{"right"} for numeric \code{category} values and 'sf' plots, and \code{"top"} otherwise.} - -\item{legend.reverse, legend.barheight, legend.barwidth, legend.nbin, legend.italic}{other settings for the legend} - -\item{sankey.node_width}{width of the vertical nodes in a Sankey plot (i.e., when \code{type = "sankey"})} - -\item{sankey.node_whitespace}{whitespace between the nodes} - -\item{sankey.alpha}{alpha of the flows in a Sankey plot (i.e., when \code{type = "sankey"})} - -\item{sankey.remove_axes}{logical to indicate whether all axes must be removed in a Sankey plot (i.e., when \code{type = "sankey"})} - -\item{zoom}{a \link{logical} to indicate if the plot should be scaled to the data, i.e., not having the x and y axes to start at 0. This will set \code{x.zoom = TRUE} and \code{y.zoom = TRUE}.} - -\item{sep}{separator character to use if multiple columns are given to either of the three directions: \code{x}, \code{category} and \code{facet}, e.g. \code{facet = c(column1, column2)}} - -\item{print}{a \link{logical} to indicate if the result should be \link[=print]{printed} instead of just returned} - -\item{text_factor}{text factor to use, which will apply to all texts shown in the plot} - -\item{font}{font (family) to use, can be set with \code{options(plot2.font = "...")}. Can be any installed system font or any of the > 1400 font names from \href{https://fonts.google.com}{Google Fonts}.} - -\item{theme}{a valid \code{ggplot2} \link[ggplot2:theme]{theme} to apply, or \code{NULL} to use the default \code{\link[ggplot2:ggtheme]{theme_grey()}}. This argument accepts themes (e.g., \code{theme_bw()}), functions (e.g., \code{theme_bw}) and characters themes (e.g., \code{"theme_bw"}). The default is \code{\link[=theme_minimal2]{theme_minimal2()}}, but can be set with \code{options(plot2.theme = "...")}.} - -\item{background}{the background colour of the entire plot, can also be \code{NA} to remove it. Will be evaluated with \code{\link[certestyle:colourpicker]{colourpicker()}}. Only applies when \code{theme} is not \code{NULL}.} - -\item{markdown}{a \link{logical} to turn all labels and titles into \link{plotmath} expressions, by converting common markdown language using the \code{\link[=md_to_expression]{md_to_expression()}} function (defaults to \code{TRUE})} - -\item{...}{any argument to give to the geom. This will override automatically-set settings for the geom.} -} -\value{ -a \code{ggplot} object -} -\description{ -The \code{\link[=plot2]{plot2()}} function is a convenient wrapper around many \code{\link[ggplot2:ggplot]{ggplot2}} functions. By design, the \code{ggplot2} package requires users to use a lot of functions and manual settings, while the \code{\link[=plot2]{plot2()}} function does all the heavy lifting automatically and only requires users to define some arguments in one single function, greatly increases convenience. - -Moreover, \code{\link[=plot2]{plot2()}} allows for in-place calculation of \code{y}, all axes, and all axis labels, often preventing the need to use \code{\link[=group_by]{group_by()}}, \code{\link[=count]{count()}}, \code{\link[=mutate]{mutate()}}, or \code{\link[=summarise]{summarise()}}. - -See \link{plot2-methods} for all implemented methods for different object classes. -} -\details{ -The \code{\link[=plot2]{plot2()}} function is a convenient wrapper around many \code{\link[ggplot2:ggplot]{ggplot2}} functions such as \code{\link[ggplot2:ggplot]{ggplot()}}, \code{\link[ggplot2:aes]{aes()}}, \code{\link[ggplot2:geom_bar]{geom_col()}}, \code{\link[ggplot2:facet_wrap]{facet_wrap()}}, \code{\link[ggplot2:labs]{labs()}}, etc., and provides: -\itemize{ -\item Writing as few lines of codes as possible -\item Easy plotting in three 'directions': \code{x} (the regular x axis), \code{category} (replaces 'fill' and 'colour') and \code{facet} -\item Automatic setting of these 'directions' based on the input data -\item Setting in-place calculations for all plotting directions and even \code{y} -\item Easy way for sorting data in many ways (such as on alphabet, numeric value, frequency, original data order), by setting a single argument for the 'direction': \code{x.sort}, \code{category.sort} and \code{facet.sort} -\item Easy limiting values, e.g. by setting \code{x.max_items = 5} or \code{category.max_items = 5} -\item Markdown support for any title text, with any theme -\item Integrated support for any Google Font and any installed system font -\item An extra clean, minimalistic theme with a lot of whitespace (but without unnecessary margins) that is ideal for printing: \code{theme_minimal2()} -\item Some conveniences from Microsoft Excel: -\itemize{ -\item The y axis starts at 0 if possible -\item The y scale expands at the top to be better able to interpret all data points -\item Date breaks can be written in a human-readable format (such as "d mmm yyyy") -\item Labels with data values can easily be printed and are automatically determined -} -\item Support for any \code{ggplot2} extension based on \code{\link[ggplot2:fortify]{ggplot2::fortify()}} -} - -The \code{ggplot2} package in conjunction with the \code{tidyr}, \code{forcats} and \code{cleaner} packages can provide above functionalities, but the goal of the \code{\link[=plot2]{plot2()}} function is to generalise this into one function. The generic \code{\link[=plot2]{plot2()}} function currently has 149 arguments, all with a default value. \strong{Less typing, faster coding.} -} -\examples{ -options(plot2.colour = NULL, plot2.colour_sf_fill = NULL) - -head(iris) - -# no variables determined, so plot2() will try for itself - -# the type will be points since the first two variables are numeric -iris |> - plot2() - -# if x and y are set, no additional mapping will be set: -iris |> - plot2(Sepal.Width, Sepal.Length) -iris |> - plot2(Species, Sepal.Length) - -# the arguments are in this order: x, y, category, facet -iris |> - plot2(Sepal.Length, Sepal.Width, Petal.Length, Species) - -iris |> - plot2(Sepal.Length, Sepal.Width, Petal.Length, Species, - colour = "viridis") # set the viridis colours - -iris |> - plot2(Sepal.Length, Sepal.Width, Petal.Length, Species, - colour = c("white", "red", "black")) # set own colours - -# y can also be multiple (named) columns -iris |> - plot2(x = Sepal.Length, - y = c(Length = Petal.Length, Width = Petal.Width), - category.title = "Petal property") -iris |> - # with included selection helpers such as where(), starts_with(), etc.: - plot2(x = Species, y = where(is.double)) - -# support for secondary y axis -mtcars |> - plot2(x = mpg, - y = hp, - y_secondary = disp ^ 2, - y_secondary.scientific = TRUE, - title = "Secondary y axis sets colour to the axis titles") - - -admitted_patients - -# the arguments are in this order: x, y, category, facet -admitted_patients |> - plot2(hospital, age) - -admitted_patients |> - plot2(hospital, age, gender) - -admitted_patients |> - plot2(hospital, age, gender, ward) - -# or use any function for y -admitted_patients |> - plot2(hospital, median(age), gender, ward) -admitted_patients |> - plot2(hospital, n(), gender, ward) - -admitted_patients |> - plot2(x = hospital, - y = age, - category = gender, - colour = c("F" = "#3F681C", "M" = "#375E97"), - colour_fill = "#FFBB00AA", - linewidth = 1.25, - y.age = TRUE) - -admitted_patients |> - plot2(age, type = "hist") - -# even titles support calculations, including support for {glue} -admitted_patients |> - plot2(age, type = "hist", - title = paste("Based on n =", n_distinct(patient_id), "patients"), - subtitle = paste("Total rows:", n()), - caption = glue::glue("From {n_distinct(hospital)} hospitals"), - x.title = paste("Age ranging from", paste(range(age), collapse = " to "))) - -# the default type is column, datalabels are automatically -# set in non-continuous types: -admitted_patients |> - plot2(hospital, n(), gender) - -admitted_patients |> - plot2(hospital, n(), gender, - stacked = TRUE) - -admitted_patients |> - plot2(hospital, n(), gender, - stackedpercent = TRUE) - -# two categories might benefit from a dumbbell plot: -admitted_patients |> - plot2(hospital, median(age), gender, type = "dumbbell") - -# sort on any direction: -admitted_patients |> - plot2(hospital, n(), gender, - x.sort = "freq-asc", - stacked = TRUE) - -admitted_patients |> - plot2(hospital, n(), gender, - x.sort = c("B", "D", "A"), # missing values ("C") will be added - category.sort = "alpha-desc", - stacked = TRUE) - -# support for Sankey plots -Titanic |> # a table from base R - plot2(x = c(Age, Class, Survived), - category = Sex, - type = "sankey") - -# matrix support, such as for cor() -correlation_matrix <- cor(mtcars) -class(correlation_matrix) -head(correlation_matrix) -correlation_matrix |> - plot2() - -correlation_matrix |> - plot2(colour = c("certeblauw2", "white", "certeroze2"), - datalabels = TRUE, - category.title = "*r*-value", - title = "Correlation matrix") - - -# plot2() supports all S3 extensions available through -# ggplot2::fortify(), such as regression models: -lm(mpg ~ hp, data = mtcars) |> - plot2(x = mpg ^ -3, - y = hp ^ 2, - smooth = TRUE, - smooth.method = "lm", - smooth.formula = "y ~ log(x)", - title = "Titles/captions *support* **markdown**", - subtitle = "Axis titles contain the square notation: x^2") - -# plot2() also has various other S3 implementations: - -# QC plots, according to e.g. Nelson's Quality Control Rules -if (require("certestats", warn.conflicts = FALSE)) { - rnorm(250, mean = 10, sd = 1) |> - qc_test() |> - plot2() -} - -# sf objects (geographic plots, 'simple features') are also supported -if (require("sf")) { - netherlands |> - plot2(datalabels = paste0(province, "\n", round(area_km2))) -} - -# Antimicrobial resistance (AMR) data analysis -if (require("AMR")) { - options(AMR_locale = "nl") - - example_isolates[, c("mo", penicillins())] |> - bug_drug_combinations(FUN = mo_gramstain) |> - plot2(y.percent_break = 0.25) -} -if (require("AMR") & require("dplyr")) { - example_isolates |> - select(date, NIT, FOS, AMC) |> - group_by(year = format(date, "\%Y")) |> - sir_df() |> - filter(year >= 2015) |> - plot2(datalabels = paste0(round(value * 100), "\%\nn = ", isolates), - y.percent_break = 0.125) -} - -# # support for any font -# mtcars |> -# plot2(mpg, hp, font = "Rock Salt", -# title = "This plot uses a Google Font") -} diff --git a/man/plotly.Rd b/man/plotly.Rd deleted file mode 100644 index 3b882fc2..00000000 --- a/man/plotly.Rd +++ /dev/null @@ -1,46 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotly.R -\name{as_plotly} -\alias{as_plotly} -\alias{plotly_style} -\title{Create Interactive Plotly} -\usage{ -as_plotly(plot, ...) - -plotly_style(plot, ...) -} -\arguments{ -\item{plot}{a \code{ggplot2} plot} - -\item{...}{In case of \code{\link[=as_plotly]{as_plotly()}}: arguments to pass on to \code{\link[plotly:layout]{layout()}} to change the Plotly layout object - -In case of \code{\link[=plotly_style]{plotly_style()}}: arguments to pass on to \code{\link[plotly:style]{style()}} to change the Plotly style object} -} -\description{ -Transform a \code{ggplot2}/\code{plot2} object to an interactive plot using the \href{https://plotly.com/r/}{Plotly R Open Source Graphing Library}. -} -\examples{ -mtcars |> - plot2(mpg, hp) |> - as_plotly() - -mtcars |> - plot2(mpg, hp) |> - as_plotly(dragmode = "pan") |> - plotly_style(marker.line.color = "red", - hoverinfo = "y") - - -\dontrun{ -# in the certetoolbox package, this: -mtcars |> - plot2(mpg, hp) |> - export_html("filename") - -# is short for: -mtcars |> - plot2(mpg, hp) |> - as_plotly() |> - htmltools::save_html("filename.html") -} -} diff --git a/man/reexports.Rd b/man/reexports.Rd deleted file mode 100644 index ee68a1b8..00000000 --- a/man/reexports.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\docType{import} -\name{reexports} -\alias{reexports} -\alias{n} -\alias{n_distinct} -\alias{everything} -\alias{starts_with} -\alias{ends_with} -\alias{matches} -\alias{where} -\alias{first} -\alias{last} -\alias{all_of} -\alias{any_of} -\alias{dec_mark} -\alias{big_mark} -\alias{colourpicker} -\title{Objects exported from other packages} -\keyword{internal} -\description{ -These objects are imported from other packages. Follow the links -below to see their documentation. - -\describe{ - \item{certestyle}{\code{\link[certestyle:dec_mark]{big_mark}}, \code{\link[certestyle]{colourpicker}}, \code{\link[certestyle]{dec_mark}}} - - \item{dplyr}{\code{\link[dplyr:reexports]{all_of}}, \code{\link[dplyr:reexports]{any_of}}, \code{\link[dplyr:nth]{first}}, \code{\link[dplyr:nth]{last}}, \code{\link[dplyr:context]{n}}, \code{\link[dplyr]{n_distinct}}} - - \item{tidyselect}{\code{\link[tidyselect:starts_with]{ends_with}}, \code{\link[tidyselect]{everything}}, \code{\link[tidyselect:starts_with]{matches}}, \code{\link[tidyselect]{starts_with}}, \code{\link[tidyselect]{where}}} -}} - diff --git a/man/scale_certe.Rd b/man/scale_certe.Rd index 2c20e1cc..78fa9bd6 100644 --- a/man/scale_certe.Rd +++ b/man/scale_certe.Rd @@ -141,7 +141,7 @@ name(s) of the aesthetic(s) that this scale works with. This can be useful, for example, to apply colour settings to the \code{colour} and \code{fill} aesthetics at the same time, via \code{aesthetics = c("colour", "fill")}.} -\item{colour}{a Certe colour set: \code{"certe"}, \code{"certe2"}, \code{"certe3"}, etc. Will be evaluated with \code{\link[certestyle:colourpicker]{certestyle::colourpicker()}}.} +\item{colour}{a Certe colour set: \code{"certe"}, \code{"certe2"}, \code{"certe3"}, etc. Will be evaluated with \code{\link[=get_colour]{get_colour()}}.} } \description{ These scales apply the colours of Certe, using the 'certestyle' package. diff --git a/man/theme_minimal2.Rd b/man/theme_minimal2.Rd deleted file mode 100644 index 047f0248..00000000 --- a/man/theme_minimal2.Rd +++ /dev/null @@ -1,42 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/theme_minimal2.R -\name{theme_minimal2} -\alias{theme_minimal2} -\title{An Even More Minimal Theme} -\usage{ -theme_minimal2( - ..., - colour_font_primary = getOption("plot2.colour_font_primary", "black"), - colour_font_secondary = getOption("plot2.colour_font_secondary", "grey35"), - colour_font_axis = getOption("plot2.colour_font_axis", "grey25"), - colour_background = getOption("plot2.colour_background", "white") -) -} -\arguments{ -\item{...}{arguments passed on to \code{\link[ggplot2:theme]{ggplot2::theme()}}} - -\item{colour_font_primary}{colour to set for the plot title and tag} - -\item{colour_font_secondary}{colour to set for the plot subtitle and caption} - -\item{colour_font_axis}{colour to set for the axis titles on both x and y} - -\item{colour_background}{colour to set for the background} -} -\description{ -This \code{ggplot2} theme provides even more white area and less clutter than \code{\link[ggplot2:ggtheme]{theme_minimal()}}. -} -\examples{ -plot2(iris) -plot2(admitted_patients, x = hospital, category = gender) - -if (require("ggplot2")) { - ggplot(mtcars, aes(hp, mpg)) + - geom_point() -} -if (require("ggplot2")) { - ggplot(mtcars, aes(hp, mpg)) + - geom_point() + - theme_minimal2() -} -} diff --git a/pkgdown/extra.css b/pkgdown/extra.css index 5136ef95..d3a0fc56 100644 --- a/pkgdown/extra.css +++ b/pkgdown/extra.css @@ -83,3 +83,15 @@ a, a code { /* text strings */ color: #93984C; } + +/* specific for certeplot2 */ +.template-article h4, .template-article h4 code, +.template-article h5, .template-article h5 code { + color: #49647D !important; +} +.template-article h4 { + font-size: 24px; +} +.template-article h5 { + font-size: 18px; +} diff --git a/tests/testthat/test_plot2.R b/tests/testthat/test_plot2.R index 3168c2cd..bdb93e0a 100644 --- a/tests/testthat/test_plot2.R +++ b/tests/testthat/test_plot2.R @@ -23,87 +23,7 @@ plotdata <- data.frame(x = seq_len(8) + 10, n = seq_len(8), stringsAsFactors = FALSE) -`%or%` <- function(a, b) if (is.null(a)) b else a - -get_mapping <- function(plot) gsub("~", "", sapply(plot$mapping, deparse)) -get_layers <- function(plot) plot$layers -get_labels <- function(plot) unlist(plot$labels) -get_data <- function(plot) plot$data -get_range_x <- function(plot) { - ggplot2::ggplot_build(plot)$layout$panel_scales_x[[1]]$limits %or% - ggplot2::ggplot_build(plot)$layout$panel_scales_x[[1]]$range$range -} -get_range_y <- function(plot) { - ggplot2::ggplot_build(plot)$layout$panel_scales_y[[1]]$limits %or% - ggplot2::ggplot_build(plot)$layout$panel_scales_y[[1]]$range$range -} - -test_that("general types work", { - expect_s3_class(plot2(rnorm(10, 10)), "gg") - expect_s3_class(plot2(rnorm(10, 10), type = "l"), "gg") - expect_s3_class(plot2(mtcars, mpg^2, hp^2), "gg") - expect_s3_class(plot2(mtcars, mpg^2, hp^2, smooth = TRUE), "gg") - expect_s3_class(iris |> plot2(Species), "gg") - expect_s3_class(iris |> plot2(Species, type = "violin"), "gg") - expect_s3_class(iris |> plot2(Species, type = "violin"), "gg") - expect_s3_class(iris |> plot2(Species, type = "blank"), "gg") - expect_s3_class(iris |> plot2(Species, type = "area"), "gg") - expect_warning(iris |> plot2(Species, type = "dotplot")) - # difftime coercion to double: - expect_s3_class(data.frame(x = letters[1:10], - y = difftime(Sys.time(), Sys.time() - seq_len(10))) |> - plot2(), - "gg") - expect_s3_class(admitted_patients |> plot2(hospital, n(), where(is.character)), "gg") - expect_s3_class(admitted_patients |> plot2(hospital, n(), c(gender, ward)), "gg") - - expect_s3_class(plotdata |> plot2(y.transform = "log2"), "gg") - # dumbbell: - expect_s3_class(admitted_patients |> plot2(age_group, n_distinct(patient_id), ward, type = "d"), "gg") - expect_s3_class(admitted_patients |> plot2(age_group, n_distinct(patient_id), ward, gender, type = "d"), "gg") - # sankey: - expect_s3_class(admitted_patients |> - plot2(x = c(hospital, ward), - y = n_distinct(patient_id), - category = age_group, - facet = gender, - type = "sankey"), - "gg") -}) - -test_that("na.rm works", { - # as characters - df <- data.frame(hp = mtcars$hp, - letters = letters[seq_len(nrow(mtcars))], - stringsAsFactors = FALSE) - expect_lt(df |> plot2(na.rm = TRUE) |> get_data() |> nrow(), nrow(df)) - expect_lt(df |> plot2(na.rm = FALSE) |> get_data() |> nrow(), nrow(df)) - # as factors - df <- data.frame(hp = mtcars$hp, - letters = letters[seq_len(nrow(mtcars))], - stringsAsFactors = TRUE) - expect_lt(df |> plot2(na.rm = TRUE) |> get_data() |> nrow(), nrow(df)) - expect_lt(df |> plot2(na.rm = FALSE) |> get_data() |> nrow(), nrow(df)) -}) - - -test_that("infinite values are removed", { - expect_equal(data.frame(x = letters[1:10], - y123 = c(1:9, Inf)) |> - plot2() |> - get_data() |> - nrow(), - 9) -}) - test_that("S3 implementations work", { - # lm - expect_s3_class(lm(mpg ~ hp, mtcars) |> plot2(), "gg") - # freq - expect_s3_class(cleaner::freq(admitted_patients$hospital) |> plot2(), "gg") - # sf - expect_s3_class(netherlands |> plot2(), "gg") - expect_s3_class(netherlands |> plot2(crs = 28992, theme = theme_minimal2()), "gg") # bug_drug_combinations expect_s3_class(AMR::example_isolates |> dplyr::select(mo, CIP, AMC) |> @@ -116,7 +36,7 @@ test_that("S3 implementations work", { dplyr::group_by(yr = format(date, "%Y")) |> AMR::sir_df() |> dplyr::filter(yr >= 2015) |> - plot2(), + plot2(x = yr), "gg") # qc_test expect_s3_class(certestats::qc_test(rnorm(1000)) |> plot2(), "gg") @@ -132,7 +52,7 @@ test_that("S3 implementations work", { # type should become boxplot here expect_s3_class(admitted_patients |> plot2(x = hospital, y = certestats::z_score(age)), "gg") - # this uses the certestyle::format2_scientific function for the y axis + # this uses the format2_scientific function for the y axis expect_s3_class(admitted_patients |> plot2(format(date, "%Y"), certestats::z_score(age), @@ -143,354 +63,6 @@ test_that("S3 implementations work", { expect_s3_class(certegis::geo_provincies |> plot2(markdown = TRUE), "gg") }) -test_that("general mapping works", { - expect_equal(plotdata |> plot2() |> get_mapping() |> names(), - c("y", "x", "fill", "colour")) - # remove x axis - expect_s3_class(admitted_patients |> plot2(x = NULL, y = age), "gg") - expect_s3_class(admitted_patients |> plot2(x = 1:250, y = age), "gg") - - # set category.labels = md_to_expression automatically - expect_s3_class(iris |> plot2(category = paste0("*", Species, "*")), "gg") -}) - -test_that("adding mapping works", { - p <- iris |> plot2(Sepal.Length, Sepal.Width) - expect_length(p$mapping, 3) - p2 <- p |> add_mapping(shape = Species) - expect_length(p2$mapping, 4) - expect_s3_class(p2, "gg") -}) - -test_that("adding types works", { - - expect_length(mtcars |> plot2(mpg, hp, cyl) |> get_layers(), 1) - expect_length(mtcars |> plot2(mpg, hp, cyl) |> add_line() |> get_layers(), 2) - expect_length(mtcars |> plot2(mpg, hp, cyl) |> add_point(shape = 4, size = 5) |> get_layers(), 2) - expect_length(mtcars |> plot2(mpg, hp, cyl) |> add_col() |> get_layers(), 2) - expect_error(mtcars |> plot2(mpg, hp, cyl) |> add_type(type = NULL)) - - p <- data.frame(x = 1:100, - y = rnorm(100, 100, 25)) |> - plot2() - expect_length(p |> get_layers(), 1) - expect_length(p |> - add_line(mean(y)) |> - get_layers(), 2) - expect_length(p |> - add_line(mean(y)) |> - add_col(y / 5, - colour = "black", - colour_fill = "yellow", - width = 0.25) |> - get_layers(), 3) - - expect_length(p |> - add_line(certestats::rr_ewma(y, 0.75), - colour = "certeroze", - linewidth = 2, - linetype = 2, - alpha = 0.5) |> - get_layers(), 2) - - expect_length(plot2(certegis::geo_provincies, datalabels = FALSE) |> - add_sf(certegis::geocode("Martini Ziekenhuis"), - colour = "certeroze") |> - get_layers(), 2) - expect_length(plot2(certegis::geo_provincies, datalabels = FALSE) |> - add_sf(certegis::geocode("Martini Ziekenhuis"), - colour = "certeroze", - datalabels = place) |> - get_layers(), 3) - - # way off with labels, and different CRS between plot and input - expect_s3_class(plot2(certegis::geo_provincies |> sf::st_transform(4326), - datalabels = FALSE) |> - add_sf(certegis::geocode("Martini Ziekenhuis"), - colour = "certeroze", - datalabels = place), - "gg") -}) - -test_that("titles work", { - expect_true(all(c(caption = "caption", - tag = "tag", - subtitle = "subtitle", - title = "title", - y = "y.title", - x = "x.title") - %in% (mtcars |> - plot2(caption = "caption", - tag = "tag", - subtitle = "subtitle", - title = "title", - y.title = "y.title", - x.title = "x.title") |> - get_labels()))) -}) - -test_that("max items and sorting work", { - expect_equal(admitted_patients |> - plot2(x = hospital, - y = n(), - x.sort = "asc") |> - get_range_x(), - c("A", "B", "C", "D")) - expect_equal(admitted_patients |> - plot2(x = hospital, - y = n(), - x.sort = "desc") |> - get_range_x(), - c("D", "C", "B", "A")) - expect_equal(admitted_patients |> - plot2(x = hospital, - y = n(), - x.sort = "freq-desc") |> - get_range_x(), - c("D", "B", "A", "C")) - expect_equal(admitted_patients |> - plot2(x = hospital, - y = n(), - x.sort = "freq-asc") |> - get_range_x(), - c("A", "C", "B", "D")) - expect_equal(admitted_patients |> - plot2(x = hospital, - y = n(), - x.sort = "asc") |> - get_range_x(), - c("A", "B", "C", "D")) - expect_equal(admitted_patients |> - plot2(x = format(date, "%Y"), - y = n(), - x.sort = "freq-desc", - x.max_items = 5) |> - get_range_x(), - c("2010", "2003", "2017", "2016", "(rest, x12)")) - - expect_s3_class(admitted_patients |> - plot2(x = format(date, "%Y"), y = n(), category = hospital, facet = age_group, - x.max_items = 2, category.max_items = 2, facet.max_items = 2), - "gg") - expect_equal(admitted_patients |> - plot2(gender, n(), hospital, - category.sort = c("A", "C", "D", "B"), - x.sort = c("M", "F")) |> - get_range_x(), - c("M", "F")) - expect_equal(admitted_patients |> - plot2(gender, n(), hospital, - category.sort = c("A", "C", "D", "B"), - horizontal = TRUE, - x.sort = c("M", "F")) |> - get_range_x(), - c("F", "M")) -}) - -test_that("x scale works", { - expect_s3_class(plotdata |> plot2(x = x_date), "gg") - plotdata |> plot2(x = x_date, x.limits = c(Sys.Date() - 13, Sys.Date() + 2)) - expect_s3_class(plotdata |> plot2(x = x_char), "gg") - expect_s3_class(plotdata |> plot2(n, type = "hist"), "gg") - expect_s3_class(plotdata |> plot2(n, type = "density"), "gg") - expect_s3_class(plotdata |> plot2(n, type = "jitter"), "gg") - expect_s3_class(plotdata |> plot2(type = "line", category = NULL), "gg") - expect_s3_class(plotdata |> plot2(type = "barpercent"), "gg") - expect_s3_class(plotdata |> plot2(type = "linedot", category = NULL), "gg") - expect_s3_class(plotdata |> plot2(x.transform = "log2"), "gg") - expect_s3_class(mtcars |> plot2(mpg, hp, x.lbl_angle = 40), "gg") - expect_s3_class(mtcars |> plot2(mpg, hp, x.lbl_angle = 200), "gg") - expect_s3_class(runif(n = 100, min = 2.0004, max = 2.0006) |> plot2(type = "h"), "gg") - expect_s3_class(suppressWarnings(mtcars |> plot2(mpg, hp, x.limits = c(10, 20))), "gg") - - # mics <- AMR::as.mic(c(1, 2, 8, 32)) - # # should print missing factors levels: - # expect_equal(mics |> plot2(x.mic = TRUE) |> get_range_x(), - # c("<=1", "2", "8", ">=32")) - # expect_equal(mics |> plot2(x.mic = TRUE, x.limits = c(2, 8)) |> get_range_x(), - # c("<=2", ">=8")) - - - p <- plotdata |> - plot2(x = x_date, - x.limits = c(Sys.Date() - 13, - Sys.Date() + 2)) - expect_equal(p |> get_range_x() |> as.Date(origin = "1970-01-01"), - c(Sys.Date() - 13 - 1, Sys.Date() + 2 + 1)) - - plotdata2 <- data.frame(x = factor(1:30), y = rnorm(30, 30, 5), z = rep(letters[1:10], 3)) - expect_identical(plotdata2 |> plot2(facet = z, facet.fixed_x = TRUE) |> get_range_x(), - plotdata2 |> plot2(facet = z, x.drop = FALSE) |> get_range_x()) - expect_identical(plotdata2 |> plot2(facet = z, facet.fixed_x = FALSE) |> get_range_x(), - plotdata2 |> plot2(facet = z, x.drop = TRUE) |> get_range_x()) - - # removed years on x axis - expect_s3_class( - data.frame(date = seq(as.Date("2021-01-01"), as.Date("2023-12-31"), "1 day"), - value = c(rep(1, 365), rep(2, 365), rep(3, 365))) |> - plot2(date, value, - type = "line", - category = format(date, "%Y"), - category.title = "year", - linewidth = 2, - x.date_remove_years = TRUE), - "gg") -}) - -test_that("y scale works", { - expect_error(data.frame(a = 1:10, b = letters[10]) |> plot2(x = a, y = b)) - expect_s3_class(plotdata |> plot2(y = n * 24, y.24h = TRUE), "gg") - expect_s3_class(plotdata |> plot2(y = n * 12, y.age = TRUE), "gg") - expect_s3_class(plotdata |> plot2(y = n * 10, y.scientific = TRUE), "gg") - expect_s3_class(plotdata |> plot2(y.percent = TRUE), "gg") - expect_s3_class(data.frame(a = letters[1:10], y = 10 ^ 1:10) |> plot2(), "gg") - expect_s3_class(data.frame(a = letters[1:10], b = 10 ^ 1:10) |> plot2(y.transform = "log10", y.n_breaks = 10), "gg") - expect_s3_class(data.frame(a = letters[1:10], b = 10 ^ 1:10) |> plot2(y.transform = "log10", y.n_breaks = 10), "gg") - expect_s3_class(data.frame(a = letters[1:10], y = 1) |> plot2(y.percent = TRUE, y.percent_break = 500), "gg") - expect_s3_class(data.frame(a = letters[1:10], y = 1) |> plot2(y.percent = TRUE), "gg") - expect_s3_class(suppressWarnings(mtcars |> plot2(mpg, hp, y.limits = c(100, 200))), "gg") - - # multiple vars of y - expect_s3_class(data.frame(x = letters[1:10], - y1 = 1:10, - y2 = 11:20) |> - plot2(x, c(y1, y2)), - "gg") - expect_error(data.frame(x = letters[1:10], - y1 = 1:10, - y2 = 11:20) |> - plot2(x, c(y1, y2), - # category must not be set - category = 1)) - expect_s3_class(admitted_patients |> - plot2(x = hospital, - y = quantile(age, c(0.25, 0.5, 0.75))), - "gg") -}) - -test_that("category scale works", { - # set as numeric - expect_s3_class(plotdata[1:4, ] |> plot2(x = x_char, y = 1, category = n), "gg") - # 2-colour scale - expect_true(all(c(fill = "Petal.Length", colour = "Petal.Length") %in% - (plot2(iris, Sepal.Length, Sepal.Width, Petal.Length, - colour = c("red", "blue")) |> - get_mapping()))) - # 3-colour scale - expect_true(all(c(fill = "Petal.Length", colour = "Petal.Length") %in% - (plot2(iris, Sepal.Length, Sepal.Width, Petal.Length, - colour = c("red", "blue", "green")) |> - get_mapping()))) - # multi-colour scale - expect_true(all(c(fill = "Petal.Length", colour = "Petal.Length") %in% - (plot2(iris, Sepal.Length, Sepal.Width, Petal.Length, - colour = c("red", "blue", "green", "yellow")) |> - get_mapping()))) - expect_true(all(c(fill = "Petal.Length", colour = "Petal.Length") %in% - (plot2(iris, Sepal.Length, Sepal.Width, Petal.Length, - colour = "certe") |> - get_mapping()))) - expect_s3_class(mtcars |> plot2(mpg, hp, as.character(cyl), category.focus = 2), "gg") - expect_s3_class(mtcars |> plot2(mpg, hp, as.character(cyl), category.focus = "4"), "gg") - # adding white to geoplot if only one colour set - expect_s3_class(certegis::geo_provincies |> plot2(colour_fill = "red"), "gg") - expect_s3_class(certegis::geo_provincies |> plot2(colour_fill = "red", - category.transform = "log10", - category.limits = c(NA, 10e3)), - "gg") - # date class as category - expect_s3_class(admitted_patients |> - plot2(hospital, - median(age), - date), - "gg") - expect_s3_class(admitted_patients |> - plot2(hospital, - median(age), - date, - category.date_breaks = "5 years", - category.date_labels = "'yy"), - "gg") -}) - -test_that("facet scale works", { - expect_s3_class(iris |> plot2(as.integer(Sepal.Length), Sepal.Width, Petal.Length, - Species), "gg") - expect_s3_class(iris |> plot2(as.integer(Sepal.Length), Sepal.Width, Petal.Length, - Species, facet.relative = TRUE), "gg") - expect_s3_class(iris |> plot2(as.integer(Sepal.Length), Sepal.Width, Petal.Length, - Species, facet.relative = TRUE, facet.nrow = 2), "gg") - expect_s3_class(iris |> plot2(as.integer(Sepal.Length), Sepal.Width, Petal.Length, - Species, - facet.repeat_lbls_x = TRUE, - facet.repeat_lbls_y = FALSE), "gg") - - expect_s3_class(iris |> plot2(as.integer(Sepal.Length), Sepal.Width, Petal.Length, - Species, - facet.repeat_lbls_x = FALSE, - facet.repeat_lbls_y = TRUE), "gg") - expect_s3_class(admitted_patients |> plot2(hospital, - n(), - ward, - gender, - stacked = TRUE, - facet.fixed_y = TRUE), "gg") -}) - -test_that("blank plot works", { - expect_s3_class(plotdata |> subset(n < 0) |> plot2(), "gg") - expect_s3_class(data.frame() |> plot2(type = "blank", - x.title = "test", - y.title = "test", - title = "test", - subtitle = "test", - tag = "test", - caption = "test"), "gg") -}) - -test_that("misc elements works", { - expect_s3_class(plotdata |> plot2(x_char, x.lbl_taxonomy = TRUE), "gg") - expect_s3_class(AMR::example_isolates |> - cleaner::freq(AMR::mo_name(mo, "nl")) |> - plot2(type = "barpercent", x.lbl_taxonomy = TRUE), "gg") -}) - -test_that("completing data works", { - expect_s3_class(data.frame(x = c(1, 5, 6, 9), - y = 10) |> - plot2(type = "l", x.complete = 5), - "gg") -}) - -test_that("get title works", { - p <- plot2(mtcars, title = "Plotting **mpg** vs. **cyl**!") - expect_equal(get_plot_title(p), "plotting_mpg_vs_cyl") - expect_equal(get_plot_title(p, valid_filename = FALSE), "Plotting mpg vs. cyl!") - expect_equal(get_plot_title(plot2(mtcars)), "cyl_per_mpg") - expect_equal(get_plot_title(plot2(mtcars, title = NULL), default = "test"), "test") -}) - -test_that("type validation works", { - library(dplyr, warn.conflicts = FALSE) - df <- tibble(x = letters[1:10], - y = 1:10, - z = LETTERS[1:10], - `_var_x` = x, - `_var_y` = y, - `_var_category` = z) - expect_equal(validate_type(NULL, df), "geom_col") - expect_equal(validate_type(NULL, df |> select(-x, -`_var_x`)), "geom_boxplot") - expect_equal(validate_type("a", df), "geom_area") - expect_equal(validate_type("b", df), "geom_boxplot") - expect_equal(validate_type("c", df), "geom_col") - expect_equal(validate_type("h", df), "geom_histogram") - expect_equal(validate_type("j", df), "geom_jitter") - expect_equal(validate_type("l", df), "geom_line") - expect_equal(validate_type("p", df), "geom_point") - expect_equal(validate_type("r", df), "geom_ribbon") - expect_equal(validate_type("v", df), "geom_violin") -}) - test_that("adding scales works", { library(ggplot2) expect_message(mtcars |> @@ -507,100 +79,7 @@ test_that("adding scales works", { scale_fill_certe_d()) }) -test_that("moving layer works", { - expect_s3_class((mtcars |> - plot2(mpg, hp, cyl) + - geom_line(colour = "grey75")) |> - move_layer(-1), "gg") -}) - -test_that("messaging works", { - expect_message(plot2_message("test", print = TRUE)) - expect_message(plot2_caution("test", print = TRUE)) - expect_warning(plot2_warning("test", print = TRUE)) -}) - -test_that("date labels work", { - expect_equal(determine_date_breaks_labels(c(as.POSIXct("2023-01-01 10:00:00"), as.POSIXct("2023-01-01 10:50:00"))), - list(breaks = "10 min", labels = "HH:MM")) - expect_equal(determine_date_breaks_labels(c(as.POSIXct("2023-01-01 10:00:00"), as.POSIXct("2023-01-01 15:00:00"))), - list(breaks = "1 hour", labels = "HH:MM")) - expect_equal(determine_date_breaks_labels(c(as.POSIXct("2023-01-01 10:00:00"), as.POSIXct("2023-01-02 10:00:00"))), - list(breaks = "2 hours", labels = "HH")) - expect_equal(determine_date_breaks_labels(c(as.Date("2023-01-01"), as.Date("2023-01-31"))), - list(breaks = "1 day", labels = "d mmm")) - expect_equal(determine_date_breaks_labels(c(as.Date("2023-01-01"), as.Date("2023-02-28"))), - list(breaks = "4 days", labels = "d mmm")) - expect_equal(determine_date_breaks_labels(c(as.Date("2023-01-01"), as.Date("2023-06-30"))), - list(breaks = "2 weeks", labels = "d mmm")) - expect_equal(determine_date_breaks_labels(c(as.Date("2023-01-01"), as.Date("2023-12-31"))), - list(breaks = "1 month", labels = "mmm")) - expect_equal(determine_date_breaks_labels(c(as.Date("2023-03-01"), as.Date("2024-01-31"))), - list(breaks = "2 months", labels = "mmm yyyy")) - expect_equal(determine_date_breaks_labels(c(as.Date("2023-01-01"), as.Date("2024-12-31"))), - list(breaks = "3 months", labels = "mmm yyyy")) - expect_equal(determine_date_breaks_labels(c(as.Date("2023-01-01"), as.Date("2025-12-31"))), - list(breaks = "6 months", labels = "mmm yyyy")) - expect_equal(determine_date_breaks_labels(c(as.Date("2023-01-01"), as.Date("2026-12-31"))), - list(breaks = "1 year", labels = "mmm yyyy")) - expect_equal(determine_date_breaks_labels(c(as.Date("2023-01-01"), as.Date("2027-12-31"))), - list(breaks = "1 year", labels = "mmm yyyy")) - expect_equal(determine_date_breaks_labels(c(as.Date("2023-01-01"), as.Date("2030-12-31"))), - list(breaks = "1 year", labels = "yyyy")) - expect_equal(determine_date_breaks_labels(c(as.Date("2023-01-01"), as.Date("2035-12-31"))), - list(breaks = "2 years", labels = "yyyy")) - expect_equal(determine_date_breaks_labels(c(as.Date("2023-01-01"), as.Date("2050-12-31"))), - list(breaks = "5 years", labels = "yyyy")) -}) - -test_that("manual fonts work", { - expect_s3_class(mtcars |> plot2(mpg, hp, font = "Rock Salt"), "gg") - expect_s3_class(mtcars |> plot2(mpg, hp, font = "Rock Salt"), "gg") # already downloaded - expect_s3_class(mtcars |> plot2(mpg, hp, font = "Courier"), "gg") - expect_s3_class(mtcars |> plot2(mpg, hp, font = "Courier"), "gg") # already downloaded -}) - -test_that("Plotly works", { - expect_error(as_plotly(mtcars)) - expect_s3_class(mtcars |> plot2(mpg, hp) |> as_plotly(), "plotly") - expect_s3_class(mtcars |> - plot2(mpg, hp) |> - as_plotly(dragmode = "pan") |> - plotly_style(marker.line.color = "red", - hoverinfo = "y"), - "plotly") - expect_s3_class(mtcars |> plot2(mpg, hp) |> plotly_style(hoverinfo = "y"), "plotly") -}) - -test_that("md to expression works", { - expr1 <- md_to_expression("test1 *test2* **test3** ***test4*** _test5_ test6 **_test7_** _**test8**_ test_{9} test10 test^{11} test12") - expect_true(is.expression(expr1)) - expect_identical(as.character(expr1), - as.character(parse(text = "paste(\"test1 \", italic(\"test2\"), \" \", bold(\"test3\"), \" \", bolditalic(\"test4\"), \" _test5_ test6 \", bold(\"_test7_\"), \" _\", bold(\"test8\"), \"_ \", test[\"9\"], \" \", test[\"10\"], \" test\"^\"11\", \" \", test^\"12\")"))) - - expr2 <- md_to_expression("test $alpha$") - expect_true(is.expression(expr2)) - - expr3 <- md_to_expression("$f[X](x)==frac(1, sigma*sqrt(2*pi))*plain(e)^{frac(-(x-mu)^2, 2*sigma^2)}$") - expect_true(is.expression(expr3)) - - expect_error(md_to_expression("test $**$")) -}) - -test_that("secondary y axis works", { - expect_s3_class(mtcars |> plot2(mpg, hp, y_secondary = disp), "gg") - expect_s3_class(mtcars |> plot2(mpg, hp, y_secondary = disp ^ 2), "gg") - - # this function is being used to determine breaks, so checks its functionality - p <- mtcars |> plot2(mpg, hp) - expect_identical(ggplot_build(p)$layout$panel_params[[1]]$y$breaks, - as.double(c(0, 100, 200, 300, 400, NA))) -}) - test_that("matrices works", { - expect_s3_class(mtcars |> - stats::cor() |> - plot2(), "gg") expect_s3_class(mtcars |> stats::cor() |> plot2(colour = c("certeblauw", "white", "certeroze"), diff --git a/vignettes/.gitignore b/vignettes/.gitignore deleted file mode 100644 index 097b2416..00000000 --- a/vignettes/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -*.html -*.R diff --git a/vignettes/plot2.Rmd b/vignettes/plot2.Rmd deleted file mode 100644 index 604c6f7e..00000000 --- a/vignettes/plot2.Rmd +++ /dev/null @@ -1,584 +0,0 @@ ---- -title: "A Gentle Introduction to `plot2()`: Enhancing Your `ggplot2` Workflow" -output: rmarkdown::html_vignette -vignette: > - %\VignetteIndexEntry{Mastering plot2()} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{knitr::rmarkdown} -editor_options: - chunk_output_type: console ---- - -```{r, include = FALSE} -knitr::opts_chunk$set( - fig.width = 6, - fig.height = 4, - collapse = TRUE, - comment = "#>" -) -library(certeplot2) -# load this as well, so function names will get tidyverse links on the website -library(ggplot2) -library(patchwork) -library(dplyr, warn.conflicts = FALSE) -library(tidyr, warn.conflicts = FALSE) -exported <- getNamespaceExports("certeplot2") -all_ls <- c(ls(envir = asNamespace("certeplot2")), ls(envir = asNamespace("certestyle"))) -reexported <- sort(exported[!exported %in% all_ls]) -``` - -# Introduction - -If you've been using `ggplot2` for a while, you're likely familiar with its strengths and versatility in creating a wide array of visualisations. However, as powerful as `ggplot2` is, it often requires you to define every single detail yourself. Whether it's specifying aesthetics, selecting geoms, or adjusting scales, you're in control of every element. And that's one of the reasons we love `ggplot2`; it offers immense flexibility and precision. - -But what if you could streamline this process for many common tasks? Enter `plot2()`, a friendly companion to `ggplot2` designed to reduce the repetitive aspects of plotting without sacrificing the customizability that `ggplot2` is known for. Think of `plot2()` as your plotting assistant, doing a lot of the heavy lifting automatically so you can focus on the fun parts — like exploring your data and finding insights. - -In this vignette, we'll take a deep dive into the `plot2()` function and its companion `add_*()` functions. We'll walk through everything from the basics to some of the more advanced features, helping you unlock the full potential of this powerful tool. Whether you're plotting simple bar charts or complex Sankey diagrams, `plot2()` has got you covered. - -## The Plot2 Philosophy: Less Typing, More Plotting - -Before we dive into the code, let's talk briefly about the philosophy behind `plot2()`. At its core, `plot2()` is designed to make plotting in R more intuitive and less cumbersome. If you've ever been frustrated by having to write out `ggplot()` and `aes()` over and over again, `plot2()` is the answer. - -The concept is simple, and the exact opposite of `ggplot2`: give `plot2()` your data, and it will figure out the rest, while enabling many popular plotting options without ever needed to leave this single function. The goal is to get you from data to visualisation with as little friction as possible. And since `plot2()` just returns a ggplot object, you can extend it in any way you would with the outcome of `ggplot2::ggplot()`. - -# Getting Started with `plot2()` - -Let's start with the basics. The `plot2()` function is a wrapper around `ggplot2` that simplifies many of the tasks you usually have to handle manually. To begin with, you don't even need to specify what kind of plot you want — `plot2()` will make an educated guess based on your data. - -### Basic Usage: Let `plot2()` Do the Work - -To get started, you can pass your data directly into `plot2()` without specifying any additional arguments. For example: - -```{r} -library(certeplot2) -data.frame(x = LETTERS[1:10], y = 11:20) |> - plot2() -``` - -In this simple example, `plot2()` automatically generates a column plot because it recognises that the x-axis is categorical and the y-axis is numeric. It even adds data labels by default because the x-axis is discrete. This is `plot2()` at its most basic — no need to specify a plot type or worry about details like labels and scales. - -You'll also notice the clean, uncluttered appearance of the plot, thanks to `theme_minimal2()`, which is applied by default in `plot2()`. Unlike `ggplot2`’s default `theme_grey()` that features a grey background, `theme_minimal2()` provides an even more spacious, white background that reduces visual clutter and is optimised for printing directly to production formats like PDFs. This makes `plot2()` plots ideal for reports, publications, and presentations where a clean, professional look is essential. - -### Customising the Plot Type - -But what if you want something different? Maybe a scatter plot or a line chart? No problem. You can easily specify the `type` argument to get exactly what you want. - -```{r} -data.frame(x = 1:10, y = rnorm(10)) |> - plot2(type = "point") -``` - -Here, we've explicitly set `type = "point"` to create a scatter plot. `plot2()` supports a wide range of plot types, and you can use either the full name (`"geom_point"`) or an abbreviation (`"point"`, `"p"`). - -As you start to get comfortable with `plot2()`, you'll find that it often knows exactly what you want to do. But when you need more control, it's easy to take the reins and specify the plot type that best fits your data. - -### A Closer Look at the Axes - -One of the key strengths of `plot2()` is how it handles axes. The `x` and `y` arguments are straightforward, but they come with a lot of flexibility. Let’s start with the basics and then build up to more advanced configurations. - -#### Setting Up Basic Axes - -To create a simple scatter plot, you might pass a single variable to the `x` and `y` arguments: - -```{r} -mtcars |> - plot2(mpg, hp) -``` - -This creates a scatter plot of miles per gallon (`mpg`) against horsepower (`hp`). This is as basic as it gets — two variables, one for each axis. - -#### Working with Multiple Variables - -Now, what if you want to compare multiple variables on the same plot? `plot2()` makes this easy by allowing you to pass a vector of variables: - -```{r} -mtcars |> - plot2(mpg, c(hp, disp)) -``` - -In this example, `plot2()` plots both `hp` and `disp` against `mpg` on the same graph, using different colours or other visual distinctions to separate them. - - -### Delving into Categories - -Categories in `plot2()` replace the `colour` and `fill` aesthetics from `ggplot2`. The `category` argument is where you define how your data should be grouped. Let’s start with a simple example and then explore how to take it further. - -#### Basic Grouping - -A basic use of the `category` argument might look something like this: - -```{r} -mtcars |> - plot2(mpg, hp, category = cyl) -``` - -Here, the `cyl` variable is used to group the data by the number of cylinders, and `plot2()` automatically assigns different colours to each group. This is particularly useful for comparing subsets of your data within the same plot. - -#### Customising Categories - -But `plot2()` doesn’t stop there. You can fully customise how categories are displayed. For instance, you might want to control the colours used for each category: - -```{r} -mtcars |> - plot2(mpg, hp, category = cyl, colour = c("4" = "red", "6" = "blue", "8" = "green")) -``` - -Here, we’ve specified the exact colours to use for each category, giving you full control over the appearance of your plot. - -### Exploring Facets - -Faceting in `plot2()` allows you to split your plot into multiple panels, one for each level of a categorical variable. It’s an excellent way to compare data across different groups. - -#### Basic Faceting - -A simple example of faceting might look like this: - -```{r} -mtcars |> - plot2(mpg, hp, facet = gear) -``` - -This command splits the plot by the number of gears, giving you a separate panel for each group. This is a quick way to see how relationships vary across different subsets of your data. - -#### Advanced Faceting Options - -`plot2()` offers additional control over how facets are displayed. You can specify the number of rows in the facet grid, control whether scales are fixed or free, and more: - -```{r} -mtcars |> - plot2(mpg, hp, facet = gear, facet.nrow = 2, facet.fixed_y = TRUE) -``` - -In this example, we limit the facet grid to two rows and ensure that all y-axes have the same scale. - -### Leveraging Inline Transformations with `plot2()` - -One of the standout features of `plot2()` is its ability to perform transformations directly within the function call. This capability can dramatically reduce the need for additional data manipulation steps, allowing you to focus on the visualisation itself. Whether you’re calculating aggregates, formatting labels, or even applying mathematical transformations, `plot2()` lets you do it all on the fly. - -#### Aggregations Made Easy - -Suppose you want to count the number of patients admitted to each hospital. With `plot2()`, there’s no need to pre-calculate these counts; you can simply use `n()` directly within the function: - -```{r} -# included data set: -admitted_patients - -admitted_patients |> - plot2(x = hospital, y = n()) -``` - -This will produce a column plot showing the number of admissions per hospital, calculated directly within `plot2()`. - -Want to add another dimension, like the number of unique age groups within each hospital? You can do that just as easily: - -```{r} -admitted_patients |> - plot2(x = hospital, y = n_distinct(age_group)) -``` - -Here, `n_distinct(age_group)` counts the number of unique age groups per hospital, again with no need for additional code outside of `plot2()`. - -The `n_distinct()` function comes from `dplyr`, yet it is not needed to load `dplyr` before creating the above plot command. The following tidyverse functions are available to use inside `plot2()` without loading other packages: `r paste0("\u0060", reexported, "()\u0060", collapse = ", ")`. - - -#### Combining Data with Inline Transformations - -The real power of `plot2()` comes when you start combining these inline transformations. For example, you might want to see the median age of patients in each hospital, broken down by gender: - -```{r} -admitted_patients |> - plot2(x = hospital, y = median(age), category = gender) -``` - -This creates a grouped column plot, showing the median age of patients at each hospital, with separate bars for each gender. You didn’t need to `group_by()` or `summarise()` your data beforehand—`plot2()` takes care of it all. - -#### Inline Math Transformations - -You can also apply mathematical transformations directly within `plot2()`, making it easy to explore relationships in your data. For example, to plot the logarithm of patient ages across different wards, you can do this: - -```{r} -admitted_patients |> - plot2(x = log(age), y = n(), category = ward) -``` - -#### Advanced Formatting on the Fly - -In addition to aggregations, `plot2()` makes it easy to apply text transformations directly within the plotting function. For instance, you might want to format the date or combine different variables for the labels: - -```{r} -admitted_patients |> - plot2(x = paste("Hospital", hospital), - y = n(), - category = format(date, "%Y")) -``` - -This example creates a plot where the x-axis labels combine the text "Hospital" with the hospital name, and the categories are based on the year extracted from the `date` variable. This level of flexibility allows for highly customised plots without the need for extra preprocessing steps. - -This produces a scatter plot of the log-transformed ages, categorised by ward, allowing you to quickly see patterns in how age distributions differ across wards. - -#### Combining Everything Together - -Let’s put it all together in a more complex example. Suppose you want to examine the distribution of patient ages across hospitals, with each bar split by gender, and you want the x-axis to reflect the hospital name and use facets for the year of admission: - -```{r} -admitted_patients |> - plot2(x = ifelse(gender == "F", "Females", "Males"), - y = median(age), - category = format(date, "%Y"), - facet = paste("Hospital", hospital), - x.title = "", - y.title = "Median Patient Age", - category.title = "Year") -``` - -In this plot, we’re using multiple inline transformations, showcasing the use of only 8 lines of code without using `dplyr` transformations manually. This level of complexity, achieved with just one `plot2()` call, demonstrates the power and flexibility of inline transformations. - -### Sorting and Limiting Data - -Sorting is a crucial part of data visualisation, as it helps bring clarity and focus to your plots. With `plot2()`, you have a variety of options to sort your data in different directions. Whether you want to sort by frequency, alphabetically, or by a custom order, `plot2()` provides flexible and powerful tools to get the job done. - -Limiting your data helps in keeping plots clean. If you only want to display the top few items, `x.max_items` and `category.max_items`, and `facet.max_items` have got you covered. - -#### Basic Sorting - -Let’s start with a simple sort based on frequency: - -```{r} -mtcars |> - plot2(carb, y = n(), x.sort = "freq-desc") -``` - -In this example, the data is sorted by the frequency of carburettor counts in descending order. This is particularly useful when you want to highlight the most common categories in your data. - -#### Sorting Alphabetically - -If you prefer to sort alphabetically, `plot2()` makes it straightforward. You can use `"asc"` or `"alpha"` to sort your data in ascending alphabetical order: - -```{r} -mtcars |> - plot2(carb, y = n(), x.sort = "asc") -``` - -This command will sort the carburettor counts alphabetically, which is useful when your data naturally follows an alphabetical order. - -#### Sorting with a Custom Order - -Sometimes, you may want to present your data in a specific order that doesn’t follow a standard sorting method. You can define a custom order by providing a manual vector of values: - -```{r} -mtcars |> - plot2(carb, y = n(), x.sort = c(4, 1, 6, 8)) -``` - -In this example, the carburettor counts will be displayed in the order of 4, 1, 6, and 8, regardless of their frequency or alphabetical order. This approach is particularly useful when you want to highlight certain categories or follow a logical sequence. - -#### Limiting Data - -You might not always want to show every single item in your plot. For example, if you’re dealing with a lot of categories, you can limit the display to just the most frequent ones: - -```{r} -mtcars |> - plot2(carb, y = n(), x.max_items = 5, type = "col") -``` - -This limits the plot to the top 5 most frequent carburetor counts, simplifying the visualisation and making it easier to focus on the most important data. - -#### Combining Sorting with Limiting - -Sorting can be combined with other features in `plot2()` to create more sophisticated plots. For example, you might want to sort by frequency and also limit the number of items displayed: - -```{r} -mtcars |> - plot2(carb, y = n(), x.sort = "freq-desc", x.max_items = 5, type = "col") -``` - -This plot will show only the top 3 most frequent carburettor counts, sorted in descending order. This combination helps to declutter your visualisation and focus on the most significant parts of your data. - -#### Visualising Sorting Options - -To illustrate the impact of different sorting options, let’s create a plot that uses a custom sort order and highlights the flexibility of `plot2()`: - -```{r} -admitted_patients |> - plot2(x = age_group, y = n(), x.sort = c("55-74", "75+", "25-54"), category = hospital, stacked = TRUE) -``` - -In this example, the `age_group` axis is sorted in a custom order, with the "55-74" group first, followed by "75+" and then "25-54". The bars are stacked by hospital, providing a clear comparison across the specified age groups. - -### Customising Colours - -Customising colours in `plot2()` is intuitive and flexible. You can use pre-set colour scales like `viridis`, or define your own colours. The `colour` and `colour_fill` arguments control the appearance of your plot. - -#### Using Pre-set Colour Scales - -For a quick and visually appealing colour scheme, you might use a `viridis` palette: - -```{r} -mtcars |> - plot2(mpg, hp, category = cyl, colour = "viridis") -``` - -This applies the `viridis` colour scale, which is particularly good for making sure your plot is accessible to those with colour vision deficiencies. - -#### Defining Custom Colours - -If you want more control, you can define specific colours for each category: - -```{r} -mtcars |> - plot2(mpg, hp, category = cyl, colour = c("4" = "red", "6" = "blue", "8" = "green")) -``` - -This approach gives you full creative control over the colour scheme, allowing you to match your plot’s aesthetics to your presentation or publication needs. - -#### Default Colours - -At default, `plot2()` sets no colours, meaning that it uses ggplot2 colours. With some simple R options, it is very easy to switch to another colour set. - -```{r, echo = FALSE} -plots <- function() { - p1 <- iris |> plot2(title = "", y.title = "", x.title = "") - p2 <- admitted_patients |> plot2(gender, n(), title = "", y.title = "", x.title = "") - p3 <- admitted_patients |> plot2(gender, n(), ward, title = "", y.title = "", x.title = "") - p4 <- admitted_patients |> plot2(gender, age, type = "boxplot", title = "", y.title = "", x.title = "") - p5 <- admitted_patients |> plot2(gender, n(), age, category.character = FALSE, title = "", y.title = "", x.title = "") - p6 <- netherlands |> plot2(datalabels = FALSE, title = "", y.title = "", x.title = "") - p7 <- admitted_patients |> plot2(gender, age, hospital, type = "boxplot", title = "", y.title = "", x.title = "") - p8 <- admitted_patients |> plot2(age, type = "histogram", title = "", y.title = "", x.title = "") - (p1 + p2) / (p3 + p4) / (p5 + p6) / (p7 + p8) -} -``` - -Default: - -```{r, echo = FALSE, message = FALSE, fig.height = 7.5, fig.width = 7} -options(plot2.colour = NULL, plot2.colour_sf_fill = NULL) -plots() -``` - -Using any [viridis colour palette](https://sjmgarnier.github.io/viridis/articles/intro-to-viridis.html): - -```{r} -options(plot2.colour = "viridis") -``` - -```{r, echo = FALSE, message = FALSE, fig.height = 7.5, fig.width = 7} -plots() -``` - -```{r} -options(plot2.colour = "magma") -``` - -```{r, echo = FALSE, message = FALSE, fig.height = 7.5, fig.width = 7} -plots() -``` - -```{r} -options(plot2.colour = "certe") -``` - -```{r, echo = FALSE, message = FALSE, fig.height = 7.5, fig.width = 7} -plots() -``` - -```{r, echo = FALSE} -# reset again -options(plot2.colour = NULL, plot2.colour_sf_fill = NULL) -``` - - -### Advanced Plot Types: Geographies, Dumbbells and Sankey Diagrams - -`plot2()` shines when it comes to more complex plot types. Let’s explore three advanced options: geography plots, dumbbell plots and Sankey diagrams. - -#### Plotting geometries (`sf` objects) - -Objects of class `sf` (*simple feature*) are handled by `plot2()` like any other data set; `plot2()` applies spatial functions such as `geom_sf()` and `geom_sf_text()` automatically wherever needed. The built-in `theme_minimal2()` theme makes sure you get a clean map, by removing the unnecessarily verbose axes and background colour. - -The included `netherlands` data set is such an `sf` object: - -```{r} -plot2(netherlands) -``` - -#### Dumbbell Plots for Comparisons - -Dumbbell plots are excellent for comparing two categories side by side: - -```{r} -admitted_patients |> - plot2(x = hospital, - y = n_distinct(patient_id), - category = gender, - type = "dumbbell") -``` - -This plot type is particularly useful for showing the difference between two related metrics across different groups. - -#### Creating Sankey Diagrams - -Sankey diagrams are another powerful visualisation, perfect for showing flow or movement from one state to another: - -```{r} -Titanic |> - plot2(x = c(Class, Age, Survived), category = Sex, type = "sankey") -``` - -Sankey plots are a great way to visualise transitions, such as the survival rates of passengers on the Titanic across different classes and age groups. - - -### Customising Fonts in `plot2()` - -Another powerful feature of `plot2()` is its flexibility with fonts. Whether you’re aiming for a professional look, something playful, or anything in between, `plot2()` allows you to easily customise fonts to suit your needs. - -#### Using System Fonts and Google Fonts - -`plot2()` supports all installed system fonts, as well as over 1,400 Google Fonts, giving you an extensive range of choices for your plots. Missing fonts will be downloaded automatically, and the required DPI will be set for you, even in R Markdown outputs. - -Here’s how you can apply a custom font from Google Fonts: - -```{r} -mtcars |> - plot2(mpg, hp, font = "Rock Salt", text_factor = 1.5, - title = "Custom Font Example", - x.title = "Miles per Gallon", - y.title = "Horsepower") -``` - -In this example, the `Rock Salt` font, a playful and hand-drawn style, is applied across the plot. The `text_factor` argument is used to scale the size of the text, ensuring readability and aesthetic balance. - -#### Creating Consistent Themes with Fonts - -By setting font options globally through R options, you can maintain consistent styling across multiple plots. This is particularly useful when preparing a series of visualisations for a report or presentation. - -```{r} -options(plot2.font = "Roboto") -options(plot2.colour = "viridis") - -# Now every plot will use the Roboto font by default -mtcars |> - plot2(mpg, hp, title = "Consistent Font Example") -``` - -In this example, all plots will now use the `Roboto` font, ensuring a consistent and professional appearance across your visualisations. - -```{r} -# reset again -options(plot2.font = NULL, plot2.colour = NULL) -``` - -Customising fonts in `plot2()` is both flexible and straightforward, allowing you to tailor the typography of your plots to match your project's style. Whether you're using a system font or one of the many Google Fonts, `plot2()` makes it easy to create visually appealing and consistent plots with minimal effort. - -## Adding Elements with `add_*()` Functions - -Beyond the basics, `plot2()` allows you to add layers and elements to your plots with the `add_*()` functions. These are designed to integrate seamlessly with `plot2()` and `ggplot2`. - -### Adding Lines, Points, and Columns - -Adding a line to an existing plot is as easy as calling `add_line()`: - -```{r} -p <- mtcars |> - plot2(mpg, hp) -p |> - add_line(y = mean(hp), colour = "red", legend.value = "Average HP") -``` - -This adds a line at the mean horsepower, with a red colour and a legend entry labeled "Average HP." - -Multiple lines for a single axis are also supported, for example to show the `range()` or `fivenum()` of an axis: -```{r} -p |> - add_line(y = range(hp), colour = "blue", legend.value = "Min/Max HP") - -p2 <- ggplot(mtcars) + - geom_point(aes(mpg, hp)) + - labs(title = "Also Works On ggplot()") -p2 |> - add_line(y = range(hp), colour = "blue", legend.value = "Min/Max HP") -``` - -#### Adding Points - -Points can be added to highlight specific values or observations: - -```{r} -p |> - add_point(x = median(mpg), y = median(hp), shape = 4, size = 10) -``` - -In this example, we add a point at the median `mpg` and `hp`, using a cross shape and a larger size for emphasis. - -#### Adding Columns - -Adding columns is just as straightforward, and can be used to create bar charts or other similar visualisations: - -```{r} -p |> - add_col(x = cyl, y = n(), width = 0.5) -``` - -Here, we add columns based on the number of cylinders, making it easy to compare the counts across different groups. - -### Plotting Error Bars - -Plotting error bars is just as simple: - -```{r} -p |> - add_errorbar(min = hp - 10, max = hp + 10, colour = "black") -``` - -This adds error bars to the plot, showing a range of ±10 around the `hp` values. - -### Adding Spatial Features with add_sf() - -For those working with geographic data, `add_sf()` makes it easy to integrate spatial features: - -```{r} -plot2(netherlands) |> - add_sf(netherlands, colour_fill = NA, colour = "red", linewidth = 2) -``` - -This example adds spatial features to a plot of the Netherlands, with an extra border around the provinces. - -# Discussion - -`plot2()` is more than just a wrapper for `ggplot2`; it embodies a philosophy of simplifying and streamlining the plotting process while building on the robust foundation that `ggplot2` provides. If you're familiar with `ggplot2`, you know that its explicit, detailed approach to plot creation is one of its greatest strengths, allowing for unparalleled control over every aspect of a visualisation. However, with that power comes the need for repetitive coding and a certain level of complexity that can be challenging, especially for beginners. - -### Enhancing Workflow Efficiency - -The primary goal of `plot2()` is to make data visualisation faster and more intuitive by automating many of the routine tasks involved in creating plots. Whether you’re working with simple data or complex datasets requiring advanced transformations, `plot2()` helps you get to the final visualisation with fewer lines of code and less cognitive load. This not only speeds up your workflow but also makes your code more readable and maintainable. - -For instance, the ability to perform inline transformations directly within the plotting function eliminates the need for pre-processing steps that would otherwise require additional code blocks using, e.g., `dplyr` or `tidyr`. This feature of `plot2()` alone can drastically reduce the complexity of your code, especially when working with large and multifaceted datasets. - -### A Natural Extension of `ggplot2` - -`ggplot2` has established itself as a cornerstone of data visualisation in R, and for good reason. Its layer-based approach and extensive customisation options make it incredibly powerful. `plot2()` is designed to complement these strengths by offering a more streamlined interface that automates many of the common tasks in `ggplot2`. Think of `plot2()` as a natural extension of `ggplot2` — one that retains the underlying power while simplifying the process, especially for users who prefer a more direct path from data to visualisation. - -The `add_*()` functions exemplify this philosophy by allowing users to add layers and elements with minimal code, maintaining the flexibility of `ggplot2` while reducing the need for repetitive boilerplate. This makes it easier to experiment with different visualisations and iterate quickly on your designs. - -### Flexibility Without Complexity - -One of the key advantages of `plot2()` is that it retains the flexibility of `ggplot2` while reducing the need for detailed specification. The automatic handling of plot types, axis settings, and scales means that you can create sophisticated plots with minimal input. Yet, when you need to take control, `plot2()` offers all the options you would expect, from custom sorting to precise colour control and font selection. - -This balance between flexibility and simplicity is what makes `plot2()` a powerful tool for both beginners and experienced users. Beginners can quickly produce high-quality plots without getting bogged down in the details, while advanced users can still leverage the full power of `ggplot2` when necessary. - -### Philosophical Underpinnings - -At the heart of `plot2()` is a commitment to making data visualisation more accessible and less intimidating. The goal is to lower the barriers to entry for creating professional-quality plots, thereby empowering more people to engage with data in a meaningful way. This aligns with the broader trend in the R community and the tidyverse towards creating tools that are both powerful and easy to use. - -`plot2()` is also designed with the understanding that not every user needs — or wants — to be an expert in the intricacies of `ggplot2`. By providing sensible defaults and automating common tasks, `plot2()` allows users to focus on the most important part of the visualisation process: interpreting and communicating their data. - -### Reflecting on Usage Scenarios - -The real value of `plot2()` becomes evident in real-world usage scenarios. Whether you’re creating a quick exploratory plot or preparing a polished visualisation for publication, `plot2()` adapts to your needs. Its versatility makes it suitable for a wide range of applications, from routine data analysis to sophisticated data storytelling. - -Moreover, `plot2()` integrates seamlessly with the broader tidyverse ecosystem. It works effortlessly with other tidyverse packages, allowing you to incorporate it into your existing workflows without disruption. This ensures that you can continue to use the tools you’re familiar with while benefiting from the efficiencies that `plot2()` brings. - -### Looking Forward - -As the R community continues to evolve, so too will the tools we use for data visualisation. `plot2()` represents a step towards a more user-friendly and efficient future, where the focus is on insights and communication rather than technical details. It’s a tool that grows with you — whether you’re just starting out or pushing the boundaries of what’s possible with data visualisation. - -In the end, the success of any tool is measured by how well it meets the needs of its users. `plot2()` has been designed with a deep understanding of the challenges and frustrations that come with creating complex plots in R. By addressing these challenges head-on, `plot2()` aims to make your data visualisation journey smoother, more enjoyable, and ultimately more productive.