From b233ac8c6cb25e8477a3bc678c65d9d10ebbfc62 Mon Sep 17 00:00:00 2001
From: gmillot <gael.millot@pasteur.fr>
Date: Sat, 1 Apr 2023 00:30:22 +0200
Subject: [PATCH] test
---
cute_little_R_functions.R | 6903 +++++++++++++++++-----------------
examples_fun_gg_donut.R | 89 +-
fun_gg_boxplot.docx | Bin 116136 -> 116122 bytes
fun_gg_donut.R | 81 +-
~$te_little_R_functions.docx | Bin 0 -> 162 bytes
5 files changed, 3555 insertions(+), 3518 deletions(-)
create mode 100644 ~$te_little_R_functions.docx
diff --git a/cute_little_R_functions.R b/cute_little_R_functions.R
index e8a2c90..2683ccd 100755
--- a/cute_little_R_functions.R
+++ b/cute_little_R_functions.R
@@ -9138,31 +9138,66 @@ fun_get_message <- function(
+# Error: class order not good when a class is removed due to NA
+# Error: line 136 in check 20201126 with add argument
+# Solve this: sometimes error messages can be more than the max display (8170). Thus, check every paste0("ERROR IN ", function.name, and trunck the message if to big. In addition, add at the begining of the warning message that it is too long and see the $warn output for complete message. Add also this into fun_scatter
+# add dot.shape ? See with available aesthetic layers
+# rasterise: https://cran.r-project.org/web/packages/ggrastr/vignettes/Raster_geoms.html
+# add horizontal argument and deal any conflict with vertical argument. Start with horizontal = NULL as default. If ! is.null() -> convert vertical if required
+# time for excecution : microbenchmark package. See also in RStudio time per line of code. See also https://stackoverflow.com/questions/7561362/what-can-cause-a-program-to-run-much-faster-the-second-time
-fun_gg_donut <- function(
+fun_gg_boxplot <- function(
data1,
- freq,
+ y,
categ,
- fill.palette = NULL,
- fill.color = NULL,
- hole.size = 0.5,
- hole.text = TRUE,
- hole.text.size = 14,
- border.color = "gray50",
- border.size = 0.2,
+ categ.class.order = NULL,
+ categ.color = NULL,
+ box.legend.name = NULL,
+ box.fill = FALSE,
+ box.width = 0.5,
+ box.space = 0.1,
+ box.line.size = 0.75,
+ box.notch = FALSE,
+ box.alpha = 1,
+ box.mean = TRUE,
+ box.whisker.kind = "std",
+ box.whisker.width = 0,
+ dot.color = grey(0.25),
+ dot.categ = NULL,
+ dot.categ.class.order = NULL,
+ dot.legend.name = NULL,
+ dot.tidy = FALSE,
+ dot.tidy.bin.nb = 50,
+ dot.jitter = 0.5,
+ dot.seed = 2,
+ dot.size = 3,
+ dot.alpha = 0.5,
+ dot.border.size = 0.5,
+ dot.border.color = NULL,
+ x.lab = NULL,
+ x.angle = 0,
+ y.lab = NULL,
+ y.lim = NULL,
+ y.log = "no",
+ y.tick.nb = NULL,
+ y.second.tick.nb = 1,
+ y.include.zero = FALSE,
+ y.top.extra.margin = 0.05,
+ y.bottom.extra.margin = 0.05,
+ stat.pos = "top",
+ stat.mean = FALSE,
+ stat.size = 4,
+ stat.dist = 5,
+ stat.angle = 0,
+ vertical = TRUE,
+ text.size = 12,
title = "",
- title.text.size = 12,
- annotation = NULL,
- annotation.distance = 0,
- annotation.size = 3,
- annotation.force = 1,
- annotation.force.pull = 100,
+ title.text.size = 8,
legend.show = TRUE,
- legend.width = 0.25,
- legend.name = NULL,
- legend.limit = NULL,
- legend.add.prop = FALSE,
+ legend.width = 0.5,
+ article = TRUE,
+ grid = FALSE,
add = NULL,
return = FALSE,
return.ggplot = FALSE,
@@ -9172,86 +9207,157 @@ fun_gg_donut <- function(
lib.path = NULL
){
# AIM
- # Plot a ggplot2 donut using contingency data, systematically in the decreasing order of frequencies, starting at the top and turning clockwise
+ # Plot ggplot2 boxplots + dots + means
# For ggplot2 specifications, see: https://ggplot2.tidyverse.org/articles/ggplot2-specs.html
# WARNINGS
- # Rows containing NA in data1[, c(freq, categ)] will be removed before processing, with a warning (see below)
- # Size arguments (hole.text.size, border.size, title.text.size and annotation.size) are in mm. See Hadley comment in https://stackoverflow.com/questions/17311917/ggplot2-the-unit-of-size. See also http://sape.inf.usi.ch/quick-reference/ggplot2/size). Unit object are not accepted, but conversion can be used (e.g., grid::convertUnit(grid::unit(0.2, "inches"), "mm", valueOnly = TRUE))
+ # Rows containing NA in data1[, c(y, categ)] will be removed before processing, with a warning (see below)
+ # Hinges are not computed like in the classical boxplot() function of R. See https://ggplot2.tidyverse.org/reference/geom_boxplot.html
+ # To have a single box, please create a factor column with a single class and specify the name of this column in the categ argument. For a single set of grouped boxes, create a factor column with a single class and specify this column in categ argument as first element (i.e., as categ1, knowing that categ2 must also be specified in this situation). See categ argument below
+ # The dot.alpha argument can alter the display of the color boxes when using pdf output
+ # Size arguments (box.line.size, dot.size, dot.border.size, stat.size, text.size and title.text.size) are in mm. See Hadley comment in https://stackoverflow.com/questions/17311917/ggplot2-the-unit-of-size. See also http://sape.inf.usi.ch/quick-reference/ggplot2/size). Unit object are not accepted, but conversion can be used (e.g., grid::convertUnit(grid::unit(0.2, "inches"), "mm", valueOnly = TRUE))
+ # Display seems to be done twice on Windows devices (like a blink). However, no double plots on pdf devices. Thus, the blink remains mysterious
+ # To remove boxes and have only dots, use box.alpha = 0
# ARGUMENTS
- # data1: a dataframe compatible with ggplot2
- # freq: single character string of the data1 column name of the frequencies
- # categ: single character string of the data1 column name of categories (qualitative variable)
- # fill.palette: single character string of a palette name (see ?ggplot2::scale_fill_brewer() for the list).Ignored if fill.color is not NULL
- # fill.color: either (1) NULL, or (2) a vector of character strings or integers of same length as the number of classes in categ. Colors can be color names (see ?colors() in R), hexadecimal color codes, or integers (according to the ggplot2 palette). The order of the elements will be used according to the frequency values, from highest to lowest. An easy way to use this argument is to sort data1 according to the frequencies values, add a color column with the corresponding desired colors and use the content of this column as values of fill.color. If color is NULL and fill.palette is NULL, default colors of ggplot2 are used. If color is not NULL, it overrides fill.palette
- # hole.size: single positive proportion of donut central hole, 0 meaning no hole and 1 no donut
- # hole.text: logical (either TRUE or FALSE). Display the sum of frequencies (column of data1 indicated in the freq argument) ?
- # hole.text.size: single positive numeric value of the title font size in mm. Ignored if hole.text is FALSE
- # border.color: a single character string or integer. Colors can be color names (see ?colors() in R), hexadecimal color codes, or integers (according to the ggplot2 palette)
- # border.size: single numeric value of border tickness in mm. Write zero for no dot border
- # title: single character string of the graph title
- # title.text.size: single numeric value of the title font size in mm
- # annotation: single character string of the data1 column name of annotations. Values inside this column will be displayed over the corresponding slices of the donut. Write NULL if not required
- # annotation.distance: single positive numeric value of the distance from the center of the slice. 0 means center of the slice, 0.5 means at the edge. Above 0.5, the donut will be reduced to make place for the annotation. Ignored if annotation is NULL
- # annotation.size: single positive numeric value of the annotation font size in mm. Ignored if annotation is NULL
- # annotation.force: single positive numeric value of the force of repulsion between overlapping text labels. See ?ggrepel::geom_text_repel() in R. Ignored if annotation is NULL
- # annotation.force.pull: single positive numeric value of the force of attraction between a text label and its corresponding data point. See ?ggrepel::geom_text_repel() in R. Ignored if annotation is NULL
- # legend.show: logical (either TRUE or FALSE). Show legend?
+ # data1: data frame containing one column of quantitative values (see the y argument below) and one or two columns of categories (see the categ argument below). Duplicated column names are not allowed
+ # y: character string of the data1 column name for y-axis (column containing numeric values). Numeric values will be split according to the classes of the column names indicated in the categ argument to generate the boxes and will also be used to plot the dots
+ # categ: vector of character strings of the data1 column name for categories (column of characters or factors). Must be either one or two column names. If a single column name (further referred to as categ1), then one box per class of categ1. If two column names (further referred to as categ1 and categ2), then one box per class of categ2, which form a group of boxes in each class of categ1. WARNING: no empty classes allowed. To have a single box, create a factor column with a single class and specify the name of this column in the categ argument (here, no categ2 in categ argument). For a single set of grouped boxes, create a factor column with a single class and specify this column in categ argument as first element (i.e., as categ1), in addition to the already used category (as categ2 in this situation)
+ # categ.class.order: list indicating the order of the classes of categ1 and categ2 represented on the boxplot (the first compartment for categ1 and and the second for categ2). If categ.class.order == NULL, classes are represented according to the alphabetical order. Some compartments can be NULL and others not. See the categ argument for categ1 and categ2 description
+ # categ.color: vector of color character string for box frames (see the categ argument for categ1 and categ2 description)
+ # If categ.color == NULL, default colors of ggplot2, whatever categ1 and categ2
+ # If categ.color is non-null and only categ1 in categ argument, categ.color can be either:
+ # (1) a single color string. All the boxes will have this color, whatever the number of classes of categ1
+ # (2) a vector of string colors, one for each class of categ1. Each color will be associated according to categ.class.order of categ1
+ # (3) a vector or factor of string colors, like if it was one of the column of data1 data frame. WARNING: a single color per class of categ1 and a single class of categ1 per color must be respected
+ # Color functions, like grey(), hsv(), etc., are also accepted
+ # Positive integers are also accepted instead of character strings, as long as above rules about length are respected. Integers will be processed by fun_gg_palette() using the maximal integer value among all the integers in categ.color (see fun_gg_palette())
+ # If categ.color is non-null and categ1 and categ2 are specified, all the rules described above will apply to categ2 instead of categ1 (colors will be determined for boxes inside a group of boxes)
+ # box.legend.name: character string of the legend title. If box.legend.name is NULL, then box.legend.name <- categ1 if only categ1 is present, and box.legend.name <- categ2 if categ1 and categ2 are present in the categ argument. Write "" if no legend required. See the categ argument for categ1 and categ2 description
+ # box.fill: logical. Fill the box? If TRUE, the categ.color argument will be used to generate filled boxplots (the box frames being black) as well as filled outlier dots (the dot border being controlled by the dot.border.color argument). If all the dots are plotted (argument dot.color other than NULL), they will be over the boxes. If FALSE, the categ.color argument will be used to color the box frames and the outlier dot borders. If all the dots are plotted, they will be beneath the boxes
+ # box.width: single numeric value (from 0 to 1) of width of either boxes or group of boxes
+ # When categ argument has a single categ1 element (i.e., separate boxes. See the categ argument for categ1 and categ2 description), then each class of categ1 is represented by a single box. In that case, box.width argument defines each box width, from 0 (no box width) to 1 (max box width), but also the space between boxes (the code uses 1 - box.width for the box spaces). Of note, xmin and xmax of the fun_gg_boxplot() output report the box boundaries (around x-axis unit 1, 2, 3, etc., for each box)
+ # When categ argument has a two categ1 and categ2 elements (i.e., grouped boxes), box.width argument defines the width allocated for each set of grouped boxes, from 0 (no group width) to 1 (max group width), but also the space between grouped boxes (the code uses 1 - box.width for the spaces). Of note, xmin and xmax of the fun_gg_boxplot() output report the box boundaries (around x-axis unit 1, 2, 3, etc., for each set of grouped box)
+ # box.space: single numeric value (from 0 to 1) indicating the box separation inside grouped boxes, when categ argument has a two categ1 and categ2 elements. 0 means no space and 1 means boxes shrunk to a vertical line. Ignored if categ argument has a single categ1 element
+ # box.line.size: single numeric value of line width of boxes and whiskers in mm
+ # box.notch: logical. Notched boxplot? It TRUE, display notched boxplot, notches corresponding approximately to the 95% confidence interval of the median (the notch interval is exactly 1.58 x Inter Quartile Range (IQR) / sqrt(n), with n the number of values that made the box). If notch intervals between two boxes do not overlap, it can be interpreted as significant median differences
+ # box.alpha: single numeric value (from 0 to 1) of box transparency (full transparent to full opaque, respectively). To remove boxplots, use box.alpha = 0
+ # box.mean: logical. Add mean value? If TRUE, a diamond-shaped dot, with the horizontal diagonal corresponding to the mean value, is displayed over each boxplot
+ # box.whisker.kind: range of the whiskers. Either "no" (no whiskers), or "std" (length of each whisker equal to 1.5 x Inter Quartile Range (IQR)), or "max" (length of the whiskers up or down to the most distant dot)
+ # box.whisker.width: single numeric value (from 0 to 1) of the whisker width, with 0 meaning no whiskers and 1 meaning a width equal to the box width
+ # dot.color: vector of color character string ruling the dot colors and the dot display. See the example section below for easier understanding of the rules described here
+ # If NULL, no dots plotted
+ # If "same", the dots will have the same colors as the respective boxplots
+ # Otherwise, as in the rule (1), (2) or (3) described in the categ.color argument, except that in the possibility (3), the rule "a single color per class of categ and a single class of categ per color", does not have to be respected (for instance, each dot can have a different color). Colors will also depend on the dot.categ argument. If dot.categ is NULL, then colors will be applied to each class of the last column name specified in categ. If dot.categ is non-NULL, colors will be applied to each class of the column name specified in dot.categ. See examples
+ # dot.categ: optional single character string of a column name (further referred to as categ3) of the data1 argument. This column of data1 will be used to generate a legend for dots, in addition to the legend for boxes. See the dot.color argument for details about the way the legend is built using the two dot.categ and dot.color arguments. If NULL, no legend created and the colors of dots will depend on dot.color and categ arguments (as explained in the dot.color argument)
+ # dot.categ.class.order: optional vector of character strings indicating the order of the classes of categ3 (see the dot.categ argument). If dot.categ is non-NULL and dot.categ.class.order is NULL, classes are displayed in the legend according to the alphabetical order. Ignored if dot.categ is NULL
+ # dot.legend.name: optional character string of the legend title for categ3 (see the dot.categ argument). If dot.legend.name == NULL, dot.categ value is used (name of the column in data1). Write "" if no legend required. Ignored if dot.categ is NULL
+ # dot.tidy: logical. Nice dot spreading? If TRUE, use the geom_dotplot() function for a nice representation. WARNING: change the true quantitative coordinates of dots (i.e., y-axis values for vertical display) because of binning. Thus, the gain in aestheticism is associated with a loss in precision that can be very important. If FALSE, dots are randomly spread on the qualitative axis, using the dot.jitter argument (see below) keeping the true quantitative coordinates
+ # dot.tidy.bin.nb: positive integer indicating the number of bins (i.e., nb of separations) of the y.lim range. Each dot will then be put in one of the bin, with a diameter of the width of the bin. In other words, increase the number of bins to have smaller dots. Not considered if dot.tidy is FALSE
+ # dot.jitter: numeric value (from 0 to 1) of random dot horizontal dispersion (for vertical display), with 0 meaning no dispersion and 1 meaning dispersion in the corresponding box width interval. Not considered if dot.tidy is TRUE
+ # dot.seed: integer value that set the random seed. Using the same number will generate the same dot jittering. Write NULL to have different jittering each time the same instruction is run. Ignored if dot.tidy is TRUE
+ # dot.size: numeric value of dot diameter in mm. Not considered if dot.tidy is TRUE
+ # dot.alpha: numeric value (from 0 to 1) of dot transparency (full transparent to full opaque, respectively)
+ # dot.border.size: numeric value of border dot width in mm. Write zero for no dot border. If dot.tidy is TRUE, value 0 remove the border and other values leave the border without size control (geom_doplot() feature)
+ # dot.border.color: single character color string defining the color of the dot border (same color for all the dots, whatever their categories). If dot.border.color == NULL, the border color will be the same as the dot color. A single integer is also accepted instead of a character string, that will be processed by fun_gg_palette()
+ # x.lab: a character string or expression for x-axis legend. If NULL, character string of categ1 (see the categ argument for categ1 and categ2 description)
+ # x.angle: integer value of the text angle for the x-axis numbers, using the same rules as in ggplot2. Positive values for counterclockwise rotation: 0 for horizontal, 90 for vertical, 180 for upside down etc. Negative values for clockwise rotation: 0 for horizontal, -90 for vertical, -180 for upside down etc.
+ # y.lab: a character string or expression for y-axis legend. If NULL, character string of the y argument
+ # y.lim: 2 numeric values indicating the range of the y-axis. Order matters (for inverted axis). If NULL, the range of the x column name of data1 will be used.
+ # y.log: either "no", "log2" (values in the y argument column of the data1 data frame will be log2 transformed and y-axis will be log2 scaled) or "log10" (values in the y argument column of the data1 data frame will be log10 transformed and y-axis will be log10 scaled). WARNING: not possible to have horizontal boxes with a log axis, due to a bug in ggplot2 (see https://github.com/tidyverse/ggplot2/issues/881)
+ # y.tick.nb: approximate number of desired values labeling the y-axis (i.e., main ticks, see the n argument of the the cute::fun_scale() function). If NULL and if y.log is "no", then the number of labeling values is set by ggplot2. If NULL and if y.log is "log2" or "log10", then the number of labeling values corresponds to all the exposant integers in the y.lim range (e.g., 10^1, 10^2 and 10^3, meaning 3 main ticks for y.lim = c(9, 1200)). WARNING: if non-NULL and if y.log is "log2" or "log10", labeling can be difficult to read (e.g., ..., 10^2, 10^2.5, 10^3, ...)
+ # y.second.tick.nb: number of desired secondary ticks between main ticks. Ignored if y.log is other than "no" (log scale plotted). Use argument return = TRUE and see $plot$y.second.tick.values to have the values associated to secondary ticks. IF NULL, no secondary ticks
+ # y.include.zero: logical. Does y.lim range include 0? Ignored if y.log is "log2" or "log10"
+ # y.top.extra.margin: single proportion (between 0 and 1) indicating if extra margins must be added to y.lim. If different from 0, add the range of the axis multiplied by y.top.extra.margin (e.g., abs(y.lim[2] - y.lim[1]) * y.top.extra.margin) to the top of y-axis
+ # y.bottom.extra.margin: idem as y.top.extra.margin but to the bottom of y-axis
+ # stat.pos: add the median number above the corresponding box. Either NULL (no number shown), "top" (at the top of the plot region) or "above" (above each box)
+ # stat.mean: logical. Display mean numbers instead of median numbers? Ignored if stat.pos is NULL
+ # stat.size: numeric value of the stat font size in mm. Ignored if stat.pos is NULL
+ # stat.dist: numeric value of the stat distance in percentage of the y-axis range (stat.dist = 5 means move the number displayed at 5% of the y-axis range). Ignored if stat.pos is NULL or "top"
+ # stat.angle: integer value of the angle of stat, using the same rules as in ggplot2. Positive values for counterclockwise rotation: 0 for horizontal, 90 for vertical, 180 for upside down etc. Negative values for clockwise rotation: 0 for horizontal, -90 for vertical, -180 for upside down etc.
+ # vertical: logical. Vertical boxes? WARNING: will be automatically set to TRUE if y.log argument is other than "no". Indeed, not possible to have horizontal boxes with a log axis, due to a bug in ggplot2 (see https://github.com/tidyverse/ggplot2/issues/881)
+ # text.size: numeric value of the font size of the (1) axis numbers, (2) axis labels and (3) texts in the graphic legend (in mm)
+ # title: character string of the graph title
+ # title.text.size: numeric value of the title font size in mm
+ # legend.show: logical. Show legend? Not considered if categ argument is NULL, because this already generate no legend, excepted if legend.width argument is non-NULL. In that specific case (categ is NULL, legend.show is TRUE and legend.width is non-NULL), an empty legend space is created. This can be useful when desiring graphs of exactly the same width, whatever they have legends or not
# legend.width: single proportion (between 0 and 1) indicating the relative width of the legend sector (on the right of the plot) relative to the width of the plot. Value 1 means that the window device width is split in 2, half for the plot and half for the legend. Value 0 means no room for the legend, which will overlay the plot region. Write NULL to inactivate the legend sector. In such case, ggplot2 will manage the room required for the legend display, meaning that the width of the plotting region can vary between graphs, depending on the text in the legend
- # legend.name: character string of the legend title. If legend.name is NULL then legend.name is the value of the categ argument. Write legend.name = "" to remove the legend
- # legend.limit: single positive proportion of the classes displayed in the legend for which the corresponding proportion is over legend.limit. Write NULL to display all the classes
- # legend.add.prop: logical (either TRUE or FALSE). add the proportion after the class names in the legend ?
+ # article: logical. If TRUE, use an article theme (article like). If FALSE, use a classic related ggplot theme. Use the add argument (e.g., add = "+ggplot2::theme_classic()" for the exact classic ggplot theme
+ # grid: logical. Draw lines in the background to better read the box values? Not considered if article == FALSE (grid systematically present)
# add: character string allowing to add more ggplot2 features (dots, lines, themes, facet, etc.). Ignored if NULL
# WARNING: (1) the string must start with "+", (2) the string must finish with ")" and (3) each function must be preceded by "ggplot2::". Example: "+ ggplot2::coord_flip() + ggplot2::theme_bw()"
- # If the character string contains the "ggplot2::theme" string, then the article argument of fun_gg_donut() (see above) is ignored with a warning. In addition, some arguments can be overwritten, like x.angle (check all the arguments)
+ # If the character string contains the "ggplot2::theme" string, then the article argument of fun_gg_boxplot() (see above) is ignored with a warning. In addition, some arguments can be overwritten, like x.angle (check all the arguments)
# Handle the add argument with caution since added functions can create conflicts with the preexisting internal ggplot2 functions
- # WARNING: the call of objects inside the quotes of add can lead to an error if the name of these objects are some of the fun_gg_donut() arguments. Indeed, the function will use the internal argument instead of the global environment object. Example article <- "a" in the working environment and add = '+ ggplot2::ggtitle(article)'. The risk here is to have TRUE as title. To solve this, use add = '+ ggplot2::ggtitle(get("article", envir = .GlobalEnv))'
- # return: logical (either TRUE or FALSE). Return the graph parameters?
- # return.ggplot: logical (either TRUE or FALSE). Return the ggplot object in the output list? Ignored if return argument is FALSE. WARNING: always assign the fun_gg_donut() function (e.g., a <- fun_gg_donut()) into something if the return.ggplot argument is TRUE, otherwise, double plotting is performed. See $ggplot in the RETURN section below for more details
- # return.gtable: logical (either TRUE or FALSE). Return the ggplot object as gtable of grobs in the output list? Ignored if plot argument is FALSE. Indeed, the graph must be plotted to get the grobs dispositions. See $gtable in the RETURN section below for more details
- # plot: logical (either TRUE or FALSE). Plot the graphic? If FALSE and return argument is TRUE, graphical parameters and associated warnings are provided without plotting
- # warn.print: logical (either TRUE or FALSE). Print warnings at the end of the execution? ? If FALSE, warning messages are never printed, but can still be recovered in the returned list. Some of the warning messages (those delivered by the internal ggplot2 functions) are not apparent when using the argument plot = FALSE
- # lib.path: vector of character strings indicating the absolute path of the required packages (see below). if NULL, the function will use the R library default folders
+ # WARNING: the call of objects inside the quotes of add can lead to an error if the name of these objects are some of the fun_gg_boxplot() arguments. Indeed, the function will use the internal argument instead of the global environment object. Example article <- "a" in the working environment and add = '+ ggplot2::ggtitle(article)'. The risk here is to have TRUE as title. To solve this, use add = '+ ggplot2::ggtitle(get("article", envir = .GlobalEnv))'
+ # return: logical. Return the graph parameters?
+ # return.ggplot: logical. Return the ggplot object in the output list? Ignored if return argument is FALSE. WARNING: always assign the fun_gg_boxplot() function (e.g., a <- fun_gg_boxplot()) if return.ggplot argument is TRUE, otherwise, double plotting is performed. See $ggplot in the RETURN section below for more details
+ # return.gtable: logical. Return the ggplot object as gtable of grobs in the output list? Ignored if plot argument is FALSE. Indeed, the graph must be plotted to get the grobs dispositions. See $gtable in the RETURN section below for more details
+ # plot: logical. Plot the graphic? If FALSE and return argument is TRUE, graphical parameters and associated warnings are provided without plotting
+ # warn.print: logical. Print warnings at the end of the execution? ? If FALSE, warning messages are never printed, but can still be recovered in the returned list. Some of the warning messages (those delivered by the internal ggplot2 functions) are not apparent when using the argument plot = FALSE
+ # lib.path: character string indicating the absolute path of the required packages (see below). if NULL, the function will use the R library default folders
# RETURN
- # a donut plot if plot argument is TRUE
- # a list of the graph info if return argument is TRUE:
- # $data: the initial data with modifications and with graphic information added
- # $removed.row.nb: a list of the removed rows numbers in data frames (because of NA). NULL if no row removed
- # $removed.rows: a list of the removed rows in data frames (because of NA). NULL if no row removed
+ # A boxplot if plot argument is TRUE
+ # A list of the graph info if return argument is TRUE:
+ # $data: the initial data with graphic information added
+ # $stat: the graphic statistics (mostly equivalent to ggplot_build()$data[[2]])
+ # $removed.row.nb: which rows have been removed due to NA/Inf detection in y and categ columns (NULL if no row removed)
+ # $removed.rows: removed rows (NULL if no row removed)
+ # $plot: the graphic box and dot coordinates
+ # $dots: dot coordinates
+ # $main.box: coordinates of boxes
+ # $median: median coordinates
+ # $sup.whisker: coordinates of top whiskers (y for base and y.end for extremities)
+ # $inf.whisker: coordinates of bottom whiskers (y for base and y.end for extremities)
+ # $sup.whisker.edge: coordinates of top whisker edges (x and xend)
+ # $inf.whisker.edge: coordinates of bottom whisker edges(x and xend)
+ # $mean: diamond mean coordinates (only if box.mean argument is TRUE)
+ # $stat.pos: coordinates of stat numbers (only if stat.pos argument is not NULL)
+ # y.second.tick.positions: coordinates of secondary ticks (only if y.second.tick.nb argument is non-NULL or if y.log argument is different from "no")
+ # y.second.tick.values: values of secondary ticks. NULL except if y.second.tick.nb argument is non-NULL or if y.log argument is different from "no")
# $panel: the variable names used for the panels (NULL if no panels). WARNING: NA can be present according to ggplot2 upgrade to v3.3.0
# $axes: the x-axis and y-axis info
+
# $warn: the warning messages. Use cat() for proper display. NULL if no warning. WARNING: warning messages delivered by the internal ggplot2 functions are not apparent when using the argument plot = FALSE
- # $ggplot: ggplot object that can be used for reprint (use print($ggplot) or update (use $ggplot + ggplot2::...). NULL if return.ggplot argument is FALSE. Warning: the legend is not in $ggplot as it is in a separated grob (use $gtable to get it). Of note, a non-null $ggplot in the output list is sometimes annoying as the manipulation of this list prints the plot
+ # $ggplot: ggplot object that can be used for reprint (use print(...$ggplot) or update (use ...$ggplot + ggplot2::...). NULL if return.ggplot argument is FALSE. Of note, a non-NULL $ggplot in the output list is sometimes annoying as the manipulation of this list prints the plot
# $gtable: gtable object that can be used for reprint (use gridExtra::grid.arrange(...$ggplot) or with additionnal grobs (see the grob decomposition in the examples). NULL if return.ggplot argument is FALSE. Contrary to $ggplot, a non-NULL $gtable in the output list is not annoying as the manipulation of this list does not print the plot
# REQUIRED PACKAGES
# ggplot2
# gridExtra
- # grid
# lemon (in case of use in the add argument)
- # ggrepel
+ # scales
# REQUIRED FUNCTIONS FROM THE cute PACKAGE
+ # fun_check()
+ # fun_comp_1d()
+ # fun_comp_2d()
+ # fun_gg_just()
# fun_gg_palette()
- # fun_gg_get_legend()
+ # fun_inter_ticks()
+ # fun_name_change()
# fun_pack()
- # fun_check()
- # EXAMPLES
- # obs1 <- data.frame(Km = c(20, 10, 1, 5), Car = c("TUUT", "WIIM", "BIP", "WROUM"), Color1 = 1:4, color2 = c("red", "blue", "green", "black"), Country = c("FR", "UK", "US", NA), stringsAsFactors = TRUE) ; fun_gg_donut(data1 = obs1, freq = "Km", categ = "Car", annotation = "Country")
+ # fun_round()
+ # fun_scale()
+ # EXAMPLE
+ # set.seed(1) ; obs1 <- data.frame(Time = c(rnorm(20, 100, 10), rnorm(20, 200, 50), rnorm(20, 500, 60), rnorm(20, 100, 50)), Categ1 = rep(c("CAT", "DOG"), times = 40), Categ2 = rep(c("A", "B", "C", "D"), each = 20), Color1 = rep(c("coral", "lightblue"), times = 40), Color2 = rep(c("#9F2108", "#306100", "#007479", "#8500C0"), each = 20), stringsAsFactors = TRUE) ; set.seed(NULL) ; fun_gg_boxplot(data1 = obs1, y = "Time", categ = "Categ1")
+ # see http
# DEBUGGING
- # obs1 <- data.frame(Km = c(20, 10, 1, 5), Car = c("TUUT", "WIIM", "BIP", "WROUM"), Color1 = 1:4, color2 = c("red", "blue", "green", "black"), Country = c("FR", "UK", "US", NA), stringsAsFactors = TRUE) ; data1 = obs1 ; freq = "Km" ; categ = "Car" ; fill.palette = NULL ; fill.color = NULL ; hole.size = 0.5 ; hole.text = TRUE ; hole.text.size = 12 ; border.color = "gray50" ; border.size = 0.1 ; title = "" ; title.text.size = 12 ; annotation = "Country" ; annotation.distance = 0.5 ; annotation.size = 3 ; annotation.force = 1 ; annotation.force.pull = 100 ; legend.show = TRUE ; legend.width = 0.5 ; legend.name = NULL ; legend.limit = NULL ; legend.add.prop = FALSE ; add = NULL ; return = TRUE ; return.ggplot = FALSE ; return.gtable = TRUE ; plot = TRUE ; warn.print = FALSE ; lib.path = NULL
+ # set.seed(1) ; obs1 <- data.frame(Time = c(rnorm(10), rnorm(10) + 2), Categ1 = rep(c("G", "H"), each = 10), stringsAsFactors = TRUE) ; set.seed(NULL) ; obs1$Time[1:10] <- NA ; data1 = obs1 ; y = "Time" ; categ = c("Categ1") ; categ.class.order = NULL ; categ.color = NULL ; box.legend.name = NULL ; box.fill = FALSE ; box.width = 0.5 ; box.space = 0.1 ; box.line.size = 0.75 ; box.notch = FALSE ; box.alpha = 1 ; box.mean = TRUE ; box.whisker.kind = "std" ; box.whisker.width = 0 ; dot.color = grey(0.25) ; dot.categ = NULL ; dot.categ.class.order = NULL ; dot.legend.name = NULL ; dot.tidy = FALSE ; dot.tidy.bin.nb = 50 ; dot.jitter = 0.5 ; dot.seed = 2 ; dot.size = 3 ; dot.alpha = 0.5 ; dot.border.size = 0.5 ; dot.border.color = NULL ; x.lab = NULL ; x.angle = 0 ; y.lab = NULL ; y.lim = NULL ; y.log = "no" ; y.tick.nb = NULL ; y.second.tick.nb = 1 ; y.include.zero = FALSE ; y.top.extra.margin = 0.05 ; y.bottom.extra.margin = 0.05 ; stat.pos = "top" ; stat.mean = FALSE ; stat.size = 4 ; stat.dist = 5 ; stat.angle = 0 ; vertical = TRUE ; text.size = 12 ; title = "" ; title.text.size = 8 ; legend.show = TRUE ; legend.width = 0.5 ; article = TRUE ; grid = FALSE ; add = NULL ; return = FALSE ; return.ggplot = FALSE ; return.gtable = TRUE ; plot = TRUE ; warn.print = FALSE ; lib.path = NULL
# function name
- function.name <- paste0(as.list(match.call(expand.dots=FALSE))[[1]], "()")
+ function.name <- paste0(as.list(match.call(expand.dots = FALSE))[[1]], "()")
arg.names <- names(formals(fun = sys.function(sys.parent(n = 2)))) # names of all the arguments
- arg.user.setting <- as.list(match.call(expand.dots=FALSE))[-1] # list of the argument settings (excluding default values not provided by the user)
+ arg.user.setting <- as.list(match.call(expand.dots = FALSE))[-1] # list of the argument settings (excluding default values not provided by the user)
# end function name
# required function checking
req.function <- c(
- "fun_check",
+ "fun_comp_2d",
+ "fun_gg_just",
"fun_gg_palette",
- "fun_gg_get_legend",
- "fun_pack"
+ "fun_name_change",
+ "fun_pack",
+ "fun_check",
+ "fun_round",
+ "fun_scale",
+ "fun_inter_ticks"
)
tempo <- NULL
for(i1 in req.function){
- if(length(find(i1, mode = "function"))== 0L){
+ if(length(find(i1, mode = "function")) == 0L){
tempo <- c(tempo, i1)
}
}
@@ -9260,16 +9366,17 @@ fun_gg_donut <- function(
stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
}
# end required function checking
- # reserved words to avoid bugs (used in this function)
+ # reserved words to avoid bugs (names of dataframe columns used in this function)
+ reserved.words <- c("categ.check", "categ.color", "dot.color", "dot.categ", "dot.max", "dot.min", "group", "PANEL", "group.check", "MEAN", "tempo.categ1", "tempo.categ2", "text.max.pos", "text.min.pos", "x", "x.y", "y", "y.check", "y_from.dot.max", "ymax", "tidy_group", "binwidth")
# end reserved words to avoid bugs (used in this function)
# arg with no default values
mandat.args <- c(
"data1",
- "freq",
+ "y",
"categ"
)
tempo <- eval(parse(text = paste0("missing(", paste0(mandat.args, collapse = ") | missing("), ")")))
- if(any(tempo)){
+ if(any(tempo)){ # normally no NA for missing() output
tempo.cat <- paste0("ERROR IN ", function.name, "\nFOLLOWING ARGUMENT", ifelse(length(mandat.args) > 1, "S HAVE", "HAS"), " NO DEFAULT VALUE AND REQUIRE ONE:\n", paste0(mandat.args, collapse = "\n"))
stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
}
@@ -9280,84 +9387,234 @@ fun_gg_donut <- function(
checked.arg.names <- NULL # for function debbuging: used by r_debugging_tools
ee <- expression(arg.check <- c(arg.check, tempo$problem) , text.check <- c(text.check, tempo$text) , checked.arg.names <- c(checked.arg.names, tempo$object.name))
tempo <- fun_check(data = data1, class = "data.frame", na.contain = TRUE, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = freq, class = "vector", mode = "character", na.contain = FALSE, length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = categ, class = "vector", mode = "character", na.contain = FALSE, length = 1, fun.name = function.name) ; eval(ee)
- if( ! is.null(fill.palette)){
- tempo <- fun_check(data = fill.palette, options = c("BrBG", "PiYG", "PRGn", "PuOr", "RdBu", "RdGy", "RdYlBu", "RdYlGn", "Spectral", "Accent", "Dark2", "Paired", "Pastel1", "Pastel2", "Set1", "Set2", "Set3", "Blues", "BuGn", "BuPu", "GnBu", "Greens", "Greys", "Oranges", "OrRd", "PuBu", "PuBuGn", "PuRd", "Purples", "RdPu", "Reds", "YlGn", "YlGnBu", "YlOrBr", "YlOrRd"), length = 1, fun.name = function.name) ; eval(ee)
- }else{
+ tempo <- fun_check(data = y, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = categ, class = "vector", mode = "character", fun.name = function.name) ; eval(ee)
+ if( ! is.null(categ.class.order)){
+ tempo <- fun_check(data = categ.class.order, class = "list", fun.name = function.name) ; eval(ee)
+ }else{
# no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = fill.palette, class = "vector")
+ tempo <- fun_check(data = categ.class.order, class = "vector")
checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- if( ! is.null(fill.color)){
- tempo1 <- fun_check(data = fill.color, class = "vector", mode = "character", na.contain = TRUE, fun.name = function.name)
- tempo2 <- fun_check(data = fill.color, class = "factor", na.contain = TRUE, fun.name = function.name)
- tempo3 <- fun_check(data = fill.color, class = "integer", double.as.integer.allowed = TRUE, na.contain = TRUE, neg.values = FALSE, fun.name = function.name) # not need to test inf with integers
- if(tempo1$problem == TRUE & tempo2$problem == TRUE & tempo3$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nfill.color ARGUMENT MUST BE A VECTOR OF (1) HEXADECIMAL COLOR STRINGS STARTING BY #, OR (2) COLOR NAMES GIVEN BY colors(), OR (3) POSITIVE INTEGER VALUES")
+ if( ! is.null(box.legend.name)){
+ tempo <- fun_check(data = box.legend.name, class = "vector", mode = "character", fun.name = function.name) ; eval(ee)
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = box.legend.name, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ if( ! is.null(categ.color)){
+ tempo1 <- fun_check(data = categ.color, class = "vector", mode = "character", na.contain = TRUE, fun.name = function.name)
+ tempo2 <- fun_check(data = categ.color, class = "factor", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.check.color <- fun_check(data = categ.color, class = "integer", double.as.integer.allowed = TRUE, na.contain = TRUE, neg.values = FALSE, fun.name = function.name)$problem
+ if(tempo.check.color == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg.color ARGUMENT MUST BE A FACTOR OR CHARACTER VECTOR OR POSITVE INTEGER VECTOR") # integer possible because dealt above
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }else if(any(categ.color == 0L, na.rm = TRUE)){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg.color ARGUMENT MUST BE A FACTOR OR CHARACTER VECTOR OR POSITVE INTEGER VECTOR") # integer possible because dealt above
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ }
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = categ.color, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ tempo <- fun_check(data = box.fill, class = "vector", mode = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = box.width, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = box.space, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = box.line.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = box.notch, class = "vector", mode = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = box.alpha, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = box.mean, class = "vector", mode = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = box.whisker.kind, options = c("no", "std", "max"), length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = box.whisker.width, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ if( ! is.null(dot.color)){
+ tempo1 <- fun_check(data = dot.color, class = "vector", mode = "character", na.contain = TRUE, fun.name = function.name)
+ tempo2 <- fun_check(data = dot.color, class = "factor", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.check.color <- fun_check(data = dot.color, class = "integer", double.as.integer.allowed = TRUE, na.contain = TRUE, neg.values = FALSE, fun.name = function.name)$problem
+ if(tempo.check.color == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.color MUST BE A FACTOR OR CHARACTER VECTOR OR POSITVE INTEGER VECTOR") # integer possible because dealt above
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }else if(any(dot.color == 0L, na.rm = TRUE)){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.color ARGUMENT MUST BE A FACTOR OR CHARACTER VECTOR OR POSITVE INTEGER VECTOR") # integer possible because dealt above
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ }
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = dot.color, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ if( ! is.null(dot.categ)){
+ tempo <- fun_check(data = dot.categ, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = dot.categ, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ if( ! is.null(dot.categ.class.order)){
+ tempo <- fun_check(data = dot.categ.class.order, class = "vector", mode = "character", fun.name = function.name) ; eval(ee)
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = dot.categ.class.order, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ if( ! is.null(dot.legend.name)){
+ tempo <- fun_check(data = dot.legend.name, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = dot.legend.name, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ tempo <- fun_check(data = dot.tidy, class = "vector", mode = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = dot.tidy.bin.nb, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, neg.values = FALSE, fun.name = function.name) ; eval(ee)
+ if(tempo$problem == FALSE){
+ if(dot.tidy.bin.nb == 0L){ # length and NA checked above
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.tidy.bin.nb ARGUMENT MUST BE A NON-NULL AND POSITVE INTEGER VALUE") # integer possible because dealt above
text.check <- c(text.check, tempo.cat)
arg.check <- c(arg.check, TRUE)
- checked.arg.names <- c(checked.arg.names, tempo1$object.name)
- }else if(tempo3$problem == FALSE & any(is.infinite(fill.color))){ # is.infinite() deals with NA as FALSE
- tempo.cat <- paste0("ERROR IN ", function.name, "\nfill.color ARGUMENT CANNOT CONTAIN Inf VALUES AMONG POSITIVE INTEGER VALUES")
+ }
+ }
+ tempo <- fun_check(data = dot.jitter, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ if( ! is.null(dot.seed)){
+ tempo <- fun_check(data = dot.seed, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, neg.values = TRUE, fun.name = function.name) ; eval(ee)
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = dot.seed, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ tempo <- fun_check(data = dot.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = dot.alpha, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = dot.border.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
+ if( ! is.null(dot.border.color)){
+ tempo1 <- fun_check(data = dot.border.color, class = "vector", mode = "character", length = 1, fun.name = function.name)
+ tempo2 <- fun_check(data = dot.border.color, class = "vector", typeof = "integer", double.as.integer.allowed = TRUE, length = 1, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.border.color ARGUMENT MUST BE (1) A HEXADECIMAL COLOR STRING STARTING BY #, OR (2) A COLOR NAME GIVEN BY colors(), OR (3) AN INTEGER VALUE")
text.check <- c(text.check, tempo.cat)
arg.check <- c(arg.check, TRUE)
- checked.arg.names <- c(checked.arg.names, tempo1$object.name)
- }else if(tempo3$problem == FALSE & any(fill.color == 0, na.rm = TRUE)){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nfill.color ARGUMENT CANNOT CONTAIN 0 AMONG POSITIVE INTEGER VALUES")
+ }else if(tempo1$problem == FALSE & tempo2$problem == TRUE){
+ if( ! all(dot.border.color %in% colors() | grepl(pattern = "^#", dot.border.color), na.rm = TRUE)){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.border.color ARGUMENT MUST BE (1) A HEXADECIMAL COLOR STRING STARTING BY #, OR (2) A COLOR NAME GIVEN BY colors(), OR (3) AN INTEGER VALUE")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ }
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = dot.border.color, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ if( ! is.null(x.lab)){
+ tempo1 <- fun_check(data = x.lab, class = "expression", length = 1, fun.name = function.name)
+ tempo2 <- fun_check(data = x.lab, class = "vector", mode = "character", length = 1, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nx.lab ARGUMENT MUST BE A SINGLE CHARACTER STRING OR EXPRESSION")
text.check <- c(text.check, tempo.cat)
arg.check <- c(arg.check, TRUE)
- checked.arg.names <- c(checked.arg.names, tempo1$object.name)
}
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = x.lab, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- tempo <- fun_check(data = hole.size, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = hole.text, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = hole.text.size, class = "vector", mode = "numeric", neg.values = FALSE, inf.values = FALSE, length = 1, fun.name = function.name) ; eval(ee)
- tempo1 <- fun_check(data = border.color, class = "vector", mode = "character", na.contain = FALSE, length = 1, fun.name = function.name)
- tempo2 <- fun_check(data = border.color, class = "integer", double.as.integer.allowed = TRUE, neg.values = FALSE, na.contain = FALSE, length = 1, fun.name = function.name) # not need to test inf with integers
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nborder.color ARGUMENT MUST BE A SINGLE CHARACTER STRING OR POSITIVE INTEGER")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- checked.arg.names <- c(checked.arg.names, tempo1$object.name)
+ tempo <- fun_check(data = x.angle, class = "vector", typeof = "integer", double.as.integer.allowed = TRUE, length = 1, neg.values = TRUE, fun.name = function.name) ; eval(ee)
+ if( ! is.null(y.lab)){
+ tempo1 <- fun_check(data = y.lab, class = "expression", length = 1, fun.name = function.name)
+ tempo2 <- fun_check(data = y.lab, class = "vector", mode = "character", length = 1, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ny.lab ARGUMENT MUST BE A SINGLE CHARACTER STRING OR EXPRESSION")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = y.lab, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- tempo <- fun_check(data = border.size, class = "vector", mode = "numeric", na.contain = FALSE, neg.values = FALSE, inf.values = FALSE, length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = title, class = "vector", mode = "character", na.contain = FALSE, length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = title.text.size, class = "vector", mode = "numeric", na.contain = FALSE, neg.values = FALSE, inf.values = FALSE, length = 1, fun.name = function.name) ; eval(ee)
- if( ! is.null(annotation)){
- tempo <- fun_check(data = annotation, class = "vector", mode = "character", na.contain = FALSE, length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = annotation.distance, class = "vector", mode = "numeric", na.contain = FALSE, neg.values = FALSE, inf.values = FALSE, length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = annotation.size, class = "vector", mode = "numeric", na.contain = FALSE, neg.values = FALSE, inf.values = FALSE, length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = annotation.force, class = "vector", mode = "numeric", na.contain = FALSE, neg.values = FALSE, inf.values = FALSE, length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = annotation.force.pull, class = "vector", mode = "numeric", na.contain = FALSE, neg.values = FALSE, inf.values = FALSE, length = 1, fun.name = function.name) ; eval(ee)
+ if( ! is.null(y.lim)){
+ tempo <- fun_check(data = y.lim, class = "vector", mode = "numeric", length = 2, fun.name = function.name) ; eval(ee)
+ if(tempo$problem == FALSE){
+ if(any(is.infinite(y.lim))){ # normally no NA for is.infinite() output
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ny.lim ARGUMENT CANNOT CONTAIN -Inf OR Inf VALUES")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ }
}else{
# no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = annotation, class = "vector")
+ tempo <- fun_check(data = y.lim, class = "vector")
checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- tempo <- fun_check(data = legend.show, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- if( ! is.null(legend.width)){
- tempo <- fun_check(data = legend.width, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = y.log, options = c("no", "log2", "log10"), length = 1, fun.name = function.name) ; eval(ee)
+ if( ! is.null(y.tick.nb)){
+ tempo <- fun_check(data = y.tick.nb, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, fun.name = function.name) ; eval(ee)
+ if(tempo$problem == FALSE){
+ if(y.tick.nb < 0){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ny.tick.nb ARGUMENT MUST BE A NON NULL POSITIVE INTEGER")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ }
}else{
# no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = legend.width, class = "vector")
+ tempo <- fun_check(data = y.tick.nb, class = "vector")
checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- if( ! is.null(legend.name)){
- tempo <- fun_check(data = legend.name, class = "vector", mode = "character", na.contain = FALSE, length = 1, fun.name = function.name) ; eval(ee)
+ if( ! is.null(y.second.tick.nb)){
+ tempo <- fun_check(data = y.second.tick.nb, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, fun.name = function.name) ; eval(ee)
+ if(tempo$problem == FALSE){
+ if(y.second.tick.nb <= 0){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ny.second.tick.nb ARGUMENT MUST BE A NON NULL POSITIVE INTEGER")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ }
}else{
# no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = legend.name, class = "vector")
+ tempo <- fun_check(data = y.second.tick.nb, class = "vector")
checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- if( ! is.null(legend.limit)){
- tempo <- fun_check(data = legend.limit, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = y.include.zero, class = "vector", mode = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = y.top.extra.margin, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = y.bottom.extra.margin, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ if( ! is.null(stat.pos)){
+ tempo <- fun_check(data = stat.pos, options = c("top", "above"), length = 1, fun.name = function.name) ; eval(ee)
}else{
# no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = legend.limit, class = "vector")
+ tempo <- fun_check(data = stat.pos, class = "vector")
checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- tempo <- fun_check(data = legend.add.prop, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = stat.mean, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = stat.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = stat.dist, class = "vector", mode = "numeric", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = stat.angle, class = "vector", typeof = "integer", double.as.integer.allowed = TRUE, length = 1, neg.values = TRUE, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = vertical, class = "vector", mode = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = text.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = title, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = title.text.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = legend.show, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ if( ! is.null(legend.width)){
+ tempo <- fun_check(data = legend.width, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = legend.width, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ tempo <- fun_check(data = article, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = grid, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
if( ! is.null(add)){
tempo <- fun_check(data = add, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
}else{
@@ -9371,65 +9628,95 @@ fun_gg_donut <- function(
tempo <- fun_check(data = plot, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
tempo <- fun_check(data = warn.print, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
if( ! is.null(lib.path)){
- tempo <- fun_check(data = lib.path, class = "vector", mode = "character", fun.name = function.name) ; eval(ee) # several possible paths
+ tempo <- fun_check(data = lib.path, class = "vector", mode = "character", fun.name = function.name) ; eval(ee)
+ if(tempo$problem == FALSE){
+ if( ! all(dir.exists(lib.path), na.rm = TRUE)){ # separation to avoid the problem of tempo$problem == FALSE and lib.path == NA
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nDIRECTORY PATH INDICATED IN THE lib.path ARGUMENT DOES NOT EXISTS:\n", paste(lib.path, collapse = "\n"))
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ }
}else{
# no fun_check test here, it is just for checked.arg.names
tempo <- fun_check(data = lib.path, class = "vector")
checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- if(any(arg.check) == TRUE){
- stop(paste0("\n\n================\n\n", paste(text.check[arg.check], collapse = "\n"), "\n\n================\n\n"), call. = FALSE) #
+ if(any(arg.check) == TRUE){ # normally no NA
+ stop(paste0("\n\n================\n\n", paste(text.check[arg.check], collapse = "\n"), "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between == #
}
# source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.7/r_debugging_tools-v1.7.R") ; eval(parse(text = str_basic_arg_check_dev)) ; eval(parse(text = str_arg_check_with_fun_check_dev)) # activate this line and use the function (with no arguments left as NULL) to check arguments status and if they have been checked using fun_check()
# end argument primary checking
# second round of checking and data preparation
# management of NA arguments
tempo.arg <- names(arg.user.setting) # values provided by the user
- tempo.log <- suppressWarnings(sapply(lapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = is.na), FUN = any)) & lapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = length)== 1L # no argument provided by the user can be just NA
- if(any(tempo.log) == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, "\n", ifelse(sum(tempo.log, na.rm = TRUE) > 1, "THESE ARGUMENTS\n", "THIS ARGUMENT\n"), paste0(tempo.arg[tempo.log], collapse = "\n"),"\nCANNOT BE JUST NA")
+ tempo.log <- suppressWarnings(sapply(lapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = is.na), FUN = any)) & lapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = length) == 1L # no argument provided by the user can be just NA
+ if(any(tempo.log) == TRUE){ # normally no NA because is.na() used here
+ tempo.cat <- paste0("ERROR IN ", function.name, ":\n", ifelse(sum(tempo.log, na.rm = TRUE) > 1, "THESE ARGUMENTS\n", "THIS ARGUMENT\n"), paste0(tempo.arg[tempo.log], collapse = "\n"),"\nCANNOT JUST BE NA")
stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
}
# end management of NA arguments
# management of NULL arguments
tempo.arg <-c(
"data1",
- "freq",
+ "y",
"categ",
- # "fill.palette", # inactivated because can be null
- # "fill.color", # inactivated because can be null
- "hole.size",
- "hole.text",
- "hole.text.size",
- "border.color",
- "border.size",
+ "box.fill",
+ "box.width",
+ "box.space",
+ "box.line.size",
+ "box.notch",
+ "box.alpha",
+ "box.mean",
+ "box.whisker.kind",
+ "box.whisker.width",
+ # "dot.color", # inactivated because can be null
+ "dot.tidy",
+ "dot.tidy.bin.nb",
+ "dot.jitter",
+ # "dot.seed", # inactivated because can be null
+ "dot.size",
+ "dot.alpha",
+ "dot.border.size",
+ "x.angle",
+ "y.log",
+ # "y.second.tick.nb", # inactivated because can be null
+ "y.include.zero",
+ "y.top.extra.margin",
+ "y.bottom.extra.margin",
+ # "stat.pos", # inactivated because can be null
+ "stat.mean",
+ "stat.size",
+ "stat.dist",
+ "stat.angle",
+ "vertical",
+ "text.size",
"title",
"title.text.size",
- # "annotation", # inactivated because can be null
- "annotation.distance",
- "annotation.size",
- "annotation.force",
- "annotation.force.pull",
"legend.show",
# "legend.width", # inactivated because can be null
- # "legend.name", # inactivated because can be null
- # "legend.limit", # inactivated because can be null
- "legend.add.prop",
- # "add", # inactivated because can be null
+ "article",
+ "grid",
"return",
"return.ggplot",
"return.gtable",
"plot",
"warn.print"
- # "lib.path" # inactivated because can be null
)
tempo.log <- sapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = is.null)
- if(any(tempo.log) == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, "\n", ifelse(sum(tempo.log, na.rm = TRUE) > 1, "THESE ARGUMENTS\n", "THIS ARGUMENT\n"), paste0(tempo.arg[tempo.log], collapse = "\n"),"\nCANNOT BE NULL")
+ if(any(tempo.log) == TRUE){# normally no NA with is.null()
+ tempo.cat <- paste0("ERROR IN ", function.name, ":\n", ifelse(sum(tempo.log, na.rm = TRUE) > 1, "THESE ARGUMENTS\n", "THIS ARGUMENT\n"), paste0(tempo.arg[tempo.log], collapse = "\n"),"\nCANNOT BE NULL")
stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
}
# end management of NULL arguments
# code that protects set.seed() in the global environment
+ # see also Protocol 100-rev0 Parallelization in R.docx
+ if(exists(".Random.seed", envir = .GlobalEnv)){ # if .Random.seed does not exists, it means that no random operation has been performed yet in any R environment
+ tempo.random.seed <- .Random.seed
+ on.exit(assign(".Random.seed", tempo.random.seed, env = .GlobalEnv))
+ }else{
+ on.exit(set.seed(NULL)) # inactivate seeding -> return to complete randomness
+ }
+ set.seed(dot.seed)
# end code that protects set.seed() in the global environment
# warning initiation
ini.warning.length <- options()$warning.length
@@ -9438,139 +9725,101 @@ fun_gg_donut <- function(
warn.count <- 0
# end warning initiation
# other checkings
- removed.row.nb <- NULL
- removed.rows <- data.frame(stringsAsFactors = FALSE)
- data1.ini <- data1 # strictly identical to data1
- if( ! freq %in% names(data1)){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nfreq ARGUMENT MUST BE A COLUMN NAME OF THE data1 ARGUMENT")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ if(any(duplicated(names(data1)), na.rm = TRUE)){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nDUPLICATED COLUMN NAMES OF data1 ARGUMENT NOT ALLOWED:\n", paste(names(data1)[duplicated(names(data1))], collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ if( ! (y %in% names(data1))){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ny ARGUMENT MUST BE A COLUMN NAME OF data1")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}else{
- if(all(is.na(data1[ , freq]) | is.infinite(data1[ , freq]))){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE freq COLUMN OF data1 CANNOT BE JUST NA OR Inf")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
- }
- tempo <- fun_check(data = data1[ , freq], mode = "numeric", neg.values = FALSE, fun.name = function.name)
+ tempo <- fun_check(data = data1[, y], data.name = "y COLUMN OF data1", class = "vector", mode = "numeric", na.contain = TRUE, fun.name = function.name)
if(tempo$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, "\n", tempo$text)
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
- }
- # Inf and NA removal
- if(any(is.infinite(data1[, freq]) | is.na(data1[, freq]))){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") PRESENCE OF Inf OR NA VALUES IN THE ", freq, " COLUMN OF THE data1 ARGUMENT AND CORRESPONDING ROWS REMOVED (SEE $removed.row.nb AND $removed.rows)")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- tempo <- which(is.infinite(data1.ini[, freq]) | is.na(data1.ini[, freq])) # data.ini used for the output
- removed.row.nb <- c(removed.row.nb, tempo)
- removed.rows <- rbind(removed.rows, data1.ini[tempo, ], stringsAsFactors = FALSE) # data.ini used for the output
- data1 <- data1[ ! (is.infinite(data1[, freq]) | is.na(data1[, freq])), ] #
- }
- # end Inf and NA removal
- # 0 removal
- if(any(data1[, freq] == 0)){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") PRESENCE OF 0 VALUES IN THE ", freq, " COLUMN OF THE data1 ARGUMENT AND CORRESPONDING ROWS REMOVED (SEE $removed.row.nb AND $removed.rows)")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- tempo <- which(data1[, freq] == 0) # data.ini used for the output
- removed.row.nb <- c(removed.row.nb, tempo)
- removed.rows <- rbind(removed.rows, data1.ini[tempo, ], stringsAsFactors = FALSE) # data.ini used for the output
- data1 <- data1[ data1[, freq] != 0, ] #
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ny ARGUMENT MUST BE NUMERIC COLUMN IN data1")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
- # end 0 removal
}
-
- if( ! categ %in% names(data1)){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg ARGUMENT MUST BE A COLUMN NAME OF THE data1 ARGUMENT")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
- }else{
- if(all(is.na(data1[ , categ]))){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE categ COLUMN OF data1 CANNOT BE JUST NA")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
- }
- tempo1 <- fun_check(data = categ, class = "vector", mode = "character", na.contain = TRUE, fun.name = function.name)
- tempo2 <- fun_check(data = categ, class = "factor", na.contain = TRUE, fun.name = function.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE categ COLUMN OF data1 MUST BE CLASS \"factor\" OR \"character\"")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
- }
- # NA removal
- if(any(is.na(data1[, categ]))){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") PRESENCE OF NA VALUES IN THE ", categ, " COLUMN OF THE data1 ARGUMENT AND CORRESPONDING ROWS REMOVED (SEE $removed.row.nb AND $removed.rows)")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- tempo <- which(is.na(data1.ini[, categ])) # data.ini used for the output
- removed.row.nb <- c(removed.row.nb, tempo)
- removed.rows <- rbind(removed.rows, data1.ini[tempo, ], stringsAsFactors = FALSE) # data.ini used for the output
- data1 <- data1[ ! is.na(data1[, categ]), ] #
- }
- # end Inf and NA removal
- if(any(duplicated(data1[, categ]))){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE categ COLUMN OF data1 CANNOT CONTAIN DUPLICATED VALUES\n", paste(data1[, categ][duplicated(data1[, categ])], collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
- }
+ if(length(categ) > 2){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg ARGUMENT CANNOT HAVE MORE THAN 2 COLUMN NAMES OF data1")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else if( ! all(categ %in% names(data1))){ # all() without na.rm -> ok because categ cannot be NA (tested above)
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg ARGUMENT MUST BE COLUMN NAMES OF data1. HERE IT IS:\n", paste(categ, collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
-
- if( ! is.null(annotation)){
- if( ! annotation %in% names(data1)){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nannotation ARGUMENT MUST BE A COLUMN NAME OF THE data1 ARGUMENT")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
- }else{
- if(all(is.na(data1[ , annotation]))){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nIF NON NULL, THE annotation COLUMN OF data1 CANNOT BE JUST NA")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ if(length(dot.categ) > 1){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.categ ARGUMENT CANNOT HAVE MORE THAN 1 COLUMN NAMES OF data1")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else if( ! all(dot.categ %in% names(data1))){ # all() without na.rm -> ok because dot.categ cannot be NA (tested above)
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.categ ARGUMENT MUST BE COLUMN NAMES OF data1. HERE IT IS:\n", paste(dot.categ, collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ # reserved word checking
+ if(any(names(data1) %in% reserved.words, na.rm = TRUE)){
+ if(any(duplicated(names(data1)), na.rm = TRUE)){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nDUPLICATED COLUMN NAMES OF data1 ARGUMENT NOT ALLOWED:\n", paste(names(data1)[duplicated(names(data1))], collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ if( ! is.null(dot.categ)){
+ if(dot.categ %in% categ){
+ reserved.words <- c(reserved.words, paste0(dot.categ, "_DOT")) # paste0(dot.categ, "_DOT") is added to the reserved words because in such situation, a new column will be added to data1 that is named paste0(dot.categ, "_DOT")
}
- tempo1 <- fun_check(data = annotation, class = "vector", mode = "character", na.contain = TRUE, fun.name = function.name)
- tempo2 <- fun_check(data = annotation, class = "factor", na.contain = TRUE, fun.name = function.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE annotation COLUMN OF data1 MUST BE CLASS \"factor\" OR \"character\"")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }
+ tempo.output <- fun_name_change(names(data1), reserved.words)
+ for(i2 in 1:length(tempo.output$ini)){ # a loop to be sure to take the good ones
+ names(data1)[names(data1) == tempo.output$ini[i2]] <- tempo.output$post[i2]
+ if(any(y == tempo.output$ini[i2])){ # any() without na.rm -> ok because y cannot be NA (tested above)
+ y[y == tempo.output$ini[i2]] <- tempo.output$post[i2]
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") IN y ARGUMENT (COLUMN NAMES OF data1 ARGUMENT),\n", tempo.output$ini[i2], " HAS BEEN REPLACED BY ", tempo.output$post[i2], "\nBECAUSE RISK OF BUG AS SOME NAMES IN y ARGUMENT ARE RESERVED WORD USED BY THE ", function.name, " FUNCTION")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
}
- if(any(duplicated(data1[, annotation]))){
+ # WARNING: names of y argument potentially replaced
+ if(any(categ == tempo.output$ini[i2])){ # any() without na.rm -> ok because categ cannot be NA (tested above)
+ categ[categ == tempo.output$ini[i2]] <- tempo.output$post[i2]
warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") PRESENCE OF DUPLICATED VALUES IN THE ", annotation, " COLUMN OF THE data1 ARGUMENT: ", paste0(data1[, annotation][duplicated(data1[, annotation])], collapse = " "))
+ tempo.warn <- paste0("(", warn.count,") IN categ ARGUMENT (COLUMN NAMES OF data1 ARGUMENT),\n", tempo.output$ini[i2], " HAS BEEN REPLACED BY ", tempo.output$post[i2], "\nBECAUSE RISK OF BUG AS SOME NAMES IN categ ARGUMENT ARE RESERVED WORD USED BY THE ", function.name, " FUNCTION")
warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
}
+ # WARNING: names of categ argument potentially replaced
+ if( ! is.null(dot.categ)){
+ if(any(dot.categ == tempo.output$ini[i2])){ # any() without na.rm -> ok because dot.categ cannot be NA (tested above)
+ dot.categ[dot.categ == tempo.output$ini[i2]] <- tempo.output$post[i2]
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") IN dot.categ ARGUMENT (COLUMN NAMES OF data1 ARGUMENT),\n", tempo.output$ini[i2], " HAS BEEN REPLACED BY ", tempo.output$post[i2], "\nBECAUSE RISK OF BUG AS SOME NAMES IN dot.categ ARGUMENT ARE RESERVED WORD USED BY THE ", function.name, " FUNCTION")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ }
+ # WARNING: names of dot.categ argument potentially replaced
}
- }
- if(length(data1) == 0){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE data1 ARGUMENT IS EMPTY AFTER Inf, NA AND 0 REMOVAL IN THE ", freq, ifelse(is.null(annotation), " AND ", ", "), categ, ifelse(is.null(annotation), "", " AND "), " COLUMNS")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
- }
- if( ! is.null(fill.color)){
- if( ! is.numeric(fill.color)){
- if( ! all(fill.color[ ! is.na(fill.color)] %in% colors() | grepl(pattern = "^#", fill.color[ ! is.na(fill.color)]), na.rm = TRUE)){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nfill.color ARGUMENT MUST BE A VECTOR OF (1) HEXADECIMAL COLOR STRINGS STARTING BY #, OR (2) COLOR NAMES GIVEN BY colors(), OR (3) INTEGER VALUES")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
- }else{
- fill.color <- as.character(fill.color) # remove class factor is any
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") REGARDING COLUMN NAMES REPLACEMENT, THE NAMES\n", paste(tempo.output$ini, collapse = " "), "\nHAVE BEEN REPLACED BY\n", paste(tempo.output$post, collapse = " "))
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ if( ! (is.null(add) | is.null(tempo.output$ini))){
+ if(grepl(x = add, pattern = paste(tempo.output$ini, collapse = "|"))){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nDETECTION OF COLUMN NAMES OF data1 IN THE add ARGUMENT STRING, THAT CORRESPOND TO RESERVED STRINGS FOR ", function.name, "\nCOLUMN NAMES HAVE TO BE CHANGED\nTHE PROBLEMATIC COLUMN NAMES ARE SOME OF THESE NAMES:\n", paste(tempo.output$ini, collapse = " "), "\nIN THE DATA FRAME OF data1 AND IN THE STRING OF add ARGUMENT, TRY TO REPLACE NAMES BY:\n", paste(tempo.output$post, collapse = " "), "\n\nFOR INFORMATION, THE RESERVED WORDS ARE:\n", paste(reserved.words, collapse = "\n"))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
}
}
- if( ! is.numeric(border.color)){
- if( ! (border.color %in% colors() | grepl(pattern = "^#", border.color))){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nfill.color ARGUMENT MUST BE (1) A HEXADECIMAL COLOR STRING STARTING BY #, OR (2) A COLOR NAME GIVEN BY colors(), OR (3) AN INTEGER VALUE")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
- }else{
- border.color <- as.character(border.color) # remove class factor is any
+ if( ! (is.null(add))){
+ if(any(sapply(X = arg.names, FUN = grepl, x = add), na.rm = TRUE)){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") NAMES OF ", function.name, " ARGUMENTS DETECTED IN THE add STRING:\n", paste(arg.names[sapply(X = arg.names, FUN = grepl, x = add)], collapse = "\n"), "\nRISK OF WRONG OBJECT USAGE INSIDE ", function.name)
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
}
}
- # legend name filling
- if(is.null(legend.name)){
- legend.name <- categ
- }
- # legend.name not NULL anymore
- # end legend name filling
+ # end reserved word checking
# verif of add
if( ! is.null(add)){
if( ! grepl(pattern = "^\\s*\\+", add)){ # check that the add string start by +
tempo.cat <- paste0("ERROR IN ", function.name, "\nadd ARGUMENT MUST START WITH \"+\": ", paste(unique(add), collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
-
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}else if( ! grepl(pattern = "(ggplot2|lemon)\\s*::", add)){ #
tempo.cat <- paste0("ERROR IN ", function.name, "\nFOR EASIER FUNCTION DETECTION, add ARGUMENT MUST CONTAIN \"ggplot2::\" OR \"lemon::\" IN FRONT OF EACH GGPLOT2 FUNCTION: ", paste(unique(add), collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}else if( ! grepl(pattern = ")\\s*$", add)){ # check that the add string finished by )
tempo.cat <- paste0("ERROR IN ", function.name, "\nadd ARGUMENT MUST FINISH BY \")\": ", paste(unique(add), collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
}
# end verif of add
@@ -9582,3108 +9831,2145 @@ fun_gg_donut <- function(
tempo <- sub(x = tempo, pattern = "^facet_wrap", replacement = "ggplot2::facet_wrap")
tempo <- sub(x = tempo, pattern = "^facet_grid", replacement = "ggplot2::facet_grid")
tempo <- sub(x = tempo, pattern = "^facet_rep", replacement = "lemon::facet_rep")
-
- if(any(grepl(x = tempo, pattern = "ggplot2::facet_wrap|lemon::facet_rep_wrap"))){
+ if(any(grepl(x = tempo, pattern = "ggplot2::facet_wrap|lemon::facet_rep_wrap"), na.rm = TRUE)){
tempo1 <- suppressWarnings(eval(parse(text = tempo[grepl(x = tempo, pattern = "ggplot2::facet_wrap|lemon::facet_rep_wrap")])))
- facet.categ <- list(names(tempo1$params$facets)) # list of length 1
+ facet.categ <- names(tempo1$params$facets)
tempo.text <- "facet_wrap OR facet_rep_wrap"
facet.check <- FALSE
}else if(grepl(x = add, pattern = "ggplot2::facet_grid|lemon::facet_rep_grid")){
tempo1 <- suppressWarnings(eval(parse(text = tempo[grepl(x = tempo, pattern = "ggplot2::facet_grid|lemon::facet_rep_grid")])))
- facet.categ <- list(c(names(tempo1$params$rows), names(tempo1$params$cols))) # list of length 1
+ facet.categ <- c(names(tempo1$params$rows), names(tempo1$params$cols))
tempo.text <- "facet_grid OR facet_rep_grid"
facet.check <- FALSE
}
- if(facet.check == FALSE & ! all(facet.categ %in% names(data1))){ # WARNING: all(facet.categ %in% names(data1)) is TRUE when facet.categ is NULL
+ if(facet.check == FALSE & ! all(facet.categ %in% names(data1))){ # WARNING: all(facet.categ %in% names(data1)) is TRUE when facet.categ is NULL # all() without na.rm -> ok because facet.categ cannot be NA (tested above)
tempo.cat <- paste0("ERROR IN ", function.name, "\nDETECTION OF \"", tempo.text, "\" STRING IN THE add ARGUMENT BUT PROBLEM OF VARIABLE DETECTION (COLUMN NAMES OF data1)\nTHE DETECTED VARIABLES ARE:\n", paste(facet.categ, collapse = " "), "\nTHE data1 COLUMN NAMES ARE:\n", paste(names(data1), collapse = " "), "\nPLEASE REWRITE THE add STRING AND RERUN")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
}
- # if facet.categ is not NULL, it is a list of length 1 now
# end management of add containing facet
- if( ! is.null(lib.path)){
- if( ! all(dir.exists(lib.path))){ # separation to avoid the problem of tempo$problem == FALSE and lib.path == NA
- tempo.cat <- paste0("ERROR IN ", function.name, "\nDIRECTORY PATH INDICATED IN THE lib.path ARGUMENT DOES NOT EXISTS:\n", paste(lib.path, collapse = "\n"))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ # conversion of categ columns in data1 into factors
+ for(i1 in 1:length(categ)){
+ tempo1 <- fun_check(data = data1[, categ[i1]], data.name = paste0("categ NUMBER ", i1, " OF data1"), class = "vector", mode = "character", na.contain = TRUE, fun.name = function.name)
+ tempo2 <- fun_check(data = data1[, categ[i1]], data.name = paste0("categ NUMBER ", i1, " OF data1"), class = "factor", na.contain = TRUE, fun.name = function.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\n", paste0("categ NUMBER ", i1, " OF data1"), " MUST BE A FACTOR OR CHARACTER VECTOR")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else if(tempo1$problem == FALSE){ # character vector
+ if(box.alpha != 0){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") IN categ NUMBER ", i1, " IN data1, THE CHARACTER COLUMN HAS BEEN CONVERTED TO FACTOR, WITH LEVELS ACCORDING TO THE ALPHABETICAL ORDER")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
}
+ data1[, categ[i1]] <- factor(data1[, categ[i1]]) # if already a factor, change nothing, if characters, levels according to alphabetical order
}
- # end other checkings
- # reserved word checking
- if( ! (is.null(add))){
- if(any(sapply(X = arg.names, FUN = grepl, x = add), na.rm = TRUE)){
+ # OK: all the categ columns of data1 are factors from here
+ # end conversion of categ columns in data1 into factors
+
+
+
+ # management of log scale and Inf removal
+ if(any(( ! is.finite(data1[, y])) & ( ! is.na(data1[, y])))){ # is.finite also detects NA: ( ! is.finite(data1[, y])) & ( ! is.na(data1[, y])) detects only Inf # normally no NA with is.finite0() and is.na()
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") PRESENCE OF -Inf OR Inf VALUES IN THE ", y, " COLUMN OF THE data1 ARGUMENT AND CORRESPONDING ROWS REMOVED (SEE $removed.row.nb AND $removed.rows)")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ data1.ini <- data1 # strictly identical to data1 except that in data1 y is log converted if and only if y.log != "no"
+ if(y.log != "no"){
+ tempo1 <- ! is.finite(data1[, y]) # where are initial NA and Inf
+ data1[, y] <- suppressWarnings(get(y.log)(data1[, y]))# no env = sys.nframe(), inherit = FALSE in get() because look for function in the classical scope
+ if(any( ! (tempo1 | is.finite(data1[, y])))){ # normally no NA with is.finite
warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") NAMES OF ", function.name, " ARGUMENTS DETECTED IN THE add STRING:\n", paste(arg.names[sapply(X = arg.names, FUN = grepl, x = add)], collapse = "\n"), "\nRISK OF WRONG OBJECT USAGE INSIDE ", function.name)
+ tempo.warn <- paste0("(", warn.count,") LOG CONVERSION INTRODUCED -Inf OR Inf OR NaN VALUES IN THE ", y, " COLUMN OF THE data1 ARGUMENT AND CORRESPONDING ROWS REMOVED (SEE $removed.row.nb AND $removed.rows)")
warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
}
}
- # verif of add
- if( ! is.null(add)){
- if( ! grepl(pattern = "^\\s*\\+", add)){ # check that the add string start by +
- tempo.cat <- paste0("ERROR IN ", function.name, "\nadd ARGUMENT MUST START WITH \"+\": ", paste(unique(add), collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else if( ! grepl(pattern = "(ggplot2|lemon)\\s*::", add)){ #
- tempo.cat <- paste0("ERROR IN ", function.name, "\nFOR EASIER FUNCTION DETECTION, add ARGUMENT MUST CONTAIN \"ggplot2::\" OR \"lemon::\" IN FRONT OF EACH GGPLOT2 FUNCTION: ", paste(unique(add), collapse = " "))
+ # Inf removal
+ if(any(( ! is.finite(data1[, y])) & ( ! is.na(data1[, y])))){ # is.finite also detects NA: ( ! is.finite(data1[, y])) & ( ! is.na(data1[, y])) detects only Inf # normally no NA with is.finite
+ removed.row.nb <- which(( ! is.finite(data1[, y])) & ( ! is.na(data1[, y])))
+ removed.rows <- data1.ini[removed.row.nb, ] # here data1.ini used to have the y = O rows that will be removed because of Inf creation after log transformation
+ data1 <- data1[-removed.row.nb, ] #
+ data1.ini <- data1.ini[-removed.row.nb, ] #
+ }else{
+ removed.row.nb <- NULL
+ removed.rows <- data.frame(stringsAsFactors = FALSE)
+ }
+ # From here, data1 and data.ini have no more Inf
+ # end Inf removal
+ if(y.log != "no" & ! is.null(y.lim)){
+ if(any(y.lim <= 0)){ # any() without na.rm -> ok because y.lim cannot be NA (tested above)
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ny.lim ARGUMENT CANNOT HAVE ZERO OR NEGATIVE VALUES WITH THE y.log ARGUMENT SET TO ", y.log, ":\n", paste(y.lim, collapse = " "))
stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else if( ! grepl(pattern = ")\\s*$", add)){ # check that the add string finished by )
- tempo.cat <- paste0("ERROR IN ", function.name, "\nadd ARGUMENT MUST FINISH BY \")\": ", paste(unique(add), collapse = " "))
+ }else if(any( ! is.finite(if(y.log == "log10"){log10(y.lim)}else{log2(y.lim)}))){ # normally no NA with is.finite
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ny.lim ARGUMENT RETURNS INF/NA WITH THE y.log ARGUMENT SET TO ", y.log, "\nAS SCALE COMPUTATION IS ", ifelse(y.log == "log10", "log10", "log2"), ":\n", paste(if(y.log == "log10"){log10(y.lim)}else{log2(y.lim)}, collapse = " "))
stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
}
- # end verif of add
- # management of add containing facet
- facet.categ <- NULL
- if( ! is.null(add)){
- facet.check <- TRUE
- tempo <- unlist(strsplit(x = add, split = "\\s*\\+\\s*(ggplot2|lemon)\\s*::\\s*")) #
- tempo <- sub(x = tempo, pattern = "^facet_wrap", replacement = "ggplot2::facet_wrap")
- tempo <- sub(x = tempo, pattern = "^facet_grid", replacement = "ggplot2::facet_grid")
- tempo <- sub(x = tempo, pattern = "^facet_rep", replacement = "lemon::facet_rep")
- if(any(grepl(x = tempo, pattern = "ggplot2::facet_wrap|lemon::facet_rep_wrap"), na.rm = TRUE)){
- tempo1 <- suppressWarnings(eval(parse(text = tempo[grepl(x = tempo, pattern = "ggplot2::facet_wrap|lemon::facet_rep_wrap")])))
- facet.categ <- names(tempo1$params$facets)
- tempo.text <- "facet_wrap OR facet_rep_wrap"
- facet.check <- FALSE
- }else if(grepl(x = add, pattern = "ggplot2::facet_grid|lemon::facet_rep_grid")){
- tempo1 <- suppressWarnings(eval(parse(text = tempo[grepl(x = tempo, pattern = "ggplot2::facet_grid|lemon::facet_rep_grid")])))
- facet.categ <- c(names(tempo1$params$rows), names(tempo1$params$cols))
- tempo.text <- "facet_grid OR facet_rep_grid"
- facet.check <- FALSE
+ if(y.log != "no" & y.include.zero == TRUE){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") y.log ARGUMENT SET TO ", y.log, " AND y.include.zero ARGUMENT SET TO TRUE -> y.include.zero ARGUMENT RESET TO FALSE BECAUSE 0 VALUE CANNOT BE REPRESENTED IN LOG SCALE")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ y.include.zero <- FALSE
+ }
+ if(y.log != "no" & vertical == FALSE){
+ vertical <- TRUE
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") BECAUSE OF A BUG IN ggplot2, CANNOT FLIP BOXES HORIZONTALLY WITH A Y.LOG SCALE -> vertical ARGUMENT RESET TO TRUE")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ # end management of log scale and Inf removal
+ # na detection and removal (done now to be sure of the correct length of categ)
+ column.check <- unique(c(y, categ, if( ! is.null(dot.color) & ! is.null(dot.categ)){dot.categ}, if( ! is.null(facet.categ)){facet.categ})) # dot.categ because can be a 3rd column of data1, categ.color and dot.color will be tested later
+ if(any(is.na(data1[, column.check]))){ # data1 used here instead of data1.ini in case of new NaN created by log conversion (neg values) # normally no NA with is.na
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") NA DETECTED IN COLUMNS OF data1 AND CORRESPONDING ROWS REMOVED (SEE $removed.row.nb AND $removed.rows)")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ for(i2 in 1:length(column.check)){
+ if(any(is.na(data1[, column.check[i2]]))){ # normally no NA with is.na
+ tempo.warn <- paste0("NA REMOVAL DUE TO COLUMN ", column.check[i2], " OF data1")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n", tempo.warn)))
+ }
}
- if(facet.check == FALSE & ! all(facet.categ %in% names(data1))){ # WARNING: all(facet.categ %in% names(data1)) is TRUE when facet.categ is NULL # all() without na.rm -> ok because facet.categ cannot be NA (tested above)
- tempo.cat <- paste0("ERROR IN ", function.name, "\nDETECTION OF \"", tempo.text, "\" STRING IN THE add ARGUMENT BUT PROBLEM OF VARIABLE DETECTION (COLUMN NAMES OF data1)\nTHE DETECTED VARIABLES ARE:\n", paste(facet.categ, collapse = " "), "\nTHE data1 COLUMN NAMES ARE:\n", paste(names(data1), collapse = " "), "\nPLEASE REWRITE THE add STRING AND RERUN")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ tempo <- unique(unlist(lapply(lapply(c(data1[column.check]), FUN = is.na), FUN = which)))
+ removed.row.nb <- c(removed.row.nb, tempo) # removed.row.nb created to remove Inf
+ removed.rows <- rbind(removed.rows, data1.ini[tempo, ], stringsAsFactors = FALSE) # here data1.ini used to have the non NA rows that will be removed because of NAN creation after log transformation (neg values for instance)
+ column.check <- column.check[ ! column.check == y] # remove y to keep quali columns
+ if(length(tempo) != 0){
+ data1 <- data1[-tempo, ] # WARNING tempo here and not removed.row.nb because the latter contain more numbers thant the former
+ data1.ini <- data1.ini[-tempo, ] # WARNING tempo here and not removed.row.nb because the latter contain more numbers than the former
+ for(i3 in 1:length(column.check)){
+ if(any( ! unique(removed.rows[, column.check[i3]]) %in% unique(data1[, column.check[i3]]), na.rm = TRUE)){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") IN COLUMN ", column.check[i3], " OF data1, THE FOLLOWING CLASSES HAVE DISAPPEARED AFTER NA/Inf REMOVAL (IF COLUMN USED IN THE PLOT, THIS CLASS WILL NOT BE DISPLAYED):\n", paste(unique(removed.rows[, column.check[i3]])[ ! unique(removed.rows[, column.check[i3]]) %in% unique(data1[, column.check[i3]])], collapse = " "))
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ }
+ }
+ count.categ <- 0
+ for(i2 in 1:length(column.check)){
+ if(column.check[i2] %in% categ){
+ count.categ <- count.categ + 1
+ }
+ if(column.check[i2] == categ[count.categ]){
+ categ.class.order[count.categ] <- list(levels(data1[, column.check[i2]])[levels(data1[, column.check[i2]]) %in% unique(data1[, column.check[i2]])]) # remove the absent color in the character vector
+ data1[, column.check[i2]] <- factor(as.character(data1[, column.check[i2]]), levels = unique(categ.class.order[[count.categ]]))
+ }
+ if( ! is.null(dot.color) & ! is.null(dot.categ)){ # reminder : dot.categ cannot be a column name of categ anymore (because in that case dot.categ name is changed into "..._DOT"
+ if(column.check[i2] == dot.categ){
+ dot.categ.class.order <- levels(data1[, column.check[i2]])[levels(data1[, column.check[i2]]) %in% unique(data1[, column.check[i2]])] # remove the absent color in the character vector
+ data1[, column.check[i2]] <- factor(as.character(data1[, column.check[i2]]), levels = unique(dot.categ.class.order))
+ }
+ }
+ if(column.check[i2] %in% facet.categ){ # works if facet.categ == NULL this method should keep the order of levels when removing some levels
+ tempo.levels <- levels(data1[, column.check[i2]])[levels(data1[, column.check[i2]]) %in% unique(as.character(data1[, column.check[i2]]))]
+ data1[, column.check[i2]] <- factor(as.character(data1[, column.check[i2]]), levels = tempo.levels)
+ }
}
}
- # end management of add containing facet
- # end reserved word checking
- # end second round of checking and data preparation
+ # end na detection and removal (done now to be sure of the correct length of categ)
+ # From here, data1 and data.ini have no more NA or NaN in y, categ, dot.categ (if dot.color != NULL) and facet.categ
- # package checking
- fun_pack(req.package = c(
- "gridExtra",
- "ggplot2",
- "lemon",
- "grid",
- "ggrepel"
- ), lib.path = lib.path)
- # end package checking
- # main code
- data1 <- data.frame(data1, prop = data1[ , freq] / sum(data1[ , freq]))
- if(legend.add.prop == TRUE){
- data1[ , categ] <- paste0(data1[ , categ], " (", round(data1$prop, 2), ")")
- }
- data1[ , categ] <- factor(data1[ , categ], levels = data1[ , categ][order(data1$prop, decreasing = TRUE)]) # reorder so that the donut is according to decreasing proportion starting at the top in a clockwise direction
- data1 <- data1[order(as.numeric(data1[ , categ]), decreasing = FALSE), ] # data1[ , categ] with rows in decreasing order, according to prop
- data1 <- data.frame(data1, x = 0) # staked bar at the origin of the donut set to x = 0
- tempo.gg.name <- "gg.indiv.plot."
- tempo.gg.count <- 0
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), eval(parse(text = paste0("ggplot2::ggplot()", if(is.null(add)){""}else{add})))) # add added here to have the facets
- bar_width = 1
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_col(
- data = data1,
- mapping = ggplot2::aes_string(x = "x", y = freq, fill = categ),
- color = border.color,
- size = border.size,
- width = bar_width
- )) # size is size of the separation in the donut
- # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_text(
- # ggplot2::aes(label = Freq),
- # position = ggplot2::position_stack(vjust = 0.5)
- # ))
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_x_continuous(
- expand = c(0, 0), # prevent extra limits in x axis
- limits = c(- bar_width / 2 - (bar_width * hole.size) / (1 - hole.size), max(bar_width / 2, annotation.distance))
- )) # must be centered on x = 0
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::ylim(c(0, max(cumsum(data1[ , freq])))))
- if(hole.text == TRUE){
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(
- geom = "text",
- x = - bar_width / 2 - (bar_width * hole.size) / (1 - hole.size),
- y = 0,
- label = sum(data1[ , freq]),
- size = hole.text.size
- ))
- }
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::coord_polar(theta = "y", direction = -1, start = 0, clip = "on"))
- if(is.null(fill.color) & ! is.null(fill.palette)){
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_fill_brewer(palette = fill.palette, name = legend.name))
- }else if( ! is.null(fill.color)){
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_fill_manual(values = fill.color, name = legend.name, na.value = "white"))
- }else if(! is.null(legend.name)){
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::labs(fill = legend.name))
- }
- if( ! is.null(add)){ # if add is NULL, then = 0
- if(grepl(pattern = "ggplot2\\s*::\\s*theme", add) == TRUE){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") \"ggplot2::theme\" STRING DETECTED IN THE add ARGUMENT\n-> INTERNAL GGPLOT2 THEME FUNCTIONS theme_void() HAS BEEN INACTIVATED, SO THAT THE USER THEME CAN BE EFFECTIVE")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- add.check <- FALSE
+ if( ! is.null(categ.class.order)){
+ if(length(categ.class.order) != length(categ)){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg.class.order ARGUMENT MUST BE A LIST OF LENGTH EQUAL TO LENGTH OF categ\nHERE IT IS LENGTH: ", length(categ.class.order), " VERSUS ", length(categ))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}else{
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::theme_void())
+ for(i3 in 1:length(categ.class.order)){
+ if(is.null(categ.class.order[[i3]])){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") THE categ.class.order COMPARTMENT ", i3, " IS NULL. ALPHABETICAL ORDER WILL BE APPLIED")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ data1[, categ[i3]] <- factor(as.character(data1[, categ[i3]])) # if already a factor, change nothing, if characters, levels according to alphabetical order
+ categ.class.order[[i3]] <- levels(data1[, categ[i3]]) # character vector that will be used later
+ }else{
+ tempo <- fun_check(data = categ.class.order[[i3]], data.name = paste0("COMPARTMENT ", i3 , " OF categ.class.order ARGUMENT"), class = "vector", mode = "character", length = length(levels(data1[, categ[i3]])), fun.name = function.name) # length(data1[, categ[i1]) -> if data1[, categ[i1] was initially character vector, then conversion as factor after the NA removal, thus class number ok. If data1[, categ[i1] was initially factor, no modification after the NA removal, thus class number ok
+ if(tempo$problem == TRUE){
+ stop(paste0("\n\n================\n\n", tempo$text, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ }
+ if(any(duplicated(categ.class.order[[i3]]), na.rm = TRUE)){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nCOMPARTMENT ", i3, " OF categ.class.order ARGUMENT CANNOT HAVE DUPLICATED CLASSES: ", paste(categ.class.order[[i3]], collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else if( ! (all(categ.class.order[[i3]] %in% unique(data1[, categ[i3]]), na.rm = TRUE) & all(unique(data1[, categ[i3]]) %in% categ.class.order[[i3]], na.rm = TRUE))){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nCOMPARTMENT ", i3, " OF categ.class.order ARGUMENT MUST BE CLASSES OF ELEMENT ", i3, " OF categ ARGUMENT\nHERE IT IS:\n", paste(categ.class.order[[i3]], collapse = " "), "\nFOR COMPARTMENT ", i3, " OF categ.class.order AND IT IS:\n", paste(unique(data1[, categ[i3]]), collapse = " "), "\nFOR COLUMN ", categ[i3], " OF data1")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else{
+ data1[, categ[i3]] <- factor(data1[, categ[i3]], levels = categ.class.order[[i3]]) # reorder the factor
+
+ }
+ names(categ.class.order)[i3] <- categ[i3]
+ }
}
}else{
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::theme_void())
- }
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::guides(
- fill = ggplot2::guide_legend(override.aes = list(color = "white", size = 2, stroke = 1))
- )) # remove border of squares in legend
-
- # annotations on slices
- if( ! is.null(annotation)){
- tempo <- rev(cumsum(rev(data1[ , freq])))
- data1 <- data.frame(data1, text_y = tempo - (tempo - c(tempo[-1], 0)) / 2)
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggrepel::geom_text_repel(
- data = data1,
- mapping = ggplot2::aes_string(
- x = "x",
- y = "text_y",
- label = annotation
- ),
- size = annotation.size,
- force = annotation.force,
- force_pull = annotation.force.pull,
- nudge_x = annotation.distance, # knowing that the bar is centered on x = 0 and that the right edge is at bar_width / 2, 0 means center of the slice, 0.5 means at the edge if bar_width = 1
- show.legend = FALSE
- ))
- }
- # end annotations on slices
-
- # legend management
- # removal of part of the legend
- if( ! is.null(legend.limit)){
- if(sum(data1$prop >= legend.limit) == 0){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE legend.limit PARAMETER VALUE (", legend.limit, ") IS TOO HIGH FOR THE PROPORTIONS IN THE DONUT PLOT:\n", paste0(data1$prop, collapse = "\n"))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
- }else{
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_fill_discrete(
- breaks = as.character(data1[ , categ][data1$prop >= legend.limit])
- ))
+ categ.class.order <- vector("list", length = length(categ))
+ tempo.categ.class.order <- NULL
+ for(i2 in 1:length(categ.class.order)){
+ categ.class.order[[i2]] <- levels(data1[, categ[i2]])
+ names(categ.class.order)[i2] <- categ[i2]
+ tempo.categ.class.order <- c(tempo.categ.class.order, ifelse(i2 != 1, "\n", ""), categ.class.order[[i2]])
}
- }
- # end removal of part of the legend
- if(legend.show == FALSE){ # must be here because must be before bef.final.plot
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::guides(fill = "none")) # inactivate the initial legend
- }
- bef.final.plot <- suppressWarnings(suppressMessages(ggplot2::ggplot_build(eval(parse(text = paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "))))))
- if( ! is.null(legend.width)){
- legend.final <- suppressWarnings(suppressMessages(fun_gg_get_legend(ggplot_built = bef.final.plot, fun.name = function.name, lib.path = lib.path))) # get legend
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::guides(fill = "none")) # inactivate the initial legend
- if(is.null(legend.final) & plot == TRUE){ # even if any(unlist(legend.disp)) is TRUE
- legend.final <- ggplot2::ggplot()+ggplot2::theme_void() # empty graph instead of legend
+ if(box.alpha != 0){
warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") LEGEND REQUESTED (legend.show ARGUMENT SET TO TRUE)\nBUT IT SEEMS THAT THE PLOT HAS NO LEGEND -> EMPTY LEGEND SPACE CREATED BECAUSE OF THE NON NULL legend.width ARGUMENT\n")
+ tempo.warn <- paste0("(", warn.count,") THE categ.class.order SETTING IS NULL. ALPHABETICAL ORDER WILL BE APPLIED FOR BOX ORDERING:\n", paste(tempo.categ.class.order, collapse = " "))
warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
}
}
- # end legend management
-
- # drawing
- final.plot <- eval(parse(text = paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + ")))
-
- # title
- if(title != ""){
- title.grob <- grid::textGrob(
- label = title,
- x = grid::unit(0, "lines"),
- y = grid::unit(0, "lines"),
- hjust = 0,
- vjust = 0,
- gp = grid::gpar(fontsize = title.text.size)
- )
- pdf(NULL)
- final.plot <- suppressMessages(suppressWarnings(gridExtra::arrangeGrob(final.plot, top = title.grob, left = " ", right = " "))) # , left = " ", right = " " : trick to add margins in the plot. padding = unit(0.5, "inch") is for top margin above the title
- dev.off()
+ # categ.class.order not NULL anymore (list)
+ if(is.null(box.legend.name) & box.alpha != 0){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") THE box.legend.name SETTING IS NULL. NAMES OF categ WILL BE USED: ", paste(categ, collapse = " "))
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ box.legend.name <- categ[length(categ)] # if only categ1, then legend name of categ1, if length(categ) == 2L, then legend name of categ2
}
- # end title
-
- grob.save <- NULL
- if(plot == TRUE){
- if( ! is.null(legend.width)){
- grob.save <- suppressMessages(suppressWarnings(gridExtra::grid.arrange(final.plot, legend.final, ncol=2, widths=c(1, legend.width))))
+ # box.legend.name not NULL anymore (character string)
+ # management of categ.color
+ if( ! is.null(categ.color)){
+ # check the nature of color
+ # integer colors into gg_palette
+ tempo.check.color <- fun_check(data = categ.color, class = "integer", double.as.integer.allowed = TRUE, na.contain = TRUE, fun.name = function.name)$problem
+ if(tempo.check.color == FALSE){
+ # convert integers into colors
+ categ.color <- fun_gg_palette(max(categ.color, na.rm = TRUE))[categ.color]
+ }
+ # end integer colors into gg_palette
+ if( ! (all(categ.color %in% colors() | grepl(pattern = "^#", categ.color)))){ # check that all strings of low.color start by #, # all() without na.rm -> ok because categ.color cannot be NA (tested above)
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg.color ARGUMENT MUST BE A HEXADECIMAL COLOR VECTOR STARTING BY # AND/OR COLOR NAMES GIVEN BY colors() OR A COLUMN NAME OF THE data1 PARAMETER: ", paste(unique(categ.color), collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ if(any(is.na(categ.color)) & box.alpha != 0){ # normally no NA with is.na
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") categ.color ARGUMENT CONTAINS NA")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ # end check the nature of color
+ # check the length of color
+ categ.len <- length(categ) # if only categ1, then colors for classes of categ1, if length(categ) == 2L, then colors for classes of categ2
+ if(length(data1[, categ[categ.len]]) == length(levels(data1[, categ[categ.len]])) & length(categ.color) == length(data1[, categ[categ.len]])){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") THE NUMBER OF CLASSES OF THE COLUMN ", categ[categ.len], " THE NUMBER OF ROWS OF THIS COLUMN AND THE NUMBER OF COLORS OF THE categ.color ARGUMENT ARE ALL EQUAL. BOX COLORS WILL BE ATTRIBUTED ACCORDING THE LEVELS OF ", categ[categ.len], ", NOT ACCORDING TO THE ROWS OF ", categ[categ.len])
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ if(length(categ.color) == length(levels(data1[, categ[categ.len]]))){ # here length(categ.color) is equal to the different number of categ
+ # data1[, categ[categ.len]] <- factor(data1[, categ[categ.len]]) # not required because sure that is is a factor
+ data1 <- data.frame(data1, categ.color = data1[, categ[categ.len]], stringsAsFactors = TRUE) # no need stringsAsFactors here for stat.nolog as factors remain factors
+ data1$categ.color <- factor(data1$categ.color, labels = categ.color) # replace the characters of data1[, categ[categ.len]] put in the categ.color column by the categ.color (can be write like this because categ.color is length of levels of data1[, categ[categ.len]])
+ if(box.alpha != 0){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") IN ", categ[categ.len], " OF categ ARGUMENT, THE FOLLOWING COLORS:\n", paste(categ.color, collapse = " "), "\nHAVE BEEN ATTRIBUTED TO THESE CLASSES:\n", paste(levels(factor(data1[, categ[categ.len]])), collapse = " "))
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ }else if(length(categ.color) == length(data1[, categ[categ.len]])){# here length(categ.color) is equal to nrow(data1) -> Modif to have length(categ.color) equal to the different number of categ (length(categ.color) == length(levels(data1[, categ[categ.len]])))
+ data1 <- data.frame(data1, categ.color = categ.color, stringsAsFactors = TRUE)
+ tempo.check <- unique(data1[ , c(categ[categ.len], "categ.color")])
+ if( ! (nrow(tempo.check) == length(unique(categ.color)) & nrow(tempo.check) == length(unique(data1[ , categ[categ.len]])))){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg.color ARGUMENT HAS THE LENGTH OF data1 ROW NUMBER\nBUT IS INCORRECTLY ASSOCIATED TO EACH CLASS OF categ ", categ[categ.len], ":\n", paste(unique(mapply(FUN = "paste", data1[ ,categ[categ.len]], data1[ ,"categ.color"])), collapse = "\n"))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else{
+ # data1[, categ[categ.len]] <- factor(data1[, categ[categ.len]]) # not required because sure that is is a factor
+ categ.color <- unique(data1$categ.color[order(data1[, categ[categ.len]])]) # Modif to have length(categ.color) equal to the different number of categ (length(categ.color) == length(levels(data1[, categ[categ.len]])))
+ if(box.alpha != 0){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") categ.color ARGUMENT HAS THE LENGTH OF data1 ROW NUMBER\nCOLORS HAVE BEEN RESPECTIVELY ASSOCIATED TO EACH CLASS OF categ ", categ[categ.len], " AS:\n", paste(levels(factor(data1[, categ[categ.len]])), collapse = " "), "\n", paste(categ.color, collapse = " "))
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ }
+ }else if(length(categ.color) == 1L){
+ # data1[, categ[categ.len]] <- factor(data1[, categ[categ.len]]) # not required because sure that is is a factor
+ data1 <- data.frame(data1, categ.color = categ.color, stringsAsFactors = TRUE)
+ categ.color <- rep(categ.color, length(levels(data1[, categ[categ.len]])))
+ if(box.alpha != 0){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") categ.color ARGUMENT HAS LENGTH 1, MEANING THAT ALL THE DIFFERENT CLASSES OF ", categ[categ.len], "\n", paste(levels(factor(data1[, categ[categ.len]])), collapse = " "), "\nWILL HAVE THE SAME COLOR\n", paste(categ.color, collapse = " "))
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
}else{
- grob.save <- suppressMessages(suppressWarnings(print(final.plot)))
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg.color ARGUMENT MUST BE (1) LENGTH 1, OR (2) THE LENGTH OF data1 NROWS AFTER NA/Inf REMOVAL, OR (3) THE LENGTH OF THE CLASSES IN THE categ ", categ[categ.len], " COLUMN. HERE IT IS COLOR LENGTH ", length(categ.color), " VERSUS CATEG LENGTH ", length(data1[, categ[categ.len]]), " AND CATEG CLASS LENGTH ", length(unique(data1[, categ[categ.len]])), "\nPRESENCE OF NA/Inf COULD BE THE PROBLEM")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
}else{
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") PLOT NOT SHOWN AS REQUESTED")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- # end drawing
-
-
-
- # output
- if(warn.print == TRUE & ! is.null(warn)){
- on.exit(warning(paste0("FROM ", function.name, ":\n\n", warn), call. = FALSE))
- }
- on.exit(exp = options(warning.length = ini.warning.length), add = TRUE)
- if(return == TRUE){
- output <- suppressMessages(ggplot2::ggplot_build(final.plot))
- if(is.null(unlist(removed.row.nb))){
- removed.row.nb <- NULL
- removed.rows <- NULL
+ categ.len <- length(categ) # if only categ1, then colors for classes of categ1, if length(categ) == 2L, then colors for classes of categ2
+ # data1[, categ[categ.len]] <- factor(data1[, categ[categ.len]]) # not required because sure that is is a factor
+ categ.color <- fun_gg_palette(length(levels(data1[, categ[categ.len]])))
+ data1 <- data.frame(data1, categ.color = data1[, categ[categ.len]], stringsAsFactors = TRUE)
+ data1$categ.color <- factor(data1$categ.color, labels = categ.color) # replace the characters of data1[, categ[categ.len]] put in the categ.color column by the categ.color (can be write like this because categ.color is length of levels of data1[, categ[categ.len]])
+ if(box.alpha != 0){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") NULL categ.color ARGUMENT -> COLORS RESPECTIVELY ATTRIBUTED TO EACH CLASS OF ", categ[categ.len], " IN data1:\n", paste(categ.color, collapse = " "), "\n", paste(levels(data1[, categ[categ.len]]), collapse = " "))
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
}
- tempo <- output$layout$panel_params[[1]]
- output <- list(
- data = data1,
- removed.row.nb = removed.row.nb,
- removed.rows = removed.rows,
- plot = output$data,
- panel = facet.categ,
- axes = list(
- x.range = tempo$x.range,
- x.labels = if(is.null(attributes(tempo$x$breaks))){tempo$x$breaks}else{tempo$x$scale$get_labels()}, # is.null(attributes(tempo$x$breaks)) test if it is number (TRUE) or character (FALSE)
- x.positions = if(is.null(attributes(tempo$x$breaks))){tempo$x$breaks}else{unlist(attributes(tempo$x$breaks))},
- y.range = tempo$y.range,
- y.labels = if(is.null(attributes(tempo$y$breaks))){tempo$y$breaks}else{tempo$y$scale$get_labels()},
- y.positions = if(is.null(attributes(tempo$y$breaks))){tempo$y$breaks}else{unlist(attributes(tempo$y$breaks))}
- ),
- warn = paste0("\n", warn, "\n\n"),
- ggplot = if(return.ggplot == TRUE){final.plot}else{NULL}, # final.plot plots the graph if return == TRUE
- gtable = if(return.gtable == TRUE){grob.save}else{NULL} #
- )
- return(output) # this plots the graph if return.ggplot is TRUE and if no assignment
}
- # end output
- # end main code
-}
-
-
-
-# Error: class order not good when a class is removed due to NA
-# Error: line 136 in check 20201126 with add argument
-# Solve this: sometimes error messages can be more than the max display (8170). Thus, check every paste0("ERROR IN ", function.name, and trunck the message if to big. In addition, add at the begining of the warning message that it is too long and see the $warn output for complete message. Add also this into fun_scatter
-# add dot.shape ? See with available aesthetic layers
-# rasterise: https://cran.r-project.org/web/packages/ggrastr/vignettes/Raster_geoms.html
-# add horizontal argument and deal any conflict with vertical argument. Start with horizontal = NULL as default. If ! is.null() -> convert vertical if required
-# time for excecution : microbenchmark package. See also in RStudio time per line of code. See also https://stackoverflow.com/questions/7561362/what-can-cause-a-program-to-run-much-faster-the-second-time
-
-
-fun_gg_boxplot <- function(
- data1,
- y,
- categ,
- categ.class.order = NULL,
- categ.color = NULL,
- box.legend.name = NULL,
- box.fill = FALSE,
- box.width = 0.5,
- box.space = 0.1,
- box.line.size = 0.75,
- box.notch = FALSE,
- box.alpha = 1,
- box.mean = TRUE,
- box.whisker.kind = "std",
- box.whisker.width = 0,
- dot.color = grey(0.25),
- dot.categ = NULL,
- dot.categ.class.order = NULL,
- dot.legend.name = NULL,
- dot.tidy = FALSE,
- dot.tidy.bin.nb = 50,
- dot.jitter = 0.5,
- dot.seed = 2,
- dot.size = 3,
- dot.alpha = 0.5,
- dot.border.size = 0.5,
- dot.border.color = NULL,
- x.lab = NULL,
- x.angle = 0,
- y.lab = NULL,
- y.lim = NULL,
- y.log = "no",
- y.tick.nb = NULL,
- y.second.tick.nb = 1,
- y.include.zero = FALSE,
- y.top.extra.margin = 0.05,
- y.bottom.extra.margin = 0.05,
- stat.pos = "top",
- stat.mean = FALSE,
- stat.size = 4,
- stat.dist = 5,
- stat.angle = 0,
- vertical = TRUE,
- text.size = 12,
- title = "",
- title.text.size = 8,
- legend.show = TRUE,
- legend.width = 0.5,
- article = TRUE,
- grid = FALSE,
- add = NULL,
- return = FALSE,
- return.ggplot = FALSE,
- return.gtable = TRUE,
- plot = TRUE,
- warn.print = FALSE,
- lib.path = NULL
-){
- # AIM
- # Plot ggplot2 boxplots + dots + means
- # For ggplot2 specifications, see: https://ggplot2.tidyverse.org/articles/ggplot2-specs.html
- # WARNINGS
- # Rows containing NA in data1[, c(y, categ)] will be removed before processing, with a warning (see below)
- # Hinges are not computed like in the classical boxplot() function of R. See https://ggplot2.tidyverse.org/reference/geom_boxplot.html
- # To have a single box, please create a factor column with a single class and specify the name of this column in the categ argument. For a single set of grouped boxes, create a factor column with a single class and specify this column in categ argument as first element (i.e., as categ1, knowing that categ2 must also be specified in this situation). See categ argument below
- # The dot.alpha argument can alter the display of the color boxes when using pdf output
- # Size arguments (box.line.size, dot.size, dot.border.size, stat.size, text.size and title.text.size) are in mm. See Hadley comment in https://stackoverflow.com/questions/17311917/ggplot2-the-unit-of-size. See also http://sape.inf.usi.ch/quick-reference/ggplot2/size). Unit object are not accepted, but conversion can be used (e.g., grid::convertUnit(grid::unit(0.2, "inches"), "mm", valueOnly = TRUE))
- # Display seems to be done twice on Windows devices (like a blink). However, no double plots on pdf devices. Thus, the blink remains mysterious
- # To remove boxes and have only dots, use box.alpha = 0
- # ARGUMENTS
- # data1: data frame containing one column of quantitative values (see the y argument below) and one or two columns of categories (see the categ argument below). Duplicated column names are not allowed
- # y: character string of the data1 column name for y-axis (column containing numeric values). Numeric values will be split according to the classes of the column names indicated in the categ argument to generate the boxes and will also be used to plot the dots
- # categ: vector of character strings of the data1 column name for categories (column of characters or factors). Must be either one or two column names. If a single column name (further referred to as categ1), then one box per class of categ1. If two column names (further referred to as categ1 and categ2), then one box per class of categ2, which form a group of boxes in each class of categ1. WARNING: no empty classes allowed. To have a single box, create a factor column with a single class and specify the name of this column in the categ argument (here, no categ2 in categ argument). For a single set of grouped boxes, create a factor column with a single class and specify this column in categ argument as first element (i.e., as categ1), in addition to the already used category (as categ2 in this situation)
- # categ.class.order: list indicating the order of the classes of categ1 and categ2 represented on the boxplot (the first compartment for categ1 and and the second for categ2). If categ.class.order == NULL, classes are represented according to the alphabetical order. Some compartments can be NULL and others not. See the categ argument for categ1 and categ2 description
- # categ.color: vector of color character string for box frames (see the categ argument for categ1 and categ2 description)
- # If categ.color == NULL, default colors of ggplot2, whatever categ1 and categ2
- # If categ.color is non-null and only categ1 in categ argument, categ.color can be either:
- # (1) a single color string. All the boxes will have this color, whatever the number of classes of categ1
- # (2) a vector of string colors, one for each class of categ1. Each color will be associated according to categ.class.order of categ1
- # (3) a vector or factor of string colors, like if it was one of the column of data1 data frame. WARNING: a single color per class of categ1 and a single class of categ1 per color must be respected
- # Color functions, like grey(), hsv(), etc., are also accepted
- # Positive integers are also accepted instead of character strings, as long as above rules about length are respected. Integers will be processed by fun_gg_palette() using the maximal integer value among all the integers in categ.color (see fun_gg_palette())
- # If categ.color is non-null and categ1 and categ2 are specified, all the rules described above will apply to categ2 instead of categ1 (colors will be determined for boxes inside a group of boxes)
- # box.legend.name: character string of the legend title. If box.legend.name is NULL, then box.legend.name <- categ1 if only categ1 is present, and box.legend.name <- categ2 if categ1 and categ2 are present in the categ argument. Write "" if no legend required. See the categ argument for categ1 and categ2 description
- # box.fill: logical. Fill the box? If TRUE, the categ.color argument will be used to generate filled boxplots (the box frames being black) as well as filled outlier dots (the dot border being controlled by the dot.border.color argument). If all the dots are plotted (argument dot.color other than NULL), they will be over the boxes. If FALSE, the categ.color argument will be used to color the box frames and the outlier dot borders. If all the dots are plotted, they will be beneath the boxes
- # box.width: single numeric value (from 0 to 1) of width of either boxes or group of boxes
- # When categ argument has a single categ1 element (i.e., separate boxes. See the categ argument for categ1 and categ2 description), then each class of categ1 is represented by a single box. In that case, box.width argument defines each box width, from 0 (no box width) to 1 (max box width), but also the space between boxes (the code uses 1 - box.width for the box spaces). Of note, xmin and xmax of the fun_gg_boxplot() output report the box boundaries (around x-axis unit 1, 2, 3, etc., for each box)
- # When categ argument has a two categ1 and categ2 elements (i.e., grouped boxes), box.width argument defines the width allocated for each set of grouped boxes, from 0 (no group width) to 1 (max group width), but also the space between grouped boxes (the code uses 1 - box.width for the spaces). Of note, xmin and xmax of the fun_gg_boxplot() output report the box boundaries (around x-axis unit 1, 2, 3, etc., for each set of grouped box)
- # box.space: single numeric value (from 0 to 1) indicating the box separation inside grouped boxes, when categ argument has a two categ1 and categ2 elements. 0 means no space and 1 means boxes shrunk to a vertical line. Ignored if categ argument has a single categ1 element
- # box.line.size: single numeric value of line width of boxes and whiskers in mm
- # box.notch: logical. Notched boxplot? It TRUE, display notched boxplot, notches corresponding approximately to the 95% confidence interval of the median (the notch interval is exactly 1.58 x Inter Quartile Range (IQR) / sqrt(n), with n the number of values that made the box). If notch intervals between two boxes do not overlap, it can be interpreted as significant median differences
- # box.alpha: single numeric value (from 0 to 1) of box transparency (full transparent to full opaque, respectively). To remove boxplots, use box.alpha = 0
- # box.mean: logical. Add mean value? If TRUE, a diamond-shaped dot, with the horizontal diagonal corresponding to the mean value, is displayed over each boxplot
- # box.whisker.kind: range of the whiskers. Either "no" (no whiskers), or "std" (length of each whisker equal to 1.5 x Inter Quartile Range (IQR)), or "max" (length of the whiskers up or down to the most distant dot)
- # box.whisker.width: single numeric value (from 0 to 1) of the whisker width, with 0 meaning no whiskers and 1 meaning a width equal to the box width
- # dot.color: vector of color character string ruling the dot colors and the dot display. See the example section below for easier understanding of the rules described here
- # If NULL, no dots plotted
- # If "same", the dots will have the same colors as the respective boxplots
- # Otherwise, as in the rule (1), (2) or (3) described in the categ.color argument, except that in the possibility (3), the rule "a single color per class of categ and a single class of categ per color", does not have to be respected (for instance, each dot can have a different color). Colors will also depend on the dot.categ argument. If dot.categ is NULL, then colors will be applied to each class of the last column name specified in categ. If dot.categ is non-NULL, colors will be applied to each class of the column name specified in dot.categ. See examples
- # dot.categ: optional single character string of a column name (further referred to as categ3) of the data1 argument. This column of data1 will be used to generate a legend for dots, in addition to the legend for boxes. See the dot.color argument for details about the way the legend is built using the two dot.categ and dot.color arguments. If NULL, no legend created and the colors of dots will depend on dot.color and categ arguments (as explained in the dot.color argument)
- # dot.categ.class.order: optional vector of character strings indicating the order of the classes of categ3 (see the dot.categ argument). If dot.categ is non-NULL and dot.categ.class.order is NULL, classes are displayed in the legend according to the alphabetical order. Ignored if dot.categ is NULL
- # dot.legend.name: optional character string of the legend title for categ3 (see the dot.categ argument). If dot.legend.name == NULL, dot.categ value is used (name of the column in data1). Write "" if no legend required. Ignored if dot.categ is NULL
- # dot.tidy: logical. Nice dot spreading? If TRUE, use the geom_dotplot() function for a nice representation. WARNING: change the true quantitative coordinates of dots (i.e., y-axis values for vertical display) because of binning. Thus, the gain in aestheticism is associated with a loss in precision that can be very important. If FALSE, dots are randomly spread on the qualitative axis, using the dot.jitter argument (see below) keeping the true quantitative coordinates
- # dot.tidy.bin.nb: positive integer indicating the number of bins (i.e., nb of separations) of the y.lim range. Each dot will then be put in one of the bin, with a diameter of the width of the bin. In other words, increase the number of bins to have smaller dots. Not considered if dot.tidy is FALSE
- # dot.jitter: numeric value (from 0 to 1) of random dot horizontal dispersion (for vertical display), with 0 meaning no dispersion and 1 meaning dispersion in the corresponding box width interval. Not considered if dot.tidy is TRUE
- # dot.seed: integer value that set the random seed. Using the same number will generate the same dot jittering. Write NULL to have different jittering each time the same instruction is run. Ignored if dot.tidy is TRUE
- # dot.size: numeric value of dot diameter in mm. Not considered if dot.tidy is TRUE
- # dot.alpha: numeric value (from 0 to 1) of dot transparency (full transparent to full opaque, respectively)
- # dot.border.size: numeric value of border dot width in mm. Write zero for no dot border. If dot.tidy is TRUE, value 0 remove the border and other values leave the border without size control (geom_doplot() feature)
- # dot.border.color: single character color string defining the color of the dot border (same color for all the dots, whatever their categories). If dot.border.color == NULL, the border color will be the same as the dot color. A single integer is also accepted instead of a character string, that will be processed by fun_gg_palette()
- # x.lab: a character string or expression for x-axis legend. If NULL, character string of categ1 (see the categ argument for categ1 and categ2 description)
- # x.angle: integer value of the text angle for the x-axis numbers, using the same rules as in ggplot2. Positive values for counterclockwise rotation: 0 for horizontal, 90 for vertical, 180 for upside down etc. Negative values for clockwise rotation: 0 for horizontal, -90 for vertical, -180 for upside down etc.
- # y.lab: a character string or expression for y-axis legend. If NULL, character string of the y argument
- # y.lim: 2 numeric values indicating the range of the y-axis. Order matters (for inverted axis). If NULL, the range of the x column name of data1 will be used.
- # y.log: either "no", "log2" (values in the y argument column of the data1 data frame will be log2 transformed and y-axis will be log2 scaled) or "log10" (values in the y argument column of the data1 data frame will be log10 transformed and y-axis will be log10 scaled). WARNING: not possible to have horizontal boxes with a log axis, due to a bug in ggplot2 (see https://github.com/tidyverse/ggplot2/issues/881)
- # y.tick.nb: approximate number of desired values labeling the y-axis (i.e., main ticks, see the n argument of the the cute::fun_scale() function). If NULL and if y.log is "no", then the number of labeling values is set by ggplot2. If NULL and if y.log is "log2" or "log10", then the number of labeling values corresponds to all the exposant integers in the y.lim range (e.g., 10^1, 10^2 and 10^3, meaning 3 main ticks for y.lim = c(9, 1200)). WARNING: if non-NULL and if y.log is "log2" or "log10", labeling can be difficult to read (e.g., ..., 10^2, 10^2.5, 10^3, ...)
- # y.second.tick.nb: number of desired secondary ticks between main ticks. Ignored if y.log is other than "no" (log scale plotted). Use argument return = TRUE and see $plot$y.second.tick.values to have the values associated to secondary ticks. IF NULL, no secondary ticks
- # y.include.zero: logical. Does y.lim range include 0? Ignored if y.log is "log2" or "log10"
- # y.top.extra.margin: single proportion (between 0 and 1) indicating if extra margins must be added to y.lim. If different from 0, add the range of the axis multiplied by y.top.extra.margin (e.g., abs(y.lim[2] - y.lim[1]) * y.top.extra.margin) to the top of y-axis
- # y.bottom.extra.margin: idem as y.top.extra.margin but to the bottom of y-axis
- # stat.pos: add the median number above the corresponding box. Either NULL (no number shown), "top" (at the top of the plot region) or "above" (above each box)
- # stat.mean: logical. Display mean numbers instead of median numbers? Ignored if stat.pos is NULL
- # stat.size: numeric value of the stat font size in mm. Ignored if stat.pos is NULL
- # stat.dist: numeric value of the stat distance in percentage of the y-axis range (stat.dist = 5 means move the number displayed at 5% of the y-axis range). Ignored if stat.pos is NULL or "top"
- # stat.angle: integer value of the angle of stat, using the same rules as in ggplot2. Positive values for counterclockwise rotation: 0 for horizontal, 90 for vertical, 180 for upside down etc. Negative values for clockwise rotation: 0 for horizontal, -90 for vertical, -180 for upside down etc.
- # vertical: logical. Vertical boxes? WARNING: will be automatically set to TRUE if y.log argument is other than "no". Indeed, not possible to have horizontal boxes with a log axis, due to a bug in ggplot2 (see https://github.com/tidyverse/ggplot2/issues/881)
- # text.size: numeric value of the font size of the (1) axis numbers, (2) axis labels and (3) texts in the graphic legend (in mm)
- # title: character string of the graph title
- # title.text.size: numeric value of the title font size in mm
- # legend.show: logical. Show legend? Not considered if categ argument is NULL, because this already generate no legend, excepted if legend.width argument is non-NULL. In that specific case (categ is NULL, legend.show is TRUE and legend.width is non-NULL), an empty legend space is created. This can be useful when desiring graphs of exactly the same width, whatever they have legends or not
- # legend.width: single proportion (between 0 and 1) indicating the relative width of the legend sector (on the right of the plot) relative to the width of the plot. Value 1 means that the window device width is split in 2, half for the plot and half for the legend. Value 0 means no room for the legend, which will overlay the plot region. Write NULL to inactivate the legend sector. In such case, ggplot2 will manage the room required for the legend display, meaning that the width of the plotting region can vary between graphs, depending on the text in the legend
- # article: logical. If TRUE, use an article theme (article like). If FALSE, use a classic related ggplot theme. Use the add argument (e.g., add = "+ggplot2::theme_classic()" for the exact classic ggplot theme
- # grid: logical. Draw lines in the background to better read the box values? Not considered if article == FALSE (grid systematically present)
- # add: character string allowing to add more ggplot2 features (dots, lines, themes, facet, etc.). Ignored if NULL
- # WARNING: (1) the string must start with "+", (2) the string must finish with ")" and (3) each function must be preceded by "ggplot2::". Example: "+ ggplot2::coord_flip() + ggplot2::theme_bw()"
- # If the character string contains the "ggplot2::theme" string, then the article argument of fun_gg_boxplot() (see above) is ignored with a warning. In addition, some arguments can be overwritten, like x.angle (check all the arguments)
- # Handle the add argument with caution since added functions can create conflicts with the preexisting internal ggplot2 functions
- # WARNING: the call of objects inside the quotes of add can lead to an error if the name of these objects are some of the fun_gg_boxplot() arguments. Indeed, the function will use the internal argument instead of the global environment object. Example article <- "a" in the working environment and add = '+ ggplot2::ggtitle(article)'. The risk here is to have TRUE as title. To solve this, use add = '+ ggplot2::ggtitle(get("article", envir = .GlobalEnv))'
- # return: logical. Return the graph parameters?
- # return.ggplot: logical. Return the ggplot object in the output list? Ignored if return argument is FALSE. WARNING: always assign the fun_gg_boxplot() function (e.g., a <- fun_gg_boxplot()) if return.ggplot argument is TRUE, otherwise, double plotting is performed. See $ggplot in the RETURN section below for more details
- # return.gtable: logical. Return the ggplot object as gtable of grobs in the output list? Ignored if plot argument is FALSE. Indeed, the graph must be plotted to get the grobs dispositions. See $gtable in the RETURN section below for more details
- # plot: logical. Plot the graphic? If FALSE and return argument is TRUE, graphical parameters and associated warnings are provided without plotting
- # warn.print: logical. Print warnings at the end of the execution? ? If FALSE, warning messages are never printed, but can still be recovered in the returned list. Some of the warning messages (those delivered by the internal ggplot2 functions) are not apparent when using the argument plot = FALSE
- # lib.path: character string indicating the absolute path of the required packages (see below). if NULL, the function will use the R library default folders
- # RETURN
- # A boxplot if plot argument is TRUE
- # A list of the graph info if return argument is TRUE:
- # $data: the initial data with graphic information added
- # $stat: the graphic statistics (mostly equivalent to ggplot_build()$data[[2]])
- # $removed.row.nb: which rows have been removed due to NA/Inf detection in y and categ columns (NULL if no row removed)
- # $removed.rows: removed rows (NULL if no row removed)
- # $plot: the graphic box and dot coordinates
- # $dots: dot coordinates
- # $main.box: coordinates of boxes
- # $median: median coordinates
- # $sup.whisker: coordinates of top whiskers (y for base and y.end for extremities)
- # $inf.whisker: coordinates of bottom whiskers (y for base and y.end for extremities)
- # $sup.whisker.edge: coordinates of top whisker edges (x and xend)
- # $inf.whisker.edge: coordinates of bottom whisker edges(x and xend)
- # $mean: diamond mean coordinates (only if box.mean argument is TRUE)
- # $stat.pos: coordinates of stat numbers (only if stat.pos argument is not NULL)
- # y.second.tick.positions: coordinates of secondary ticks (only if y.second.tick.nb argument is non-NULL or if y.log argument is different from "no")
- # y.second.tick.values: values of secondary ticks. NULL except if y.second.tick.nb argument is non-NULL or if y.log argument is different from "no")
- # $panel: the variable names used for the panels (NULL if no panels). WARNING: NA can be present according to ggplot2 upgrade to v3.3.0
- # $axes: the x-axis and y-axis info
- # $warn: the warning messages. Use cat() for proper display. NULL if no warning. WARNING: warning messages delivered by the internal ggplot2 functions are not apparent when using the argument plot = FALSE
- # $ggplot: ggplot object that can be used for reprint (use print(...$ggplot) or update (use ...$ggplot + ggplot2::...). NULL if return.ggplot argument is FALSE. Of note, a non-NULL $ggplot in the output list is sometimes annoying as the manipulation of this list prints the plot
- # $gtable: gtable object that can be used for reprint (use gridExtra::grid.arrange(...$ggplot) or with additionnal grobs (see the grob decomposition in the examples). NULL if return.ggplot argument is FALSE. Contrary to $ggplot, a non-NULL $gtable in the output list is not annoying as the manipulation of this list does not print the plot
- # REQUIRED PACKAGES
- # ggplot2
- # gridExtra
- # lemon (in case of use in the add argument)
- # scales
- # REQUIRED FUNCTIONS FROM THE cute PACKAGE
- # fun_check()
- # fun_comp_1d()
- # fun_comp_2d()
- # fun_gg_just()
- # fun_gg_palette()
- # fun_inter_ticks()
- # fun_name_change()
- # fun_pack()
- # fun_round()
- # fun_scale()
- # EXAMPLE
- # set.seed(1) ; obs1 <- data.frame(Time = c(rnorm(20, 100, 10), rnorm(20, 200, 50), rnorm(20, 500, 60), rnorm(20, 100, 50)), Categ1 = rep(c("CAT", "DOG"), times = 40), Categ2 = rep(c("A", "B", "C", "D"), each = 20), Color1 = rep(c("coral", "lightblue"), times = 40), Color2 = rep(c("#9F2108", "#306100", "#007479", "#8500C0"), each = 20), stringsAsFactors = TRUE) ; set.seed(NULL) ; fun_gg_boxplot(data1 = obs1, y = "Time", categ = "Categ1")
- # see http
- # DEBUGGING
- # set.seed(1) ; obs1 <- data.frame(Time = c(rnorm(10), rnorm(10) + 2), Categ1 = rep(c("G", "H"), each = 10), stringsAsFactors = TRUE) ; set.seed(NULL) ; obs1$Time[1:10] <- NA ; data1 = obs1 ; y = "Time" ; categ = c("Categ1") ; categ.class.order = NULL ; categ.color = NULL ; box.legend.name = NULL ; box.fill = FALSE ; box.width = 0.5 ; box.space = 0.1 ; box.line.size = 0.75 ; box.notch = FALSE ; box.alpha = 1 ; box.mean = TRUE ; box.whisker.kind = "std" ; box.whisker.width = 0 ; dot.color = grey(0.25) ; dot.categ = NULL ; dot.categ.class.order = NULL ; dot.legend.name = NULL ; dot.tidy = FALSE ; dot.tidy.bin.nb = 50 ; dot.jitter = 0.5 ; dot.seed = 2 ; dot.size = 3 ; dot.alpha = 0.5 ; dot.border.size = 0.5 ; dot.border.color = NULL ; x.lab = NULL ; x.angle = 0 ; y.lab = NULL ; y.lim = NULL ; y.log = "no" ; y.tick.nb = NULL ; y.second.tick.nb = 1 ; y.include.zero = FALSE ; y.top.extra.margin = 0.05 ; y.bottom.extra.margin = 0.05 ; stat.pos = "top" ; stat.mean = FALSE ; stat.size = 4 ; stat.dist = 5 ; stat.angle = 0 ; vertical = TRUE ; text.size = 12 ; title = "" ; title.text.size = 8 ; legend.show = TRUE ; legend.width = 0.5 ; article = TRUE ; grid = FALSE ; add = NULL ; return = FALSE ; return.ggplot = FALSE ; return.gtable = TRUE ; plot = TRUE ; warn.print = FALSE ; lib.path = NULL
- # function name
- function.name <- paste0(as.list(match.call(expand.dots = FALSE))[[1]], "()")
- arg.names <- names(formals(fun = sys.function(sys.parent(n = 2)))) # names of all the arguments
- arg.user.setting <- as.list(match.call(expand.dots = FALSE))[-1] # list of the argument settings (excluding default values not provided by the user)
- # end function name
- # required function checking
- req.function <- c(
- "fun_comp_2d",
- "fun_gg_just",
- "fun_gg_palette",
- "fun_name_change",
- "fun_pack",
- "fun_check",
- "fun_round",
- "fun_scale",
- "fun_inter_ticks"
- )
- tempo <- NULL
- for(i1 in req.function){
- if(length(find(i1, mode = "function")) == 0L){
- tempo <- c(tempo, i1)
- }
- }
- if( ! is.null(tempo)){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nREQUIRED cute FUNCTION", ifelse(length(tempo) > 1, "S ARE", " IS"), " MISSING IN THE R ENVIRONMENT:\n", paste0(tempo, collapse = "()\n"))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- # end required function checking
- # reserved words to avoid bugs (names of dataframe columns used in this function)
- reserved.words <- c("categ.check", "categ.color", "dot.color", "dot.categ", "dot.max", "dot.min", "group", "PANEL", "group.check", "MEAN", "tempo.categ1", "tempo.categ2", "text.max.pos", "text.min.pos", "x", "x.y", "y", "y.check", "y_from.dot.max", "ymax", "tidy_group", "binwidth")
- # end reserved words to avoid bugs (used in this function)
- # arg with no default values
- mandat.args <- c(
- "data1",
- "y",
- "categ"
- )
- tempo <- eval(parse(text = paste0("missing(", paste0(mandat.args, collapse = ") | missing("), ")")))
- if(any(tempo)){ # normally no NA for missing() output
- tempo.cat <- paste0("ERROR IN ", function.name, "\nFOLLOWING ARGUMENT", ifelse(length(mandat.args) > 1, "S HAVE", "HAS"), " NO DEFAULT VALUE AND REQUIRE ONE:\n", paste0(mandat.args, collapse = "\n"))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- # end arg with no default values
- # argument primary checking
- arg.check <- NULL #
- text.check <- NULL #
- checked.arg.names <- NULL # for function debbuging: used by r_debugging_tools
- ee <- expression(arg.check <- c(arg.check, tempo$problem) , text.check <- c(text.check, tempo$text) , checked.arg.names <- c(checked.arg.names, tempo$object.name))
- tempo <- fun_check(data = data1, class = "data.frame", na.contain = TRUE, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = y, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = categ, class = "vector", mode = "character", fun.name = function.name) ; eval(ee)
- if( ! is.null(categ.class.order)){
- tempo <- fun_check(data = categ.class.order, class = "list", fun.name = function.name) ; eval(ee)
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = categ.class.order, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- if( ! is.null(box.legend.name)){
- tempo <- fun_check(data = box.legend.name, class = "vector", mode = "character", fun.name = function.name) ; eval(ee)
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = box.legend.name, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- if( ! is.null(categ.color)){
- tempo1 <- fun_check(data = categ.color, class = "vector", mode = "character", na.contain = TRUE, fun.name = function.name)
- tempo2 <- fun_check(data = categ.color, class = "factor", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.check.color <- fun_check(data = categ.color, class = "integer", double.as.integer.allowed = TRUE, na.contain = TRUE, neg.values = FALSE, fun.name = function.name)$problem
- if(tempo.check.color == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg.color ARGUMENT MUST BE A FACTOR OR CHARACTER VECTOR OR POSITVE INTEGER VECTOR") # integer possible because dealt above
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }else if(any(categ.color == 0L, na.rm = TRUE)){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg.color ARGUMENT MUST BE A FACTOR OR CHARACTER VECTOR OR POSITVE INTEGER VECTOR") # integer possible because dealt above
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- }
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = categ.color, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- tempo <- fun_check(data = box.fill, class = "vector", mode = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = box.width, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = box.space, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = box.line.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = box.notch, class = "vector", mode = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = box.alpha, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = box.mean, class = "vector", mode = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = box.whisker.kind, options = c("no", "std", "max"), length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = box.whisker.width, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ # categ.color not NULL anymore
+ categ.color <- as.character(categ.color)
+ # categ.color is a character string representing the diff classes
+ data1$categ.color <- factor(data1$categ.color, levels = unique(categ.color)) # ok because if categ.color is a character string, the order make class 1, class 2, etc. unique() because no duplicates allowed
+ # data1$categ.color is a factor with order of levels -> categ.color
+ # end management of categ.color
+ # management of dot.color
if( ! is.null(dot.color)){
- tempo1 <- fun_check(data = dot.color, class = "vector", mode = "character", na.contain = TRUE, fun.name = function.name)
- tempo2 <- fun_check(data = dot.color, class = "factor", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.check.color <- fun_check(data = dot.color, class = "integer", double.as.integer.allowed = TRUE, na.contain = TRUE, neg.values = FALSE, fun.name = function.name)$problem
- if(tempo.check.color == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.color MUST BE A FACTOR OR CHARACTER VECTOR OR POSITVE INTEGER VECTOR") # integer possible because dealt above
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }else if(any(dot.color == 0L, na.rm = TRUE)){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.color ARGUMENT MUST BE A FACTOR OR CHARACTER VECTOR OR POSITVE INTEGER VECTOR") # integer possible because dealt above
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
+ # optional legend of dot colors
+ if( ! is.null(dot.categ)){
+ ini.dot.categ <- dot.categ
+ if( ! dot.categ %in% names(data1)){ # no need to use all() because length(dot.categ) = 1
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.categ ARGUMENT MUST BE A COLUMN NAME OF data1. HERE IT IS:\n", dot.categ)
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else if(dot.categ %in% categ){ # no need to use all() because length(dot.categ) = 1. Do not use dot.categ %in% categ[length(categ)] -> error
+ # management of dot legend if dot.categ %in% categ (because legends with the same name are joined in ggplot2)
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") THE COLUMN NAME OF data1 INDICATED IN THE dot.categ ARGUMENT (", dot.categ, ") HAS BEEN REPLACED BY ", paste0(dot.categ, "_DOT"), " TO AVOID MERGED LEGEND BY GGPLOT2")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ data1 <- data.frame(data1, dot.categ = data1[, dot.categ], stringsAsFactors = TRUE) # dot.categ is not a column name of data1 (checked above with reserved words)
+ dot.categ <- paste0(dot.categ, "_DOT")
+ names(data1)[names(data1) == "dot.categ"] <- dot.categ # paste0(dot.categ, "_DOT") is not a column name of data1 (checked above with reserved words)
+ # tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.categ ARGUMENT CANNOT BE A COLUMN NAME OF data1 ALREADY SPECIFIED IN THE categ ARGUMENT:\n", dot.categ, "\nINDEED, dot.categ ARGUMENT IS MADE TO HAVE MULTIPLE DOT COLORS NOT RELATED TO THE BOXPLOT CATEGORIES")
+ # stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
}
- }
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = dot.color, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- if( ! is.null(dot.categ)){
- tempo <- fun_check(data = dot.categ, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = dot.categ, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- if( ! is.null(dot.categ.class.order)){
- tempo <- fun_check(data = dot.categ.class.order, class = "vector", mode = "character", fun.name = function.name) ; eval(ee)
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = dot.categ.class.order, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ tempo1 <- fun_check(data = data1[, dot.categ], data.name = paste0(dot.categ, " COLUMN OF data1"), class = "vector", mode = "character", na.contain = TRUE, fun.name = function.name)
+ tempo2 <- fun_check(data = data1[, dot.categ], data.name = paste0(dot.categ, " COLUMN OF data1"), class = "factor", na.contain = TRUE, fun.name = function.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.categ COLUMN MUST BE A FACTOR OR CHARACTER VECTOR") #
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ data1[, dot.categ] <- factor(data1[, dot.categ]) # if already a factor, change nothing, if characters, levels according to alphabetical order
+ # dot.categ column of data1 is factor from here
+ if( ! is.null(dot.categ.class.order)){
+ if(any(duplicated(dot.categ.class.order), na.rm = TRUE)){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.categ.class.order ARGUMENT CANNOT HAVE DUPLICATED CLASSES: ", paste(dot.categ.class.order, collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else if( ! (all(dot.categ.class.order %in% levels(data1[, dot.categ])) & all(levels(data1[, dot.categ]) %in% dot.categ.class.order, na.rm = TRUE))){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.categ.class.order ARGUMENT MUST BE CLASSES OF dot.categ ARGUMENT\nHERE IT IS:\n", paste(dot.categ.class.order, collapse = " "), "\nFOR dot.categ.class.order AND IT IS:\n", paste(levels(data1[, dot.categ]), collapse = " "), "\nFOR dot.categ COLUMN (", ini.dot.categ, ") OF data1")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else{
+ data1[, dot.categ] <- factor(data1[, dot.categ], levels = dot.categ.class.order) # reorder the factor
+ }
+ }else{
+ if(all(dot.color == "same") & length(dot.color)== 1L){ # all() without na.rm -> ok because dot.color cannot be NA (tested above)
+ dot.categ.class.order <- unlist(categ.class.order[length(categ)])
+ data1[, dot.categ] <- factor(data1[, dot.categ], levels = dot.categ.class.order) # reorder the factor
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") THE dot.categ.class.order SETTING IS NULL AND dot.color IS \"same\". ORDER OF categ.class.order WILL BE APPLIED FOR LEGEND DISPLAY: ", paste(dot.categ.class.order, collapse = " "))
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }else{
+ dot.categ.class.order <- sort(levels(data1[, dot.categ]))
+ data1[, dot.categ] <- factor(data1[, dot.categ], levels = dot.categ.class.order) # reorder the factor
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") THE dot.categ.class.order SETTING IS NULL. ALPHABETICAL ORDER WILL BE APPLIED FOR LEGEND DISPLAY: ", paste(dot.categ.class.order, collapse = " "))
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ }
+ # dot.categ.class.order not NULL anymore (character string) if dot.categ is not NULL
+ if(all(dot.color == "same") & length(dot.color)== 1L){ # all() without na.rm -> ok because dot.color cannot be NA (tested above)
+ if( ! identical(ini.dot.categ, categ[length(categ)])){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nWHEN dot.color ARGUMENT IS \"same\", THE COLUMN NAME IN dot.categ ARGUMENT MUST BE IDENTICAL TO THE LAST COLUMN NAME IN categ ARGUMENT. HERE IT IS:\ndot.categ: ", paste(ini.dot.categ, collapse = " "), "\ncateg: ", paste(categ, collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else if( ! fun_comp_1d(unlist(categ.class.order[length(categ)]), dot.categ.class.order)$identical.content){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nWHEN dot.color ARGUMENT IS \"same\",\nLAST COMPARTMENT OF categ.class.order ARGUMENT AND dot.categ.class.order ARGUMENT CANNOT BE DIFFERENT:\nLAST COMPARTMENT OF categ.class.order: ", paste(unlist(categ.class.order[length(categ)]), collapse = " "), "\ndot.categ.class.order: ", paste(dot.categ.class.order, collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ }
+ for(i3 in 1:length(categ)){
+ if(identical(categ[i3], ini.dot.categ) & ! identical(unlist(categ.class.order[i3]), dot.categ.class.order) & identical(sort(unlist(categ.class.order[i3])), sort(dot.categ.class.order))){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") THE dot.categ ARGUMENT SETTING IS PRESENT IN THE categ ARGUMENT SETTING, BUT ORDER OF THE CLASSES IS NOT THE SAME:\ncateg.class.order: ", paste(unlist(categ.class.order[i3]), collapse = " "), "\ndot.categ.class.order: ", paste(dot.categ.class.order, collapse = " "), "\nNOTE THAT ORDER OF categ.class.order IS THE ONE USED FOR THE AXIS REPRESENTATION")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ }
+ if(is.null(dot.legend.name)){
+ dot.legend.name <- if(ini.dot.categ %in% categ[length(categ)]){dot.categ}else{ini.dot.categ} #
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") THE dot.legend.name SETTING IS NULL -> ", dot.legend.name, " WILL BE USED AS LEGEND TITLE OF DOTS")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ # dot.legend.name not NULL anymore (character string)
+ }else{
+ if( ! is.null(dot.categ.class.order)){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") THE dot.categ.class.order ARGUMENT IS NOT NULL, BUT IS THE dot.categ ARGUMENT\n-> dot.categ.class.order NOT CONSIDERED AS NO LEGEND WILL BE DRAWN")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ # But dot.categ.class.order will be converted to NULL below (not now)
+ }
+ # end optional legend of dot colors
+ # check the nature of color
+ # integer colors into gg_palette
+ tempo.check.color <- fun_check(data = dot.color, class = "integer", double.as.integer.allowed = TRUE, na.contain = TRUE, fun.name = function.name)$problem
+ if(tempo.check.color == FALSE){
+ # convert integers into colors
+ dot.color <- fun_gg_palette(max(dot.color, na.rm = TRUE))[dot.color]
+ }
+ # end integer colors into gg_palette
+ if(all(dot.color == "same") & length(dot.color)== 1L){# all() without na.rm -> ok because dot.color cannot be NA (tested above)
+ dot.color <- categ.color # same color of the dots as the corresponding box color
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") dot.color ARGUMENT HAS BEEN SET TO \"same\"\nTHUS, DOTS WILL HAVE THE SAME COLORS AS THE CORRESPONDING BOXPLOT")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }else if( ! (all(dot.color %in% colors() | grepl(pattern = "^#", dot.color)))){ # check that all strings of low.color start by #, # all() without na.rm -> ok because dot.color cannot be NA (tested above)
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.color ARGUMENT MUST BE (1) A HEXADECIMAL COLOR VECTOR STARTING BY #, OR (2) COLOR NAMES GIVEN BY colors(), OR (3) INTEGERS, OR THE STRING \"same\"\nHERE IT IS: ", paste(unique(dot.color), collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ if(any(is.na(dot.color))){ # normally no NA with is.finite
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") dot.color ARGUMENT CONTAINS NA")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ # end check the nature of color
+ # check the length of color
+ if( ! is.null(dot.categ)){
+ # optional legend of dot colors
+ if(length(data1[, dot.categ]) == length(levels(data1[, dot.categ])) & length(dot.color) == length(data1[, dot.categ])){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") THE NUMBER OF CLASSES OF THE COLUMN ", dot.categ, " THE NUMBER OF ROWS OF THIS COLUMN AND THE NUMBER OF COLORS OF THE dot.color ARGUMENT ARE ALL EQUAL. DOT COLORS WILL BE ATTRIBUTED ACCORDING THE LEVELS OF ", dot.categ, ", NOT ACCORDING TO THE ROWS OF ", dot.categ)
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ if(length(dot.color) > 1 & ! (length(dot.color) == length(unique(data1[, dot.categ])) | length(dot.color) == length(data1[, dot.categ]))){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nWHEN LENGTH OF THE dot.color ARGUMENT IS MORE THAN 1, IT MUST BE EQUAL TO THE NUMBER OF 1) ROWS OR 2) LEVELS OF dot.categ COLUMN (", dot.categ, "):\ndot.color: ", paste(dot.color, collapse = " "), "\ndot.categ LEVELS: ", paste(levels(data1[, dot.categ]), collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else if(length(dot.color) > 1 & length(dot.color) == length(unique(data1[, dot.categ]))){
+ data1 <- data.frame(data1, dot.color = data1[, dot.categ], stringsAsFactors = TRUE)
+ data1$dot.color <- factor(data1$dot.color, labels = dot.color) # do not use labels = unique(dot.color). Otherwise, we can have green1 green2 when dot.color is c("green", "green")
+ }else if(length(dot.color) > 1 & length(dot.color) == length(data1[, dot.categ])){
+ data1 <- data.frame(data1, dot.color = dot.color, stringsAsFactors = TRUE)
+ }else if(length(dot.color)== 1L){ # to deal with single color. Warning: & length(dot.categ.class.order) > 1 removed because otherwise, the data1 is not with dot.color column when length(dot.categ.class.order) == 1
+ data1 <- data.frame(data1, dot.color = dot.color, stringsAsFactors = TRUE)
+ }
+ dot.color <- as.character(unique(data1$dot.color[order(data1[, dot.categ])])) # reorder the dot.color character vector
+ if(length(dot.color)== 1L & length(dot.categ.class.order) > 1){ # to deal with single color
+ dot.color <- rep(dot.color, length(dot.categ.class.order))
+ }
+ tempo.check <- unique(data1[ , c(dot.categ, "dot.color")])
+ if(length(unique(data1[ , "dot.color"])) > 1 & ( ! (nrow(tempo.check) == length(unique(data1[ , "dot.color"])) & nrow(tempo.check) == length(unique(data1[ , dot.categ]))))){ # length(unique(data1[ , "dot.color"])) > 1 because if only one color, can be attributed to each class of dot.categ
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.color ARGUMENT IS INCORRECTLY ASSOCIATED TO EACH CLASS OF dot.categ (", dot.categ, ") COLUMN:\n", paste(unique(mapply(FUN = "paste", data1[ , dot.categ], data1[ ,"dot.color"])), collapse = "\n"))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else{
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") IN dot.categ ARGUMENT (", ini.dot.categ, "), THE FOLLOWING COLORS OF DOTS:\n", paste(dot.color, collapse = " "), "\nHAVE BEEN ATTRIBUTED TO THESE CLASSES:\n", paste(levels(data1[, dot.categ]), collapse = " "))
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ # dot.color is a character string representing the diff classes of dot.categ
+ # data1$dot.color is a factor with order of levels -> dot.categ
+ # end optional legend of dot colors
+ }else{
+ categ.len <- length(categ) # if only categ1, then colors for classes of categ1, if length(categ) == 2L, then colors for classes of categ2
+ if(length(dot.color) == length(levels(data1[, categ[categ.len]]))){ # here length(dot.color) is equal to the different number of categ
+ # data1[, categ[categ.len]] <- factor(data1[, categ[categ.len]]) # not required because sure that is is a factor
+ data1 <- data.frame(data1, dot.color = data1[, categ[categ.len]], stringsAsFactors = TRUE)
+ data1$dot.color <- factor(data1$dot.color, labels = dot.color)
+ if(box.alpha != 0){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") IN ", categ[categ.len], " OF categ ARGUMENT, THE FOLLOWING COLORS:\n", paste(dot.color, collapse = " "), "\nHAVE BEEN ATTRIBUTED TO THESE CLASSES:\n", paste(levels(factor(data1[, categ[categ.len]])), collapse = " "))
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ }else if(length(dot.color) == length(data1[, categ[categ.len]])){# here length(dot.color) is equal to nrow(data1) -> Modif to have length(dot.color) equal to the different number of categ (length(dot.color) == length(levels(data1[, categ[categ.len]])))
+ data1 <- data.frame(data1, dot.color = dot.color, stringsAsFactors = TRUE)
+ }else if(length(dot.color)== 1L & ! all(dot.color == "same")){ # all() without na.rm -> ok because dot.color cannot be NA (tested above)
+ # data1[, categ[categ.len]] <- factor(data1[, categ[categ.len]]) # not required because sure that is is a factor
+ data1 <- data.frame(data1, dot.color = dot.color, stringsAsFactors = TRUE)
+ dot.color <- rep(dot.color, length(levels(data1[, categ[categ.len]])))
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") dot.color ARGUMENT HAS LENGTH 1, MEANING THAT ALL THE DIFFERENT CLASSES OF ", categ[categ.len], "\n", paste(levels(factor(data1[, categ[categ.len]])), collapse = " "), "\nWILL HAVE THE SAME COLOR\n", paste(dot.color, collapse = " "))
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }else{
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.color ARGUMENT MUST BE (1) LENGTH 1, OR (2) THE LENGTH OF data1 NROWS AFTER NA/Inf REMOVAL, OR (3) THE LENGTH OF THE CLASSES IN THE categ ", categ[categ.len], " COLUMN. HERE IT IS COLOR LENGTH ", length(dot.color), " VERSUS CATEG LENGTH ", length(data1[, categ[categ.len]]), " AND CATEG CLASS LENGTH ", length(unique(data1[, categ[categ.len]])), "\nPRESENCE OF NA/Inf COULD BE THE PROBLEM")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ # end check the length of color
+ dot.color <- as.character(dot.color)
+ # dot.color is a character string representing the diff classes
+ data1$dot.color <- factor(data1$dot.color, levels = unique(dot.color)) # ok because if dot.color is a character string, the order make class 1, class 2, etc. If dot.color is a column of data1, then levels will be created, without incidence, except if dot.categ specified (see below). unique() because no duplicates allowed
+ # data1$dot.color is a factor with order of levels -> dot.color
+ }
+ # end optional legend of dot colors
+ }else if(is.null(dot.color) & ! (is.null(dot.categ) & is.null(dot.categ.class.order) & is.null(dot.legend.name))){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") dot.categ OR dot.categ.class.order OR dot.legend.name ARGUMENT HAS BEEN SPECIFIED BUT dot.color ARGUMENT IS NULL (NO DOT PLOTTED)")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
}
- if( ! is.null(dot.legend.name)){
- tempo <- fun_check(data = dot.legend.name, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = dot.legend.name, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ # dot.color either NULL (no dot plotted) or character string (potentially representing the diff classes of dot.categ)
+ # data1$dot.color is either NA or a factor (with order of levels -> depending on dot.categ or categ[length(categ)], or other
+ if(is.null(dot.categ)){
+ dot.categ.class.order <- NULL # because not used anyway
}
- tempo <- fun_check(data = dot.tidy, class = "vector", mode = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = dot.tidy.bin.nb, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, neg.values = FALSE, fun.name = function.name) ; eval(ee)
- if(tempo$problem == FALSE){
- if(dot.tidy.bin.nb == 0L){ # length and NA checked above
- tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.tidy.bin.nb ARGUMENT MUST BE A NON-NULL AND POSITVE INTEGER VALUE") # integer possible because dealt above
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
+ # dot.categ.class.order either NULL if dot.categ is NULL (no legend displayed) or character string (potentially representing the diff classes of dot.categ)
+ # end management of dot.color
+ if(is.null(dot.color) & box.fill == FALSE & dot.alpha <= 0.025){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") THE FOLLOWING ARGUMENTS WERE SET AS:\ndot.color = NULL (NOT ALL DOTS BUT ONLY POTENTIAL OUTLIER DOTS DISPLAYED)\nbox.fill = FALSE (NO FILLING COLOR FOR BOTH BOXES AND POTENTIAL OUTLIER DOTS)\ndot.alpha = ", fun_round(dot.alpha, 4), "\n-> POTENTIAL OUTLIER DOTS MIGHT NOT BE VISIBLE BECAUSE ALMOST TRANSPARENT")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
}
- tempo <- fun_check(data = dot.jitter, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
- if( ! is.null(dot.seed)){
- tempo <- fun_check(data = dot.seed, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, neg.values = TRUE, fun.name = function.name) ; eval(ee)
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = dot.seed, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ if(is.null(dot.color) & box.fill == FALSE & dot.border.size == 0){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE FOLLOWING ARGUMENTS WERE SET AS:\ndot.color = NULL (NOT ALL DOTS BUT ONLY POTENTIAL OUTLIER DOTS DISPLAYED)\nbox.fill = FALSE (NO FILLING COLOR FOR BOTH BOXES AND POTENTIAL OUTLIER DOTS)\ndot.border.size = 0 (NO BORDER FOR POTENTIAL OUTLIER DOTS)\n-> THESE SETTINGS ARE NOT ALLOWED BECAUSE THE POTENTIAL OUTLIER DOTS WILL NOT BE VISIBLE")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
- tempo <- fun_check(data = dot.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = dot.alpha, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = dot.border.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
+ # integer dot.border.color into gg_palette
if( ! is.null(dot.border.color)){
- tempo1 <- fun_check(data = dot.border.color, class = "vector", mode = "character", length = 1, fun.name = function.name)
- tempo2 <- fun_check(data = dot.border.color, class = "vector", typeof = "integer", double.as.integer.allowed = TRUE, length = 1, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.border.color ARGUMENT MUST BE (1) A HEXADECIMAL COLOR STRING STARTING BY #, OR (2) A COLOR NAME GIVEN BY colors(), OR (3) AN INTEGER VALUE")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }else if(tempo1$problem == FALSE & tempo2$problem == TRUE){
- if( ! all(dot.border.color %in% colors() | grepl(pattern = "^#", dot.border.color), na.rm = TRUE)){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.border.color ARGUMENT MUST BE (1) A HEXADECIMAL COLOR STRING STARTING BY #, OR (2) A COLOR NAME GIVEN BY colors(), OR (3) AN INTEGER VALUE")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
+ tempo <- fun_check(data = dot.border.color, class = "vector", typeof = "integer", double.as.integer.allowed = TRUE, length = 1, fun.name = function.name)
+ if(tempo$problem == FALSE){ # convert integers into colors
+ dot.border.color <- fun_gg_palette(max(dot.border.color, na.rm = TRUE))[dot.border.color]
}
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = dot.border.color, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- if( ! is.null(x.lab)){
- tempo1 <- fun_check(data = x.lab, class = "expression", length = 1, fun.name = function.name)
- tempo2 <- fun_check(data = x.lab, class = "vector", mode = "character", length = 1, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nx.lab ARGUMENT MUST BE A SINGLE CHARACTER STRING OR EXPRESSION")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
+ # end integer dot.border.color into gg_palette
+ # na detection and removal (done now to be sure of the correct length of categ)
+ column.check <- c("categ.color", if( ! is.null(dot.color)){"dot.color"}) #
+ if(any(is.na(data1[, column.check]))){ # data1 used here instead of data1.ini in case of new NaN created by log conversion (neg values) # normally no NA with is.na
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") NA DETECTED IN COLUMNS ", paste(column.check, collapse = " "), " OF data1 AND CORRESPONDING ROWS REMOVED (SEE $removed.row.nb AND $removed.rows)")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ for(i2 in 1:length(column.check)){
+ if(any(is.na(data1[, column.check[i2]]))){ # normally no NA with is.na
+ tempo.warn <- paste0("NA REMOVAL DUE TO COLUMN ", column.check[i2], " OF data1")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n", tempo.warn)))
+ }
}
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = x.lab, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- tempo <- fun_check(data = x.angle, class = "vector", typeof = "integer", double.as.integer.allowed = TRUE, length = 1, neg.values = TRUE, fun.name = function.name) ; eval(ee)
- if( ! is.null(y.lab)){
- tempo1 <- fun_check(data = y.lab, class = "expression", length = 1, fun.name = function.name)
- tempo2 <- fun_check(data = y.lab, class = "vector", mode = "character", length = 1, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ny.lab ARGUMENT MUST BE A SINGLE CHARACTER STRING OR EXPRESSION")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = y.lab, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- if( ! is.null(y.lim)){
- tempo <- fun_check(data = y.lim, class = "vector", mode = "numeric", length = 2, fun.name = function.name) ; eval(ee)
- if(tempo$problem == FALSE){
- if(any(is.infinite(y.lim))){ # normally no NA for is.infinite() output
- tempo.cat <- paste0("ERROR IN ", function.name, "\ny.lim ARGUMENT CANNOT CONTAIN -Inf OR Inf VALUES")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
+ tempo <- unique(unlist(lapply(lapply(c(data1[column.check]), FUN = is.na), FUN = which)))
+ removed.row.nb <- c(removed.row.nb, tempo)
+ removed.rows <- rbind(removed.rows, data1[tempo, ], stringsAsFactors = FALSE) # here data1 used because categorical columns tested
+ if(length(tempo) != 0){
+ data1 <- data1[-tempo, ] # WARNING tempo here and not removed.row.nb because the latter contain more numbers thant the former
+ data1.ini <- data1.ini[-tempo, ] # WARNING tempo here and not removed.row.nb because the latter contain more numbers thant the former
+ for(i3 in 1:length(column.check)){
+ if(any( ! unique(removed.rows[, column.check[i3]]) %in% unique(data1[, column.check[i3]]), na.rm = TRUE)){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") IN COLUMN ", column.check[i3], " OF data1, THE FOLLOWING CLASSES HAVE DISAPPEARED AFTER NA/Inf REMOVAL (IF COLUMN USED IN THE PLOT, THIS CLASS WILL NOT BE DISPLAYED):\n", paste(unique(removed.rows[, column.check[i3]])[ ! unique(removed.rows[, column.check[i3]]) %in% unique(data1[, column.check[i3]])], collapse = " "))
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
}
}
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = y.lim, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- tempo <- fun_check(data = y.log, options = c("no", "log2", "log10"), length = 1, fun.name = function.name) ; eval(ee)
- if( ! is.null(y.tick.nb)){
- tempo <- fun_check(data = y.tick.nb, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, fun.name = function.name) ; eval(ee)
- if(tempo$problem == FALSE){
- if(y.tick.nb < 0){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ny.tick.nb ARGUMENT MUST BE A NON NULL POSITIVE INTEGER")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
+ for(i2 in 1:length(column.check)){
+ if(column.check[i2] == "categ.color"){
+ categ.color <- levels(data1[, column.check[i2]])[levels(data1[, column.check[i2]]) %in% unique(data1[, column.check[i2]])] # remove the absent color in the character vector
+ if(length(categ.color)== 1L & length(unlist(categ.class.order[length(categ)])) > 1){ # to deal with single color
+ categ.color <- rep(categ.color, length(unlist(categ.class.order[length(categ)])))
+ }
+ data1[, column.check[i2]] <- factor(as.character(data1[, column.check[i2]]), levels = unique(categ.color))
}
- }
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = y.tick.nb, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- if( ! is.null(y.second.tick.nb)){
- tempo <- fun_check(data = y.second.tick.nb, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, fun.name = function.name) ; eval(ee)
- if(tempo$problem == FALSE){
- if(y.second.tick.nb <= 0){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ny.second.tick.nb ARGUMENT MUST BE A NON NULL POSITIVE INTEGER")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
+ if(column.check[i2] == "dot.color"){
+ dot.color <- levels(data1[, column.check[i2]])[levels(data1[, column.check[i2]]) %in% unique(data1[, column.check[i2]])] # remove the absent color in the character vector
+ if(length(dot.color)== 1L & length(dot.categ.class.order) > 1){ # to deal with single color. If dot.categ.class.order == NULL (which is systematically the case if dot.categ == NULL), no rep(dot.color, length(dot.categ.class.order)
+ dot.color <- rep(dot.color, length(dot.categ.class.order))
+ }
+ data1[, column.check[i2]] <- factor(as.character(data1[, column.check[i2]]), levels = unique(dot.color))
}
}
+ }
+ # end na detection and removal (done now to be sure of the correct length of categ)
+ # From here, data1 and data.ini have no more NA or NaN
+ # end other checkings
+ # reserved word checking
+ #already done above
+ # end reserved word checking
+ # end second round of checking and data preparation
+
+
+ # package checking
+ fun_pack(req.package = c(
+ "ggplot2",
+ "gridExtra",
+ "lemon",
+ "scales"
+ ), lib.path = lib.path)
+ # end package checking
+
+
+
+
+
+ # main code
+ # y coordinates recovery (create ini.box.coord, dot.coord and modify data1)
+ if(length(categ)== 1L){
+ # width commputations
+ box.width2 <- box.width
+ box.space <- 0 # to inactivate the shrink that add space between grouped boxes, because no grouped boxes here
+ # end width commputations
+ # data1 check categ order for dots coordinates recovery
+ data1 <- data.frame(data1, categ.check = data1[, categ[1]], stringsAsFactors = TRUE)
+ data1$categ.check <- as.integer(data1$categ.check) # to check that data1[, categ[1]] and dot.coord$group are similar, during merging
+ # end data1 check categ order for dots coordinates recovery
+ # per box dots coordinates recovery
+ tempo.gg.name <- "gg.indiv.plot."
+ tempo.gg.count <- 0
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), eval(parse(text = paste0("ggplot2::ggplot()", if(is.null(add)){""}else{add})))) # add added here to have the facets
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_point(data = data1, mapping = ggplot2::aes_string(x = categ[1], y = y, color = categ[1]), stroke = dot.border.size, size = dot.size, alpha = dot.alpha, shape = 21))
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "color", name = box.legend.name, values = if(is.null(categ.color)){rep(NA, length(unique(data1[, categ[1]])))}else if(length(categ.color)== 1L){rep(categ.color, length(unique(data1[, categ[1]])))}else{categ.color})) # categ.color used for dot colors because at that stage, we do not care about colors
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_boxplot(data = data1, mapping = ggplot2::aes_string(x = categ[1], y = y, fill = categ[1]), coef = if(box.whisker.kind == "no"){0}else if(box.whisker.kind == "std"){1.5}else if(box.whisker.kind == "max"){Inf})) # fill because this is what is used with geom_box # to easily have the equivalent of the grouped boxes
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "fill", name = box.legend.name, values = if(length(categ.color)== 1L){rep(categ.color, length(unique(data1[, categ[1]])))}else{categ.color}))
+ # end per box dots coordinates recovery
+ }else if(length(categ) == 2L){
+ # width commputations
+ box.width2 <- box.width / length(unique(data1[, categ[length(categ)]])) # real width of each box in x-axis unit, among the set of grouped box. Not relevant if no grouped boxes length(categ)== 1L
+ # end width commputations
+ # data1 check categ order for dots coordinates recovery
+ tempo.factor <- paste0(data1[order(data1[, categ[2]], data1[, categ[1]]), categ[2]], "_", data1[order(data1[, categ[2]], data1[, categ[1]]), categ[1]])
+ data1 <- data.frame(data1[order(data1[, categ[2]], data1[, categ[1]]), ], categ.check = factor(tempo.factor, levels = unique(tempo.factor)), stringsAsFactors = TRUE)
+ data1$categ.check <- as.integer(data1$categ.check)
+ # end data1 check categ order for dots coordinates recovery
+ # per box dots coordinates recovery
+ tempo.gg.name <- "gg.indiv.plot."
+ tempo.gg.count <- 0
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), eval(parse(text = paste0("ggplot2::ggplot()", if(is.null(add)){""}else{add})))) # add added here to have the facets
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_point(data = data1, mapping = ggplot2::aes_string(x = categ[1], y = y, color = categ[2]), stroke = dot.border.size, size = dot.size, alpha = dot.alpha, shape = 21))
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "color", name = box.legend.name, values = if(is.null(categ.color)){rep(NA, length(unique(data1[, categ[2]])))}else if(length(categ.color)== 1L){rep(categ.color, length(unique(data1[, categ[2]])))}else{categ.color})) # categ.color used for dot colors because at that stage, we do not care about colors
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_boxplot(data = data1, mapping = ggplot2::aes_string(x = categ[1], y = y, fill = categ[2]), coef = if(box.whisker.kind == "no"){0}else if(box.whisker.kind == "std"){1.5}else if(box.whisker.kind == "max"){Inf})) # fill because this is what is used with geom_box # to easily have the equivalent of the grouped boxes
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "fill", name = box.legend.name, values = if(length(categ.color)== 1L){rep(categ.color, length(unique(data1[, categ[2]])))}else{categ.color}))
+ # end per box dots coordinates recovery
}else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = y.second.tick.nb, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nCODE INCONSISTENCY 1")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
- tempo <- fun_check(data = y.include.zero, class = "vector", mode = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = y.top.extra.margin, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = y.bottom.extra.margin, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
if( ! is.null(stat.pos)){
- tempo <- fun_check(data = stat.pos, options = c("top", "above"), length = 1, fun.name = function.name) ; eval(ee)
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = stat.pos, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ stat.just <- fun_gg_just(
+ angle = stat.angle,
+ pos = ifelse(
+ vertical == TRUE,
+ ifelse(stat.pos == "top", "bottom", "top"), # "bottom" because we want justification for text that are below the ref point which is the top of the graph. The opposite for "above"
+ ifelse(stat.pos == "top", "left", "right") # "left" because we want justification for text that are on the left of the ref point which is the right border of the graph. The opposite for "above"
+ ),
+ kind = "text"
+ )
}
- tempo <- fun_check(data = stat.mean, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = stat.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = stat.dist, class = "vector", mode = "numeric", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = stat.angle, class = "vector", typeof = "integer", double.as.integer.allowed = TRUE, length = 1, neg.values = TRUE, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = vertical, class = "vector", mode = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = text.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = title, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = title.text.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = legend.show, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- if( ! is.null(legend.width)){
- tempo <- fun_check(data = legend.width, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = legend.width, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ # has in fact no interest because ggplot2 does not create room for geom_text()
+ tempo.data.max <- data1[which.max(data1[, y]), ]
+ tempo.data.max <- data.frame(tempo.data.max, label = formatC(tempo.data.max[, y], digit = 2, drop0trailing = TRUE, format = "f"), stringsAsFactors = TRUE)
+ # end has in fact no interest because ggplot2 does not create room for geom_text()
+ tempo.graph.info.ini <- ggplot2::ggplot_build(eval(parse(text = paste(paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "), if( ! is.null(stat.pos)){' + ggplot2::geom_text(data = tempo.data.max, mapping = ggplot2::aes_string(x = 1, y = y, label = "label"), size = stat.size, color = "black", angle = stat.angle, hjust = stat.just$hjust, vjust = stat.just$vjust)'})))) # added here to have room for annotation
+ dot.coord <- tempo.graph.info.ini$data[[1]]
+ dot.coord$x <- as.numeric(dot.coord$x) # because weird class
+ dot.coord$PANEL <- as.numeric(dot.coord$PANEL) # because numbers as levels. But may be a problem is facet are reordered ?
+ tempo.mean <- aggregate(x = dot.coord$y, by = list(dot.coord$group, dot.coord$PANEL), FUN = mean, na.rm = TRUE)
+ names(tempo.mean)[names(tempo.mean) == "x"] <- "MEAN"
+ names(tempo.mean)[names(tempo.mean) == "Group.1"] <- "BOX"
+ names(tempo.mean)[names(tempo.mean) == "Group.2"] <- "PANEL"
+ dot.coord <- data.frame(
+ dot.coord[order(dot.coord$group, dot.coord$y), ], # dot.coord$PANEL deals below
+ y.check = as.double(data1[order(data1$categ.check, data1[, y]), y]),
+ categ.check = data1[order(data1$categ.check, data1[, y]), "categ.check"],
+ dot.color = if(is.null(dot.color)){NA}else{data1[order(data1$categ.check, data1[, y]), "dot.color"]},
+ data1[order(data1$categ.check, data1[, y]), ][categ], # avoid the renaming below
+ stringsAsFactors = TRUE
+ ) # y.check to be sure that the order is the same between the y of data1 and the y of dot.coord
+ # names(dot.coord)[names(dot.coord) == "tempo.categ1"] <- categ[1]
+ if( ! is.null(dot.categ)){
+ dot.coord <- data.frame(dot.coord, data1[order(data1$categ.check, data1[, y]), ][dot.categ], stringsAsFactors = TRUE) # avoid the renaming
}
- tempo <- fun_check(data = article, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = grid, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- if( ! is.null(add)){
- tempo <- fun_check(data = add, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = add, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ if( ! is.null(facet.categ)){
+ dot.coord <- data.frame(dot.coord, data1[order(data1$categ.check, data1[, y]), ][facet.categ], stringsAsFactors = TRUE) # for facet panels
+ tempo.test <- NULL
+ for(i2 in 1:length(facet.categ)){
+ tempo.test <- paste0(tempo.test, ".", formatC(as.numeric(dot.coord[, facet.categ[i2]]), width = nchar(max(as.numeric(dot.coord[, facet.categ[i2]]), na.rm = TRUE)), flag = "0")) # convert factor into numeric with leading zero for proper ranking # merge the formatC() to create a new factor. The convertion to integer should recreate the correct group number. Here as.numeric is used and not as.integer in case of numeric in facet.categ (because comes from add and not checked by fun_check, contrary to categ)
+ }
+ tempo.test <- as.integer(factor(tempo.test))
+ if( ! identical(as.integer(dot.coord$PANEL), tempo.test)){
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nas.integer(dot.coord$PANEL) AND tempo.test MUST BE IDENTICAL. CODE HAS TO BE MODIFIED")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
}
- tempo <- fun_check(data = return, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = return.ggplot, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = return.gtable, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = plot, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = warn.print, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- if( ! is.null(lib.path)){
- tempo <- fun_check(data = lib.path, class = "vector", mode = "character", fun.name = function.name) ; eval(ee)
- if(tempo$problem == FALSE){
- if( ! all(dir.exists(lib.path), na.rm = TRUE)){ # separation to avoid the problem of tempo$problem == FALSE and lib.path == NA
- tempo.cat <- paste0("ERROR IN ", function.name, "\nDIRECTORY PATH INDICATED IN THE lib.path ARGUMENT DOES NOT EXISTS:\n", paste(lib.path, collapse = "\n"))
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
+ if(dot.tidy == TRUE){
+ if( ! is.null(dot.categ)){
+ dot.coord <- data.frame(dot.coord, tidy_group = data1[order(data1$categ.check, data1[, y]), ][, dot.categ], stringsAsFactors = TRUE) # avoid the renaming
+ # tidy_group_coord is to be able to fuse table when creating the table for dot coordinates
+ if(dot.categ %in% categ){
+ dot.coord <- data.frame(dot.coord, tidy_group_coord = dot.coord$group, stringsAsFactors = TRUE)
+ }else{
+ dot.coord <- data.frame(dot.coord, tidy_group_coord = as.integer(factor(paste0(
+ formatC(as.integer(dot.coord[, categ[1]]), width = nchar(max(as.integer(dot.coord[, categ[1]]), na.rm = TRUE)), flag = "0"), # convert factor into numeric with leading zero for proper ranking
+ ".",
+ if(length(categ) == 2L){formatC(as.integer(dot.coord[, categ[2]]), width = nchar(max(as.integer(dot.coord[, categ[2]]), na.rm = TRUE)), flag = "0")}, # convert factor into numeric with leading zero for proper ranking
+ if(length(categ) == 2L){"."},
+ formatC(as.integer(dot.coord[, dot.categ]), width = nchar(max(as.integer(dot.coord[, dot.categ]), na.rm = TRUE)), flag = "0") # convert factor into numeric with leading zero for proper ranking
+ )), stringsAsFactors = TRUE) # merge the 2 or 3 formatC() to create a new factor. The convertion to integer should recreate the correct group number
+ ) # for tidy dot plots
}
+ }else{
+ dot.coord <- data.frame(dot.coord, tidy_group = if(length(categ)== 1L){
+ dot.coord[, categ]}else{as.integer(factor(paste0(
+ formatC(as.integer(dot.coord[, categ[1]]), width = nchar(max(as.integer(dot.coord[, categ[1]]), na.rm = TRUE)), flag = "0"), # convert factor into numeric with leading zero for proper ranking
+ ".",
+ formatC(as.integer(dot.coord[, categ[2]]), width = nchar(max(as.integer(dot.coord[, categ[2]]), na.rm = TRUE)), flag = "0")# convert factor into numeric with leading zero for proper ranking
+ )), stringsAsFactors = TRUE) # merge the 2 formatC() to create a new factor. The convertion to integer should recreate the correct group number
+ }) # for tidy dot plots
+ # tidy_group_coord is to be able to fuse table when creating the table for dot coordinates
+ dot.coord <- data.frame(dot.coord, tidy_group_coord = dot.coord$group, stringsAsFactors = TRUE)
}
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = lib.path, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- if(any(arg.check) == TRUE){ # normally no NA
- stop(paste0("\n\n================\n\n", paste(text.check[arg.check], collapse = "\n"), "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between == #
}
- # source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.7/r_debugging_tools-v1.7.R") ; eval(parse(text = str_basic_arg_check_dev)) ; eval(parse(text = str_arg_check_with_fun_check_dev)) # activate this line and use the function (with no arguments left as NULL) to check arguments status and if they have been checked using fun_check()
- # end argument primary checking
- # second round of checking and data preparation
- # management of NA arguments
- tempo.arg <- names(arg.user.setting) # values provided by the user
- tempo.log <- suppressWarnings(sapply(lapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = is.na), FUN = any)) & lapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = length) == 1L # no argument provided by the user can be just NA
- if(any(tempo.log) == TRUE){ # normally no NA because is.na() used here
- tempo.cat <- paste0("ERROR IN ", function.name, ":\n", ifelse(sum(tempo.log, na.rm = TRUE) > 1, "THESE ARGUMENTS\n", "THIS ARGUMENT\n"), paste0(tempo.arg[tempo.log], collapse = "\n"),"\nCANNOT JUST BE NA")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- # end management of NA arguments
- # management of NULL arguments
- tempo.arg <-c(
- "data1",
- "y",
- "categ",
- "box.fill",
- "box.width",
- "box.space",
- "box.line.size",
- "box.notch",
- "box.alpha",
- "box.mean",
- "box.whisker.kind",
- "box.whisker.width",
- # "dot.color", # inactivated because can be null
- "dot.tidy",
- "dot.tidy.bin.nb",
- "dot.jitter",
- # "dot.seed", # inactivated because can be null
- "dot.size",
- "dot.alpha",
- "dot.border.size",
- "x.angle",
- "y.log",
- # "y.second.tick.nb", # inactivated because can be null
- "y.include.zero",
- "y.top.extra.margin",
- "y.bottom.extra.margin",
- # "stat.pos", # inactivated because can be null
- "stat.mean",
- "stat.size",
- "stat.dist",
- "stat.angle",
- "vertical",
- "text.size",
- "title",
- "title.text.size",
- "legend.show",
- # "legend.width", # inactivated because can be null
- "article",
- "grid",
- "return",
- "return.ggplot",
- "return.gtable",
- "plot",
- "warn.print"
- )
- tempo.log <- sapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = is.null)
- if(any(tempo.log) == TRUE){# normally no NA with is.null()
- tempo.cat <- paste0("ERROR IN ", function.name, ":\n", ifelse(sum(tempo.log, na.rm = TRUE) > 1, "THESE ARGUMENTS\n", "THIS ARGUMENT\n"), paste0(tempo.arg[tempo.log], collapse = "\n"),"\nCANNOT BE NULL")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- # end management of NULL arguments
- # code that protects set.seed() in the global environment
- # see also Protocol 100-rev0 Parallelization in R.docx
- if(exists(".Random.seed", envir = .GlobalEnv)){ # if .Random.seed does not exists, it means that no random operation has been performed yet in any R environment
- tempo.random.seed <- .Random.seed
- on.exit(assign(".Random.seed", tempo.random.seed, env = .GlobalEnv))
- }else{
- on.exit(set.seed(NULL)) # inactivate seeding -> return to complete randomness
- }
- set.seed(dot.seed)
- # end code that protects set.seed() in the global environment
- # warning initiation
- ini.warning.length <- options()$warning.length
- options(warning.length = 8170)
- warn <- NULL
- warn.count <- 0
- # end warning initiation
- # other checkings
- if(any(duplicated(names(data1)), na.rm = TRUE)){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nDUPLICATED COLUMN NAMES OF data1 ARGUMENT NOT ALLOWED:\n", paste(names(data1)[duplicated(names(data1))], collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- if( ! (y %in% names(data1))){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ny ARGUMENT MUST BE A COLUMN NAME OF data1")
+ if( ! (identical(dot.coord$y, dot.coord$y.check) & identical(dot.coord$group, dot.coord$categ.check))){
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\n(dot.coord$y AND dot.coord$y.check) AS WELL AS (dot.coord$group AND dot.coord$categ.check) MUST BE IDENTICAL. CODE HAS TO BE MODIFIED")
stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}else{
- tempo <- fun_check(data = data1[, y], data.name = "y COLUMN OF data1", class = "vector", mode = "numeric", na.contain = TRUE, fun.name = function.name)
- if(tempo$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ny ARGUMENT MUST BE NUMERIC COLUMN IN data1")
+ if( ! identical(tempo.mean[order(tempo.mean$BOX, tempo.mean$PANEL), ]$BOX, unique(dot.coord[order(dot.coord$group, dot.coord$PANEL), c("group", "PANEL")])$group)){
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\n(tempo.mean$BOX, tempo.mean$PANEL) AND (dot.coord$group, dot.coord$PANEL) MUST BE IDENTICAL. CODE HAS TO BE MODIFIED")
stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else{
+ tempo <- unique(dot.coord[order(dot.coord$group, dot.coord$PANEL), c(categ, if( ! is.null(dot.color) & ! is.null(dot.categ)){if(dot.categ != ini.dot.categ){dot.categ}}, if( ! is.null(facet.categ)){facet.categ}), drop = FALSE])
+ # names(tempo) <- paste0(names(tempo), ".mean")
+ tempo.mean <- data.frame(tempo.mean[order(tempo.mean$BOX, tempo.mean$PANEL), ], tempo, stringsAsFactors = TRUE)
}
}
- if(length(categ) > 2){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg ARGUMENT CANNOT HAVE MORE THAN 2 COLUMN NAMES OF data1")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else if( ! all(categ %in% names(data1))){ # all() without na.rm -> ok because categ cannot be NA (tested above)
- tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg ARGUMENT MUST BE COLUMN NAMES OF data1. HERE IT IS:\n", paste(categ, collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- if(length(dot.categ) > 1){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.categ ARGUMENT CANNOT HAVE MORE THAN 1 COLUMN NAMES OF data1")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else if( ! all(dot.categ %in% names(data1))){ # all() without na.rm -> ok because dot.categ cannot be NA (tested above)
- tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.categ ARGUMENT MUST BE COLUMN NAMES OF data1. HERE IT IS:\n", paste(dot.categ, collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- # reserved word checking
- if(any(names(data1) %in% reserved.words, na.rm = TRUE)){
- if(any(duplicated(names(data1)), na.rm = TRUE)){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nDUPLICATED COLUMN NAMES OF data1 ARGUMENT NOT ALLOWED:\n", paste(names(data1)[duplicated(names(data1))], collapse = " "))
+ # at that stage, categ color and dot color are correctly attributed in data1, box.coord and dot.coord
+ # end y dot coordinates recovery (create ini.box.coord, dot.coord and modify data1)
+ # ylim range
+ if(is.null(y.lim)){
+ y.lim <- tempo.graph.info.ini$layout$panel_params[[1]]$y.range # finite = TRUE removes all the -Inf and Inf except if only this. In that case, whatever the -Inf and/or Inf present, output -Inf;Inf range. Idem with NA only
+ if(any(( ! is.finite(y.lim)) | is.na(y.lim)) | length(y.lim) != 2){ # kept but normally no more Inf in data1 # normally no NA with is.finite, etc.
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\ntempo.graph.info.ini$layout$panel_params[[1]]$y.range[1] CONTAINS NA OR Inf OR HAS LENGTH 1")
stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
- if( ! is.null(dot.categ)){
- if(dot.categ %in% categ){
- reserved.words <- c(reserved.words, paste0(dot.categ, "_DOT")) # paste0(dot.categ, "_DOT") is added to the reserved words because in such situation, a new column will be added to data1 that is named paste0(dot.categ, "_DOT")
- }
- }
- tempo.output <- fun_name_change(names(data1), reserved.words)
- for(i2 in 1:length(tempo.output$ini)){ # a loop to be sure to take the good ones
- names(data1)[names(data1) == tempo.output$ini[i2]] <- tempo.output$post[i2]
- if(any(y == tempo.output$ini[i2])){ # any() without na.rm -> ok because y cannot be NA (tested above)
- y[y == tempo.output$ini[i2]] <- tempo.output$post[i2]
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") IN y ARGUMENT (COLUMN NAMES OF data1 ARGUMENT),\n", tempo.output$ini[i2], " HAS BEEN REPLACED BY ", tempo.output$post[i2], "\nBECAUSE RISK OF BUG AS SOME NAMES IN y ARGUMENT ARE RESERVED WORD USED BY THE ", function.name, " FUNCTION")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- # WARNING: names of y argument potentially replaced
- if(any(categ == tempo.output$ini[i2])){ # any() without na.rm -> ok because categ cannot be NA (tested above)
- categ[categ == tempo.output$ini[i2]] <- tempo.output$post[i2]
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") IN categ ARGUMENT (COLUMN NAMES OF data1 ARGUMENT),\n", tempo.output$ini[i2], " HAS BEEN REPLACED BY ", tempo.output$post[i2], "\nBECAUSE RISK OF BUG AS SOME NAMES IN categ ARGUMENT ARE RESERVED WORD USED BY THE ", function.name, " FUNCTION")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- # WARNING: names of categ argument potentially replaced
- if( ! is.null(dot.categ)){
- if(any(dot.categ == tempo.output$ini[i2])){ # any() without na.rm -> ok because dot.categ cannot be NA (tested above)
- dot.categ[dot.categ == tempo.output$ini[i2]] <- tempo.output$post[i2]
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") IN dot.categ ARGUMENT (COLUMN NAMES OF data1 ARGUMENT),\n", tempo.output$ini[i2], " HAS BEEN REPLACED BY ", tempo.output$post[i2], "\nBECAUSE RISK OF BUG AS SOME NAMES IN dot.categ ARGUMENT ARE RESERVED WORD USED BY THE ", function.name, " FUNCTION")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- }
- # WARNING: names of dot.categ argument potentially replaced
- }
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") REGARDING COLUMN NAMES REPLACEMENT, THE NAMES\n", paste(tempo.output$ini, collapse = " "), "\nHAVE BEEN REPLACED BY\n", paste(tempo.output$post, collapse = " "))
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- if( ! (is.null(add) | is.null(tempo.output$ini))){
- if(grepl(x = add, pattern = paste(tempo.output$ini, collapse = "|"))){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nDETECTION OF COLUMN NAMES OF data1 IN THE add ARGUMENT STRING, THAT CORRESPOND TO RESERVED STRINGS FOR ", function.name, "\nCOLUMN NAMES HAVE TO BE CHANGED\nTHE PROBLEMATIC COLUMN NAMES ARE SOME OF THESE NAMES:\n", paste(tempo.output$ini, collapse = " "), "\nIN THE DATA FRAME OF data1 AND IN THE STRING OF add ARGUMENT, TRY TO REPLACE NAMES BY:\n", paste(tempo.output$post, collapse = " "), "\n\nFOR INFORMATION, THE RESERVED WORDS ARE:\n", paste(reserved.words, collapse = "\n"))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- }
- }
- if( ! (is.null(add))){
- if(any(sapply(X = arg.names, FUN = grepl, x = add), na.rm = TRUE)){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") NAMES OF ", function.name, " ARGUMENTS DETECTED IN THE add STRING:\n", paste(arg.names[sapply(X = arg.names, FUN = grepl, x = add)], collapse = "\n"), "\nRISK OF WRONG OBJECT USAGE INSIDE ", function.name)
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
+ }else if(y.log != "no"){
+ y.lim <- get(y.log)(y.lim) # no env = sys.nframe(), inherit = FALSE in get() because look for function in the classical scope
}
- # end reserved word checking
- # verif of add
- if( ! is.null(add)){
- if( ! grepl(pattern = "^\\s*\\+", add)){ # check that the add string start by +
- tempo.cat <- paste0("ERROR IN ", function.name, "\nadd ARGUMENT MUST START WITH \"+\": ", paste(unique(add), collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else if( ! grepl(pattern = "(ggplot2|lemon)\\s*::", add)){ #
- tempo.cat <- paste0("ERROR IN ", function.name, "\nFOR EASIER FUNCTION DETECTION, add ARGUMENT MUST CONTAIN \"ggplot2::\" OR \"lemon::\" IN FRONT OF EACH GGPLOT2 FUNCTION: ", paste(unique(add), collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else if( ! grepl(pattern = ")\\s*$", add)){ # check that the add string finished by )
- tempo.cat <- paste0("ERROR IN ", function.name, "\nadd ARGUMENT MUST FINISH BY \")\": ", paste(unique(add), collapse = " "))
+ if(y.log != "no"){
+ # normally this control is not necessary anymore
+ if(any( ! is.finite(y.lim))){ # normally no NA with is.finite
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ny.lim ARGUMENT CANNOT HAVE ZERO OR NEGATIVE VALUES WITH THE y.log ARGUMENT SET TO ", y.log, ":\n", paste(y.lim, collapse = " "), "\nPLEASE, CHECK DATA VALUES (PRESENCE OF ZERO OR INF VALUES)")
stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
}
- # end verif of add
- # management of add containing facet
- facet.categ <- NULL
- if( ! is.null(add)){
- facet.check <- TRUE
- tempo <- unlist(strsplit(x = add, split = "\\s*\\+\\s*(ggplot2|lemon)\\s*::\\s*")) #
- tempo <- sub(x = tempo, pattern = "^facet_wrap", replacement = "ggplot2::facet_wrap")
- tempo <- sub(x = tempo, pattern = "^facet_grid", replacement = "ggplot2::facet_grid")
- tempo <- sub(x = tempo, pattern = "^facet_rep", replacement = "lemon::facet_rep")
- if(any(grepl(x = tempo, pattern = "ggplot2::facet_wrap|lemon::facet_rep_wrap"), na.rm = TRUE)){
- tempo1 <- suppressWarnings(eval(parse(text = tempo[grepl(x = tempo, pattern = "ggplot2::facet_wrap|lemon::facet_rep_wrap")])))
- facet.categ <- names(tempo1$params$facets)
- tempo.text <- "facet_wrap OR facet_rep_wrap"
- facet.check <- FALSE
- }else if(grepl(x = add, pattern = "ggplot2::facet_grid|lemon::facet_rep_grid")){
- tempo1 <- suppressWarnings(eval(parse(text = tempo[grepl(x = tempo, pattern = "ggplot2::facet_grid|lemon::facet_rep_grid")])))
- facet.categ <- c(names(tempo1$params$rows), names(tempo1$params$cols))
- tempo.text <- "facet_grid OR facet_rep_grid"
- facet.check <- FALSE
- }
- if(facet.check == FALSE & ! all(facet.categ %in% names(data1))){ # WARNING: all(facet.categ %in% names(data1)) is TRUE when facet.categ is NULL # all() without na.rm -> ok because facet.categ cannot be NA (tested above)
- tempo.cat <- paste0("ERROR IN ", function.name, "\nDETECTION OF \"", tempo.text, "\" STRING IN THE add ARGUMENT BUT PROBLEM OF VARIABLE DETECTION (COLUMN NAMES OF data1)\nTHE DETECTED VARIABLES ARE:\n", paste(facet.categ, collapse = " "), "\nTHE data1 COLUMN NAMES ARE:\n", paste(names(data1), collapse = " "), "\nPLEASE REWRITE THE add STRING AND RERUN")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
+ if(suppressWarnings(all(y.lim %in% c(Inf, -Inf)))){ # all() without na.rm -> ok because y.lim cannot be NA (tested above)
+ # normally this control is not necessary anymore
+ tempo.cat <- paste0("ERROR IN ", function.name, " y.lim CONTAINS Inf VALUES, MAYBE BECAUSE VALUES FROM data1 ARGUMENTS ARE NA OR Inf ONLY OR BECAUSE OF LOG SCALE REQUIREMENT")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
- # end management of add containing facet
- # conversion of categ columns in data1 into factors
- for(i1 in 1:length(categ)){
- tempo1 <- fun_check(data = data1[, categ[i1]], data.name = paste0("categ NUMBER ", i1, " OF data1"), class = "vector", mode = "character", na.contain = TRUE, fun.name = function.name)
- tempo2 <- fun_check(data = data1[, categ[i1]], data.name = paste0("categ NUMBER ", i1, " OF data1"), class = "factor", na.contain = TRUE, fun.name = function.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, "\n", paste0("categ NUMBER ", i1, " OF data1"), " MUST BE A FACTOR OR CHARACTER VECTOR")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else if(tempo1$problem == FALSE){ # character vector
- if(box.alpha != 0){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") IN categ NUMBER ", i1, " IN data1, THE CHARACTER COLUMN HAS BEEN CONVERTED TO FACTOR, WITH LEVELS ACCORDING TO THE ALPHABETICAL ORDER")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- }
- data1[, categ[i1]] <- factor(data1[, categ[i1]]) # if already a factor, change nothing, if characters, levels according to alphabetical order
+ if(suppressWarnings(any(is.na(y.lim)))){ # normally no NA with is.na
+ # normally this control is not necessary anymore
+ tempo.cat <- paste0("ERROR IN ", function.name, " y.lim CONTAINS NA OR NaN VALUES, MAYBE BECAUSE VALUES FROM data1 ARGUMENTS ARE NA OR Inf ONLY OR BECAUSE OF LOG SCALE REQUIREMENT")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
- # OK: all the categ columns of data1 are factors from here
- # end conversion of categ columns in data1 into factors
+ y.lim.order <- order(y.lim) # to deal with inverse axis
+ y.lim <- sort(y.lim)
+ y.lim[1] <- y.lim[1] - abs(y.lim[2] - y.lim[1]) * ifelse(diff(y.lim.order) > 0, y.bottom.extra.margin, y.top.extra.margin) # diff(y.lim.order) > 0 medians not inversed axis
+ y.lim[2] <- y.lim[2] + abs(y.lim[2] - y.lim[1]) * ifelse(diff(y.lim.order) > 0, y.top.extra.margin, y.bottom.extra.margin) # diff(y.lim.order) > 0 medians not inversed axis
+ if(y.include.zero == TRUE){ # no need to check y.log != "no" because done before
+ y.lim <- range(c(y.lim, 0), na.rm = TRUE, finite = TRUE) # finite = TRUE removes all the -Inf and Inf except if only this. In that case, whatever the -Inf and/or Inf present, output -Inf;Inf range. Idem with NA only
+ }
+ y.lim <- y.lim[y.lim.order]
+ if(any(is.na(y.lim))){ # normally no NA with is.na
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nCODE INCONSISTENCY 2")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ # end ylim range
- # management of log scale and Inf removal
- if(any(( ! is.finite(data1[, y])) & ( ! is.na(data1[, y])))){ # is.finite also detects NA: ( ! is.finite(data1[, y])) & ( ! is.na(data1[, y])) detects only Inf # normally no NA with is.finite0() and is.na()
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") PRESENCE OF -Inf OR Inf VALUES IN THE ", y, " COLUMN OF THE data1 ARGUMENT AND CORRESPONDING ROWS REMOVED (SEE $removed.row.nb AND $removed.rows)")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- data1.ini <- data1 # strictly identical to data1 except that in data1 y is log converted if and only if y.log != "no"
- if(y.log != "no"){
- tempo1 <- ! is.finite(data1[, y]) # where are initial NA and Inf
- data1[, y] <- suppressWarnings(get(y.log)(data1[, y]))# no env = sys.nframe(), inherit = FALSE in get() because look for function in the classical scope
- if(any( ! (tempo1 | is.finite(data1[, y])))){ # normally no NA with is.finite
+
+
+
+ # drawing
+ # constant part
+ tempo.gg.name <- "gg.indiv.plot."
+ tempo.gg.count <- 0
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), eval(parse(text = paste0("ggplot2::ggplot()", if(is.null(add)){""}else{add})))) # add is directly put here to deal with additional variable of data, like when using facet_grid. No problem if add is a theme, will be dealt below
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::xlab(if(is.null(x.lab)){categ[1]}else{x.lab}))
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::ylab(if(is.null(y.lab)){y}else{y.lab}))
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::ggtitle(title))
+ # text angle management
+ axis.just <- fun_gg_just(angle = x.angle, pos = ifelse(vertical == TRUE, "bottom", "left"), kind = "axis")
+ # end text angle management
+ add.check <- TRUE
+ if( ! is.null(add)){ # if add is NULL, then = 0
+ if(grepl(pattern = "ggplot2\\s*::\\s*theme", add) == TRUE){
warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") LOG CONVERSION INTRODUCED -Inf OR Inf OR NaN VALUES IN THE ", y, " COLUMN OF THE data1 ARGUMENT AND CORRESPONDING ROWS REMOVED (SEE $removed.row.nb AND $removed.rows)")
+ tempo.warn <- paste0("(", warn.count,") \"ggplot2::theme\" STRING DETECTED IN THE add ARGUMENT\n-> INTERNAL GGPLOT2 THEME FUNCTIONS theme() AND theme_classic() HAVE BEEN INACTIVATED, TO BE USED BY THE USER\n-> article ARGUMENT WILL BE IGNORED")
warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ add.check <- FALSE
}
}
- # Inf removal
- if(any(( ! is.finite(data1[, y])) & ( ! is.na(data1[, y])))){ # is.finite also detects NA: ( ! is.finite(data1[, y])) & ( ! is.na(data1[, y])) detects only Inf # normally no NA with is.finite
- removed.row.nb <- which(( ! is.finite(data1[, y])) & ( ! is.na(data1[, y])))
- removed.rows <- data1.ini[removed.row.nb, ] # here data1.ini used to have the y = O rows that will be removed because of Inf creation after log transformation
- data1 <- data1[-removed.row.nb, ] #
- data1.ini <- data1.ini[-removed.row.nb, ] #
- }else{
- removed.row.nb <- NULL
- removed.rows <- data.frame(stringsAsFactors = FALSE)
- }
- # From here, data1 and data.ini have no more Inf
- # end Inf removal
- if(y.log != "no" & ! is.null(y.lim)){
- if(any(y.lim <= 0)){ # any() without na.rm -> ok because y.lim cannot be NA (tested above)
- tempo.cat <- paste0("ERROR IN ", function.name, "\ny.lim ARGUMENT CANNOT HAVE ZERO OR NEGATIVE VALUES WITH THE y.log ARGUMENT SET TO ", y.log, ":\n", paste(y.lim, collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else if(any( ! is.finite(if(y.log == "log10"){log10(y.lim)}else{log2(y.lim)}))){ # normally no NA with is.finite
- tempo.cat <- paste0("ERROR IN ", function.name, "\ny.lim ARGUMENT RETURNS INF/NA WITH THE y.log ARGUMENT SET TO ", y.log, "\nAS SCALE COMPUTATION IS ", ifelse(y.log == "log10", "log10", "log2"), ":\n", paste(if(y.log == "log10"){log10(y.lim)}else{log2(y.lim)}, collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- }
- if(y.log != "no" & y.include.zero == TRUE){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") y.log ARGUMENT SET TO ", y.log, " AND y.include.zero ARGUMENT SET TO TRUE -> y.include.zero ARGUMENT RESET TO FALSE BECAUSE 0 VALUE CANNOT BE REPRESENTED IN LOG SCALE")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- y.include.zero <- FALSE
- }
- if(y.log != "no" & vertical == FALSE){
- vertical <- TRUE
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") BECAUSE OF A BUG IN ggplot2, CANNOT FLIP BOXES HORIZONTALLY WITH A Y.LOG SCALE -> vertical ARGUMENT RESET TO TRUE")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- # end management of log scale and Inf removal
- # na detection and removal (done now to be sure of the correct length of categ)
- column.check <- unique(c(y, categ, if( ! is.null(dot.color) & ! is.null(dot.categ)){dot.categ}, if( ! is.null(facet.categ)){facet.categ})) # dot.categ because can be a 3rd column of data1, categ.color and dot.color will be tested later
- if(any(is.na(data1[, column.check]))){ # data1 used here instead of data1.ini in case of new NaN created by log conversion (neg values) # normally no NA with is.na
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") NA DETECTED IN COLUMNS OF data1 AND CORRESPONDING ROWS REMOVED (SEE $removed.row.nb AND $removed.rows)")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- for(i2 in 1:length(column.check)){
- if(any(is.na(data1[, column.check[i2]]))){ # normally no NA with is.na
- tempo.warn <- paste0("NA REMOVAL DUE TO COLUMN ", column.check[i2], " OF data1")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n", tempo.warn)))
- }
- }
- tempo <- unique(unlist(lapply(lapply(c(data1[column.check]), FUN = is.na), FUN = which)))
- removed.row.nb <- c(removed.row.nb, tempo) # removed.row.nb created to remove Inf
- removed.rows <- rbind(removed.rows, data1.ini[tempo, ], stringsAsFactors = FALSE) # here data1.ini used to have the non NA rows that will be removed because of NAN creation after log transformation (neg values for instance)
- column.check <- column.check[ ! column.check == y] # remove y to keep quali columns
- if(length(tempo) != 0){
- data1 <- data1[-tempo, ] # WARNING tempo here and not removed.row.nb because the latter contain more numbers thant the former
- data1.ini <- data1.ini[-tempo, ] # WARNING tempo here and not removed.row.nb because the latter contain more numbers than the former
- for(i3 in 1:length(column.check)){
- if(any( ! unique(removed.rows[, column.check[i3]]) %in% unique(data1[, column.check[i3]]), na.rm = TRUE)){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") IN COLUMN ", column.check[i3], " OF data1, THE FOLLOWING CLASSES HAVE DISAPPEARED AFTER NA/Inf REMOVAL (IF COLUMN USED IN THE PLOT, THIS CLASS WILL NOT BE DISPLAYED):\n", paste(unique(removed.rows[, column.check[i3]])[ ! unique(removed.rows[, column.check[i3]]) %in% unique(data1[, column.check[i3]])], collapse = " "))
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- }
- }
- count.categ <- 0
- for(i2 in 1:length(column.check)){
- if(column.check[i2] %in% categ){
- count.categ <- count.categ + 1
- }
- if(column.check[i2] == categ[count.categ]){
- categ.class.order[count.categ] <- list(levels(data1[, column.check[i2]])[levels(data1[, column.check[i2]]) %in% unique(data1[, column.check[i2]])]) # remove the absent color in the character vector
- data1[, column.check[i2]] <- factor(as.character(data1[, column.check[i2]]), levels = unique(categ.class.order[[count.categ]]))
- }
- if( ! is.null(dot.color) & ! is.null(dot.categ)){ # reminder : dot.categ cannot be a column name of categ anymore (because in that case dot.categ name is changed into "..._DOT"
- if(column.check[i2] == dot.categ){
- dot.categ.class.order <- levels(data1[, column.check[i2]])[levels(data1[, column.check[i2]]) %in% unique(data1[, column.check[i2]])] # remove the absent color in the character vector
- data1[, column.check[i2]] <- factor(as.character(data1[, column.check[i2]]), levels = unique(dot.categ.class.order))
- }
- }
- if(column.check[i2] %in% facet.categ){ # works if facet.categ == NULL this method should keep the order of levels when removing some levels
- tempo.levels <- levels(data1[, column.check[i2]])[levels(data1[, column.check[i2]]) %in% unique(as.character(data1[, column.check[i2]]))]
- data1[, column.check[i2]] <- factor(as.character(data1[, column.check[i2]]), levels = tempo.levels)
- }
+ if(add.check == TRUE & article == TRUE){
+ # WARNING: not possible to add theme()several times. NO message but the last one overwrites the others
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::theme_classic(base_size = text.size))
+ if(grid == TRUE){
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), m.gg <- ggplot2::theme(
+ text = ggplot2::element_text(size = text.size),
+ plot.title = ggplot2::element_text(size = title.text.size), # stronger than text
+ line = ggplot2::element_line(size = 0.5),
+ legend.key = ggplot2::element_rect(color = "white", size = 1.5), # size of the frame of the legend
+ axis.line.y.left = ggplot2::element_line(colour = "black"), # draw lines for the y axis
+ axis.line.x.bottom = ggplot2::element_line(colour = "black"), # draw lines for the x axis
+ panel.grid.major.x = if(vertical == TRUE){NULL}else{ggplot2::element_line(colour = "grey85", size = 0.75)},
+ panel.grid.major.y = if(vertical == TRUE){ggplot2::element_line(colour = "grey85", size = 0.75)}else{NULL},
+ panel.grid.minor.y = if(vertical == TRUE){ggplot2::element_line(colour = "grey90", size = 0.25)}else{NULL},
+ axis.text.x = if(vertical == TRUE){ggplot2::element_text(angle = axis.just$angle, hjust = axis.just$hjust, vjust = axis.just$vjust)}else{NULL},
+ axis.text.y = if(vertical == TRUE){NULL}else{ggplot2::element_text(angle = axis.just$angle, hjust = axis.just$hjust, vjust = axis.just$vjust)},
+ strip.background = ggplot2::element_rect(fill = NA, colour = NA) # for facet background
+ ))
+ }else{
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), m.gg <- ggplot2::theme(
+ text = ggplot2::element_text(size = text.size),
+ plot.title = ggplot2::element_text(size = title.text.size), # stronger than text
+ line = ggplot2::element_line(size = 0.5),
+ legend.key = ggplot2::element_rect(color = "white", size = 1.5), # size of the frame of the legend
+ axis.line.y.left = ggplot2::element_line(colour = "black"),
+ axis.line.x.bottom = ggplot2::element_line(colour = "black"),
+ axis.text.x = if(vertical == TRUE){ggplot2::element_text(angle = axis.just$angle, hjust = axis.just$hjust, vjust = axis.just$vjust)}else{NULL},
+ axis.text.y = if(vertical == TRUE){NULL}else{ggplot2::element_text(angle = axis.just$angle, hjust = axis.just$hjust, vjust = axis.just$vjust)},
+ strip.background = ggplot2::element_rect(fill = NA, colour = NA)
+ ))
}
+ }else if(add.check == TRUE & article == FALSE){
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), m.gg <- ggplot2::theme(
+ text = ggplot2::element_text(size = text.size),
+ plot.title = ggplot2::element_text(size = title.text.size), # stronger than text
+ line = ggplot2::element_line(size = 0.5),
+ legend.key = ggplot2::element_rect(color = "white", size = 1.5), # size of the frame of the legend
+ panel.background = ggplot2::element_rect(fill = "grey95"),
+ axis.line.y.left = ggplot2::element_line(colour = "black"),
+ axis.line.x.bottom = ggplot2::element_line(colour = "black"),
+ panel.grid.major.x = ggplot2::element_line(colour = "grey85", size = 0.75),
+ panel.grid.major.y = ggplot2::element_line(colour = "grey85", size = 0.75),
+ panel.grid.minor.x = ggplot2::element_blank(),
+ panel.grid.minor.y = ggplot2::element_line(colour = "grey90", size = 0.25),
+ strip.background = ggplot2::element_rect(fill = NA, colour = NA),
+ axis.text.x = if(vertical == TRUE){ggplot2::element_text(angle = axis.just$angle, hjust = axis.just$hjust, vjust = axis.just$vjust)}else{NULL},
+ axis.text.y = if(vertical == TRUE){NULL}else{ggplot2::element_text(angle = axis.just$angle, hjust = axis.just$hjust, vjust = axis.just$vjust)}
+ ))
}
- # end na detection and removal (done now to be sure of the correct length of categ)
- # From here, data1 and data.ini have no more NA or NaN in y, categ, dot.categ (if dot.color != NULL) and facet.categ
+ # Contrary to fun_gg_bar(), cannot plot the boxplot right now, because I need the dots plotted first
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_boxplot(data = data1, mapping = ggplot2::aes_string(x = categ[1], y = y, group = categ[length(categ)]), position = ggplot2::position_dodge(width = NULL), color = NA, width = box.width, fill = NA)) # this is to set the graph (i.e., a blanck boxplot to be able to use x coordinates to plot dots before boxes)
+ # end constant part
- if( ! is.null(categ.class.order)){
- if(length(categ.class.order) != length(categ)){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg.class.order ARGUMENT MUST BE A LIST OF LENGTH EQUAL TO LENGTH OF categ\nHERE IT IS LENGTH: ", length(categ.class.order), " VERSUS ", length(categ))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else{
- for(i3 in 1:length(categ.class.order)){
- if(is.null(categ.class.order[[i3]])){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") THE categ.class.order COMPARTMENT ", i3, " IS NULL. ALPHABETICAL ORDER WILL BE APPLIED")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- data1[, categ[i3]] <- factor(as.character(data1[, categ[i3]])) # if already a factor, change nothing, if characters, levels according to alphabetical order
- categ.class.order[[i3]] <- levels(data1[, categ[i3]]) # character vector that will be used later
- }else{
- tempo <- fun_check(data = categ.class.order[[i3]], data.name = paste0("COMPARTMENT ", i3 , " OF categ.class.order ARGUMENT"), class = "vector", mode = "character", length = length(levels(data1[, categ[i3]])), fun.name = function.name) # length(data1[, categ[i1]) -> if data1[, categ[i1] was initially character vector, then conversion as factor after the NA removal, thus class number ok. If data1[, categ[i1] was initially factor, no modification after the NA removal, thus class number ok
- if(tempo$problem == TRUE){
- stop(paste0("\n\n================\n\n", tempo$text, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- }
- if(any(duplicated(categ.class.order[[i3]]), na.rm = TRUE)){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nCOMPARTMENT ", i3, " OF categ.class.order ARGUMENT CANNOT HAVE DUPLICATED CLASSES: ", paste(categ.class.order[[i3]], collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else if( ! (all(categ.class.order[[i3]] %in% unique(data1[, categ[i3]]), na.rm = TRUE) & all(unique(data1[, categ[i3]]) %in% categ.class.order[[i3]], na.rm = TRUE))){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nCOMPARTMENT ", i3, " OF categ.class.order ARGUMENT MUST BE CLASSES OF ELEMENT ", i3, " OF categ ARGUMENT\nHERE IT IS:\n", paste(categ.class.order[[i3]], collapse = " "), "\nFOR COMPARTMENT ", i3, " OF categ.class.order AND IT IS:\n", paste(unique(data1[, categ[i3]]), collapse = " "), "\nFOR COLUMN ", categ[i3], " OF data1")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else{
- data1[, categ[i3]] <- factor(data1[, categ[i3]], levels = categ.class.order[[i3]]) # reorder the factor
-
- }
- names(categ.class.order)[i3] <- categ[i3]
- }
- }
+
+ # graphic info recovery (including means)
+ tempo.graph.info <- ggplot2::ggplot_build(eval(parse(text = paste0(paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "), ' + ggplot2::geom_boxplot(data = data1, mapping = ggplot2::aes_string(x = categ[1], y = y, fill = categ[length(categ)]), position = ggplot2::position_dodge(width = NULL), width = box.width, notch = box.notch, coef = if(box.whisker.kind == "no"){0}else if(box.whisker.kind == "std"){1.5}else if(box.whisker.kind == "max"){Inf}) + ggplot2::scale_discrete_manual(aesthetics = "fill", name = box.legend.name, values = if(length(categ.color)== 1L){rep(categ.color, length(unique(data1[, categ[length(categ)]])))}else{categ.color})')))) # will be recovered later again, when ylim will be considered
+ tempo.yx.ratio <- (tempo.graph.info$layout$panel_params[[1]]$y.range[2] - tempo.graph.info$layout$panel_params[[1]]$y.range[1]) / (tempo.graph.info$layout$panel_params[[1]]$x.range[2] - tempo.graph.info$layout$panel_params[[1]]$x.range[1])
+ box.coord <- tempo.graph.info$data[[2]] # to have the summary statistics of the plot. Contrary to ini.box.plot, now integrates ylim Here because can be required for stat.pos when just box are plotted
+ box.coord$x <- as.numeric(box.coord$x) # because x is of special class that block comparison of values using identical
+ box.coord$PANEL <- as.numeric(box.coord$PANEL) # because numbers as levels. But may be a problem is facet are reordered ?
+ box.coord <- box.coord[order(box.coord$group, box.coord$PANEL), ]
+ if( ! (identical(tempo.mean$BOX, box.coord$group) & identical(tempo.mean$PANEL, box.coord$PANEL))){
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nidentical(tempo.mean$BOX, box.coord$group) & identical(tempo.mean$PANEL, box.coord$PANEL) DO NOT HAVE THE SAME VALUE ORDER")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}else{
- categ.class.order <- vector("list", length = length(categ))
- tempo.categ.class.order <- NULL
- for(i2 in 1:length(categ.class.order)){
- categ.class.order[[i2]] <- levels(data1[, categ[i2]])
- names(categ.class.order)[i2] <- categ[i2]
- tempo.categ.class.order <- c(tempo.categ.class.order, ifelse(i2 != 1, "\n", ""), categ.class.order[[i2]])
- }
- if(box.alpha != 0){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") THE categ.class.order SETTING IS NULL. ALPHABETICAL ORDER WILL BE APPLIED FOR BOX ORDERING:\n", paste(tempo.categ.class.order, collapse = " "))
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ # tempo <- c(categ, if( ! is.null(dot.color) & ! is.null(dot.categ)){if(dot.categ != ini.dot.categ){dot.categ}}, if( ! is.null(facet.categ)){facet.categ})
+ if(any(names(tempo.mean) %in% names(box.coord), na.rm = TRUE)){
+ names(tempo.mean)[names(tempo.mean) %in% names(box.coord)] <- paste0(names(tempo.mean)[names(tempo.mean) %in% names(box.coord)], ".mean")
}
+ box.coord <- data.frame(box.coord, tempo.mean, stringsAsFactors = TRUE)
}
- # categ.class.order not NULL anymore (list)
- if(is.null(box.legend.name) & box.alpha != 0){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") THE box.legend.name SETTING IS NULL. NAMES OF categ WILL BE USED: ", paste(categ, collapse = " "))
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- box.legend.name <- categ[length(categ)] # if only categ1, then legend name of categ1, if length(categ) == 2L, then legend name of categ2
+ # end graphic info recovery (including means)
+
+
+
+ # stat output (will also serve for boxplot and mean display)
+ # x not added now (to do not have them in stat.nolog)
+ stat <- data.frame(
+ MIN = box.coord$ymin_final,
+ QUART1 = box.coord$lower,
+ MEDIAN = box.coord$middle,
+ MEAN = box.coord$MEAN,
+ QUART3 = box.coord$upper,
+ MAX = box.coord$ymax_final,
+ WHISK_INF = box.coord$ymin,
+ BOX_INF = box.coord$lower,
+ NOTCH_INF = box.coord$notchlower,
+ NOTCH_SUP = box.coord$notchupper,
+ BOX_SUP = box.coord$upper,
+ WHISK_SUP = box.coord$ymax,
+ OUTLIERS = box.coord["outliers"],
+ tempo.mean[colnames(tempo.mean) != "MEAN"],
+ COLOR = box.coord$fill,
+ stringsAsFactors = TRUE
+ ) # box.coord["outliers"] written like this because it is a list. X coordinates not put now because several features to set
+ names(stat)[names(stat) == "outliers"] <- "OUTLIERS"
+ stat.nolog <- stat # stat.nolog ini will serve for outputs
+ if(y.log != "no"){
+ stat.nolog[c("MIN", "QUART1", "MEDIAN", "MEAN", "QUART3", "MAX", "WHISK_INF", "BOX_INF", "NOTCH_INF", "NOTCH_SUP", "BOX_SUP", "WHISK_SUP")] <- ifelse(y.log == "log2", 2, 10)^(stat.nolog[c("MIN", "QUART1", "MEDIAN", "MEAN", "QUART3", "MAX", "WHISK_INF", "BOX_INF", "NOTCH_INF", "NOTCH_SUP", "BOX_SUP", "WHISK_SUP")])
+ stat.nolog$OUTLIERS <- lapply(stat.nolog$OUTLIERS, FUN = function(X){ifelse(y.log == "log2", 2, 10)^X})
}
- # box.legend.name not NULL anymore (character string)
- # management of categ.color
- if( ! is.null(categ.color)){
- # check the nature of color
- # integer colors into gg_palette
- tempo.check.color <- fun_check(data = categ.color, class = "integer", double.as.integer.allowed = TRUE, na.contain = TRUE, fun.name = function.name)$problem
- if(tempo.check.color == FALSE){
- # convert integers into colors
- categ.color <- fun_gg_palette(max(categ.color, na.rm = TRUE))[categ.color]
- }
- # end integer colors into gg_palette
- if( ! (all(categ.color %in% colors() | grepl(pattern = "^#", categ.color)))){ # check that all strings of low.color start by #, # all() without na.rm -> ok because categ.color cannot be NA (tested above)
- tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg.color ARGUMENT MUST BE A HEXADECIMAL COLOR VECTOR STARTING BY # AND/OR COLOR NAMES GIVEN BY colors() OR A COLUMN NAME OF THE data1 PARAMETER: ", paste(unique(categ.color), collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- if(any(is.na(categ.color)) & box.alpha != 0){ # normally no NA with is.na
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") categ.color ARGUMENT CONTAINS NA")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- # end check the nature of color
- # check the length of color
- categ.len <- length(categ) # if only categ1, then colors for classes of categ1, if length(categ) == 2L, then colors for classes of categ2
- if(length(data1[, categ[categ.len]]) == length(levels(data1[, categ[categ.len]])) & length(categ.color) == length(data1[, categ[categ.len]])){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") THE NUMBER OF CLASSES OF THE COLUMN ", categ[categ.len], " THE NUMBER OF ROWS OF THIS COLUMN AND THE NUMBER OF COLORS OF THE categ.color ARGUMENT ARE ALL EQUAL. BOX COLORS WILL BE ATTRIBUTED ACCORDING THE LEVELS OF ", categ[categ.len], ", NOT ACCORDING TO THE ROWS OF ", categ[categ.len])
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- if(length(categ.color) == length(levels(data1[, categ[categ.len]]))){ # here length(categ.color) is equal to the different number of categ
- # data1[, categ[categ.len]] <- factor(data1[, categ[categ.len]]) # not required because sure that is is a factor
- data1 <- data.frame(data1, categ.color = data1[, categ[categ.len]], stringsAsFactors = TRUE) # no need stringsAsFactors here for stat.nolog as factors remain factors
- data1$categ.color <- factor(data1$categ.color, labels = categ.color) # replace the characters of data1[, categ[categ.len]] put in the categ.color column by the categ.color (can be write like this because categ.color is length of levels of data1[, categ[categ.len]])
- if(box.alpha != 0){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") IN ", categ[categ.len], " OF categ ARGUMENT, THE FOLLOWING COLORS:\n", paste(categ.color, collapse = " "), "\nHAVE BEEN ATTRIBUTED TO THESE CLASSES:\n", paste(levels(factor(data1[, categ[categ.len]])), collapse = " "))
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- }else if(length(categ.color) == length(data1[, categ[categ.len]])){# here length(categ.color) is equal to nrow(data1) -> Modif to have length(categ.color) equal to the different number of categ (length(categ.color) == length(levels(data1[, categ[categ.len]])))
- data1 <- data.frame(data1, categ.color = categ.color, stringsAsFactors = TRUE)
- tempo.check <- unique(data1[ , c(categ[categ.len], "categ.color")])
- if( ! (nrow(tempo.check) == length(unique(categ.color)) & nrow(tempo.check) == length(unique(data1[ , categ[categ.len]])))){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg.color ARGUMENT HAS THE LENGTH OF data1 ROW NUMBER\nBUT IS INCORRECTLY ASSOCIATED TO EACH CLASS OF categ ", categ[categ.len], ":\n", paste(unique(mapply(FUN = "paste", data1[ ,categ[categ.len]], data1[ ,"categ.color"])), collapse = "\n"))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else{
- # data1[, categ[categ.len]] <- factor(data1[, categ[categ.len]]) # not required because sure that is is a factor
- categ.color <- unique(data1$categ.color[order(data1[, categ[categ.len]])]) # Modif to have length(categ.color) equal to the different number of categ (length(categ.color) == length(levels(data1[, categ[categ.len]])))
- if(box.alpha != 0){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") categ.color ARGUMENT HAS THE LENGTH OF data1 ROW NUMBER\nCOLORS HAVE BEEN RESPECTIVELY ASSOCIATED TO EACH CLASS OF categ ", categ[categ.len], " AS:\n", paste(levels(factor(data1[, categ[categ.len]])), collapse = " "), "\n", paste(categ.color, collapse = " "))
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- }
- }else if(length(categ.color) == 1L){
- # data1[, categ[categ.len]] <- factor(data1[, categ[categ.len]]) # not required because sure that is is a factor
- data1 <- data.frame(data1, categ.color = categ.color, stringsAsFactors = TRUE)
- categ.color <- rep(categ.color, length(levels(data1[, categ[categ.len]])))
- if(box.alpha != 0){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") categ.color ARGUMENT HAS LENGTH 1, MEANING THAT ALL THE DIFFERENT CLASSES OF ", categ[categ.len], "\n", paste(levels(factor(data1[, categ[categ.len]])), collapse = " "), "\nWILL HAVE THE SAME COLOR\n", paste(categ.color, collapse = " "))
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- }else{
- tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg.color ARGUMENT MUST BE (1) LENGTH 1, OR (2) THE LENGTH OF data1 NROWS AFTER NA/Inf REMOVAL, OR (3) THE LENGTH OF THE CLASSES IN THE categ ", categ[categ.len], " COLUMN. HERE IT IS COLOR LENGTH ", length(categ.color), " VERSUS CATEG LENGTH ", length(data1[, categ[categ.len]]), " AND CATEG CLASS LENGTH ", length(unique(data1[, categ[categ.len]])), "\nPRESENCE OF NA/Inf COULD BE THE PROBLEM")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
+ # end stat output (will also serve for boxplot and mean display)
+
+
+
+
+
+
+ # x coordinates management (for random plotting and for stat display)
+ # width commputations
+ width.ini <- c(box.coord$xmax - box.coord$xmin)[1] # all the box widths are equal here. Only the first one taken
+ width.correct <- width.ini * box.space / 2
+ if( ! (identical(stat$BOX, box.coord$group) & identical(stat$PANEL, box.coord$PANEL))){
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nidentical(stat$BOX, box.coord$group) & identical(stat$PANEL, box.coord$PANEL) MUST BE IDENTICAL. CODE HAS TO BE MODIFIED")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}else{
- categ.len <- length(categ) # if only categ1, then colors for classes of categ1, if length(categ) == 2L, then colors for classes of categ2
- # data1[, categ[categ.len]] <- factor(data1[, categ[categ.len]]) # not required because sure that is is a factor
- categ.color <- fun_gg_palette(length(levels(data1[, categ[categ.len]])))
- data1 <- data.frame(data1, categ.color = data1[, categ[categ.len]], stringsAsFactors = TRUE)
- data1$categ.color <- factor(data1$categ.color, labels = categ.color) # replace the characters of data1[, categ[categ.len]] put in the categ.color column by the categ.color (can be write like this because categ.color is length of levels of data1[, categ[categ.len]])
- if(box.alpha != 0){
+ stat <- data.frame(
+ stat,
+ X = box.coord$x,
+ X_BOX_INF = box.coord$xmin + width.correct,
+ X_BOX_SUP = box.coord$xmax - width.correct,
+ X_NOTCH_INF = box.coord$x - (box.coord$x - (box.coord$xmin + width.correct)) / 2,
+ X_NOTCH_SUP = box.coord$x + (box.coord$x - (box.coord$xmin + width.correct)) / 2,
+ X_WHISK_INF = box.coord$x - (box.coord$x - (box.coord$xmin + width.correct)) * box.whisker.width,
+ X_WHISK_SUP = box.coord$x + (box.coord$x - (box.coord$xmin + width.correct)) * box.whisker.width,
+ # tempo.mean[colnames(tempo.mean) != "MEAN"], # already added above
+ stringsAsFactors = TRUE
+ )
+ stat$COLOR <- factor(stat$COLOR, levels = unique(categ.color))
+ if( ! all(stat$NOTCH_SUP < stat$BOX_SUP & stat$NOTCH_INF > stat$BOX_INF, na.rm = TRUE) & box.notch == TRUE){
warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") NULL categ.color ARGUMENT -> COLORS RESPECTIVELY ATTRIBUTED TO EACH CLASS OF ", categ[categ.len], " IN data1:\n", paste(categ.color, collapse = " "), "\n", paste(levels(data1[, categ[categ.len]]), collapse = " "))
+ tempo.warn <- paste0("(", warn.count,") SOME NOTCHES ARE BEYOND BOX HINGES. TRY ARGUMENT box.notch = FALSE")
warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
}
}
- # categ.color not NULL anymore
- categ.color <- as.character(categ.color)
- # categ.color is a character string representing the diff classes
- data1$categ.color <- factor(data1$categ.color, levels = unique(categ.color)) # ok because if categ.color is a character string, the order make class 1, class 2, etc. unique() because no duplicates allowed
- # data1$categ.color is a factor with order of levels -> categ.color
- # end management of categ.color
- # management of dot.color
+ dot.jitter <- c((box.coord$xmax - width.correct) - (box.coord$xmin + width.correct))[1] * dot.jitter # real dot.jitter. (box.coord$xmin + width.correct) - (box.coord$xmax - width.correct))[1] is the width of the box. Is equivalent to (box.coord$x - (box.coord$xmin + width.correct))[1] * 2
+ # end width commputations
if( ! is.null(dot.color)){
- # optional legend of dot colors
- if( ! is.null(dot.categ)){
- ini.dot.categ <- dot.categ
- if( ! dot.categ %in% names(data1)){ # no need to use all() because length(dot.categ) = 1
- tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.categ ARGUMENT MUST BE A COLUMN NAME OF data1. HERE IT IS:\n", dot.categ)
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else if(dot.categ %in% categ){ # no need to use all() because length(dot.categ) = 1. Do not use dot.categ %in% categ[length(categ)] -> error
- # management of dot legend if dot.categ %in% categ (because legends with the same name are joined in ggplot2)
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") THE COLUMN NAME OF data1 INDICATED IN THE dot.categ ARGUMENT (", dot.categ, ") HAS BEEN REPLACED BY ", paste0(dot.categ, "_DOT"), " TO AVOID MERGED LEGEND BY GGPLOT2")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- data1 <- data.frame(data1, dot.categ = data1[, dot.categ], stringsAsFactors = TRUE) # dot.categ is not a column name of data1 (checked above with reserved words)
- dot.categ <- paste0(dot.categ, "_DOT")
- names(data1)[names(data1) == "dot.categ"] <- dot.categ # paste0(dot.categ, "_DOT") is not a column name of data1 (checked above with reserved words)
- # tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.categ ARGUMENT CANNOT BE A COLUMN NAME OF data1 ALREADY SPECIFIED IN THE categ ARGUMENT:\n", dot.categ, "\nINDEED, dot.categ ARGUMENT IS MADE TO HAVE MULTIPLE DOT COLORS NOT RELATED TO THE BOXPLOT CATEGORIES")
- # stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- tempo1 <- fun_check(data = data1[, dot.categ], data.name = paste0(dot.categ, " COLUMN OF data1"), class = "vector", mode = "character", na.contain = TRUE, fun.name = function.name)
- tempo2 <- fun_check(data = data1[, dot.categ], data.name = paste0(dot.categ, " COLUMN OF data1"), class = "factor", na.contain = TRUE, fun.name = function.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.categ COLUMN MUST BE A FACTOR OR CHARACTER VECTOR") #
+ # random dots
+ if(dot.tidy == FALSE){
+ dot.coord.rd1 <- merge(dot.coord, box.coord[c("fill", "PANEL", "group", "x")], by = c("PANEL", "group"), sort = FALSE) # rd for random. Send the coord of the boxes into the coord data.frame of the dots (in the column x.y). WARNING: by = c("PANEL", "group") without fill column because PANEL & group columns are enough as only one value of x column per group number in box.coord. Thus, no need to consider fill column
+ if(nrow(dot.coord.rd1) != nrow(dot.coord)){
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nTHE merge() FUNCTION DID NOT RETURN A CORRECT dot.coord.rd1 DATA FRAME. CODE HAS TO BE MODIFIED")
stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
- data1[, dot.categ] <- factor(data1[, dot.categ]) # if already a factor, change nothing, if characters, levels according to alphabetical order
- # dot.categ column of data1 is factor from here
- if( ! is.null(dot.categ.class.order)){
- if(any(duplicated(dot.categ.class.order), na.rm = TRUE)){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.categ.class.order ARGUMENT CANNOT HAVE DUPLICATED CLASSES: ", paste(dot.categ.class.order, collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else if( ! (all(dot.categ.class.order %in% levels(data1[, dot.categ])) & all(levels(data1[, dot.categ]) %in% dot.categ.class.order, na.rm = TRUE))){
- tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.categ.class.order ARGUMENT MUST BE CLASSES OF dot.categ ARGUMENT\nHERE IT IS:\n", paste(dot.categ.class.order, collapse = " "), "\nFOR dot.categ.class.order AND IT IS:\n", paste(levels(data1[, dot.categ]), collapse = " "), "\nFOR dot.categ COLUMN (", ini.dot.categ, ") OF data1")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else{
- data1[, dot.categ] <- factor(data1[, dot.categ], levels = dot.categ.class.order) # reorder the factor
- }
+ sampled.dot.jitter <- if(nrow(dot.coord.rd1)== 1L){runif(n = nrow(dot.coord.rd1), min = - dot.jitter / 2, max = dot.jitter / 2)}else{sample(x = runif(n = nrow(dot.coord.rd1), min = - dot.jitter / 2, max = dot.jitter / 2), size = nrow(dot.coord.rd1), replace = FALSE)}
+ dot.coord.rd2 <- data.frame(dot.coord.rd1, dot.x = dot.coord.rd1$x.y + sampled.dot.jitter, stringsAsFactors = TRUE) # set the dot.jitter thanks to runif and dot.jitter range. Then, send the coord of the boxes into the coord data.frame of the dots (in the column x.y)
+ if(length(categ)== 1L){
+ tempo.data1 <- unique(data.frame(data1[categ[1]], group = as.integer(data1[, categ[1]]), stringsAsFactors = TRUE)) # categ[1] is factor
+ names(tempo.data1)[names(tempo.data1) == categ[1]] <- paste0(categ[1], ".check")
+ verif <- paste0(categ[1], ".check")
+ }else if(length(categ) == 2L){
+ tempo.data1 <- unique(
+ data.frame(
+ data1[c(categ[1], categ[2])],
+ group = as.integer(factor(paste0(
+ formatC(as.integer(data1[, categ[2]]), width = nchar(max(as.integer(data1[, categ[2]]), na.rm = TRUE)), flag = "0"), # convert factor into numeric with leading zero for proper ranking
+ ".",
+ formatC(as.integer(data1[, categ[1]]), width = nchar(max(as.integer(data1[, categ[1]]), na.rm = TRUE)), flag = "0")# convert factor into numeric with leading zero for proper ranking
+ )), stringsAsFactors = TRUE) # merge the 2 formatC() to create a new factor. The convertion to integer should recreate the correct group number
+ )
+ ) # categ[2] first if categ[2] is used to make the categories in ggplot and categ[1] is used to make the x-axis
+ names(tempo.data1)[names(tempo.data1) == categ[1]] <- paste0(categ[1], ".check")
+ names(tempo.data1)[names(tempo.data1) == categ[2]] <- paste0(categ[2], ".check")
+ verif <- c(paste0(categ[1], ".check"), paste0(categ[2], ".check"))
}else{
- if(all(dot.color == "same") & length(dot.color)== 1L){ # all() without na.rm -> ok because dot.color cannot be NA (tested above)
- dot.categ.class.order <- unlist(categ.class.order[length(categ)])
- data1[, dot.categ] <- factor(data1[, dot.categ], levels = dot.categ.class.order) # reorder the factor
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") THE dot.categ.class.order SETTING IS NULL AND dot.color IS \"same\". ORDER OF categ.class.order WILL BE APPLIED FOR LEGEND DISPLAY: ", paste(dot.categ.class.order, collapse = " "))
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }else{
- dot.categ.class.order <- sort(levels(data1[, dot.categ]))
- data1[, dot.categ] <- factor(data1[, dot.categ], levels = dot.categ.class.order) # reorder the factor
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") THE dot.categ.class.order SETTING IS NULL. ALPHABETICAL ORDER WILL BE APPLIED FOR LEGEND DISPLAY: ", paste(dot.categ.class.order, collapse = " "))
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nCODE INCONSISTENCY 3")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
- # dot.categ.class.order not NULL anymore (character string) if dot.categ is not NULL
- if(all(dot.color == "same") & length(dot.color)== 1L){ # all() without na.rm -> ok because dot.color cannot be NA (tested above)
- if( ! identical(ini.dot.categ, categ[length(categ)])){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nWHEN dot.color ARGUMENT IS \"same\", THE COLUMN NAME IN dot.categ ARGUMENT MUST BE IDENTICAL TO THE LAST COLUMN NAME IN categ ARGUMENT. HERE IT IS:\ndot.categ: ", paste(ini.dot.categ, collapse = " "), "\ncateg: ", paste(categ, collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else if( ! fun_comp_1d(unlist(categ.class.order[length(categ)]), dot.categ.class.order)$identical.content){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nWHEN dot.color ARGUMENT IS \"same\",\nLAST COMPARTMENT OF categ.class.order ARGUMENT AND dot.categ.class.order ARGUMENT CANNOT BE DIFFERENT:\nLAST COMPARTMENT OF categ.class.order: ", paste(unlist(categ.class.order[length(categ)]), collapse = " "), "\ndot.categ.class.order: ", paste(dot.categ.class.order, collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
+ dot.coord.rd3 <- merge(dot.coord.rd2, tempo.data1, by = intersect("group", "group"), sort = FALSE) # send the factors of data1 into coord. WARNING: I have replaced by = "group" by intersect("group", "group") because of an error due to wrong group group merging in dot.coord.rd3
+ if(nrow(dot.coord.rd3) != nrow(dot.coord) | ( ! fun_comp_2d(dot.coord.rd3[categ], dot.coord.rd3[verif])$identical.content)){
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nTHE merge() FUNCTION DID NOT RETURN A CORRECT dot.coord.rd3 DATA FRAME. CODE HAS TO BE MODIFIED")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
- for(i3 in 1:length(categ)){
- if(identical(categ[i3], ini.dot.categ) & ! identical(unlist(categ.class.order[i3]), dot.categ.class.order) & identical(sort(unlist(categ.class.order[i3])), sort(dot.categ.class.order))){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") THE dot.categ ARGUMENT SETTING IS PRESENT IN THE categ ARGUMENT SETTING, BUT ORDER OF THE CLASSES IS NOT THE SAME:\ncateg.class.order: ", paste(unlist(categ.class.order[i3]), collapse = " "), "\ndot.categ.class.order: ", paste(dot.categ.class.order, collapse = " "), "\nNOTE THAT ORDER OF categ.class.order IS THE ONE USED FOR THE AXIS REPRESENTATION")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
+ # end random dots
+ }
+ # tidy dots
+ # coordinates are recovered during plotting (see dot.coord.tidy1 below)
+ # end tidy dots
+ }
+ # end x coordinates management (for random plotting and for stat display)
+
+
+
+
+
+ # boxplot display before dot display if box.fill = TRUE
+ coord.names <- NULL
+ # creation of the data frame for (main box + legend) and data frame for means
+ if(box.notch == FALSE){
+ for(i3 in 1:length(categ)){
+ if(i3== 1L){
+ tempo.polygon <- data.frame(GROUPX = c(t(stat[, rep(categ[i3], 5)])), stringsAsFactors = TRUE)
+ }else{
+ tempo.polygon <- cbind(tempo.polygon, c(t(stat[, rep(categ[i3], 5)])), stringsAsFactors = TRUE)
}
- if(is.null(dot.legend.name)){
- dot.legend.name <- if(ini.dot.categ %in% categ[length(categ)]){dot.categ}else{ini.dot.categ} #
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") THE dot.legend.name SETTING IS NULL -> ", dot.legend.name, " WILL BE USED AS LEGEND TITLE OF DOTS")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ names(tempo.polygon) <- categ
+ tempo.polygon <- data.frame(X = c(t(stat[, c("X_BOX_INF", "X_BOX_SUP", "X_BOX_SUP", "X_BOX_INF", "X_BOX_INF")])), Y = c(t(stat[, c("BOX_INF", "BOX_INF", "BOX_SUP", "BOX_SUP", "BOX_INF")])), COLOR = c(t(stat[, c("COLOR", "COLOR", "COLOR", "COLOR", "COLOR")])), BOX = as.character(c(t(stat[, c("BOX", "BOX", "BOX", "BOX", "BOX")]))), tempo.polygon, stringsAsFactors = TRUE)
+ if( ! is.null(facet.categ)){
+ for(i4 in 1:length(facet.categ)){
+ tempo.polygon <- data.frame(tempo.polygon, c(t(stat[, c(facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4])])), stringsAsFactors = TRUE)
+ names(tempo.polygon)[length(names(tempo.polygon))] <- facet.categ[i4]
}
- # dot.legend.name not NULL anymore (character string)
- }else{
- if( ! is.null(dot.categ.class.order)){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") THE dot.categ.class.order ARGUMENT IS NOT NULL, BUT IS THE dot.categ ARGUMENT\n-> dot.categ.class.order NOT CONSIDERED AS NO LEGEND WILL BE DRAWN")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ }else{
+ for(i3 in 1:length(categ)){
+ if(i3== 1L){
+ tempo.polygon <- data.frame(GROUPX = c(t(stat[, rep(categ[i3], 11)])), stringsAsFactors = TRUE)
+ }else{
+ tempo.polygon <- cbind(tempo.polygon, c(t(stat[, rep(categ[i3], 11)])), stringsAsFactors = TRUE)
}
- # But dot.categ.class.order will be converted to NULL below (not now)
}
- # end optional legend of dot colors
- # check the nature of color
- # integer colors into gg_palette
- tempo.check.color <- fun_check(data = dot.color, class = "integer", double.as.integer.allowed = TRUE, na.contain = TRUE, fun.name = function.name)$problem
- if(tempo.check.color == FALSE){
- # convert integers into colors
- dot.color <- fun_gg_palette(max(dot.color, na.rm = TRUE))[dot.color]
+ names(tempo.polygon) <- categ
+ tempo.polygon <- data.frame(X = c(t(stat[, c("X_BOX_INF", "X_BOX_SUP", "X_BOX_SUP", "X_NOTCH_SUP", "X_BOX_SUP", "X_BOX_SUP", "X_BOX_INF", "X_BOX_INF", "X_NOTCH_INF", "X_BOX_INF", "X_BOX_INF")])), Y = c(t(stat[, c("BOX_INF", "BOX_INF", "NOTCH_INF", "MEDIAN", "NOTCH_SUP", "BOX_SUP", "BOX_SUP", "NOTCH_SUP", "MEDIAN", "NOTCH_INF", "BOX_INF")])), COLOR = c(t(stat[, c("COLOR", "COLOR", "COLOR", "COLOR", "COLOR", "COLOR", "COLOR", "COLOR", "COLOR", "COLOR", "COLOR")])), BOX = as.character(c(t(stat[, c("BOX", "BOX", "BOX", "BOX", "BOX", "BOX", "BOX", "BOX", "BOX", "BOX", "BOX")]))), tempo.polygon, stringsAsFactors = TRUE)
+ if( ! is.null(facet.categ)){
+ for(i4 in 1:length(facet.categ)){
+ tempo.polygon <- data.frame(tempo.polygon, c(t(stat[, c(facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4])])), stringsAsFactors = TRUE)
+ names(tempo.polygon)[length(names(tempo.polygon))] <- facet.categ[i4]
+ }
}
- # end integer colors into gg_palette
- if(all(dot.color == "same") & length(dot.color)== 1L){# all() without na.rm -> ok because dot.color cannot be NA (tested above)
- dot.color <- categ.color # same color of the dots as the corresponding box color
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") dot.color ARGUMENT HAS BEEN SET TO \"same\"\nTHUS, DOTS WILL HAVE THE SAME COLORS AS THE CORRESPONDING BOXPLOT")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }else if( ! (all(dot.color %in% colors() | grepl(pattern = "^#", dot.color)))){ # check that all strings of low.color start by #, # all() without na.rm -> ok because dot.color cannot be NA (tested above)
- tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.color ARGUMENT MUST BE (1) A HEXADECIMAL COLOR VECTOR STARTING BY #, OR (2) COLOR NAMES GIVEN BY colors(), OR (3) INTEGERS, OR THE STRING \"same\"\nHERE IT IS: ", paste(unique(dot.color), collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- if(any(is.na(dot.color))){ # normally no NA with is.finite
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") dot.color ARGUMENT CONTAINS NA")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- # end check the nature of color
- # check the length of color
- if( ! is.null(dot.categ)){
- # optional legend of dot colors
- if(length(data1[, dot.categ]) == length(levels(data1[, dot.categ])) & length(dot.color) == length(data1[, dot.categ])){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") THE NUMBER OF CLASSES OF THE COLUMN ", dot.categ, " THE NUMBER OF ROWS OF THIS COLUMN AND THE NUMBER OF COLORS OF THE dot.color ARGUMENT ARE ALL EQUAL. DOT COLORS WILL BE ATTRIBUTED ACCORDING THE LEVELS OF ", dot.categ, ", NOT ACCORDING TO THE ROWS OF ", dot.categ)
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- if(length(dot.color) > 1 & ! (length(dot.color) == length(unique(data1[, dot.categ])) | length(dot.color) == length(data1[, dot.categ]))){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nWHEN LENGTH OF THE dot.color ARGUMENT IS MORE THAN 1, IT MUST BE EQUAL TO THE NUMBER OF 1) ROWS OR 2) LEVELS OF dot.categ COLUMN (", dot.categ, "):\ndot.color: ", paste(dot.color, collapse = " "), "\ndot.categ LEVELS: ", paste(levels(data1[, dot.categ]), collapse = " "))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else if(length(dot.color) > 1 & length(dot.color) == length(unique(data1[, dot.categ]))){
- data1 <- data.frame(data1, dot.color = data1[, dot.categ], stringsAsFactors = TRUE)
- data1$dot.color <- factor(data1$dot.color, labels = dot.color) # do not use labels = unique(dot.color). Otherwise, we can have green1 green2 when dot.color is c("green", "green")
- }else if(length(dot.color) > 1 & length(dot.color) == length(data1[, dot.categ])){
- data1 <- data.frame(data1, dot.color = dot.color, stringsAsFactors = TRUE)
- }else if(length(dot.color)== 1L){ # to deal with single color. Warning: & length(dot.categ.class.order) > 1 removed because otherwise, the data1 is not with dot.color column when length(dot.categ.class.order) == 1
- data1 <- data.frame(data1, dot.color = dot.color, stringsAsFactors = TRUE)
- }
- dot.color <- as.character(unique(data1$dot.color[order(data1[, dot.categ])])) # reorder the dot.color character vector
- if(length(dot.color)== 1L & length(dot.categ.class.order) > 1){ # to deal with single color
- dot.color <- rep(dot.color, length(dot.categ.class.order))
- }
- tempo.check <- unique(data1[ , c(dot.categ, "dot.color")])
- if(length(unique(data1[ , "dot.color"])) > 1 & ( ! (nrow(tempo.check) == length(unique(data1[ , "dot.color"])) & nrow(tempo.check) == length(unique(data1[ , dot.categ]))))){ # length(unique(data1[ , "dot.color"])) > 1 because if only one color, can be attributed to each class of dot.categ
- tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.color ARGUMENT IS INCORRECTLY ASSOCIATED TO EACH CLASS OF dot.categ (", dot.categ, ") COLUMN:\n", paste(unique(mapply(FUN = "paste", data1[ , dot.categ], data1[ ,"dot.color"])), collapse = "\n"))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else{
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") IN dot.categ ARGUMENT (", ini.dot.categ, "), THE FOLLOWING COLORS OF DOTS:\n", paste(dot.color, collapse = " "), "\nHAVE BEEN ATTRIBUTED TO THESE CLASSES:\n", paste(levels(data1[, dot.categ]), collapse = " "))
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- # dot.color is a character string representing the diff classes of dot.categ
- # data1$dot.color is a factor with order of levels -> dot.categ
- # end optional legend of dot colors
- }else{
- categ.len <- length(categ) # if only categ1, then colors for classes of categ1, if length(categ) == 2L, then colors for classes of categ2
- if(length(dot.color) == length(levels(data1[, categ[categ.len]]))){ # here length(dot.color) is equal to the different number of categ
- # data1[, categ[categ.len]] <- factor(data1[, categ[categ.len]]) # not required because sure that is is a factor
- data1 <- data.frame(data1, dot.color = data1[, categ[categ.len]], stringsAsFactors = TRUE)
- data1$dot.color <- factor(data1$dot.color, labels = dot.color)
- if(box.alpha != 0){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") IN ", categ[categ.len], " OF categ ARGUMENT, THE FOLLOWING COLORS:\n", paste(dot.color, collapse = " "), "\nHAVE BEEN ATTRIBUTED TO THESE CLASSES:\n", paste(levels(factor(data1[, categ[categ.len]])), collapse = " "))
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- }else if(length(dot.color) == length(data1[, categ[categ.len]])){# here length(dot.color) is equal to nrow(data1) -> Modif to have length(dot.color) equal to the different number of categ (length(dot.color) == length(levels(data1[, categ[categ.len]])))
- data1 <- data.frame(data1, dot.color = dot.color, stringsAsFactors = TRUE)
- }else if(length(dot.color)== 1L & ! all(dot.color == "same")){ # all() without na.rm -> ok because dot.color cannot be NA (tested above)
- # data1[, categ[categ.len]] <- factor(data1[, categ[categ.len]]) # not required because sure that is is a factor
- data1 <- data.frame(data1, dot.color = dot.color, stringsAsFactors = TRUE)
- dot.color <- rep(dot.color, length(levels(data1[, categ[categ.len]])))
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") dot.color ARGUMENT HAS LENGTH 1, MEANING THAT ALL THE DIFFERENT CLASSES OF ", categ[categ.len], "\n", paste(levels(factor(data1[, categ[categ.len]])), collapse = " "), "\nWILL HAVE THE SAME COLOR\n", paste(dot.color, collapse = " "))
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }else{
- tempo.cat <- paste0("ERROR IN ", function.name, "\ndot.color ARGUMENT MUST BE (1) LENGTH 1, OR (2) THE LENGTH OF data1 NROWS AFTER NA/Inf REMOVAL, OR (3) THE LENGTH OF THE CLASSES IN THE categ ", categ[categ.len], " COLUMN. HERE IT IS COLOR LENGTH ", length(dot.color), " VERSUS CATEG LENGTH ", length(data1[, categ[categ.len]]), " AND CATEG CLASS LENGTH ", length(unique(data1[, categ[categ.len]])), "\nPRESENCE OF NA/Inf COULD BE THE PROBLEM")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- # end check the length of color
- dot.color <- as.character(dot.color)
- # dot.color is a character string representing the diff classes
- data1$dot.color <- factor(data1$dot.color, levels = unique(dot.color)) # ok because if dot.color is a character string, the order make class 1, class 2, etc. If dot.color is a column of data1, then levels will be created, without incidence, except if dot.categ specified (see below). unique() because no duplicates allowed
- # data1$dot.color is a factor with order of levels -> dot.color
- }
- # end optional legend of dot colors
- }else if(is.null(dot.color) & ! (is.null(dot.categ) & is.null(dot.categ.class.order) & is.null(dot.legend.name))){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") dot.categ OR dot.categ.class.order OR dot.legend.name ARGUMENT HAS BEEN SPECIFIED BUT dot.color ARGUMENT IS NULL (NO DOT PLOTTED)")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- # dot.color either NULL (no dot plotted) or character string (potentially representing the diff classes of dot.categ)
- # data1$dot.color is either NA or a factor (with order of levels -> depending on dot.categ or categ[length(categ)], or other
- if(is.null(dot.categ)){
- dot.categ.class.order <- NULL # because not used anyway
- }
- # dot.categ.class.order either NULL if dot.categ is NULL (no legend displayed) or character string (potentially representing the diff classes of dot.categ)
- # end management of dot.color
- if(is.null(dot.color) & box.fill == FALSE & dot.alpha <= 0.025){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") THE FOLLOWING ARGUMENTS WERE SET AS:\ndot.color = NULL (NOT ALL DOTS BUT ONLY POTENTIAL OUTLIER DOTS DISPLAYED)\nbox.fill = FALSE (NO FILLING COLOR FOR BOTH BOXES AND POTENTIAL OUTLIER DOTS)\ndot.alpha = ", fun_round(dot.alpha, 4), "\n-> POTENTIAL OUTLIER DOTS MIGHT NOT BE VISIBLE BECAUSE ALMOST TRANSPARENT")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
}
- if(is.null(dot.color) & box.fill == FALSE & dot.border.size == 0){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE FOLLOWING ARGUMENTS WERE SET AS:\ndot.color = NULL (NOT ALL DOTS BUT ONLY POTENTIAL OUTLIER DOTS DISPLAYED)\nbox.fill = FALSE (NO FILLING COLOR FOR BOTH BOXES AND POTENTIAL OUTLIER DOTS)\ndot.border.size = 0 (NO BORDER FOR POTENTIAL OUTLIER DOTS)\n-> THESE SETTINGS ARE NOT ALLOWED BECAUSE THE POTENTIAL OUTLIER DOTS WILL NOT BE VISIBLE")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ tempo.polygon$COLOR <- factor(tempo.polygon$COLOR, levels = unique(categ.color))
+ if( ! is.null(categ.class.order)){
+ for(i3 in 1:length(categ)){
+ tempo.polygon[, categ[i3]] <- factor(tempo.polygon[, categ[i3]], levels = categ.class.order[[i3]])
+ }
}
- # integer dot.border.color into gg_palette
- if( ! is.null(dot.border.color)){
- tempo <- fun_check(data = dot.border.color, class = "vector", typeof = "integer", double.as.integer.allowed = TRUE, length = 1, fun.name = function.name)
- if(tempo$problem == FALSE){ # convert integers into colors
- dot.border.color <- fun_gg_palette(max(dot.border.color, na.rm = TRUE))[dot.border.color]
+ # modified name of dot.categ column (e.g., "Categ1_DOT") must be included for boxplot using ridy dots
+ if( ! is.null(dot.color) & ! is.null(dot.categ)){
+ if(dot.categ != ini.dot.categ){
+ tempo.polygon <- data.frame(tempo.polygon, GROUPX = tempo.polygon[, ini.dot.categ], stringsAsFactors = TRUE)
+ names(tempo.polygon)[names(tempo.polygon) == "GROUPX"] <- dot.categ
+
}
}
- # end integer dot.border.color into gg_palette
- # na detection and removal (done now to be sure of the correct length of categ)
- column.check <- c("categ.color", if( ! is.null(dot.color)){"dot.color"}) #
- if(any(is.na(data1[, column.check]))){ # data1 used here instead of data1.ini in case of new NaN created by log conversion (neg values) # normally no NA with is.na
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") NA DETECTED IN COLUMNS ", paste(column.check, collapse = " "), " OF data1 AND CORRESPONDING ROWS REMOVED (SEE $removed.row.nb AND $removed.rows)")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- for(i2 in 1:length(column.check)){
- if(any(is.na(data1[, column.check[i2]]))){ # normally no NA with is.na
- tempo.warn <- paste0("NA REMOVAL DUE TO COLUMN ", column.check[i2], " OF data1")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n", tempo.warn)))
- }
+ tempo.diamon.mean <- data.frame(X = c(t(stat[, c("X", "X_NOTCH_INF", "X", "X_NOTCH_SUP", "X")])), Y = c(t(cbind(stat["MEAN"] - (stat[, "X"] - stat[, "X_NOTCH_INF"]) * tempo.yx.ratio, stat["MEAN"], stat["MEAN"] + (stat[, "X"] - stat[, "X_NOTCH_INF"]) * tempo.yx.ratio, stat["MEAN"], stat["MEAN"] - (stat[, "X"] - stat[, "X_NOTCH_INF"]) * tempo.yx.ratio, stringsAsFactors = TRUE))), COLOR = c(t(stat[, c("COLOR", "COLOR", "COLOR", "COLOR", "COLOR")])), GROUP = c(t(stat[, c("BOX", "BOX", "BOX", "BOX", "BOX")])), stringsAsFactors = TRUE) # stringsAsFactors = TRUE for cbind() because stat["MEAN"] is a data frame. Otherwise, stringsAsFactors is not an argument for cbind() on vectors
+ if( ! is.null(facet.categ)){
+ for(i3 in 1:length(facet.categ)){
+ tempo.diamon.mean <- data.frame(tempo.diamon.mean, c(t(stat[, c(facet.categ[i3], facet.categ[i3], facet.categ[i3], facet.categ[i3], facet.categ[i3])])), stringsAsFactors = TRUE)
+ names(tempo.diamon.mean)[length(names(tempo.diamon.mean))] <- facet.categ[i3]
}
- tempo <- unique(unlist(lapply(lapply(c(data1[column.check]), FUN = is.na), FUN = which)))
- removed.row.nb <- c(removed.row.nb, tempo)
- removed.rows <- rbind(removed.rows, data1[tempo, ], stringsAsFactors = FALSE) # here data1 used because categorical columns tested
- if(length(tempo) != 0){
- data1 <- data1[-tempo, ] # WARNING tempo here and not removed.row.nb because the latter contain more numbers thant the former
- data1.ini <- data1.ini[-tempo, ] # WARNING tempo here and not removed.row.nb because the latter contain more numbers thant the former
- for(i3 in 1:length(column.check)){
- if(any( ! unique(removed.rows[, column.check[i3]]) %in% unique(data1[, column.check[i3]]), na.rm = TRUE)){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") IN COLUMN ", column.check[i3], " OF data1, THE FOLLOWING CLASSES HAVE DISAPPEARED AFTER NA/Inf REMOVAL (IF COLUMN USED IN THE PLOT, THIS CLASS WILL NOT BE DISPLAYED):\n", paste(unique(removed.rows[, column.check[i3]])[ ! unique(removed.rows[, column.check[i3]]) %in% unique(data1[, column.check[i3]])], collapse = " "))
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- }
- }
+ }
+ tempo.diamon.mean$COLOR <- factor(tempo.diamon.mean$COLOR, levels = unique(categ.color))
+ # end creation of the data frame for (main box + legend) and data frame for means
+ if(box.fill == TRUE){
+ # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_boxplot(data = data1, mapping = ggplot2::aes_string(x = categ[1], y = y, color = categ[length(categ)], fill = categ[length(categ)]), position = ggplot2::position_dodge(width = NULL), width = box.width, size = box.line.size, notch = box.notch, coef = if(box.whisker.kind == "no"){0}else if(box.whisker.kind == "std"){1.5}else if(box.whisker.kind == "max"){Inf}, alpha = box.alpha, outlier.shape = if( ! is.null(dot.color)){NA}else{21}, outlier.color = if( ! is.null(dot.color)){NA}else{dot.border.color}, outlier.fill = if( ! is.null(dot.color)){NA}else{NULL}, outlier.size = if( ! is.null(dot.color)){NA}else{dot.size}, outlier.stroke = if( ! is.null(dot.color)){NA}else{dot.border.size}, outlier.alpha = if( ! is.null(dot.color)){NA}else{dot.alpha})) # the color, size, etc. of the outliers are dealt here. outlier.color = NA to do not plot outliers when dots are already plotted. Finally, boxplot redrawn (see below)
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_polygon(
+ data = tempo.polygon,
+ mapping = ggplot2::aes_string(x = "X", y = "Y", group = "BOX", fill = categ[length(categ)], color = categ[length(categ)]),
+ size = box.line.size,
+ alpha = box.alpha # works only for fill, not for color
+ ))
+ coord.names <- c(coord.names, "main.box")
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = X, xend = X, y = BOX_SUP, yend = WHISK_SUP, group = categ[length(categ)]), color = "black", size = box.line.size, alpha = box.alpha)) #
+ coord.names <- c(coord.names, "sup.whisker")
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = X, xend = X, y = BOX_INF, yend = WHISK_INF, group = categ[length(categ)]), color = "black", size = box.line.size, alpha = box.alpha)) #
+ coord.names <- c(coord.names, "inf.whisker")
+ if(box.whisker.width > 0){
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = X_WHISK_INF, xend = X_WHISK_SUP, y = WHISK_SUP, yend = WHISK_SUP, group = categ[length(categ)]), color = "black", size = box.line.size, alpha = box.alpha, lineend = "round")) #
+ coord.names <- c(coord.names, "sup.whisker.edge")
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = X_WHISK_INF, xend = X_WHISK_SUP, y = WHISK_INF, yend = WHISK_INF, group = categ[length(categ)]), color = "black", size = box.line.size, alpha = box.alpha, lineend = "round")) #
+ coord.names <- c(coord.names, "inf.whisker.edge")
}
- for(i2 in 1:length(column.check)){
- if(column.check[i2] == "categ.color"){
- categ.color <- levels(data1[, column.check[i2]])[levels(data1[, column.check[i2]]) %in% unique(data1[, column.check[i2]])] # remove the absent color in the character vector
- if(length(categ.color)== 1L & length(unlist(categ.class.order[length(categ)])) > 1){ # to deal with single color
- categ.color <- rep(categ.color, length(unlist(categ.class.order[length(categ)])))
- }
- data1[, column.check[i2]] <- factor(as.character(data1[, column.check[i2]]), levels = unique(categ.color))
- }
- if(column.check[i2] == "dot.color"){
- dot.color <- levels(data1[, column.check[i2]])[levels(data1[, column.check[i2]]) %in% unique(data1[, column.check[i2]])] # remove the absent color in the character vector
- if(length(dot.color)== 1L & length(dot.categ.class.order) > 1){ # to deal with single color. If dot.categ.class.order == NULL (which is systematically the case if dot.categ == NULL), no rep(dot.color, length(dot.categ.class.order)
- dot.color <- rep(dot.color, length(dot.categ.class.order))
- }
- data1[, column.check[i2]] <- factor(as.character(data1[, column.check[i2]]), levels = unique(dot.color))
- }
+ if(box.mean == TRUE){
+ # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_point(data = stat, mapping = ggplot2::aes_string(x = "X", y = "MEAN", group = categ[length(categ)]), shape = 23, stroke = box.line.size * 2, fill = stat$COLOR, size = box.mean.size, color = "black", alpha = box.alpha)) # group used in aesthetic to do not have it in the legend
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_polygon(
+ data = tempo.diamon.mean,
+ mapping = ggplot2::aes(x = X, y = Y, group = GROUP),
+ fill = tempo.diamon.mean[, "COLOR"],
+ color = hsv(0, 0, 0, alpha = box.alpha), # outline of the polygon in black but with alpha
+ size = box.line.size,
+ alpha = box.alpha
+ ))
+ coord.names <- c(coord.names, "mean")
}
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = if(box.notch == FALSE){X_BOX_INF}else{X_NOTCH_INF}, xend = if(box.notch == FALSE){X_BOX_SUP}else{X_NOTCH_SUP}, y = MEDIAN, yend = MEDIAN, group = categ[length(categ)]), color = "black", size = box.line.size * 2, alpha = box.alpha)) #
+ coord.names <- c(coord.names, "median")
}
- # end na detection and removal (done now to be sure of the correct length of categ)
- # From here, data1 and data.ini have no more NA or NaN
- # end other checkings
- # reserved word checking
- #already done above
- # end reserved word checking
- # end second round of checking and data preparation
-
+ # end boxplot display before dot display if box.fill = TRUE
- # package checking
- fun_pack(req.package = c(
- "ggplot2",
- "gridExtra",
- "lemon",
- "scales"
- ), lib.path = lib.path)
- # end package checking
- # main code
- # y coordinates recovery (create ini.box.coord, dot.coord and modify data1)
- if(length(categ)== 1L){
- # width commputations
- box.width2 <- box.width
- box.space <- 0 # to inactivate the shrink that add space between grouped boxes, because no grouped boxes here
- # end width commputations
- # data1 check categ order for dots coordinates recovery
- data1 <- data.frame(data1, categ.check = data1[, categ[1]], stringsAsFactors = TRUE)
- data1$categ.check <- as.integer(data1$categ.check) # to check that data1[, categ[1]] and dot.coord$group are similar, during merging
- # end data1 check categ order for dots coordinates recovery
- # per box dots coordinates recovery
- tempo.gg.name <- "gg.indiv.plot."
- tempo.gg.count <- 0
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), eval(parse(text = paste0("ggplot2::ggplot()", if(is.null(add)){""}else{add})))) # add added here to have the facets
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_point(data = data1, mapping = ggplot2::aes_string(x = categ[1], y = y, color = categ[1]), stroke = dot.border.size, size = dot.size, alpha = dot.alpha, shape = 21))
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "color", name = box.legend.name, values = if(is.null(categ.color)){rep(NA, length(unique(data1[, categ[1]])))}else if(length(categ.color)== 1L){rep(categ.color, length(unique(data1[, categ[1]])))}else{categ.color})) # categ.color used for dot colors because at that stage, we do not care about colors
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_boxplot(data = data1, mapping = ggplot2::aes_string(x = categ[1], y = y, fill = categ[1]), coef = if(box.whisker.kind == "no"){0}else if(box.whisker.kind == "std"){1.5}else if(box.whisker.kind == "max"){Inf})) # fill because this is what is used with geom_box # to easily have the equivalent of the grouped boxes
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "fill", name = box.legend.name, values = if(length(categ.color)== 1L){rep(categ.color, length(unique(data1[, categ[1]])))}else{categ.color}))
- # end per box dots coordinates recovery
- }else if(length(categ) == 2L){
- # width commputations
- box.width2 <- box.width / length(unique(data1[, categ[length(categ)]])) # real width of each box in x-axis unit, among the set of grouped box. Not relevant if no grouped boxes length(categ)== 1L
- # end width commputations
- # data1 check categ order for dots coordinates recovery
- tempo.factor <- paste0(data1[order(data1[, categ[2]], data1[, categ[1]]), categ[2]], "_", data1[order(data1[, categ[2]], data1[, categ[1]]), categ[1]])
- data1 <- data.frame(data1[order(data1[, categ[2]], data1[, categ[1]]), ], categ.check = factor(tempo.factor, levels = unique(tempo.factor)), stringsAsFactors = TRUE)
- data1$categ.check <- as.integer(data1$categ.check)
- # end data1 check categ order for dots coordinates recovery
- # per box dots coordinates recovery
- tempo.gg.name <- "gg.indiv.plot."
- tempo.gg.count <- 0
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), eval(parse(text = paste0("ggplot2::ggplot()", if(is.null(add)){""}else{add})))) # add added here to have the facets
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_point(data = data1, mapping = ggplot2::aes_string(x = categ[1], y = y, color = categ[2]), stroke = dot.border.size, size = dot.size, alpha = dot.alpha, shape = 21))
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "color", name = box.legend.name, values = if(is.null(categ.color)){rep(NA, length(unique(data1[, categ[2]])))}else if(length(categ.color)== 1L){rep(categ.color, length(unique(data1[, categ[2]])))}else{categ.color})) # categ.color used for dot colors because at that stage, we do not care about colors
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_boxplot(data = data1, mapping = ggplot2::aes_string(x = categ[1], y = y, fill = categ[2]), coef = if(box.whisker.kind == "no"){0}else if(box.whisker.kind == "std"){1.5}else if(box.whisker.kind == "max"){Inf})) # fill because this is what is used with geom_box # to easily have the equivalent of the grouped boxes
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "fill", name = box.legend.name, values = if(length(categ.color)== 1L){rep(categ.color, length(unique(data1[, categ[2]])))}else{categ.color}))
- # end per box dots coordinates recovery
- }else{
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nCODE INCONSISTENCY 1")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- if( ! is.null(stat.pos)){
- stat.just <- fun_gg_just(
- angle = stat.angle,
- pos = ifelse(
- vertical == TRUE,
- ifelse(stat.pos == "top", "bottom", "top"), # "bottom" because we want justification for text that are below the ref point which is the top of the graph. The opposite for "above"
- ifelse(stat.pos == "top", "left", "right") # "left" because we want justification for text that are on the left of the ref point which is the right border of the graph. The opposite for "above"
- ),
- kind = "text"
- )
- }
- # has in fact no interest because ggplot2 does not create room for geom_text()
- tempo.data.max <- data1[which.max(data1[, y]), ]
- tempo.data.max <- data.frame(tempo.data.max, label = formatC(tempo.data.max[, y], digit = 2, drop0trailing = TRUE, format = "f"), stringsAsFactors = TRUE)
- # end has in fact no interest because ggplot2 does not create room for geom_text()
- tempo.graph.info.ini <- ggplot2::ggplot_build(eval(parse(text = paste(paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "), if( ! is.null(stat.pos)){' + ggplot2::geom_text(data = tempo.data.max, mapping = ggplot2::aes_string(x = 1, y = y, label = "label"), size = stat.size, color = "black", angle = stat.angle, hjust = stat.just$hjust, vjust = stat.just$vjust)'})))) # added here to have room for annotation
- dot.coord <- tempo.graph.info.ini$data[[1]]
- dot.coord$x <- as.numeric(dot.coord$x) # because weird class
- dot.coord$PANEL <- as.numeric(dot.coord$PANEL) # because numbers as levels. But may be a problem is facet are reordered ?
- tempo.mean <- aggregate(x = dot.coord$y, by = list(dot.coord$group, dot.coord$PANEL), FUN = mean, na.rm = TRUE)
- names(tempo.mean)[names(tempo.mean) == "x"] <- "MEAN"
- names(tempo.mean)[names(tempo.mean) == "Group.1"] <- "BOX"
- names(tempo.mean)[names(tempo.mean) == "Group.2"] <- "PANEL"
- dot.coord <- data.frame(
- dot.coord[order(dot.coord$group, dot.coord$y), ], # dot.coord$PANEL deals below
- y.check = as.double(data1[order(data1$categ.check, data1[, y]), y]),
- categ.check = data1[order(data1$categ.check, data1[, y]), "categ.check"],
- dot.color = if(is.null(dot.color)){NA}else{data1[order(data1$categ.check, data1[, y]), "dot.color"]},
- data1[order(data1$categ.check, data1[, y]), ][categ], # avoid the renaming below
- stringsAsFactors = TRUE
- ) # y.check to be sure that the order is the same between the y of data1 and the y of dot.coord
- # names(dot.coord)[names(dot.coord) == "tempo.categ1"] <- categ[1]
- if( ! is.null(dot.categ)){
- dot.coord <- data.frame(dot.coord, data1[order(data1$categ.check, data1[, y]), ][dot.categ], stringsAsFactors = TRUE) # avoid the renaming
- }
- if( ! is.null(facet.categ)){
- dot.coord <- data.frame(dot.coord, data1[order(data1$categ.check, data1[, y]), ][facet.categ], stringsAsFactors = TRUE) # for facet panels
- tempo.test <- NULL
- for(i2 in 1:length(facet.categ)){
- tempo.test <- paste0(tempo.test, ".", formatC(as.numeric(dot.coord[, facet.categ[i2]]), width = nchar(max(as.numeric(dot.coord[, facet.categ[i2]]), na.rm = TRUE)), flag = "0")) # convert factor into numeric with leading zero for proper ranking # merge the formatC() to create a new factor. The convertion to integer should recreate the correct group number. Here as.numeric is used and not as.integer in case of numeric in facet.categ (because comes from add and not checked by fun_check, contrary to categ)
- }
- tempo.test <- as.integer(factor(tempo.test))
- if( ! identical(as.integer(dot.coord$PANEL), tempo.test)){
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nas.integer(dot.coord$PANEL) AND tempo.test MUST BE IDENTICAL. CODE HAS TO BE MODIFIED")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- }
- if(dot.tidy == TRUE){
- if( ! is.null(dot.categ)){
- dot.coord <- data.frame(dot.coord, tidy_group = data1[order(data1$categ.check, data1[, y]), ][, dot.categ], stringsAsFactors = TRUE) # avoid the renaming
- # tidy_group_coord is to be able to fuse table when creating the table for dot coordinates
- if(dot.categ %in% categ){
- dot.coord <- data.frame(dot.coord, tidy_group_coord = dot.coord$group, stringsAsFactors = TRUE)
+ # dot display
+ if( ! is.null(dot.color)){
+ if(dot.tidy == FALSE){
+ if(is.null(dot.categ)){
+ if(dot.border.size == 0){
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_point(
+ data = dot.coord.rd3,
+ mapping = ggplot2::aes_string(x = "dot.x", y = "y", group = categ[length(categ)]),
+ size = dot.size,
+ shape = 19,
+ color = dot.coord.rd3$dot.color,
+ alpha = dot.alpha
+ )) # group used in aesthetic to do not have it in the legend. Here ggplot2::scale_discrete_manual() cannot be used because of the group easthetic
+ }else{
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_point(
+ data = dot.coord.rd3,
+ mapping = ggplot2::aes_string(x = "dot.x", y = "y", group = categ[length(categ)]),
+ shape = 21,
+ stroke = dot.border.size,
+ color = if(is.null(dot.border.color)){dot.coord.rd3$dot.color}else{rep(dot.border.color, nrow(dot.coord.rd3))},
+ size = dot.size,
+ fill = dot.coord.rd3$dot.color,
+ alpha = dot.alpha
+ )) # group used in aesthetic to do not have it in the legend. Here ggplot2::scale_discrete_manual() cannot be used because of the group easthetic
+ }
}else{
- dot.coord <- data.frame(dot.coord, tidy_group_coord = as.integer(factor(paste0(
- formatC(as.integer(dot.coord[, categ[1]]), width = nchar(max(as.integer(dot.coord[, categ[1]]), na.rm = TRUE)), flag = "0"), # convert factor into numeric with leading zero for proper ranking
- ".",
- if(length(categ) == 2L){formatC(as.integer(dot.coord[, categ[2]]), width = nchar(max(as.integer(dot.coord[, categ[2]]), na.rm = TRUE)), flag = "0")}, # convert factor into numeric with leading zero for proper ranking
- if(length(categ) == 2L){"."},
- formatC(as.integer(dot.coord[, dot.categ]), width = nchar(max(as.integer(dot.coord[, dot.categ]), na.rm = TRUE)), flag = "0") # convert factor into numeric with leading zero for proper ranking
- )), stringsAsFactors = TRUE) # merge the 2 or 3 formatC() to create a new factor. The convertion to integer should recreate the correct group number
- ) # for tidy dot plots
+ if(dot.border.size == 0){
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_point(
+ data = dot.coord.rd3,
+ mapping = ggplot2::aes_string(x = "dot.x", y = "y", alpha = dot.categ),
+ size = dot.size,
+ shape = 19,
+ color = dot.coord.rd3$dot.color
+ )) # group used in aesthetic to do not have it in the legend. Here ggplot2::scale_discrete_manual() cannot be used because of the group easthetic
+ }else{
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_point(
+ data = dot.coord.rd3,
+ mapping = ggplot2::aes_string(x = "dot.x", y = "y", alpha = dot.categ),
+ size = dot.size,
+ shape = 21,
+ stroke = dot.border.size,
+ color = if(is.null(dot.border.color)){dot.coord.rd3$dot.color}else{rep(dot.border.color, nrow(dot.coord.rd3))},
+ fill = dot.coord.rd3$dot.color
+ )) # group used in aesthetic to do not have it in the legend. Here ggplot2::scale_discrete_manual() cannot be used because of the group easthetic
+ }
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "alpha", name = dot.legend.name, values = rep(dot.alpha, length(dot.categ.class.order)), guide = ggplot2::guide_legend(override.aes = list(fill = dot.color, color = if(is.null(dot.border.color)){dot.color}else{dot.border.color}, stroke = dot.border.size, alpha = dot.alpha)))) # values are the values of color (which is the border color in geom_box. WARNING: values = categ.color takes the numbers to make the colors if categ.color is a factor
}
- }else{
- dot.coord <- data.frame(dot.coord, tidy_group = if(length(categ)== 1L){
- dot.coord[, categ]}else{as.integer(factor(paste0(
- formatC(as.integer(dot.coord[, categ[1]]), width = nchar(max(as.integer(dot.coord[, categ[1]]), na.rm = TRUE)), flag = "0"), # convert factor into numeric with leading zero for proper ranking
- ".",
- formatC(as.integer(dot.coord[, categ[2]]), width = nchar(max(as.integer(dot.coord[, categ[2]]), na.rm = TRUE)), flag = "0")# convert factor into numeric with leading zero for proper ranking
- )), stringsAsFactors = TRUE) # merge the 2 formatC() to create a new factor. The convertion to integer should recreate the correct group number
- }) # for tidy dot plots
- # tidy_group_coord is to be able to fuse table when creating the table for dot coordinates
- dot.coord <- data.frame(dot.coord, tidy_group_coord = dot.coord$group, stringsAsFactors = TRUE)
+ coord.names <- c(coord.names, "dots")
+ }else if(dot.tidy == TRUE){
+ # here plot using group -> no scale
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_dotplot(
+ data = dot.coord,
+ mapping = ggplot2::aes_string(x = categ[1], y = "y", group = "group"), # not dot.categ here because the classes of dot.categ create new separations
+ position = ggplot2::position_dodge(width = box.width),
+ binpositions = "all",
+ binaxis = "y",
+ stackdir = "center",
+ alpha = dot.alpha,
+ fill = dot.coord$dot.color,
+ stroke = dot.border.size,
+ color = if(is.null(dot.border.color)){dot.coord$dot.color}else{rep(dot.border.color, nrow(dot.coord))},
+ show.legend = FALSE, # WARNING: do not use show.legend = TRUE because it uses the arguments outside aes() as aesthetics (here color and fill). Thus I must find a way using ggplot2::scale_discrete_manual()
+ binwidth = (y.lim[2] - y.lim[1]) / dot.tidy.bin.nb
+ )) # geom_dotplot ggplot2 v3.3.0: I had to remove rev() in fill and color # very weird behavior of geom_dotplot ggplot2 v3.2.1, (1) because with aes group = (to avoid legend), the dot plotting is not good in term of coordinates, and (2) because data1 seems reorderer according to x = categ[1] before plotting. Thus, I have to use fill = dot.coord[rev(order(dot.coord[, categ[1]], decreasing = TRUE)), "dot.color"] to have the good corresponding colors # show.legend option do not remove the legend, only the aesthetic of the legend (dot, line, etc.)
+ coord.names <- c(coord.names, "dots")
+ if( ! is.null(dot.categ)){
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_dotplot(
+ data = dot.coord,
+ mapping = ggplot2::aes_string(x = categ[1], y = "y", alpha = dot.categ), # not dot.categ here because the classes of dot.categ create new separations
+ position = ggplot2::position_dodge(width = box.width),
+ binpositions = "all",
+ binaxis = "y",
+ stackdir = "center",
+ fill = NA,
+ stroke = NA,
+ color = NA,
+ # WARNING: do not use show.legend = TRUE because it uses the arguments outside aes() as aesthetics (here color and fill). Thus I must find a way using ggplot2::scale_discrete_manual()
+ binwidth = (y.lim[2] - y.lim[1]) / dot.tidy.bin.nb
+ )) # geom_dotplot ggplot2 v3.3.0: I had to remove rev() in fill and color # very weird behavior of geom_dotplot ggplot2 v3.2.1, (1) because with aes group = (to avoid legend), the dot plotting is not good in term of coordinates, and (2) because data1 seems reorderer according to x = categ[1] before plotting. Thus, I have to use fill = dot.coord[rev(order(dot.coord[, categ[1]], decreasing = TRUE)), "dot.color"] to have the good corresponding colors # show.legend option do not remove the legend, only the aesthetic of the legend (dot, line, etc.)
+ # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "linetype", name = dot.legend.name, values = rep(1, length(categ.color)))) # values = rep("black", length(categ.color)) are the values of color (which is the border color of dots), and this modify the border color on the plot. WARNING: values = categ.color takes the numbers to make the colors if categ.color is a factor
+ coord.names <- c(coord.names, "bad_remove")
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "alpha", name = dot.legend.name, values = rep(dot.alpha, length(dot.categ.class.order)), labels = dot.categ.class.order, guide = ggplot2::guide_legend(title = if(ini.dot.categ == categ[length(categ)]){dot.categ}else{ini.dot.categ}, override.aes = list(fill = levels(dot.coord$dot.color), color = if(is.null(dot.border.color)){levels(dot.coord$dot.color)}else{dot.border.color}, stroke = dot.border.size, alpha = dot.alpha)))) # values are the values of color (which is the border color in geom_box. WARNING: values = categ.color takes the numbers to make the colors if categ.color is a factor
+ }
+ # coordinates of tidy dots
+ tempo.coord <- ggplot2::ggplot_build(eval(parse(text = paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "))))$data # to have the tidy dot coordinates
+ if(length(which(sapply(X = tempo.coord, FUN = function(X){any(names(X) == "binwidth", na.rm = TRUE)}))) != 1){ # detect the compartment of tempo.coord which is the binned data frame
+ # if(length(which(sapply(tempo.coord, FUN = nrow) == nrow(data1))) > if(is.null(dot.categ)){1}else{2}){ # this does not work if only one dot per class, thus replaced by above # if(is.null(dot.categ)){1}else{2} because 1 dotplot if dot.categ is NULL and 2 dotplots if not, with the second being a blank dotplot with wrong coordinates. Thus take the first in that situation
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nEITHER MORE THAN 1 OR NO COMPARTMENT HAVING A DATA FRAME WITH binwidth AS COLUMN NAME IN THE tempo.coord LIST (FOR TIDY DOT COORDINATES). CODE HAS TO BE MODIFIED")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else{
+ # dot.coord.tidy1 <- tempo.coord[[which(sapply(tempo.coord, FUN = nrow) == nrow(data1))[1]]] # this does not work if only one dot per class, thus replaced by above # the second being a blank dotplot with wrong coordinates. Thus take the first whatever situation
+ dot.coord.tidy1 <- tempo.coord[[which(sapply(X = tempo.coord, FUN = function(X){any(names(X) == "binwidth", na.rm = TRUE)}))]] # detect the compartment of tempo.coord which is the binned data frame
+ dot.coord.tidy1$x <- as.numeric(dot.coord.tidy1$x) # because weird class
+ dot.coord.tidy1$PANEL <- as.numeric(dot.coord.tidy1$PANEL) # because numbers as levels. But may be a problem is facet are reordered ?
+ }
+ # tempo.box.coord <- merge(box.coord, unique(dot.coord[, c("PANEL", "group", categ)]), by = c("PANEL", "group"), sort = FALSE) # not required anymore because box.coord already contains categ do not add dot.categ and tidy_group_coord here because the coordinates are for stats. Add the categ in box.coord. WARNING: by = c("PANEL", "group") without fill column because PANEL & group columns are enough as only one value of x column per group number in box.coord. Thus, no need to consider fill column
+ # below inactivated because not true when dealing with dot.categ different from categ
+ # if(nrow(tempo.box.coord) != nrow(box.coord)){
+ # tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nTHE merge() FUNCTION DID NOT RETURN A CORRECT tempo.box.coord DATA FRAME. CODE HAS TO BE MODIFIED")
+ # stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
+ # }
+ dot.coord.tidy2 <- merge(dot.coord.tidy1, box.coord[c("fill", "PANEL", "group", "x", categ)], by = c("PANEL", "group"), sort = FALSE) # send the coord of the boxes into the coord data.frame of the dots (in the column x.y).WARNING: by = c("PANEL", "group") without fill column because PANEL & group columns are enough as only one value of x column per group number in tempo.box.coord. Thus, no need to consider fill colum # DANGER: from here the fill.y and x.y (from tempo.box.coord) are not good in dot.coord.tidy2. It is ok because Categ1 Categ2 from tempo.box.coord are ok with the group column from dot.coord.tidy1. This is due to the fact that dot.coord.tidy resulting from geom_dotplot does not make the same groups as the other functions
+ if(nrow(dot.coord.tidy2) != nrow(dot.coord)){
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nTHE merge() FUNCTION DID NOT RETURN A CORRECT dot.coord.tidy2 DATA FRAME. CODE HAS TO BE MODIFIED")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ # From here, check for dot.coord.tidy3 which wil be important for stat over the plot. WARNING: dot.categ has nothing to do here for stat coordinates. Thus, not in tempo.data1
+ if(length(categ)== 1L){
+ tempo.data1 <- unique(data.frame(data1[categ[1]], group = as.integer(data1[, categ[1]]), stringsAsFactors = TRUE)) # categ[1] is factor
+ names(tempo.data1)[names(tempo.data1) == categ[1]] <- paste0(categ[1], ".check")
+ verif <- paste0(categ[1], ".check")
+ }else if(length(categ) == 2L){
+ tempo.data1 <- unique(
+ data.frame(
+ data1[c(categ[1], categ[2])],
+ group = as.integer(factor(paste0(
+ formatC(as.integer(data1[, categ[2]]), width = nchar(max(as.integer(data1[, categ[2]]), na.rm = TRUE)), flag = "0"), # convert factor into numeric with leading zero for proper ranking
+ ".",
+ formatC(as.integer(data1[, categ[1]]), width = nchar(max(as.integer(data1[, categ[1]]), na.rm = TRUE)), flag = "0")# convert factor into numeric with leading zero for proper ranking
+ )), stringsAsFactors = TRUE) # merge the 2 formatC() to create a new factor. The convertion to integer should recreate the correct group number
+ )
+ ) # categ[2] first if categ[2] is used to make the categories in ggplot and categ[1] is used to make the x-axis
+ names(tempo.data1)[names(tempo.data1) == categ[1]] <- paste0(categ[1], ".check")
+ names(tempo.data1)[names(tempo.data1) == categ[2]] <- paste0(categ[2], ".check")
+ verif <- c(paste0(categ[1], ".check"), paste0(categ[2], ".check"))
+ }else{
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nCODE INCONSISTENCY 4")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ dot.coord.tidy3 <- merge(dot.coord.tidy2, tempo.data1, by = intersect("group", "group"), sort = FALSE) # send the factors of data1 into coord. WARNING: I have tested intersect("group", "group") instead of by = "group". May be come back to by = "group" in case of error. But I did this because of an error in dot.coord.rd3 above
+ if(nrow(dot.coord.tidy3) != nrow(dot.coord) | ( ! fun_comp_2d(dot.coord.tidy3[categ], dot.coord.tidy3[verif])$identical.content)){
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nTHE merge() FUNCTION DID NOT RETURN A CORRECT dot.coord.tidy3 DATA FRAME. CODE HAS TO BE MODIFIED")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ # end coordinates of tidy dots
}
}
- if( ! (identical(dot.coord$y, dot.coord$y.check) & identical(dot.coord$group, dot.coord$categ.check))){
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\n(dot.coord$y AND dot.coord$y.check) AS WELL AS (dot.coord$group AND dot.coord$categ.check) MUST BE IDENTICAL. CODE HAS TO BE MODIFIED")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ # end dot display
+
+
+
+ # boxplot display (if box.fill = FALSE, otherwise, already plotted above)
+ if(box.fill == TRUE){
+ # overcome "work only for the filling of boxes, not for the frame. See https://github.com/tidyverse/ggplot2/issues/252"
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "fill", name = box.legend.name, values = if(length(categ.color)== 1L){rep(categ.color, length(unique(data1[, categ[length(categ)]])))}else{categ.color}, guide = ggplot2::guide_legend(order = 1))) #, guide = ggplot2::guide_legend(override.aes = list(fill = levels(tempo.polygon$COLOR), color = "black")))) # values are the values of color (which is the border color in geom_box. WARNING: values = categ.color takes the numbers to make the colors if categ.color is a factor
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "color", name = box.legend.name, values = rep(hsv(0, 0, 0, alpha = box.alpha), length(unique(data1[, categ[length(categ)]]))), guide = ggplot2::guide_legend(order = 1))) # , guide = ggplot2::guide_legend(override.aes = list(color = "black", alpha = box.alpha)))) # values are the values of color (which is the border color in geom_box. WARNING: values = categ.color takes the numbers to make the colors if categ.color is a factor # outline of the polygon in black but with alpha
}else{
- if( ! identical(tempo.mean[order(tempo.mean$BOX, tempo.mean$PANEL), ]$BOX, unique(dot.coord[order(dot.coord$group, dot.coord$PANEL), c("group", "PANEL")])$group)){
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\n(tempo.mean$BOX, tempo.mean$PANEL) AND (dot.coord$group, dot.coord$PANEL) MUST BE IDENTICAL. CODE HAS TO BE MODIFIED")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else{
- tempo <- unique(dot.coord[order(dot.coord$group, dot.coord$PANEL), c(categ, if( ! is.null(dot.color) & ! is.null(dot.categ)){if(dot.categ != ini.dot.categ){dot.categ}}, if( ! is.null(facet.categ)){facet.categ}), drop = FALSE])
- # names(tempo) <- paste0(names(tempo), ".mean")
- tempo.mean <- data.frame(tempo.mean[order(tempo.mean$BOX, tempo.mean$PANEL), ], tempo, stringsAsFactors = TRUE)
- }
- }
- # at that stage, categ color and dot color are correctly attributed in data1, box.coord and dot.coord
- # end y dot coordinates recovery (create ini.box.coord, dot.coord and modify data1)
- # ylim range
- if(is.null(y.lim)){
- y.lim <- tempo.graph.info.ini$layout$panel_params[[1]]$y.range # finite = TRUE removes all the -Inf and Inf except if only this. In that case, whatever the -Inf and/or Inf present, output -Inf;Inf range. Idem with NA only
- if(any(( ! is.finite(y.lim)) | is.na(y.lim)) | length(y.lim) != 2){ # kept but normally no more Inf in data1 # normally no NA with is.finite, etc.
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\ntempo.graph.info.ini$layout$panel_params[[1]]$y.range[1] CONTAINS NA OR Inf OR HAS LENGTH 1")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_boxplot(data = data1, mapping = ggplot2::aes_string(x = categ[1], y = y, color = categ[length(categ)], fill = categ[length(categ)]), position = ggplot2::position_dodge(width = NULL), width = box.width, size = box.line.size, notch = box.notch, alpha = box.alpha, coef = if(box.whisker.kind == "no"){0}else if(box.whisker.kind == "std"){1.5}else if(box.whisker.kind == "max"){Inf}, outlier.shape = if( ! is.null(dot.color)){NA}else{21}, outlier.color = if( ! is.null(dot.color)){NA}else{if(dot.border.size == 0){NA}else{dot.border.color}}, outlier.fill = if( ! is.null(dot.color)){NA}else{NULL}, outlier.size = if( ! is.null(dot.color)){NA}else{dot.size}, outlier.stroke = if( ! is.null(dot.color)){NA}else{dot.border.size}, outlier.alpha = if( ! is.null(dot.color)){NA}else{dot.alpha})) # the color, size, etc. of the outliers are dealt here. outlier.color = NA to do not plot outliers when dots are already plotted
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_path(
+ data = tempo.polygon,
+ mapping = ggplot2::aes_string(x = "X", y = "Y", group = "BOX", color = categ[length(categ)]),
+ size = box.line.size,
+ alpha = box.alpha,
+ lineend = "round",
+ linejoin = "round"
+ ))
+ coord.names <- c(coord.names, "main.box")
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = if(box.notch == FALSE){X_BOX_INF}else{X_NOTCH_INF}, xend = if(box.notch == FALSE){X_BOX_SUP}else{X_NOTCH_SUP}, y = MEDIAN, yend = MEDIAN, group = categ[length(categ)]), color = stat$COLOR, size = box.line.size * 2, alpha = box.alpha)) #
+ coord.names <- c(coord.names, "median")
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = X, xend = X, y = BOX_SUP, yend = WHISK_SUP, group = categ[length(categ)]), color = stat$COLOR, size = box.line.size, alpha = box.alpha)) #
+ coord.names <- c(coord.names, "sup.whisker")
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = X, xend = X, y = BOX_INF, yend = WHISK_INF, group = categ[length(categ)]), color = stat$COLOR, size = box.line.size, alpha = box.alpha)) #
+ coord.names <- c(coord.names, "inf.whisker")
+ if(box.whisker.width > 0){
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = X_WHISK_INF, xend = X_WHISK_SUP, y = WHISK_SUP, yend = WHISK_SUP, group = categ[length(categ)]), color = stat$COLOR, size = box.line.size, alpha = box.alpha, lineend = "round")) #
+ coord.names <- c(coord.names, "sup.whisker.edge")
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = X_WHISK_INF, xend = X_WHISK_SUP, y = WHISK_INF, yend = WHISK_INF, group = categ[length(categ)]), color = stat$COLOR, size = box.line.size, alpha = box.alpha, lineend = "round")) #
+ coord.names <- c(coord.names, "inf.whisker.edge")
}
- }else if(y.log != "no"){
- y.lim <- get(y.log)(y.lim) # no env = sys.nframe(), inherit = FALSE in get() because look for function in the classical scope
- }
- if(y.log != "no"){
- # normally this control is not necessary anymore
- if(any( ! is.finite(y.lim))){ # normally no NA with is.finite
- tempo.cat <- paste0("ERROR IN ", function.name, "\ny.lim ARGUMENT CANNOT HAVE ZERO OR NEGATIVE VALUES WITH THE y.log ARGUMENT SET TO ", y.log, ":\n", paste(y.lim, collapse = " "), "\nPLEASE, CHECK DATA VALUES (PRESENCE OF ZERO OR INF VALUES)")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ if(box.mean == TRUE){
+ # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_point(data = stat, mapping = ggplot2::aes_string(x = "X", y = "MEAN", group = categ[length(categ)]), shape = 23, stroke = box.line.size * 2, color = stat$COLOR, size = box.mean.size, fill = NA, alpha = box.alpha)) # group used in aesthetic to do not have it in the legend. Here ggplot2::scale_discrete_manual() cannot be used because of the group easthetic
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_path(
+ data = tempo.diamon.mean,
+ mapping = ggplot2::aes(x = X, y = Y, group = GROUP),
+ color = tempo.diamon.mean[, "COLOR"],
+ size = box.line.size,
+ alpha = box.alpha,
+ lineend = "round",
+ linejoin = "round"
+ ))
+ coord.names <- c(coord.names, "mean")
+ }
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "fill", name = box.legend.name, values = rep(NA, length(unique(data1[, categ[length(categ)]]))))) #, guide = ggplot2::guide_legend(override.aes = list(color = categ.color)))) # values are the values of color (which is the border color in geom_box. WARNING: values = categ.color takes the numbers to make the colors if categ.color is a factor
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "color", name = box.legend.name, values = if(length(categ.color)== 1L){rep(categ.color, length(unique(data1[, categ[length(categ)]])))}else{categ.color}, guide = ggplot2::guide_legend(override.aes = list(alpha = if(plot == TRUE & ((length(dev.list()) > 0 & names(dev.cur()) == "windows") | (length(dev.list()) == 0L & Sys.info()["sysname"] == "Windows"))){1}else{box.alpha})))) # , guide = ggplot2::guide_legend(override.aes = list(color = as.character(categ.color))))) # values are the values of color (which is the border color in geom_box. WARNING: values = categ.color takes the numbers to make the colors if categ.color is a factor
+ if(plot == TRUE & ((length(dev.list()) > 0 & names(dev.cur()) == "windows") | (length(dev.list()) == 0L & Sys.info()["sysname"] == "Windows"))){ # if any Graph device already open and this device is "windows", or if no Graph device opened yet and we are on windows system -> prevention of alpha legend bug on windows using value 1
+ # to avoid a bug on windows: if alpha argument is different from 1 for lines (transparency), then lines are not correctly displayed in the legend when using the R GUI (bug https://github.com/tidyverse/ggplot2/issues/2452). No bug when using a pdf
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") GRAPHIC DEVICE USED ON A WINDOWS SYSTEM ->\nTRANSPARENCY OF THE LINES IS INACTIVATED IN THE LEGEND TO PREVENT A WINDOWS DEPENDENT BUG (SEE https://github.com/tidyverse/ggplot2/issues/2452)\nTO OVERCOME THIS ON WINDOWS, USE ANOTHER DEVICE (pdf() FOR INSTANCE)")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
}
}
- if(suppressWarnings(all(y.lim %in% c(Inf, -Inf)))){ # all() without na.rm -> ok because y.lim cannot be NA (tested above)
- # normally this control is not necessary anymore
- tempo.cat <- paste0("ERROR IN ", function.name, " y.lim CONTAINS Inf VALUES, MAYBE BECAUSE VALUES FROM data1 ARGUMENTS ARE NA OR Inf ONLY OR BECAUSE OF LOG SCALE REQUIREMENT")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- if(suppressWarnings(any(is.na(y.lim)))){ # normally no NA with is.na
- # normally this control is not necessary anymore
- tempo.cat <- paste0("ERROR IN ", function.name, " y.lim CONTAINS NA OR NaN VALUES, MAYBE BECAUSE VALUES FROM data1 ARGUMENTS ARE NA OR Inf ONLY OR BECAUSE OF LOG SCALE REQUIREMENT")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- y.lim.order <- order(y.lim) # to deal with inverse axis
- y.lim <- sort(y.lim)
- y.lim[1] <- y.lim[1] - abs(y.lim[2] - y.lim[1]) * ifelse(diff(y.lim.order) > 0, y.bottom.extra.margin, y.top.extra.margin) # diff(y.lim.order) > 0 medians not inversed axis
- y.lim[2] <- y.lim[2] + abs(y.lim[2] - y.lim[1]) * ifelse(diff(y.lim.order) > 0, y.top.extra.margin, y.bottom.extra.margin) # diff(y.lim.order) > 0 medians not inversed axis
- if(y.include.zero == TRUE){ # no need to check y.log != "no" because done before
- y.lim <- range(c(y.lim, 0), na.rm = TRUE, finite = TRUE) # finite = TRUE removes all the -Inf and Inf except if only this. In that case, whatever the -Inf and/or Inf present, output -Inf;Inf range. Idem with NA only
- }
- y.lim <- y.lim[y.lim.order]
- if(any(is.na(y.lim))){ # normally no NA with is.na
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nCODE INCONSISTENCY 2")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ if(box.alpha == 0){ # remove box legend because no boxes drawn
+ # add this after the scale_xxx_manual() for boxplots
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::guides(fill = "none", color = "none")) # inactivate the legend
}
- # end ylim range
-
-
+ # end boxplot display (if box.fill = FALSE, otherwise, already plotted above)
- # drawing
- # constant part
- tempo.gg.name <- "gg.indiv.plot."
- tempo.gg.count <- 0
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), eval(parse(text = paste0("ggplot2::ggplot()", if(is.null(add)){""}else{add})))) # add is directly put here to deal with additional variable of data, like when using facet_grid. No problem if add is a theme, will be dealt below
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::xlab(if(is.null(x.lab)){categ[1]}else{x.lab}))
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::ylab(if(is.null(y.lab)){y}else{y.lab}))
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::ggtitle(title))
- # text angle management
- axis.just <- fun_gg_just(angle = x.angle, pos = ifelse(vertical == TRUE, "bottom", "left"), kind = "axis")
- # end text angle management
- add.check <- TRUE
- if( ! is.null(add)){ # if add is NULL, then = 0
- if(grepl(pattern = "ggplot2\\s*::\\s*theme", add) == TRUE){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") \"ggplot2::theme\" STRING DETECTED IN THE add ARGUMENT\n-> INTERNAL GGPLOT2 THEME FUNCTIONS theme() AND theme_classic() HAVE BEEN INACTIVATED, TO BE USED BY THE USER\n-> article ARGUMENT WILL BE IGNORED")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- add.check <- FALSE
- }
- }
- if(add.check == TRUE & article == TRUE){
- # WARNING: not possible to add theme()several times. NO message but the last one overwrites the others
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::theme_classic(base_size = text.size))
- if(grid == TRUE){
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), m.gg <- ggplot2::theme(
- text = ggplot2::element_text(size = text.size),
- plot.title = ggplot2::element_text(size = title.text.size), # stronger than text
- line = ggplot2::element_line(size = 0.5),
- legend.key = ggplot2::element_rect(color = "white", size = 1.5), # size of the frame of the legend
- axis.line.y.left = ggplot2::element_line(colour = "black"), # draw lines for the y axis
- axis.line.x.bottom = ggplot2::element_line(colour = "black"), # draw lines for the x axis
- panel.grid.major.x = if(vertical == TRUE){NULL}else{ggplot2::element_line(colour = "grey85", size = 0.75)},
- panel.grid.major.y = if(vertical == TRUE){ggplot2::element_line(colour = "grey85", size = 0.75)}else{NULL},
- panel.grid.minor.y = if(vertical == TRUE){ggplot2::element_line(colour = "grey90", size = 0.25)}else{NULL},
- axis.text.x = if(vertical == TRUE){ggplot2::element_text(angle = axis.just$angle, hjust = axis.just$hjust, vjust = axis.just$vjust)}else{NULL},
- axis.text.y = if(vertical == TRUE){NULL}else{ggplot2::element_text(angle = axis.just$angle, hjust = axis.just$hjust, vjust = axis.just$vjust)},
- strip.background = ggplot2::element_rect(fill = NA, colour = NA) # for facet background
- ))
+ # stat display
+ # layer after dots but ok, behind dots on the plot
+ if( ! is.null(stat.pos)){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") NUMBERS DISPLAYED ARE ", ifelse(stat.mean == FALSE, "MEDIANS", "MEANS"))
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ if(stat.pos == "top"){
+ tempo.stat <- data.frame(stat, Y = y.lim[2], stringsAsFactors = TRUE) # I had to create a data frame for geom_tex() so that facet is taken into account, (ggplot2::annotate() does not deal with facet because no data and mapping arguments). Of note, facet.categ is in tempo.stat, via tempo.mean, via dot.coord
+ if(stat.mean == FALSE){tempo.stat$MEDIAN <- formatC(stat.nolog$MEDIAN, digit = 2, drop0trailing = TRUE, format = "f")}else{tempo.stat$MEAN <- formatC(stat.nolog$MEAN, digit = 2, drop0trailing = TRUE, format = "f")}
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_text(
+ data = tempo.stat,
+ mapping = ggplot2::aes_string(x = "X", y = "Y", label = ifelse(stat.mean == FALSE, "MEDIAN", "MEAN")),
+ size = stat.size,
+ color = "black",
+ angle = stat.angle,
+ hjust = stat.just$hjust,
+ vjust = stat.just$vjust
+ )) # stat$X used here because identical to stat.nolog but has the X. WARNING: no need of order() for labels because box.coord$x set the order. For justification, see https://stackoverflow.com/questions/7263849/what-do-hjust-and-vjust-do-when-making-a-plot-using-ggplot
+ coord.names <- c(coord.names, "stat.pos")
+ }else if(stat.pos == "above"){
+ # stat coordinates
+ if( ! is.null(dot.color)){ # for text just above max dot
+ if(dot.tidy == FALSE){
+ tempo.stat.ini <- dot.coord.rd3
+ }else if(dot.tidy == TRUE){
+ tempo.stat.ini <- dot.coord.tidy3
+ tempo.stat.ini$x.y <- tempo.stat.ini$x.x # this is just to be able to use tempo.stat.ini$x.y for untidy or tidy dots (remember that dot.coord.tidy3$x.y is not good, see above)
+ }
+ stat.coord1 <- aggregate(x = tempo.stat.ini["y"], by = {x.env <- if(length(categ)== 1L){list(tempo.stat.ini$group, tempo.stat.ini$PANEL, tempo.stat.ini$x.y, tempo.stat.ini[, categ[1]])}else if(length(categ) == 2L){list(tempo.stat.ini$group, tempo.stat.ini$PANEL, tempo.stat.ini$x.y, tempo.stat.ini[, categ[1]], tempo.stat.ini[, categ[2]])} ; names(x.env) <- if(length(categ)== 1L){c("group", "PANEL", "x.y", categ[1])}else if(length(categ) == 2L){c("group", "PANEL", "x.y", categ[1], categ[2])} ; x.env}, FUN = min, na.rm = TRUE)
+ names(stat.coord1)[names(stat.coord1) == "y"] <- "dot.min"
+ stat.coord2 <- aggregate(x = tempo.stat.ini["y"], by = {x.env <- if(length(categ)== 1L){list(tempo.stat.ini$group, tempo.stat.ini$PANEL, tempo.stat.ini$x.y, tempo.stat.ini[, categ[1]])}else if(length(categ) == 2L){list(tempo.stat.ini$group, tempo.stat.ini$PANEL, tempo.stat.ini$x.y, tempo.stat.ini[, categ[1]], tempo.stat.ini[, categ[2]])} ; names(x.env) <- if(length(categ)== 1L){c("group", "PANEL", "x.y", categ[1])}else if(length(categ) == 2L){c("group", "PANEL", "x.y", categ[1], categ[2])} ; x.env}, FUN = max, na.rm = TRUE)
+ names(stat.coord2) <- paste0(names(stat.coord2), "_from.dot.max")
+ names(stat.coord2)[names(stat.coord2) == "y_from.dot.max"] <- "dot.max"
+ stat.coord3 <- cbind(box.coord[order(box.coord$group, box.coord$PANEL), ], stat.coord1[order(stat.coord1$group, stat.coord1$x.y), ], stat.coord2[order(stat.coord2$group, stat.coord2$x.y), ], stringsAsFactors = TRUE) #
+ if( ! all(identical(round(stat.coord3$x, 9), round(as.numeric(stat.coord3$x.y), 9)), na.rm = TRUE)){ # as.numeric() because stat.coord3$x is class "mapped_discrete" "numeric"
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nFUSION OF box.coord, stat.coord1 AND stat.coord2 ACCORDING TO box.coord$x, stat.coord1$x.y AND stat.coord2$x.y IS NOT CORRECT. CODE HAS TO BE MODIFIED")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ # text.coord <- stat.coord3[, c("x", "group", "dot.min", "dot.max")]
+ # names(text.coord)[names(text.coord) == "dot.min"] <- "text.min.pos"
+ #names(text.coord)[names(text.coord) == "dot.max"] <- "text.max.pos"
+ box.coord <- box.coord[order(box.coord$x, box.coord$group, box.coord$PANEL), ]
+ # text.coord <- text.coord[order(text.coord$x), ] # to be sure to have the two objects in the same order for x. WARNING: cannot add identical(as.integer(text.coord$group), as.integer(box.coord$group)) because with error, the correspondence between x and group is not the same
+ stat.coord3 <- stat.coord3[order(stat.coord3$x, stat.coord3$group, stat.coord3$PANEL), ] # to be sure to have the two objects in the same order for x. WARNING: cannot add identical(as.integer(text.coord$group), as.integer(box.coord$group)) because with error, the correspondence between x and group is not the same
+ if( ! (identical(box.coord$x, stat.coord3$x) & identical(box.coord$group, stat.coord3$group) & identical(box.coord$PANEL, stat.coord3$PANEL))){
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\ntext.coord AND box.coord DO NOT HAVE THE SAME x, group AND PANEL COLUMN CONTENT")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ }else{
+ stat.coord3 <- box.coord
+ }
+ stat.coord3 <- data.frame(
+ stat.coord3,
+ Y = stat.coord3[, ifelse(
+ is.null(dot.color),
+ ifelse(diff(y.lim) > 0, "ymax", "ymin"),
+ ifelse(diff(y.lim) > 0, "ymax_final", "ymin_final")
+ )],
+ stringsAsFactors = TRUE
+ ) # ymax is top whisker, ymax_final is top dot
+ # stat.coord3 <- data.frame(stat.coord3, Y = vector("numeric", length = nrow(stat.coord3)), stringsAsFactors = TRUE)
+ # check.Y <- as.logical(stat.coord3$Y) # convert everything in Y into FALSE (because Y is full of zero)
+ # end stat coordinates
+ # stat display
+ # performed twice: first for y values >=0, then y values < 0, because only a single value allowed for hjust anf vjust
+ if(stat.mean == FALSE){
+ tempo.center.ref <- "middle"
+ }else{
+ tempo.center.ref <- "MEAN"
+ }
+ # if(is.null(dot.color)){
+ # tempo.low.ref <- "ymin"
+ # tempo.high.ref <- "ymax"
+ # }else{
+ # tempo.low.ref <- "ymin_final"
+ # tempo.high.ref <- "ymax_final"
+ # }
+ # tempo.log.high <- if(diff(y.lim) > 0){stat.coord3[, tempo.center.ref] >= 0}else{stat.coord3[, tempo.center.ref] < 0}
+ # tempo.log.low <- if(diff(y.lim) > 0){stat.coord3[, tempo.center.ref] < 0}else{stat.coord3[, tempo.center.ref] >= 0}
+ # stat.coord3$Y[tempo.log.high] <- stat.coord3[tempo.log.high, tempo.high.ref]
+ # stat.coord3$Y[tempo.log.low] <- stat.coord3[tempo.log.low, tempo.low.ref]
+ # add distance
+ stat.coord3$Y <- stat.coord3$Y + diff(y.lim) * stat.dist / 100
+ # end add distance
+ # correct median or mean text format
+ if(y.log != "no"){
+ stat.coord3[, tempo.center.ref] <- ifelse(y.log == "log2", 2, 10)^(stat.coord3[, tempo.center.ref])
+ }
+ stat.coord3[, tempo.center.ref] <- formatC(stat.coord3[, tempo.center.ref], digit = 2, drop0trailing = TRUE, format = "f")
+ # end correct median or mean text format
+ # if(any(tempo.log.high) == TRUE){
+ # tempo.stat <- stat.coord3[tempo.log.high,]
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_text(
+ data = stat.coord3,
+ mapping = ggplot2::aes_string(x = "x", y = "Y", label = tempo.center.ref),
+ size = stat.size,
+ color = "black",
+ angle = stat.angle,
+ hjust = stat.just$hjust,
+ vjust = stat.just$vjust
+ )) # WARNING: no need of order() for labels because box.coord$x set the order
+ coord.names <- c(coord.names, "stat.pos")
+ # }
+ # if(any(tempo.log.low) == TRUE){
+ # tempo.stat <- stat.coord3[tempo.log.low,]
+ # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_text(
+ # data = tempo.stat,
+ # mapping = ggplot2::aes_string(x = "x", y = "Y", label = tempo.center.ref),
+ # size = stat.size,
+ # color = "black",
+ # hjust = ifelse(vertical == TRUE, 0.5, 0.5 + stat.dist),
+ # vjust = ifelse(vertical == TRUE, 0.5 + stat.dist, 0.5)
+ # )) # WARNING: no need of order() for labels because box.coord$x set the order
+ # coord.names <- c(coord.names, "stat.pos.negative")
+ # }
+ # end stat display
}else{
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), m.gg <- ggplot2::theme(
- text = ggplot2::element_text(size = text.size),
- plot.title = ggplot2::element_text(size = title.text.size), # stronger than text
- line = ggplot2::element_line(size = 0.5),
- legend.key = ggplot2::element_rect(color = "white", size = 1.5), # size of the frame of the legend
- axis.line.y.left = ggplot2::element_line(colour = "black"),
- axis.line.x.bottom = ggplot2::element_line(colour = "black"),
- axis.text.x = if(vertical == TRUE){ggplot2::element_text(angle = axis.just$angle, hjust = axis.just$hjust, vjust = axis.just$vjust)}else{NULL},
- axis.text.y = if(vertical == TRUE){NULL}else{ggplot2::element_text(angle = axis.just$angle, hjust = axis.just$hjust, vjust = axis.just$vjust)},
- strip.background = ggplot2::element_rect(fill = NA, colour = NA)
- ))
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nCODE INCONSISTENCY 5")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
- }else if(add.check == TRUE & article == FALSE){
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), m.gg <- ggplot2::theme(
- text = ggplot2::element_text(size = text.size),
- plot.title = ggplot2::element_text(size = title.text.size), # stronger than text
- line = ggplot2::element_line(size = 0.5),
- legend.key = ggplot2::element_rect(color = "white", size = 1.5), # size of the frame of the legend
- panel.background = ggplot2::element_rect(fill = "grey95"),
- axis.line.y.left = ggplot2::element_line(colour = "black"),
- axis.line.x.bottom = ggplot2::element_line(colour = "black"),
- panel.grid.major.x = ggplot2::element_line(colour = "grey85", size = 0.75),
- panel.grid.major.y = ggplot2::element_line(colour = "grey85", size = 0.75),
- panel.grid.minor.x = ggplot2::element_blank(),
- panel.grid.minor.y = ggplot2::element_line(colour = "grey90", size = 0.25),
- strip.background = ggplot2::element_rect(fill = NA, colour = NA),
- axis.text.x = if(vertical == TRUE){ggplot2::element_text(angle = axis.just$angle, hjust = axis.just$hjust, vjust = axis.just$vjust)}else{NULL},
- axis.text.y = if(vertical == TRUE){NULL}else{ggplot2::element_text(angle = axis.just$angle, hjust = axis.just$hjust, vjust = axis.just$vjust)}
- ))
}
- # Contrary to fun_gg_bar(), cannot plot the boxplot right now, because I need the dots plotted first
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_boxplot(data = data1, mapping = ggplot2::aes_string(x = categ[1], y = y, group = categ[length(categ)]), position = ggplot2::position_dodge(width = NULL), color = NA, width = box.width, fill = NA)) # this is to set the graph (i.e., a blanck boxplot to be able to use x coordinates to plot dots before boxes)
- # end constant part
-
+ # end stat display
+ # legend management
+ if(legend.show == FALSE){ # must be here because must be before bef.final.plot <-
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::guides(fill = "none", color = "none", alpha = "none")) # inactivate the initial legend
+ }
+ # end legend management
- # graphic info recovery (including means)
- tempo.graph.info <- ggplot2::ggplot_build(eval(parse(text = paste0(paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "), ' + ggplot2::geom_boxplot(data = data1, mapping = ggplot2::aes_string(x = categ[1], y = y, fill = categ[length(categ)]), position = ggplot2::position_dodge(width = NULL), width = box.width, notch = box.notch, coef = if(box.whisker.kind == "no"){0}else if(box.whisker.kind == "std"){1.5}else if(box.whisker.kind == "max"){Inf}) + ggplot2::scale_discrete_manual(aesthetics = "fill", name = box.legend.name, values = if(length(categ.color)== 1L){rep(categ.color, length(unique(data1[, categ[length(categ)]])))}else{categ.color})')))) # will be recovered later again, when ylim will be considered
- tempo.yx.ratio <- (tempo.graph.info$layout$panel_params[[1]]$y.range[2] - tempo.graph.info$layout$panel_params[[1]]$y.range[1]) / (tempo.graph.info$layout$panel_params[[1]]$x.range[2] - tempo.graph.info$layout$panel_params[[1]]$x.range[1])
- box.coord <- tempo.graph.info$data[[2]] # to have the summary statistics of the plot. Contrary to ini.box.plot, now integrates ylim Here because can be required for stat.pos when just box are plotted
- box.coord$x <- as.numeric(box.coord$x) # because x is of special class that block comparison of values using identical
- box.coord$PANEL <- as.numeric(box.coord$PANEL) # because numbers as levels. But may be a problem is facet are reordered ?
- box.coord <- box.coord[order(box.coord$group, box.coord$PANEL), ]
- if( ! (identical(tempo.mean$BOX, box.coord$group) & identical(tempo.mean$PANEL, box.coord$PANEL))){
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nidentical(tempo.mean$BOX, box.coord$group) & identical(tempo.mean$PANEL, box.coord$PANEL) DO NOT HAVE THE SAME VALUE ORDER")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ # y scale management (cannot be before dot plot management)
+ # the rescaling aspect is complicated and not intuitive. See:
+ # explaination: https://github.com/tidyverse/ggplot2/issues/3948
+ # the oob argument of scale_y_continuous() https://ggplot2.tidyverse.org/reference/scale_continuous.html
+ # see also https://github.com/rstudio/cheatsheets/blob/master/data-visualization-2.1.pdf
+ # secondary ticks
+ bef.final.plot <- ggplot2::ggplot_build(eval(parse(text = paste(paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "), ' + if(vertical == TRUE){ggplot2::scale_y_continuous(expand = c(0, 0), limits = sort(y.lim), oob = scales::rescale_none)}else{ggplot2::coord_flip(ylim = y.lim)}')))) # here I do not need the x-axis and y-axis orientation, I just need the number of main ticks and the legend. I DI NOT UNDERSTAND THE COMMENT HERE BECAUSE WE NEED COORD_FLiP
+ tempo.coord <- bef.final.plot$layout$panel_params[[1]]
+ # y.second.tick.positions: coordinates of secondary ticks (only if y.second.tick.nb argument is non NULL or if y.log argument is different from "no")
+ if(y.log != "no"){ # integer main ticks for log2 and log10
+ tempo.scale <- (as.integer(min(y.lim, na.rm = TRUE)) - 1):(as.integer(max(y.lim, na.rm = TRUE)) + 1)
}else{
- # tempo <- c(categ, if( ! is.null(dot.color) & ! is.null(dot.categ)){if(dot.categ != ini.dot.categ){dot.categ}}, if( ! is.null(facet.categ)){facet.categ})
- if(any(names(tempo.mean) %in% names(box.coord), na.rm = TRUE)){
- names(tempo.mean)[names(tempo.mean) %in% names(box.coord)] <- paste0(names(tempo.mean)[names(tempo.mean) %in% names(box.coord)], ".mean")
+ tempo <- if(is.null(attributes(tempo.coord$y$breaks))){tempo.coord$y$breaks}else{unlist(attributes(tempo.coord$y$breaks))}
+ if(all(is.na(tempo))){# all() without na.rm -> ok because is.na() cannot be NA
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nONLY NA IN tempo.coord$y$breaks")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
}
- box.coord <- data.frame(box.coord, tempo.mean, stringsAsFactors = TRUE)
+ tempo.scale <- fun_scale(lim = y.lim, n = ifelse(is.null(y.tick.nb), length(tempo[ ! is.na(tempo)]), y.tick.nb)) # in ggplot 3.3.0, tempo.coord$y.major_source replaced by tempo.coord$y$breaks. If fact: n = ifelse(is.null(y.tick.nb), length(tempo[ ! is.na(tempo)]), y.tick.nb)) replaced by n = ifelse(is.null(y.tick.nb), 4, y.tick.nb))
}
- # end graphic info recovery (including means)
-
-
-
- # stat output (will also serve for boxplot and mean display)
- # x not added now (to do not have them in stat.nolog)
- stat <- data.frame(
- MIN = box.coord$ymin_final,
- QUART1 = box.coord$lower,
- MEDIAN = box.coord$middle,
- MEAN = box.coord$MEAN,
- QUART3 = box.coord$upper,
- MAX = box.coord$ymax_final,
- WHISK_INF = box.coord$ymin,
- BOX_INF = box.coord$lower,
- NOTCH_INF = box.coord$notchlower,
- NOTCH_SUP = box.coord$notchupper,
- BOX_SUP = box.coord$upper,
- WHISK_SUP = box.coord$ymax,
- OUTLIERS = box.coord["outliers"],
- tempo.mean[colnames(tempo.mean) != "MEAN"],
- COLOR = box.coord$fill,
- stringsAsFactors = TRUE
- ) # box.coord["outliers"] written like this because it is a list. X coordinates not put now because several features to set
- names(stat)[names(stat) == "outliers"] <- "OUTLIERS"
- stat.nolog <- stat # stat.nolog ini will serve for outputs
+ y.second.tick.values <- NULL
+ y.second.tick.pos <- NULL
if(y.log != "no"){
- stat.nolog[c("MIN", "QUART1", "MEDIAN", "MEAN", "QUART3", "MAX", "WHISK_INF", "BOX_INF", "NOTCH_INF", "NOTCH_SUP", "BOX_SUP", "WHISK_SUP")] <- ifelse(y.log == "log2", 2, 10)^(stat.nolog[c("MIN", "QUART1", "MEDIAN", "MEAN", "QUART3", "MAX", "WHISK_INF", "BOX_INF", "NOTCH_INF", "NOTCH_SUP", "BOX_SUP", "WHISK_SUP")])
- stat.nolog$OUTLIERS <- lapply(stat.nolog$OUTLIERS, FUN = function(X){ifelse(y.log == "log2", 2, 10)^X})
+ tempo <- fun_inter_ticks(lim = y.lim, log = y.log)
+ y.second.tick.values <- tempo$values
+ y.second.tick.pos <- tempo$coordinates
+ # if(vertical == TRUE){ # do not remove in case the bug is fixed
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(geom = "segment", y = y.second.tick.pos, yend = y.second.tick.pos, x = tempo.coord$x.range[1], xend = tempo.coord$x.range[1] + diff(tempo.coord$x.range) / 80))
+ # }else{ # not working because of the ggplot2 bug
+ # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(geom = "segment", x = y.second.tick.pos, xend = y.second.tick.pos, y = tempo.coord$y.range[1], yend = tempo.coord$y.range[1] + diff(tempo.coord$y.range) / 80))
+ # }
+ coord.names <- c(coord.names, "y.second.tick.positions")
+ }else if(( ! is.null(y.second.tick.nb)) & y.log == "no"){
+ # if(y.second.tick.nb > 0){ #inactivated because already checked before
+ if(length(tempo.scale) < 2){
+ tempo.cat1 <- c("y.tick.nb", "y.second.tick.nb")
+ tempo.cat2 <- sapply(list(y.tick.nb, y.second.tick.nb), FUN = paste0, collapse = " ")
+ tempo.sep <- sapply(mapply(" ", max(nchar(tempo.cat1)) - nchar(tempo.cat1) + 3, FUN = rep, SIMPLIFY = FALSE), FUN = paste0, collapse = "")
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE NUMBER OF GENERATED TICKS FOR THE Y-AXIS IS NOT CORRECT: ", length(tempo.scale), "\nUSING THESE ARGUMENT SETTINGS (NO DISPLAY MEANS NULL VALUE):\n", paste0(tempo.cat1, tempo.sep, tempo.cat2, collapse = "\n"), "\nPLEASE, TEST OTHER VALUES")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else{
+ tempo <- fun_inter_ticks(lim = y.lim, log = y.log, breaks = tempo.scale, n = y.second.tick.nb)
+ }
+ y.second.tick.values <- tempo$values
+ y.second.tick.pos <- tempo$coordinates
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(
+ geom = "segment",
+ y = y.second.tick.pos,
+ yend = y.second.tick.pos,
+ x = if(vertical == TRUE){tempo.coord$x.range[1]}else{tempo.coord$y.range[1]},
+ xend = if(vertical == TRUE){tempo.coord$x.range[1] + diff(tempo.coord$x.range) / 80}else{tempo.coord$y.range[1] + diff(tempo.coord$y.range) / 80}
+ ))
+ coord.names <- c(coord.names, "y.second.tick.positions")
}
- # end stat output (will also serve for boxplot and mean display)
-
-
-
-
+ # end y.second.tick.positions
+ # for the ggplot2 bug with y.log, this does not work: eval(parse(text = ifelse(vertical == FALSE & y.log == "log10", "ggplot2::scale_x_continuous", "ggplot2::scale_y_continuous")))
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_y_continuous(
+ breaks = tempo.scale,
+ minor_breaks = y.second.tick.pos,
+ labels = if(y.log == "log10"){scales::trans_format("identity", scales::math_format(10^.x))}else if(y.log == "log2"){scales::trans_format("identity", scales::math_format(2^.x))}else if(y.log == "no"){ggplot2::waiver()}else{tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nCODE INCONSISTENCY 6") ; stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)}, # == in stop() to be able to add several messages between ==
+ expand = c(0, 0), # remove space after after axis limits
+ limits = sort(y.lim), # NA indicate that limits must correspond to data limits but ylim() already used
+ oob = scales::rescale_none,
+ trans = ifelse(diff(y.lim) < 0, "reverse", "identity") # equivalent to ggplot2::scale_y_reverse() but create the problem of y-axis label disappearance with y.lim decreasing. Thus, do not use. Use ylim() below and after this
+ ))
+ if(vertical == TRUE){
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::coord_cartesian(ylim = y.lim)) # problem of ggplot2::ylim() is that it redraws new breaks # coord_cartesian(ylim = y.lim)) not used because bug -> y-axis label disappearance with y.lim decreasing I DO NOT UNDERSTAND THIS MESSAGE WHILE I USE COORD_CARTESIAN # clip = "off" to have secondary ticks outside plot region does not work
+ }else{
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::coord_flip(ylim = y.lim)) # clip = "off" to have secondary ticks outside plot region does not work # create the problem of y-axis label disappearance with y.lim decreasing. IDEM ABOVE
+
+ }
+ # end y scale management (cannot be before dot plot management)
- # x coordinates management (for random plotting and for stat display)
- # width commputations
- width.ini <- c(box.coord$xmax - box.coord$xmin)[1] # all the box widths are equal here. Only the first one taken
- width.correct <- width.ini * box.space / 2
- if( ! (identical(stat$BOX, box.coord$group) & identical(stat$PANEL, box.coord$PANEL))){
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nidentical(stat$BOX, box.coord$group) & identical(stat$PANEL, box.coord$PANEL) MUST BE IDENTICAL. CODE HAS TO BE MODIFIED")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else{
- stat <- data.frame(
- stat,
- X = box.coord$x,
- X_BOX_INF = box.coord$xmin + width.correct,
- X_BOX_SUP = box.coord$xmax - width.correct,
- X_NOTCH_INF = box.coord$x - (box.coord$x - (box.coord$xmin + width.correct)) / 2,
- X_NOTCH_SUP = box.coord$x + (box.coord$x - (box.coord$xmin + width.correct)) / 2,
- X_WHISK_INF = box.coord$x - (box.coord$x - (box.coord$xmin + width.correct)) * box.whisker.width,
- X_WHISK_SUP = box.coord$x + (box.coord$x - (box.coord$xmin + width.correct)) * box.whisker.width,
- # tempo.mean[colnames(tempo.mean) != "MEAN"], # already added above
- stringsAsFactors = TRUE
- )
- stat$COLOR <- factor(stat$COLOR, levels = unique(categ.color))
- if( ! all(stat$NOTCH_SUP < stat$BOX_SUP & stat$NOTCH_INF > stat$BOX_INF, na.rm = TRUE) & box.notch == TRUE){
+ # legend management
+ if( ! is.null(legend.width)){
+ legend.final <- fun_gg_get_legend(ggplot_built = bef.final.plot, fun.name = function.name, lib.path = lib.path) # get legend
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::guides(fill = "none", color = "none", alpha = "none")) # inactivate the initial legend
+ if(is.null(legend.final) & plot == TRUE){ # even if any(unlist(legend.disp)) is TRUE
+ legend.final <- ggplot2::ggplot()+ggplot2::theme_void() # empty graph instead of legend
warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") SOME NOTCHES ARE BEYOND BOX HINGES. TRY ARGUMENT box.notch = FALSE")
+ tempo.warn <- paste0("(", warn.count,") LEGEND REQUESTED (NON NULL categ ARGUMENT OR legend.show ARGUMENT SET TO TRUE)\nBUT IT SEEMS THAT THE PLOT HAS NO LEGEND -> EMPTY LEGEND SPACE CREATED BECAUSE OF THE NON NULL legend.width ARGUMENT\n")
warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
}
}
- dot.jitter <- c((box.coord$xmax - width.correct) - (box.coord$xmin + width.correct))[1] * dot.jitter # real dot.jitter. (box.coord$xmin + width.correct) - (box.coord$xmax - width.correct))[1] is the width of the box. Is equivalent to (box.coord$x - (box.coord$xmin + width.correct))[1] * 2
- # end width commputations
- if( ! is.null(dot.color)){
- # random dots
- if(dot.tidy == FALSE){
- dot.coord.rd1 <- merge(dot.coord, box.coord[c("fill", "PANEL", "group", "x")], by = c("PANEL", "group"), sort = FALSE) # rd for random. Send the coord of the boxes into the coord data.frame of the dots (in the column x.y). WARNING: by = c("PANEL", "group") without fill column because PANEL & group columns are enough as only one value of x column per group number in box.coord. Thus, no need to consider fill column
- if(nrow(dot.coord.rd1) != nrow(dot.coord)){
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nTHE merge() FUNCTION DID NOT RETURN A CORRECT dot.coord.rd1 DATA FRAME. CODE HAS TO BE MODIFIED")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- sampled.dot.jitter <- if(nrow(dot.coord.rd1)== 1L){runif(n = nrow(dot.coord.rd1), min = - dot.jitter / 2, max = dot.jitter / 2)}else{sample(x = runif(n = nrow(dot.coord.rd1), min = - dot.jitter / 2, max = dot.jitter / 2), size = nrow(dot.coord.rd1), replace = FALSE)}
- dot.coord.rd2 <- data.frame(dot.coord.rd1, dot.x = dot.coord.rd1$x.y + sampled.dot.jitter, stringsAsFactors = TRUE) # set the dot.jitter thanks to runif and dot.jitter range. Then, send the coord of the boxes into the coord data.frame of the dots (in the column x.y)
- if(length(categ)== 1L){
- tempo.data1 <- unique(data.frame(data1[categ[1]], group = as.integer(data1[, categ[1]]), stringsAsFactors = TRUE)) # categ[1] is factor
- names(tempo.data1)[names(tempo.data1) == categ[1]] <- paste0(categ[1], ".check")
- verif <- paste0(categ[1], ".check")
- }else if(length(categ) == 2L){
- tempo.data1 <- unique(
- data.frame(
- data1[c(categ[1], categ[2])],
- group = as.integer(factor(paste0(
- formatC(as.integer(data1[, categ[2]]), width = nchar(max(as.integer(data1[, categ[2]]), na.rm = TRUE)), flag = "0"), # convert factor into numeric with leading zero for proper ranking
- ".",
- formatC(as.integer(data1[, categ[1]]), width = nchar(max(as.integer(data1[, categ[1]]), na.rm = TRUE)), flag = "0")# convert factor into numeric with leading zero for proper ranking
- )), stringsAsFactors = TRUE) # merge the 2 formatC() to create a new factor. The convertion to integer should recreate the correct group number
- )
- ) # categ[2] first if categ[2] is used to make the categories in ggplot and categ[1] is used to make the x-axis
- names(tempo.data1)[names(tempo.data1) == categ[1]] <- paste0(categ[1], ".check")
- names(tempo.data1)[names(tempo.data1) == categ[2]] <- paste0(categ[2], ".check")
- verif <- c(paste0(categ[1], ".check"), paste0(categ[2], ".check"))
- }else{
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nCODE INCONSISTENCY 3")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- dot.coord.rd3 <- merge(dot.coord.rd2, tempo.data1, by = intersect("group", "group"), sort = FALSE) # send the factors of data1 into coord. WARNING: I have replaced by = "group" by intersect("group", "group") because of an error due to wrong group group merging in dot.coord.rd3
- if(nrow(dot.coord.rd3) != nrow(dot.coord) | ( ! fun_comp_2d(dot.coord.rd3[categ], dot.coord.rd3[verif])$identical.content)){
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nTHE merge() FUNCTION DID NOT RETURN A CORRECT dot.coord.rd3 DATA FRAME. CODE HAS TO BE MODIFIED")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- # end random dots
- }
- # tidy dots
- # coordinates are recovered during plotting (see dot.coord.tidy1 below)
- # end tidy dots
- }
- # end x coordinates management (for random plotting and for stat display)
+ # end legend management
+ # drawing
+ fin.plot <- suppressMessages(suppressWarnings(eval(parse(text = paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + ")))))
+ grob.save <- NULL
+ if(plot == TRUE){
+ # following lines inactivated because of problem in warn.recov and message.recov
+ # assign("env_fun_get_message", new.env())
+ # assign("tempo.gg.name", tempo.gg.name, envir = env_fun_get_message)
+ # assign("tempo.gg.count", tempo.gg.count, envir = env_fun_get_message)
+ # assign("add", add, envir = env_fun_get_message)
+ # two next line: for the moment, I cannot prevent the warning printing
+ # warn.recov <- fun_get_message(paste(paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "), if(is.null(add)){NULL}else{add}), kind = "warning", header = FALSE, print.no = FALSE, env = env_fun_get_message) # for recovering warnings printed by ggplot() functions
+ # message.recov <- fun_get_message('print(eval(parse(text = paste(paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "), if(is.null(add)){NULL}else{add}))))', kind = "message", header = FALSE, print.no = FALSE, env = env_fun_get_message) # for recovering messages printed by ggplot() functions
+ # if( ! (return == TRUE & return.ggplot == TRUE)){ # because return() plots when return.ggplot is TRUE # finally not used -> see return.ggplot description
+ if(is.null(legend.width)){
+ grob.save <- suppressMessages(suppressWarnings(gridExtra::grid.arrange(fin.plot)))
+ }else{
+ grob.save <-suppressMessages(suppressWarnings(gridExtra::grid.arrange(fin.plot, legend.final, ncol=2, widths=c(1, legend.width))))
+ }
+ # }
+ # suppressMessages(suppressWarnings(print(eval(parse(text = paste(paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "), if(is.null(add)){NULL}else{add}))))))
+ }else{
+ # following lines inactivated because of problem in warn.recov and message.recov
+ # message.recov <- NULL
+ # warn.recov <- NULL
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") PLOT NOT SHOWN AS REQUESTED")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ # end drawing
- # boxplot display before dot display if box.fill = TRUE
- coord.names <- NULL
- # creation of the data frame for (main box + legend) and data frame for means
- if(box.notch == FALSE){
- for(i3 in 1:length(categ)){
- if(i3== 1L){
- tempo.polygon <- data.frame(GROUPX = c(t(stat[, rep(categ[i3], 5)])), stringsAsFactors = TRUE)
- }else{
- tempo.polygon <- cbind(tempo.polygon, c(t(stat[, rep(categ[i3], 5)])), stringsAsFactors = TRUE)
- }
- }
- names(tempo.polygon) <- categ
- tempo.polygon <- data.frame(X = c(t(stat[, c("X_BOX_INF", "X_BOX_SUP", "X_BOX_SUP", "X_BOX_INF", "X_BOX_INF")])), Y = c(t(stat[, c("BOX_INF", "BOX_INF", "BOX_SUP", "BOX_SUP", "BOX_INF")])), COLOR = c(t(stat[, c("COLOR", "COLOR", "COLOR", "COLOR", "COLOR")])), BOX = as.character(c(t(stat[, c("BOX", "BOX", "BOX", "BOX", "BOX")]))), tempo.polygon, stringsAsFactors = TRUE)
- if( ! is.null(facet.categ)){
- for(i4 in 1:length(facet.categ)){
- tempo.polygon <- data.frame(tempo.polygon, c(t(stat[, c(facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4])])), stringsAsFactors = TRUE)
- names(tempo.polygon)[length(names(tempo.polygon))] <- facet.categ[i4]
- }
- }
- }else{
- for(i3 in 1:length(categ)){
- if(i3== 1L){
- tempo.polygon <- data.frame(GROUPX = c(t(stat[, rep(categ[i3], 11)])), stringsAsFactors = TRUE)
- }else{
- tempo.polygon <- cbind(tempo.polygon, c(t(stat[, rep(categ[i3], 11)])), stringsAsFactors = TRUE)
- }
- }
- names(tempo.polygon) <- categ
- tempo.polygon <- data.frame(X = c(t(stat[, c("X_BOX_INF", "X_BOX_SUP", "X_BOX_SUP", "X_NOTCH_SUP", "X_BOX_SUP", "X_BOX_SUP", "X_BOX_INF", "X_BOX_INF", "X_NOTCH_INF", "X_BOX_INF", "X_BOX_INF")])), Y = c(t(stat[, c("BOX_INF", "BOX_INF", "NOTCH_INF", "MEDIAN", "NOTCH_SUP", "BOX_SUP", "BOX_SUP", "NOTCH_SUP", "MEDIAN", "NOTCH_INF", "BOX_INF")])), COLOR = c(t(stat[, c("COLOR", "COLOR", "COLOR", "COLOR", "COLOR", "COLOR", "COLOR", "COLOR", "COLOR", "COLOR", "COLOR")])), BOX = as.character(c(t(stat[, c("BOX", "BOX", "BOX", "BOX", "BOX", "BOX", "BOX", "BOX", "BOX", "BOX", "BOX")]))), tempo.polygon, stringsAsFactors = TRUE)
- if( ! is.null(facet.categ)){
- for(i4 in 1:length(facet.categ)){
- tempo.polygon <- data.frame(tempo.polygon, c(t(stat[, c(facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4], facet.categ[i4])])), stringsAsFactors = TRUE)
- names(tempo.polygon)[length(names(tempo.polygon))] <- facet.categ[i4]
- }
- }
+ # output
+ # following lines inactivated because of problem in warn.recov and message.recov
+ # if( ! (is.null(warn) & is.null(warn.recov) & is.null(message.recov))){
+ # warn <- paste0(warn, "\n\n", if(length(warn.recov) > 0 | length(message.recov) > 0){paste0(paste0("MESSAGES FROM ggplot2 FUNCTIONS: ", ifelse( ! is.null(warn.recov), unique(message.recov), ""), ifelse( ! is.null(message.recov), unique(message.recov), ""), collapse = "\n\n"), "\n\n")})
+ # }else if( ! (is.null(warn) & is.null(warn.recov)) & is.null(message.recov)){
+ # warn <- paste0(warn, "\n\n", if(length(warn.recov) > 0){paste0(paste0("MESSAGES FROM ggplot2 FUNCTIONS: ", unique(warn.recov), collapse = "\n\n"), "\n\n")})
+ # }else if( ! (is.null(warn) & is.null(message.recov)) & is.null(warn.recov)){
+ # warn <- paste0(warn, "\n\n", if(length(message.recov) > 0){paste0(paste0("MESSAGES FROM ggplot2 FUNCTIONS: ", unique(message.recov), collapse = "\n\n"), "\n\n")})
+ # }
+ if(warn.print == TRUE & ! is.null(warn)){
+ on.exit(warning(paste0("FROM ", function.name, ":\n\n", warn), call. = FALSE))
}
- tempo.polygon$COLOR <- factor(tempo.polygon$COLOR, levels = unique(categ.color))
- if( ! is.null(categ.class.order)){
- for(i3 in 1:length(categ)){
- tempo.polygon[, categ[i3]] <- factor(tempo.polygon[, categ[i3]], levels = categ.class.order[[i3]])
- }
- }
- # modified name of dot.categ column (e.g., "Categ1_DOT") must be included for boxplot using ridy dots
- if( ! is.null(dot.color) & ! is.null(dot.categ)){
- if(dot.categ != ini.dot.categ){
- tempo.polygon <- data.frame(tempo.polygon, GROUPX = tempo.polygon[, ini.dot.categ], stringsAsFactors = TRUE)
- names(tempo.polygon)[names(tempo.polygon) == "GROUPX"] <- dot.categ
-
- }
- }
- tempo.diamon.mean <- data.frame(X = c(t(stat[, c("X", "X_NOTCH_INF", "X", "X_NOTCH_SUP", "X")])), Y = c(t(cbind(stat["MEAN"] - (stat[, "X"] - stat[, "X_NOTCH_INF"]) * tempo.yx.ratio, stat["MEAN"], stat["MEAN"] + (stat[, "X"] - stat[, "X_NOTCH_INF"]) * tempo.yx.ratio, stat["MEAN"], stat["MEAN"] - (stat[, "X"] - stat[, "X_NOTCH_INF"]) * tempo.yx.ratio, stringsAsFactors = TRUE))), COLOR = c(t(stat[, c("COLOR", "COLOR", "COLOR", "COLOR", "COLOR")])), GROUP = c(t(stat[, c("BOX", "BOX", "BOX", "BOX", "BOX")])), stringsAsFactors = TRUE) # stringsAsFactors = TRUE for cbind() because stat["MEAN"] is a data frame. Otherwise, stringsAsFactors is not an argument for cbind() on vectors
- if( ! is.null(facet.categ)){
- for(i3 in 1:length(facet.categ)){
- tempo.diamon.mean <- data.frame(tempo.diamon.mean, c(t(stat[, c(facet.categ[i3], facet.categ[i3], facet.categ[i3], facet.categ[i3], facet.categ[i3])])), stringsAsFactors = TRUE)
- names(tempo.diamon.mean)[length(names(tempo.diamon.mean))] <- facet.categ[i3]
- }
- }
- tempo.diamon.mean$COLOR <- factor(tempo.diamon.mean$COLOR, levels = unique(categ.color))
- # end creation of the data frame for (main box + legend) and data frame for means
- if(box.fill == TRUE){
- # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_boxplot(data = data1, mapping = ggplot2::aes_string(x = categ[1], y = y, color = categ[length(categ)], fill = categ[length(categ)]), position = ggplot2::position_dodge(width = NULL), width = box.width, size = box.line.size, notch = box.notch, coef = if(box.whisker.kind == "no"){0}else if(box.whisker.kind == "std"){1.5}else if(box.whisker.kind == "max"){Inf}, alpha = box.alpha, outlier.shape = if( ! is.null(dot.color)){NA}else{21}, outlier.color = if( ! is.null(dot.color)){NA}else{dot.border.color}, outlier.fill = if( ! is.null(dot.color)){NA}else{NULL}, outlier.size = if( ! is.null(dot.color)){NA}else{dot.size}, outlier.stroke = if( ! is.null(dot.color)){NA}else{dot.border.size}, outlier.alpha = if( ! is.null(dot.color)){NA}else{dot.alpha})) # the color, size, etc. of the outliers are dealt here. outlier.color = NA to do not plot outliers when dots are already plotted. Finally, boxplot redrawn (see below)
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_polygon(
- data = tempo.polygon,
- mapping = ggplot2::aes_string(x = "X", y = "Y", group = "BOX", fill = categ[length(categ)], color = categ[length(categ)]),
- size = box.line.size,
- alpha = box.alpha # works only for fill, not for color
- ))
- coord.names <- c(coord.names, "main.box")
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = X, xend = X, y = BOX_SUP, yend = WHISK_SUP, group = categ[length(categ)]), color = "black", size = box.line.size, alpha = box.alpha)) #
- coord.names <- c(coord.names, "sup.whisker")
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = X, xend = X, y = BOX_INF, yend = WHISK_INF, group = categ[length(categ)]), color = "black", size = box.line.size, alpha = box.alpha)) #
- coord.names <- c(coord.names, "inf.whisker")
- if(box.whisker.width > 0){
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = X_WHISK_INF, xend = X_WHISK_SUP, y = WHISK_SUP, yend = WHISK_SUP, group = categ[length(categ)]), color = "black", size = box.line.size, alpha = box.alpha, lineend = "round")) #
- coord.names <- c(coord.names, "sup.whisker.edge")
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = X_WHISK_INF, xend = X_WHISK_SUP, y = WHISK_INF, yend = WHISK_INF, group = categ[length(categ)]), color = "black", size = box.line.size, alpha = box.alpha, lineend = "round")) #
- coord.names <- c(coord.names, "inf.whisker.edge")
- }
- if(box.mean == TRUE){
- # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_point(data = stat, mapping = ggplot2::aes_string(x = "X", y = "MEAN", group = categ[length(categ)]), shape = 23, stroke = box.line.size * 2, fill = stat$COLOR, size = box.mean.size, color = "black", alpha = box.alpha)) # group used in aesthetic to do not have it in the legend
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_polygon(
- data = tempo.diamon.mean,
- mapping = ggplot2::aes(x = X, y = Y, group = GROUP),
- fill = tempo.diamon.mean[, "COLOR"],
- color = hsv(0, 0, 0, alpha = box.alpha), # outline of the polygon in black but with alpha
- size = box.line.size,
- alpha = box.alpha
- ))
- coord.names <- c(coord.names, "mean")
- }
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = if(box.notch == FALSE){X_BOX_INF}else{X_NOTCH_INF}, xend = if(box.notch == FALSE){X_BOX_SUP}else{X_NOTCH_SUP}, y = MEDIAN, yend = MEDIAN, group = categ[length(categ)]), color = "black", size = box.line.size * 2, alpha = box.alpha)) #
- coord.names <- c(coord.names, "median")
- }
- # end boxplot display before dot display if box.fill = TRUE
-
-
-
-
-
-
- # dot display
- if( ! is.null(dot.color)){
- if(dot.tidy == FALSE){
- if(is.null(dot.categ)){
- if(dot.border.size == 0){
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_point(
- data = dot.coord.rd3,
- mapping = ggplot2::aes_string(x = "dot.x", y = "y", group = categ[length(categ)]),
- size = dot.size,
- shape = 19,
- color = dot.coord.rd3$dot.color,
- alpha = dot.alpha
- )) # group used in aesthetic to do not have it in the legend. Here ggplot2::scale_discrete_manual() cannot be used because of the group easthetic
- }else{
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_point(
- data = dot.coord.rd3,
- mapping = ggplot2::aes_string(x = "dot.x", y = "y", group = categ[length(categ)]),
- shape = 21,
- stroke = dot.border.size,
- color = if(is.null(dot.border.color)){dot.coord.rd3$dot.color}else{rep(dot.border.color, nrow(dot.coord.rd3))},
- size = dot.size,
- fill = dot.coord.rd3$dot.color,
- alpha = dot.alpha
- )) # group used in aesthetic to do not have it in the legend. Here ggplot2::scale_discrete_manual() cannot be used because of the group easthetic
- }
- }else{
- if(dot.border.size == 0){
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_point(
- data = dot.coord.rd3,
- mapping = ggplot2::aes_string(x = "dot.x", y = "y", alpha = dot.categ),
- size = dot.size,
- shape = 19,
- color = dot.coord.rd3$dot.color
- )) # group used in aesthetic to do not have it in the legend. Here ggplot2::scale_discrete_manual() cannot be used because of the group easthetic
- }else{
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_point(
- data = dot.coord.rd3,
- mapping = ggplot2::aes_string(x = "dot.x", y = "y", alpha = dot.categ),
- size = dot.size,
- shape = 21,
- stroke = dot.border.size,
- color = if(is.null(dot.border.color)){dot.coord.rd3$dot.color}else{rep(dot.border.color, nrow(dot.coord.rd3))},
- fill = dot.coord.rd3$dot.color
- )) # group used in aesthetic to do not have it in the legend. Here ggplot2::scale_discrete_manual() cannot be used because of the group easthetic
- }
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "alpha", name = dot.legend.name, values = rep(dot.alpha, length(dot.categ.class.order)), guide = ggplot2::guide_legend(override.aes = list(fill = dot.color, color = if(is.null(dot.border.color)){dot.color}else{dot.border.color}, stroke = dot.border.size, alpha = dot.alpha)))) # values are the values of color (which is the border color in geom_box. WARNING: values = categ.color takes the numbers to make the colors if categ.color is a factor
- }
- coord.names <- c(coord.names, "dots")
- }else if(dot.tidy == TRUE){
- # here plot using group -> no scale
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_dotplot(
- data = dot.coord,
- mapping = ggplot2::aes_string(x = categ[1], y = "y", group = "group"), # not dot.categ here because the classes of dot.categ create new separations
- position = ggplot2::position_dodge(width = box.width),
- binpositions = "all",
- binaxis = "y",
- stackdir = "center",
- alpha = dot.alpha,
- fill = dot.coord$dot.color,
- stroke = dot.border.size,
- color = if(is.null(dot.border.color)){dot.coord$dot.color}else{rep(dot.border.color, nrow(dot.coord))},
- show.legend = FALSE, # WARNING: do not use show.legend = TRUE because it uses the arguments outside aes() as aesthetics (here color and fill). Thus I must find a way using ggplot2::scale_discrete_manual()
- binwidth = (y.lim[2] - y.lim[1]) / dot.tidy.bin.nb
- )) # geom_dotplot ggplot2 v3.3.0: I had to remove rev() in fill and color # very weird behavior of geom_dotplot ggplot2 v3.2.1, (1) because with aes group = (to avoid legend), the dot plotting is not good in term of coordinates, and (2) because data1 seems reorderer according to x = categ[1] before plotting. Thus, I have to use fill = dot.coord[rev(order(dot.coord[, categ[1]], decreasing = TRUE)), "dot.color"] to have the good corresponding colors # show.legend option do not remove the legend, only the aesthetic of the legend (dot, line, etc.)
- coord.names <- c(coord.names, "dots")
- if( ! is.null(dot.categ)){
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_dotplot(
- data = dot.coord,
- mapping = ggplot2::aes_string(x = categ[1], y = "y", alpha = dot.categ), # not dot.categ here because the classes of dot.categ create new separations
- position = ggplot2::position_dodge(width = box.width),
- binpositions = "all",
- binaxis = "y",
- stackdir = "center",
- fill = NA,
- stroke = NA,
- color = NA,
- # WARNING: do not use show.legend = TRUE because it uses the arguments outside aes() as aesthetics (here color and fill). Thus I must find a way using ggplot2::scale_discrete_manual()
- binwidth = (y.lim[2] - y.lim[1]) / dot.tidy.bin.nb
- )) # geom_dotplot ggplot2 v3.3.0: I had to remove rev() in fill and color # very weird behavior of geom_dotplot ggplot2 v3.2.1, (1) because with aes group = (to avoid legend), the dot plotting is not good in term of coordinates, and (2) because data1 seems reorderer according to x = categ[1] before plotting. Thus, I have to use fill = dot.coord[rev(order(dot.coord[, categ[1]], decreasing = TRUE)), "dot.color"] to have the good corresponding colors # show.legend option do not remove the legend, only the aesthetic of the legend (dot, line, etc.)
- # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "linetype", name = dot.legend.name, values = rep(1, length(categ.color)))) # values = rep("black", length(categ.color)) are the values of color (which is the border color of dots), and this modify the border color on the plot. WARNING: values = categ.color takes the numbers to make the colors if categ.color is a factor
- coord.names <- c(coord.names, "bad_remove")
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "alpha", name = dot.legend.name, values = rep(dot.alpha, length(dot.categ.class.order)), labels = dot.categ.class.order, guide = ggplot2::guide_legend(title = if(ini.dot.categ == categ[length(categ)]){dot.categ}else{ini.dot.categ}, override.aes = list(fill = levels(dot.coord$dot.color), color = if(is.null(dot.border.color)){levels(dot.coord$dot.color)}else{dot.border.color}, stroke = dot.border.size, alpha = dot.alpha)))) # values are the values of color (which is the border color in geom_box. WARNING: values = categ.color takes the numbers to make the colors if categ.color is a factor
- }
- # coordinates of tidy dots
- tempo.coord <- ggplot2::ggplot_build(eval(parse(text = paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "))))$data # to have the tidy dot coordinates
- if(length(which(sapply(X = tempo.coord, FUN = function(X){any(names(X) == "binwidth", na.rm = TRUE)}))) != 1){ # detect the compartment of tempo.coord which is the binned data frame
- # if(length(which(sapply(tempo.coord, FUN = nrow) == nrow(data1))) > if(is.null(dot.categ)){1}else{2}){ # this does not work if only one dot per class, thus replaced by above # if(is.null(dot.categ)){1}else{2} because 1 dotplot if dot.categ is NULL and 2 dotplots if not, with the second being a blank dotplot with wrong coordinates. Thus take the first in that situation
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nEITHER MORE THAN 1 OR NO COMPARTMENT HAVING A DATA FRAME WITH binwidth AS COLUMN NAME IN THE tempo.coord LIST (FOR TIDY DOT COORDINATES). CODE HAS TO BE MODIFIED")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else{
- # dot.coord.tidy1 <- tempo.coord[[which(sapply(tempo.coord, FUN = nrow) == nrow(data1))[1]]] # this does not work if only one dot per class, thus replaced by above # the second being a blank dotplot with wrong coordinates. Thus take the first whatever situation
- dot.coord.tidy1 <- tempo.coord[[which(sapply(X = tempo.coord, FUN = function(X){any(names(X) == "binwidth", na.rm = TRUE)}))]] # detect the compartment of tempo.coord which is the binned data frame
- dot.coord.tidy1$x <- as.numeric(dot.coord.tidy1$x) # because weird class
- dot.coord.tidy1$PANEL <- as.numeric(dot.coord.tidy1$PANEL) # because numbers as levels. But may be a problem is facet are reordered ?
- }
- # tempo.box.coord <- merge(box.coord, unique(dot.coord[, c("PANEL", "group", categ)]), by = c("PANEL", "group"), sort = FALSE) # not required anymore because box.coord already contains categ do not add dot.categ and tidy_group_coord here because the coordinates are for stats. Add the categ in box.coord. WARNING: by = c("PANEL", "group") without fill column because PANEL & group columns are enough as only one value of x column per group number in box.coord. Thus, no need to consider fill column
- # below inactivated because not true when dealing with dot.categ different from categ
- # if(nrow(tempo.box.coord) != nrow(box.coord)){
- # tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nTHE merge() FUNCTION DID NOT RETURN A CORRECT tempo.box.coord DATA FRAME. CODE HAS TO BE MODIFIED")
- # stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
- # }
- dot.coord.tidy2 <- merge(dot.coord.tidy1, box.coord[c("fill", "PANEL", "group", "x", categ)], by = c("PANEL", "group"), sort = FALSE) # send the coord of the boxes into the coord data.frame of the dots (in the column x.y).WARNING: by = c("PANEL", "group") without fill column because PANEL & group columns are enough as only one value of x column per group number in tempo.box.coord. Thus, no need to consider fill colum # DANGER: from here the fill.y and x.y (from tempo.box.coord) are not good in dot.coord.tidy2. It is ok because Categ1 Categ2 from tempo.box.coord are ok with the group column from dot.coord.tidy1. This is due to the fact that dot.coord.tidy resulting from geom_dotplot does not make the same groups as the other functions
- if(nrow(dot.coord.tidy2) != nrow(dot.coord)){
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nTHE merge() FUNCTION DID NOT RETURN A CORRECT dot.coord.tidy2 DATA FRAME. CODE HAS TO BE MODIFIED")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- # From here, check for dot.coord.tidy3 which wil be important for stat over the plot. WARNING: dot.categ has nothing to do here for stat coordinates. Thus, not in tempo.data1
- if(length(categ)== 1L){
- tempo.data1 <- unique(data.frame(data1[categ[1]], group = as.integer(data1[, categ[1]]), stringsAsFactors = TRUE)) # categ[1] is factor
- names(tempo.data1)[names(tempo.data1) == categ[1]] <- paste0(categ[1], ".check")
- verif <- paste0(categ[1], ".check")
- }else if(length(categ) == 2L){
- tempo.data1 <- unique(
- data.frame(
- data1[c(categ[1], categ[2])],
- group = as.integer(factor(paste0(
- formatC(as.integer(data1[, categ[2]]), width = nchar(max(as.integer(data1[, categ[2]]), na.rm = TRUE)), flag = "0"), # convert factor into numeric with leading zero for proper ranking
- ".",
- formatC(as.integer(data1[, categ[1]]), width = nchar(max(as.integer(data1[, categ[1]]), na.rm = TRUE)), flag = "0")# convert factor into numeric with leading zero for proper ranking
- )), stringsAsFactors = TRUE) # merge the 2 formatC() to create a new factor. The convertion to integer should recreate the correct group number
- )
- ) # categ[2] first if categ[2] is used to make the categories in ggplot and categ[1] is used to make the x-axis
- names(tempo.data1)[names(tempo.data1) == categ[1]] <- paste0(categ[1], ".check")
- names(tempo.data1)[names(tempo.data1) == categ[2]] <- paste0(categ[2], ".check")
- verif <- c(paste0(categ[1], ".check"), paste0(categ[2], ".check"))
- }else{
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nCODE INCONSISTENCY 4")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- dot.coord.tidy3 <- merge(dot.coord.tidy2, tempo.data1, by = intersect("group", "group"), sort = FALSE) # send the factors of data1 into coord. WARNING: I have tested intersect("group", "group") instead of by = "group". May be come back to by = "group" in case of error. But I did this because of an error in dot.coord.rd3 above
- if(nrow(dot.coord.tidy3) != nrow(dot.coord) | ( ! fun_comp_2d(dot.coord.tidy3[categ], dot.coord.tidy3[verif])$identical.content)){
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nTHE merge() FUNCTION DID NOT RETURN A CORRECT dot.coord.tidy3 DATA FRAME. CODE HAS TO BE MODIFIED")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- # end coordinates of tidy dots
+ on.exit(exp = options(warning.length = ini.warning.length), add = TRUE)
+ if(return == TRUE){
+ tempo.output <- ggplot2::ggplot_build(fin.plot)
+ tempo.output$data <- tempo.output$data[-1] # remove the first data because corresponds to the initial empty boxplot
+ if(length(tempo.output$data) != length(coord.names)){
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nlength(tempo.output$data) AND length(coord.names) MUST BE IDENTICAL. CODE HAS TO BE MODIFIED")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else{
+ names(tempo.output$data) <- coord.names
+ tempo.output$data <- tempo.output$data[coord.names != "bad_remove"]
}
+ tempo <- tempo.output$layout$panel_params[[1]]
+ output <- list(
+ data = data1.ini,
+ stat = stat.nolog,
+ removed.row.nb = removed.row.nb,
+ removed.rows = removed.rows,
+ plot = c(tempo.output$data, y.second.tick.values = list(y.second.tick.values)),
+ panel = facet.categ,
+ axes = list(
+ x.range = tempo$x.range,
+ x.labels = if(is.null(attributes(tempo$x$breaks))){tempo$x$breaks}else{tempo$x$scale$get_labels()}, # is.null(attributes(tempo$x$breaks)) test if it is number (TRUE) or character (FALSE)
+ x.positions = if(is.null(attributes(tempo$x$breaks))){tempo$x$breaks}else{unlist(attributes(tempo$x$breaks))},
+ y.range = tempo$y.range,
+ y.labels = if(is.null(attributes(tempo$y$breaks))){tempo$y$breaks}else{tempo$y$scale$get_labels()},
+ y.positions = if(is.null(attributes(tempo$y$breaks))){tempo$y$breaks}else{unlist(attributes(tempo$y$breaks))}
+ ),
+ warn = paste0("\n", warn, "\n\n"),
+ ggplot = if(return.ggplot == TRUE){fin.plot}else{NULL}, # fin.plot plots the graph if return == TRUE
+ gtable = if(return.gtable == TRUE){grob.save}else{NULL}
+ )
+ return(output) # this plots the graph if return.ggplot is TRUE and if no assignment
}
- # end dot display
-
-
-
- # boxplot display (if box.fill = FALSE, otherwise, already plotted above)
- if(box.fill == TRUE){
- # overcome "work only for the filling of boxes, not for the frame. See https://github.com/tidyverse/ggplot2/issues/252"
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "fill", name = box.legend.name, values = if(length(categ.color)== 1L){rep(categ.color, length(unique(data1[, categ[length(categ)]])))}else{categ.color}, guide = ggplot2::guide_legend(order = 1))) #, guide = ggplot2::guide_legend(override.aes = list(fill = levels(tempo.polygon$COLOR), color = "black")))) # values are the values of color (which is the border color in geom_box. WARNING: values = categ.color takes the numbers to make the colors if categ.color is a factor
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "color", name = box.legend.name, values = rep(hsv(0, 0, 0, alpha = box.alpha), length(unique(data1[, categ[length(categ)]]))), guide = ggplot2::guide_legend(order = 1))) # , guide = ggplot2::guide_legend(override.aes = list(color = "black", alpha = box.alpha)))) # values are the values of color (which is the border color in geom_box. WARNING: values = categ.color takes the numbers to make the colors if categ.color is a factor # outline of the polygon in black but with alpha
- }else{
- # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_boxplot(data = data1, mapping = ggplot2::aes_string(x = categ[1], y = y, color = categ[length(categ)], fill = categ[length(categ)]), position = ggplot2::position_dodge(width = NULL), width = box.width, size = box.line.size, notch = box.notch, alpha = box.alpha, coef = if(box.whisker.kind == "no"){0}else if(box.whisker.kind == "std"){1.5}else if(box.whisker.kind == "max"){Inf}, outlier.shape = if( ! is.null(dot.color)){NA}else{21}, outlier.color = if( ! is.null(dot.color)){NA}else{if(dot.border.size == 0){NA}else{dot.border.color}}, outlier.fill = if( ! is.null(dot.color)){NA}else{NULL}, outlier.size = if( ! is.null(dot.color)){NA}else{dot.size}, outlier.stroke = if( ! is.null(dot.color)){NA}else{dot.border.size}, outlier.alpha = if( ! is.null(dot.color)){NA}else{dot.alpha})) # the color, size, etc. of the outliers are dealt here. outlier.color = NA to do not plot outliers when dots are already plotted
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_path(
- data = tempo.polygon,
- mapping = ggplot2::aes_string(x = "X", y = "Y", group = "BOX", color = categ[length(categ)]),
- size = box.line.size,
- alpha = box.alpha,
- lineend = "round",
- linejoin = "round"
- ))
- coord.names <- c(coord.names, "main.box")
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = if(box.notch == FALSE){X_BOX_INF}else{X_NOTCH_INF}, xend = if(box.notch == FALSE){X_BOX_SUP}else{X_NOTCH_SUP}, y = MEDIAN, yend = MEDIAN, group = categ[length(categ)]), color = stat$COLOR, size = box.line.size * 2, alpha = box.alpha)) #
- coord.names <- c(coord.names, "median")
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = X, xend = X, y = BOX_SUP, yend = WHISK_SUP, group = categ[length(categ)]), color = stat$COLOR, size = box.line.size, alpha = box.alpha)) #
- coord.names <- c(coord.names, "sup.whisker")
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = X, xend = X, y = BOX_INF, yend = WHISK_INF, group = categ[length(categ)]), color = stat$COLOR, size = box.line.size, alpha = box.alpha)) #
- coord.names <- c(coord.names, "inf.whisker")
- if(box.whisker.width > 0){
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = X_WHISK_INF, xend = X_WHISK_SUP, y = WHISK_SUP, yend = WHISK_SUP, group = categ[length(categ)]), color = stat$COLOR, size = box.line.size, alpha = box.alpha, lineend = "round")) #
- coord.names <- c(coord.names, "sup.whisker.edge")
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_segment(data = stat, mapping = ggplot2::aes(x = X_WHISK_INF, xend = X_WHISK_SUP, y = WHISK_INF, yend = WHISK_INF, group = categ[length(categ)]), color = stat$COLOR, size = box.line.size, alpha = box.alpha, lineend = "round")) #
- coord.names <- c(coord.names, "inf.whisker.edge")
- }
- if(box.mean == TRUE){
- # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_point(data = stat, mapping = ggplot2::aes_string(x = "X", y = "MEAN", group = categ[length(categ)]), shape = 23, stroke = box.line.size * 2, color = stat$COLOR, size = box.mean.size, fill = NA, alpha = box.alpha)) # group used in aesthetic to do not have it in the legend. Here ggplot2::scale_discrete_manual() cannot be used because of the group easthetic
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_path(
- data = tempo.diamon.mean,
- mapping = ggplot2::aes(x = X, y = Y, group = GROUP),
- color = tempo.diamon.mean[, "COLOR"],
- size = box.line.size,
- alpha = box.alpha,
- lineend = "round",
- linejoin = "round"
- ))
- coord.names <- c(coord.names, "mean")
- }
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "fill", name = box.legend.name, values = rep(NA, length(unique(data1[, categ[length(categ)]]))))) #, guide = ggplot2::guide_legend(override.aes = list(color = categ.color)))) # values are the values of color (which is the border color in geom_box. WARNING: values = categ.color takes the numbers to make the colors if categ.color is a factor
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "color", name = box.legend.name, values = if(length(categ.color)== 1L){rep(categ.color, length(unique(data1[, categ[length(categ)]])))}else{categ.color}, guide = ggplot2::guide_legend(override.aes = list(alpha = if(plot == TRUE & ((length(dev.list()) > 0 & names(dev.cur()) == "windows") | (length(dev.list()) == 0L & Sys.info()["sysname"] == "Windows"))){1}else{box.alpha})))) # , guide = ggplot2::guide_legend(override.aes = list(color = as.character(categ.color))))) # values are the values of color (which is the border color in geom_box. WARNING: values = categ.color takes the numbers to make the colors if categ.color is a factor
- if(plot == TRUE & ((length(dev.list()) > 0 & names(dev.cur()) == "windows") | (length(dev.list()) == 0L & Sys.info()["sysname"] == "Windows"))){ # if any Graph device already open and this device is "windows", or if no Graph device opened yet and we are on windows system -> prevention of alpha legend bug on windows using value 1
- # to avoid a bug on windows: if alpha argument is different from 1 for lines (transparency), then lines are not correctly displayed in the legend when using the R GUI (bug https://github.com/tidyverse/ggplot2/issues/2452). No bug when using a pdf
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") GRAPHIC DEVICE USED ON A WINDOWS SYSTEM ->\nTRANSPARENCY OF THE LINES IS INACTIVATED IN THE LEGEND TO PREVENT A WINDOWS DEPENDENT BUG (SEE https://github.com/tidyverse/ggplot2/issues/2452)\nTO OVERCOME THIS ON WINDOWS, USE ANOTHER DEVICE (pdf() FOR INSTANCE)")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ # end output
+ # end main code
+}
+
+
+
+
+
+# add density
+# rasterise all kind: https://cran.r-project.org/web/packages/ggrastr/vignettes/Raster_geoms.html
+
+
+fun_gg_scatter <- function(
+ data1,
+ x,
+ y,
+ categ = NULL,
+ categ.class.order = NULL,
+ color = NULL,
+ geom = "geom_point",
+ geom.step.dir = "hv",
+ geom.stick.base = NULL,
+ alpha = 0.5,
+ dot.size = 2,
+ dot.shape = 21,
+ dot.border.size = 0.5,
+ dot.border.color = NULL,
+ line.size = 0.5,
+ line.type = "solid",
+ x.lim = NULL,
+ x.lab = NULL,
+ x.log = "no",
+ x.tick.nb = NULL,
+ x.second.tick.nb = NULL,
+ x.include.zero = FALSE,
+ x.left.extra.margin = 0.05,
+ x.right.extra.margin = 0.05,
+ x.text.angle = 0,
+ y.lim = NULL,
+ y.lab = NULL,
+ y.log = "no",
+ y.tick.nb = NULL,
+ y.second.tick.nb = NULL,
+ y.include.zero = FALSE,
+ y.top.extra.margin = 0.05,
+ y.bottom.extra.margin = 0.05,
+ y.text.angle = 0,
+ raster = FALSE,
+ raster.ratio = 1,
+ raster.threshold = NULL,
+ text.size = 12,
+ title = "",
+ title.text.size = 12,
+ legend.show = TRUE,
+ legend.width = 0.5,
+ legend.name = NULL,
+ article = TRUE,
+ grid = FALSE,
+ add = NULL,
+ return = FALSE,
+ return.ggplot = FALSE,
+ return.gtable = TRUE,
+ plot = TRUE,
+ warn.print = FALSE,
+ lib.path = NULL
+){
+ # AIM
+ # Plot ggplot2 scatterplot with the possibility to overlay dots from up to 3 different data frames (-> three different legends) and lines from up to 3 different data frames (-> three different legends) -> up to 6 overlays totally
+ # For ggplot2 specifications, see: https://ggplot2.tidyverse.org/articles/ggplot2-specs.html
+ # WARNINGS
+ # Rows containing NA in data1[, c(x, y, categ)] will be removed before processing, with a warning (see below)
+ # Size arguments (dot.size, dot.border.size, line.size, text.size and title.text.size) are in mm. See Hadley comment in https://stackoverflow.com/questions/17311917/ggplot2-the-unit-of-size. See also http://sape.inf.usi.ch/quick-reference/ggplot2/size). Unit object are not accepted, but conversion can be used (e.g., grid::convertUnit(grid::unit(0.2, "inches"), "mm", valueOnly = TRUE))
+ # ARGUMENTS
+ # data1: a dataframe compatible with ggplot2, or a list of data frames. Order matters for the order of the legend and for the layer staking (starting from below to top)
+ # x: single character string of the data1 column name for x-axis coordinates. If data1 is a list, then x must be a list of single character strings, of same size as data1, with compartment 1 related to compartment 1 of data1, etc. Write NULL for each "geom_hline" in geom argument
+ # y: single character string of the data1 column name for y-axis coordinates. If data1 is a list, then y must be a list of single character strings, of same size as data1, with compartment 1 related to compartment 1 of data1, etc. Write NULL for each "geom_vline" in geom argument
+ # categ: either NULL or a single character string or a list of single character strings, indicating the data1 column names to use for categories which creates legend display
+ # If categ == NULL, no categories -> no legend displayed
+ # If data1 is a data frame, categ must be a single character string of the data1 column name for categories
+ # If data1 is a list, then categ must be a list of single character strings, of same size as data1, with compartment 1 related to compartment 1 of data1, etc. Some of the list compartments can be NULL (no legend display for these compartments), and other not
+ # categ.class.order: either (1) NULL or (2) a vector of character strings or (3) a list of these vectors, setting the order of the classes of categ in the legend display
+ # If categ.class.order is NULL, classes are represented according to the alphabetical order
+ # If data1 is a data frame, categ.class.order must be a vector of character strings specifying the different classes in the categ column name of data1
+ # If data1 is a list, then categ.class.order must be a list of vector of character strings, of same size as data1, with compartment 1 related to compartment 1 of data1, etc. Some of the list compartments can be NULL (alphabetical order for these compartments), and other not
+ # color: either (1) NULL, or (2) a vector of character strings or integers, or (3) a list of vectors of character strings or integers
+ # If color is NULL, default colors of ggplot2
+ # If data1 is a data frame, color argument can be either:
+ # (1) a single color string. All the dots of the corresponding data1 will have this color, whatever the categ value (NULL or not)
+ # (2) if categ is non-null, a vector of string colors, one for each class of categ. Each color will be associated according to the categ.class.order argument if specified, or to the alphabetical order of categ classes otherwise
+ # (3) if categ is non-null, a vector or factor of string colors, like if it was one of the column of data1 data frame. WARNING: a single color per class of categ and a single class of categ per color must be respected
+ # Positive integers are also accepted instead of character strings, as long as above rules about length are respected. Integers will be processed by fun_gg_palette() using the max integer value among all the integers in color (see fun_gg_palette())
+ # If data1 is a list, then color argument must be either:
+ # (1) a list of character strings or integers, of same size as data1, with compartment 1 related to compartment 1 of data1, etc.
+ # (2) a single character string or a single integer
+ # With a list (first possibility), the rules described for when data1 is a data frame apply to each compartment of the list. Some of the compartments can be NULL. In that case, a different grey color will be used for each NULL compartment. With a single value (second possibility), the same color will be used for all the dots and lines, whatever the data1 list
+ # geom: single character string of the kind of plot, or a list of single character strings
+ # Either:
+ # "geom_point" (scatterplot)
+ # "geom_line" (coordinates plotted then line connection, from the lowest to highest x coordinates first and from the lowest to highest y coordinates thenafter)
+ # "geom_path" (coordinates plotted then line connection respecting the row order in data1)
+ # "geom_step" coordinates plotted then line connection respecting the row order in data1 but drawn in steps). See the geom.step.dir argument
+ # "geom_hline" (horizontal line, no x value provided)
+ # "geom_vline" (vertical line, no y value provided)
+ # "geom_stick" (dots as vertical bars)
+ # If data1 is a list, then geom must be either:
+ # (1) a list of single character strings, of same size as data1, with compartment 1 related to compartment 1 of data1, etc.
+ # (2) a single character string. In that case the same kind of plot will apply for the different compartments of the data1 list
+ # WARNING concerning "geom_hline" or "geom_vline":
+ # (1) x or y argument must be NULL, respectively
+ # (2) x.lim or y.lim argument must NOT be NULL, respectively, if only these kind of lines are drawn (if other geom present, then x.lim = NULL and y.lim = NULL will generate x.lim and y.lim defined by these other geom, which is not possible with "geom_hline" or "geom_vline" alone)
+ # (3) the function will draw n lines for n values in the x argument column name of the data1 data frame. If several colors required, the categ argument must be specified and the corresponding categ column name must exist in the data1 data frame with a different class name for each row
+ # geom.step.dir: single character string indicating the direction when using "geom_step" of the geom argument, or a list of single character strings
+ # Either:
+ # "vh" (vertical then horizontal)
+ # "hv" (horizontal then vertical)
+ # "mid" (step half-way between adjacent x-values)
+ # See https://ggplot2.tidyverse.org/reference/geom_path.html
+ # If data1 is a list, then geom.step.dir must be either:
+ # (1) a list of single character strings, of same size as data1, with compartment 1 related to compartment 1 of data1, etc. The value in compartments related to other geom values than "geom_step" will be ignored
+ # (2) a single character string, which will be used for all the "geom_step" values of the geom argument, whatever the data1 list
+ # geom.stick.base: either (1) NULL or (2) a single numeric value or (3) a list of single numeric values, setting the base of the sticks when using "geom_stick" of the geom argument
+ # If geom.stick.base is NULL, the bottom limit of the y-axis is taken as the base
+ # If data1 is a list, then geom.stick.base must be either (1) a list of single numeric values, of same size as data1, with compartment 1 related to compartment 1 of data1, etc., or (2) a single numeric value. With a list (former possibility), the values in compartments related to other geom values than "geom_stick" will be ignored. With a single value (latter possibility), the same base will be used for all the sticks, whatever the data1 list
+ # Warning: the y-axis limits are not modified by the value of geom.stick.base, meaning that this value can be outside of the range of y.lim. Add the value of geom.stick.base also in the y.lim argument if required
+ # Warning: if geom.stick.base is NULL, the bottom limit of the y-axis is taken as the base. Thus, be careful with inverted y-axis
+ # alpha: single numeric value (from 0 to 1) of transparency. If data1 is a list, then alpha must be either (1) a list of single numeric values, of same size as data1, with compartment 1 related to compartment 1 of data1, etc., or (2) a single numeric value. In that case the same transparency will apply for the different compartments of the data1 list
+ # dot.size: single numeric value of dot shape radius? in mm. If data1 is a list, then dot.size must be either (1) a list of single numeric values, of same size as data1, with compartment 1 related to compartment 1 of data1, etc., or (2) a single numeric value. With a list (former possibility), the value in compartments related to lines will be ignored. With a single value (latter possibility), the same dot.size will be used for all the dots, whatever the data1 list
+ # dot.shape: value indicating the shape of the dots (see https://ggplot2.tidyverse.org/articles/ggplot2-specs.html) If data1 is a list, then dot.shape must be either (1) a list of single shape values, of same size as data1, with compartment 1 related to compartment 1 of data1, etc., or (2) a single shape value. With a list (former possibility), the value in compartments related to lines will be ignored. With a single value (latter possibility), the same dot.shape will be used for all the dots, whatever the data1 list
+ # dot.border.size: single numeric value of border dot width in mm. Write zero for no dot border. If data1 is a list, then dot.border.size must be either (1) a list of single numeric values, of same size as data1, with compartment 1 related to compartment 1 of data1, etc., or (2) a single numeric value. With a list (former possibility), the value in compartments related to lines will be ignored. With a single value (latter possibility), the same dot.border.size will be used for all the dots, whatever the data1 list
+ # dot.border.color: single character color string defining the color of the dot border (same border color for all the dots, whatever their categories). If dot.border.color == NULL, the border color will be the same as the dot color. A single integer is also accepted instead of a character string, that will be processed by fun_gg_palette()
+ # line.size: single numeric value of line width in mm. If data1 is a list, then line.size must be either (1) a list of single numeric values, of same size as data1, with compartment 1 related to compartment 1 of data1, etc., or (2) a single numeric value. With a list (former possibility), the value in compartments related to dots will be ignored. With a single value (latter possibility), the same line.size will be used for all the lines, whatever the data1 list
+ # line.type: value indicating the kind of lines (see https://ggplot2.tidyverse.org/articles/ggplot2-specs.html) If data1 is a list, then line.type must be either (1) a list of single line kind values, of same size as data1, with compartment 1 related to compartment 1 of data1, etc., or (2) a single line kind value. With a list (former possibility), the value in compartments related to dots will be ignored. With a single value (latter possibility), the same line.type will be used for all the lines, whatever the data1 list
+ # x.lim: 2 numeric values setting the x-axis range. Order of the 2 values matters (for inverted axis). If NULL, the range of the x column name of data1 will be used
+ # x.lab: a character string or expression for x-axis label. If NULL, will use the first value of x (x column name of the first data frame in data1). Warning message if the elements in x are different between data frames in data1
+ # x.log: either "no", "log2" (values in the x column name of the data1 data frame will be log2 transformed and x-axis will be log2 scaled) or "log10" (values in the x column name of the data1 data frame will be log10 transformed and x-axis will be log10 scaled)
+ # x.tick.nb: approximate number of desired values labeling the x-axis (i.e., main ticks, see the n argument of the the cute::fun_scale() function). If NULL and if x.log is "no", then the number of labeling values is set by ggplot2. If NULL and if x.log is "log2" or "log10", then the number of labeling values corresponds to all the exposant integers in the x.lim range (e.g., 10^1, 10^2 and 10^3, meaning 3 main ticks for x.lim = c(9, 1200)). WARNING: if non-NULL and if x.log is "log2" or "log10", labeling can be difficult to read (e.g., ..., 10^2, 10^2.5, 10^3, ...)
+ # x.second.tick.nb: number of desired secondary ticks between main ticks. Ignored if x.log is other than "no" (log scale plotted). Use argument return = TRUE and see $plot$x.second.tick.values to have the values associated to secondary ticks. IF NULL, no secondary ticks
+ # x.include.zero: logical. Does x.lim range include 0? Ignored if x.log is "log2" or "log10"
+ # x.left.extra.margin: single proportion (between 0 and 1) indicating if extra margins must be added to x.lim. If different from 0, add the range of the axis multiplied by x.left.extra.margin (e.g., abs(x.lim[2] - x.lim[1]) * x.left.extra.margin) to the left of x-axis
+ # x.right.extra.margin: idem as x.left.extra.margin but to the right of x-axis
+ # x.text.angle: integer value of the text angle for the x-axis labeling values, using the same rules as in ggplot2. Use positive value for clockwise rotation: 0 for horizontal, 90 for vertical, 180 for upside down etc. Use negative values for counterclockwise rotation: 0 for horizontal, -90 for vertical, -180 for upside down etc.
+ # y.lim: 2 numeric values setting the y-axis range. Order of the 2 values matters (for inverted axis). If NULL, the range of the y column name of data1 will be used
+ # y.lab: a character string or expression for y-axis label. If NULL, will use the first value of y (y column name of the first data frame in data1). Warning message if the elements in y are different between data frames in data1
+ # y.log: either "no", "log2" (values in the y column name of the data1 data frame will be log2 transformed and y-axis will be log2 scaled) or "log10" (values in the y column name of the data1 data frame will be log10 transformed and y-axis will be log10 scaled)
+ # y.tick.nb: approximate number of desired values labeling the y-axis (i.e., main ticks, see the n argument of the the cute::fun_scale() function). If NULL and if y.log is "no", then the number of labeling values is set by ggplot2. If NULL and if y.log is "log2" or "log10", then the number of labeling values corresponds to all the exposant integers in the y.lim range (e.g., 10^1, 10^2 and 10^3, meaning 3 main ticks for y.lim = c(9, 1200)). WARNING: if non-NULL and if y.log is "log2" or "log10", labeling can be difficult to read (e.g., ..., 10^2, 10^2.5, 10^3, ...)
+ # y.second.tick.nb: number of desired secondary ticks between main ticks. Ignored if y.log is other than "no" (log scale plotted). Use argument return = TRUE and see $plot$y.second.tick.values to have the values associated to secondary ticks. IF NULL, no secondary ticks
+ # y.include.zero: logical. Does y.lim range include 0? Ignored if y.log is "log2" or "log10"
+ # y.top.extra.margin: single proportion (between 0 and 1) indicating if extra margins must be added to y.lim. If different from 0, add the range of the axis multiplied by y.top.extra.margin (e.g., abs(y.lim[2] - y.lim[1]) * y.top.extra.margin) to the top of y-axis
+ # y.bottom.extra.margin: idem as y.top.extra.margin but to the bottom of y-axis
+ # y.text.angle: integer value of the text angle for the y-axis labeling values, using the same rules as in ggplot2. Use positive value for clockwise rotation: 0 for horizontal, 90 for vertical, 180 for upside down etc. Use negative values for counterclockwise rotation: 0 for horizontal, -90 for vertical, -180 for upside down etc.
+ # raster: logical. Dots in raster mode? If FALSE, dots from each "geom_point" from geom argument are plotted in vectorial mode (bigger pdf and long to display if lots of dots). If TRUE, dots from each "geom_point" from geom argument are plotted in matricial mode (smaller pdf and easy display if lots of dots, but it takes time to generate the layer). If TRUE, the raster.ratio argument is used to avoid an ellipsoid representation of the dots. If TRUE, solve the transparency problem with some GUI. Overriden by the non-NULL raster.threshold argument
+ # raster.ratio: single numeric value indicating the height / width ratio of the graphic device used (for instance provided by the $dim compartment in the output of the fun_open() function). The default value is 1 because by default R opens a square graphic device. But this argument has to be set when using other device dimensions. Ignored if raster == FALSE
+ # raster.threshold: positive integer value indicating the limit of the dot number above which "geom_point" layers from the geom argument switch from vectorial mode to matricial mode (see the raster argument). If any layer is matricial, then the raster.ratio argument is used to avoid an ellipsoid representation of the dots. If non-NULL, it overrides the raster argument
+ # text.size: numeric value of the font size of the (1) axis numbers and axis legends and (2) texts in the graphic legend (in mm)
+ # title: character string of the graph title
+ # title.text.size: numeric value of the title font size in mm
+ # legend.show: logical. Show legend? Not considered if categ argument is NULL, because this already generate no legend, excepted if legend.width argument is non-NULL. In that specific case (categ is NULL, legend.show is TRUE and legend.width is non-NULL), an empty legend space is created. This can be useful when desiring graphs of exactly the same width, whatever they have legends or not
+ # legend.width: single proportion (between 0 and 1) indicating the relative width of the legend sector (on the right of the plot) relative to the width of the plot. Value 1 means that the window device width is split in 2, half for the plot and half for the legend. Value 0 means no room for the legend, which will overlay the plot region. Write NULL to inactivate the legend sector. In such case, ggplot2 will manage the room required for the legend display, meaning that the width of the plotting region can vary between graphs, depending on the text in the legend
+ # legend.name: character string of the legend title. If legend.name is NULL and categ argument is not NULL, then legend.name <- categ. If data1 is a list, then legend.name must be a list of character strings, of same size as data1, with compartment 1 related to compartment 1 of data1, etc. Some of the list compartments can be NULL, and other not
+ # article: logical. If TRUE, use an article theme (article like). If FALSE, use a classic related ggplot theme. Use the add argument (e.g., add = "+ggplot2::theme_classic()" for the exact classic ggplot theme
+ # grid: logical. Draw lines in the background to better read the box values? Not considered if article == FALSE (grid systematically present)
+ # add: character string allowing to add more ggplot2 features (dots, lines, themes, facet, etc.). Ignored if NULL
+ # WARNING: (1) the string must start with "+", (2) the string must finish with ")" and (3) each function must be preceded by "ggplot2::". Example: "+ ggplot2::coord_flip() + ggplot2::theme_bw()"
+ # If the character string contains the "ggplot2::theme" string, then the article argument of fun_gg_scatter() (see above) is ignored with a warning. In addition, some arguments can be overwritten, like x.angle (check all the arguments)
+ # Handle the add argument with caution since added functions can create conflicts with the preexisting internal ggplot2 functions
+ # WARNING: the call of objects inside the quotes of add can lead to an error if the name of these objects are some of the fun_gg_scatter() arguments. Indeed, the function will use the internal argument instead of the global environment object. Example article <- "a" in the working environment and add = '+ ggplot2::ggtitle(article)'. The risk here is to have TRUE as title. To solve this, use add = '+ ggplot2::ggtitle(get("article", envir = .GlobalEnv))'
+ # return: logical. Return the graph parameters?
+ # return.ggplot: logical. Return the ggplot object in the output list? Ignored if return argument is FALSE. WARNING: always assign the fun_gg_scatter() function (e.g., a <- fun_gg_scatter()) if return.ggplot argument is TRUE, otherwise, double plotting is performed. See $ggplot in the RETURN section below for more details
+ # return.gtable: logical. Return the ggplot object as gtable of grobs in the output list? Ignored if plot argument is FALSE. Indeed, the graph must be plotted to get the grobs dispositions. See $gtable in the RETURN section below for more details
+ # plot: logical. Plot the graphic? If FALSE and return argument is TRUE, graphical parameters and associated warnings are provided without plotting
+ # warn.print: logical. Print warnings at the end of the execution? ? If FALSE, warning messages are never printed, but can still be recovered in the returned list. Some of the warning messages (those delivered by the internal ggplot2 functions) are not apparent when using the argument plot = FALSE
+ # lib.path: character string indicating the absolute path of the required packages (see below). if NULL, the function will use the R library default folders
+ # RETURN
+ # a scatter plot if plot argument is TRUE
+ # a list of the graph info if return argument is TRUE:
+ # $data: the initial data with graphic information added. WARNING: if the x.log or y.log argument is not "no", x or y argument column of the data1 data frame are log2 or log10 converted in $data, respectively. Use 2^values or 10^$values to recover the initial values
+ # $removed.row.nb: a list of the removed rows numbers in data frames (because of NA). NULL if no row removed
+ # $removed.rows: a list of the removed rows in data frames (because of NA). NULL if no row removed
+ # $plot: the graphic box and dot coordinates
+ # $dots: dot coordinates
+ # y.second.tick.positions: coordinates of secondary ticks (only if y.second.tick.nb argument is non-null or if y.log argument is different from "no")
+ # y.second.tick.values: values of secondary ticks. NULL except if y.second.tick.nb argument is non-null or if y.log argument is different from "no")
+ # $panel: the variable names used for the panels (NULL if no panels). WARNING: NA can be present according to ggplot2 upgrade to v3.3.0
+ # $axes: the x-axis and y-axis info
+ # $warn: the warning messages. Use cat() for proper display. NULL if no warning. WARNING: warning messages delivered by the internal ggplot2 functions are not apparent when using the argument plot = FALSE
+ # $ggplot: ggplot object that can be used for reprint (use print($ggplot) or update (use $ggplot + ggplot2::...). NULL if return.ggplot argument is FALSE. Of note, a non-null $ggplot in the output list is sometimes annoying as the manipulation of this list prints the plot
+ # $gtable: gtable object that can be used for reprint (use gridExtra::grid.arrange(...$ggplot) or with additionnal grobs (see the grob decomposition in the examples). NULL if return.ggplot argument is FALSE. Contrary to $ggplot, a non-NULL $gtable in the output list is not annoying as the manipulation of this list does not print the plot
+ # REQUIRED PACKAGES
+ # ggplot2
+ # gridExtra
+ # lemon (in case of use in the add argument)
+ # scales
+ # if raster plots are drawn (see the raster and raster.threshold arguments):
+ # Cairo
+ # grid
+ # REQUIRED FUNCTIONS FROM THE cute PACKAGE
+ # fun_gg_empty_graph()
+ # fun_gg_palette()
+ # fun_gg_point_rast()
+ # fun_pack()
+ # fun_check()
+ # fun_round()
+ # fun_scale()
+ # fun_inter_ticks()
+ # EXAMPLES
+ # set.seed(1) ; obs1 <- data.frame(Km = c(2, 1, 6, 5, 4, 7), Time = c(2, 1, 6, 5, 4, 7)^2, Car = c("TUUT", "TUUT", "TUUT", "WIIM", "WIIM", "WIIM"), Color1 = rep(c("coral", "lightblue"), each = 3), stringsAsFactors = TRUE) ; fun_gg_scatter(data1 = obs1, x = "Km", y = "Time")
+ # DEBUGGING
+ # set.seed(1) ; obs1 <- data.frame(km = rnorm(1000, 10, 3), time = rnorm(1000, 10, 3), group1 = rep(c("A1", "A2"), 500), stringsAsFactors = TRUE) ; obs2 <-data.frame(km = rnorm(1000, 15, 3), time = rnorm(1000, 15, 3), group2 = rep(c("G1", "G2"), 500), stringsAsFactors = TRUE) ; set.seed(NULL) ; obs1$km[2:3] <- NA ; data1 = list(L1 = obs1, L2 = obs2) ; x = list(L1 = "km", L2 = "km") ; y = list(L1 = "time", L2 = "time") ; categ = list(L1 = "group1", L2 = "group2") ; categ = NULL ; categ.class.order = NULL ; color = NULL ; geom = "geom_point" ; geom.step.dir = "hv" ; geom.stick.base = NULL ; alpha = 0.5 ; dot.size = 2 ; dot.shape = 21 ; dot.border.size = 0.5 ; dot.border.color = NULL ; line.size = 0.5 ; line.type = "solid" ; x.lim = NULL ; x.lab = NULL ; x.log = "no" ; x.tick.nb = NULL ; x.second.tick.nb = NULL ; x.include.zero = FALSE ; x.left.extra.margin = 0.05 ; x.right.extra.margin = 0.05 ; x.text.angle = 0 ; y.lim = NULL ; y.lab = NULL ; y.log = "no" ; y.tick.nb = NULL ; y.second.tick.nb = NULL ; y.include.zero = FALSE ; y.top.extra.margin = 0.05 ; y.bottom.extra.margin = 0.05 ; y.text.angle = 0 ; raster = FALSE ; raster.ratio = 1 ; raster.threshold = NULL ; text.size = 12 ; title = "" ; title.text.size = 12 ; legend.show = TRUE ; legend.width = 0.5 ; legend.name = NULL ; article = TRUE ; grid = FALSE ; add = NULL ; return = FALSE ; return.ggplot = FALSE ; return.gtable = TRUE ; plot = TRUE ; warn.print = FALSE ; lib.path = NULL
+ # function name
+ function.name <- paste0(as.list(match.call(expand.dots=FALSE))[[1]], "()")
+ arg.names <- names(formals(fun = sys.function(sys.parent(n = 2)))) # names of all the arguments
+ arg.user.setting <- as.list(match.call(expand.dots=FALSE))[-1] # list of the argument settings (excluding default values not provided by the user)
+ # end function name
+ # required function checking
+ req.function <- c(
+ "fun_check",
+ "fun_gg_just",
+ "fun_gg_empty_graph",
+ "fun_gg_palette",
+ "fun_gg_point_rast",
+ "fun_round",
+ "fun_pack",
+ "fun_scale",
+ "fun_inter_ticks"
+ )
+ tempo <- NULL
+ for(i1 in req.function){
+ if(length(find(i1, mode = "function"))== 0L){
+ tempo <- c(tempo, i1)
}
}
- if(box.alpha == 0){ # remove box legend because no boxes drawn
- # add this after the scale_xxx_manual() for boxplots
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::guides(fill = "none", color = "none")) # inactivate the legend
+ if( ! is.null(tempo)){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nREQUIRED cute FUNCTION", ifelse(length(tempo) > 1, "S ARE", " IS"), " MISSING IN THE R ENVIRONMENT:\n", paste0(tempo, collapse = "()\n"))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
}
- # end boxplot display (if box.fill = FALSE, otherwise, already plotted above)
-
-
-
-
- # stat display
- # layer after dots but ok, behind dots on the plot
- if( ! is.null(stat.pos)){
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") NUMBERS DISPLAYED ARE ", ifelse(stat.mean == FALSE, "MEDIANS", "MEANS"))
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
- if(stat.pos == "top"){
- tempo.stat <- data.frame(stat, Y = y.lim[2], stringsAsFactors = TRUE) # I had to create a data frame for geom_tex() so that facet is taken into account, (ggplot2::annotate() does not deal with facet because no data and mapping arguments). Of note, facet.categ is in tempo.stat, via tempo.mean, via dot.coord
- if(stat.mean == FALSE){tempo.stat$MEDIAN <- formatC(stat.nolog$MEDIAN, digit = 2, drop0trailing = TRUE, format = "f")}else{tempo.stat$MEAN <- formatC(stat.nolog$MEAN, digit = 2, drop0trailing = TRUE, format = "f")}
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_text(
- data = tempo.stat,
- mapping = ggplot2::aes_string(x = "X", y = "Y", label = ifelse(stat.mean == FALSE, "MEDIAN", "MEAN")),
- size = stat.size,
- color = "black",
- angle = stat.angle,
- hjust = stat.just$hjust,
- vjust = stat.just$vjust
- )) # stat$X used here because identical to stat.nolog but has the X. WARNING: no need of order() for labels because box.coord$x set the order. For justification, see https://stackoverflow.com/questions/7263849/what-do-hjust-and-vjust-do-when-making-a-plot-using-ggplot
- coord.names <- c(coord.names, "stat.pos")
- }else if(stat.pos == "above"){
- # stat coordinates
- if( ! is.null(dot.color)){ # for text just above max dot
- if(dot.tidy == FALSE){
- tempo.stat.ini <- dot.coord.rd3
- }else if(dot.tidy == TRUE){
- tempo.stat.ini <- dot.coord.tidy3
- tempo.stat.ini$x.y <- tempo.stat.ini$x.x # this is just to be able to use tempo.stat.ini$x.y for untidy or tidy dots (remember that dot.coord.tidy3$x.y is not good, see above)
- }
- stat.coord1 <- aggregate(x = tempo.stat.ini["y"], by = {x.env <- if(length(categ)== 1L){list(tempo.stat.ini$group, tempo.stat.ini$PANEL, tempo.stat.ini$x.y, tempo.stat.ini[, categ[1]])}else if(length(categ) == 2L){list(tempo.stat.ini$group, tempo.stat.ini$PANEL, tempo.stat.ini$x.y, tempo.stat.ini[, categ[1]], tempo.stat.ini[, categ[2]])} ; names(x.env) <- if(length(categ)== 1L){c("group", "PANEL", "x.y", categ[1])}else if(length(categ) == 2L){c("group", "PANEL", "x.y", categ[1], categ[2])} ; x.env}, FUN = min, na.rm = TRUE)
- names(stat.coord1)[names(stat.coord1) == "y"] <- "dot.min"
- stat.coord2 <- aggregate(x = tempo.stat.ini["y"], by = {x.env <- if(length(categ)== 1L){list(tempo.stat.ini$group, tempo.stat.ini$PANEL, tempo.stat.ini$x.y, tempo.stat.ini[, categ[1]])}else if(length(categ) == 2L){list(tempo.stat.ini$group, tempo.stat.ini$PANEL, tempo.stat.ini$x.y, tempo.stat.ini[, categ[1]], tempo.stat.ini[, categ[2]])} ; names(x.env) <- if(length(categ)== 1L){c("group", "PANEL", "x.y", categ[1])}else if(length(categ) == 2L){c("group", "PANEL", "x.y", categ[1], categ[2])} ; x.env}, FUN = max, na.rm = TRUE)
- names(stat.coord2) <- paste0(names(stat.coord2), "_from.dot.max")
- names(stat.coord2)[names(stat.coord2) == "y_from.dot.max"] <- "dot.max"
- stat.coord3 <- cbind(box.coord[order(box.coord$group, box.coord$PANEL), ], stat.coord1[order(stat.coord1$group, stat.coord1$x.y), ], stat.coord2[order(stat.coord2$group, stat.coord2$x.y), ], stringsAsFactors = TRUE) #
- if( ! all(identical(round(stat.coord3$x, 9), round(as.numeric(stat.coord3$x.y), 9)), na.rm = TRUE)){ # as.numeric() because stat.coord3$x is class "mapped_discrete" "numeric"
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nFUSION OF box.coord, stat.coord1 AND stat.coord2 ACCORDING TO box.coord$x, stat.coord1$x.y AND stat.coord2$x.y IS NOT CORRECT. CODE HAS TO BE MODIFIED")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- # text.coord <- stat.coord3[, c("x", "group", "dot.min", "dot.max")]
- # names(text.coord)[names(text.coord) == "dot.min"] <- "text.min.pos"
- #names(text.coord)[names(text.coord) == "dot.max"] <- "text.max.pos"
- box.coord <- box.coord[order(box.coord$x, box.coord$group, box.coord$PANEL), ]
- # text.coord <- text.coord[order(text.coord$x), ] # to be sure to have the two objects in the same order for x. WARNING: cannot add identical(as.integer(text.coord$group), as.integer(box.coord$group)) because with error, the correspondence between x and group is not the same
- stat.coord3 <- stat.coord3[order(stat.coord3$x, stat.coord3$group, stat.coord3$PANEL), ] # to be sure to have the two objects in the same order for x. WARNING: cannot add identical(as.integer(text.coord$group), as.integer(box.coord$group)) because with error, the correspondence between x and group is not the same
- if( ! (identical(box.coord$x, stat.coord3$x) & identical(box.coord$group, stat.coord3$group) & identical(box.coord$PANEL, stat.coord3$PANEL))){
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\ntext.coord AND box.coord DO NOT HAVE THE SAME x, group AND PANEL COLUMN CONTENT")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- }else{
- stat.coord3 <- box.coord
- }
- stat.coord3 <- data.frame(
- stat.coord3,
- Y = stat.coord3[, ifelse(
- is.null(dot.color),
- ifelse(diff(y.lim) > 0, "ymax", "ymin"),
- ifelse(diff(y.lim) > 0, "ymax_final", "ymin_final")
- )],
- stringsAsFactors = TRUE
- ) # ymax is top whisker, ymax_final is top dot
- # stat.coord3 <- data.frame(stat.coord3, Y = vector("numeric", length = nrow(stat.coord3)), stringsAsFactors = TRUE)
- # check.Y <- as.logical(stat.coord3$Y) # convert everything in Y into FALSE (because Y is full of zero)
- # end stat coordinates
- # stat display
- # performed twice: first for y values >=0, then y values < 0, because only a single value allowed for hjust anf vjust
- if(stat.mean == FALSE){
- tempo.center.ref <- "middle"
- }else{
- tempo.center.ref <- "MEAN"
- }
- # if(is.null(dot.color)){
- # tempo.low.ref <- "ymin"
- # tempo.high.ref <- "ymax"
- # }else{
- # tempo.low.ref <- "ymin_final"
- # tempo.high.ref <- "ymax_final"
- # }
- # tempo.log.high <- if(diff(y.lim) > 0){stat.coord3[, tempo.center.ref] >= 0}else{stat.coord3[, tempo.center.ref] < 0}
- # tempo.log.low <- if(diff(y.lim) > 0){stat.coord3[, tempo.center.ref] < 0}else{stat.coord3[, tempo.center.ref] >= 0}
- # stat.coord3$Y[tempo.log.high] <- stat.coord3[tempo.log.high, tempo.high.ref]
- # stat.coord3$Y[tempo.log.low] <- stat.coord3[tempo.log.low, tempo.low.ref]
- # add distance
- stat.coord3$Y <- stat.coord3$Y + diff(y.lim) * stat.dist / 100
- # end add distance
- # correct median or mean text format
- if(y.log != "no"){
- stat.coord3[, tempo.center.ref] <- ifelse(y.log == "log2", 2, 10)^(stat.coord3[, tempo.center.ref])
- }
- stat.coord3[, tempo.center.ref] <- formatC(stat.coord3[, tempo.center.ref], digit = 2, drop0trailing = TRUE, format = "f")
- # end correct median or mean text format
- # if(any(tempo.log.high) == TRUE){
- # tempo.stat <- stat.coord3[tempo.log.high,]
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_text(
- data = stat.coord3,
- mapping = ggplot2::aes_string(x = "x", y = "Y", label = tempo.center.ref),
- size = stat.size,
- color = "black",
- angle = stat.angle,
- hjust = stat.just$hjust,
- vjust = stat.just$vjust
- )) # WARNING: no need of order() for labels because box.coord$x set the order
- coord.names <- c(coord.names, "stat.pos")
- # }
- # if(any(tempo.log.low) == TRUE){
- # tempo.stat <- stat.coord3[tempo.log.low,]
- # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_text(
- # data = tempo.stat,
- # mapping = ggplot2::aes_string(x = "x", y = "Y", label = tempo.center.ref),
- # size = stat.size,
- # color = "black",
- # hjust = ifelse(vertical == TRUE, 0.5, 0.5 + stat.dist),
- # vjust = ifelse(vertical == TRUE, 0.5 + stat.dist, 0.5)
- # )) # WARNING: no need of order() for labels because box.coord$x set the order
- # coord.names <- c(coord.names, "stat.pos.negative")
- # }
- # end stat display
- }else{
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nCODE INCONSISTENCY 5")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
+ # end required function checking
+ # reserved words to avoid bugs (used in this function)
+ reserved.words <- c("fake_x", "fake_y", "fake_categ")
+ # end reserved words to avoid bugs (used in this function)
+ # arg with no default values
+ mandat.args <- c(
+ "data1",
+ "x",
+ "y"
+ )
+ tempo <- eval(parse(text = paste0("missing(", paste0(mandat.args, collapse = ") | missing("), ")")))
+ if(any(tempo)){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nFOLLOWING ARGUMENT", ifelse(length(mandat.args) > 1, "S HAVE", "HAS"), " NO DEFAULT VALUE AND REQUIRE ONE:\n", paste0(mandat.args, collapse = "\n"))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
}
- # end stat display
- # legend management
- if(legend.show == FALSE){ # must be here because must be before bef.final.plot <-
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::guides(fill = "none", color = "none", alpha = "none")) # inactivate the initial legend
+ # end arg with no default values
+ # argument primary checking
+ arg.check <- NULL #
+ text.check <- NULL #
+ checked.arg.names <- NULL # for function debbuging: used by r_debugging_tools
+ ee <- expression(arg.check <- c(arg.check, tempo$problem) , text.check <- c(text.check, tempo$text) , checked.arg.names <- c(checked.arg.names, tempo$object.name))
+ tempo1 <- fun_check(data = data1, class = "data.frame", na.contain = TRUE, fun.name = function.name)
+ tempo2 <- fun_check(data = data1, class = "list", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": data1 ARGUMENT MUST BE A DATA FRAME OR A LIST OF DATA FRAMES")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
}
- # end legend management
-
-
-
- # y scale management (cannot be before dot plot management)
- # the rescaling aspect is complicated and not intuitive. See:
- # explaination: https://github.com/tidyverse/ggplot2/issues/3948
- # the oob argument of scale_y_continuous() https://ggplot2.tidyverse.org/reference/scale_continuous.html
- # see also https://github.com/rstudio/cheatsheets/blob/master/data-visualization-2.1.pdf
- # secondary ticks
- bef.final.plot <- ggplot2::ggplot_build(eval(parse(text = paste(paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "), ' + if(vertical == TRUE){ggplot2::scale_y_continuous(expand = c(0, 0), limits = sort(y.lim), oob = scales::rescale_none)}else{ggplot2::coord_flip(ylim = y.lim)}')))) # here I do not need the x-axis and y-axis orientation, I just need the number of main ticks and the legend. I DI NOT UNDERSTAND THE COMMENT HERE BECAUSE WE NEED COORD_FLiP
- tempo.coord <- bef.final.plot$layout$panel_params[[1]]
- # y.second.tick.positions: coordinates of secondary ticks (only if y.second.tick.nb argument is non NULL or if y.log argument is different from "no")
- if(y.log != "no"){ # integer main ticks for log2 and log10
- tempo.scale <- (as.integer(min(y.lim, na.rm = TRUE)) - 1):(as.integer(max(y.lim, na.rm = TRUE)) + 1)
- }else{
- tempo <- if(is.null(attributes(tempo.coord$y$breaks))){tempo.coord$y$breaks}else{unlist(attributes(tempo.coord$y$breaks))}
- if(all(is.na(tempo))){# all() without na.rm -> ok because is.na() cannot be NA
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nONLY NA IN tempo.coord$y$breaks")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ if( ! is.null(x)){
+ tempo1 <- fun_check(data = x, class = "vector", mode = "character", na.contain = TRUE, length = 1, fun.name = function.name)
+ tempo2 <- fun_check(data = x, class = "list", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": x ARGUMENT MUST BE A SINGLE CHARACTER STRING OR A LIST OF CHARACTER STRINGS")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
}
- tempo.scale <- fun_scale(lim = y.lim, n = ifelse(is.null(y.tick.nb), length(tempo[ ! is.na(tempo)]), y.tick.nb)) # in ggplot 3.3.0, tempo.coord$y.major_source replaced by tempo.coord$y$breaks. If fact: n = ifelse(is.null(y.tick.nb), length(tempo[ ! is.na(tempo)]), y.tick.nb)) replaced by n = ifelse(is.null(y.tick.nb), 4, y.tick.nb))
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = x, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- y.second.tick.values <- NULL
- y.second.tick.pos <- NULL
- if(y.log != "no"){
- tempo <- fun_inter_ticks(lim = y.lim, log = y.log)
- y.second.tick.values <- tempo$values
- y.second.tick.pos <- tempo$coordinates
- # if(vertical == TRUE){ # do not remove in case the bug is fixed
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(geom = "segment", y = y.second.tick.pos, yend = y.second.tick.pos, x = tempo.coord$x.range[1], xend = tempo.coord$x.range[1] + diff(tempo.coord$x.range) / 80))
- # }else{ # not working because of the ggplot2 bug
- # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(geom = "segment", x = y.second.tick.pos, xend = y.second.tick.pos, y = tempo.coord$y.range[1], yend = tempo.coord$y.range[1] + diff(tempo.coord$y.range) / 80))
- # }
- coord.names <- c(coord.names, "y.second.tick.positions")
- }else if(( ! is.null(y.second.tick.nb)) & y.log == "no"){
- # if(y.second.tick.nb > 0){ #inactivated because already checked before
- if(length(tempo.scale) < 2){
- tempo.cat1 <- c("y.tick.nb", "y.second.tick.nb")
- tempo.cat2 <- sapply(list(y.tick.nb, y.second.tick.nb), FUN = paste0, collapse = " ")
- tempo.sep <- sapply(mapply(" ", max(nchar(tempo.cat1)) - nchar(tempo.cat1) + 3, FUN = rep, SIMPLIFY = FALSE), FUN = paste0, collapse = "")
- tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE NUMBER OF GENERATED TICKS FOR THE Y-AXIS IS NOT CORRECT: ", length(tempo.scale), "\nUSING THESE ARGUMENT SETTINGS (NO DISPLAY MEANS NULL VALUE):\n", paste0(tempo.cat1, tempo.sep, tempo.cat2, collapse = "\n"), "\nPLEASE, TEST OTHER VALUES")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else{
- tempo <- fun_inter_ticks(lim = y.lim, log = y.log, breaks = tempo.scale, n = y.second.tick.nb)
+ if( ! is.null(y)){
+ tempo1 <- fun_check(data = y, class = "vector", mode = "character", na.contain = TRUE, length = 1, fun.name = function.name)
+ tempo2 <- fun_check(data = y, class = "list", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": y ARGUMENT MUST BE A SINGLE CHARACTER STRING OR A LIST OF CHARACTER STRINGS")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
}
- y.second.tick.values <- tempo$values
- y.second.tick.pos <- tempo$coordinates
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(
- geom = "segment",
- y = y.second.tick.pos,
- yend = y.second.tick.pos,
- x = if(vertical == TRUE){tempo.coord$x.range[1]}else{tempo.coord$y.range[1]},
- xend = if(vertical == TRUE){tempo.coord$x.range[1] + diff(tempo.coord$x.range) / 80}else{tempo.coord$y.range[1] + diff(tempo.coord$y.range) / 80}
- ))
- coord.names <- c(coord.names, "y.second.tick.positions")
- }
- # end y.second.tick.positions
- # for the ggplot2 bug with y.log, this does not work: eval(parse(text = ifelse(vertical == FALSE & y.log == "log10", "ggplot2::scale_x_continuous", "ggplot2::scale_y_continuous")))
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_y_continuous(
- breaks = tempo.scale,
- minor_breaks = y.second.tick.pos,
- labels = if(y.log == "log10"){scales::trans_format("identity", scales::math_format(10^.x))}else if(y.log == "log2"){scales::trans_format("identity", scales::math_format(2^.x))}else if(y.log == "no"){ggplot2::waiver()}else{tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nCODE INCONSISTENCY 6") ; stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)}, # == in stop() to be able to add several messages between ==
- expand = c(0, 0), # remove space after after axis limits
- limits = sort(y.lim), # NA indicate that limits must correspond to data limits but ylim() already used
- oob = scales::rescale_none,
- trans = ifelse(diff(y.lim) < 0, "reverse", "identity") # equivalent to ggplot2::scale_y_reverse() but create the problem of y-axis label disappearance with y.lim decreasing. Thus, do not use. Use ylim() below and after this
- ))
- if(vertical == TRUE){
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::coord_cartesian(ylim = y.lim)) # problem of ggplot2::ylim() is that it redraws new breaks # coord_cartesian(ylim = y.lim)) not used because bug -> y-axis label disappearance with y.lim decreasing I DO NOT UNDERSTAND THIS MESSAGE WHILE I USE COORD_CARTESIAN # clip = "off" to have secondary ticks outside plot region does not work
}else{
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::coord_flip(ylim = y.lim)) # clip = "off" to have secondary ticks outside plot region does not work # create the problem of y-axis label disappearance with y.lim decreasing. IDEM ABOVE
-
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = y, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- # end y scale management (cannot be before dot plot management)
-
-
- # legend management
- if( ! is.null(legend.width)){
- legend.final <- fun_gg_get_legend(ggplot_built = bef.final.plot, fun.name = function.name, lib.path = lib.path) # get legend
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::guides(fill = "none", color = "none", alpha = "none")) # inactivate the initial legend
- if(is.null(legend.final) & plot == TRUE){ # even if any(unlist(legend.disp)) is TRUE
- legend.final <- ggplot2::ggplot()+ggplot2::theme_void() # empty graph instead of legend
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") LEGEND REQUESTED (NON NULL categ ARGUMENT OR legend.show ARGUMENT SET TO TRUE)\nBUT IT SEEMS THAT THE PLOT HAS NO LEGEND -> EMPTY LEGEND SPACE CREATED BECAUSE OF THE NON NULL legend.width ARGUMENT\n")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ if( ! is.null(categ)){
+ tempo1 <- fun_check(data = categ, class = "vector", mode = "character", length = 1, fun.name = function.name)
+ tempo2 <- fun_check(data = categ, class = "list", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": categ ARGUMENT MUST BE A SINGLE CHARACTER STRING OR A LIST OF CHARACTER STRINGS")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
}
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = categ, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- # end legend management
-
-
- # drawing
- fin.plot <- suppressMessages(suppressWarnings(eval(parse(text = paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + ")))))
- grob.save <- NULL
- if(plot == TRUE){
- # following lines inactivated because of problem in warn.recov and message.recov
- # assign("env_fun_get_message", new.env())
- # assign("tempo.gg.name", tempo.gg.name, envir = env_fun_get_message)
- # assign("tempo.gg.count", tempo.gg.count, envir = env_fun_get_message)
- # assign("add", add, envir = env_fun_get_message)
- # two next line: for the moment, I cannot prevent the warning printing
- # warn.recov <- fun_get_message(paste(paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "), if(is.null(add)){NULL}else{add}), kind = "warning", header = FALSE, print.no = FALSE, env = env_fun_get_message) # for recovering warnings printed by ggplot() functions
- # message.recov <- fun_get_message('print(eval(parse(text = paste(paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "), if(is.null(add)){NULL}else{add}))))', kind = "message", header = FALSE, print.no = FALSE, env = env_fun_get_message) # for recovering messages printed by ggplot() functions
- # if( ! (return == TRUE & return.ggplot == TRUE)){ # because return() plots when return.ggplot is TRUE # finally not used -> see return.ggplot description
- if(is.null(legend.width)){
- grob.save <- suppressMessages(suppressWarnings(gridExtra::grid.arrange(fin.plot)))
- }else{
- grob.save <-suppressMessages(suppressWarnings(gridExtra::grid.arrange(fin.plot, legend.final, ncol=2, widths=c(1, legend.width))))
+ if( ! is.null(categ.class.order)){
+ if(is.null(categ)){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": categ.class.order ARGUMENT IS NOT NULL, BUT categ IS")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ tempo1 <- fun_check(data = categ.class.order, class = "vector", mode = "character", fun.name = function.name)
+ tempo2 <- fun_check(data = categ.class.order, class = "list", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": categ.class.order ARGUMENT MUST BE A VECTOR OF CHARACTER STRINGS OR A LIST OF VECTOR OF CHARACTER STRINGS")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
}
- # }
- # suppressMessages(suppressWarnings(print(eval(parse(text = paste(paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "), if(is.null(add)){NULL}else{add}))))))
}else{
- # following lines inactivated because of problem in warn.recov and message.recov
- # message.recov <- NULL
- # warn.recov <- NULL
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") PLOT NOT SHOWN AS REQUESTED")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = categ.class.order, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- # end drawing
-
-
-
- # output
- # following lines inactivated because of problem in warn.recov and message.recov
- # if( ! (is.null(warn) & is.null(warn.recov) & is.null(message.recov))){
- # warn <- paste0(warn, "\n\n", if(length(warn.recov) > 0 | length(message.recov) > 0){paste0(paste0("MESSAGES FROM ggplot2 FUNCTIONS: ", ifelse( ! is.null(warn.recov), unique(message.recov), ""), ifelse( ! is.null(message.recov), unique(message.recov), ""), collapse = "\n\n"), "\n\n")})
- # }else if( ! (is.null(warn) & is.null(warn.recov)) & is.null(message.recov)){
- # warn <- paste0(warn, "\n\n", if(length(warn.recov) > 0){paste0(paste0("MESSAGES FROM ggplot2 FUNCTIONS: ", unique(warn.recov), collapse = "\n\n"), "\n\n")})
- # }else if( ! (is.null(warn) & is.null(message.recov)) & is.null(warn.recov)){
- # warn <- paste0(warn, "\n\n", if(length(message.recov) > 0){paste0(paste0("MESSAGES FROM ggplot2 FUNCTIONS: ", unique(message.recov), collapse = "\n\n"), "\n\n")})
- # }
- if(warn.print == TRUE & ! is.null(warn)){
- on.exit(warning(paste0("FROM ", function.name, ":\n\n", warn), call. = FALSE))
+ if( ! is.null(legend.name)){
+ tempo1 <- fun_check(data = legend.name, class = "vector", mode = "character", na.contain = TRUE, length = 1, fun.name = function.name)
+ tempo2 <- fun_check(data = legend.name, class = "list", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": legend.name ARGUMENT MUST BE A SINGLE CHARACTER STRING OR A LIST OF CHARACTER STRINGS")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = legend.name, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- on.exit(exp = options(warning.length = ini.warning.length), add = TRUE)
- if(return == TRUE){
- tempo.output <- ggplot2::ggplot_build(fin.plot)
- tempo.output$data <- tempo.output$data[-1] # remove the first data because corresponds to the initial empty boxplot
- if(length(tempo.output$data) != length(coord.names)){
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nlength(tempo.output$data) AND length(coord.names) MUST BE IDENTICAL. CODE HAS TO BE MODIFIED")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ if( ! is.null(color)){
+ tempo1 <- fun_check(data = color, class = "vector", mode = "character", na.contain = TRUE, fun.name = function.name)
+ tempo2 <- fun_check(data = color, class = "factor", na.contain = TRUE, fun.name = function.name)
+ tempo3 <- fun_check(data = color, class = "integer", double.as.integer.allowed = TRUE, na.contain = TRUE, fun.name = function.name)
+ tempo4 <- fun_check(data = color, class = "list", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo4$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE & tempo3$problem == TRUE & tempo4$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": color ARGUMENT MUST BE A VECTOR (OF CHARACTER STRINGS OR INTEGERS) OR A FACTOR OR A LIST OF THESE POSSIBILITIES")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = color, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ tempo1 <- fun_check(data = geom, class = "vector", mode = "character", na.contain = FALSE, length = 1, fun.name = function.name)
+ tempo2 <- fun_check(data = geom, class = "list", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": geom ARGUMENT MUST BE A SINGLE CHARACTER STRING OR A LIST OF CHARACTER STRINGS")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ tempo1 <- fun_check(data = geom.step.dir, options = c("vh", "hv", "mid"), na.contain = FALSE, length = 1, fun.name = function.name)
+ tempo2 <- fun_check(data = geom.step.dir, class = "list", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": geom.step.dir ARGUMENT MUST BE A SINGLE CHARACTER STRING (\"vh\" OR \"hv\" OR \"mid\") OR A LIST OF THESE CHARACTER STRINGS")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ if( ! is.null(geom.stick.base)){
+ tempo1 <- fun_check(data = geom.stick.base, class = "vector", mode = "numeric", na.contain = FALSE, length = 1, fun.name = function.name)
+ tempo2 <- fun_check(data = color, class = "list", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": geom.stick.base ARGUMENT MUST BE A SINGLE NUMERIC VALUE OR A LIST OF SINGLE NUMERIC VALUES")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = geom.stick.base, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ tempo1 <- fun_check(data = alpha, prop = TRUE, length = 1, fun.name = function.name)
+ tempo2 <- fun_check(data = alpha, class = "list", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": alpha ARGUMENT MUST BE A SINGLE NUMERIC VALUE BETWEEN 0 AND 1 OR A LIST OF SUCH VALUES")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ tempo1 <- fun_check(data = dot.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name)
+ tempo2 <- fun_check(data = dot.size, class = "list", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": dot.size ARGUMENT MUST BE A SINGLE NUMERIC VALUE OR A LIST OF SINGLE NUMERIC VALUES")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ tempo1 <- fun_check(data = dot.shape, class = "vector", length = 1, fun.name = function.name)
+ tempo2 <- fun_check(data = dot.shape, class = "list", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": dot.shape ARGUMENT MUST BE A SINGLE SHAPE VALUE OR A LIST OF SINGLE SHAPE VALUES (SEE https://ggplot2.tidyverse.org/articles/ggplot2-specs.html)")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ tempo1 <- fun_check(data = dot.border.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name)
+ tempo2 <- fun_check(data = dot.border.size, class = "list", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": dot.border.size ARGUMENT MUST BE A SINGLE NUMERIC VALUE OR A LIST OF SINGLE NUMERIC VALUES")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ if( ! is.null(dot.border.color)){
+ tempo1 <- fun_check(data = dot.border.color, class = "vector", mode = "character", length = 1, fun.name = function.name)
+ tempo2 <- fun_check(data = dot.border.color, class = "vector", typeof = "integer", double.as.integer.allowed = TRUE, length = 1, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ # integer colors -> gg_palette
+ tempo.cat <- paste0("ERROR IN ", function.name, ": dot.border.color MUST BE A SINGLE CHARACTER STRING OF COLOR OR A SINGLE INTEGER VALUE")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = dot.border.color, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ tempo1 <- fun_check(data = line.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name)
+ tempo2 <- fun_check(data = line.size, class = "list", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo2$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": line.size ARGUMENT MUST BE A SINGLE NUMERIC VALUE OR A LIST OF SINGLE NUMERIC VALUES")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ tempo1 <- fun_check(data = line.type, class = "vector", typeof = "integer", double.as.integer.allowed = FALSE, length = 1, fun.name = function.name)
+ tempo2 <- fun_check(data = line.type, class = "vector", mode = "character", length = 1, fun.name = function.name)
+ tempo3 <- fun_check(data = line.type, class = "list", na.contain = TRUE, fun.name = function.name)
+ checked.arg.names <- c(checked.arg.names, tempo3$object.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE & tempo3$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": line.type ARGUMENT MUST BE A SINGLE LINE KIND VALUE OR A LIST OF SINGLE LINE KIND VALUES (SEE https://ggplot2.tidyverse.org/articles/ggplot2-specs.html)")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ if( ! is.null(x.lim)){
+ tempo <- fun_check(data = x.lim, class = "vector", mode = "numeric", length = 2, fun.name = function.name) ; eval(ee)
+ if(tempo$problem == FALSE & any(x.lim %in% c(Inf, -Inf))){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": x.lim ARGUMENT CANNOT CONTAIN -Inf OR Inf VALUES")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = x.lim, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ if( ! is.null(x.lab)){
+ if(all(class(x.lab) %in% "expression")){ # to deal with math symbols
+ tempo <- fun_check(data = x.lab, class = "expression", length = 1, fun.name = function.name) ; eval(ee)
}else{
- names(tempo.output$data) <- coord.names
- tempo.output$data <- tempo.output$data[coord.names != "bad_remove"]
+ tempo <- fun_check(data = x.lab, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
}
- tempo <- tempo.output$layout$panel_params[[1]]
- output <- list(
- data = data1.ini,
- stat = stat.nolog,
- removed.row.nb = removed.row.nb,
- removed.rows = removed.rows,
- plot = c(tempo.output$data, y.second.tick.values = list(y.second.tick.values)),
- panel = facet.categ,
- axes = list(
- x.range = tempo$x.range,
- x.labels = if(is.null(attributes(tempo$x$breaks))){tempo$x$breaks}else{tempo$x$scale$get_labels()}, # is.null(attributes(tempo$x$breaks)) test if it is number (TRUE) or character (FALSE)
- x.positions = if(is.null(attributes(tempo$x$breaks))){tempo$x$breaks}else{unlist(attributes(tempo$x$breaks))},
- y.range = tempo$y.range,
- y.labels = if(is.null(attributes(tempo$y$breaks))){tempo$y$breaks}else{tempo$y$scale$get_labels()},
- y.positions = if(is.null(attributes(tempo$y$breaks))){tempo$y$breaks}else{unlist(attributes(tempo$y$breaks))}
- ),
- warn = paste0("\n", warn, "\n\n"),
- ggplot = if(return.ggplot == TRUE){fin.plot}else{NULL}, # fin.plot plots the graph if return == TRUE
- gtable = if(return.gtable == TRUE){grob.save}else{NULL}
- )
- return(output) # this plots the graph if return.ggplot is TRUE and if no assignment
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = x.lab, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- # end output
- # end main code
-}
-
-
-
-
-
-
-# add density
-# rasterise all kind: https://cran.r-project.org/web/packages/ggrastr/vignettes/Raster_geoms.html
-
-
-fun_gg_scatter <- function(
- data1,
- x,
- y,
- categ = NULL,
- categ.class.order = NULL,
- color = NULL,
- geom = "geom_point",
- geom.step.dir = "hv",
- geom.stick.base = NULL,
- alpha = 0.5,
- dot.size = 2,
- dot.shape = 21,
- dot.border.size = 0.5,
- dot.border.color = NULL,
- line.size = 0.5,
- line.type = "solid",
- x.lim = NULL,
- x.lab = NULL,
- x.log = "no",
- x.tick.nb = NULL,
- x.second.tick.nb = NULL,
- x.include.zero = FALSE,
- x.left.extra.margin = 0.05,
- x.right.extra.margin = 0.05,
- x.text.angle = 0,
- y.lim = NULL,
- y.lab = NULL,
- y.log = "no",
- y.tick.nb = NULL,
- y.second.tick.nb = NULL,
- y.include.zero = FALSE,
- y.top.extra.margin = 0.05,
- y.bottom.extra.margin = 0.05,
- y.text.angle = 0,
- raster = FALSE,
- raster.ratio = 1,
- raster.threshold = NULL,
- text.size = 12,
- title = "",
- title.text.size = 12,
- legend.show = TRUE,
- legend.width = 0.5,
- legend.name = NULL,
- article = TRUE,
- grid = FALSE,
- add = NULL,
- return = FALSE,
- return.ggplot = FALSE,
- return.gtable = TRUE,
- plot = TRUE,
- warn.print = FALSE,
- lib.path = NULL
-){
- # AIM
- # Plot ggplot2 scatterplot with the possibility to overlay dots from up to 3 different data frames (-> three different legends) and lines from up to 3 different data frames (-> three different legends) -> up to 6 overlays totally
- # For ggplot2 specifications, see: https://ggplot2.tidyverse.org/articles/ggplot2-specs.html
- # WARNINGS
- # Rows containing NA in data1[, c(x, y, categ)] will be removed before processing, with a warning (see below)
- # Size arguments (dot.size, dot.border.size, line.size, text.size and title.text.size) are in mm. See Hadley comment in https://stackoverflow.com/questions/17311917/ggplot2-the-unit-of-size. See also http://sape.inf.usi.ch/quick-reference/ggplot2/size). Unit object are not accepted, but conversion can be used (e.g., grid::convertUnit(grid::unit(0.2, "inches"), "mm", valueOnly = TRUE))
- # ARGUMENTS
- # data1: a dataframe compatible with ggplot2, or a list of data frames. Order matters for the order of the legend and for the layer staking (starting from below to top)
- # x: single character string of the data1 column name for x-axis coordinates. If data1 is a list, then x must be a list of single character strings, of same size as data1, with compartment 1 related to compartment 1 of data1, etc. Write NULL for each "geom_hline" in geom argument
- # y: single character string of the data1 column name for y-axis coordinates. If data1 is a list, then y must be a list of single character strings, of same size as data1, with compartment 1 related to compartment 1 of data1, etc. Write NULL for each "geom_vline" in geom argument
- # categ: either NULL or a single character string or a list of single character strings, indicating the data1 column names to use for categories which creates legend display
- # If categ == NULL, no categories -> no legend displayed
- # If data1 is a data frame, categ must be a single character string of the data1 column name for categories
- # If data1 is a list, then categ must be a list of single character strings, of same size as data1, with compartment 1 related to compartment 1 of data1, etc. Some of the list compartments can be NULL (no legend display for these compartments), and other not
- # categ.class.order: either (1) NULL or (2) a vector of character strings or (3) a list of these vectors, setting the order of the classes of categ in the legend display
- # If categ.class.order is NULL, classes are represented according to the alphabetical order
- # If data1 is a data frame, categ.class.order must be a vector of character strings specifying the different classes in the categ column name of data1
- # If data1 is a list, then categ.class.order must be a list of vector of character strings, of same size as data1, with compartment 1 related to compartment 1 of data1, etc. Some of the list compartments can be NULL (alphabetical order for these compartments), and other not
- # color: either (1) NULL, or (2) a vector of character strings or integers, or (3) a list of vectors of character strings or integers
- # If color is NULL, default colors of ggplot2
- # If data1 is a data frame, color argument can be either:
- # (1) a single color string. All the dots of the corresponding data1 will have this color, whatever the categ value (NULL or not)
- # (2) if categ is non-null, a vector of string colors, one for each class of categ. Each color will be associated according to the categ.class.order argument if specified, or to the alphabetical order of categ classes otherwise
- # (3) if categ is non-null, a vector or factor of string colors, like if it was one of the column of data1 data frame. WARNING: a single color per class of categ and a single class of categ per color must be respected
- # Positive integers are also accepted instead of character strings, as long as above rules about length are respected. Integers will be processed by fun_gg_palette() using the max integer value among all the integers in color (see fun_gg_palette())
- # If data1 is a list, then color argument must be either:
- # (1) a list of character strings or integers, of same size as data1, with compartment 1 related to compartment 1 of data1, etc.
- # (2) a single character string or a single integer
- # With a list (first possibility), the rules described for when data1 is a data frame apply to each compartment of the list. Some of the compartments can be NULL. In that case, a different grey color will be used for each NULL compartment. With a single value (second possibility), the same color will be used for all the dots and lines, whatever the data1 list
- # geom: single character string of the kind of plot, or a list of single character strings
- # Either:
- # "geom_point" (scatterplot)
- # "geom_line" (coordinates plotted then line connection, from the lowest to highest x coordinates first and from the lowest to highest y coordinates thenafter)
- # "geom_path" (coordinates plotted then line connection respecting the row order in data1)
- # "geom_step" coordinates plotted then line connection respecting the row order in data1 but drawn in steps). See the geom.step.dir argument
- # "geom_hline" (horizontal line, no x value provided)
- # "geom_vline" (vertical line, no y value provided)
- # "geom_stick" (dots as vertical bars)
- # If data1 is a list, then geom must be either:
- # (1) a list of single character strings, of same size as data1, with compartment 1 related to compartment 1 of data1, etc.
- # (2) a single character string. In that case the same kind of plot will apply for the different compartments of the data1 list
- # WARNING concerning "geom_hline" or "geom_vline":
- # (1) x or y argument must be NULL, respectively
- # (2) x.lim or y.lim argument must NOT be NULL, respectively, if only these kind of lines are drawn (if other geom present, then x.lim = NULL and y.lim = NULL will generate x.lim and y.lim defined by these other geom, which is not possible with "geom_hline" or "geom_vline" alone)
- # (3) the function will draw n lines for n values in the x argument column name of the data1 data frame. If several colors required, the categ argument must be specified and the corresponding categ column name must exist in the data1 data frame with a different class name for each row
- # geom.step.dir: single character string indicating the direction when using "geom_step" of the geom argument, or a list of single character strings
- # Either:
- # "vh" (vertical then horizontal)
- # "hv" (horizontal then vertical)
- # "mid" (step half-way between adjacent x-values)
- # See https://ggplot2.tidyverse.org/reference/geom_path.html
- # If data1 is a list, then geom.step.dir must be either:
- # (1) a list of single character strings, of same size as data1, with compartment 1 related to compartment 1 of data1, etc. The value in compartments related to other geom values than "geom_step" will be ignored
- # (2) a single character string, which will be used for all the "geom_step" values of the geom argument, whatever the data1 list
- # geom.stick.base: either (1) NULL or (2) a single numeric value or (3) a list of single numeric values, setting the base of the sticks when using "geom_stick" of the geom argument
- # If geom.stick.base is NULL, the bottom limit of the y-axis is taken as the base
- # If data1 is a list, then geom.stick.base must be either (1) a list of single numeric values, of same size as data1, with compartment 1 related to compartment 1 of data1, etc., or (2) a single numeric value. With a list (former possibility), the values in compartments related to other geom values than "geom_stick" will be ignored. With a single value (latter possibility), the same base will be used for all the sticks, whatever the data1 list
- # Warning: the y-axis limits are not modified by the value of geom.stick.base, meaning that this value can be outside of the range of y.lim. Add the value of geom.stick.base also in the y.lim argument if required
- # Warning: if geom.stick.base is NULL, the bottom limit of the y-axis is taken as the base. Thus, be careful with inverted y-axis
- # alpha: single numeric value (from 0 to 1) of transparency. If data1 is a list, then alpha must be either (1) a list of single numeric values, of same size as data1, with compartment 1 related to compartment 1 of data1, etc., or (2) a single numeric value. In that case the same transparency will apply for the different compartments of the data1 list
- # dot.size: single numeric value of dot shape radius? in mm. If data1 is a list, then dot.size must be either (1) a list of single numeric values, of same size as data1, with compartment 1 related to compartment 1 of data1, etc., or (2) a single numeric value. With a list (former possibility), the value in compartments related to lines will be ignored. With a single value (latter possibility), the same dot.size will be used for all the dots, whatever the data1 list
- # dot.shape: value indicating the shape of the dots (see https://ggplot2.tidyverse.org/articles/ggplot2-specs.html) If data1 is a list, then dot.shape must be either (1) a list of single shape values, of same size as data1, with compartment 1 related to compartment 1 of data1, etc., or (2) a single shape value. With a list (former possibility), the value in compartments related to lines will be ignored. With a single value (latter possibility), the same dot.shape will be used for all the dots, whatever the data1 list
- # dot.border.size: single numeric value of border dot width in mm. Write zero for no dot border. If data1 is a list, then dot.border.size must be either (1) a list of single numeric values, of same size as data1, with compartment 1 related to compartment 1 of data1, etc., or (2) a single numeric value. With a list (former possibility), the value in compartments related to lines will be ignored. With a single value (latter possibility), the same dot.border.size will be used for all the dots, whatever the data1 list
- # dot.border.color: single character color string defining the color of the dot border (same border color for all the dots, whatever their categories). If dot.border.color == NULL, the border color will be the same as the dot color. A single integer is also accepted instead of a character string, that will be processed by fun_gg_palette()
- # line.size: single numeric value of line width in mm. If data1 is a list, then line.size must be either (1) a list of single numeric values, of same size as data1, with compartment 1 related to compartment 1 of data1, etc., or (2) a single numeric value. With a list (former possibility), the value in compartments related to dots will be ignored. With a single value (latter possibility), the same line.size will be used for all the lines, whatever the data1 list
- # line.type: value indicating the kind of lines (see https://ggplot2.tidyverse.org/articles/ggplot2-specs.html) If data1 is a list, then line.type must be either (1) a list of single line kind values, of same size as data1, with compartment 1 related to compartment 1 of data1, etc., or (2) a single line kind value. With a list (former possibility), the value in compartments related to dots will be ignored. With a single value (latter possibility), the same line.type will be used for all the lines, whatever the data1 list
- # x.lim: 2 numeric values setting the x-axis range. Order of the 2 values matters (for inverted axis). If NULL, the range of the x column name of data1 will be used
- # x.lab: a character string or expression for x-axis label. If NULL, will use the first value of x (x column name of the first data frame in data1). Warning message if the elements in x are different between data frames in data1
- # x.log: either "no", "log2" (values in the x column name of the data1 data frame will be log2 transformed and x-axis will be log2 scaled) or "log10" (values in the x column name of the data1 data frame will be log10 transformed and x-axis will be log10 scaled)
- # x.tick.nb: approximate number of desired values labeling the x-axis (i.e., main ticks, see the n argument of the the cute::fun_scale() function). If NULL and if x.log is "no", then the number of labeling values is set by ggplot2. If NULL and if x.log is "log2" or "log10", then the number of labeling values corresponds to all the exposant integers in the x.lim range (e.g., 10^1, 10^2 and 10^3, meaning 3 main ticks for x.lim = c(9, 1200)). WARNING: if non-NULL and if x.log is "log2" or "log10", labeling can be difficult to read (e.g., ..., 10^2, 10^2.5, 10^3, ...)
- # x.second.tick.nb: number of desired secondary ticks between main ticks. Ignored if x.log is other than "no" (log scale plotted). Use argument return = TRUE and see $plot$x.second.tick.values to have the values associated to secondary ticks. IF NULL, no secondary ticks
- # x.include.zero: logical. Does x.lim range include 0? Ignored if x.log is "log2" or "log10"
- # x.left.extra.margin: single proportion (between 0 and 1) indicating if extra margins must be added to x.lim. If different from 0, add the range of the axis multiplied by x.left.extra.margin (e.g., abs(x.lim[2] - x.lim[1]) * x.left.extra.margin) to the left of x-axis
- # x.right.extra.margin: idem as x.left.extra.margin but to the right of x-axis
- # x.text.angle: integer value of the text angle for the x-axis labeling values, using the same rules as in ggplot2. Use positive value for clockwise rotation: 0 for horizontal, 90 for vertical, 180 for upside down etc. Use negative values for counterclockwise rotation: 0 for horizontal, -90 for vertical, -180 for upside down etc.
- # y.lim: 2 numeric values setting the y-axis range. Order of the 2 values matters (for inverted axis). If NULL, the range of the y column name of data1 will be used
- # y.lab: a character string or expression for y-axis label. If NULL, will use the first value of y (y column name of the first data frame in data1). Warning message if the elements in y are different between data frames in data1
- # y.log: either "no", "log2" (values in the y column name of the data1 data frame will be log2 transformed and y-axis will be log2 scaled) or "log10" (values in the y column name of the data1 data frame will be log10 transformed and y-axis will be log10 scaled)
- # y.tick.nb: approximate number of desired values labeling the y-axis (i.e., main ticks, see the n argument of the the cute::fun_scale() function). If NULL and if y.log is "no", then the number of labeling values is set by ggplot2. If NULL and if y.log is "log2" or "log10", then the number of labeling values corresponds to all the exposant integers in the y.lim range (e.g., 10^1, 10^2 and 10^3, meaning 3 main ticks for y.lim = c(9, 1200)). WARNING: if non-NULL and if y.log is "log2" or "log10", labeling can be difficult to read (e.g., ..., 10^2, 10^2.5, 10^3, ...)
- # y.second.tick.nb: number of desired secondary ticks between main ticks. Ignored if y.log is other than "no" (log scale plotted). Use argument return = TRUE and see $plot$y.second.tick.values to have the values associated to secondary ticks. IF NULL, no secondary ticks
- # y.include.zero: logical. Does y.lim range include 0? Ignored if y.log is "log2" or "log10"
- # y.top.extra.margin: single proportion (between 0 and 1) indicating if extra margins must be added to y.lim. If different from 0, add the range of the axis multiplied by y.top.extra.margin (e.g., abs(y.lim[2] - y.lim[1]) * y.top.extra.margin) to the top of y-axis
- # y.bottom.extra.margin: idem as y.top.extra.margin but to the bottom of y-axis
- # y.text.angle: integer value of the text angle for the y-axis labeling values, using the same rules as in ggplot2. Use positive value for clockwise rotation: 0 for horizontal, 90 for vertical, 180 for upside down etc. Use negative values for counterclockwise rotation: 0 for horizontal, -90 for vertical, -180 for upside down etc.
- # raster: logical. Dots in raster mode? If FALSE, dots from each "geom_point" from geom argument are plotted in vectorial mode (bigger pdf and long to display if lots of dots). If TRUE, dots from each "geom_point" from geom argument are plotted in matricial mode (smaller pdf and easy display if lots of dots, but it takes time to generate the layer). If TRUE, the raster.ratio argument is used to avoid an ellipsoid representation of the dots. If TRUE, solve the transparency problem with some GUI. Overriden by the non-NULL raster.threshold argument
- # raster.ratio: single numeric value indicating the height / width ratio of the graphic device used (for instance provided by the $dim compartment in the output of the fun_open() function). The default value is 1 because by default R opens a square graphic device. But this argument has to be set when using other device dimensions. Ignored if raster == FALSE
- # raster.threshold: positive integer value indicating the limit of the dot number above which "geom_point" layers from the geom argument switch from vectorial mode to matricial mode (see the raster argument). If any layer is matricial, then the raster.ratio argument is used to avoid an ellipsoid representation of the dots. If non-NULL, it overrides the raster argument
- # text.size: numeric value of the font size of the (1) axis numbers and axis legends and (2) texts in the graphic legend (in mm)
- # title: character string of the graph title
- # title.text.size: numeric value of the title font size in mm
- # legend.show: logical. Show legend? Not considered if categ argument is NULL, because this already generate no legend, excepted if legend.width argument is non-NULL. In that specific case (categ is NULL, legend.show is TRUE and legend.width is non-NULL), an empty legend space is created. This can be useful when desiring graphs of exactly the same width, whatever they have legends or not
- # legend.width: single proportion (between 0 and 1) indicating the relative width of the legend sector (on the right of the plot) relative to the width of the plot. Value 1 means that the window device width is split in 2, half for the plot and half for the legend. Value 0 means no room for the legend, which will overlay the plot region. Write NULL to inactivate the legend sector. In such case, ggplot2 will manage the room required for the legend display, meaning that the width of the plotting region can vary between graphs, depending on the text in the legend
- # legend.name: character string of the legend title. If legend.name is NULL and categ argument is not NULL, then legend.name <- categ. If data1 is a list, then legend.name must be a list of character strings, of same size as data1, with compartment 1 related to compartment 1 of data1, etc. Some of the list compartments can be NULL, and other not
- # article: logical. If TRUE, use an article theme (article like). If FALSE, use a classic related ggplot theme. Use the add argument (e.g., add = "+ggplot2::theme_classic()" for the exact classic ggplot theme
- # grid: logical. Draw lines in the background to better read the box values? Not considered if article == FALSE (grid systematically present)
- # add: character string allowing to add more ggplot2 features (dots, lines, themes, facet, etc.). Ignored if NULL
- # WARNING: (1) the string must start with "+", (2) the string must finish with ")" and (3) each function must be preceded by "ggplot2::". Example: "+ ggplot2::coord_flip() + ggplot2::theme_bw()"
- # If the character string contains the "ggplot2::theme" string, then the article argument of fun_gg_scatter() (see above) is ignored with a warning. In addition, some arguments can be overwritten, like x.angle (check all the arguments)
- # Handle the add argument with caution since added functions can create conflicts with the preexisting internal ggplot2 functions
- # WARNING: the call of objects inside the quotes of add can lead to an error if the name of these objects are some of the fun_gg_scatter() arguments. Indeed, the function will use the internal argument instead of the global environment object. Example article <- "a" in the working environment and add = '+ ggplot2::ggtitle(article)'. The risk here is to have TRUE as title. To solve this, use add = '+ ggplot2::ggtitle(get("article", envir = .GlobalEnv))'
- # return: logical. Return the graph parameters?
- # return.ggplot: logical. Return the ggplot object in the output list? Ignored if return argument is FALSE. WARNING: always assign the fun_gg_scatter() function (e.g., a <- fun_gg_scatter()) if return.ggplot argument is TRUE, otherwise, double plotting is performed. See $ggplot in the RETURN section below for more details
- # return.gtable: logical. Return the ggplot object as gtable of grobs in the output list? Ignored if plot argument is FALSE. Indeed, the graph must be plotted to get the grobs dispositions. See $gtable in the RETURN section below for more details
- # plot: logical. Plot the graphic? If FALSE and return argument is TRUE, graphical parameters and associated warnings are provided without plotting
- # warn.print: logical. Print warnings at the end of the execution? ? If FALSE, warning messages are never printed, but can still be recovered in the returned list. Some of the warning messages (those delivered by the internal ggplot2 functions) are not apparent when using the argument plot = FALSE
- # lib.path: character string indicating the absolute path of the required packages (see below). if NULL, the function will use the R library default folders
- # RETURN
- # a scatter plot if plot argument is TRUE
- # a list of the graph info if return argument is TRUE:
- # $data: the initial data with graphic information added. WARNING: if the x.log or y.log argument is not "no", x or y argument column of the data1 data frame are log2 or log10 converted in $data, respectively. Use 2^values or 10^$values to recover the initial values
- # $removed.row.nb: a list of the removed rows numbers in data frames (because of NA). NULL if no row removed
- # $removed.rows: a list of the removed rows in data frames (because of NA). NULL if no row removed
- # $plot: the graphic box and dot coordinates
- # $dots: dot coordinates
- # y.second.tick.positions: coordinates of secondary ticks (only if y.second.tick.nb argument is non-null or if y.log argument is different from "no")
- # y.second.tick.values: values of secondary ticks. NULL except if y.second.tick.nb argument is non-null or if y.log argument is different from "no")
- # $panel: the variable names used for the panels (NULL if no panels). WARNING: NA can be present according to ggplot2 upgrade to v3.3.0
- # $axes: the x-axis and y-axis info
- # $warn: the warning messages. Use cat() for proper display. NULL if no warning. WARNING: warning messages delivered by the internal ggplot2 functions are not apparent when using the argument plot = FALSE
- # $ggplot: ggplot object that can be used for reprint (use print($ggplot) or update (use $ggplot + ggplot2::...). NULL if return.ggplot argument is FALSE. Of note, a non-null $ggplot in the output list is sometimes annoying as the manipulation of this list prints the plot
- # $gtable: gtable object that can be used for reprint (use gridExtra::grid.arrange(...$ggplot) or with additionnal grobs (see the grob decomposition in the examples). NULL if return.ggplot argument is FALSE. Contrary to $ggplot, a non-NULL $gtable in the output list is not annoying as the manipulation of this list does not print the plot
- # REQUIRED PACKAGES
- # ggplot2
- # gridExtra
- # lemon (in case of use in the add argument)
- # scales
- # if raster plots are drawn (see the raster and raster.threshold arguments):
- # Cairo
- # grid
- # REQUIRED FUNCTIONS FROM THE cute PACKAGE
- # fun_gg_empty_graph()
- # fun_gg_palette()
- # fun_gg_point_rast()
- # fun_pack()
- # fun_check()
- # fun_round()
- # fun_scale()
- # fun_inter_ticks()
- # EXAMPLES
- # set.seed(1) ; obs1 <- data.frame(Km = c(2, 1, 6, 5, 4, 7), Time = c(2, 1, 6, 5, 4, 7)^2, Car = c("TUUT", "TUUT", "TUUT", "WIIM", "WIIM", "WIIM"), Color1 = rep(c("coral", "lightblue"), each = 3), stringsAsFactors = TRUE) ; fun_gg_scatter(data1 = obs1, x = "Km", y = "Time")
- # DEBUGGING
- # set.seed(1) ; obs1 <- data.frame(km = rnorm(1000, 10, 3), time = rnorm(1000, 10, 3), group1 = rep(c("A1", "A2"), 500), stringsAsFactors = TRUE) ; obs2 <-data.frame(km = rnorm(1000, 15, 3), time = rnorm(1000, 15, 3), group2 = rep(c("G1", "G2"), 500), stringsAsFactors = TRUE) ; set.seed(NULL) ; obs1$km[2:3] <- NA ; data1 = list(L1 = obs1, L2 = obs2) ; x = list(L1 = "km", L2 = "km") ; y = list(L1 = "time", L2 = "time") ; categ = list(L1 = "group1", L2 = "group2") ; categ = NULL ; categ.class.order = NULL ; color = NULL ; geom = "geom_point" ; geom.step.dir = "hv" ; geom.stick.base = NULL ; alpha = 0.5 ; dot.size = 2 ; dot.shape = 21 ; dot.border.size = 0.5 ; dot.border.color = NULL ; line.size = 0.5 ; line.type = "solid" ; x.lim = NULL ; x.lab = NULL ; x.log = "no" ; x.tick.nb = NULL ; x.second.tick.nb = NULL ; x.include.zero = FALSE ; x.left.extra.margin = 0.05 ; x.right.extra.margin = 0.05 ; x.text.angle = 0 ; y.lim = NULL ; y.lab = NULL ; y.log = "no" ; y.tick.nb = NULL ; y.second.tick.nb = NULL ; y.include.zero = FALSE ; y.top.extra.margin = 0.05 ; y.bottom.extra.margin = 0.05 ; y.text.angle = 0 ; raster = FALSE ; raster.ratio = 1 ; raster.threshold = NULL ; text.size = 12 ; title = "" ; title.text.size = 12 ; legend.show = TRUE ; legend.width = 0.5 ; legend.name = NULL ; article = TRUE ; grid = FALSE ; add = NULL ; return = FALSE ; return.ggplot = FALSE ; return.gtable = TRUE ; plot = TRUE ; warn.print = FALSE ; lib.path = NULL
- # function name
- function.name <- paste0(as.list(match.call(expand.dots=FALSE))[[1]], "()")
- arg.names <- names(formals(fun = sys.function(sys.parent(n = 2)))) # names of all the arguments
- arg.user.setting <- as.list(match.call(expand.dots=FALSE))[-1] # list of the argument settings (excluding default values not provided by the user)
- # end function name
- # required function checking
- req.function <- c(
- "fun_check",
- "fun_gg_just",
- "fun_gg_empty_graph",
- "fun_gg_palette",
- "fun_gg_point_rast",
- "fun_round",
- "fun_pack",
- "fun_scale",
- "fun_inter_ticks"
- )
- tempo <- NULL
- for(i1 in req.function){
- if(length(find(i1, mode = "function"))== 0L){
- tempo <- c(tempo, i1)
+ tempo <- fun_check(data = x.log, options = c("no", "log2", "log10"), length = 1, fun.name = function.name) ; eval(ee)
+ if( ! is.null(x.tick.nb)){
+ tempo <- fun_check(data = x.tick.nb, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, fun.name = function.name) ; eval(ee)
+ if(tempo$problem == FALSE & x.tick.nb < 0){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": x.tick.nb ARGUMENT MUST BE A NON-NULL POSITIVE INTEGER")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
}
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = x.tick.nb, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- if( ! is.null(tempo)){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nREQUIRED cute FUNCTION", ifelse(length(tempo) > 1, "S ARE", " IS"), " MISSING IN THE R ENVIRONMENT:\n", paste0(tempo, collapse = "()\n"))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
+ if( ! is.null(x.second.tick.nb)){
+ tempo <- fun_check(data = x.second.tick.nb, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, fun.name = function.name) ; eval(ee)
+ if(tempo$problem == FALSE & x.second.tick.nb <= 0){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": x.second.tick.nb ARGUMENT MUST BE A NON-NULL POSITIVE INTEGER")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = x.second.tick.nb, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- # end required function checking
- # reserved words to avoid bugs (used in this function)
- reserved.words <- c("fake_x", "fake_y", "fake_categ")
- # end reserved words to avoid bugs (used in this function)
- # arg with no default values
- mandat.args <- c(
- "data1",
- "x",
- "y"
- )
- tempo <- eval(parse(text = paste0("missing(", paste0(mandat.args, collapse = ") | missing("), ")")))
- if(any(tempo)){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nFOLLOWING ARGUMENT", ifelse(length(mandat.args) > 1, "S HAVE", "HAS"), " NO DEFAULT VALUE AND REQUIRE ONE:\n", paste0(mandat.args, collapse = "\n"))
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
- }
- # end arg with no default values
- # argument primary checking
- arg.check <- NULL #
- text.check <- NULL #
- checked.arg.names <- NULL # for function debbuging: used by r_debugging_tools
- ee <- expression(arg.check <- c(arg.check, tempo$problem) , text.check <- c(text.check, tempo$text) , checked.arg.names <- c(checked.arg.names, tempo$object.name))
- tempo1 <- fun_check(data = data1, class = "data.frame", na.contain = TRUE, fun.name = function.name)
- tempo2 <- fun_check(data = data1, class = "list", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, ": data1 ARGUMENT MUST BE A DATA FRAME OR A LIST OF DATA FRAMES")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- if( ! is.null(x)){
- tempo1 <- fun_check(data = x, class = "vector", mode = "character", na.contain = TRUE, length = 1, fun.name = function.name)
- tempo2 <- fun_check(data = x, class = "list", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, ": x ARGUMENT MUST BE A SINGLE CHARACTER STRING OR A LIST OF CHARACTER STRINGS")
+ tempo <- fun_check(data = x.include.zero, class = "vector", mode = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = x.left.extra.margin, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = x.right.extra.margin, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = x.text.angle, class = "vector", typeof = "integer", double.as.integer.allowed = TRUE, length = 1, neg.values = TRUE, fun.name = function.name) ; eval(ee)
+ if( ! is.null(y.lim)){
+ tempo <- fun_check(data = y.lim, class = "vector", mode = "numeric", length = 2, fun.name = function.name) ; eval(ee)
+ if(tempo$problem == FALSE & any(y.lim %in% c(Inf, -Inf))){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": y.lim ARGUMENT CANNOT CONTAIN -Inf OR Inf VALUES")
text.check <- c(text.check, tempo.cat)
arg.check <- c(arg.check, TRUE)
}
}else{
# no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = x, class = "vector")
+ tempo <- fun_check(data = y.lim, class = "vector")
checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- if( ! is.null(y)){
- tempo1 <- fun_check(data = y, class = "vector", mode = "character", na.contain = TRUE, length = 1, fun.name = function.name)
- tempo2 <- fun_check(data = y, class = "list", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, ": y ARGUMENT MUST BE A SINGLE CHARACTER STRING OR A LIST OF CHARACTER STRINGS")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
+ if( ! is.null(y.lab)){
+ if(all(class(y.lab) %in% "expression")){ # to deal with math symbols
+ tempo <- fun_check(data = y.lab, class = "expression", length = 1, fun.name = function.name) ; eval(ee)
+ }else{
+ tempo <- fun_check(data = y.lab, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
}
}else{
# no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = y, class = "vector")
+ tempo <- fun_check(data = y.lab, class = "vector")
checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- if( ! is.null(categ)){
- tempo1 <- fun_check(data = categ, class = "vector", mode = "character", length = 1, fun.name = function.name)
- tempo2 <- fun_check(data = categ, class = "list", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, ": categ ARGUMENT MUST BE A SINGLE CHARACTER STRING OR A LIST OF CHARACTER STRINGS")
+ tempo <- fun_check(data = y.log, options = c("no", "log2", "log10"), length = 1, fun.name = function.name) ; eval(ee)
+ if( ! is.null(y.tick.nb)){
+ tempo <- fun_check(data = y.tick.nb, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, fun.name = function.name) ; eval(ee)
+ if(tempo$problem == FALSE & y.tick.nb < 0){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": y.tick.nb ARGUMENT MUST BE A NON-NULL POSITIVE INTEGER")
text.check <- c(text.check, tempo.cat)
arg.check <- c(arg.check, TRUE)
}
}else{
# no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = categ, class = "vector")
+ tempo <- fun_check(data = y.tick.nb, class = "vector")
checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- if( ! is.null(categ.class.order)){
- if(is.null(categ)){
- tempo.cat <- paste0("ERROR IN ", function.name, ": categ.class.order ARGUMENT IS NOT NULL, BUT categ IS")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- tempo1 <- fun_check(data = categ.class.order, class = "vector", mode = "character", fun.name = function.name)
- tempo2 <- fun_check(data = categ.class.order, class = "list", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, ": categ.class.order ARGUMENT MUST BE A VECTOR OF CHARACTER STRINGS OR A LIST OF VECTOR OF CHARACTER STRINGS")
+ if( ! is.null(y.second.tick.nb)){
+ tempo <- fun_check(data = y.second.tick.nb, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, fun.name = function.name) ; eval(ee)
+ if(tempo$problem == FALSE & y.second.tick.nb <= 0){
+ tempo.cat <- paste0("ERROR IN ", function.name, ": y.second.tick.nb ARGUMENT MUST BE A NON-NULL POSITIVE INTEGER")
text.check <- c(text.check, tempo.cat)
arg.check <- c(arg.check, TRUE)
}
}else{
# no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = categ.class.order, class = "vector")
+ tempo <- fun_check(data = y.second.tick.nb, class = "vector")
checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- if( ! is.null(legend.name)){
- tempo1 <- fun_check(data = legend.name, class = "vector", mode = "character", na.contain = TRUE, length = 1, fun.name = function.name)
- tempo2 <- fun_check(data = legend.name, class = "list", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, ": legend.name ARGUMENT MUST BE A SINGLE CHARACTER STRING OR A LIST OF CHARACTER STRINGS")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
+ tempo <- fun_check(data = y.include.zero, class = "vector", mode = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = y.top.extra.margin, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = y.bottom.extra.margin, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = y.text.angle, class = "vector", typeof = "integer", double.as.integer.allowed = TRUE, length = 1, neg.values = TRUE, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = raster, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = raster.ratio, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
+ if( ! is.null(raster.threshold)){
+ tempo <- fun_check(data = raster.threshold, class = "vector", typeof = "integer", neg.values = FALSE, double.as.integer.allowed = TRUE, fun.name = function.name) ; eval(ee)
}else{
# no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = legend.name, class = "vector")
+ tempo <- fun_check(data = raster.threshold, class = "vector")
checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- if( ! is.null(color)){
- tempo1 <- fun_check(data = color, class = "vector", mode = "character", na.contain = TRUE, fun.name = function.name)
- tempo2 <- fun_check(data = color, class = "factor", na.contain = TRUE, fun.name = function.name)
- tempo3 <- fun_check(data = color, class = "integer", double.as.integer.allowed = TRUE, na.contain = TRUE, fun.name = function.name)
- tempo4 <- fun_check(data = color, class = "list", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo4$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE & tempo3$problem == TRUE & tempo4$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, ": color ARGUMENT MUST BE A VECTOR (OF CHARACTER STRINGS OR INTEGERS) OR A FACTOR OR A LIST OF THESE POSSIBILITIES")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
+ tempo <- fun_check(data = text.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = title, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = title.text.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = legend.show, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ if( ! is.null(legend.width)){
+ tempo <- fun_check(data = legend.width, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
}else{
# no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = color, class = "vector")
+ tempo <- fun_check(data = legend.width, class = "vector")
checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- tempo1 <- fun_check(data = geom, class = "vector", mode = "character", na.contain = FALSE, length = 1, fun.name = function.name)
- tempo2 <- fun_check(data = geom, class = "list", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, ": geom ARGUMENT MUST BE A SINGLE CHARACTER STRING OR A LIST OF CHARACTER STRINGS")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- tempo1 <- fun_check(data = geom.step.dir, options = c("vh", "hv", "mid"), na.contain = FALSE, length = 1, fun.name = function.name)
- tempo2 <- fun_check(data = geom.step.dir, class = "list", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, ": geom.step.dir ARGUMENT MUST BE A SINGLE CHARACTER STRING (\"vh\" OR \"hv\" OR \"mid\") OR A LIST OF THESE CHARACTER STRINGS")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- if( ! is.null(geom.stick.base)){
- tempo1 <- fun_check(data = geom.stick.base, class = "vector", mode = "numeric", na.contain = FALSE, length = 1, fun.name = function.name)
- tempo2 <- fun_check(data = color, class = "list", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, ": geom.stick.base ARGUMENT MUST BE A SINGLE NUMERIC VALUE OR A LIST OF SINGLE NUMERIC VALUES")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
+ tempo <- fun_check(data = article, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = grid, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ if( ! is.null(add)){
+ tempo <- fun_check(data = add, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
}else{
# no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = geom.stick.base, class = "vector")
+ tempo <- fun_check(data = add, class = "vector")
checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- tempo1 <- fun_check(data = alpha, prop = TRUE, length = 1, fun.name = function.name)
- tempo2 <- fun_check(data = alpha, class = "list", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, ": alpha ARGUMENT MUST BE A SINGLE NUMERIC VALUE BETWEEN 0 AND 1 OR A LIST OF SUCH VALUES")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- tempo1 <- fun_check(data = dot.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name)
- tempo2 <- fun_check(data = dot.size, class = "list", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, ": dot.size ARGUMENT MUST BE A SINGLE NUMERIC VALUE OR A LIST OF SINGLE NUMERIC VALUES")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- tempo1 <- fun_check(data = dot.shape, class = "vector", length = 1, fun.name = function.name)
- tempo2 <- fun_check(data = dot.shape, class = "list", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, ": dot.shape ARGUMENT MUST BE A SINGLE SHAPE VALUE OR A LIST OF SINGLE SHAPE VALUES (SEE https://ggplot2.tidyverse.org/articles/ggplot2-specs.html)")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- tempo1 <- fun_check(data = dot.border.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name)
- tempo2 <- fun_check(data = dot.border.size, class = "list", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, ": dot.border.size ARGUMENT MUST BE A SINGLE NUMERIC VALUE OR A LIST OF SINGLE NUMERIC VALUES")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- if( ! is.null(dot.border.color)){
- tempo1 <- fun_check(data = dot.border.color, class = "vector", mode = "character", length = 1, fun.name = function.name)
- tempo2 <- fun_check(data = dot.border.color, class = "vector", typeof = "integer", double.as.integer.allowed = TRUE, length = 1, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- # integer colors -> gg_palette
- tempo.cat <- paste0("ERROR IN ", function.name, ": dot.border.color MUST BE A SINGLE CHARACTER STRING OF COLOR OR A SINGLE INTEGER VALUE")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
+ tempo <- fun_check(data = return, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = return.ggplot, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = return.gtable, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = plot, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = warn.print, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ if( ! is.null(lib.path)){
+ tempo <- fun_check(data = lib.path, class = "vector", mode = "character", fun.name = function.name) ; eval(ee)
+ if(tempo$problem == FALSE){
+ if( ! all(dir.exists(lib.path))){ # separation to avoid the problem of tempo$problem == FALSE and lib.path == NA
+ tempo.cat <- paste0("ERROR IN ", function.name, ": DIRECTORY PATH INDICATED IN THE lib.path ARGUMENT DOES NOT EXISTS:\n", paste(lib.path, collapse = "\n"))
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ }
}
}else{
# no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = dot.border.color, class = "vector")
+ tempo <- fun_check(data = lib.path, class = "vector")
checked.arg.names <- c(checked.arg.names, tempo$object.name)
}
- tempo1 <- fun_check(data = line.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name)
- tempo2 <- fun_check(data = line.size, class = "list", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo2$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, ": line.size ARGUMENT MUST BE A SINGLE NUMERIC VALUE OR A LIST OF SINGLE NUMERIC VALUES")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- tempo1 <- fun_check(data = line.type, class = "vector", typeof = "integer", double.as.integer.allowed = FALSE, length = 1, fun.name = function.name)
- tempo2 <- fun_check(data = line.type, class = "vector", mode = "character", length = 1, fun.name = function.name)
- tempo3 <- fun_check(data = line.type, class = "list", na.contain = TRUE, fun.name = function.name)
- checked.arg.names <- c(checked.arg.names, tempo3$object.name)
- if(tempo1$problem == TRUE & tempo2$problem == TRUE & tempo3$problem == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, ": line.type ARGUMENT MUST BE A SINGLE LINE KIND VALUE OR A LIST OF SINGLE LINE KIND VALUES (SEE https://ggplot2.tidyverse.org/articles/ggplot2-specs.html)")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
+ if(any(arg.check) == TRUE){
+ stop(paste0("\n\n================\n\n", paste(text.check[arg.check], collapse = "\n"), "\n\n================\n\n"), call. = FALSE) #
}
- if( ! is.null(x.lim)){
- tempo <- fun_check(data = x.lim, class = "vector", mode = "numeric", length = 2, fun.name = function.name) ; eval(ee)
- if(tempo$problem == FALSE & any(x.lim %in% c(Inf, -Inf))){
- tempo.cat <- paste0("ERROR IN ", function.name, ": x.lim ARGUMENT CANNOT CONTAIN -Inf OR Inf VALUES")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = x.lim, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- if( ! is.null(x.lab)){
- if(all(class(x.lab) %in% "expression")){ # to deal with math symbols
- tempo <- fun_check(data = x.lab, class = "expression", length = 1, fun.name = function.name) ; eval(ee)
- }else{
- tempo <- fun_check(data = x.lab, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
- }
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = x.lab, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- tempo <- fun_check(data = x.log, options = c("no", "log2", "log10"), length = 1, fun.name = function.name) ; eval(ee)
- if( ! is.null(x.tick.nb)){
- tempo <- fun_check(data = x.tick.nb, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, fun.name = function.name) ; eval(ee)
- if(tempo$problem == FALSE & x.tick.nb < 0){
- tempo.cat <- paste0("ERROR IN ", function.name, ": x.tick.nb ARGUMENT MUST BE A NON-NULL POSITIVE INTEGER")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = x.tick.nb, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- if( ! is.null(x.second.tick.nb)){
- tempo <- fun_check(data = x.second.tick.nb, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, fun.name = function.name) ; eval(ee)
- if(tempo$problem == FALSE & x.second.tick.nb <= 0){
- tempo.cat <- paste0("ERROR IN ", function.name, ": x.second.tick.nb ARGUMENT MUST BE A NON-NULL POSITIVE INTEGER")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = x.second.tick.nb, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- tempo <- fun_check(data = x.include.zero, class = "vector", mode = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = x.left.extra.margin, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = x.right.extra.margin, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = x.text.angle, class = "vector", typeof = "integer", double.as.integer.allowed = TRUE, length = 1, neg.values = TRUE, fun.name = function.name) ; eval(ee)
- if( ! is.null(y.lim)){
- tempo <- fun_check(data = y.lim, class = "vector", mode = "numeric", length = 2, fun.name = function.name) ; eval(ee)
- if(tempo$problem == FALSE & any(y.lim %in% c(Inf, -Inf))){
- tempo.cat <- paste0("ERROR IN ", function.name, ": y.lim ARGUMENT CANNOT CONTAIN -Inf OR Inf VALUES")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = y.lim, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- if( ! is.null(y.lab)){
- if(all(class(y.lab) %in% "expression")){ # to deal with math symbols
- tempo <- fun_check(data = y.lab, class = "expression", length = 1, fun.name = function.name) ; eval(ee)
- }else{
- tempo <- fun_check(data = y.lab, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
- }
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = y.lab, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- tempo <- fun_check(data = y.log, options = c("no", "log2", "log10"), length = 1, fun.name = function.name) ; eval(ee)
- if( ! is.null(y.tick.nb)){
- tempo <- fun_check(data = y.tick.nb, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, fun.name = function.name) ; eval(ee)
- if(tempo$problem == FALSE & y.tick.nb < 0){
- tempo.cat <- paste0("ERROR IN ", function.name, ": y.tick.nb ARGUMENT MUST BE A NON-NULL POSITIVE INTEGER")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = y.tick.nb, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- if( ! is.null(y.second.tick.nb)){
- tempo <- fun_check(data = y.second.tick.nb, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, fun.name = function.name) ; eval(ee)
- if(tempo$problem == FALSE & y.second.tick.nb <= 0){
- tempo.cat <- paste0("ERROR IN ", function.name, ": y.second.tick.nb ARGUMENT MUST BE A NON-NULL POSITIVE INTEGER")
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = y.second.tick.nb, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- tempo <- fun_check(data = y.include.zero, class = "vector", mode = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = y.top.extra.margin, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = y.bottom.extra.margin, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = y.text.angle, class = "vector", typeof = "integer", double.as.integer.allowed = TRUE, length = 1, neg.values = TRUE, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = raster, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = raster.ratio, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
- if( ! is.null(raster.threshold)){
- tempo <- fun_check(data = raster.threshold, class = "vector", typeof = "integer", neg.values = FALSE, double.as.integer.allowed = TRUE, fun.name = function.name) ; eval(ee)
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = raster.threshold, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- tempo <- fun_check(data = text.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = title, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = title.text.size, class = "vector", mode = "numeric", length = 1, neg.values = FALSE, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = legend.show, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- if( ! is.null(legend.width)){
- tempo <- fun_check(data = legend.width, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = legend.width, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- tempo <- fun_check(data = article, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = grid, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- if( ! is.null(add)){
- tempo <- fun_check(data = add, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = add, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- tempo <- fun_check(data = return, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = return.ggplot, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = return.gtable, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = plot, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- tempo <- fun_check(data = warn.print, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
- if( ! is.null(lib.path)){
- tempo <- fun_check(data = lib.path, class = "vector", mode = "character", fun.name = function.name) ; eval(ee)
- if(tempo$problem == FALSE){
- if( ! all(dir.exists(lib.path))){ # separation to avoid the problem of tempo$problem == FALSE and lib.path == NA
- tempo.cat <- paste0("ERROR IN ", function.name, ": DIRECTORY PATH INDICATED IN THE lib.path ARGUMENT DOES NOT EXISTS:\n", paste(lib.path, collapse = "\n"))
- text.check <- c(text.check, tempo.cat)
- arg.check <- c(arg.check, TRUE)
- }
- }
- }else{
- # no fun_check test here, it is just for checked.arg.names
- tempo <- fun_check(data = lib.path, class = "vector")
- checked.arg.names <- c(checked.arg.names, tempo$object.name)
- }
- if(any(arg.check) == TRUE){
- stop(paste0("\n\n================\n\n", paste(text.check[arg.check], collapse = "\n"), "\n\n================\n\n"), call. = FALSE) #
- }
- # source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.7/r_debugging_tools-v1.7.R") ; eval(parse(text = str_basic_arg_check_dev)) ; eval(parse(text = str_arg_check_with_fun_check_dev)) # activate this line and use the function (with no arguments left as NULL) to check arguments status and if they have been checked using fun_check()
- # end argument primary checking
-
-
- # second round of checking and data preparation
- # management of NA arguments
- tempo.arg <- names(arg.user.setting) # values provided by the user
- tempo.log <- suppressWarnings(sapply(lapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = is.na), FUN = any)) & lapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = length)== 1L # no argument provided by the user can be just NA
- if(any(tempo.log) == TRUE){
- tempo.cat <- paste0("ERROR IN ", function.name, ":\n", ifelse(sum(tempo.log, na.rm = TRUE) > 1, "THESE ARGUMENTS\n", "THIS ARGUMENT\n"), paste0(tempo.arg[tempo.log], collapse = "\n"),"\nCANNOT JUST BE NA")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
+ # source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.7/r_debugging_tools-v1.7.R") ; eval(parse(text = str_basic_arg_check_dev)) ; eval(parse(text = str_arg_check_with_fun_check_dev)) # activate this line and use the function (with no arguments left as NULL) to check arguments status and if they have been checked using fun_check()
+ # end argument primary checking
+
+
+ # second round of checking and data preparation
+ # management of NA arguments
+ tempo.arg <- names(arg.user.setting) # values provided by the user
+ tempo.log <- suppressWarnings(sapply(lapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = is.na), FUN = any)) & lapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = length)== 1L # no argument provided by the user can be just NA
+ if(any(tempo.log) == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, ":\n", ifelse(sum(tempo.log, na.rm = TRUE) > 1, "THESE ARGUMENTS\n", "THIS ARGUMENT\n"), paste0(tempo.arg[tempo.log], collapse = "\n"),"\nCANNOT JUST BE NA")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
}
# end management of NA arguments
# management of NULL arguments
@@ -14103,340 +13389,1065 @@ fun_gg_scatter <- function(
}
}
}
- # end loop part
-
+ # end loop part
+
+
+
+
+ # legend display
+ tempo.legend.final <- 'ggplot2::guides(
+fill = if(fin.lg.disp[[1]] == TRUE){
+ggplot2::guide_legend(
+order = lg.order[[1]],
+override.aes = list(
+fill = lg.color[[1]],
+colour = if(lg.dot.shape[[1]] %in% 21:24 & ! is.null(dot.border.color)){lg.dot.border.color[[1]]}else{lg.color[[1]]}, # lg.dot.shape[[1]] %in% 21:24 are the only one that can be filled
+shape = lg.dot.shape[[1]],
+size = lg.dot.size[[1]],
+stroke = lg.dot.border.size[[1]],
+alpha = lg.alpha[[1]],
+linetype = 0
+)
+)
+}else{
+"none"
+},
+shape = if(fin.lg.disp[[2]] == TRUE){
+ggplot2::guide_legend(
+order = lg.order[[2]],
+override.aes = list(
+fill = lg.color[[2]],
+colour = if(lg.dot.shape[[2]] %in% 21:24 & ! is.null(dot.border.color)){lg.dot.border.color[[2]]}else{lg.color[[2]]}, # lg.dot.shape[[2]] %in% 21:24 are the only one that can be filled
+shape = lg.dot.shape[[2]],
+size = lg.dot.size[[2]],
+stroke = lg.dot.border.size[[2]],
+alpha = lg.alpha[[2]],
+linetype = 0
+)
+)
+}else{
+"none"
+},
+stroke = if(fin.lg.disp[[3]] == TRUE){
+ggplot2::guide_legend(
+order = lg.order[[3]],
+override.aes = list(
+fill = lg.color[[3]],
+colour = if(lg.dot.shape[[3]] %in% 21:24 & ! is.null(dot.border.color)){lg.dot.border.color[[3]]}else{lg.color[[3]]}, # lg.dot.shape[[3]] %in% 21:24 are the only one that can be filled
+shape = lg.dot.shape[[3]],
+size = lg.dot.size[[3]],
+stroke = lg.dot.border.size[[3]],
+alpha = lg.alpha[[3]],
+linetype = 0
+)
+)
+}else{
+"none"
+},
+linetype = if(fin.lg.disp[[4]] == TRUE){
+ggplot2::guide_legend(
+order = lg.order[[4]],
+override.aes = list(
+color = lg.color[[4]],
+size = lg.line.size[[4]],
+linetype = lg.line.type[[4]],
+alpha = lg.alpha[[4]],
+shape = NA
+)
+)
+}else{
+"none"
+},
+alpha = if(fin.lg.disp[[5]] == TRUE){
+ggplot2::guide_legend(
+order = lg.order[[5]],
+override.aes = list(
+color = lg.color[[5]],
+size = lg.line.size[[5]],
+linetype = lg.line.type[[5]],
+alpha = lg.alpha[[5]],
+shape = NA
+)
+)
+}else{
+"none"
+},
+size = if(fin.lg.disp[[6]] == TRUE){
+ggplot2::guide_legend(
+order = lg.order[[6]],
+override.aes = list(
+color = lg.color[[6]],
+size = lg.line.size[[6]],
+linetype = lg.line.type[[6]],
+alpha = lg.alpha[[6]],
+shape = NA
+)
+)
+}else{
+"none"
+}
+)' # clip = "off" to have secondary ticks outside plot region does not work
+if( ! is.null(legend.width)){
+ if(any(unlist(legend.disp))){ # means some TRUE
+ tempo.graph.info <- suppressMessages(ggplot2::ggplot_build(eval(parse(text = paste0(paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "), ' + ', tempo.legend.final))))) # will be recovered later again, when ylim will be considered
+ legend.final <- fun_gg_get_legend(ggplot_built = tempo.graph.info, fun.name = function.name) # get legend
+ fin.lg.disp[] <- FALSE # remove all the legends. Must be done even if fin.lg.disp is not appearing in the code thenafter. Otherwise twice the legend
+ if(is.null(legend.final) & plot == TRUE){ # even if any(unlist(legend.disp)) is TRUE
+ legend.final <- fun_gg_empty_graph() # empty graph instead of legend
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") LEGEND REQUESTED (NON-NULL categ ARGUMENT OR legend.show ARGUMENT SET TO TRUE)\nBUT IT SEEMS THAT THE PLOT HAS NO LEGEND -> EMPTY LEGEND SPACE CREATED BECAUSE OF THE NON-NULL legend.width ARGUMENT\n")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ }else if(plot == TRUE){ # means all FALSE
+ legend.final <- ggplot2::ggplot()+ggplot2::theme_void() # empty graph instead of legend
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") LEGEND REQUESTED (NON-NULL categ ARGUMENT OR legend.show ARGUMENT SET TO TRUE)\nBUT IT SEEMS THAT THE PLOT HAS NO LEGEND -> EMPTY LEGEND SPACE CREATED BECAUSE OF THE NON-NULL legend.width ARGUMENT\n")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+}
+if( ! any(unlist(legend.disp))){
+ fin.lg.disp[] <- FALSE # remove all the legends. Must be done even if fin.lg.disp is not appearing in the code thenafter. Otherwise twice the legend
+}
+assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), eval(parse(text = tempo.legend.final)))
+# end legend display
+
+
+
+
+
+# scale management
+tempo.coord <- suppressMessages(ggplot2::ggplot_build(eval(parse(text = paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + ", ' + ggplot2::scale_x_continuous(expand = c(0, 0), limits = sort(x.lim), oob = scales::rescale_none) + ggplot2::scale_y_continuous(expand = c(0, 0), limits = sort(y.lim), oob = scales::rescale_none)'))))$layout$panel_params[[1]]) # here I do not need the x-axis and y-axis orientation, I just need the number of main ticks
+# x.second.tick.positions # coordinates of secondary ticks (only if x.second.tick.nb argument is non-null or if x.log argument is different from "no")
+if(x.log != "no"){ # integer main ticks for log2 and log10
+ tempo.scale <- (as.integer(min(x.lim, na.rm = TRUE)) - 1):(as.integer(max(x.lim, na.rm = TRUE)) + 1)
+}else{
+ tempo <- if(is.null(attributes(tempo.coord$x$breaks))){tempo.coord$x$breaks}else{unlist(attributes(tempo.coord$x$breaks))}
+ if(all(is.na(tempo))){
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nONLY NA IN tempo.coord$x$breaks")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }
+ if(length(unique(x.lim)) <= 1){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nIT SEEMS THAT X-AXIS VALUES HAVE A NULL RANGE: ", paste(x.lim, collapse = " "), "\nPLEASE, USE THE x.lim ARGUMENT WITH 2 DIFFERENT VALUES TO SOLVE THIS")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }else{
+ tempo.scale <- fun_scale(lim = x.lim, n = ifelse(is.null(x.tick.nb), length(tempo[ ! is.na(tempo)]), x.tick.nb)) # in ggplot 3.3.0, tempo.coord$x.major_source replaced by tempo.coord$x$breaks. If fact: n = ifelse(is.null(x.tick.nb), length(tempo[ ! is.na(tempo)]), x.tick.nb)) replaced by n = ifelse(is.null(x.tick.nb), 4, x.tick.nb))
+ }
+}
+x.second.tick.values <- NULL
+x.second.tick.pos <- NULL
+if(x.log != "no"){
+ tempo <- fun_inter_ticks(lim = x.lim, log = x.log)
+ x.second.tick.values <- tempo$values
+ x.second.tick.pos <- tempo$coordinates
+ # if(vertical == TRUE){ # do not remove in case the bug is fixed
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(
+ geom = "segment",
+ x = x.second.tick.pos,
+ xend = x.second.tick.pos,
+ y = if(diff(y.lim) > 0){tempo.coord$y.range[1]}else{tempo.coord$y.range[2]},
+ yend = if(diff(y.lim) > 0){tempo.coord$y.range[1] + abs(diff(tempo.coord$y.range)) / 80}else{tempo.coord$y.range[2] - abs(diff(tempo.coord$y.range)) / 80}
+ ))
+ # }else{ # not working because of the ggplot2 bug
+ # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(geom = "segment", y = x.second.tick.pos, yend = x.second.tick.pos, x = tempo.coord$x.range[1], xend = tempo.coord$x.range[1] + diff(tempo.coord$x.range) / 80))
+ # }
+ coord.names <- c(coord.names, "x.second.tick.positions")
+}else if(( ! is.null(x.second.tick.nb)) & x.log == "no"){
+ # if(x.second.tick.nb > 0){ #inactivated because already checked before
+ if(length(tempo.scale) < 2){
+ tempo.cat1 <- c("x.tick.nb", "x.second.tick.nb")
+ tempo.cat2 <- sapply(list(x.tick.nb, x.second.tick.nb), FUN = paste0, collapse = " ")
+ tempo.sep <- sapply(mapply(" ", max(nchar(tempo.cat1)) - nchar(tempo.cat1) + 3, FUN = rep, SIMPLIFY = FALSE), FUN = paste0, collapse = "")
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE NUMBER OF GENERATED TICKS FOR THE X-AXIS IS NOT CORRECT: ", length(tempo.scale), "\nUSING THESE ARGUMENT SETTINGS (NO DISPLAY MEANS NULL VALUE):\n", paste0(tempo.cat1, tempo.sep, tempo.cat2, collapse = "\n"), "\nPLEASE, TEST OTHER VALUES")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else{
+ tempo <- fun_inter_ticks(lim = x.lim, log = x.log, breaks = tempo.scale, n = x.second.tick.nb)
+ }
+ x.second.tick.values <- tempo$values
+ x.second.tick.pos <- tempo$coordinates
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(
+ geom = "segment",
+ x = x.second.tick.pos,
+ xend = x.second.tick.pos,
+ y = if(diff(y.lim) > 0){tempo.coord$y.range[1]}else{tempo.coord$y.range[2]},
+ yend = if(diff(y.lim) > 0){tempo.coord$y.range[1] + abs(diff(tempo.coord$y.range)) / 80}else{tempo.coord$y.range[2] - abs(diff(tempo.coord$y.range)) / 80}
+ ))
+ coord.names <- c(coord.names, "x.second.tick.positions")
+}
+# for the ggplot2 bug with x.log, this does not work: eval(parse(text = ifelse(vertical == FALSE & x.log == "log10", "ggplot2::scale_x_continuous", "ggplot2::scale_x_continuous")))
+assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_x_continuous(
+ breaks = tempo.scale,
+ minor_breaks = x.second.tick.pos,
+ labels = if(x.log == "log10"){scales::trans_format("identity", scales::math_format(10^.x))}else if(x.log == "log2"){scales::trans_format("identity", scales::math_format(2^.x))}else if(x.log == "no"){ggplot2::waiver()}else{tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nCODE INCONSISTENCY 10") ; stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)},
+ expand = c(0, 0), # remove space after after axis limits
+ limits = sort(x.lim), # NA indicate that limits must correspond to data limits but xlim() already used
+ oob = scales::rescale_none,
+ trans = ifelse(diff(x.lim) < 0, "reverse", "identity") # equivalent to ggplot2::scale_x_reverse() but create the problem of x-axis label disappearance with x.lim decreasing. Thus, do not use. Use xlim() below and after this
+))
+# end x.second.tick.positions
+# y.second.tick.positions # coordinates of secondary ticks (only if y.second.tick.nb argument is non-null or if y.log argument is different from "no")
+if(y.log != "no"){ # integer main ticks for log2 and log10
+ tempo.scale <- (as.integer(min(y.lim, na.rm = TRUE)) - 1):(as.integer(max(y.lim, na.rm = TRUE)) + 1)
+}else{
+ tempo <- if(is.null(attributes(tempo.coord$y$breaks))){tempo.coord$y$breaks}else{unlist(attributes(tempo.coord$y$breaks))}
+ if(all(is.na(tempo))){
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nONLY NA IN tempo.coord$y$breaks")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }
+ if(length(unique(y.lim)) <= 1){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nIT SEEMS THAT Y-AXIS VALUES HAVE A NULL RANGE: ", paste(y.lim, collapse = " "), "\nPLEASE, USE THE y.lim ARGUMENT WITH 2 DIFFERENT VALUES TO SOLVE THIS")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }else{
+ tempo.scale <- fun_scale(lim = y.lim, n = ifelse(is.null(y.tick.nb), length(tempo[ ! is.na(tempo)]), y.tick.nb)) # in ggplot 3.3.0, tempo.coord$y.major_source replaced by tempo.coord$y$breaks. If fact: n = ifelse(is.null(y.tick.nb), length(tempo[ ! is.na(tempo)]), y.tick.nb)) replaced by n = ifelse(is.null(y.tick.nb), 4, y.tick.nb))
+ }
+}
+y.second.tick.values <- NULL
+y.second.tick.pos <- NULL
+if(y.log != "no"){
+ tempo <- fun_inter_ticks(lim = y.lim, log = y.log)
+ y.second.tick.values <- tempo$values
+ y.second.tick.pos <- tempo$coordinates
+ # if(vertical == TRUE){ # do not remove in case the bug is fixed
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(
+ geom = "segment",
+ y = y.second.tick.pos,
+ yend = y.second.tick.pos,
+ x = if(diff(x.lim) > 0){tempo.coord$x.range[1]}else{tempo.coord$x.range[2]},
+ xend = if(diff(x.lim) > 0){tempo.coord$x.range[1] + abs(diff(tempo.coord$x.range)) / 80}else{tempo.coord$x.range[2] - abs(diff(tempo.coord$x.range)) / 80}
+ ))
+ # }else{ # not working because of the ggplot2 bug
+ # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(geom = "segment", x = y.second.tick.pos, xend = y.second.tick.pos, y = tempo.coord$y.range[1], yend = tempo.coord$y.range[1] + diff(tempo.coord$y.range) / 80))
+ # }
+ coord.names <- c(coord.names, "y.second.tick.positions")
+}else if(( ! is.null(y.second.tick.nb)) & y.log == "no"){
+ # if(y.second.tick.nb > 0){ #inactivated because already checked before
+ if(length(tempo.scale) < 2){
+ tempo.cat1 <- c("y.tick.nb", "y.second.tick.nb")
+ tempo.cat2 <- sapply(list(y.tick.nb, y.second.tick.nb), FUN = paste0, collapse = " ")
+ tempo.sep <- sapply(mapply(" ", max(nchar(tempo.cat1)) - nchar(tempo.cat1) + 3, FUN = rep, SIMPLIFY = FALSE), FUN = paste0, collapse = "")
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE NUMBER OF GENERATED TICKS FOR THE Y-AXIS IS NOT CORRECT: ", length(tempo.scale), "\nUSING THESE ARGUMENT SETTINGS (NO DISPLAY MEANS NULL VALUE):\n", paste0(tempo.cat1, tempo.sep, tempo.cat2, collapse = "\n"), "\nPLEASE, TEST OTHER VALUES")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else{
+ tempo <- fun_inter_ticks(lim = y.lim, log = y.log, breaks = tempo.scale, n = y.second.tick.nb)
+ }
+ y.second.tick.values <- tempo$values
+ y.second.tick.pos <- tempo$coordinates
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(
+ geom = "segment",
+ y = y.second.tick.pos,
+ yend = y.second.tick.pos,
+ x = if(diff(x.lim) > 0){tempo.coord$x.range[1]}else{tempo.coord$x.range[2]},
+ xend = if(diff(x.lim) > 0){tempo.coord$x.range[1] + abs(diff(tempo.coord$x.range)) / 80}else{tempo.coord$x.range[2] - abs(diff(tempo.coord$x.range)) / 80}
+ ))
+ coord.names <- c(coord.names, "y.second.tick.positions")
+}
+# for the ggplot2 bug with y.log, this does not work: eval(parse(text = ifelse(vertical == FALSE & y.log == "log10", "ggplot2::scale_x_continuous", "ggplot2::scale_y_continuous")))
+assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_y_continuous(
+ breaks = tempo.scale,
+ minor_breaks = y.second.tick.pos,
+ labels = if(y.log == "log10"){scales::trans_format("identity", scales::math_format(10^.x))}else if(y.log == "log2"){scales::trans_format("identity", scales::math_format(2^.x))}else if(y.log == "no"){ggplot2::waiver()}else{tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nCODE INCONSISTENCY 10") ; stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)},
+ expand = c(0, 0), # remove space after axis limits
+ limits = sort(y.lim), # NA indicate that limits must correspond to data limits but ylim() already used
+ oob = scales::rescale_none,
+ trans = ifelse(diff(y.lim) < 0, "reverse", "identity") # equivalent to ggplot2::scale_y_reverse() but create the problem of y-axis label disappearance with y.lim decreasing. Thus, do not use. Use ylim() below and after this
+))
+# end y.second.tick.positions
+assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::coord_cartesian(xlim = x.lim, ylim = y.lim)) # clip = "off" to have secondary ticks outside plot region. The problem is that points out of bounds are also drawn outside the plot region. Thus, I cannot use it # at that stage, x.lim and y.lim not NULL anymore
+# end scale management
+
+
+
+
+# drawing
+fin.plot <- eval(parse(text = paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + ")))
+grob.save <- NULL
+if(plot == TRUE){
+ if( ! is.null(legend.width)){ # any(unlist(legend.disp)) == TRUE removed to have empty legend space # not & any(unlist(fin.lg.disp)) == TRUE here because converted to FALSE
+ grob.save <- suppressMessages(suppressWarnings(gridExtra::grid.arrange(fin.plot, legend.final, ncol=2, widths=c(1, legend.width))))
+ }else{
+ grob.save <- suppressMessages(suppressWarnings(print(fin.plot)))
+ }
+}else{
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") PLOT NOT SHOWN AS REQUESTED")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+}
+# end drawing
+
+
+
+# output
+if(warn.print == TRUE & ! is.null(warn)){
+ on.exit(warning(paste0("FROM ", function.name, ":\n\n", warn), call. = FALSE))
+}
+on.exit(exp = options(warning.length = ini.warning.length), add = TRUE)
+if(return == TRUE){
+ output <- suppressMessages(ggplot2::ggplot_build(fin.plot))
+ # output$data <- output$data[-1] # yes for boxplot but not for scatter # remove the first data because corresponds to the initial empty boxplot
+ if(length(output$data) != length(coord.names)){
+ tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, ": length(output$data) AND length(coord.names) MUST BE IDENTICAL. CODE HAS TO BE MODIFIED")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }else{
+ names(output$data) <- coord.names
+ }
+ if(is.null(unlist(removed.row.nb))){
+ removed.row.nb <- NULL
+ removed.rows <- NULL
+ }else{
+ for(i3 in 1:length(data1)){
+ if( ! is.null(removed.row.nb[[i3]])){
+ removed.row.nb[[i3]] <- sort(removed.row.nb[[i3]])
+ removed.rows[[i3]] <- data1.ini[[i3]][removed.row.nb[[i3]], ]
+ }
+ }
+ }
+ tempo <- output$layout$panel_params[[1]]
+ output <- list(
+ data = data1,
+ removed.row.nb = removed.row.nb,
+ removed.rows = removed.rows,
+ plot = c(output$data, x.second.tick.values = list(x.second.tick.values), y.second.tick.values = list(y.second.tick.values)),
+ panel = facet.categ,
+ axes = list(
+ x.range = tempo$x.range,
+ x.labels = if(is.null(attributes(tempo$x$breaks))){tempo$x$breaks}else{tempo$x$scale$get_labels()}, # is.null(attributes(tempo$x$breaks)) test if it is number (TRUE) or character (FALSE)
+ x.positions = if(is.null(attributes(tempo$x$breaks))){tempo$x$breaks}else{unlist(attributes(tempo$x$breaks))},
+ y.range = tempo$y.range,
+ y.labels = if(is.null(attributes(tempo$y$breaks))){tempo$y$breaks}else{tempo$y$scale$get_labels()},
+ y.positions = if(is.null(attributes(tempo$y$breaks))){tempo$y$breaks}else{unlist(attributes(tempo$y$breaks))}
+ ),
+ warn = paste0("\n", warn, "\n\n"),
+ ggplot = if(return.ggplot == TRUE){fin.plot}else{NULL}, # fin.plot plots the graph if return == TRUE
+ gtable = if(return.gtable == TRUE){grob.save}else{NULL} #
+ )
+ return(output) # this plots the graph if return.ggplot is TRUE and if no assignment
+}
+# end output
+# end main code
+}
+
+
+
+
+
+fun_gg_donut <- function(
+ data1,
+ freq,
+ categ,
+ fill.palette = NULL,
+ fill.color = NULL,
+ hole.size = 0.5,
+ hole.text = TRUE,
+ hole.text.size = 14,
+ border.color = "gray50",
+ border.size = 0.2,
+ title = "",
+ title.text.size = 12,
+ annotation = NULL,
+ annotation.distance = 0,
+ annotation.size = 3,
+ annotation.force = 1,
+ annotation.force.pull = 100,
+ legend.show = TRUE,
+ legend.width = 0.25,
+ legend.name = NULL,
+ legend.limit = NULL,
+ legend.add.prop = FALSE,
+ add = NULL,
+ return = FALSE,
+ return.ggplot = FALSE,
+ return.gtable = TRUE,
+ plot = TRUE,
+ warn.print = TRUE,
+ lib.path = NULL
+){
+ # AIM
+ # Plot a ggplot2 donut using contingency data, systematically in the decreasing order of frequencies, starting at the top and turning clockwise
+ # For ggplot2 specifications, see: https://ggplot2.tidyverse.org/articles/ggplot2-specs.html
+ # WARNINGS
+ # Rows containing NA in data1[, c(freq, categ)] will be removed before processing, with a warning (see below)
+ # Size arguments (hole.text.size, border.size, title.text.size and annotation.size) are in mm. See Hadley comment in https://stackoverflow.com/questions/17311917/ggplot2-the-unit-of-size. See also http://sape.inf.usi.ch/quick-reference/ggplot2/size). Unit object are not accepted, but conversion can be used (e.g., grid::convertUnit(grid::unit(0.2, "inches"), "mm", valueOnly = TRUE))
+ # ARGUMENTS
+ # data1: a dataframe compatible with ggplot2
+ # freq: single character string of the data1 column name of the frequencies
+ # categ: single character string of the data1 column name of categories (qualitative variable)
+ # fill.palette: single character string of a palette name (see ?ggplot2::scale_fill_brewer() for the list).Ignored if fill.color is not NULL
+ # fill.color: either (1) NULL, or (2) a vector of character strings or integers of same length as the number of classes in categ. Colors can be color names (see ?colors() in R), hexadecimal color codes, or integers (according to the ggplot2 palette). The order of the elements will be used according to the frequency values, from highest to lowest. An easy way to use this argument is to sort data1 according to the frequencies values, add a color column with the corresponding desired colors and use the content of this column as values of fill.color. If color is NULL and fill.palette is NULL, default colors of ggplot2 are used. If color is not NULL, it overrides fill.palette
+ # hole.size: single positive proportion of donut central hole, 0 meaning no hole (pie chart) and 1 no plot (donut with a null thickness)
+ # hole.text: logical (either TRUE or FALSE). Display the sum of frequencies (column of data1 indicated in the freq argument) ?
+ # hole.text.size: single positive numeric value of the title font size in mm. Ignored if hole.text is FALSE
+ # border.color: a single character string or integer. Colors can be color names (see ?colors() in R), hexadecimal color codes, or integers (according to the ggplot2 palette)
+ # border.size: single numeric value of border tickness in mm. Write zero for no dot border
+ # title: single character string of the graph title
+ # title.text.size: single numeric value of the title font size in mm
+ # annotation: single character string of the data1 column name of annotations. Values inside this column will be displayed over the corresponding slices of the donut. Write NULL if not required
+ # annotation.distance: single positive numeric value of the distance from the center of the slice. 0 means center of the slice, 0.5 means at the edge. Above 0.5, the donut will be reduced to make place for the annotation. Ignored if annotation is NULL
+ # annotation.size: single positive numeric value of the annotation font size in mm. Ignored if annotation is NULL
+ # annotation.force: single positive numeric value of the force of repulsion between overlapping text labels. See ?ggrepel::geom_text_repel() in R. Ignored if annotation is NULL
+ # annotation.force.pull: single positive numeric value of the force of attraction between a text label and its corresponding data point. See ?ggrepel::geom_text_repel() in R. Ignored if annotation is NULL
+ # legend.show: logical (either TRUE or FALSE). Show legend?
+ # legend.width: single proportion (between 0 and 1) indicating the relative width of the legend sector (on the right of the plot) relative to the width of the plot. Value 1 means that the window device width is split in 2, half for the plot and half for the legend. Value 0 means no room for the legend, which will overlay the plot region. Write NULL to inactivate the legend sector. In such case, ggplot2 will manage the room required for the legend display, meaning that the width of the plotting region can vary between graphs, depending on the text in the legend
+ # legend.name: character string of the legend title. If legend.name is NULL then legend.name is the value of the categ argument. Write legend.name = "" to remove the legend
+ # legend.limit: single positive proportion of the classes displayed in the legend for which the corresponding proportion is over legend.limit. Write NULL to display all the classes
+ # legend.add.prop: logical (either TRUE or FALSE). add the proportion after the class names in the legend ?
+ # add: character string allowing to add more ggplot2 features (dots, lines, themes, facet, etc.). Ignored if NULL
+ # WARNING: (1) the string must start with "+", (2) the string must finish with ")" and (3) each function must be preceded by "ggplot2::". Example: "+ ggplot2::coord_flip() + ggplot2::theme_bw()"
+ # If the character string contains the "ggplot2::theme" string, then the article argument of fun_gg_donut() (see above) is ignored with a warning. In addition, some arguments can be overwritten, like x.angle (check all the arguments)
+ # Handle the add argument with caution since added functions can create conflicts with the preexisting internal ggplot2 functions
+ # WARNING: the call of objects inside the quotes of add can lead to an error if the name of these objects are some of the fun_gg_donut() arguments. Indeed, the function will use the internal argument instead of the global environment object. Example article <- "a" in the working environment and add = '+ ggplot2::ggtitle(article)'. The risk here is to have TRUE as title. To solve this, use add = '+ ggplot2::ggtitle(get("article", envir = .GlobalEnv))'
+ # return: logical (either TRUE or FALSE). Return the graph parameters?
+ # return.ggplot: logical (either TRUE or FALSE). Return the ggplot object in the output list? Ignored if return argument is FALSE. WARNING: always assign the fun_gg_donut() function (e.g., a <- fun_gg_donut()) into something if the return.ggplot argument is TRUE, otherwise, double plotting is performed. See $ggplot in the RETURN section below for more details
+ # return.gtable: logical (either TRUE or FALSE). Return the full graph (main, title and legend) as a gtable of grobs in the output list? See $gtable in the RETURN section below for more details
+ # plot: logical (either TRUE or FALSE). Plot the graphic? If FALSE and return argument is TRUE, graphical parameters and associated warnings are provided without plotting
+ # warn.print: logical (either TRUE or FALSE). Print warnings at the end of the execution? ? If FALSE, warning messages are never printed, but can still be recovered in the returned list. Some of the warning messages (those delivered by the internal ggplot2 functions) are not apparent when using the argument plot = FALSE
+ # lib.path: vector of character strings indicating the absolute path of the required packages (see below). if NULL, the function will use the R library default folders
+ # RETURN
+ # a donut plot if plot argument is TRUE
+ # a list of the graph info if return argument is TRUE:
+ # $data: the initial data with modifications and with graphic information added
+ # $removed.row.nb: a list of the removed rows numbers in data frames (because of NA). NULL if no row removed
+ # $removed.rows: a list of the removed rows in data frames (because of NA). NULL if no row removed
+ # $plot.data
+ # $panel: the variable names used for the panels (NULL if no panels). WARNING: NA can be present according to ggplot2 upgrade to v3.3.0
+ # $axes: the x-axis and y-axis info
+ # $warn: the warning messages. Use cat() for proper display. NULL if no warning. WARNING: warning messages delivered by the internal ggplot2 functions are not apparent when using the argument plot = FALSE
+ # $ggplot: ggplot object that can be used for reprint (use print($ggplot) or update (use $ggplot + ggplot2::...). NULL if return.ggplot argument is FALSE. Warning: the legend is not in $ggplot as it is in a separated grob (use $gtable to get it). Of note, a non-null $ggplot in the output list is sometimes annoying as the manipulation of this list prints the plot
+ # $gtable: gtable object that can be used for reprint (use gridExtra::grid.arrange(...$ggplot) or with additionnal grobs (see the grob decomposition in the examples). Contrary to $ggplot, a non-NULL $gtable in the output list is not annoying as the manipulation of this list does not print the plot
+ # REQUIRED PACKAGES
+ # ggplot2
+ # gridExtra
+ # grid
+ # lemon (in case of use in the add argument)
+ # ggrepel
+ # REQUIRED FUNCTIONS FROM THE cute PACKAGE
+ # fun_gg_palette()
+ # fun_gg_get_legend()
+ # fun_pack()
+ # fun_check()
+ # EXAMPLES
+ # obs1 <- data.frame(Km = c(20, 10, 1, 5), Car = c("TUUT", "WIIM", "BIP", "WROUM"), Color1 = 1:4, color2 = c("red", "blue", "green", "black"), Country = c("FR", "UK", "US", NA), stringsAsFactors = TRUE) ; fun_gg_donut(data1 = obs1, freq = "Km", categ = "Car", annotation = "Country")
+ # DEBUGGING
+ # obs1 <- data.frame(Km = c(20, 10, 1, 5), Car = c("TUUT", "WIIM", "BIP", "WROUM"), Color1 = 1:4, color2 = c("red", "blue", "green", "black"), Country = c("FR", "UK", "US", NA), stringsAsFactors = TRUE) ; data1 = obs1 ; freq = "Km" ; categ = "Car" ; fill.palette = NULL ; fill.color = NULL ; hole.size = 0.5 ; hole.text = TRUE ; hole.text.size = 12 ; border.color = "gray50" ; border.size = 0.1 ; title = "" ; title.text.size = 12 ; annotation = "Country" ; annotation.distance = 0.5 ; annotation.size = 3 ; annotation.force = 1 ; annotation.force.pull = 100 ; legend.show = TRUE ; legend.width = 0.5 ; legend.name = NULL ; legend.limit = NULL ; legend.add.prop = FALSE ; add = NULL ; return = TRUE ; return.ggplot = FALSE ; return.gtable = TRUE ; plot = TRUE ; warn.print = FALSE ; lib.path = NULL
+ # function name
+ function.name <- paste0(as.list(match.call(expand.dots=FALSE))[[1]], "()")
+ arg.names <- names(formals(fun = sys.function(sys.parent(n = 2)))) # names of all the arguments
+ arg.user.setting <- as.list(match.call(expand.dots=FALSE))[-1] # list of the argument settings (excluding default values not provided by the user)
+ # end function name
+ # required function checking
+ req.function <- c(
+ "fun_check",
+ "fun_gg_palette",
+ "fun_gg_get_legend",
+ "fun_pack"
+ )
+ tempo <- NULL
+ for(i1 in req.function){
+ if(length(find(i1, mode = "function"))== 0L){
+ tempo <- c(tempo, i1)
+ }
+ }
+ if( ! is.null(tempo)){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nREQUIRED cute FUNCTION", ifelse(length(tempo) > 1, "S ARE", " IS"), " MISSING IN THE R ENVIRONMENT:\n", paste0(tempo, collapse = "()\n"))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ # end required function checking
+ # reserved words to avoid bugs (used in this function)
+ # end reserved words to avoid bugs (used in this function)
+ # arg with no default values
+ mandat.args <- c(
+ "data1",
+ "freq",
+ "categ"
+ )
+ tempo <- eval(parse(text = paste0("missing(", paste0(mandat.args, collapse = ") | missing("), ")")))
+ if(any(tempo)){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nFOLLOWING ARGUMENT", ifelse(length(mandat.args) > 1, "S HAVE", "HAS"), " NO DEFAULT VALUE AND REQUIRE ONE:\n", paste0(mandat.args, collapse = "\n"))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ # end arg with no default values
+ # argument primary checking
+ arg.check <- NULL #
+ text.check <- NULL #
+ checked.arg.names <- NULL # for function debbuging: used by r_debugging_tools
+ ee <- expression(arg.check <- c(arg.check, tempo$problem) , text.check <- c(text.check, tempo$text) , checked.arg.names <- c(checked.arg.names, tempo$object.name))
+ tempo <- fun_check(data = data1, class = "data.frame", na.contain = TRUE, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = freq, class = "vector", mode = "character", na.contain = FALSE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = categ, class = "vector", mode = "character", na.contain = FALSE, length = 1, fun.name = function.name) ; eval(ee)
+ if( ! is.null(fill.palette)){
+ tempo <- fun_check(data = fill.palette, options = c("BrBG", "PiYG", "PRGn", "PuOr", "RdBu", "RdGy", "RdYlBu", "RdYlGn", "Spectral", "Accent", "Dark2", "Paired", "Pastel1", "Pastel2", "Set1", "Set2", "Set3", "Blues", "BuGn", "BuPu", "GnBu", "Greens", "Greys", "Oranges", "OrRd", "PuBu", "PuBuGn", "PuRd", "Purples", "RdPu", "Reds", "YlGn", "YlGnBu", "YlOrBr", "YlOrRd"), length = 1, fun.name = function.name) ; eval(ee)
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = fill.palette, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ if( ! is.null(fill.color)){
+ tempo1 <- fun_check(data = fill.color, class = "vector", mode = "character", na.contain = TRUE, fun.name = function.name)
+ tempo2 <- fun_check(data = fill.color, class = "factor", na.contain = TRUE, fun.name = function.name)
+ tempo3 <- fun_check(data = fill.color, class = "integer", double.as.integer.allowed = TRUE, na.contain = TRUE, neg.values = FALSE, fun.name = function.name) # not need to test inf with integers
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE & tempo3$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nfill.color ARGUMENT MUST BE A VECTOR OF (1) HEXADECIMAL COLOR STRINGS STARTING BY #, OR (2) COLOR NAMES GIVEN BY colors(), OR (3) POSITIVE INTEGER VALUES")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ checked.arg.names <- c(checked.arg.names, tempo1$object.name)
+ }else if(tempo3$problem == FALSE & any(is.infinite(fill.color))){ # is.infinite() deals with NA as FALSE
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nfill.color ARGUMENT CANNOT CONTAIN Inf VALUES AMONG POSITIVE INTEGER VALUES")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ checked.arg.names <- c(checked.arg.names, tempo1$object.name)
+ }else if(tempo3$problem == FALSE & any(fill.color == 0, na.rm = TRUE)){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nfill.color ARGUMENT CANNOT CONTAIN 0 AMONG POSITIVE INTEGER VALUES")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ checked.arg.names <- c(checked.arg.names, tempo1$object.name)
+ }
+ }
+ tempo <- fun_check(data = hole.size, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = hole.text, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = hole.text.size, class = "vector", mode = "numeric", neg.values = FALSE, inf.values = FALSE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo1 <- fun_check(data = border.color, class = "vector", mode = "character", na.contain = FALSE, length = 1, fun.name = function.name)
+ tempo2 <- fun_check(data = border.color, class = "integer", double.as.integer.allowed = TRUE, neg.values = FALSE, na.contain = FALSE, length = 1, fun.name = function.name) # not need to test inf with integers
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nborder.color ARGUMENT MUST BE A SINGLE CHARACTER STRING OR POSITIVE INTEGER")
+ text.check <- c(text.check, tempo.cat)
+ arg.check <- c(arg.check, TRUE)
+ checked.arg.names <- c(checked.arg.names, tempo1$object.name)
+ }
+ tempo <- fun_check(data = border.size, class = "vector", mode = "numeric", na.contain = FALSE, neg.values = FALSE, inf.values = FALSE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = title, class = "vector", mode = "character", na.contain = FALSE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = title.text.size, class = "vector", mode = "numeric", na.contain = FALSE, neg.values = FALSE, inf.values = FALSE, length = 1, fun.name = function.name) ; eval(ee)
+ if( ! is.null(annotation)){
+ tempo <- fun_check(data = annotation, class = "vector", mode = "character", na.contain = FALSE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = annotation.distance, class = "vector", mode = "numeric", na.contain = FALSE, neg.values = FALSE, inf.values = FALSE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = annotation.size, class = "vector", mode = "numeric", na.contain = FALSE, neg.values = FALSE, inf.values = FALSE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = annotation.force, class = "vector", mode = "numeric", na.contain = FALSE, neg.values = FALSE, inf.values = FALSE, length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = annotation.force.pull, class = "vector", mode = "numeric", na.contain = FALSE, neg.values = FALSE, inf.values = FALSE, length = 1, fun.name = function.name) ; eval(ee)
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = annotation, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ tempo <- fun_check(data = legend.show, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ if( ! is.null(legend.width)){
+ tempo <- fun_check(data = legend.width, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = legend.width, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ if( ! is.null(legend.name)){
+ tempo <- fun_check(data = legend.name, class = "vector", mode = "character", na.contain = FALSE, length = 1, fun.name = function.name) ; eval(ee)
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = legend.name, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ if( ! is.null(legend.limit)){
+ tempo <- fun_check(data = legend.limit, prop = TRUE, length = 1, fun.name = function.name) ; eval(ee)
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = legend.limit, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ tempo <- fun_check(data = legend.add.prop, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ if( ! is.null(add)){
+ tempo <- fun_check(data = add, class = "vector", mode = "character", length = 1, fun.name = function.name) ; eval(ee)
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = add, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ tempo <- fun_check(data = return, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = return.ggplot, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = return.gtable, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = plot, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ tempo <- fun_check(data = warn.print, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
+ if( ! is.null(lib.path)){
+ tempo <- fun_check(data = lib.path, class = "vector", mode = "character", fun.name = function.name) ; eval(ee) # several possible paths
+ }else{
+ # no fun_check test here, it is just for checked.arg.names
+ tempo <- fun_check(data = lib.path, class = "vector")
+ checked.arg.names <- c(checked.arg.names, tempo$object.name)
+ }
+ if(any(arg.check) == TRUE){
+ stop(paste0("\n\n================\n\n", paste(text.check[arg.check], collapse = "\n"), "\n\n================\n\n"), call. = FALSE) #
+ }
+ # source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.7/r_debugging_tools-v1.7.R") ; eval(parse(text = str_basic_arg_check_dev)) ; eval(parse(text = str_arg_check_with_fun_check_dev)) # activate this line and use the function (with no arguments left as NULL) to check arguments status and if they have been checked using fun_check()
+ # end argument primary checking
+ # second round of checking and data preparation
+ # management of NA arguments
+ tempo.arg <- names(arg.user.setting) # values provided by the user
+ tempo.log <- suppressWarnings(sapply(lapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = is.na), FUN = any)) & lapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = length)== 1L # no argument provided by the user can be just NA
+ if(any(tempo.log) == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\n", ifelse(sum(tempo.log, na.rm = TRUE) > 1, "THESE ARGUMENTS\n", "THIS ARGUMENT\n"), paste0(tempo.arg[tempo.log], collapse = "\n"),"\nCANNOT BE JUST NA")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ # end management of NA arguments
+ # management of NULL arguments
+ tempo.arg <-c(
+ "data1",
+ "freq",
+ "categ",
+ # "fill.palette", # inactivated because can be null
+ # "fill.color", # inactivated because can be null
+ "hole.size",
+ "hole.text",
+ "hole.text.size",
+ "border.color",
+ "border.size",
+ "title",
+ "title.text.size",
+ # "annotation", # inactivated because can be null
+ "annotation.distance",
+ "annotation.size",
+ "annotation.force",
+ "annotation.force.pull",
+ "legend.show",
+ # "legend.width", # inactivated because can be null
+ # "legend.name", # inactivated because can be null
+ # "legend.limit", # inactivated because can be null
+ "legend.add.prop",
+ # "add", # inactivated because can be null
+ "return",
+ "return.ggplot",
+ "return.gtable",
+ "plot",
+ "warn.print"
+ # "lib.path" # inactivated because can be null
+ )
+ tempo.log <- sapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = is.null)
+ if(any(tempo.log) == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\n", ifelse(sum(tempo.log, na.rm = TRUE) > 1, "THESE ARGUMENTS\n", "THIS ARGUMENT\n"), paste0(tempo.arg[tempo.log], collapse = "\n"),"\nCANNOT BE NULL")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
+ # end management of NULL arguments
+ # code that protects set.seed() in the global environment
+ if(exists(".Random.seed", envir = .GlobalEnv)){ # if .Random.seed does not exists, it means that no random operation has been performed yet in any R environment
+ tempo.random.seed <- .Random.seed
+ on.exit(assign(".Random.seed", tempo.random.seed, env = .GlobalEnv))
+ }else{
+ on.exit(set.seed(NULL)) # inactivate seeding -> return to complete randomness
+ }
+ set.seed(1)
+ # end code that protects set.seed() in the global environment
+ # warning initiation
+ ini.warning.length <- options()$warning.length
+ options(warning.length = 8170)
+ warn <- NULL
+ warn.count <- 0
+ # end warning initiation
+ # other checkings
+ removed.row.nb <- NULL
+ removed.rows <- data.frame(stringsAsFactors = FALSE)
+ data1.ini <- data1 # strictly identical to data1
+ if( ! freq %in% names(data1)){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nfreq ARGUMENT MUST BE A COLUMN NAME OF THE data1 ARGUMENT")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }else{
+ if(all(is.na(data1[ , freq]) | is.infinite(data1[ , freq]))){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE freq COLUMN OF data1 CANNOT BE JUST NA OR Inf")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }
+ tempo <- fun_check(data = data1[ , freq], mode = "numeric", neg.values = FALSE, fun.name = function.name)
+ if(tempo$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\n", tempo$text)
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }
+ # Inf and NA removal
+ if(any(is.infinite(data1[, freq]) | is.na(data1[, freq]))){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") PRESENCE OF Inf OR NA VALUES IN THE ", freq, " COLUMN OF THE data1 ARGUMENT AND CORRESPONDING ROWS REMOVED (SEE $removed.row.nb AND $removed.rows)")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ tempo <- which(is.infinite(data1.ini[, freq]) | is.na(data1.ini[, freq])) # data.ini used for the output
+ removed.row.nb <- c(removed.row.nb, tempo)
+ removed.rows <- rbind(removed.rows, data1.ini[tempo, ], stringsAsFactors = FALSE) # data.ini used for the output
+ data1 <- data1[ ! (is.infinite(data1[, freq]) | is.na(data1[, freq])), ] #
+ }
+ # end Inf and NA removal
+ # 0 removal
+ if(any(data1[, freq] == 0)){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") PRESENCE OF 0 VALUES IN THE ", freq, " COLUMN OF THE data1 ARGUMENT AND CORRESPONDING ROWS REMOVED (SEE $removed.row.nb AND $removed.rows)")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ tempo <- which(data1[, freq] == 0) # data.ini used for the output
+ removed.row.nb <- c(removed.row.nb, tempo)
+ removed.rows <- rbind(removed.rows, data1.ini[tempo, ], stringsAsFactors = FALSE) # data.ini used for the output
+ data1 <- data1[ data1[, freq] != 0, ] #
+ }
+ # end 0 removal
+ }
-
-
- # legend display
- tempo.legend.final <- 'ggplot2::guides(
-fill = if(fin.lg.disp[[1]] == TRUE){
-ggplot2::guide_legend(
-order = lg.order[[1]],
-override.aes = list(
-fill = lg.color[[1]],
-colour = if(lg.dot.shape[[1]] %in% 21:24 & ! is.null(dot.border.color)){lg.dot.border.color[[1]]}else{lg.color[[1]]}, # lg.dot.shape[[1]] %in% 21:24 are the only one that can be filled
-shape = lg.dot.shape[[1]],
-size = lg.dot.size[[1]],
-stroke = lg.dot.border.size[[1]],
-alpha = lg.alpha[[1]],
-linetype = 0
-)
-)
-}else{
-"none"
-},
-shape = if(fin.lg.disp[[2]] == TRUE){
-ggplot2::guide_legend(
-order = lg.order[[2]],
-override.aes = list(
-fill = lg.color[[2]],
-colour = if(lg.dot.shape[[2]] %in% 21:24 & ! is.null(dot.border.color)){lg.dot.border.color[[2]]}else{lg.color[[2]]}, # lg.dot.shape[[2]] %in% 21:24 are the only one that can be filled
-shape = lg.dot.shape[[2]],
-size = lg.dot.size[[2]],
-stroke = lg.dot.border.size[[2]],
-alpha = lg.alpha[[2]],
-linetype = 0
-)
-)
-}else{
-"none"
-},
-stroke = if(fin.lg.disp[[3]] == TRUE){
-ggplot2::guide_legend(
-order = lg.order[[3]],
-override.aes = list(
-fill = lg.color[[3]],
-colour = if(lg.dot.shape[[3]] %in% 21:24 & ! is.null(dot.border.color)){lg.dot.border.color[[3]]}else{lg.color[[3]]}, # lg.dot.shape[[3]] %in% 21:24 are the only one that can be filled
-shape = lg.dot.shape[[3]],
-size = lg.dot.size[[3]],
-stroke = lg.dot.border.size[[3]],
-alpha = lg.alpha[[3]],
-linetype = 0
-)
-)
-}else{
-"none"
-},
-linetype = if(fin.lg.disp[[4]] == TRUE){
-ggplot2::guide_legend(
-order = lg.order[[4]],
-override.aes = list(
-color = lg.color[[4]],
-size = lg.line.size[[4]],
-linetype = lg.line.type[[4]],
-alpha = lg.alpha[[4]],
-shape = NA
-)
-)
-}else{
-"none"
-},
-alpha = if(fin.lg.disp[[5]] == TRUE){
-ggplot2::guide_legend(
-order = lg.order[[5]],
-override.aes = list(
-color = lg.color[[5]],
-size = lg.line.size[[5]],
-linetype = lg.line.type[[5]],
-alpha = lg.alpha[[5]],
-shape = NA
-)
-)
-}else{
-"none"
-},
-size = if(fin.lg.disp[[6]] == TRUE){
-ggplot2::guide_legend(
-order = lg.order[[6]],
-override.aes = list(
-color = lg.color[[6]],
-size = lg.line.size[[6]],
-linetype = lg.line.type[[6]],
-alpha = lg.alpha[[6]],
-shape = NA
-)
-)
-}else{
-"none"
-}
-)' # clip = "off" to have secondary ticks outside plot region does not work
-if( ! is.null(legend.width)){
- if(any(unlist(legend.disp))){ # means some TRUE
- tempo.graph.info <- suppressMessages(ggplot2::ggplot_build(eval(parse(text = paste0(paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "), ' + ', tempo.legend.final))))) # will be recovered later again, when ylim will be considered
- legend.final <- fun_gg_get_legend(ggplot_built = tempo.graph.info, fun.name = function.name) # get legend
- fin.lg.disp[] <- FALSE # remove all the legends. Must be done even if fin.lg.disp is not appearing in the code thenafter. Otherwise twice the legend
- if(is.null(legend.final) & plot == TRUE){ # even if any(unlist(legend.disp)) is TRUE
- legend.final <- fun_gg_empty_graph() # empty graph instead of legend
+ if( ! categ %in% names(data1)){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\ncateg ARGUMENT MUST BE A COLUMN NAME OF THE data1 ARGUMENT")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }else{
+ if(all(is.na(data1[ , categ]))){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE categ COLUMN OF data1 CANNOT BE JUST NA")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }
+ tempo1 <- fun_check(data = categ, class = "vector", mode = "character", na.contain = TRUE, fun.name = function.name)
+ tempo2 <- fun_check(data = categ, class = "factor", na.contain = TRUE, fun.name = function.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE categ COLUMN OF data1 MUST BE CLASS \"factor\" OR \"character\"")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }
+ # NA removal
+ if(any(is.na(data1[, categ]))){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") PRESENCE OF NA VALUES IN THE ", categ, " COLUMN OF THE data1 ARGUMENT AND CORRESPONDING ROWS REMOVED (SEE $removed.row.nb AND $removed.rows)")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ tempo <- which(is.na(data1.ini[, categ])) # data.ini used for the output
+ removed.row.nb <- c(removed.row.nb, tempo)
+ removed.rows <- rbind(removed.rows, data1.ini[tempo, ], stringsAsFactors = FALSE) # data.ini used for the output
+ data1 <- data1[ ! is.na(data1[, categ]), ] #
+ }
+ # end Inf and NA removal
+ if(any(duplicated(data1[, categ]))){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE categ COLUMN OF data1 CANNOT CONTAIN DUPLICATED VALUES\n", paste(data1[, categ][duplicated(data1[, categ])], collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }
+ }
+
+ if( ! is.null(annotation)){
+ if( ! annotation %in% names(data1)){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nannotation ARGUMENT MUST BE A COLUMN NAME OF THE data1 ARGUMENT")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }else{
+ if(all(is.na(data1[ , annotation]))){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nIF NON NULL, THE annotation COLUMN OF data1 CANNOT BE JUST NA")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }
+ tempo1 <- fun_check(data = annotation, class = "vector", mode = "character", na.contain = TRUE, fun.name = function.name)
+ tempo2 <- fun_check(data = annotation, class = "factor", na.contain = TRUE, fun.name = function.name)
+ if(tempo1$problem == TRUE & tempo2$problem == TRUE){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE annotation COLUMN OF data1 MUST BE CLASS \"factor\" OR \"character\"")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }
+ if(any(duplicated(data1[, annotation]))){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") PRESENCE OF DUPLICATED VALUES IN THE ", annotation, " COLUMN OF THE data1 ARGUMENT: ", paste0(data1[, annotation][duplicated(data1[, annotation])], collapse = " "))
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ }
+ }
+ if(length(data1) == 0){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE data1 ARGUMENT IS EMPTY AFTER Inf, NA AND 0 REMOVAL IN THE ", freq, ifelse(is.null(annotation), " AND ", ", "), categ, ifelse(is.null(annotation), "", " AND "), " COLUMNS")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }
+ if( ! is.null(fill.color)){
+ if( ! is.numeric(fill.color)){
+ if( ! all(fill.color[ ! is.na(fill.color)] %in% colors() | grepl(pattern = "^#", fill.color[ ! is.na(fill.color)]), na.rm = TRUE)){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nfill.color ARGUMENT MUST BE A VECTOR OF (1) HEXADECIMAL COLOR STRINGS STARTING BY #, OR (2) COLOR NAMES GIVEN BY colors(), OR (3) INTEGER VALUES")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }else{
+ fill.color <- as.character(fill.color) # remove class factor is any
+ }
+ }
+ }
+ if( ! is.numeric(border.color)){
+ if( ! (border.color %in% colors() | grepl(pattern = "^#", border.color))){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nfill.color ARGUMENT MUST BE (1) A HEXADECIMAL COLOR STRING STARTING BY #, OR (2) A COLOR NAME GIVEN BY colors(), OR (3) AN INTEGER VALUE")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }else{
+ border.color <- as.character(border.color) # remove class factor is any
+ }
+ }
+ # legend name filling
+ if(is.null(legend.name)){
+ legend.name <- categ
+ }
+ # legend.name not NULL anymore
+ # end legend name filling
+ # verif of add
+ if( ! is.null(add)){
+ if( ! grepl(pattern = "^\\s*\\+", add)){ # check that the add string start by +
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nadd ARGUMENT MUST START WITH \"+\": ", paste(unique(add), collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+
+ }else if( ! grepl(pattern = "(ggplot2|lemon)\\s*::", add)){ #
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nFOR EASIER FUNCTION DETECTION, add ARGUMENT MUST CONTAIN \"ggplot2::\" OR \"lemon::\" IN FRONT OF EACH GGPLOT2 FUNCTION: ", paste(unique(add), collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }else if( ! grepl(pattern = ")\\s*$", add)){ # check that the add string finished by )
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nadd ARGUMENT MUST FINISH BY \")\": ", paste(unique(add), collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }
+ }
+ # end verif of add
+ # management of add containing facet
+ facet.categ <- NULL
+ if( ! is.null(add)){
+ facet.check <- TRUE
+ tempo <- unlist(strsplit(x = add, split = "\\s*\\+\\s*(ggplot2|lemon)\\s*::\\s*")) #
+ tempo <- sub(x = tempo, pattern = "^facet_wrap", replacement = "ggplot2::facet_wrap")
+ tempo <- sub(x = tempo, pattern = "^facet_grid", replacement = "ggplot2::facet_grid")
+ tempo <- sub(x = tempo, pattern = "^facet_rep", replacement = "lemon::facet_rep")
+
+ if(any(grepl(x = tempo, pattern = "ggplot2::facet_wrap|lemon::facet_rep_wrap"))){
+ tempo1 <- suppressWarnings(eval(parse(text = tempo[grepl(x = tempo, pattern = "ggplot2::facet_wrap|lemon::facet_rep_wrap")])))
+ facet.categ <- list(names(tempo1$params$facets)) # list of length 1
+ tempo.text <- "facet_wrap OR facet_rep_wrap"
+ facet.check <- FALSE
+ }else if(grepl(x = add, pattern = "ggplot2::facet_grid|lemon::facet_rep_grid")){
+ tempo1 <- suppressWarnings(eval(parse(text = tempo[grepl(x = tempo, pattern = "ggplot2::facet_grid|lemon::facet_rep_grid")])))
+ facet.categ <- list(c(names(tempo1$params$rows), names(tempo1$params$cols))) # list of length 1
+ tempo.text <- "facet_grid OR facet_rep_grid"
+ facet.check <- FALSE
+ }
+ if(facet.check == FALSE & ! all(facet.categ %in% names(data1))){ # WARNING: all(facet.categ %in% names(data1)) is TRUE when facet.categ is NULL
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nDETECTION OF \"", tempo.text, "\" STRING IN THE add ARGUMENT BUT PROBLEM OF VARIABLE DETECTION (COLUMN NAMES OF data1)\nTHE DETECTED VARIABLES ARE:\n", paste(facet.categ, collapse = " "), "\nTHE data1 COLUMN NAMES ARE:\n", paste(names(data1), collapse = " "), "\nPLEASE REWRITE THE add STRING AND RERUN")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }
+ }
+ # if facet.categ is not NULL, it is a list of length 1 now
+ # end management of add containing facet
+ if( ! is.null(lib.path)){
+ if( ! all(dir.exists(lib.path))){ # separation to avoid the problem of tempo$problem == FALSE and lib.path == NA
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nDIRECTORY PATH INDICATED IN THE lib.path ARGUMENT DOES NOT EXISTS:\n", paste(lib.path, collapse = "\n"))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }
+ }
+ # end other checkings
+ # reserved word checking
+ if( ! (is.null(add))){
+ if(any(sapply(X = arg.names, FUN = grepl, x = add), na.rm = TRUE)){
warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") LEGEND REQUESTED (NON-NULL categ ARGUMENT OR legend.show ARGUMENT SET TO TRUE)\nBUT IT SEEMS THAT THE PLOT HAS NO LEGEND -> EMPTY LEGEND SPACE CREATED BECAUSE OF THE NON-NULL legend.width ARGUMENT\n")
+ tempo.warn <- paste0("(", warn.count,") NAMES OF ", function.name, " ARGUMENTS DETECTED IN THE add STRING:\n", paste(arg.names[sapply(X = arg.names, FUN = grepl, x = add)], collapse = "\n"), "\nRISK OF WRONG OBJECT USAGE INSIDE ", function.name)
warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
}
- }else if(plot == TRUE){ # means all FALSE
- legend.final <- ggplot2::ggplot()+ggplot2::theme_void() # empty graph instead of legend
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") LEGEND REQUESTED (NON-NULL categ ARGUMENT OR legend.show ARGUMENT SET TO TRUE)\nBUT IT SEEMS THAT THE PLOT HAS NO LEGEND -> EMPTY LEGEND SPACE CREATED BECAUSE OF THE NON-NULL legend.width ARGUMENT\n")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
}
-}
-if( ! any(unlist(legend.disp))){
- fin.lg.disp[] <- FALSE # remove all the legends. Must be done even if fin.lg.disp is not appearing in the code thenafter. Otherwise twice the legend
-}
-assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), eval(parse(text = tempo.legend.final)))
-# end legend display
-
-
-
-
-
-# scale management
-tempo.coord <- suppressMessages(ggplot2::ggplot_build(eval(parse(text = paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + ", ' + ggplot2::scale_x_continuous(expand = c(0, 0), limits = sort(x.lim), oob = scales::rescale_none) + ggplot2::scale_y_continuous(expand = c(0, 0), limits = sort(y.lim), oob = scales::rescale_none)'))))$layout$panel_params[[1]]) # here I do not need the x-axis and y-axis orientation, I just need the number of main ticks
-# x.second.tick.positions # coordinates of secondary ticks (only if x.second.tick.nb argument is non-null or if x.log argument is different from "no")
-if(x.log != "no"){ # integer main ticks for log2 and log10
- tempo.scale <- (as.integer(min(x.lim, na.rm = TRUE)) - 1):(as.integer(max(x.lim, na.rm = TRUE)) + 1)
-}else{
- tempo <- if(is.null(attributes(tempo.coord$x$breaks))){tempo.coord$x$breaks}else{unlist(attributes(tempo.coord$x$breaks))}
- if(all(is.na(tempo))){
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nONLY NA IN tempo.coord$x$breaks")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ # verif of add
+ if( ! is.null(add)){
+ if( ! grepl(pattern = "^\\s*\\+", add)){ # check that the add string start by +
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nadd ARGUMENT MUST START WITH \"+\": ", paste(unique(add), collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else if( ! grepl(pattern = "(ggplot2|lemon)\\s*::", add)){ #
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nFOR EASIER FUNCTION DETECTION, add ARGUMENT MUST CONTAIN \"ggplot2::\" OR \"lemon::\" IN FRONT OF EACH GGPLOT2 FUNCTION: ", paste(unique(add), collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }else if( ! grepl(pattern = ")\\s*$", add)){ # check that the add string finished by )
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nadd ARGUMENT MUST FINISH BY \")\": ", paste(unique(add), collapse = " "))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
}
- if(length(unique(x.lim)) <= 1){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nIT SEEMS THAT X-AXIS VALUES HAVE A NULL RANGE: ", paste(x.lim, collapse = " "), "\nPLEASE, USE THE x.lim ARGUMENT WITH 2 DIFFERENT VALUES TO SOLVE THIS")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
- }else{
- tempo.scale <- fun_scale(lim = x.lim, n = ifelse(is.null(x.tick.nb), length(tempo[ ! is.na(tempo)]), x.tick.nb)) # in ggplot 3.3.0, tempo.coord$x.major_source replaced by tempo.coord$x$breaks. If fact: n = ifelse(is.null(x.tick.nb), length(tempo[ ! is.na(tempo)]), x.tick.nb)) replaced by n = ifelse(is.null(x.tick.nb), 4, x.tick.nb))
+ # end verif of add
+ # management of add containing facet
+ facet.categ <- NULL
+ if( ! is.null(add)){
+ facet.check <- TRUE
+ tempo <- unlist(strsplit(x = add, split = "\\s*\\+\\s*(ggplot2|lemon)\\s*::\\s*")) #
+ tempo <- sub(x = tempo, pattern = "^facet_wrap", replacement = "ggplot2::facet_wrap")
+ tempo <- sub(x = tempo, pattern = "^facet_grid", replacement = "ggplot2::facet_grid")
+ tempo <- sub(x = tempo, pattern = "^facet_rep", replacement = "lemon::facet_rep")
+ if(any(grepl(x = tempo, pattern = "ggplot2::facet_wrap|lemon::facet_rep_wrap"), na.rm = TRUE)){
+ tempo1 <- suppressWarnings(eval(parse(text = tempo[grepl(x = tempo, pattern = "ggplot2::facet_wrap|lemon::facet_rep_wrap")])))
+ facet.categ <- names(tempo1$params$facets)
+ tempo.text <- "facet_wrap OR facet_rep_wrap"
+ facet.check <- FALSE
+ }else if(grepl(x = add, pattern = "ggplot2::facet_grid|lemon::facet_rep_grid")){
+ tempo1 <- suppressWarnings(eval(parse(text = tempo[grepl(x = tempo, pattern = "ggplot2::facet_grid|lemon::facet_rep_grid")])))
+ facet.categ <- c(names(tempo1$params$rows), names(tempo1$params$cols))
+ tempo.text <- "facet_grid OR facet_rep_grid"
+ facet.check <- FALSE
+ }
+ if(facet.check == FALSE & ! all(facet.categ %in% names(data1))){ # WARNING: all(facet.categ %in% names(data1)) is TRUE when facet.categ is NULL # all() without na.rm -> ok because facet.categ cannot be NA (tested above)
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nDETECTION OF \"", tempo.text, "\" STRING IN THE add ARGUMENT BUT PROBLEM OF VARIABLE DETECTION (COLUMN NAMES OF data1)\nTHE DETECTED VARIABLES ARE:\n", paste(facet.categ, collapse = " "), "\nTHE data1 COLUMN NAMES ARE:\n", paste(names(data1), collapse = " "), "\nPLEASE REWRITE THE add STRING AND RERUN")
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ }
}
-}
-x.second.tick.values <- NULL
-x.second.tick.pos <- NULL
-if(x.log != "no"){
- tempo <- fun_inter_ticks(lim = x.lim, log = x.log)
- x.second.tick.values <- tempo$values
- x.second.tick.pos <- tempo$coordinates
- # if(vertical == TRUE){ # do not remove in case the bug is fixed
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(
- geom = "segment",
- x = x.second.tick.pos,
- xend = x.second.tick.pos,
- y = if(diff(y.lim) > 0){tempo.coord$y.range[1]}else{tempo.coord$y.range[2]},
- yend = if(diff(y.lim) > 0){tempo.coord$y.range[1] + abs(diff(tempo.coord$y.range)) / 80}else{tempo.coord$y.range[2] - abs(diff(tempo.coord$y.range)) / 80}
- ))
- # }else{ # not working because of the ggplot2 bug
- # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(geom = "segment", y = x.second.tick.pos, yend = x.second.tick.pos, x = tempo.coord$x.range[1], xend = tempo.coord$x.range[1] + diff(tempo.coord$x.range) / 80))
- # }
- coord.names <- c(coord.names, "x.second.tick.positions")
-}else if(( ! is.null(x.second.tick.nb)) & x.log == "no"){
- # if(x.second.tick.nb > 0){ #inactivated because already checked before
- if(length(tempo.scale) < 2){
- tempo.cat1 <- c("x.tick.nb", "x.second.tick.nb")
- tempo.cat2 <- sapply(list(x.tick.nb, x.second.tick.nb), FUN = paste0, collapse = " ")
- tempo.sep <- sapply(mapply(" ", max(nchar(tempo.cat1)) - nchar(tempo.cat1) + 3, FUN = rep, SIMPLIFY = FALSE), FUN = paste0, collapse = "")
- tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE NUMBER OF GENERATED TICKS FOR THE X-AXIS IS NOT CORRECT: ", length(tempo.scale), "\nUSING THESE ARGUMENT SETTINGS (NO DISPLAY MEANS NULL VALUE):\n", paste0(tempo.cat1, tempo.sep, tempo.cat2, collapse = "\n"), "\nPLEASE, TEST OTHER VALUES")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
+ # end management of add containing facet
+ # end reserved word checking
+ # end second round of checking and data preparation
+
+ # package checking
+ fun_pack(req.package = c(
+ "gridExtra",
+ "ggplot2",
+ "lemon",
+ "grid",
+ "ggrepel"
+ ), lib.path = lib.path)
+ # end package checking
+
+ # main code
+ data1 <- data.frame(data1, prop = data1[ , freq] / sum(data1[ , freq]))
+ if(legend.add.prop == TRUE){
+ data1[ , categ] <- paste0(data1[ , categ], " (", round(data1$prop, 2), ")")
+ }
+ data1[ , categ] <- factor(data1[ , categ], levels = data1[ , categ][order(data1$prop, decreasing = TRUE)]) # reorder so that the donut is according to decreasing proportion starting at the top in a clockwise direction
+ data1 <- data1[order(as.numeric(data1[ , categ]), decreasing = FALSE), ] # data1[ , categ] with rows in decreasing order, according to prop
+ data1 <- data.frame(data1, x = 0) # staked bar at the origin of the donut set to x = 0
+ tempo.gg.name <- "gg.indiv.plot."
+ tempo.gg.count <- 0
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), eval(parse(text = paste0("ggplot2::ggplot()", if(is.null(add)){""}else{add})))) # add added here to have the facets
+ bar_width = 1
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_col(
+ data = data1,
+ mapping = ggplot2::aes_string(x = "x", y = freq, fill = categ),
+ color = border.color,
+ size = border.size,
+ width = bar_width
+ )) # size is size of the separation in the donut
+ # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_text(
+ # ggplot2::aes(label = Freq),
+ # position = ggplot2::position_stack(vjust = 0.5)
+ # ))
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_x_continuous(
+ expand = c(0, 0), # prevent extra limits in x axis
+ limits = c(- bar_width / 2 - (bar_width * hole.size) / (1 - hole.size), max(bar_width / 2, annotation.distance))
+ )) # must be centered on x = 0
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::ylim(c(0, max(cumsum(data1[ , freq])))))
+ if(hole.text == TRUE){
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(
+ geom = "text",
+ x = - bar_width / 2 - (bar_width * hole.size) / (1 - hole.size),
+ y = 0,
+ label = sum(data1[ , freq]),
+ size = hole.text.size
+ ))
+ }
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::coord_polar(theta = "y", direction = -1, start = 0, clip = "on"))
+ if(is.null(fill.color) & ! is.null(fill.palette)){
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_fill_brewer(palette = fill.palette, name = legend.name))
+ }else if( ! is.null(fill.color)){
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_fill_manual(values = fill.color, name = legend.name, na.value = "white"))
+ }else if(! is.null(legend.name)){
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::labs(fill = legend.name))
+ }
+
+ if( ! is.null(add)){ # if add is NULL, then = 0
+ if(grepl(pattern = "ggplot2\\s*::\\s*theme", add) == TRUE){
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") \"ggplot2::theme\" STRING DETECTED IN THE add ARGUMENT\n-> INTERNAL GGPLOT2 THEME FUNCTIONS theme_void() HAS BEEN INACTIVATED, SO THAT THE USER THEME CAN BE EFFECTIVE")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ add.check <- FALSE
+ }else{
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::theme_void())
+ }
}else{
- tempo <- fun_inter_ticks(lim = x.lim, log = x.log, breaks = tempo.scale, n = x.second.tick.nb)
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::theme_void())
}
- x.second.tick.values <- tempo$values
- x.second.tick.pos <- tempo$coordinates
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(
- geom = "segment",
- x = x.second.tick.pos,
- xend = x.second.tick.pos,
- y = if(diff(y.lim) > 0){tempo.coord$y.range[1]}else{tempo.coord$y.range[2]},
- yend = if(diff(y.lim) > 0){tempo.coord$y.range[1] + abs(diff(tempo.coord$y.range)) / 80}else{tempo.coord$y.range[2] - abs(diff(tempo.coord$y.range)) / 80}
- ))
- coord.names <- c(coord.names, "x.second.tick.positions")
-}
-# for the ggplot2 bug with x.log, this does not work: eval(parse(text = ifelse(vertical == FALSE & x.log == "log10", "ggplot2::scale_x_continuous", "ggplot2::scale_x_continuous")))
-assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_x_continuous(
- breaks = tempo.scale,
- minor_breaks = x.second.tick.pos,
- labels = if(x.log == "log10"){scales::trans_format("identity", scales::math_format(10^.x))}else if(x.log == "log2"){scales::trans_format("identity", scales::math_format(2^.x))}else if(x.log == "no"){ggplot2::waiver()}else{tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nCODE INCONSISTENCY 10") ; stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)},
- expand = c(0, 0), # remove space after after axis limits
- limits = sort(x.lim), # NA indicate that limits must correspond to data limits but xlim() already used
- oob = scales::rescale_none,
- trans = ifelse(diff(x.lim) < 0, "reverse", "identity") # equivalent to ggplot2::scale_x_reverse() but create the problem of x-axis label disappearance with x.lim decreasing. Thus, do not use. Use xlim() below and after this
-))
-# end x.second.tick.positions
-# y.second.tick.positions # coordinates of secondary ticks (only if y.second.tick.nb argument is non-null or if y.log argument is different from "no")
-if(y.log != "no"){ # integer main ticks for log2 and log10
- tempo.scale <- (as.integer(min(y.lim, na.rm = TRUE)) - 1):(as.integer(max(y.lim, na.rm = TRUE)) + 1)
-}else{
- tempo <- if(is.null(attributes(tempo.coord$y$breaks))){tempo.coord$y$breaks}else{unlist(attributes(tempo.coord$y$breaks))}
- if(all(is.na(tempo))){
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nONLY NA IN tempo.coord$y$breaks")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::guides(
+ fill = ggplot2::guide_legend(override.aes = list(color = "white", size = 2, stroke = 1))
+ )) # remove border of squares in legend
+
+ # annotations on slices
+ if( ! is.null(annotation)){
+ tempo <- rev(cumsum(rev(data1[ , freq])))
+ data1 <- data.frame(data1, text_y = tempo - (tempo - c(tempo[-1], 0)) / 2)
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggrepel::geom_text_repel(
+ data = data1,
+ mapping = ggplot2::aes_string(
+ x = "x",
+ y = "text_y",
+ label = annotation
+ ),
+ size = annotation.size,
+ force = annotation.force,
+ force_pull = annotation.force.pull,
+ nudge_x = annotation.distance, # knowing that the bar is centered on x = 0 and that the right edge is at bar_width / 2, 0 means center of the slice, 0.5 means at the edge if bar_width = 1
+ show.legend = FALSE
+ ))
}
- if(length(unique(y.lim)) <= 1){
- tempo.cat <- paste0("ERROR IN ", function.name, "\nIT SEEMS THAT Y-AXIS VALUES HAVE A NULL RANGE: ", paste(y.lim, collapse = " "), "\nPLEASE, USE THE y.lim ARGUMENT WITH 2 DIFFERENT VALUES TO SOLVE THIS")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
- }else{
- tempo.scale <- fun_scale(lim = y.lim, n = ifelse(is.null(y.tick.nb), length(tempo[ ! is.na(tempo)]), y.tick.nb)) # in ggplot 3.3.0, tempo.coord$y.major_source replaced by tempo.coord$y$breaks. If fact: n = ifelse(is.null(y.tick.nb), length(tempo[ ! is.na(tempo)]), y.tick.nb)) replaced by n = ifelse(is.null(y.tick.nb), 4, y.tick.nb))
+ # end annotations on slices
+
+ # legend management
+ # removal of part of the legend
+ if( ! is.null(legend.limit)){
+ if(sum(data1$prop >= legend.limit) == 0){
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE legend.limit PARAMETER VALUE (", legend.limit, ") IS TOO HIGH FOR THE PROPORTIONS IN THE DONUT PLOT:\n", paste0(data1$prop, collapse = "\n"))
+ stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ }else{
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_fill_discrete(
+ breaks = as.character(data1[ , categ][data1$prop >= legend.limit])
+ ))
+ }
}
-}
-y.second.tick.values <- NULL
-y.second.tick.pos <- NULL
-if(y.log != "no"){
- tempo <- fun_inter_ticks(lim = y.lim, log = y.log)
- y.second.tick.values <- tempo$values
- y.second.tick.pos <- tempo$coordinates
- # if(vertical == TRUE){ # do not remove in case the bug is fixed
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(
- geom = "segment",
- y = y.second.tick.pos,
- yend = y.second.tick.pos,
- x = if(diff(x.lim) > 0){tempo.coord$x.range[1]}else{tempo.coord$x.range[2]},
- xend = if(diff(x.lim) > 0){tempo.coord$x.range[1] + abs(diff(tempo.coord$x.range)) / 80}else{tempo.coord$x.range[2] - abs(diff(tempo.coord$x.range)) / 80}
- ))
- # }else{ # not working because of the ggplot2 bug
- # assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(geom = "segment", x = y.second.tick.pos, xend = y.second.tick.pos, y = tempo.coord$y.range[1], yend = tempo.coord$y.range[1] + diff(tempo.coord$y.range) / 80))
- # }
- coord.names <- c(coord.names, "y.second.tick.positions")
-}else if(( ! is.null(y.second.tick.nb)) & y.log == "no"){
- # if(y.second.tick.nb > 0){ #inactivated because already checked before
- if(length(tempo.scale) < 2){
- tempo.cat1 <- c("y.tick.nb", "y.second.tick.nb")
- tempo.cat2 <- sapply(list(y.tick.nb, y.second.tick.nb), FUN = paste0, collapse = " ")
- tempo.sep <- sapply(mapply(" ", max(nchar(tempo.cat1)) - nchar(tempo.cat1) + 3, FUN = rep, SIMPLIFY = FALSE), FUN = paste0, collapse = "")
- tempo.cat <- paste0("ERROR IN ", function.name, "\nTHE NUMBER OF GENERATED TICKS FOR THE Y-AXIS IS NOT CORRECT: ", length(tempo.scale), "\nUSING THESE ARGUMENT SETTINGS (NO DISPLAY MEANS NULL VALUE):\n", paste0(tempo.cat1, tempo.sep, tempo.cat2, collapse = "\n"), "\nPLEASE, TEST OTHER VALUES")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE) # == in stop() to be able to add several messages between ==
- }else{
- tempo <- fun_inter_ticks(lim = y.lim, log = y.log, breaks = tempo.scale, n = y.second.tick.nb)
+ # end removal of part of the legend
+ if(legend.show == FALSE){ # must be here because must be before bef.final.plot
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::guides(fill = "none")) # inactivate the initial legend
}
- y.second.tick.values <- tempo$values
- y.second.tick.pos <- tempo$coordinates
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(
- geom = "segment",
- y = y.second.tick.pos,
- yend = y.second.tick.pos,
- x = if(diff(x.lim) > 0){tempo.coord$x.range[1]}else{tempo.coord$x.range[2]},
- xend = if(diff(x.lim) > 0){tempo.coord$x.range[1] + abs(diff(tempo.coord$x.range)) / 80}else{tempo.coord$x.range[2] - abs(diff(tempo.coord$x.range)) / 80}
- ))
- coord.names <- c(coord.names, "y.second.tick.positions")
-}
-# for the ggplot2 bug with y.log, this does not work: eval(parse(text = ifelse(vertical == FALSE & y.log == "log10", "ggplot2::scale_x_continuous", "ggplot2::scale_y_continuous")))
-assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_y_continuous(
- breaks = tempo.scale,
- minor_breaks = y.second.tick.pos,
- labels = if(y.log == "log10"){scales::trans_format("identity", scales::math_format(10^.x))}else if(y.log == "log2"){scales::trans_format("identity", scales::math_format(2^.x))}else if(y.log == "no"){ggplot2::waiver()}else{tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nCODE INCONSISTENCY 10") ; stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)},
- expand = c(0, 0), # remove space after axis limits
- limits = sort(y.lim), # NA indicate that limits must correspond to data limits but ylim() already used
- oob = scales::rescale_none,
- trans = ifelse(diff(y.lim) < 0, "reverse", "identity") # equivalent to ggplot2::scale_y_reverse() but create the problem of y-axis label disappearance with y.lim decreasing. Thus, do not use. Use ylim() below and after this
-))
-# end y.second.tick.positions
-assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::coord_cartesian(xlim = x.lim, ylim = y.lim)) # clip = "off" to have secondary ticks outside plot region. The problem is that points out of bounds are also drawn outside the plot region. Thus, I cannot use it # at that stage, x.lim and y.lim not NULL anymore
-# end scale management
-
-
-
-
-# drawing
-fin.plot <- eval(parse(text = paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + ")))
-grob.save <- NULL
-if(plot == TRUE){
- if( ! is.null(legend.width)){ # any(unlist(legend.disp)) == TRUE removed to have empty legend space # not & any(unlist(fin.lg.disp)) == TRUE here because converted to FALSE
- grob.save <- suppressMessages(suppressWarnings(gridExtra::grid.arrange(fin.plot, legend.final, ncol=2, widths=c(1, legend.width))))
+ bef.final.plot <- suppressWarnings(suppressMessages(ggplot2::ggplot_build(eval(parse(text = paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "))))))
+ if( ! is.null(legend.width)){
+ legend.plot <- suppressWarnings(suppressMessages(fun_gg_get_legend(ggplot_built = bef.final.plot, fun.name = function.name, lib.path = lib.path))) # get legend
+ assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::guides(fill = "none")) # inactivate the initial legend
+ if(is.null(legend.plot) & plot == TRUE){ # even if any(unlist(legend.disp)) is TRUE
+ legend.plot <- ggplot2::ggplot()+ggplot2::theme_void() # empty graph instead of legend
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") LEGEND REQUESTED (legend.show ARGUMENT SET TO TRUE)\nBUT IT SEEMS THAT THE PLOT HAS NO LEGEND -> EMPTY LEGEND SPACE CREATED BECAUSE OF THE NON NULL legend.width ARGUMENT\n")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
}else{
- grob.save <- suppressMessages(suppressWarnings(print(fin.plot)))
+ legend.plot <- NULL
}
-}else{
- warn.count <- warn.count + 1
- tempo.warn <- paste0("(", warn.count,") PLOT NOT SHOWN AS REQUESTED")
- warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
-}
-# end drawing
-
-
-
-# output
-if(warn.print == TRUE & ! is.null(warn)){
- on.exit(warning(paste0("FROM ", function.name, ":\n\n", warn), call. = FALSE))
-}
-on.exit(exp = options(warning.length = ini.warning.length), add = TRUE)
-if(return == TRUE){
- output <- suppressMessages(ggplot2::ggplot_build(fin.plot))
- # output$data <- output$data[-1] # yes for boxplot but not for scatter # remove the first data because corresponds to the initial empty boxplot
- if(length(output$data) != length(coord.names)){
- tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, ": length(output$data) AND length(coord.names) MUST BE IDENTICAL. CODE HAS TO BE MODIFIED")
- stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
+ # end legend management
+
+ # title
+ title.grob <- grid::textGrob(
+ label = title,
+ x = grid::unit(0, "lines"),
+ y = grid::unit(0, "lines"),
+ hjust = 0,
+ vjust = 0,
+ gp = grid::gpar(fontsize = 7)
+ )
+ # end title
+
+ # drawing
+ pdf(NULL)
+ grob.save <- NULL
+ main.plot <- eval(parse(text = paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + ")))
+ main.plot.output <- suppressMessages(ggplot2::ggplot_build(main.plot))
+ main.grob <- suppressMessages(suppressWarnings(gridExtra::arrangeGrob(
+ main.plot,
+ top = if(title == ""){" "}else{title.grob},
+ left = " ",
+ right = " "
+ ))) # , left = " ", right = " " : trick to add margins in the plot. padding = unit(0.5, "inch") is for top margin above the title
+ if( ! is.null(legend.width)){
+ grob.save <- suppressMessages(suppressWarnings(gridExtra::grid.arrange(main.grob, legend.plot, ncol=2, widths=c(1, legend.width)))) # assemble grobs, ggplot, gtable into a gtable that defines the positions of the different elements (as grobs)
}else{
- names(output$data) <- coord.names
+ grob.save <- suppressMessages(suppressWarnings(print(main.grob)))
}
- if(is.null(unlist(removed.row.nb))){
- removed.row.nb <- NULL
- removed.rows <- NULL
+ dev.off() # inactivate the pdf(NULL) above
+ if(plot == TRUE){
+ gridExtra::grid.arrange(grob.save) # plot a gtable (grob)
}else{
- for(i3 in 1:length(data1)){
- if( ! is.null(removed.row.nb[[i3]])){
- removed.row.nb[[i3]] <- sort(removed.row.nb[[i3]])
- removed.rows[[i3]] <- data1.ini[[i3]][removed.row.nb[[i3]], ]
- }
+ warn.count <- warn.count + 1
+ tempo.warn <- paste0("(", warn.count,") PLOT NOT SHOWN AS REQUESTED")
+ warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
+ }
+ # end drawing
+
+ # output
+ if(warn.print == TRUE & ! is.null(warn)){
+ on.exit(warning(paste0("FROM ", function.name, ":\n\n", warn), call. = FALSE))
+ }
+ on.exit(exp = options(warning.length = ini.warning.length), add = TRUE)
+ if(return == TRUE){
+ if(is.null(unlist(removed.row.nb))){
+ removed.row.nb <- NULL
+ removed.rows <- NULL
}
+ tempo <- main.plot.output$layout$panel_params[[1]]
+ output <- list(
+ data = data1,
+ removed.row.nb = removed.row.nb,
+ removed.rows = removed.rows,
+ plot.data = main.plot.output$data,
+ panel = facet.categ,
+ axes = list(
+ x.range = tempo$x.range,
+ x.labels = if(is.null(attributes(tempo$x$breaks))){tempo$x$breaks}else{tempo$x$scale$get_labels()}, # is.null(attributes(tempo$x$breaks)) test if it is number (TRUE) or character (FALSE)
+ x.positions = if(is.null(attributes(tempo$x$breaks))){tempo$x$breaks}else{unlist(attributes(tempo$x$breaks))},
+ y.range = tempo$y.range,
+ y.labels = if(is.null(attributes(tempo$y$breaks))){tempo$y$breaks}else{tempo$y$scale$get_labels()},
+ y.positions = if(is.null(attributes(tempo$y$breaks))){tempo$y$breaks}else{unlist(attributes(tempo$y$breaks))}
+ ),
+ warn = paste0("\n", warn, "\n\n"),
+ ggplot = if(return.ggplot == TRUE){main.plot}else{NULL}, # main plot -> plots the graph if return == TRUE
+ gtable = if(return.gtable == TRUE){grob.save}else{NULL} # gtable of the full graph (main + title + legend)
+ )
+ return(output) # this plots the graph if return.ggplot is TRUE and if no assignment
}
- tempo <- output$layout$panel_params[[1]]
- output <- list(
- data = data1,
- removed.row.nb = removed.row.nb,
- removed.rows = removed.rows,
- plot = c(output$data, x.second.tick.values = list(x.second.tick.values), y.second.tick.values = list(y.second.tick.values)),
- panel = facet.categ,
- axes = list(
- x.range = tempo$x.range,
- x.labels = if(is.null(attributes(tempo$x$breaks))){tempo$x$breaks}else{tempo$x$scale$get_labels()}, # is.null(attributes(tempo$x$breaks)) test if it is number (TRUE) or character (FALSE)
- x.positions = if(is.null(attributes(tempo$x$breaks))){tempo$x$breaks}else{unlist(attributes(tempo$x$breaks))},
- y.range = tempo$y.range,
- y.labels = if(is.null(attributes(tempo$y$breaks))){tempo$y$breaks}else{tempo$y$scale$get_labels()},
- y.positions = if(is.null(attributes(tempo$y$breaks))){tempo$y$breaks}else{unlist(attributes(tempo$y$breaks))}
- ),
- warn = paste0("\n", warn, "\n\n"),
- ggplot = if(return.ggplot == TRUE){fin.plot}else{NULL}, # fin.plot plots the graph if return == TRUE
- gtable = if(return.gtable == TRUE){grob.save}else{NULL} #
- )
- return(output) # this plots the graph if return.ggplot is TRUE and if no assignment
-}
-# end output
-# end main code
+ # end output
+ # end main code
}
diff --git a/examples_fun_gg_donut.R b/examples_fun_gg_donut.R
index 10ee97b..4b7cf52 100644
--- a/examples_fun_gg_donut.R
+++ b/examples_fun_gg_donut.R
@@ -109,51 +109,66 @@ fun_gg_donut(data1 = obs1, freq = "Km", categ = "Car",
add = "+ggplot2::theme_gray()"
)
fun_gg_donut(data1 = obs1, freq = "Km", categ = "Car",
- add = "+ggplot2::facet_wrap(facets = 'Country', labeller = 'label_both') + ggplot2::theme(strip.background = ggplot2::element_rect(color = 'grey', size = 0.5), strip.text = ggplot2::element_text(size = 10, face = 'bold'), panel.spacing = ggplot2::unit(0.5, 'lines'))" # or ggplot2::vars(Country) instead of 'Country'. See https://ggplot2.tidyverse.org/reference/labeller.html
+ add = "+ggplot2::facet_wrap(facets = 'Country', labeller = 'label_both') + ggplot2::theme(strip.background = ggplot2::element_rect(color = 'grey', size = 0.5), strip.text = ggplot2::element_text(size = 10, face = 'bold'), panel.spacing = ggplot2::unit(0.5, 'lines'))" # or ggplot2::vars(Country) instead of 'Country'. See https://ggplot2.tidyverse.org/reference/labeller.html
)
-
-## Other parameters
+## The return and plot arguments
+fun_gg_donut(data1 = obs1, freq = "Km", categ = "Car",
+ return = FALSE,
+ plot = FALSE,
+)
+# nothing is returned and nothing is plotted
res <- fun_gg_donut(data1 = obs1, freq = "Km", categ = "Car",
- return = TRUE, # output returned and assigned into res. If FALSE, res is NULL
- return.ggplot = TRUE, # ggplot object added in res (without the legend
- return.gtable = TRUE, # ggplot object as gtable of grobs in res ($gtable is NULL if plot = FALSE)
- plot = TRUE, # plot displayed during asignation into res
- warn.print = TRUE,
- lib.path = NULL
-)
-# plot the result
-fun_open(pdf = FALSE)
-res$ggplot
-# The advantage of $ggplot is that it is easy to update the plot
-res$ggplot + ggplot2::annotate(geom = "text", x = -0.5, y = 0, label = "NOT GOOD", size = 20, angle = 45)
-# However, manipulation of res triggers plotting when $ggplot is not NULL (NULL $ggplot obtained using return.ggplot = FALSE), which is annoying, as explain in the function description. Thus, it is preferable to use return.ggplot = FALSE
-
-
-## Notes about the gtable output
-res2 <- fun_gg_donut(data1 = obs1, freq = "Km", categ = "Car",
- return = TRUE,
- return.ggplot = FALSE,
- return.gtable = TRUE, # return.gtable must be TRUE to have a non NULL $gtable output into res2
- plot = TRUE, # plot must be TRUE to have a non NULL $gtable output into res2
- warn.print = FALSE,
- lib.path = NULL
+ return = TRUE, # output returned and assigned into res. If FALSE, res is NULL
+ plot = TRUE, # plot displayed during assignation into res
)
+res # info of the plot are stored in the res object. The plot is also displayed during the assignation into res (plot = TRUE)
-# display the results (does not plot the graph, contrary to $ggplot)
-fun_open(pdf = FALSE)
-res2
+## The return.ggplot argument (return argument must be TRUE)
+res2 <- fun_gg_donut(data1 = obs1, freq = "Km", categ = "Car",
+ return = TRUE,
+ return.ggplot = TRUE,
+ plot = FALSE
+)
+# Nothing plotted during the assignation into res2
+res2 # the pain with return.ggplot = TRUE is that each time res2 is called, a plot appears (because res2$ggplot is not NULL, as when return.ggplot = FALSE is used)
+res2$panel # however, calling a element of res2 does not plot the graph
+res2$ggplot #except when using $ggplot
+# The advantage of $ggplot is that it is easy to update the plot
+res$ggplot + ggplot2::annotate(geom = "text", x = -0.5, y = 0, label = "NOT GOOD", size = 20, angle = 45)
-# replot
-fun_open(pdf = FALSE)
-gridExtra::grid.arrange(res2$gtable) # Contrary to $ggplot, $gtable cannot be easily updated (see https://stackoverflow.com/questions/26499608/inverse-of-ggplotgrob)
+## The return.gtable argument (return argument must be TRUE)
+res3 <- fun_gg_donut(data1 = obs1, freq = "Km", categ = "Car",
+ title = "DONUT",
+ return = TRUE,
+ return.gtable = TRUE, # gtable of the full graph
+ plot = FALSE
+)
+# Nothing plotted during the assignation into res3
+res3 # no plotting, contrary to with return.ggplot = TRUE
+# replotting
+gridExtra::grid.arrange(res3$gtable) # full graph
+# But contrary to $ggplot, $gtable cannot be easily updated (see https://stackoverflow.com/questions/26499608/inverse-of-ggplotgrob)
# plot the first grob
-fun_open(pdf = FALSE)
-gridExtra::grid.arrange(res2$gtable[1,1])
+gridExtra::grid.arrange(res3$gtable[ ,1]) # made of the main plot + title
# plot the second grob
-fun_open(pdf = FALSE)
-gridExtra::grid.arrange(res2$gtable[1,2])
-
+gridExtra::grid.arrange(res3$gtable[ ,2]) # legend
+# plot the main plot without the title
+gridExtra::grid.arrange(res3$gtable[,1]$grob[[1]][2])
+#plot the title
+gridExtra::grid.arrange(res3$gtable[,1]$grob[[1]][1])
+
+## The warn.print argument
+fun_gg_donut(data1 = obs1, freq = "Km", categ = "Country",
+ warn.print = TRUE
+)
+# Warning messages shown
+res4 <- fun_gg_donut(data1 = obs1, freq = "Km", categ = "Country",
+ return = TRUE,
+ warn.print = FALSE
+)
+# Warning messages not shown
+cat(res4$warn) # but can be recover this way using return = TRUE
## All the arguments
fun_gg_donut(
diff --git a/fun_gg_boxplot.docx b/fun_gg_boxplot.docx
index 6a4958fc34f14cfb47ac786159bdf4c53431b98e..19fac582a77139b3dd87d5049befd14aa37c515b 100755
GIT binary patch
delta 98367
zcmV(|K+(UbiwByE2e3g23P&q`jB<7X0NGlTO9>lB+eWtM_pRFhp_iFEL+(%zpQ5C>
zR*HIMT$S<U+R4p_skx~p&?FIoXc}mWV)mckbGjQKzz0anvW<p1Rk0)x0MR(V^X!wX
z2`_)u|NdY9xxDnayO^<15V%DcUoPkFo7z-}`Q_<p>`vK?#?H)lBOddya9ln+<>RsM
zvePAxywgsr-IBk}Bkr;|hVQ$f;UkS}`gZQqad-0~x`d1IhP_jFN+ZFZ*7s<C@=f}u
z7pLc&H=1oPjn7#KAC7r6qXPbnCZ{tRJuH9bCve|675>N%e6fOCw$75<@He$Z6kh6E
zoTQI}mt3kx(La(aqGP^SU2?0*A;0l7VgWn@596snPv7b6xp#vPr^!toix%-X3zGAe
z^LFp^0CB6RvcBOlkFQBN3)GVr-?7~~f+Bc}^onC1A^)Aplgy|euD|$MuO{<y+x>q}
zyFq8`24^w*v|IG`El%UrY|R?W`Q-Dc{6oYS^Yz{Q&%4{(@FBey%BxSfmqtq#!SUxk
z%!etR11rzm%eRw|M|2dx69MfBkdH_T5ag2D6-d(&_g46GPL`J-jlK78YOU7I`QZ8j
zB(Og8Q-lX^FFNhpyY%2K8`DJ~wm*OQ2@mzod!0dBe#88y2!HsY2PXt<443rJ26*<A
zh7&39@$XYS>30_nKhoe$4Np|ZB6WRq&qEQz$24|*pw<mvL_UkiJGPYf8iw)qQ8&&X
zk~bWwe{W*>)8zq=l5f4gZ^3`+wD^zYX!|@la)S?$I~Kqil4C49`QaK5pXz_7K22AT
z-?05I4PV~!Qe1sU?xKiCm&6Td923AHJWI$0nQ#sSpR$lp{h1$=h|TyT^N6=#L~!zM
zi1!lej_P%7VQ~X?>izZZ2mSsUpcadtfkpi;tAxeC4;g89&xjuq5TNb@>9jyjwmWBJ
z>5D0$o=0djk(S0MBQOKDyIz0)tlKvXY@bDi*MlZh#+UJ&x}ZDf5sO*$$Z7zw4?K7T
z;WhQ+OA_-L6aI|Fgdy+<{1(#*{OQt=j2M~m2v3DS#1#IbPsH=%c|cdBe%>Cm8V>n+
zx`>+^qYV6^70Kc88@%2Zfd?*OPGiAZ_1fM0_y2rP-o7KXCK)e67u|mYC!{mhB;el>
z5y7zs^@7yvBmNkb!^odF<ZXz|>f<#{#kNA8I%2>;z(RzN<=;yh$v=}@z)Kgz7pQXt
z=LDR{iTt*h;b)Be2`?agA?6D~z=$U3Jq1jp53!F7NQCoVzte5+R!JsM#vwy|lR?ZS
zjzLPo>ju*N7Q0jk79D>Ui5K10*>&$|rJO(AD&<{b)Bxb@6N$)|9v4oGeh2xUd;lg>
zdiIg}0lFW1r5ZwEaMrnP8NoTbUjSt>h!o+wTdOo+NmrnaSQJ0g4j;BVotw@smd}4;
zS^lu)q~Dm~%TsoEgt|ZSV|Ga}kP%;=p1KhYo#<p9@!y#%RKS0VjZT4?9?)buolNke
z==9N_gbcJ$eEMGA<hKdqv)Gx6S#TJn8+cSN_WbVbt}ns03DW#07Nmzks^3^8K#FQ>
z$|L^|SO5)Dhfvyy9>XKy3hcsg9QdwK3JolDkn@?79r8iYNPn8S*&Fiimmhy5G=@7#
zxPd7<CjSTQQ73;~1VOz)PX0U*f5Y43J=Zq|+c#n#7k<RN!*Jh^?7{Htu6=KjeLS)|
zo&NBmB4H5pNu^iAo?PZG(0d}6M8=RuEOe*1V??y%b)>l_odG{2?>~rz=W}(3Ijlj3
zQozY_xmV~Dbz9ww>)Q&vzTGxn<}DrZ7V^ld%&WOdba{U)06QFH);Qoxxg+s$0Y)(H
z`<)K@XYKA;=X41k_=!tH_<s?z6N;K2RQ&8j@Dp(PPi6~udNP(O{sheDlbC@l^iB|X
zhXvox_pCWMIhc`#`O~d5+>(YnUvgfDR7Sge>DSge@3eM@i}Rnn-q)59nu>G#H@)lr
z_1BP)FC>2mF<3U4{I;nI%vr#QKg|Q4-~2G1EW1@V`Ewxtc9Mpk>xZ?=3vzI~-IZ}q
z%fd!r#iN3@n|Tw@Lc~HO1Cf=5hlK~i<I1IiO^h`GcBA_l;8xVT>$isI-PeiuibC5d
zwhlGLOGbme$d);1j>=C{(OHZ2FM)N_U?GvNVl02h!=f|joeze)5Rm`mb?bLC9$34>
zPQWHC^kimIvEZwSTddG-?H4Q4t0vQto5y~DyRi4eA3xk#P*_k%P%M2<OaT=wr*AP~
zF(EM_4@yitC-7%6QAJE((t{KGe;_XQ*@C#Vi&p<)P#Q}xv$U(0GwAPoawExNdDHTy
z<jsGO3m0{`wd^b^)~KMtd`bZoR)<?eC`8N{4FM28zyHNb35yBs|4se)fkn;(Qsxb*
z#lovua9D8Uz>x+CEHW%IuCT5#*&WKkA+xY@yMmL5t?DhO({Jp1e(Mlg?lhP?aR=9K
z>Axr_O7dh!?A#&(ishP3zWMfi`c;x|+O2=iuzhVg^;;Vp$dX4SQ|zU1rSmIxtlsd2
zTAgbRG0F47_f|GAZ$YsI3TNbpPB;Q=^q(J88T8KXuGdYsEHHMw9Fu_YyN|8Lj!(w9
zzZl&0E;d0i>~wo;q+~#mKV5=CA9_8YP%p<MP{fR3V7~KgDbX98-QVs^%(hY@c{zVZ
z0YW9=bS)q(AS57?jsDL`;k1~j7A8hAu$0J(=OM#_z;H)HgWyvuxn462s#wYO<OFn-
zBl{M(ZT(hxS9J`_-rjWw=YtKMe$ndQWja!4J;AfVS^q4@$NCQP&eas>#=rm=7S0F?
zcL|CJUNRCCvFmeUUsfL(4)2xKM^%5<M|K~h;_e0Tus^dIMivkmKyXYstA*U=k6S<>
zAcXHes69?AC0-5`<)c54T6L<H6fZXH3<I%(@4h8Tz+H5E-7@YdUbQPl2`fIVP60vV
zhi<U&nDYmVxJ|6G(8!t_eD1I(5m9GGBOrp@_iEX$HWnR-ju97v&%P2sZq9$&y-%9-
zW)0IXVgkj23TMvqqx>>hK15nm;C;YG?RR=-=dBX1=BfrlyH<7TSOHUQ0fTKdUV((M
zw)P8R*=R6G)a%r;-skP$o(=lLVc#_3mrsB_OK^F9EU*Hlgu?5qDc*c4%t2wbBXh>$
z^;^+bf>@@?*xodsDeJ4En$mxv!Ow1UX48wxY<wS)UL@F)vQGA?H3jU>b$57iRu*7?
zMv76pv$;^i*Ys>bzCYpBa`Ha;Uap+c=R!vKLK*?J=jWbS@Vsj9IH}qI7@b=bSrqL<
zQ9xtyo`oKZnD-N%u<MA?2YKNheCftN@suy0Z<bnkRRdlJrIAL9oy&jnGVggWEDUpO
zDf+e2#<A_YEhHo)CXtVwL5|*+vF&0$6%dBCi=iIk!IpWy0Obu61rZaA2osu~yGd)a
z>dQuGO;cwwnFk!V=@e-XQ}(>mJ8!4CAqVw-{`6PL?D`dy7z2Wiw(G&m_q@-_PP^`R
z2j``%pg>Ez{4f3L2$_FieSwM_09r>_-_YVg;$cZaZOkJ-L{t<>-;4WR`?fUOpjojd
z?VWv({#p`&ZG^YX=K2xY2!TIx=2T3Jfqc<98(!R$1<0R~jIh=3<aqU?-@!{DAAw#?
z;F}GbtH%F(E;y>Q@ulCWfAo7j41+JZ!}aXPMLK^+hHw8-0+N3ZTCz>PCHWU8`EJed
zU7-zn*E;JAzmyI7S@`{_@Ui=y!R?m{T)aFD&_g_6g_Kr~s32&EjQA7&VkA|r_LiX<
z$<oCfU0NdiwOT~*xG1b{HcUp5zY?sb%rEIBOa`rD^e3;xWGEli!4SAFf@={~OSl>y
zkwi1abLRSE-=%-T=V9C=F=LlxD#Sd#JU!JX$;nTTEQ*=KqsggG>4}q%Pw*bGGZnMo
z#qn>wq*8lHzYgEOd;9K(4<(?xb(Ov%-QV+NOk8*x>WA>Q$-5!(L*h|E+y813x4wdZ
zaP)2C-(=|r0U0q8u^E449{f7y5hL@6yDX03;wGFTri6bIjQ!)y>L7#Qw16-3W6qDq
zRp+jCbKbYO+KDUua!QG-zr!nLF`)pE5ZpeO&*lpOpb7j3h6oc=M&tluSu3f%s(OQr
z7om#^jPNmeU!<sSJN@gy`EIzB?~Uwf?pWx;Y+%3aH2(m+UTkheY|J7Sy6kkq`0O`L
z^s<;6R_%X$>j>S?oJ{E>0|kQGBw#2OHg+sGSi~^ravm@mGgD(=yVvAK4D17-*_gTl
z+!2=ti&>ah0-BIg(h~~oro5Dul>a!09Ob;2`e=j5>k`#~HV0^r$zsMr;gEZ{b9%R!
z3A}6)@x>feN)bR>!}i&kIqn<)o>ePI2j=5*0g`_MMII1@#$@bAu^=p9@<82pnA61L
z^2~OVJcN9SMyQxlp$>M)Yyp?hAm(VtYKIvRBtZvX7yDu%-RFiwP@SnSt&jjp-=Cov
zyOPd?H5Oi%kNPtxg!P!w6vHkJftPV!HEImckLLkhDSg6Fa)7Ln@{}y6EF=q*G-U3L
z315E*@I?-TXs3s<A4K`nEr`l54ZkBFu-ZNWR7~oC7boyT=3p6qQ-W^&TV|r^eydcy
zi2Hu`w*RH_`ExHq;aso#{vKpmD|sJ>-w=GSKbZ#bzeqk<u>d6OCJ(0l_Dt0qO|tH;
zfL6vv$AyLrRDc;Un<>rzcj^Ufg<%URYT$p9#I=Q2;XZJ1YRB-N95~_h<ATL9=6>29
zbldHV_8^U?gCsgxguXc8;}iTIb#rNe;QjD+bj}<<96KPN9Cr#g^WBG&jHj&bbSj_H
zA-}-Q2p|2<T#?3BsOz%1U|y4q78q#>(c{Jt3JOTDa~3g}ICbVsz&^r?&C5%5j=+DL
z)zuMv$a>4^G)c`5-6@M}4fu67t2GI{(FOZw7_4-5cjJgy-t~F6cfB)*H2;a+1}m9B
zEV6YkuG@F#Uqz_B$YO4_K@c-Gi;0jXzsEyH#L{=c?+nSWfHMq#d+ZU8fcTfeNlHeb
z0v>?b{?3;S_~ekV*N`sXd$|fZtayJh0{`kz&Pr)%dnjk6v@d^8dI7)=Y|sj^S;9RI
znCXkSDUEN*K)6pt{V*o8RSZVD&lg7|Ra~F7hj(l9I!EK=U{;&tPOqXi`PLN)UntI7
z!~oarUhjHn3<Id`Q0;1>ZCSLo;YIs;SV{|7M&3D^d6?1FM62<D<W;<93YmY9Ksti(
zhO`b#BAecF*sk6Aa!QEp@5u1|55N55?%mHezr}`qzEkNfmsQ$0!WEHmL}#W(X!Z#0
zOlA_gZhAk6j|*wnJ0INKD*iKJkslW{6uzLsf2`Qv@FRwfVwDC~A%dZcQz<&F)|)CS
zTaTa}iwwsjB9>h9U5tz;_e6g=Jd&kri57IVu|KZJ=#bmRJiwH2<|VQdlP=bIc@(4l
z%(GUJwTj5<lDJbEQ5UyVV-ZQEt9DbR!IVW18G~e4ozN#A#DG4Y(bXZKF!EiscMt;(
z-{lUZsl+j$Q*L1J$dkDme4QA|q`1+0xohMCXf&XArV8OLCM;wT=A3^NF|>h3UiGqr
zq@IyrNRo2oW);v-wiA-j+pI6M;;Hi9x@74~^2lVu7#bZLaw!!Jy9HC$Mp?TI=}lrZ
zYg9Ixk=9Ga>Ucpt`~&myfcu#bM2)sBPbK>u@^+j_8O#v9K3+uf$_hz)nFA1Q*k-2F
z8by1WquG$VMWG}&=r(^chc8!&poyQ+mL%WAfhD(*<d(`_CE^~Ye5Xm4Q{SDUJf8v6
z%Vh6Efgers5>mH<rW=^wi~@nSIJSsF-Mdz|cUwjZ=>phF(dZI<e8OgPu}WPk?eIH$
zifz6|H3zAK=w?lPHl3EgmEYg^?1~R71HJ;jzFcuf5rx|qz5ai7DVsGFm!yEwgSAr6
z^JRgnj&;xgUZJ;Aj<0rHR-~R>wKZDNXu#~Kw8^dS)cW?X!nb#%NN{9A{Ur%-3b>Bz
zsfsOh|KOuE0Jx3^ZkduKViI2=h6ItVF#k+d7Lz*up_md2&}k$jW2PYjbsw1zK1C(t
za`-j<w9}B@$JT!XlQ+qTlT@ij*cD;@7+V2NnRhZ`YA~=WBOo9644v5Yv5G|A#YOkJ
zJ18STD`wPU%DkB?Di{iQHDVI566qWrXN$EGU@a_8$u4iF2UW$g!?52FtXe>OEOsM*
zj@sTT`&X&#u|_Qy&X+}NTbqptAB+YS<}n#6qDsxtdjx-!%<p&(o0q_-?{v;&Ew1JB
zufXR;pug*4U9>r%H`K<sT6-!|xTZder<h2|T<JpTl2Qz?!v&9Q2Qwe$-?L7)(^?nD
zTUIsL68$dY=1TDR#Q`|OcGf~3o`j1a-($>lnn`Ar<vN;q^I_B?@@dvBA*H~$(CsEQ
z5OoE+N(+Cu{2Zy2|Ku2{bl#P{_iWwy*APHOc<uCio%2#!`}KAsmyf~|SH>a3LIG-2
zlj+?w3xZ?QD@#bY!mYTfP)H?K%1z#6zl}#3t8f2EuyS)9!}Q`2Q;~$todK&OUZsvO
ztZje2gNkDv5YquL<)h`N>6*fpd;49el-%8^LVJIwYZ^#Xxj@y8OIJ6*V!7+njU7QV
zg|5!k$?bz$p=*V%=|)n$o0Y^#S-`eT){X1O#1~{qW0j&_oQ-OjsLoVc!NOEw#k#D#
zqG_E5>Y2+;mvcwjJdt@V`TV=&!_8Mw!X>uVn&j$a%Vs%sB%Yh8IzhG^Q(=4GIlFI5
z&9;B3BJ-bE75S|Q`5n2DkW6NjBwAq-u~og%B-8j2e=y-<+GnI2eJ1TW4<q0c_e8Db
zWUS?M-D%(UODU{=;;}Cqk@yu-nIWh>Ec@KzN#cjGVAR`LV=7a(0}eJI{G=mn@)j)u
zO!pk|g&+Y7Cz$0fb3ZY$U0_+o+vK|vCs2Qn$HIA8E0i3+O(wt1X~2YF^@i?Bj;7a)
zJ{7(3@}|7_GrD(cttwsu;6##D^)DcFCQ+e7;QBLcO_1HZGLo7_nLwN1wOKwdqS1_I
z44XP&pfF4Gd~*4F6_Qt|lPg8CbW~9@)jG-)QAw90j4(?BMfFmd&w~|~o@mNujU0bP
zcI=9Q*<gv0;xVv$W`4+2`O6U;Tta58WQ{dEJC;}4^7n7|@JHA=ok8z>Fx*gU`)AkY
zPq(vc%g>45$@b9!*!iL7V5R&1UTNwiJz)mTqm3(z_Y6u~^y44kU(<>kRCcuNLb6Gq
zKL_G(Cuv^gIG<)26J6)ol*UuRwH<%FcH7QE<3!)02npSbZm-?iEmDkm$vgW$7>c7S
zhx{7(f{|Jc2^;c+(<AnA;TLr7Df_ByF<*JqVwsEiP}GgVVYnm#pI{}sL+;Uk&=vRJ
zqprgNVQL0UHYku{D)BdDvx{t}PP{LMNLAr}5hvZ;_FHEcWqd;w^F3tqgtUJgGX}Du
zkuwUY`_RCM_>!TkiF0@*>G(nf_)OTZQ(X(c5j8VWUt2_0!vaIt>o(%J@M;l#q<T4J
z#$Dz)IPVJ?!<t}+8%n3EaT@WFoF%PC5RtffRZrzA(n}Faws(NjX(%mR)o5>(3SJys
znFws%Q1gEH<A+a?+3MpB;gEmyP{~LE&HIIE_7*W;6)_uN7=iYsV!Fn|VT-Qa?hXgi
z=Ca0{IgludX)JwDOp9mXls3C>Pq18Ny;Vvv=Njsh`Z(e<(n4w6ZWQ;*Q~X-KWnS?y
zk<i1inQr^6M(BZZNu%9IN~OVF|9-GDyF4$iUdfKKDWERSk<vspWifxhVkGg1^(2Rs
z7%DA)?q1|Zh{#CtT}^4BO<DyyRf)0IY3wQ(nY34}4h^sBW-^lMZyU2Yl`%Z+Qocwy
z*=%|iMoG#`PrV(st5g&By|NunN2^@p@Xhs>aB-NLi*XSFD~efj?fa}D>anpO9?DZN
zO%q6JVx&ecw)}+Jy^McmwcI)FznMynddSz1+V6mtJy3@3v#BH?^%;HI&)24qV6Ubu
zyNU+|vcU0~v1;%w=|e_LESX9u!6`+mqSlk4^O&^BNk-|QIh4fE<;6H9@t>GhAV4`i
z&2Ulxm`P7aWt~{0^Y8T@X}y8L_BlKR=w%+MVR?AB5nqHJjpTpuGaBI^<Vg)`T!e*1
zJ>@k_1Zg)(r%Ad=ab4O`0v7!8We9m|(*})7CHTH0g^`vjhE>Y9jG`DyH3BB4JUCU;
z@wOam9VOXcjbmI)q=e6?0wBp$Dyj7gUH^^UQzJR0$a6N9i_mt`O9}#xEOfXK#w=o9
zNpopqj@rRCh-ZJjR_C^i6(ye<CCDr$Pq1nP4h*Il#uC(i?}2E7c_iE!U@(|eD&~+O
zR)t7asJAO61`X3&1!0z)8apoB@)biZ`-2wSTG&oOe32N2A;P989Zw#%>3HRlKSh~$
z8#60qELZJ@<A7H`ETUq0qpk3Sd#7)iS=Df~zhhWx3^sprw^?UqaFxwED=TFVg-}h^
zTn^}|8KYtGpo_Bh4A}#*kZUIZ3Ds8X(+)s9jTYfUwKNyl8Q7gVQj?<tKg5<2laNQ)
zyRf($jFtRW@>|J&K=SWQEzT|G)H>s@))|-bHunFp4td$vl=ss4SgOiGqTS+H+D)-r
zUSrPWEWdv}IwPs?BWTJkr+)l!pjzB4lI>ZwACg&qJg3z#mDVr;jm3KwdJJs#pXh{L
zM~ptmtCFTVAs6m6(^cmk{=M#o^F4VhbYmUQkLLkh;nqd=jHW(-GyWog+MI`S))bx3
zBmU&iz`9WlK`}~s(f<!PEgbtE3tiQ{I)VpJwmyGm%=2lec2neC*Jt=KVNcW*aId!0
zKPOMJ+j&I(YeB(50hRI|z{E)X?SH**kW&(Wj6^+bG|AEzQ=&S7tta<MNgb<-j2ZP*
z%@A&d$fgweZ^q^`YRd;bbtN=Bjwi{676F|%aW0RZ7Avm;j+1k@z%BGAp+AN<3l4-{
zoacX!$3PBP{t?B+mJ?rvtw)3Tlv+ElG;1o{cu}SU5fKex*~rN&IAeirPtrpI&y~mc
zoPJ!eCPB%_T%2wZtQt-crH2>o>*1Qc)vMA6O(8$|nZt@_{D^gykou2O8K82Do4BFB
z=27y7w5-&AMN(S}XbkmcjHIFG$>^_=4@G|<@7(t9?@Aee!j_4KisyYYN1Ca$P>q(i
zO*t5cGccV`;whb1t+StpZbG3h=(JlMb7nk9rviP3DUbX=;6cGb0s2jN2)|T{ba|gn
zdvR;g*E}?H#W2EZ9~WDSVzWX+NvZPfwFzU*mDgvk=zym40A#o%k&KM!5K9v4bjW|5
zYJ64;d5vHqeDX=7iEYqovGCxy9yEu2(hyVn9Kt>>K+>T<<n#+eG5TgR`jop__DKk~
zTf?rM%P<u%JQf&l5*RlD<zZ7)ZKNcR>?1lyme%xstvh2|VU&y%P&FMoT&q%t(BR03
zC9+Psk>O=sGnYytyqS@3zyU>-qWXW1`W!2=D{ptCZNM+dBXb3|10U;t-R_iDNKoeo
zFGY(WNx{dy<9fDT(vlnxX`f=<oQ^%w*&IZDjPYQO+eQIj9xVC2>*5Y{8EMaGjCWh$
zHY1vB(pA*reREPESe*HI**B34c6964lnigjdf*jkbJ-PMcZ9b%cy&0a#dLqhYHHwv
zgn}FgFr|-5GUBJH2*v&Rbi6rEg-`Zmo{5|GO|R7*SlpO}n|;pUKQVZ*^s$?!ky>;2
zx~LrFo+!>^R%SFA>+MF9)H@A~|J1w1?H3HA<l5xX1g#D&Rb|A+sGcU6wJw`ueL5A%
zn&&)@{gEH|Vukcoa$h35woZS4m$#Y2)8*U#611V$XXQVWr{jg7OFRx1CZ=O4HNr6s
zOKT0BQ-pRk4xy%@3$j8+F{PnSLv;a7GqSYxUf7MHyjHkFZuUL6k+LB(B)m!j9=l0Y
zicTJz;~-M5I9^5pa)nberE-1PkF(QnH%7tZ@OWQM`YL`$+Lklr9p!(!n&W%I#9Unc
zVipoPyBFn^KgPv_>{J4F>%|rE!Oj_mrF~6TArDUw2ZoaQs#yTtZEEi&bV^<o9nz7Z
z=XyBj{qEqtlOD9O(;Y9Td|2A&;iTBOBwP-uph0R4?HK=FBpinAcJJ<bH(E@2A^Y>X
zj9gAuB-F=?NbbddvVeat?V_(D1~zrUU~(ggCQIUDrJlQmenJ&EF40~d6||k&b49B@
z>vTJ<%_6z-V$>l&PkpRglB@`;RV&>XI$JFSr&G@<3D^WJcXW_37F!|0Hqo}Cp6AQ`
zHJu!gS+1<&a;inx>X2{u0+Zd-^|<NWcrT9$>IX5QBfd~g5{rLc$cCj{c04bs8jY?Y
z3^Hr9@B;x7D%pD$%feclDgYoGTY#6aje`TtlFF=yvRkB@$Zo`BEAS+hK>M4hr8bg!
zH?iGq58GX1ux%>U_U1l;@vx4GX_OYxOQ*k>LN8>vq)*wJ^+@3u$<|G$tKtbpERkZZ
z`8=S0D5EshA>MyJuckm-mYr6q8mKmn_Dr_^(k_|NaV!`^Lr&_*?Pyqpq}I}^Zk
zWH8*}k;kG;Ff)@Tx)IOBEQnlpV|i&BO~<>j^=@#t&>G64r{r&K59`<Ctn-u8ya$FD
z8n)6G*z+ncM;y23Wg0e9Uu=`p*IT^_!_tT)+0g5}80~-VP}ha4GDW7c-@=Hg=A-h4
zx$dJ|JIc@0F1FsFK)V>16<8!K+O5v8y%~}(Z;}-PT=9m3n?%JzqrA(===)u}mKg~k
zd=W4i%R8*q4a@o|jzt<}p<F%R7BNhkNL$1T6f+p?%^PiNd^)F<JG6leRxMIJ%3@%g
zQ-%Ahb(wzwk<XLD#3<Z}Z8+rD$QO*%YH0GUW8)F~xbVRc{2~@%2PdxCEUMiWp?*20
zfK3G<gzv4gElzz`Rc6L;B1NAAdtvGJQ2<H_#R=oH-{2%YgKfMBRk0@8CzOPEi-^fD
z3WXfG<Q&t!(U6yU_3QBcySMLtC>A`1Vc`-DP;7rpBKJ$9#esGKc`0Dzia#!B2v#+f
z)pM1irORco0Hl3!gs2KsR6D*gsjG?KD>dY?Xw?_pPPf%JW`WWms1hBoP)VeNb9BV3
zK}O7_s9vyvtRG?*6GM4YCeAGi6UIsl!K-Ga1fjB3s4tCX%3}BvQ0K=pG=gaybJv$y
zB(i_64h0)1mKCOO12{=0$6>jiZe9+MT@inVV`ix?+_@kA_yK#rqX5G2ZA3$l&w`b<
zovJQ-ld>jkGL$G%6u*_i5E{Li9wyH3zQ7<|nqDU(KC($kgFG-cPjk+yWkco7rHqA<
zTjJ^QI}1t#CI>6yN2;Vd{jDweA6^NFn6ZBw{OnCluqV+@UitAvz<0aT>->7!<jXDY
z2p`n}v%m>QmsmILOBCWbi3!63=G=DpdXfcPky?h~2#>6X0LN*QwUrb2Gt~#uA$Lg$
zv`kf#WtbrQal$w#1|Fut7`V0W$99CGe?|1df^j-yC?X5Wu3o{5K#-^=d~3vj(ExuS
z5?IW%1OXajCO&4e>Zpnat_9SFgD2VeRY2)VaMgDqp3xv+s`NyT9m2stuv{Efl!S9p
zD54=Nt<dMHVY|U!pjb<~cThaHYHg%mqC{Z@Ek>2UBGp~4S9?5X5&AzzNTSlcoV{6M
zpDb1li=Z43kY??J?do;A#wE#jyDfjB?9ME>5^qBv<UKRDHFY{$eqaI)ic%(0GEVN0
zs>5BV!<w#lJ?LGp3o0^7E&qv9YU+@@iB)Rf68lPZZQ{O!4;r(IjiA|X6<@-)uD$(g
z$wg(D8SwUHBs^xScv#zw$OjJjB@K_t2Bq4GmEn`LoId>&O-*H-!bM2}3#NagpiwG4
zpLM^v^gPuwNcgkNjj(B5v`|?GpctYBI@kGhmrqj~);+3>CMk*}s+sXyL&*`B`y>ml
z)v%f5X$)?ArnNa_ym}dH&@y(_Ohi2p_&{(2S^9Iv&{||!l_B9aQuS4PG>7`MY6>KA
z%gxmu`^pxS$@vG1xXe~nQx|_U71ILCtcEGhns49s2G^Ur_~oUmf^Cc7_-Q>>Km!;<
zYI19;QuMAI?G7Z@m`0v}CDSc53^DABJ*rUJqUk3h9+0}uH&4>d85N6&Sq*J9bWTI-
z0b5&bVAYnbF01s|*q6Hox}-++SkT#B2@31$Su3ihLFIzT?bs$+PN{!jH~|+9`MMyJ
z!&2i$sz9<&v@XBO;9PGb>t>2+SVPZs!AFs2IAoZtC(U+=iR_b3U7RQ&OT}ZssE5m-
znN=4_KErlJ6zPf<H0bxb*QKlo-J4Ns9v${3+0p}TcT8JR!j|)hyDY{+ywM7aoPL{3
zew)*P3Bl@C`@FKq!;^m#(9va1#3q&c5q3la_{hC!)E7^x3`G|duNxTdD)N`=qg^B=
zI(My`bCXgnk|Owg0sOjqL7Sva@;Z9_p=^V21W(=GbqD8zqj@TSy5uQ+$nsQKExICB
zxIY`5_0P&EAf6nGW?H2b;bm%cO5Zavlrg`N$kj@g#zR`*ZLWXbl!dBI%Q#!>A<c0$
zpjFMCn@rIC?Ch^(F1rf*Dao6c#Eg|V<_k={aRcr?;JiQ*aaFK=Nm}xRbzWeTT&P1y
z=2?@p&()E|9M+Fs%Q7TPxDGt=L=}o;zv`&(INAD=lYQS}4Y1c`fUQ2k0Mm8AM;TzU
z24r^wQH!eAfGU4~c1b$<ot>>7o3cD8MT<mNk)6^T^xEh5Wn8gC{wV`cGm6<Yg^TEP
z&aS(|5-#Eyv3|XlJT6<kR(Dv&1zzdFoTvq{%RQj2aG*{XEaTR-F_b#c4Mr`-5K`@4
zVXAN{L^YIrRi|4j<}KZfqT7?11j`M&<KwDRNj0vk5Nm(srlD1xdK+5%)cQuRGCT_o
z6Q5iX=F2+vTF7fnQiDUC8mXtg(}q)>nIb5+x8)>3{FjU)6nzOB;cZlgCfL6-J>N<D
z^0{+jmj=vhpy!X@-EO_im$zF-d^?<^zy7GMhUKH|aSaTOi&ckQU~iDv9|bHeC&|<`
z7tu;@#Fu}NR&p9+r6{#-w>6QTZIgHlNia%Ai%BNbt~L^<Ld@gK)6)rDwHP@rpPgcQ
zCb-5iJJn~N`f&`re|mo2K4K5?y3=jn%B~GoNmW)!3EzE??Sklh9`PrChIMG`)<7PM
zu}5+e?JJTE7Z?4T+nX}VhJcP(;q*L>bW`Y-1Y3U(bnz^EP+51JnqlKXgkfQj)i4rO
zDx#I-shA41aBbrzTl1K8vk>g^64TYBnVRX(T^K_)42b6L!|T{ELGQvJD}M^JdX+0B
zu;m<*ajmNkiuv+tsDiXzGi_IGF95l)7=E-`r-ke#tMZN4o@$21MMSMaZtxnzX2RE8
z1FL_C^QwZbgc;Xeg(~JKgHLQG_>y`V_B7`)4Y7Hu%p**qbJZe~Y9MPSrPPLJojDWm
zSlX@sY0G~*Qj5Va-DcWlt($RZRF0Kg_8a2XFW{n1t7U2nx{cw>yJ=@MM2iE}<wfU#
zKy_8fv)zBo4D!gaV`^-#6c~Qt4t5nNRcL?K7cJh}xL-4fs7H2G9gWy4&36}p>|}!z
zM-oNuI8HGf%PUjbt*TS)e>#>n<)w|&H<vnSt^@1a(&XpANPJuRX$%3f-0h5+%R_Iy
z>AAhpsm`F$N_%i4CYFqa8K*ASKr^*-)VK-(gp>hlQpe+RV}W4cQ^+)!Ut+f2iim%h
zSVSQ>hS)ucpk0XjEPukY|CE2yM-{(Gay2kwpbuq+bHS$@&khfIuhXl;tq(2sUmN!Q
z&<z$IbFimZW{~YI2OMQ)`{1k<Jdd=#-wE_BgWe+P6(Ol0k%Z43_9P<e%s|BXVcKA5
z9&sE7h$V;hM4GmwylXeI<zoOcc|Cto*T-bGhy}VQ)bo^llPFcagVOHDs-0yMPuea(
zJ3QpH-ENh$PJXs1dhUMz?Cz$Nd3ePeu%&(7!k-7eY+$qR`Av<(Z1QE|`_fTdmkjl<
z&cDft;;nzR|J@+}cgIByWIvfW!RN?aJ1RS^<bMS=#0V@|KHHG<zQ<<R{9%6w)<z2%
zb5RZ5@KOsNYc^!eh9YHgbJp(Nlya_AEU0kiyjr{Hm#GOgW1bIgtoDuRDCvN^HI>LA
zcdEKY?rhY-$<)`xQ@#uvO;Q7a0Io1q<1n=DIGE7W>t5enl#%Y}npev_h}Z=49i=xX
z360c}1edc!fW|gR_KM_m!Nh;W3QBOy*r=EYPop}80@kdqwzq0<V<FIPdLTp05xbQ`
zUa=S`D|M27cG=d@IpfDv3-9XtB6{?@owHuw9BgHx&<1Op0)N3oqWH12`g2P<wbtRQ
z^x`GH_sso~JwoC0Le_0}JKdYx-54?DHH_ieOs%!rQ}&0mMLwBq_x*qFZU3u?VLcl{
zt?B+AWJfDm>*3YI_xh7*0RM~RgB1$`F25-&ybFgr87R4P=?hk$T78NOvHJ9z09mU}
z&yPis>cr1!=<Y2C!bNtkTZ4N=R5S1%k~xc977DuAFjnv3*N<4PDTGeRTqP2|A$=Li
zh)FsmPsjf~6|%wBP=bH-|6><<3u}q2O0_EW#Z;=?+`x^f!@5<E&Dbebl7kuDnm=9Y
z*394yt6R(Ht8N0kd{3@;@zqR8Q3F!SPnO+_f<+*?>_ikh5yd)LMk#^>Cz(yt|JH|&
z**z^Gn^vy{=J&;2)NJF}uSko_w6`x^2tK2dQ-YQ3?<BY?VoHDOMA9Os?aC-{mO_s)
z4~vp)BU%$E|IHiGT5Vi;ZH%)Li?$GpWI<(i4-am*T@TLA?z_e;O4F|1Zm3GEbbMsJ
z)2P-~>A^y?(o#<KH33%@<YB#QC{eB&Qh=mG4JHwtPpcy`u0R^95sjoSx1+7jd}Z5&
z!WRLk#(iTsCEkD4NfsH_no>w`4%t-ltO{9H86#>tX~(j{>tqEz+88U+GLgOy@TdOh
zd-9Is>?3$gS@(iL43`R)4`Qe`DkJ97MT}eBaEJ!jN^C{oCM=RuGq}EGldvb3&9N&B
z+)O{g()ZAd&fK$z^9-xeNZK13YCrDX)<<)af=rn+*B^g_{B$W$zpmhsq9Ow^Jeaog
z$r0YtyG+mDXaa=@o6W^4v8*NekxVYIHL$Kjenu|WEfRt2$BTe0u_L`~6@}K9G`nI{
zr|b#LvS78||C2;-!ufEkM~2}~wo(C3^>s03C4?L0q*g~&-jL7Agir2}Bm3L1Ky8pJ
zv7$}61jB#K6@aTcS8i}5vzzrP7<X-~FV|fea(BT~9P;1NMr`ZUE-C-inV|;)&SQ_h
zn_P$E9p-_LealIw3HT1ia>F&bnOsBes9wMRl9v7w(3}zHvyHQg<mF)4z37&*Pi(VN
zIuIn7?@ra$4+lXOP$lFfbyfAaLw=2XFn?sO6~KSW4?!0Ck7yBXK~t*Kcma1rP1;O1
z4&?o3G{js`iCjcO#6B)$Prf`XlI+5D%k>OKH_$BEMm?sK<d4|@E@3exzMBB)Ia56i
zG~b}(l!TIYK+%fn*Xc@7%nraXOzK9w9ZPEuvwx~Iq~@w>)ybN2$k1S$)ssI1|A93m
z74LtCKYq|;q{Izq9D}hhbtQ-&C8X5Fs)wh{Tl2iNH&>XeURqtX`)#TAV5VC3NR~IG
z_E)W0E-xk7e$zCqH)^Rikv4lu>@1P3w0~Vj`6TkaY)90HE<rYg>mk`A>OM>&z6fO-
zO0XX=1TP!O%TM`}PFLI&OG<>zn>R|zR7ihPkUG9O60c&x)(JuK^H3bIN7cI?^se_5
z@$BHD{OO8|)FI17CEy~EygPQNDAv?UBb`f?IpYya&Hgc?VgYa=b&m_M#3j?oxqmbK
zIR?CmrcBvIHNCE}Ij&OjOT(+vIXk!T`lcrNrZ6obW0;)_dUYw&cVt{sF|_Q;91DL?
zYbr0W_Sc$9=-E7H?1z4gp#wY#>@JmI(omh{l2N;9lV_l+%dpS$XhmwN@m6!l-4mV7
z(d(-HHIW;amoDd#_uDw|=k*5399PEPXbE<nl@G5={k&CCpDhIh)|jB!P8>g7BTFKs
zrccU@noZ2L?8IoC5j~mw26i4^42XY|d9JcgVgqBKzSc}SPj*Qo3`-Rmdc*TpcUZ;&
z;8)HOkDUiazty`aWh(Z*c2Xf4B0fr=CW-lMP3v^G2P2)!$Okh&M5E+^ktbD<R~Y2^
zdPM!K&L>%F*WD>|AJ9nC;MXsr1jf6So?laX{vEWl3XtUkTT-OCbRl(h?1z7DGL9ip
z;EHF|o+-*&(8(??39pk;_=vG5KUNbSuwpQz!P@>$Zero~5^yUevb6nsskAdn8qlbG
z^gBbC_%c!=Kl-@fg2~Nv1R#PckO3BO8$-gP2n3$5RD6gV>}r!IX6dac_?1$c>+K({
zv<n6HO{?7=l#wB|sj>O+C47HUu!d5tu`cb>1W+cv+}u-XQ<#~jWxzTUYTbMjPnZOJ
z1Rt~T(T{kjOfX5})D=i=v_A*pZzrTiYe}4L$)g7pG}(*M?NCACzhoSR$wX#9CR+iG
zzhJrt?wH39WXd9$2$Gbfsf3<bXH}A)Ip8di4NtHZO70o#z5hP=Dfxdj?01HPQnosu
zFj3FDQ00W5rk|;=8C++HRX~sPg9QFv__);?r-TpQ_{(9HZ8u4(WFe|?g_&)V_iBEj
zl-aWWU=E)5jDdKM^X-Q%I9_LPRw2ewI&lwh)UK;i@QD`Z3o%~^@VjG?8$qZCW)@j=
z{Z8k$f3q7^ro6b+Fe-mmYKE-}>?yhZSv;Dc3iL}Io}z_bpAEWqhSx09U`bbU2CY9)
zoLiX{fAS!dtq^hQ{Uqb|w70T(Vq-1Yw4}_{h^X{3*+K(5AQjKtt^)UXe1Yvi(&WwR
zFcFHtIg7?Tnz6#%<|>fU+-7GVa0s{NL~W3~zx(-@_wQs1Gjf0Qhy{Ep)5v5pgU1B*
zgCjzi=e@ygr@Nc3$-#`tn?K!}yrn`(YTa(ayoAp>5p-m1FUjmst1ZW&{4amc9;9}7
zXiOAwF!(u%_^4uyqYgN9g}S}p9h{f4!PhR}nN6mw!Fhy}R$9{RUS4)jLItYQoFg<c
z)oA$%cCnKu026=83M1L`l!vkDmW%-k%4GdiEcsr@a<swHDp`&j;n1IS-H8%TzWaSz
zkVJ6rQb#?vg97?=8e{_R@(LQq-1TMYl1@cayW{hSKl+%vfyo)5lT#<#0`PSK5K-aG
zBR|Z+5dY2qMqv``ZS}@Hdt$E41Nxq<A=*r?ATt)nbb^0P&jD(oY<eKS0#)w_z=jze
zvCu7KBj#d`9h!l<R9&JR{zfCwAs;e{99v&d2lU1$Jp*6eW29=5_oo+Ojso^)0gHPM
z%pwz;FyV9Ev^`}n>G$s{)v<h0dA<nzku#^*m|-i6c%usg9mPCY2#~3CU2vY(tAjQ0
zppc4r!cu?fH=Lwyr6@V(Jw8H&HR_%M4cH2Sw>gLQ+aR&sl{d0T{2EA9cH@gv{kGNW
zw(|pPsxN;^N#J3Qwi#?5qH6h8v&RF{J6tICcJ69fa9eO23vRSh^UYWN@c*;-EzXT1
zNuU2pt$KDtj`J{jSd!fn-4S~B_|7f&`7yg+OwWIHU{RLYMxX=aw&uS5-><3w36MY_
zfv7^cu`%67SY289%SUD9<Js^fsf5w~zIY1`1r^7Xfu9uFmYt+`Rab45982gEr!c}j
zx--z2v~u2HHA$gsVL(awQ9_4@IVkZkL7&iinMv#{Mp|~)cjgQVp)jj6!=eom=@E(i
zBGrG4H0sU{>ffFgs-{%Wn8^I`N8`^wIp}W=a&S~RFfpAWt4OBtL(-q#yKU#lPnJ`I
z@kAT8xi5L+XU4I9#^s>h<#R&NFW35W)XK$lhZJnPHyo;tmWT$SogTRpLtD&r3sqTj
zK;j;;PLDr4PJ*1Du$)`(R|3uC954bHVHkgL?#KK-5$&)=m5Rc;YZ<1Z>O{S85EX4)
zHd}y<<DIDtn`jL{!D*vlCabzcRKj~d3TQNDbMzv>;RN7-6;;;XBj-=h3?~c)YcZF|
z$<g|b%?;&X8*_T9q@NLAbIG!>p6ECa>R2o#n&?0u;WwK&o~o_lBu#JtKc&Ktsy}~6
z;^)b*ZDR%y0tm%I$ftrNtW4?9zDPZU=nDi%&f(^b;0N$>!YXGwUV?hZfeaw#L=h9!
zYT+k33MIbcT(A)o#Fw8L(KCR=jFVF?1?0PG=-QITJju~jVxNW+2SC10%_77Jalc)^
z=r?#=IK8%(=0@zLb+cFNj2xJ8w)%e!t4qo8=GB)=2dz|2IdLW?Q<9E_<yV4eafQ$m
zLBY;~AB~ohg(t-Alx%hKovIn926)pvu(xQT27S@z#|6JYe}aL}BB^1g$M90pjNtTd
zMSXt8tZeMrBxmu8Zd5>DfW8Rpi&r)T?7ce-Y>S?doFS>sba+q~pe~N8E+Bu4sqiq}
zT-LGX<Tky^rpj9X(029~EdgB*I%cm0Gvb^_XYrj`n!{T2V!)#U5Pk~Qxa$pvVGN~>
z<tG#76SC2EUdj1lJ~d@J(ZE2jO{po>Qp-JvxEPQi(k#DGYflCC?PvK-b-HgXoxjr3
zp5443^y|a=RbrhVe4PQpeH4EM2=QISC&TzYlg;n<&d9m<szS)7|030!A1dEI89jOO
z-Tn96cZX~XoHv~>1#^3f=9ab&aRfBnM8uinJ&{?fUW2wOG3I1FwDFfFFI_*~vApiD
zg5@p9@^18h@i%^n<H<#*)xP2}h#hg9i0@$|C<7w{-a_`{0i}La2g`pO9T6N8VZX>u
zJ1OFfuZ~S7X5FSxmG;tMe~p~IM9J<AiF)Ajf=iO5Qi;0D#4{Q#S<DqWCXn$6xWf^5
z{4<mZiDzpED0(!3+bQ;zI!QLB6At273IR(FtZt~Uy{|7bWhkAVXsa|BCF{Deq^6io
zy(2HqWL=#vG^bGoYkPk}UT43?G_CW}MqlKu7W%SraanI9w$Q=X!9sH-B-BEO1%$(8
zmao0=W~L{H+b;Cjf%v}tyFJi&vR$plBhyS(8NS)3{Qf=tt0bEyQKZ5SkJvZ^aJWWs
zT}r=iA5TKP)ocv}l5^IjOI8$?{=>pCY%W0Tk<z76Xu@f~+R}f}7&FA}qc`gTDR^Sc
zyhJb0F~-iI=^ZgQZh8ChOjL~$A&v<TqjAW+Y&JVJaY&X>pRA6xg0_uVk#q?Ygu$N4
zC=sjTXEJVO54RM4l#v(t*mAZLf=ThmJ@HtQc(m58ltF$urYF(|V)H9`NKH&0Dh9UL
zjUGD$m!6%;1D=1wTD#F*wIvVQXYZje;2C_K1w7qH?3<lc!C;1BKu!lU{O`x>yWs$R
z>GuCu_tWs60|3B`m?Hwfy(Zg}?e%uO-CvIY2DWe696s6Z#YKVfr^R>;&xnI2LL8Z#
z2qv@{6>%mP){clhw>utx+L0Ay74=C_Q3IB@OqSQ0$l-sGY%yF1hr3v9;Pb*qkK_Ks
z_3ii`jqYwgi*PIc@Y@hg=;T2600CO;w6xgsLjN{-!ISS*Fkq+1dSf>KR#$-eC(HZ>
zF#jZ(Kb?O2_rkJ)`6tT!IXS)9HU|EmBL7)g-#69+1^{r10HDR{#P6rMv;crp1i)N|
zBj0Iq-ZXy}I{5r2$$A#DPQv;OdjLUr`j}iE{;T`>%T0nPZhzDs4f=_NJNP<dyZb1L
z?IjRyE;(#rTe2`#s`WGUD>9y}I{JrZ|N1i<=Po^)#IcJk3vsyYV;o=9ZNFZ5P-hr@
zK$EJe8|JLqsGXyFjs55B9Ic-<=(ASvS$H2rA-R7=X=w*(VKfu^&Z6_XIcM+3KApi_
zC%iQATvXOnC)G;7`%pPYmBH<&3gL!RqW%G0P<{!`nufy~O5(;Sb5Zz18PlWx=`$8l
z24Q*fLMUqp%^yQEOjmR$e<nsK^-CZYX_PaXI(@O9v;{7Y2vHXKMCjess8O$7QexjV
zYi)m`zu8}F!4{kX@vU>wxnd+-68qGzg+<G<P2%WTU27yyY{R7dWCMeUm$LF%Xdw@M
zAS#dD*!h$3Mze0K)a9Z=NxiUhv?PD4P;Z57(uC?$`m<y6lJr~dUv_#|tXGI{D|&Tu
zy4rdW3%>4n<jy1Z&1pRHoHuzw1;g9Z(TIPXAz2s9j80?j4v9jC=fq?5V%tG4Xe%nV
zc93gbHd;;AbQF%~8-Q>(hqL86d>;&ZkDoq;+g~PUeDnc5J>yFkedCt#QE7uoj`E??
zukX-H{)+wwYQ%U<Og&y+47hAM>YfJUJpsX3x_16PQAg=FpNmAe700G#uifWzz}bI3
zHRdicK~{20;l~KaRZwJp-0E;s<?<8NC4bc4*K2>edS=`uANieF^5fczB|ms>EI~9V
z8BS!c5_f=#JV^M?1|ks2fG15f*|H?VRLH;f!Rfl<Vp4LP@zp~*uU5lTtSb^tZ3uqw
ztZJIqv)O(0Lse|5mTOYWeZrQ&o=|@&VBe?eShCc=oTnY{McuHOM)!Z6tj%9!s^#6E
z+2~wHjd=f{J5&2R^}&dQS++t2%>U79O;jiidqv{Z#LH?;YP2Zh*$1vvx+Jb1ZQn2Y
z@z$-OAK0ow1>U2@dn7%nIvxM?0kyo<{9Cnc_O;HI(MMFn(9^&7qq9{__eXzkPuA~0
zv6Zd2H1s^gQo;b4u3+^eaa1+-i&RSmKO{e@v%rrAJALa0-Q?wJoR#m5(4Z@acS}jt
zC)z^6(qGs#d>cc)!k9~#R$NLm*(4q_qo77fAiKq8qDOojE2=`z&n<(Zp(r7&r7#hg
zQB>cY0H-`@WHh^K<ih(|q0N6vh{E!I_N$9mY!X42sTFW_vQ325`-(c%V76+r*DDkX
z><7vJ&Lw&3YEkRO__6*X_hHbW$n>9MU+2C>>$QCZ(8AG`E^@kv`92M{72AByIts17
z+kMOZiH@g`oX(%?-_+D6X)dz`Zgi3U1;S2c4?B57JJ@WuJ(=GabVh%paxg!zr<pL{
z-5k!AOZn`v-tqmMW8Yl1Y+S3#mP8voRcA7BXo&}@X;u6-mx(eXPFbwsr`>`FYb<cS
z2NC8Zia_2u`T;n@DQB3qJv;m3kNTf~o})_jEXlQBdr<4u!ojj=WgC2*DO>ju`{q-y
zwEO~qocx%cwOmEZ{$4qKHq4o<kv|vI$+MQ0<SFGU{lOVHRi&Rb&dC1?M1KxW`#X1@
ztnrM9feFmgO3*u_)@)yP!}BPklY&P$0WXugM;QtrC;NS>iuRp&Uz6TP90FM0ll(^~
z0<4CUB}hyd#rZgL4rL6GXu~K#5Flt5PFRcufC50-vx!I+2Y)k-brC4ocUUJ7$I2IZ
zihCxOzq4Q5rQStVSle4Wiq6Nfa%<N$sc>v^@<S5mMeujXIf}J_b2uO8@U84Ui7-p1
zp?`k8!C>e=N*7TY>a|9<-rLS~P6$h&exHmtNyAg(@o=Gh_hlPg$-r4V;aMAGmlMl+
z-23_5Pwe1><$vdc!9@aFiWoeGi-dzUJ6t4yb5oj&gzP*SN*mlRfGi7)bhtwRZWYZf
zxI^IWfCJ~(^!rwzO@KRu<2g}+n0`OIlieYRY7*DurbVJGpl#u@pxpYF`2+Q+v$GGu
zNkh<Es@0>S(osS|cdCBb=wGde9}Db_fOH5h9gTF-@qaA4(gBhXl7v>L)owQvOG5B<
zkOVmW=LcVi)j+I<J2pAir{uvJaF4`wkI3oWIX`$!?&v%M>gk|=$g}ycPFK1{_`|)A
zlo_^&XjHvpbRbO^t{vM>CbluLZQHhui8{75u_hDSwl%TsWMVsK-sd~(to8lrzuncV
zYS*>zd+#c?wVwe|=S^!06c=%S^Pxs>vc>7XZ!2h&qX(5Imz>w)EAsYqp<tK_lj|fg
zjQti*VxM{j0x_S8RN3@#U(jiIu9VxWbuQMJ`Iv|NMv?1?+`-0{r<_sOBX@J8M{`b8
zb8{n{<(y4H@s;aLlhA<m%O7Muufz_5->(X;1*F0x)1<J)TL~QoYcLnTJHBdGFB2#x
zIMMIzp*XMFVN&-NPIB=;jO=EdIS<#ZUp8jy=SD;T_(fw19KjM@TgTRI6+a$yp*pYd
zXy`2RrpbTa1!Ze+<qi-CCK<4e`0=vm5nT}}IYzV}aLob4CSsr4UsXPm{y19&+u>Uc
zT(QKXiGL?9J{|_HM0b(&miNPVOE6hQ#ttR*fo4{tO%#O8Z)v}iej$4IqyI2AE;7<?
zNPIT~I-!tL7ZCFef5=R$c#qELqYZ1X@oR>?s^H&SK;axf2d@~5ogY!Kf9=MFDr$^0
z^BpoB$VDe5zUrkun4hCM*h1v=`22yegbsXf)5>eywlj$F=Cl6{M=tds!+KwpPvUlE
zN<=$Ub4(4f;>G{B3N5!egwD@O&lPYw_N;~gOqdTCPzIQf6zcl{UVW5f8q@5OgE(>T
zQJ6z5Gpu9SJ`gU0t%T`aG{Y?}WXZ~{mRtUbz8}ogRZ@>(uNp$paHw2kKhe00-b~Z3
z>Hfu2q8xmB)?2Rx<);z8vcvW_(;u}!!r7sj__TI7zQx`wt&Eq0r?V19PRe+dKK=_J
zFEm{pO*VRfHF;cKpvo%nrgQgxI-yeR=?(?r;M`ZGKV;lrM`MmHdAZW)i7m-R3g2fy
zXrhe*%3YnrpAXC1vqgW={8?$EGy7L?1K!Z{?|e)dPa^xR*ud+8Kgpjn?btYO*s|$H
zPP*gYMap3Eko)1~D@?~$4tRI!07L+QA#?^J#Zm#5048M)O(VZpXI2L6a%Gh=S*)m0
zkz}=ArqnyIg26ysJ*9LSZq`yU?R*Al5rq_g$HUUj>KWas2>1;m+ebfyFu{WZmtd1{
z_FeiR9((aMPX3fP@Tb?D{bX5y%1f>qUAwSZo5?ENhbd)``m|7EA2c65#F-2L9U=m%
zbDE!Oahu_U*&Jnjr)=24<oTHAllGfSgj>R)TKIjV0n<M^!+UsE;KnFb2;mkpcofuf
zeUP~1#==BcfNhN4-zwv+^!}u~oISiNnvYxCuD*geF(RaFte1hYwTX^hn~TG~Y8}<`
zg=V<w#&W7pTeinB@hFD#5e*uc>>g+jlCShlENQhgdEtFyz!~(w^IBz1Pn;s=5I(n#
zN=Aq=MjsTF;SQ@ZutluV!e76VgyjjFq6qV(B*7UNPCTaSZ63gB?o?n&M1qSk=FK$^
zW3iLu6A_~OyN~zg1pMVvUA<g@*4(9a_?$$I`8ff!Q7xKgXCXw`ZTJ8<j>EkB`4<l~
zyd<Y2WO3+V`%@rLDK*;n{YXPlew9f6{aP2%U42tS%Gy&t(fW>QxHq?ZQ}jT?M6=KD
zclz2+)^RSKZ9?#|=B;uu-Rb)?j6$xqx(+w+F^@C--91R=xXM<@0j}?;tq{%`--pd*
zE;Wk6W0V}kEu1sx{~Q9nHyd2JqA-*`k>So}+O>GYiK#kC#`xOY-2bL^ptG4B&1xU=
zaH2Vs6{kP={%9|OO#axoV4R)hFxqd_u*95ZF^5eI1)MxTL~aB!a0l~g1{?{ffl&^7
zFa)xR*e>Q6`mU8LGu9pf!`eF1JDbyd{gV^TORg2zCUXPhb}Il3Nifd-syN;6SdV#8
z1O&olwNnzAI1RDRE+YFP&`&|5k*5~^h_@)(99v$`A(ud3U~orKH`(rgFGXf~E-V9e
zpxD70+#!MLu|_9`%KPR+0+nZQ?pd$hiqkpBCp^ZCX(z(heNflAGQ%4x))~2nz41+n
zF*BjF{~E<x5Fq)N=JQ?&gTr)*o)Cap?9imns1}+DX?-iYm*U}N-zTZmXJhZJg4hVE
z<p^owv<C}may4ZNX_}AzP~eD0TZ)?#PYLs`nyorsOS(<KKu1)pt9D}9b20qB^P0aA
zzK1aX5>FN%G+}Ju36n4mWZuF*!NTr9Kf$)qv(EYU0)Ai{R4IlJ7CSsQqH-#NkuG2k
zC_;?!MZZ;92^~<PilJIl19Y8&K{#QuI6xgxTuhlZh|NX~tYlpDKK?>~f0(yd*T(Al
zqzBK)WKpN8Pm{%AC0}%cq=uUGJUUaxO~_RPi!8C9ssHI}$2Tu|`JRH(ieY+FWGvlG
z{^TmX1hDNxYiwxSA4`p>M$$V3o?^$hb3P5=NJ&VOZ5~WWe3*<P`H-Ib4xW<6j=J+;
zKj;8iqmY6$ZBqwk;widku1$PX)c%=SP>Gwkuf6U<v1JIem2OGvpK5y-0w#v_;+;Pt
zf(WdXx%UWB?+QUZOLhNd-jj{HH+v*06v^)(08XQUrqi>Vyx(X_bH!HIM_2u;C27%9
zxh_dL7c$(6wvA@a9#>(i#crZ@{=%lX_JMaBsW59cn~xOjaJ3<DBLroUP8UEn1aTKx
z@Y8VxW?w5zK6||1J>MKbxsQOSJLr+KY>k>02tC|9T~7USf;LU3@>7|%^iKHSR`W6m
z*yXyxK=nEcaOV#3oeofJ`C;?{qiR#}U$FH=D)pL^S@`~<U2lXMBsCQ1(+->XNUL3U
zI`7-%_NI6EQ}U+W?c>t|6?=utZ6~2ujc-*tZ-p(0s(s4@a@_GCs*t8K$qa8uf8jXl
zZpCx=aw89~&Rdd}jCt=LB(Q%DkTBf?6r)-cb7;j<*+a5e!*C@NPc^K{FV7n0X!iMY
zbjfHN-=R561S>sl`+tW!u2gx&_G2ds*ffW0#2N0nk3xn^>E?kLt}hhKSn-G``~s2s
zU4fNSMO1)1@c6+Oi6Yy*m*QbR6CTJw!TT&s6gCNRVWW96Kpb@z+5nx+zjM9|kkMS8
z3&RF^;N}a&o5|e;a5hf-M_X1uK`*}lTg8nNqp@8H8VUa`shvhJ*$?;;cc&R_R=e_K
zB_SSl*bfqY0uWzwsJwqU%fW`K4u}dBL>UzaCHw-O5i=)($Sp=qwCC?0Gx|izFbfO;
zGVWzDmUPzsc%4b|>Vb2>&94W`FP~M|GELNy&|kFSOD>&yjpp!SLgLG25dDy^b;gJc
zt`-%s7WJKp&`!)>%-oo)`4IVP8dpG?Ztkpc?c#_d81+2_7vUdWCw>1GQ=#L!(t#r7
zrfLutJvTw4eFo+f4exLvqmL3Nulo%)y5U{owi5oc(i?1oy|M+U4$HAmvz@tISg#5=
z<VpRd(6xMm+$K{SVZAufy3%3QG|<NSuDm;VwS?G)o-jCjMu3d{A(}e{xVICszjqCB
zzU_t3xQNA)MWGGOh`y2p&|eiOT0<CG$_z+8V*OUm<xt3uTDMqU8Aq*hUZc2LX2&Yz
z95H-9m2hlDzmEW1x67%jmlc|I1V#1l*RKsX`)YxYHlN_v7EZB^OQOr_k-R8Mo_V+u
zf)eUaw}%hWr^`Sm(1%a>E?&tHx<#nNw1EQWr#lqC_D?^q;yl(EokiB;Cdz-#dFNJj
zk0&SIolg;~DW9F*f({=lp?;m>@_Jh-vbSE9=YaQZTqQsrE(DD!EK|tT7gWQmu!X1j
z+v8SdGl!iAt2TC@YH#Uh1FtPY1*f9ZA>y0U;NsUz^*5_yDay}a9)~zryKHhfGRXsS
zX?i&d{zLVYcPINdl3wXDEcskBsjnlO8<dmL_)@#+S3vWjrv_>0q-S<v(6x%^r?stV
z&QZ;Ko+ps1|5Q$_N~}snqgwDR)Xgl@(d=3@@sHY)CyXrN-CY}c-a72+)4?`A%>Nj+
zzJcH6tnc;t9!simFtTiXz#dTbZf-9<^lxtW!5{5j*03oUv|W7$F@wb2jotj({^+|H
zLT$~=_aoF>fg5EzF&NX>o&8gx5~_{gu?yY6<pOA19FSmHIQP=WO{&*eHK3XB__lsJ
z^1VWqy@WDSp!^l!P_L_VkU@(f0iAFr7bHav7{Ec>(U{!`Vj*V^Gn=RE#Yx&&fj5=<
zZpH*Sx3e+Ky*#LGlgs<ldf${`S{C~DW!EGX{Iu~$h;yu(V*bl(vdejPs8wD-b^dKq
zm=plh^D&1`2{U@7dt}25eH62A82HwQS~5M+SLC|@zd|BI#rAO^jVc_iVKu7*k(DoQ
zYYekaCW=ju{X2OAtE%HQ%cXIRd`j+#|8^t=CfDJZni_S|Xe>Mh=C<UmMFQ+a+pvGG
z{#hTp*vMg^Y#)aDX?b6fQ*_}UyDwh|A^=z8b%!NN-lM1y5qtQbe<wDtKR;hR@SFa+
z{VBM-+<~OJKC6+a+A_a&^1OCG;%<vy;rzMkO6$I<|9``#^rn8MD_@EeL12YazdF`S
z2wL^#bue1BUK;KXoB%XN>RsBNvrYY9sr8-GGn4%7ZlxKZ%KS-t3R7OC88kp9-i`*C
zgYXo>!ld0AL}|uYY!|Evaj<cNEAH-+ow4J!`>??i>Yww?k;o`B)*1mK=cjYtO1cA#
z^8bfyRrDWT?cl#WN;YloTEG{gshH>C6fq{Itpz0?UE*RbU!@l9`G)Q@Oz3mj=*Q9y
z1d`3<S^bTM?28F2f%TaiHPWvguz4mAfw;*gi5^n9t$+T6^>R~%MumV(C2vp->*lV2
z$+n)wJh4s}L3n)~y}h;mr3nOReJ2jSsTSGai#TdqDiTxfpNv6n60%g1)Lemc;!60d
zjCkcj+<iU*nRt4XGE@tgw?*>>a2Vx6(MITMfmmU+<ev0KKwGmDTDcIiuDyhMzV4r%
zS@rxfP<ZwH7vX$2_5AZ}SoNq8OL#S!Bgub{SI?YFZZ#UhP9r4Jb)|;167xTmGAsiF
z&`x}UahA%zVUFdR;o@2|iz?j1<bp#o$()mzQYb1_HqKDQN?xOiS@UI3%P|x&-^?|-
zaLqW6rDA4)mpI8P0SMHCzV{+aJ~bjNc|<2V(3bpHrQWlF4SO&(qN8Dh^p#W+AMpxe
zp2ss}r-nuC*=WToE_4cq0|s5ELjG!S)$wj#k@4+j9{n08A;ZbqGKF_Ysn|+52k0D&
zu0DqqA#ccDj=BWp(MRWGGCf`@IK!l!QXkhmdRb;5rw$fu)tans3(>$a4cU&Y5A~NP
zF>72F{&+?ulj+zg;#v;n&ktI)wZ2{LMfGn#BS|Jpp)a%}@-<qd5mCZz<Mo@3d||8|
zlm|(TE%s-vr2WKCk3qYF*)8jf8BWd5TeAY9h&!RW6k29?5*lGRhBm40rfBmx7?FPp
zXqd7Ccr6<%hOiO+IHtybuss6u4R2u&&abPOvg`yv8?ER@>q95p_L#T+19*>^cX6o=
znO|Ho?H39atB2OJiPE2LZ6CtF46g1PH{8JQxKP6&o-*}9AR65DH8E{JF1>tZKU)a|
z-C&RXyO;7%%}HPO|8dCvwSaP=+zfHiBJk1tZq^2PyD>i~_@{p}lVr5Xf&WQ=rCu;K
zgf#k68Nu~E$@~L4|8!wCMciKc#K9yU=K3gfs9+^1{{~ffP_!Ld&*t!Ar&o{Nf!iC0
z>TZ$UdKt=faYdy*m`IHt6Z?Lm#Ds?8QSw3JuAT|$aiY?jq{kM~G`)hdGh<vy4JgnE
zgI9-0l_zzEr_F+>v>V@~6f#$JI1e2!Mp%XafQV9S8WiL#zBx-Bd4)GsaO^1iCQzo~
z_RA%XHY6_W&9X~_Tb2uia<i8e#YQ=_o$WBHndgP^lp-et>PeK!j!hUUnwyU@i~Fpl
zxX{I6c|+~yJs<2$W<NPnc<2auA4osrH%M&ns%MLeLYee(HqJ-#05)C+W609dDv&%5
z)0yMp7vuI_M4e%&-UT~bLwfL_9Zlrhb)at`IQZtE+-ILXVus^6IZytR9v-elMLq|v
z=dY1uAii6|rNDq>g2+2t1)+foXi>05<csyLE+vgnq1AGy$F`FxF8To&L&~je6XqFN
z*^`>fMf$q^Xn`nm9*3(%;Y2Ag2lbPq;0!4+<cz4)-2eM`y8;jQ;}Al6KbX}|agoiz
z#8tsJWO^B>(NSvUh&{7F%)#2~u*V_3o7Gt14skQO0g~(e=%SkGJp?s$FAtR@Pq<*)
zO3V;zg_Uby^^GL5K0rrk0KI*I5rX#G5SMPk?=C?HKa*ip*<^ET*XGnn{Zjpag9JvV
zAw9WjUutA3(*E0om%KzY3~;CeGox)|{XR;K?orhZ*1Gqc53B`<N~^s%+e2<+(Fc*b
z^MEr*A@qD2BzdK-Ug(MtC{#5ju63Q;RsuDq>+#tEu8f*$>14q4Cn#70wiyv9*qTcN
zm$@=1z{^e;7~~i39$M;g7|l1tk3O-z%G6Ilx<P{V=bs7}!aFE$3+fs1Z={zftY%Cb
zg7}(WuYq<ZKE`L_HH6hD!Xd&TteD0~*tGH`u2Z$bt9I%f4;l^ZMrXu{^|0MY<4`Gx
z)LHrUb%#_^abSO-Qetbzp*ln7v3BHCO}&2s(G$A~*y&WUfesOkrS<3Kg+%pbvaYI&
zAF-qHjMTp@?78f6iu2Ef42s@ceJJDJAzYEzAEYxU9^qrq{)l(Lg~zE_FRSHTKv-r|
zjTYkd7e!VFJx3;Zr1F|XkkH|sTmL-Y*#0BGFFn9|-*@3V5qxU@Pr4Ha<8bGpgzlXJ
z2Jw_V<<xRMILXnmRg~pnd&<)6tGdRhqi|5(a;8I*bNg}-=gh~*gT^w)BF9r}>41&j
zR}7<xXhB;f@P8tqh3xt35y^Y-%7f0a<#fMT<Zbw{sYP*<+BXG=GpKEZwcBrHY1sD}
zp~Eig$4K#&HayHkM`{`5&3Fq_JBT2F|HYF(i(*A_Z4+s+wu|G}mzR%7`tgab7}|M)
z)5?bxjHP2M)3tpMo3&p~K2L@xvQN95B6mCO+kQAm)DOr#h`S&RAjry3m-G9_yU(DA
z4&hH$zHb3xU+vvMEAXXG1!GaV<s5~UmUwJsVwK6)qJ<DR^X)X%<!Ux?RqkJ#>t6aq
zyj@J3D(z|N&q|`4U#YtXJ35kFSEpvx?pB8iD54cq$LCxV!DuvGqm3<SjL342RWqZv
zHd>9k-G1&cJxJnU7(#FHB3%C>QrFjY9f#FdUs@8ud;W){Gs{$Pbg3fh8*aJ5XwfcH
zJ46N>em$Ib<3UA4e#;2UDhfcb8m2%G<_ynMCq$Jdp9PYm<zjl(?c7}-3rw@EO<Wn(
z=d{)OGVqW2g>~y~8)eU)7i@C>c)z9Mq4=ZyuYt(Uwe=Eaxq?{-X<Y1=F^wyw?Z1kE
zlE-Ory4m~7^W^H6RG|ruBX!Q`3M+=BNDPhcGs6eug0ET2RQ+j=7CB%|p)|RuaXRAJ
z)Ew(`L+*wq_pz}z=IB@LFypj<+gp`G%?LU;OhkloLV{*&veARE!u_`gW!4fH%jO^V
zgV8GPgKE3DQ$;|3gh#Nk^g~n-{d<(WwkWHe_AQ3)f$JOeFwaXDSY5iLI4E>8k%FY8
zs?-}{7*m89C)95vPaz;8VwR2iZl!0fjNNuKvn95J(_`BX$CDM3>JPV+mKi9zUe*2f
z*R7OW)WZZ7u5AxO%$P|StaQ&{MuNxJo(mi8fPk;ch2x;nKg!hIw%cFt@2^Wi$F*W(
zoDgaY%EMBn9SN}$ZRqCzcEov?6=VqbSIOoWo*05N)sD>RcLJyk@d0WYL(i_OjriL+
zt(s}}{ys?z?zgdC*VBGnn+**oEz4IQN*6yJD{S4KmbXZLm{io%%k!mUFN$QAqlbrC
z=?95v5S^%><kNomd7o2lpNvu$u3?Q~;R$YSFk6m}X=wKtt=4zdt~{0fx&NDXBJMvl
zNJC1P=p!%sNdfemZGQ;dmyVN^_d2@o^M;H~`=krIs^*Lx%?U%VzHJ&=Eshlw;)02q
z&fvy22a!DUfCs-(v*U;vb#|cYec$Rw54LNxrXK}jk1_vb^c!Wc9Q5v{GJvDVz=f0|
zjB*KDF_$A}R-%Z&l>RZ(&owFDhM5#~cAe#JYJTbvzXx1qsy&z4Q5d^4W0hU`V-~3j
z`<62z+W(O+HeF%h$E1W<PVA0dTS|!nD1mWf7VF@g&B`I^4Z8eTf3tkEkEFX*^}!+P
zp2)!iWV2O#jHWtC_1S#V%V5gUe7`r+QG{mYNRz<~f+9%2)Ny=V{E~^nvg3y;hkFpR
z?MP0J5r9y4@S>-y(bP*s$L<~{5pU`OmTU5soy}z6S*&%e=x6iDz#t89L>40EL=5e2
zjJOt^F|DXsGxxXQ-r|U6m5f*9nfbK|lZ78djE9%r8~)(<!VH9nq!CsSwM|=6k1vcP
zNacC(ehZRZbAU6GVZ1D4;%Z;C6hqf8!5*&k2AHHDG4OwG<e*N37PS?zy|^5*RVOiV
zCgZ&5`t`>Q`C|DS{Y&9<rOfO}=c5sh?A891qR>{xrGd{z%jq5TdSg+$;N~tZ#olu0
z{E0k3B5z~ZI4{y<3$-?X>XM>gh3$o)DSEFH@+-ceEMGEdZr1Db@3uT4Qhn3p5&7-p
z3tZS{68V4ILe}K}xWxTMi`=8XU6aerU0Xe_l@tD{Wk1%OqJ6vV@5$HgC-il9^9lM8
zHuwtDBo3P*7v%FYhb!OrzPLbTW+(yZeSaU%t;ecDt;wO70-FXnTjgFDBusWfen#U;
zCm_S0!qin_G7tn>(1=^J$)FUGUk_BV0W`40#lO+!Z=+83r>X;9B4Mq&R@>Sqb*01^
zC|v$$L#qgcyF`jyghv?zr^Oa76Q2<>c9|Et$Rm>=@KlkZ6gwbJLQc$y_I!}^*%(;=
zjNz+M<!@P9FCv}W|DOa@sB~-ADgCEh!m<-wNyu7>>s<-+4e}bq%ju>!7XTv!L1rYh
zN^JNi#e-6Upc7KM4dez)f$({GB{aQ6BY1)EwR)u+{~#-Y-*IY}jQPK6yD?%fm=S6a
zWVTRO?DVG$kER~JoADcxI>tbnmLqllyQkD**QLyOIaXg4=p1$?)CowHFsNw-+{O<O
z{CB5+LZSX#-lL>=1u$>ZvWyIhsmmcrt@c0DSZ-?EK}Zk5CRVw1=r&)q$F7e2Co^%T
z-|aX3K#;^P#a#y^%ZXSBG2cvG{5SD}1mUfIuYD&9q`v}3hhI7MHpojf{8@tWmk<lj
zyrnB7m`={lX4lt;VuTR6-~(&<-gCc7#LAEV3AJmN$ZRvYKnGKL`D$zwXQW*hlobeD
z?WDdAQ63C@!Td=znawqN7-ZfyvgAVHz?SUT=^?}F*+B<-OV9}?bqoZY=>K!2d!s<8
zaj5M~8Fx9?Q+{XIp)rCmgWw?GD2Ca8Yq(zl@%*KBDG{*S{d+$2Y5gJEKX@c`-dbvI
z111gNg>SssSqRKTA}M4R=CfLrL$MaI>?Dt}AncO{qdGMW4g5yh7yvCuh_P4?iW~rq
zjEvF<E#wv8HB?-sU`Cw}&85UOv)Z>K2tuggrDV^H84${jMLvTP04GSx#y8YXs?9Wv
zEHvots`&e0%DhMO7KX$`371zrOfDXOM*{@F!@(;qh7-RBfrNuZUx!D(<p)8qWtN&h
z)ng_0MNGdo?Jp+t0znUe4T4odE`bh>PbK<33;qv~E{yPGT&9W4$D>QL|F~z43TG=a
zN7U+Gu`v$3<j$Hd{!3*&I^tCtbYYgF*yY^Wf6V6`*^b?{HCNh96ID2q9$VdWNe}@u
z80*I{e`^kEK=Uzb5v>#L{|h&VxYbx({5Q;}e3Ip#LGp_RQ-Sw5q9smDY>0y`m3zAH
z8*kvIs|7bVf@*I=qV`h6(Si0wK4XEOv?$fMI=Jb$ObKlv88@K~AQr=x%&fU_(LiS#
zcVFPm?}qdsZtpT=YG!8tu5as$fY&tm{;ri;<>0xksFBfoL1k#*O=xbMG2TOz>y*Y@
zJ+?#b8qrcmQ-yudzk}6a%ikjW8jOP42X3NM3_XFt{C-$yd4y1$3+z=1*ZJC;5c;Kl
z1zjDJmB`2zL*`7IVRV)wEkIpfv;+nW1T+921ht4*y8+=obZ3N^N=OU=xc@`xUsb^L
z-5Hd<vJ4nwgAko{qoNr;K%5~X^ag7*3n6@Hi`rJ3XfDS*Ran9_J$e|hC=bKWEK-zv
zKzLYgn0jtssYn0OsFIfma3+`}+$B4#jILI=7Oh2ic+}!|Rec*Zb0jlWnAVe<Gcfbs
zBOPJ5Jy>P7JkU*BDF&kk{>r+IWKbS+2RMJPKM7&QC+BW;y@YvJ;$x@`*oy0qDv%Y!
zUR7VMUnuJ?=;X{lIHY}Uda-^1$@eU*y(jW+Lu0!z3RN&@sGQDcgF#op8u@)&n!8<I
zo<LZE0VaCS+M(_Cz2Dl&&t&olkCKV&Onqc264F)3qxsi=YBlixldG}OA&+baEGDpn
zJ)4Q|XP^^zs0u}ke7)U%3l3ze;-j4~$ALZg3+VNYM{;+g@Wg@zyZWT*zISa|yWv%#
zM2P&W7lQNe7jkp{F?+&=Jyj+|ZU+r#3D2eLP}K8`G<!yTMn)((Lgdy^epX&pzhVaV
z04&=ZaJ1OA_fmlcu+_Ty1f?{jwry+}XEI5~O0d=-Z9`XWV&X~v&)?i#;9sM8cW_!t
zS52%hw-iiGAka+}tx&CK=|4`H5e2}McaqU(ar&l6IP6yluSb25yMz()kx%Nk$|$ar
zZGXnD8R7JcIJ!A=>j~cHX@l4NM1>y%{480p&S@gN4v$>)aFR^eUnS<W(GK8|Z{;xb
z|JKji9O+DT#XBcc4vRd&RoirE`#iTzdBz30ev3bDuH`{DKXhL07O5{Rf<E!C+O)2c
zrNCd(Yy1}M;aLF(+j&`va{R9hgpF1V!hP2PBAm}Z9N{h0ck=*Ju{${y6C@25U?ghs
zKCQ0W3X*U#;?ky^=TT??H)mO1fVKC~{cXOWp`K{pM(D?&7-@}^IbdK=Y{X;|#NKfe
z79*$;a%UKw$WE9Eq^d0yX0qasz@0Z8sBcFw#A0<r5nzJiFnhhbxNcqvAV8M_K6lSQ
zVum;W4EVV5ipXtO(eBPZKZ3dgjt&lA-1wcAO}#OipqtN<Dbon4W4~mQ)J9WWHu2cQ
z2l^sM*(G7d8{OXV+hVCYFZu2pT_pSm2EM&;Mx3}q2mcNKyMCkjk+<1#^YA?Xiv6(*
zT_ZTefALpnVvg==6A1OQ?_{`o)Ya$A3HYX)Tlvpbf6c%C52F8fB4f6U&-K*M19lSm
z1E`O<fOkPp!5P|z{^D007$ZbB#Q2mq7c7R{l*`2#;NNLERnh**+IJ?U1iJk}EPW7h
zywgEsThiwVz5OxB;5%11LVw5CYdo=R?3%;A_u*@b?KP=OB@@RD2W0;`%=^mga&%Vs
zCjIoG=`G~}f9cJ~2gDGq)>lA8r28;GgD7~!CFdjwuc!&#%8(LnH@x+1UuwXUCxoD&
zxkWqL&_)XHTz>j}bP-YAZ>uqo{!`o~e`{Hxr?V<x&XYTSs)eUH>}XmP34!$FPg$0;
z;2v3Fm_|HR7)_gme=i+B^sSP7TQlJ2)<D~j$gDk-ggx7@018ZvS>Uah{ZR^(81v>m
z9D2o7_DGE$3G6sOb+Y3bMp=jnI_C^3E~T(y5K`%bNSx6Js<(zhurex~L-5jP-gvB;
z3x=2rgh>>F)=1`>(385u!LGqNeON6o`n&nY!n`dSRK`&TCppfIrU<<_@0%H7H95kM
zHC{=7bvP(W0KvLt!Q-E0aVX1^F}DyBtKABCG2bI>3EO5$oaN0*s&_k#Y<;s>S2P$U
zKi)glm|Poc0(?-6kqvqo52GhcbaLPxmCHIgQ#@#8$Wt`)lkFechN8O91<GIJD^0_+
zFO)L&WvR*CK7H!jq&yM^zRivDLDRGIqK)g)YGg}j0Rd-%rV!_S)L2piLCTXqmCwc8
z{9<=h-RMkt+t`Jwx;rN0{h`%vD12PG3sGy+pWNq+Sb~Rq5AcLTb~MYBtJyUykDvzr
z`fWHIoAy9lUlMGYUq_o_#=EU~jvR%^Vn?IN%6(u3uBPC1XRu~raVpeiVa=kBqauCV
z%PXvF2S7kfpq&Hh;Ea;OVm;7SwPI~P1FN8ig|L48!jGPcp`lhLo!M|C#fRH9op`U}
z(;(*7RW?=TsNK;l+)COs>CYdIuD}d%4R);S(5+23#SkBg3_)y(>jDo)I7+}5hQEv<
zpC;VE-I-nq<~3#Q)czwU<<BEu&V0p{6UGAR3%s|p+~%pcrl=+C%3d;ItZ3o1h)#Lb
z5$Ghx@J22aoU4kgZe>VR>nHH{YGs*eB2QJaR#WuC(6rjl2s;Uai2fK0^mH90E6NWy
zAjN<fqIyd{RPqJmzgIb=>kjXq#oXx&9s%!k-hhG*;jaEUFwN&`)>nT9J{e?Z=o;gb
z066Vun|aDU?jpmUkvB0BAbVb-RWOBjxE6}Zn~+>QP_z2@rayIe&h$fe<xXTp#0CoD
zZT4lB1bU_i#ireBW>>}mUNUPm?W3p^L+e7IbQ*)1Dw2bh^#*E=ttmL_9#IT+gGU3{
zW(t*UA{+WtQo@<9623fl8DU$L^E6E}K=xHVzvNQ1Nur@JpD>xw+l-YfahI^Ef;@eI
zF~YxzT-a~>HvG``z~f13Y(`6zm<=F|1^VpMQ^8By+aAsYGtH;1YH{8se^(xm$<uPg
z;_UOywn|R;Y%I)xgv&g8rE`7Fat-GBU^onyQD3msCnC{T?V?f4pEip*;8!*W6qmLh
z*rUlABfp$gK0kBn<p228v|A@~25QvH(a{_J<&R+FxW7DNw4{@`x>S3rz2ewhlsVlS
z@0RwpKY~imNTA*rv|*fX-tYR1T?<viDnV`89~hrG6uyf1>#zYGH*2P|&?N{Z!@Y$`
zoFBDN+MjbPVcq-Czpa5c4El@<fNytSLENNbobk!JHp1?bYZ7x$RIl#5T>EbKN7C8O
zPuM6ZA#KX|sU;sGosB)&moaiGU3ey;UQGB~4O_}r%Od;XKInXWk@i$SUgPdEoqArG
zHA7v!77_YuTuyW`Jx}y__#lP|$^%n78jrHw5>w#{IcA~7%<xE3xvc)cF@?uh(eB}*
zRuRLB;LQ6zWZml_7*Uu-uXF<5loN{3F4$Iqz#^>HeG6uElS$JFejZ9IRsCmrTx679
zWj4Fm$|fRRG|XD8mDQ$iy$=bgUyM4$kXP;>waSg|GptYBLb;NwQ6<9?oGH|eJNgFa
zqrXkA)_vPq<AlB2f0e!|J^S=+`#dwOP9phsOVZv_zsDD#A^Y}7$`b6n@ta(?+<jEb
zp&ibBb<|5-gMy#FCHk-U;$9<xvj=)|ZM6k@u28~UBSoJPG-JYCqYyFBC3E|*0M5Ve
z_xV&n)RG8Oorq{auIIsl4ynGR*lPlYYweO1RPa`?)7u`oVaVRHf1?!A1KA0!MSf}(
zU7<p2v*bE&Sb*S0{t&`$l521c;N<se^E3i^J`L;%1^-0_q<JIKpLC*ErT-1|f>kJG
z4d_14G;2ER)XLHpm+#d*jqW@GCSYE%_U2XwPU!O0rdQOkJ`jXhPiJFt8td~>%-Lx3
z0j4Car7XYx_pHhJ0oFS0TfihEuq@CCW<rI<v@MRj@-t^YM5327qh12ymnw2|Rv2G`
z^+Cj7$@_q*SB2O-IT<`QYWZh=xVvg$kPP^Hoq^)zwkIzl+X*AM<|8ZMw=g(z=%bNq
zD5<XUev=t<)}nIUu<=}+Xy~*3cWLc5hs|oS>o1w`_kUysKZN|4!FW#i7f&A7;>}hH
z9G2ZD=_8i@dqm6NR<oz*mJ1PtK;YKZV|5wf)RM*<zY}iv8r%HOQRyb0XT|zWhmoag
z{y?F2`zOyD1r8U0#Xkm!Mr{JSQ;c(<jVaw+mL7;$6O&lrsG0slJB9J^eP&a&0}Qou
z#(Dt0_*HmUe-_R|q+X31oLs!EbZdmB^PD2U^XmHbd4cprOl3sR=x7qVvuJA~_!v(;
z?N4;-9Hyk&X^nj5_}{<x{9nkG95t8WztA;fEYAXZi(T#tf|q3g{S>N*7ivgR6LaEX
z+r9;awn{b|YxSHVolDq?#de9{t>8(P416a6=SfIO6u4XM-;7N5>eydT-J&moK9T-o
zJYUECk5Q}wK7ua9mqu4P4Wb&v&1Fqq8kJILJJSr8pJ49Mc8Q@QggpZ+nhzl$kFC?K
z%ZX}BT)CeD^`aEOEh(uGzL|#_v7T1#-;v$VjX;RFF^hr*{xBjo>hXMPNsSXOovap%
z9~aCoheTUWWM2rIUjj+YG_k4N=9z{*`e>(BABK~cv!aHt^rmUsj_e1$cyL>RXjtEr
zEYXUBVA?>81R=7CxEY%9kP`XT+8J9jkVPo<pdyK(Mp-(6vg1V}oUIl9G9>Ujg`7VE
z#F%-V$<N_ZdqjBMr2|CIJDjRPZpz)%jG=8^s}^PCsWtD^eQ(doDqy_$pVTA@zd0>7
z4%fKj%|2AwDfeMyvGKAIvB+CG+Ga;=4f3eZ#myA<xSP&b;I_8<*?y6WoX=?5LC~SB
z2P3Zf(~uDX91dXfgS4i5@h+y$Y6i0~D^pC++tbbGgN!%28jpvcFBe%aK)2tU?q!Hn
zOoGDV=@s>=-j8xqvcKYW*F@zxM2@)W+Pgg%10sr7CywEkMG2UBgjLXLbWo^Vt72Ws
zjHzdQ_M|_nz$6s4_clfI7AR%9KwsDJHVPfvdi*8;Khkea!5gmjw>51tskvMP49%S#
z>zd=RzMkBqu%#*M%hIC1^+;1)jPxQM^t3s@NIVGwNruK8z8gs$=H(fdw5xwUspXvN
z1g5L!37Ain^YFPs1k><mLIp<(%1I@oYM-?nY?;`A$l4b(NG@HJdAG18TwnGa;)uT9
zpXwq3yN)kuzp^7gBeoqMuY<_}g|xGlle^<L4^Jh7ccj|>UN~?%`qX47I)uvF7#cjI
z&?*Ci+WyCW+2u-R8&5yJTqBLr>r#!0Sk})LDjX@!{YVZL!v$1W63QBoVDZVZ?|r04
z=*jNMEvsjZuPtUfTb%SD#6d94bSu@T*=#F7we?DMe^wc9@us(Qh^ec4&uCPdl6;az
zljSkH`rCu6{Z~C%ALK~z2Biu0ENt6u|Id?%dKZ-+Sd@j33`}TAQKO@yQtaH_LwU!y
z+GUsP2uM+aIRm>1F@pISg~ksF3eZikAXx>OzvbAHA_a#3-4Z4aBLZ7T9UwA!G`J=J
z6ithEAf{X5-g&Y6l#%6T1W>lLWJ_3|>vk`(U^D;0Ia<gXoyoPGkF-9NpI|mDLAT`=
zjsKJ?;axTNIAGeAQ@%YeSM;t4uRZ3QjZy8UUb~o1ah%ShZkk`-U?p??Dw4a2=M?=h
zl|zhHIwGhlj?>dND(}XR;rWcKB>z|n9Id9uaHt^q!IVOk4j16bG5!@BsL%bW2r^`c
z94dq{P~1o#j$4x)9e-b!%7UHoJVw5JIkqL9wbIAyqL)6lDqXUdlJOI3<2^MU;Yf3c
zcv^|IW>4|Z5OaW>)$5DAGfUtreMbJ1uuPIR;b-eX)1~cihMSAX>EH3`jVT!~K%#&-
z7>!xpe6|XQiK>Xh7_k(~2AnI12^U!R&h7NvdDB2Jl7*0WK9fy!+8Ox6C=?y?U`}l{
z---g%jGQp*rZg)e8RLvxgMz`|%v0v8k}SN}ENx<m_g7s}KO3+N{E{V^l@Lwa-!b43
zyD(l*R#lR}n+W+kGvX|aT?hTDfEsNA%-4$VJ|DcVkTmmUcOZ+HpWkOc`x^rjO=y1i
z4`+H9tB8r9&(pcoxh(BiVRKfFE7lJ5ykG<t%?uXplHNZS+BC=Y<qkPknpad4s|yM;
zEl#}8>xS@q)pe#YF-E({Oqy=Hn$3w>w;=ow$%VY<s57{48!G(SGgq(u0Z1;fh$@~b
zWn`77&%9iXO$pQoZ%--BvTc%z_Y%MwPi!<UpsM8F=h3DgDC*`>b5oG8HP_P6gLVl&
za(8;_(r*1mg#pIz3lS+#O<rQ}Ewx@1N5fo71y77~V(q+~=zM(4mk6Owx|ge(4tZ~H
zm{e*gc8O+gW$zvw-gc{l0jBqy4XQsYXLFpfzCS<GH?(|f<9l>I#dvvFswDMdoT?sR
z_#JN9@97ecv8#Mzbye@aa^ITijnNCKfQu%mTayyIE0vPK?K6Hi6)B%!f2wd2-xJUJ
zn&dEls>pj@(D<TKI20m6=~8um^3GV3Ca<IQc?mA^_=+bG>o3p`06KuSQ!Vgjq;O-f
zn5Y0|T{ZY3>P3z<63Qrx9364OPmVCnA)N)5T=ecNnGE4`%{tDVOpqkt7n*?m#j5w1
zYGy><Z5sLYOb9>2&Icl>BH@Nt^@lKc>cUq*Eb;g^LPZWYyK447jE9Y#t%O)O<`bxy
zoyy+G+vvd4qqE8@@c9uUBBJkwlS_<D-a9aMA(9i`k-0&3xeR-gMBf=TsQNvdwpbe9
zM^K&A<A#;hPmJGh0DGvnP>Z6*dYndeM=O!&;eZEY$N3D30GGRV&b-Zk@gOpHznw~W
zEy9PWw2>yb5!4#|8ee8@MS@TYD}mlb1}jPRR80owbzUt8NK}HFvTSIewI^wKr9@t0
zkaLiZr;VfM4Hg8^+clj*K|+#5KqRq5UM?Gx5|J+x=xvPrs@azLcdNnY40c8*7H<{A
z@X3t2lbb0?m6;(GqBX_o?^H8MTSaEVu{`fut3S2X9qXQ?q7A$mPgtvQn=o#E?jFjw
z1cdv3&|>@DKq=<@Y4YcB*>^ub<$vwcrL9DFiG2hi7Zg~aK_-8FsPREBH3UjOPP}&=
zOCfeFao!WOhG<BFG2=yYtqVBZvk%|~Lj<$0>szu<^scXM7!7K!%k86;3z{!r84|VD
z>MCFNG|o(QH7|GacnuE-%Pw%-GIo7}x|^X|N*RDeVBL>=@$aTVFoxz1^r)xw#hY#!
zC9;ltS*-m*82$(?ltph1`Sq3;FyJvpgauXo0p65|ZPAd|g(nWXK`kW2$`?b>fUFJ@
zBn!giMe_Ljl=}yj+C@PmvO*XfV(R)(dhQcEv|8L=aiHR`R0dx8cW+6!^;Os#b*n$L
zb8dejfn+@AA;wMYBiPJx!MYRCai`L6WGX^JonC{K{wh^tN*Sc@^>{;lpf7v9sF2~F
zrHbxgSReL7CRJJtJR?*Pmywm*78ILbh4x_y4~5kW$tR{7iiJ4kstQ5FVFIE|<-77^
zJTfve-M7^0{nGh_454RaWj_pB>@(E8ue-_M0L#ez4(Ah4Bp4*>Q1J4+9Cq7dI^SoR
zay|XmB}gBl<F5s@gPwCGF74te&o1^})eqbZEp6nfz0{iNiNln7uVjQ8+VlvWH5}YC
zxe=lbdU{`)Hl6m?^4F#BM3@vM^`u#3LolsSi6w~I4O-Qhs%I#8j$>vg_*rlKxmM`1
zfIb)8Ru48DJ?<(lLbcbHo-D|omF_ommh+AQSaxXFC}dfq+B%ant0J8<l$r)IKNq7_
ztd=3qlePPt>jLJq%%jHME_azj`#lmzpOsmWIXBZVhEvaX<T<OPMsfW)a~8w=+v(x~
z7!q<rZS0K}Qy*<;`=2VN9lTWeAkTY2z*R`pi#q)Ki$lmp`djYCPhR(o6ufsCHcyq?
zpf5Ph@2$b3z?WgsWAKLOYit;7!J7CX7;qZMiBYfu3I6OK#F27+4f^M36T%AK0}93R
zC&Qz|^^i_;n*MzUB6O`9-Lg4vR|Gni)a%kx2md6)Wd}i~-Qr*Wi(k3E%O9kifKoTp
z#0go`>*8!#K~Ij2V&ihvTT?1Y&AV%A7WEHPx*!5Gt{ynOm`)ad@z1Gg8vAZq>%&ep
zfeLcbX|V7Q?tX5OknQc(QbV<GQ}o1R71->vl@8^^*$R!Y`zp=-wZbNAC?yR;Y+-xp
zX)L%p^PX(DWtlm@%uekp&hkVbfJKpi8GV(#ZVCaT$WhRq$DKl$Tw+2>4vx@pdBP;y
zBz&nN=GWUtO6SJ}`?$4tNaD}#$}+7sYQxu~wYOTzN9K<sJ6PO*jZP)^jxn!AJqPLZ
zkCf>$kX%pHi!pr`BN=*a?P!d~en0VHp*3@*oc2pemloM0IP`H`TUv-U0ZE}52f=>6
z&<|f?G91KI3)v)n`P%lm#8NgrL`H`nl0$BYW*2cf(Q84TCB?njJ!oLeJtky$c?}tW
z218va@mI@L@lNDkxbt9?8cmJ*F6M+~>XA4P$Y2b<<O;ap1mcc=CZhlvsIF>L-U(jD
z)lnG-M@mK}Q??OQ{Ev@8z$FtT^pEHfqKJtXnu5C4By-N$D>B<stoUD^q-l9NFsTw{
zn;%)CAM7G?z!IDME`Jbcb+~hGQK$ViAM@z*>f{uYnLpiP_!mLK9YqiX{65xc#SJfB
zI^AD;jdIPylvb}G2%_-<)lJb%ZFAkb{Xy19BVT84?D#jf?;yY*K+i5(K*A>_czw>j
z<1K^z>@-<>s%koa*`9CVP@<KC6h@*T!?}}*kg4OB-C4j8QOW(mWvH}wT00e`vG~eL
z;8U%S0_idFkit3ou7tP{ay<jddQ!ap756%t+U9+Jh~0#IN|tXk#j{3o?~gaT2~+vR
z2bJ%D2%Eze{kk+3up{4{r(DillIYw{lvtlE>Gc$bi#-(mIuuGY=Di)LcIC%HWR>1G
z(VTBAA%e(SK4nvtu5#jKh{!s(Av!z|6z69wmuq+(-;;(+P0@S|5eOGcoV$l<8E>!S
zI_bV`KsoSJ2vrKHo7ym2wxUbyB{_<Po9+)73ndecrfe!2u!zVyB#XutH@Hth`IT*^
zjEy@e=k*XM;Qiwf_LZ<3+@pt!<Q7HTjcKqRIaaCEwIr4LozQQ=hZZh1TH?S}mB2iB
zhJm1qT2MW+k`WK?>IBcd0Tg@@$%^H3-HeAKI4FZpHwEX!M<y)lN}T|&T*QW`zAq_-
zB|}H{ER#VLn4M&~!LGcxY#Duh&(Nb+_dDjmuMx-_kIFTfWlAmC4WW}s%fjIZGqUu%
zd;Ti{9_%v?Bj`F@pt35C7Mjy*+c0PgdCvkf<rsQ@3i1at;2171vB~sTET-7R;>3iS
zqw+?%wquw^yC>Bpp7he$<3&30D_$%|1BRb_^1zQWz)g9V_FMhkjKc`|ezc7=Eqh?h
zrWrlT5Y*7~M(c!%G~=z>t)lv%Y6rLMO26&lxOmz0e7|(Gs(sbpB%i5NlQ!jJYnwk)
zI=hhDlJpt!935%we^H|w_bH8-#ixJVtTgFOYcyBSNJuts(T^S46pr4K8GB~hbrqm2
zh$D4V0kkL0U_-Ca3vR{kc@S=ySe_G{MRk;^Z$<Dtv7oj*nWtfR6`K}E>6B`B5lT~{
z#pPE9v&jXdY{H}LSS#8W3DbX2p+mW(E*}cw1v08uPWOwb4UAMWCn3Q1i&1_}_}_MN
zgWGqB7pN=|r=rohN9zCDqeX3P7UdwzQUAjT3E1=kwO!|0uM$o)Gf|v=4kYs2>=q}>
zJp#Ib<ZC>P&#j8lFAtK`348}O5VkZ08gdU%-TJGQ{|GhX7eOT33;P%w$)WUD+3-UE
z#psWQ`434H{t<_ttZLcQC55!S3c&Q@gKMi=+cKFv9WS+Ky%ji6PQ#kY!LsKDjtabs
z>78Va$z1koxEG%1GrIF^g0`o2kDdSr20t5RFGllz3&Z#HX8wrsKJ59&42@O!_N+{`
zXA|ITCrRrR<3*UhH-eE-VD{}2Z8cQ`dHDqbIkYv!QPs*whbElH9kdz;nU2P;P1=cv
z!--ay*_9DORywb?Td0jin_Ca#0FaC2t5ss8{{lvMcg3IXItu%RL{Iix;upJ>JMVU5
zjY`e@nXiHW%w|h6;gu78{__)DhZdCRjqn43OR`N(pGN^C`lhHqrb>HPw1k)(Fl
z)9u2<ZwrdwLb~-AuGKYTF!(Y$kl)?0{(bGd8pW5I1esa6pt@*AVTMiSIM86T_f*BH
zzIc6%c1*WJ<%0CDjsh+FOZ1Y@W%#tU1K3%%Lj*}yLHg3CJ%am^{c5IA3G`3tRPivN
z4hW~o=yF=oqv?CgA#fCXeR>7ig7MEt{ncw{d3M*?VRjBUpst&JJstFk)`&tGvJH4$
zr23Mmw-t?U^QbiEM_PT%1JRTZ$~}xt=4w}4n}P`BCQA7ld3=L*k?N3pgKzQmrYiJy
zn>aGiTEk;9TnZWxX*U9jc=V>VG4mK)jGucxT-gjib%ybKb27{%E)jmOTyq>Y$c{1o
z1^3cK3MKR6Y$;Oo8yi~-1Z7y+_)%3UStIr4A^PagGaEMlBE|m!0ObYf-25l}5E>mf
zGG2A)49RBnV2YA^1lw+5c;L^Z0Ypdov1|)mGi6B(+UC&|eOxVqtt+)91C)@M<-$6_
zl5-YdrHiuSZqR8Oh%1pn`id4O%1jvLWA3M*U;2%%XI>7s!{5Pdzi$ojuS!_fS`&5>
z?<8=2%kWav|6nOz0)m3bVuDzQqGS~pCCUrpE>kU=EK0|bU&~fR9p*F0;TPOcY-C33
zTgt4ueoh%*LsRM5h@gheQNq-qe1NFvZGOrx=-i#Fr2Q~1b=Du${Sp4c5b<1ww`5i-
z7iq}Vh=^Cy0!e#4v=_#UUS4%nIm8U|9242+MhXVf4YPBF51=~f>1|RbDP8Qc-Zb+G
z_9(bl_y(n`maRH$-kradyMK{9L86a<w$ItOEWhSCSQ0m__pG<oqP>2&?S4ibC}CCN
z`H<9zsg^Ev4T~)eKPrI@V1l_<zbEXJq6ArxJ{KHR+_|*1fnBAlwY8_b?>q=h3wFXb
zE1QS+k9~)&2KJ_`G@6uK8xJoNz&XCFvK?yYl&vhxj=1TRM5;$NJsNCW1+$rMmB&}<
z4a+&C8bU;aU+vHMXJj3!d<L>X#;VEw4lPQ-!Xe0ims*xGz2wxOF_}i>flH6EB|HlY
z6bvdZf3)jL&<v0IEg(5V@g7;CT!!`U)C3dscr8_QPJpWw9Ja#CT{#I^pq{MS$G=qZ
znDxT#xey5uOV@W*r@>~Tdv|=asFwd^M<%o+OVKq-2dE%jo?RR#7w8SxWUZU_<<N3J
zhA&lO9SJfA_n_bkoBOdC5Pq=ERjKmui>jHyDf3iEyDV~Yn3OmvPf>LG{82CSW;BHB
zUB~)14#3oG9UsiFSvw?OAABDea#tSq5}c^mdp#8_c)0Z~wIlrW;KEO;IyBsHE2-hK
z9+0PdRUX1g946Lkp-jWgA;g4I>GI!dJ@{9WWIq<*X(6j3RwB;rg4rcstXeO>WZ@e{
zbPu<_O`4TcuV$kbzk2RAosEyHJM>vCYS%2b20Wm47hM+*`#?CaRH2W9`EHPRh&hXR
zy(1Pz?q3-rQu3eEr;1b2bv(K_?nmarJZYr34)gRyC?p&_cYgd7n60(blz_hoosPsn
z!03dn97<m>uP$>e9blQIE6lNnMnqI6dEK7pMeIU!zbJ|NS!r81%QJ4P6+V)eUSaVs
z15>ZjI7k919xHfEP&qc5^5OR9l@h~9Dp%2_>~lZHumCaCyXLf{3wLg)*wYr5Vdts4
z@TXo)+OV1I#k&=%Mm~U&uBi50NA}E#A*c1svLofOR#3Tm^mh5`Ubk-K$y2U*Yl`>2
z)qjHD^863A<t>#YOTs=q%K2yiv>F1e@XGZTyK&J|JIIOb9ZZ?KeTV7RV0eEe{8cD(
zTxIjlLrM^pZJi=6KvShmbLP8)nf2KC1N!EB9H-#;KKN$l_lw^77uFTia>~glxTC-<
zmEgV~*Q-EgBu{U`-$UbPMh?m!4>Zb78JET4A%CaAXwnBQx+%|+Mk^M5_2U7Wo2=xL
zp~(mtExey4Soa2s<g2vGerEAq&}<wMZy+8_3xf@7ds|7;&_Vql0HQ!$zyH^9V|^~4
zmFml3S%5V?KW<>9+&Wy!Fa-Hobbyt)xpwfpSSrd5o^Dm7B0=r|z{{RaOe;TCUSFs0
z&R;{p{d4>s^P>n0PSg>{9|qqGC#d<*L4Vh_=V$TL+skD55<caUKXwyWA7{lO&Wl+Q
z;tAGB2qGj`@*w<0CPxIjE>k!^_LURn_-L7>9-eLLz4snwkjhq)tuR=jb|+id(%Czt
z<4sJCSgw{TrG%=+fFtt35zPoDge;Zh;ssX>=V`LuOpBxSiOj)GuKD+(Dn_&uUN*C9
zI9i*C4iQWX-@}+ztz5Y%9Xw;hyI|8YuzU+!b){Ht)VUhxvc?YhK4i&kDnm;*OcXFN
zlWmog0<*D`0+u)ej0uxGmLPw}UxA?}yJ#PuBtNT*)k&N2_*8Zgw?yfy)a#I*2b4r?
z=M(9asp-~g^wY7+i4i|lEMhJW@#>X{hGshcm^Pn1sRlLbHH$t)jL6t+H9;V<-_Ef>
z6fkxqv``c>RtJI+1mp1t#-NRoZSvP5dxIDk47C8-+gTM!(6_~tDzZQQ{U%4oR^fX>
zoGg=oOxx{LwrIBl$?*GdlEwCqC3y!kQ(-NLcFlV5pkELxS8`{_ZEP0<7xPfKJx(g$
zzZa7lm(YKE;X7@OIaOXw6`Q*`l#AWW4(ta3V4q^~*Hg8TYN(@o<yoy6s`7(=inG}f
z;7AvMnz(3}mz~a+056nT0K5QiQt%Fm&+n8@muGUl$PeI<T9PvQTTgNVt7{La@R3>q
zDpP6zPsVV~4vzvE@nJijsQ80?u4B`5+^=vE69<2un;!h&g~&9#AX0fifr`}YYg?c`
zy7=q&DAKjrs9d;ap=`Q;-p4_@@)z8r(4P*cifNwe#z-|hB*CPxJw8GGsZLD@{c#Sc
zJ&N-Y&=LqOh^_N0E58>oK8rS1q`FUeGF8nY@pjtqjlMQ~Q4D2B${T;Gq>1TfNeXsq
z#w1E9+*`i!p_iE{G-KLnIIozei;D|<mmB;T-#tOL5`(TC(YUUxdbHK=T%@Uh2O%}O
zh~OYf-9SAoyvH~3WHQbRTj}x(ox(<P?vpZ^Dg!cI(UV`9fq(y=Mhpj}de)>mTwDG*
zEyQpHz%MX{<EuDF3EY6EMObDFft#a;H{)T~EXU;_ahnSimbFk=^HKeMk9*xlvSFS#
z-S}am$=JO+;uh{awA<J`o0w>(S}*ztnJ@Z$I<jX;60^<ryy;^{(|CJPHQUs~d;ppH
zOl9wIz@$LMNPp{kgf-M;gaOW3(JVbkV;9#03U)cqc6q@&)Cr{FF-SwWg?!@!-c7-{
zsLQ+Q)-)jtJ<Gh6r*>=5ee3X87n^6&d1VFb6>s)VSeGhifc25wYliiq;APqLqIk1o
zFPGr_0jXrds)9zUr4Fr$t|2mVm3j`9Dawy@O+}jihJP%b<e8gugQl0$OcC8M@JEo{
zk8hE59#`(yn<cqSO`!}j3p>Sz{kCGUR;(5sbT;F)L5mEeI(DLhZY$70_<)**KBMD-
zPwYu2`y3*k@|JJN?IW8abH~w(@{`;?drELeLijg#l+NmI-B&BkdB+FDoMflHuiJbA
z<4k#Frhk#VIdN4O<tJnNC;B^ou_Ib*lN2*Yw&XUuLV24-qtraFvvJi+M!q61U82$Z
zxB$A9{bzD@n2zv^a+pVTZg4<J98mGHTx`fI*Rgt8u2zbEr{;b97*6eNRq14h!`X5P
z+a)#h%OYW)?8^uhY^l>jW+n)vPX{sZkJLJzUw;Z-quE1mWZMlCh~~#Y@U754$fe6p
zn1DaT?T8S@dS#aHD&=ytWVzSt_Q*WW+zA@bHR=>QB^?szP%zQ1+<JMg)cgE!CwB(u
z?x9b|ib|;6!vE?vQCseO9^4}NzaOMF8g!kX@jLWuzG=5|Pe!c)YW3NBpU5czTRkva
zC4XaozsSA*L*E4lW3Y+y*J`sO%Z(%9uN<LlTKa3=;h$tW;q}UYo{5DReKy1};4%Ms
zh&gAhF#a8w1xk%ZYtZU;zG+{jUZ>Uhy!_yD5<B|qv-NjW!XNJE$TyI$`NV#U-{3^o
zjiRPzy(-nXih-SAb~l}#qHENY+I>07>VLhLr(P~KD=GQzl1(_jz9z0!N?HXL<58Zb
zD*2}}8X;5tsT#@@%~aD=o>ddSZ@sCihCg?By$y_|^sc~v$Q=jWJkuD{p=y;ahN^)I
zm!1m8g&~}oTx8w=4jWZH884JDxPAw^evkG5c^)odcG{ir2eaE|q3$Tx3y}t^0e|@7
zf^XZ!1o0JLWS-fnHX)qk3TSXE+a52E<E-AjyO(+c>N_KLaD}*CT78<zaEhe%{jF4!
z2d%o)M%`XR?xC-(cAGlb?(f?zxsglW7Xt*w8F%rLmcNf>Nr($yi~R$2*DO3Zey)>a
zq?rWsaJi$I@Deq9IvvqWBGf}I9}+GUHWWvtc?@yWkSAlLOtDrxlj)rs8-pf&4v5!k
z`ud_gsn%quOzo}+aDha+Ku2zZlOLW>1sKF@hAxwHo>YI|3+Pvx{X)u{R^LN!iisxL
z#F{A6>HC_-dqS#cH8j+<pV*qEmA59de33FH&ygzIj^q^MlIQ0pqcv?ld%{oXKTc6=
z^RIU7X<AA+nvAh=Y?t~*{xzFbw5n8W)K^>A)|zLR)%xN^cNUrF@uTuwvP0qMnoh=f
zs-=B=HS~X{sX8NRL4)3d93>v+i+iy7wLR`v=k#$fzmms&tCYf3R?g8rK3eLZmS~DY
zSb8QTO!BG-q?s`3&q}>7f(Yf*leHOMa8v@k056yDVg*>y-t(jR>y+3=>IhQt4jTsx
zRUzutid?$lY0=oUR!$9UH&L@mv?GVS$BeT#sKS3e@NRrl2c5E7|LWYj)ai5w=vMk7
zqsGI1yH%G4as$=dQok?vY27V_5hT@NCDjR;pE*@tP3rGQIUXu*Mdqa(0Spzl`_rGm
zfs|UsZLwIcUHI{pV>UtUL*eKO&{Qa7H>t`in~T9x-@v})I(JC0OiaH?<`EJx$)0Mp
zb9{e~_+qeI7^u7<;?GM9=&#D`_3wz>m0*}`7~w7*^e(|&+2865;LQPV4qYZkOFnvU
zj?-(6xo^nRa$ENQhQ+7c{nkEF<IeW@1SB7?c_QfHHu1r4vEWW){r3e+*RWsNez>D}
zFCJ&VlzvU@TG&#pT=$<T16~sFl7N>4yd-}~^OYm^lCVSJ=nCxAmn=byvr|RJ9mer$
z;@97I&7}-iFw;MQJ(>T4K*=&Z4v0$JCIyCSYssWy!lt{U=S1<P4anxK$!1W!M1nW2
zP$F&{bKM6am}t5w5GllTh=tO?0R?BK;Vm#IA9%CVvzj+}!&<EJ06Y(qzQ8E}mz#eR
zj1z6>u^z{;<+^A(iQO0=pPNoh%co%k-Dd3kQXq68XuuAW9GY^I>+53QMA9P{=r+rA
zOQ%Vcx0ogYZr9YXh@S$KHA^<p*|q{v?BnC4yxL7vG%8*R>6ACM*W(u+4pcU{jo=~O
z-a}em@sO6mL%RK09*}~;_@Klqoalec7!J#<zA~8rPEzt{79P#X3(#G_&5>zN6Tu~a
zCY8#UG@QGNr1u?BkW5tjVMoB(atWl9asEmF^OO$aAh*4^Cu4MZAfWyplmOD1vIfK;
zBr)tfb*(QC2CdHLZ3e9&Qh-wH{=<G3f7o5j0;=FX;rCGmcW##gS6>`CaEO0-cq@A2
zCh>8U$|Q&60!cdC3y1@91%Nl+xnc3A6R_xSD;8_TYSB49A#hJ*{e%)e_$YgtZc!}{
zDcbu?H&m1-sW3daf_NaEBhecs<AsLc0p7I*x`AR@Dy3SVyUhkj0;=}xyrycuey*+V
zi+Dw*>a(hiLMQo%70g@#rFfIRq6Zce2U!cD2s`qk!|gUHku6<s!qOOI^OM`6TmsZe
zlR2X_0`eh~Z=+}dl9Sk@PXeY<lPRQ!0-jitvZO(O(X|&2dU1i<B0cC~TEUU|C`nEb
z_$iO~!rSq}Jeg<jRyF7Vdz&8e1@v$9Y^bl({HucL!643|+&@1!Q+Dl76xK$7?{)LZ
zW;r?$9K}NTU|2eZN#ZzD{f(WFX(?Epe|kqBf_6>SmJ|ogC%ETeC#-7|UNkS|i_0Q6
zHrU309foH)r3uq+9GYCr0(zTRFZ$eKdfBgZ#<2b)>zJV@b*Riub$jCE7taW00oNM{
zKq@<=h!N6AZrziLIugoTs%fbsq&(?ARp_X_y^bM}Dzumtzf$bEO4}SQS?=|^J=E%u
z5=BpVj#ilkT}oa7a4Vov@AJc*+!>&|hyH+nw%J3s@;{`8TyNb;ZB*~J@y5T%^+C6H
z=xrujnkpJ-{eje@wY0V0vF0pw8oyy+Y<TRV+Rv>oa)-R@m=j^LqIy}ns-`9P5=05_
zP9nQ}xa-hulG0&P0#3(ApnIu@UmM5=C(Uiabk#b~waLHctmK)QczdXPt~M*O+&B_{
zfyfc?rlr5;9f3#cldo6)^VBS3qF`mr0gw4tMCTmh!oLH{EUD3G4O-pKH|?v`>tGhL
z{Ghuv2eEZX^Y*^eyFK@b{T9E{=@ot=)vHo1)$*0?o$Etv)14v~?~by1@8zkNOU+73
zO}LYFqg-E;$y}7Q3dqulO07IiRq{`NWi&#j`cpNODVnLKsXVJDe&2diRSkbGalQgR
zM~<!l1Q{|7?_``;w0Fw<6_5UK;3jU#ur<4R8($sIwnZq|Q%?m<wIYjv#KHEkW5`X@
zjTu$}-tj+(i;4JlX~C9qc(w@crSvWx_wD8Y{Pe)zqLZAj7p&gx45U`4j~PaP4&2b0
z=Mw_-7Xy`>8=9G7^n0o{QVn%<k1gq%p(;P<r@+<{CXs8G1TLsJK2q?Pz}ubH0C>TG
zkHhYrKq-cNF>Bq`X3qmX|5UtPt3j5cI>x#&tt3`yR^Bmm9ORV=Z3ZSnm%;PP^XjE9
z-|@Z!YUZImyX=0^IQJvV0A}@nA^5HD-wPz_!ycNdKe6Ew@@%+6`26CcR^({=@uzv%
zJK-H&H|t~``_)jKpb%vToZ!23IJpsTLs2TDSH!|59o0uxu$SmJugeN>W2J}h&hBmi
zUtI8)uE$lj#Lpr_JJW{`dg(me)#M(@`K!03eqSb&Lj>c$5hW$>3nplPur$m}0N@nW
zxkUR3%5e+}MPP9sf-n$CS?qPc(n&yr+g6{^R@k=6rSj#KZH;ohEveJkIHamrD#;R0
z*^>Tyaj{>LXWkFplOXu8{Bhsluhf%~)NUjBzaOObX%uUQpWWWny8m!sVpFw*QwgNO
zpx3HB4CIDbXYaoqsb24Y_8O#OgAiO>{vx+2zl*Rn=Otd%PJihs)_pk<ABXr}7~c2L
z>0)lYyg%L0J)Kpm4JoAnLxOuET)@$J#JVb>H(QX?5AVFdHo^IQx8sp6rW>>+ZheuS
z1^>2lgbEx_hx9rgB6%*DJSz24<Lbgg9@!0GazqJ`_?G1q7=K}Zx{Ob+1TmvWqznIh
zKu2QSG_V)da5BKWJD-?H{nuQXl9Ef3B{rIj$M{*zLfU-xgnzY@qjC7la$u>L@kGHu
zif6)dtPCyP2utfAbxRg9FgZ;Ob+l;BWRi4K+9?gw8vb8lUlo&}YUgK?+&nIVirdSW
zKkduzeqmD-`S<C6*idGwO;w(5f#^DzB7@j3RkO+$<@&1s<6J%~)l>Ca$8B?e;<OHw
z%qG1RWb%oKqd`Iwwb-5IXSs2DlzI6MV@8<XiYXCRlI`UKQ)o3EX)0#cYg9-T29m33
zT8ee5;Vb!!6qB)T6La|)nE}IojLFKIrAoEAXypRB0na>t`=gsTuWJPEw@=VidBRGx
zcd%0^gIJ*i4|#9`SlBHht#9$GRDoX1*rn;s!CKYpoQ!&~KjJ!C{O5e8k*=|;?_j-M
zBMnmCjERMH`N<FR`zE9(imhk4pT#dP%ROw9CUiAXivR5H3x1c?^UhJ#hH}@Ef*82o
z&J+8YFXK9Y2tU9tE7fcOp1~|i0AF12w`dw*w*d7^9qTsjmlx?ICp7Ng?6%w8uOy0T
zCue-3UT?egpGVrSwEUwU@>}VPjB2vnai>NMy5x)dvXc|({zm3^+vsITqQxLkGrz3t
zAbkzIs?A0Ycue{ZN8|zVnoQsR|B$PWHU?-yM1yF5(?z1jWi&&7v-e$KlO68#(PT{C
zdQpD*e?D4J2kjmWi+L%l#bUX3k;tXYjycH=g`-QkjlbUYQ_w{un>-E=J%3QbP0jR8
zbq!2r_m%Z$x0yG>x7FtIUhB_wX>)~0en6lRVQGYoa-;f$i(cFk->0d6fi*CQ@UbPW
z`DhA%Tui#ojQP$Tb@@j}f=1?q&!urI7U6Q1KRaeolyxihSpiMw^Wc`a*=%j9*Zs=s
zA-`$0hXHE!@j2AHy`Eejw0}oZzu&F5B<3)arTVSyFI)QQ{QY=tZyLLfGv)Pl`krq-
zbcnBvzJ(ugF6r7GUB2ZJ3u{g{{EN64>>==fUFL{hVX()(P8tS#2r<|LsxQ*J0@TR|
zdLZNybCF97hJ^r3Bcyk=zxZ(*59^)~cc$8-Zs4yCp~LUN4MO?7ePRU%5=<-0%oT*R
zvPiiYmFgL-d<LGIJmB1?l>zwafxqi4nkb$x*70YVDAtqv_i}yE`XcY(1j8RpCaa8p
zIyoZcyX`ms49GrRo|nn|GjNn9K^`3BpMh&C)9^xiVT$l>NH6rNw5|=2?W8#gB;Ixo
zI0Yo$g1LzPLzQSM%RFAMFUaH67zU)CX0$m(l$#2dl20VpV=IRG>UEE#7#&F7GKNa@
z)JO#?(T|KbKqdMSgP%mmfQ1XNc6TR#OC&204Q{0Y9c)0N35`~>Dfj5C`^8M1fG|LE
zApkm&fCeeZ68h2|ohH-maTy!{0#BE_L2)`?G{X^j{D1bog*j~{TlcT@CVS3-I^Jx+
z&t%H35+D+)2>1d{W>=D%lA*D60um$1aXfS9zu#Uh2_z8WVT8KHIyEQT27$YOd%Yk1
zEzBNgTKa|QTgBKmVHakwbX6%tb+NQg{4J`*g^NyrNXPKwU9V57D#@1%0SA%oI$v=|
zEiN{hv|&`qs;$Gu&r7Atvr~aKzG|pcqpx;JTluqTj7V4g*!iSLSM_lzb-G9?K9tdO
z;u-hO=9;bQ>T!qc70CzY|C1(HzcR<YaQ`cFv$RvNtOuX`q;`9E>}jR1zF&TNbvVF#
ziQ0AVgKqE9(#J!$URMMaOb&0mYENy~RM>f2k%~2MfcYe2x)tJ7>)f^Kph<w+Zo8do
zOZ}LWxvu+v12Mzaka$~k=eO@#t>_kgcl3;h+Y?6X3C(y5p!KYB6-4#&R$eH8E+uYs
z)85gp+GDHfeT$bTWFuqt(n4upEJ4+NP&=Q+izZnJ76fD$Y(?4LMx>|}ki5H{o9l~u
zf2~ximd;E5@kv4Vy{sQN;Z4XnhmtS%*fry2Vp<e`xh2cWU^)G)*~M9&GIaL=83EPC
zYPG@pKxT~NmEa)z4H*N&fnR)Rc)u0t=ot#jTjBDSTa38&hbsh?PiFcj%^$O>jP7;f
z#YqtF<0E{i1es_*s4F{g_rv|6azdyxDEdcMn0>inlHt>ItixYmUpyY0&vb|?994K&
zg)d8gX`rExJnK*<<jglO7P?8>z(>U4DocNOWWWAVL8YFER$~l9*|ASFLwleT81UkE
z6C)=a9VdjjU}!p`@c^cllU****`5FF=aJ)`v})t*N>xSK1=KuQP~yEtjX&O37dIEp
z(-KifhymHyLztu%Hm88lqK%n%_5iloRmI+a#h;@m{t@e9uDrlC6G90f%2YDT<a9Um
z;*8q<MF9WzqbGfqlWfshCRYzg>a#>|Y0lnhZ);oO{F`q4jR1a{2VB0WjSsqo{iZSv
zlNgi^0lEY-jv6yM^ZcU^hc&Z8WN{!)I?4#~Y!hR3L_0(kdN3omgyyJtkba~Mh}u4X
zc4H9W&uv(hl&Ew1$z}mX0K~&_mHVJ10^%L&q!AEL3P3yzZIcs$*>p|x!i1m)4`kg?
z?uaAUBB`6aMHZfz6LWqzUqVo4-@I-KYFR=Im&EAzusjw~CHD(8`Y25m;OVqIZdC-$
zwp$TxF1#c^7k(g;?RG#x3!be_D9_`65zV6He@)$BdV@JG4-eC^>4d@b4ok}Yk#GT-
z5mi*iTq*(X`y=tw&CYIgVV}>^h)AZ9X1m^m@fCG{#Kv6d&+>8bb+eaQ9A4mq_^PVf
zCSCQmrPSD`tA9bl)muQ?s`J$eIkw5~^-g~&&n-Gf@QEb-4pBaJnsxF~?Y?J!q-m+|
z)i$Tl`}eo4PQQ}CKnv6h0&ziVm&3EoGugk}vl4Q0ZWQK#le5<lX;SzS%|REu--OPb
z^>mx3X*3@-kB4qP&K=1Q9_io*i{P|-^CxwqJnws$1~ILnjT$V|R&TLi4t>$A6^YSd
z5Qn_c`a0MZ_a*oX)C6-gmd^Qq0}JHMFuoB$zq}^nE0TWMZ36{#2#!TV?JA<FwlD6s
zXkptIvAncqJF|3YO=-6~F%67FX?0bl{ucpo)MleO&%K88uBkUS?#;e@HJa_Zs@8*v
zgxPU5d*q{1S0QcrLHVSTk9Vzp^R}fDW|Vv&Svb$G+TwX?_8gp5wet^uNM^dTmpk32
z+LO<Mq5a9W{n=}GCH6atnxevf#{=?KDhgmX5fA{D6Umz#dAZj1YbG!;j|ZGQ;SpIT
zIdKasJW9RxV-aEQfb6v=HvKy}+Y&S9yXwA|4mS>5K(=d=`$?e|#4Pp19CC2=8K@h3
z&CrSiws?)%0Jm1eBR8La&Y>VK&Ip#TDz&!_k<LT}{}lCCLgbAZ58`UJ$_mXE>&Ts-
zSLz9kdfthLx13HUbaft$i7e!bHzqC;BN`4g98ww%j!NYEzQ0c`lLfjHh=75A$$x2+
z>EGRSMrH9$Aux+D-IW+u92r(bsc}}SCpw5V3Ft$fdUuVJWJYy=g(o-1ifAacKBFf4
zU+sg^WxuFh@=1l)R;Ny-Dlm~Zdsm<cyO56JLD+>uoivsqundu~UWq&ufkXhy5XaYu
zxtuVHnAH+`f8nO^K{vi@eO(_BZER6(_%a)CaRT#Jj0c#O;ym(cD=?GA&(_<sku=(1
zU|K^RW*9N`2=mf^nL5;&t#F59pho2X;#id#ug$|JuiJFiXsX-(aFvl|PRJt_VZt5`
z<2_i`dKF4{k!O61T%U-6*p0W35_7T`4`{|qem0<M$oU{WllnT2UgF=hH}bj)L}0-@
zq&q)Vy)ov3ESJ}Utck35O+`>{r)Q-!CqrdgxgiX6%Dahw^eN^o^xlmF-acQyyKQ-h
zF141@>#4nWGh`ODNhzly&GA^9+Ps5|<Pw0?*gBstv(^-dw3yF7pb%j`UxIu-hMI|q
zzzjy2{6_KsaEn$wJ!-6wUJgL&rkbO2?FFw>3aGdGDfe5Bg1WGcYW0HY6cM)}dw4EH
zeE#-=e-T=Lg#A+(<8!g&bH7Q=3&?p}_|irAug2nBqj}7}^xaFbBtNzWJJJ<PY1fy(
zd9~%);OqSscL0YCjjQAUvGd0Fy=xwfaWTfl7#CyQ)IA!Eag!4P9^+zFDf^JaTlJ{T
zy0@;6BPy0E=OJSQp+#Ny7{<Z4T!&^Q%PI$3p|eeYUO~JDAw*cR=F4qq4GnjGw<YiL
z1%zQ3>6P=7>%nP%@I-7JRlh8kFGNDFxMBM#w<PlnZdMPHg!Lw$;onbOy1^d8gt$^K
zuS#k{8{0qf>YGh=DBfmn+-aVG<ZM1UUQNcG#%cb@I?ZN7Ot;>sxb&Q<W+~Y*^U8w-
zss;dmtlv}8R!H8Vw&TO83xM!~4ZoW&^VLI0Ld7IEOY>xmb=ygOzRIhUFAL+Hk+XMa
znG`u3laIUdzhnZ8$wyQ@*)Xoc&u&I$I2bcTYqc#0JV$$LJ+<F&w%@~?jrLuu#an^q
zSu^(PSDrTenk$k{x2|@fcPA4zVfiRzwb`G4n~ZJ%a&~*$f^jj>h~-Unt~YzPE#<F;
zJ6`Mi#n8<?I$MJyp^=An=b<>faO~Cz9PbgQglyAt{H|ijT!@H-fUMpE+IBhhGN!OL
z+&HGN_Pq^EVWCU73kP5d3z=cY3`u0GibQGMeo(4vzgbgSUV;kKA;_w)*ISqlK^}U4
z4G&>2xqE&YjjoWq?ztfZw8szu2<VW<0v&R^u%;O=6Vsw3KZ6@5wqr5E6##>LesNy6
zXP-eH%d!f=D+(e~CH{(nQo6XjPy|}<4qe9H9>Rpk)D?w9sg%kUg)Go)qbmx+l5WKy
zm6`I+4)w(D>&N@giFzb3sbWYCKI<lbzX06C|FhT+kKpdv<_QFkOL;e+Kd9|MN9GJQ
zF3_5J!ZYR`;#ynzsKVyw5#<ulT(i!8;~DdQhkvxCus0SyAO38Sgy839Umi%MFKUYj
zh`7a%L_dn4aIexR0`V?_!X4_Q5flzV;f~u=iRPC%8hYAxf3H_Rep|Dh+T~e)<MLF%
z?c6Yj?EAo+Ouv_hdGC(!+B>&_CbiJiyx(V`3e)O_!+w^{xx?rw(>e*GCmEuruZ9=@
ze7se<eg1Z*;l@AFfZek@a;qQlW^S=ytKMuhSm@O5zuWNd1mdI36=YPj6}dzKdY>>F
z!)OenF^tAi_k1uKOHKr^LCQUUH*9x2DspF3nn$LU*H1yym*0haPaIsIZNlrL)UWF9
zs*>h)?6h~V?aJLkyMFp@VRn+Nl<@l*gS`cr!3ShyT9u%bonCWl@vHlpA{nC@-&D2;
zw=&Yi1UO!;6M;kVN-#3Rj2U*g5-g?hnU@6u_m^+GYL8bU+I({|J9sO9l7ox8J|We+
z{v1V+_pEs%PvJgyr_W#NDIe8$(iNIE#29=hEy&<vO-f2ZT=D{CrN-)lAIgoOawDzv
z%0OTg&1KO-#O#pD43QGBRML|T>?_#TPFp2+Jr5HFUQqtQ-s!5IFQP!DR$4(rke1yK
z5Kc>~;2{og6yaNtyI!k*O|YJc<VJF5mE8JhW(!uiJA4DBic(Irv2523Krk_;56l4a
z)?8VAwj|mIJfdwOc<Gwe?c4DJ0w)Mf!5=do{MV@Q$NTDz9J`X>r<Jo>Ez#ky``z%0
zoT%%TZoPZ)VoXq>hF%nKCwt8i%x_U=fM$QwjlV^sIK+Y;WkMb^=ak%FtMcs1ovjh-
z5(@jWX>;mcyUq9REMN?dy#mM#(pu*&8wlbQqgb)t{v2vKTL%`CR=X*G4QBs$KR-!5
zk4#pO@QPF-%jA(5l9&IBi102$>;hbzya%&4ynDgi&t$2#35tLE;$OZjl~KDVq}>IX
zVT)DbgI0;*%A)7;MMIF`{paK23Cu|%GsOD}dzo_>#3^fc`rP+$ug@$xS^~<5*K9m5
zo%*{;+ezGYLthOy{}@ewE1*xU)9y9vYS&GDwL5<H%TJ2cyUORb2p!6(9x#iP2_F=*
zNSP)tW|2IGctfgB&I-%(tdGY4xHmA3pVWdWJ&x(7Demdmd?tBFTNvgu<|a^QWSYFM
z>Y+Uxd3PJf^@dP((&iL^n6)u+ldi<%GehA9qiNa50NG}M!6O}i{2<OFC5GlaSrn+x
zDUXWX^UWn;fZdntGJ<X}AAo(KEB5fKNgf`)Pqi_1oNy5a&Ai}dK7p(g*Ar_7QVQzD
zL~qNDp83oW*jj$5IU2d11Nxs3?hnKLeNQxEdc;J}7Yxm(`!OwQcG25QQ5!Qip1Jkc
zq~E<$C8Oxg2@JS@g~2SEZg^YZBPDpjn7t61F0pEJd}~*g+S`UmTaylF@As)?GUl4>
zXd<eOvnzG}qVy(WkNuA;Er@q!a_j=QLSn4nW%GCK&0dJ#k#sZ?qTZaj9)v{MU~89u
z12%Z$=luMLz>5W5l@8dWl9!G}jz-DPTxYj3C7B<yqCF3P0)%-OoS$gF)>txm$tD@W
z+#tZ3c>aH(@MX4>Z|PeyOjjgFc&thsS#A=l5}2PnUV&%fqvrR?`XLw}v6=JdNqC?W
zvnOKb;?*z9<%=_sHpuo<ZpmhU<Dos2(#7S4vLJ6)>g82Qm}n@lnO&~bcsmqtGdCbC
z1@f#rkLHtq<9SJLpP~69>og<xbf7)iR8G>xKn2B?UgV?R%|J7tiRhk^wnFj_wV}&M
zyElJQY($jBuiJ_63wZ*6Om(^;=zd4nf^Xt_s?bjX-4$%pHqmVU^T4#&!&B23GS(vZ
z<}Xn?F0lPJIj$G~dJhsmG2(A=b7!s{XE${|C_PetRn<0N*N}dPeC4sv*W6d5|KYB8
z!tqbs`yd~bPcUJ?9d$!$omQvYgKHyvAWo;-ReQIcb{*hvs-1t_wmN+wE{-7MC8~9@
zcu@qiEy?i=zmQJcE6NLb7Z>J}XW&?X`Txj+MW^HZRC63^K_gD?|Gvq26H9p(rm%R6
z`Jmf>->*;ScgkuGVTa;jGuYtYjm>B8d~8RvSV;4-fF~K)b<)x29`_s%iH7-|)HZ|p
z9n9}weg}O{p@W@)<_Efdth3150xenXb~{~|mzv{k#Pi-^?f|Ff!R)r1h!FDQU9S&l
z0r_%)DCC3s52dcwnje*x8zhoXYOUYtroGXBz1~}pZnj>puXH&yZS^nm=7cb+<SPY_
zK5Z7y_sIL^C$$Z4`!2Zq)M<gSZeM+`c6<B<o&e}~*;mDylS<|MOr$DkM#wnN&U{e2
zDro}J$~#aj{*YV!pHJ@0PB%tcniaW!^LXAkRn_{Dm`8zF!FJ4P-Zy`cNV#74zff|2
zg;`85-?HMd=+sTlXD#+Om<3bn^(GA4{Azqwx^1Qd<{u2EpdnZ&vk&)j@D1=a@4UYf
zmE&1d9kp|%nkbm$wkOSmhy_JO;<e^)vih*_)GFo1>3K3++HW4>`kLql;jC2vR0if?
zYxiRcKWf7vvFT50X=5^>wyix-o4xOUJX310&+T2WVA@U~5x}m<Op_OS;EWfp{I!7h
z5R+i#YVG_~Elbd5pV}T?*_mpX)`S_J7xn|BIUpqmu%08`&_!rU#WY890*M9vqa}Xa
zi162y`fHtbUum{`OqpP5KKuFuOY_Jx=;J3FOQ%BK*W7eMNUkF#{+#gcbtWW#{81?N
z6~iFJ7yyCyAQBY#S0Znoo?TwPjiht<9ZqNOB{AuoW%-WIcrl^(@2qN$R{pZwY$whR
z)(<$B>gc}}poZd|{+Rw`K^GDs!G(WYE+&f3BHpcX*-qNyX|b7DwnOy_EsOP28MrtT
z>Ke`DAvE*`vBrYCxh~e&-Uk(bVSo@8tC09vBmTTVAe{x<WX@gt?qgN$l1_uvT1u~{
z_Slb^uzUjBy66SF*Nj_tAKTe*Jt7d_#aVL3qVf}xlak-(+Naz34629eq-M_-1EpPG
z)KTuGeEys_$uismpmbHDv|2>{KX*#22$%c)&-f!Bm43h5tlsruBxJ3B*6H#K{qSuq
z^^@A--;Lsj;<swyOwt5C))O?{37>GAX_SE8=y28HD=+{0zKo2$LG#N#OC}hxBu2@!
zdZV^t54=Kk08YTEwOJPQwYAaNJqPc`+M2=)Y_f5FTD}lUoBc*s&I|}FSa4F!^6(o$
zEDJ}36>i$~bykXe5}v+)e-+xR?9BYmZw0`XLXnY9WaJ}_T!th<QsOpnadlpPdn(cf
zq#JH1L=Pqgnu*c(Xt0Vnn<<xN<x-&IkG3$MKd5ceQrqwQAN(}AWNKp_%G)g0-|WTO
zQb`E*vC{?AVWka-BF#D26t7_T3C4K^q+IZ_ja^bHNaudfYb-N=E9@70pgcW$kx66W
z-B)8q^Z*3V?6oE6A1=c4?{)uH;FAm8ssTShNE9K74VOS1hbTgaI%z}^+6#)%#ntKC
zv(t_BO89ZESG<>2=@q<`l$Z$2z`xgIVArNL#Mx8kQ-1=jFeat9NhqDT=D<)oG17CI
zdto&ETpU>}D0NwXAutnw8P{d*h!?~Q^{iY=)KS<Gc$PT~-WUMIZfFAs29vteh-K3(
z8$=6{vbpf0#Il*~k!v7vzt3gRmC_MsSyw{mZ=R5`cF(*35Y)AWi{v-FU$=K?5&)%#
z`2n+CE+O(3NymAl*0XL?7RXQ*6d2@D`$=Kk2{p>@e=6jE`H}g<^E1_LGRWundk_t|
zKkO=3=q*bjSLiJZOdJVr!$!Et=p}D|ma<vm&Aep)=Xkk8=U4>ic*|5e8gYTh8*VWT
zEO;GZ1=_<(KO}B%^~-YkLZk^GH_Xc@x8x^Bv=3GIcWklu;9J`jwaPKckZNNW?Am79
zXzb0pj@#XT<z=~kC4Ob3NIq+p!S?hnmR8<w!n6`@i#N-`hdXM0tl4(aw1#vRr(}S1
z#G(`PCmqfP1e)_8o=;%so)?SKApyX7ckXSmf1f6X8_{Qg?y(fl0;$1Hg!TdM27Dmo
zlwH<KZ>y31SNI+5!4uC|ZXPGa@$*%stg4GedI5ufLJai;p#);?XIa(YZNg);Bnwq9
z%`OfeHH)b!YR#rGhD%^yxTh4=#Q;~6($i_XMr;=48*<&?xzp>P0{KZnXCJ+6WID^0
z@#K(HDk-8WxGFG@NgBzXAxcNZU?7*6fG%2Ei%x@g9b(xX9q&xD20GrECa-t(gwL;W
zWk1w^2ux1MU@rG3BsbFvxx&H~=3``yBk?;ISt7s%5LSg6reGpY-muK)e1Nrra~sxu
z8UL1Tz97`99y3)}P_Juc$K#6a%C)_?ft%56<QIYT5iyPN3;V}&LE(;<!LK_xj-}r}
zIdlmAD%A#$ggYeO6rKnOJakyIX|}R|`(ONjh#`0-zS*vIx?Q!_Z~aA-UawPYDu8v{
z?+{g~eQ;5}!xylZZeDv=vfuH$sP5fqPXkW0>2&;(Z``%vqBMUCKD=xO<}ZddO!%fX
z`vZ8@`gK}DAb!NF)`vQ2ylTCdtJWAaOPmt{8Ap7nOw;()b9a#VvWFMTSk@79Y?vQ^
zF!yF>zA!we8+tM1+MaMYrADXK>U;(O_xV7HdZ*tDdc1+$d(dU|afUu9pHxy+)pl^8
zgp1bHQ~g;w!S72IeF!;QFtwHjK0CTQ61zJ{UjDC}@9_RwsZ=eUm;B?Cg6?}+KX3xv
z#`n`dx=pk|Lz3G~3I${cqzngs;mu2b`e@{4X{m5|TI4OUcxwUjf^(RQc;WV?xGiyv
ziCnja{J~Q!$WcB;B&ka7+M`6-Nt;thpKD{r0uTImu2I}Nk)1vRlrKx=)Kv;5Ur@*;
zrLo&(Hl}{4;+4Yr%b7tm@(bL2S7m<H(eN}F89|r#+*|S=(ZS{gjw1F7Rg!&wz`N=0
z>uXX;u@88+MXx7J1(i{TmC+WHuI4>T3kf&QCSPV+?HdQxl(0Sgky>;a5(_+Z`p+lk
zjXCBl*kex`4l$l4_munU*pwrYpzO*YEBQSFw=hyHm|28N{uW~=-3lNA*iVe{oJY+8
zUJC?-N6%2(t2Bw+!0mx)mpCea&Oy4UTvlqO1=hf;+KH1DOHA39+Py*6MzY7-%d^v~
zd0$b06T<Ht6(@LG7l;#>lYDRfDr)2DqegzaCZ)p+WeXfc1i??wN);6SWC$)m(+m<n
zE#hz2G?QC))=o$cnqk7NG|^2n2WXaA8>{T2cLsS`Tt${fo6Le^vrhki9hJ8u5PM)p
zOs1tjW;nn+#T#Q7WV?d8S!S2t$>qB)cr6zn&7nSmxA=^W<xg*x6eh3DqzfR7m`+Gc
z825;~4;#d!-|;5>&}61yGUJ31q008L=vb(---yP-m4KRLp{mUkXfDQ0fn6%4i^~f|
z{9SIahcNlB)XS@qn$X67JT1S+Mxi&G>`=VT+yK`Vc)zas#9ThDXiYq?(fpBhn$61A
zQj%^R7;AQ@cQeooXg9d0q^*#=Lv6s6(eBNk6oU$ERl!!3{fep_47L3-F-pZK6{S=P
zDP3qviN?9bl;e@J31WX7E%D><Dz|8Gm@AqYB*+J)M_Ow8eg6Z0pn-i<6+jFl{SQi?
zD6JOna;P^O4Ydmodu<8O4iVibv6p@Y{ym?Y?631C30Oi;`KY=*78`X~pd!q?B1E(h
z<e6=F2Eoy?Ph*7N6(*3G`4=DWdVNw=NxobN_!(@^`AUJCcJD=i-{r}QcDM7nw`$|C
z?ekLU(i?0p#<o{~WZRWSU+t2%@@LZ+k*@l&^GT7dgm>do>U5D(@SE=oGTwz>-JY2h
z?Xxa;a*=#sZX{`POlI!P`Cpj}4|CxKTKL>2wcER6&nkWOeZ;dXeM<PO(yn_Sbn%^+
zJ|04_U*VZD8NBVPJ+)m^Vc%^<D#pA4){~6oRtQtAbJwbWgB}51yX|(WE%jp#ak95R
z;($39h*1$I`*0c^ak3F7J5jw7c_;#j0Jg~=0Ti1%I}AF!U3ZW7buZO7QMNNC+l!^N
z&~WB$?s6Xm6Sybk{WXM+b-!*0=vXu;nbs-WAxF6Auh+AQl{2N28HhmhM{pe88p+{6
zbsjkGMEgO1y`gw4q;h|#oDk{^iln*xP3HJ%VsH>uw_k}P-g)QytdGaw(GM)DIdph3
z>*>{vfj*?hfU@uXHK0>xwnm<zvZr*Qk90aDd7D!94P*1UQ1ppam~G53$?$19*5Ok&
zG^?A>bckjH&BlV+cm*o77~Uv?0w-rV1c)?KCNF}2ey7d=<<m2i?}X&rzh0Q0XXh?_
z*A8hvLmt2WYUAumP3or1*6W9EI2MC>uTkTV_tnL1t!-u(oi6^s@!!a-h><}OEpADk
z)$>?FcINUqYZe?8c|=y^F6-h$t2WEGTB;~zA#Z@d)?Bm9n`)$`Sc<6wcja5JSb$bL
zjBJvBqp$FH5s>(a5kERFxa~Cro{j5tQye$&DxDm29evT1#_bZ#XIi96o$<CMM(D~8
zM-J`Xs<mdLsn$vLt{-)|r`aRzyH<<j+Z`C@OKw}8eqXH@66l;m1uYP(Wc7j!=CYFG
z84+^TB9Ir0TOLCMdm^arJi?#i#so^ErbDKGW7Bcyus~q;*kZdxerh_<ETN6ZFI$Y=
zMID1oxX6Ud6;_`c6=1ztxiueGZ>3Y_!~*-7Mj-qE&gIuWLgNd+oxmF={0(u~(b69t
z*{^>fwt7PLPan;^qq#Z~DUF33kT3^C2k)*M%`M-XKzEQs*nfvaGhUvx7gQ5R!z2QK
zxyj<t8r>C-J3OCxNr?pg=TJK$^JZpFwbwr~)a~h5d&#b6Edt*jL0{5DGqeXffzbv&
zBM8!Qh*_LNc(EZur?B+b6dl}#d9MWlhV_l0-TT_RwCcSM54uDAz(>0#rDCaap7yS>
zP>uo_q%RiAkC^yd)WpN%1pNwLk9-Dy$dsPiCkjjhoTtIAXO%q{sIT5(4?`KS({BAm
zZaaPU>88>mox6UksdnA>>&@P6OZiK!7rq*Et?DUNC=xcBt=4RuAzM$ER6G3-?4N(A
zJ&vdn{l$g!p^9E(ZCoRA?O`x|w-`-^JPE|#I3Z^)5{#QlTyeA?o9{pL2~eYds*+F5
zUbEVQ`HnT^jvcMi`q=69Nx!SKd$$TeDavN1uwtBjGldmn<e6=F1}nxHCT|?#@UaD%
z_dJPLwDo^cc)KK<@x~Z4+lm-*PgC9v25+fo@zp)pA&pH+{CKLJZe4ZHMK=D5CS0bd
zR`BC%CQCgoG=0X)jBl9)d1BIk`3#-TUPuihmklx!KI$NxIS>KbRA!4U5YZ9Z^iU^_
z(56yAn_|qKoCs`^lBrkTHfo!bH}tp!<lTAlYC2?o)u7lnOba;lVWCgi|3|2`?sN&y
zV?F^-J`iN24K$JfRTx*9<l*7_R2x&r3E%rXUYoH?ypy8s*clUOlqbJ`t;PLtcOfI}
z%wcq85{vgVPR2+gIZ{&s$@S`0S*f0GqaHC-f9;BZgggXa#fa<ZD9%1s7<CV}_{sRr
zvGF-_F^iSA-ftFke#9o_+0Pm?kR8IsTLyUq5;9X9>-w7Hep0xs3i-a5DK$s%k{83V
z*M{cP{g@UtyXd`E^nj;-y}9-N>@xOinb*yD$&CFLDxt+4Sox|_d)pA{Y<A6bFXS<#
zH=lcy9Wkvdiz_l>U~hh(S|$_J$*fr<Q}!h`ah?s!6870s-{RIOob_8=SvnY)#!qU&
zoCI!RY&Y5SDzs|vZ2T9cpKp+iDwbSiFmoc_t^)ID;<qMCj0(|z={)b8pJ=}@0f}OC
z5HXTWfLKgvXhmz{MTUjK7Zel}6cm(YLHQP1@SkaTwHZz@NY2uDhiQAET1kEEhr)iS
z)Rqf$c7boOCn}xO$DXK=VyRx8HI!|N{=vslu?VJE42=w_LwS{rXp9UNotW%tk{_A|
z075={ec1MsMFDVs3((jGre(2@1V_+sh{YDoJoVG_k_(}>FXoX8i)~l8wDk6}tR|&1
z_qF<!s>hv!T;yFFUKdA-s&#)Vb&$__NQq!AawoB^D3=$NN;!2B26aNXPjY^te4!!C
z|3{2PFWm_ioO4!>a+Kjv#bn%YP$U5lq&WR<zt^^QwEL=mQm&sLv)x~7;Kk!vW*s!+
zh2PWEmTFi6t&@*ekW3*&%h#9H4uo7@V94Q<O;>*_L^wd<MSJQjkwqt{ualD79g{8V
z<yMw+=7SU-DGQs$J@4qH>xS)6ZOHMpfgVNO(AOv-;fTUEK?a)5a~1}DCT)S4UX$%?
z+hkx-7UK?o$^8o%n-5<1ovoXOY`jkL27Msx6HnBR?GUY<pQ>dE-0`&b@ajyYX-)X>
z2g8IBSbXXgcQZp9`ZJZ3G=jV(vP_`stAWIk`0^5e3m|c(66$JSt@YJ9;Oo^ot-Fuy
z9^mZp&#dXE#2D!S)I5Q9`>{5);p$e7aO5S@X}CUrBuDD2b-G=(ciU;#0no48`P?I2
z^<(D~qiMdUs^oWGeWJsnWj+^;d;Xc=YxYJXo>3#nZ4S}^>^>CF;2^t%8E9l$dA$NK
zV&!+<_)|0u>6bb-fs;sD28FnUg>?a}3t(L!Gm7ntUilVV8{o^XU6jgo;W;Wcb(H8H
zvYR@8s$89(qs>W1_Eu&O(pDn7f^IS1<>9c>BK13!^gCXf1F{@JB?(F=7+cGxG(`yF
zQ81IE?`A=KoVBTzPHPpR@O<J^4$?`Wa0wC&&XS|{2G_+f|8?ZFzEID~wfW=#q%}W3
zVaOT_F&3hrIE#)2?2NPis&aOAA=C_xCqw^#=hM0(qi_UZ%O2~tlOJo->G;L}&p`70
zoOs8)2BSob1@AQxCms#H6;4Rwu1&7p%+Kt%=SO|;7(enyJax0HKaNJ+`|ANCE;!>x
z8_9(}h-i~35W_Cp6v2;u;e-V~S}#)HRV7r;%ctc%U9u8LCG7E%m3%6}-oS^hR!%Q}
z#k!wq-7{tqSkPovVPS|{vCj2mlOlx#PQ5^DlQA2>_#g~f7g(~G3hRW}j>T+S+^SDY
zm3qy!n1ZZ&Nfn5F$co+2U~~jbk%+{c7ig_(F6?`*Rw4`D?*&l7ZzXP$1(M~k1wLhd
zLG_*vH1>mw;AC3*KpT6#1~v;kY=?$_UA8~d%tc`OVgEW!ALUoHNei?{DgB)S`R$sN
zc5Zw=Q%mLZ(q81pudPcTxC=yG8DpBQ3UYYXuUqt&rP&n%EiNkoq&TbF3G~*}@rmqW
z*JkR^O1BNSGdYX6kpkd?8m8l7gU+iGzUv5(pkvK(*k2#8)oZ#zCMNrs@ie)Ahe=Eh
zGc^u>YGhiI1q5R>h+ET1V1o!qF=!O=ywNZoa?xlQkJ>QqG1DTFVceeE0)|m^k>%Ia
zPq(<Hj!k5TNZIV1t=XpxX69y+B)*<^cb)u3yf)upVSVj2YZT11==McF{r0Uu{-zs$
z^C`!jVkDUWB=e}VYSpl2;jYDhFASeV>$QXRIz20))0hx}lfg<v;>$q%XcM>vfMT<q
zx>ej27r{kA$b`=VP!8yv2;rOr5j0Ln|AR^zomQ*!8FD<emeT8~J@P^Mq>_5Gr`+DE
zN>{BDrO{Wrq^&G&SfIWA*)&GkkQE;cCEslLNGNwb7ylK=b=&InfpE=#o=Y$Cx!G!w
zcBfCOoM^W#<uA2fc*pS|U6fc1@Z<~dzOcYtuI-E&uXU+0q!u0CY7ew(QSAr+)QXKF
zTVmb;Nwz=J{;lwB35;5RJGB@dB}aClfTOV*AO+6|fR&RS*efJ2-ds3V@?yJ0!nEER
z)gN8$15ibbb_ukgi4j<TAEB6~PX&N`Cf6*A<##mQvGF<VRLZpIMQ5G@4B*AOWBQXt
zxtM<voN(@#h%ZPjiKvAMUUALgx578_#%sIh4fNW*O$`TfzDzZ;Facg0JZhFUfbRRB
z6d*>>U~YZh@)*njkU_vo#`Yi9FU#eNgdjwA+XHj*%B@VOQ1V}Y+GP57B1o*hYvYlJ
zpDde(^aNn6*>=&ihSd5Jl#If+LV^6(gY$P%F8rHmQO6`hs*T;TNj6hUW9sVB^z|hc
z%o1mkKrCU=X;62bp!5nVy;zpav}B4<mPGO%)?dQ-Qf&J0pwqLHBMw-Z*X-gf!o>W5
zF!b~C1K_<tvW;AS`zf4YSSW%8#ky6dEhv&VG4f(rQUof@%92CV!J_0b2;K_U)h9oe
zB&G9cu_TElNhH}`Od*yecRBAY&v6QrBxg1f3z9+<Bso16^X!4DSbAID6`gQp6|YE|
zBNDk^aNgT@trp4iA(=$CiTz?bbfP&h24ei;sw~Z>L=Sv_h5xa_2{BAwG@5butYj2@
zzUgZ_EGQ<YD;DE`Z8!rfTA5}ItY~GKyjanakv>?_l7)UND_ZlY0_#~>R<L;06=@wq
z>sOJreCiGdN3v#LggsiPMP9FsQ<jw9&dYTZG8AS*Xk<toI&gH;ATTU~r-!vMVW!)l
z#4w*BZ*xz7iTz|zVvgK|i)mTxBVND^ueyz&J2FuDvT|ABp-%>tg`02i{u<j+>Ad7q
zXFa{vc#SK$uGT24>_jEq*2;k34QW{Bgbz0HMz$Yv{87SNz5(fjO~J$@@~Hg;>2s&C
zv=zesa$9S!7qHsf^K$9!f`FY}RO%N>lz@dF=K|(`y|hNamSsu?ZR{O{V9Sl+_rtLF
z{#OpBWpVA2kmAN<Ce9)}3}+lJJ_T;<9o0gGS<*@a)q;Nz0+JTW^<1RbQJdB<nkzS<
z_%RVzL^^6?i)zCc!o6zk-uy{XXtOJ{VE%R$+|pI0R9^~_s+F1=Db3->k21#g4o6r{
zu<5{m1cor5*uM}gd%Qq=kDoBdX{uQo1mVaauVxTDH9R#`MiI)0MQJ~@2k7zK)EG6+
z%Z;nZJic_K4xOO*q~3YCK+@5Z@g0c0<`Po1adxGuqHJK-te{2zS@b#kdQH|rT#^mK
zv`SnWMSy)i5^2mmJWR)?Q^~F3%>Zr1TYj{E&@FV`Y{{<ScaDTzWg%_u!P1B7FUQgr
zC&5KiS-rR@N0xuX?{F%6FJ+j@{y7M*lopkdfNLDn$wEMk2aKv+lmnDe=<R_vrgoS$
zBMF@K!2gJ-9xdgC<-Tb_mcBu|&)A)oUYZyT}^-bTc<StFFV3Uh;&HcXKUr78D+
zP_NlOO^Q6Qh6gq|H9Vlj15zuDgCcAF;dk(WHj_I%HPlu+pW0dF{OT$)&lP^>NKCq5
zD|4;)MAHp2Fozp7S49fJ>Z>g1wh4We<%Ln*w1&E&In*W=9hg6<^+NIki?UaUZs^5(
z^H-5Sbm9Vqz>fqva3<zZAHBHu33l~=_Y+_ox$e8|dQ(N3+t~}lTO>e9+F(=CfG2IR
zmram86PMkTbJ@qG^q=*i^T-tcWHNnnc=O~2HzBgl0-=)?p9OYaE@%YX=~81zEjql_
z9%z+Jonw$>ZLqD|Hm7adwry+LwpndV+qP}n*0gO*+s5thoO>f~)Q?>iv42(U*zd~B
zXRTa&Blu96f&b+_gO83VVDbdwG<NF{J_*TNcvUYno=radF%(ev4Yq=G#j*j2O|kp<
zEntN(A1bo%x1Ym3n}mJX&zxK00!1r&iTZRW=-n`gEWRtc%bRq6FU_a)-n*i#cm~AX
zsl38CIJCzRq|_HX3F{xl=LI4$3qg+y#IV+8fi@(DgqMyn^zLR72$XJO{z;S1vfB`T
z4&{&+5??IGn{<boYN`9c=5z^YSirnqVmPwj*}wP{J8Dp-5o3w)KXDMY3FG2LY%${C
ztilIsdF*trsPgNZQG1KL6T3u9?v8T$@K)5<OJBYyu&cxLwHVtap}BV@l1GYSujF&X
zA8zwLQJPHXApWo`&pr9d?i?3w)T}C0c&Inaj@v^$1!B&}V5F5+1n~vX7ceKEuoX_a
zz*RgYM=_fkj09Sngo8z;2e+)`CzfmZcu-<bxjtRk#e7bj=6}-;u(j^jY#oguJ2?;a
z`7q-O%>LnZki~B|+jt9#&$Vh1k$H`a;UtQOYq;6}j&s@zR(yKAkfF_NxPCdRD_eXQ
z|Ax5ibiYD;6}}2SE$jl=VMdqUa@N9!g$(pMw|~#o%Y9G#y(<_xLVOx3upp-rNTXhS
z|BE|mCj!}}j92XcRbPrX<%yrTA8nS%C$+D;UB>mw&!(k2ZEPjL;wDVK?gDdr@c5w>
zy}q+GrTm5Iy%j5_Fb4a6c{G&C!T~7kLsdFP^tbg_e9Q?W5YqvCW9ra+bYjd1(eB&K
z6@hF7XOA~k@4hL7v*++TvH#}T6JSy1vr@@ZEAARk3X?=v)u5L?!L;~s2GUg$`k6nz
zE4D&nxSl>onDH`k1W@6az2N!+jh|=nY`zBHl$kUy`!CR@QvZPzB204-Y8*)8S2P|&
zl+nlQ-}WdFO!WsuVo0DUyn%1Ra;P<+4CHp*+ow6NsGEUaVU*m@IE_r19wV^EO?#u2
zr(i4@De&KZ?dxGOh>G0Kn2OR<j@?n!e~i3QZJtJxa^psPHFB4u><x$MzMDKHN#+dG
z;M`k0j+cn^5*|a;wd?>(vyRgBtj9d{>28=$;1fgeLWTg;FSmW}1W>q}1ekFCtj$$B
zGtzSIrq61a8;ZYq;K~oc$#OeoyKa+xmu(1?seJ%n3|@H7Fgk|-Qq6J<4_R7ROc0YJ
zPi|x7nhY-LOPKyBkv5o_zqY?s^c(VoSsu;i5v&5*vG;;zeT_Qka8(;0Zzp+UWxijF
z8hd51P(1*REgujkoZULg6PTD%z*}7vep4F_O7E9d@`nq4`-j1TgiK_lzojWXVlfK0
znlP@#JAsL9@B!fbO%`MG?dS&Gy%PoANLs2NHH<?_NVbnOTS3E3jj;7d){UkEnq`C|
zAk^Mm$$Z;YNx9&{k=tY-5#q{(fD!H}A~l2=<39jy#`xe^vF3UTg5z*S+nX^x;w{47
zuQ@-VzoT>6s0DJeC2Cw#KtFjveaVl+mYE3e1x%mi^@JJ({bMIprana!&A-|dY6~Wu
zivIk0rvzbZ+WC16cuZf{=_dxu=VaOtI5GmwPTwm()+mf(nf3Qp`n<a}_+0;*h`4Wc
z-f;$evGDkSe?<9s$ol*Wo2$oz^wj}-a7f>v;cM>|9C)X|6Hyz8{2h2b(%O-PU99ap
z^LrojH_{y_deGsYJ+(N3(^Gu0uAmuu<_T?aAz4^fdf-q&S=hsHbX+Du*+`P30MYkf
z&u}jB$8@h68Ad}*g84jgb9g`t1%YW8PBt`vHou`JN%?V^(m<ooKZNVU`ojqG^uZgG
zw|RQ1NSDHt6~j5a+uu?}fuR<dmJL4-8}vN=Ut;6}y`OsnputPY)VfH~*TEHLe}3~f
zK@{kThBbw|-NLvM=RS!vMfzr-h<5f_aO4l$N4OzJ^&(vwDUdVcJ$_AquodWCPy))m
z%jio^5iiQwvE%!NQWfoHR_z~o*8^O(gv>k!QtO?j-3%^Uk}=9%&(0DODW*&87wuXX
z$fns1@y}1kfAw{%&hpLpvh8n@JYE#Ir7X%0leSDyE!nJaU+OomXlyk1N@|f)SOw7?
zKV73`bI7YT$G{+9r0)i{x`x?|W&z#|=};GIM;-^h`>nYIMoix#C+{alACS{VwdOy5
z7C&J;9k22@he#xOb+6gGts6xDR5x2Ty}1A+{@t*7#F-tbbl<krAbbB>&y!E|ujbow
zpJKNfRh4IoKnnPPF%Ml6A`=nI$3;1Hf|P3Q;!RFI1v8m<IkJW}WezCwY5<4{^mTp)
z<8gQ19G;cRv7z<<Wg{phIe(6#3ullQwNp3Pe{QuWQH^(&LB0lHsKGmXvJP5wG?<UB
zvV_h(YIVuLj}J;YAL8u)%6<gFtW`4UtJ4bKYRoZO=`jjng1-!%4ailiwiPcjwDh#)
z!9#V%KkAS&+~;0}7C@u)@1m+Q563!L@AW>}`nl)#!9jN^DpycljOEGN6|C*S51ABK
z@nWa`UMQMOs&OKoXGc|ECBdu1KXJ7jDj7GVK2Ma6%G#F4D0gR!3dXo8c^aiBl5>M&
zX9`waKc%L~AJD!Ow>Uiw30w54KXTu`s<Fd`-*QQm0>(*RzW`jIuYY)61>eL&FAs5@
zGj!(AQItsB?YU#P0(g0Cit4&hbJ>ZGQl_5t*FN{IO_$H!roJE*w~*dXNlG^JUB-2e
zx#B>t<HG!2yt&zPJ!LAzB!UgtDQ08ec9GwV_e|Yb?@Kgn-!w^mp9;B5jmmhE0LJp2
z9BTmu(}I~q+kpMX-z>ah=Xdn)47K}*%l+k0)wKvBF&fn<@;ZM}^$l-YS`bhaBdT$1
zP>~|n%4O$iW@u#uv1*FLVQCZTI!F%@4M((MyatpLBR#B#vMzEwlm(xhuWgx2<I>OI
zlVsCuBn)7lXNBm=8Y9YTtg#3Eh?polg%(ykFF!6f+5uA?NqQbkt0A~v=8<lF7rN7T
zF@iq^`~Is!Gm#U@sB`~zPev&J9}R&K?fGmzK3CKdscNVc{hE+sDc>eCZeJSIF>9ZP
zZuR(Md(}qE4Bm<Nmt(E~@>uZ<j{|mtsOa+5sZb9Vous<6<UqY#*}ogsv9<|H@s4DV
zfk<t30+drvf#(pyd*J6$@&nub%ABg9>Af+Oz|rhkNKlSg)X!1$xXyc$R`af21VwH_
zvq!X63*wlS0l}K2Ws@J%>@4+<XzDNdNYyo{tIATZh`4gmp=P46E8t=?DI2^9*vN#d
zn})_ZL*$OqE2|@*bJljEl_Ov=PNCO(Dzsw}1mxXJ^B0L|yEtTG=+R9Im0;9(F<ele
zi!co@&)^&~>gRsL90oCdC!2lIX#eYq&-2IYcIwm8CUY++B}U8)kLp^`=jY+;wh@KC
zopE1BHlX#)zTD%#3x(YJMQ6$YuFI@biqBByv`wd%*7fxHB}IUEKly{YWPvKcfEQsy
z0#voutf)KE+A3p5ROotPgG!ykPyR#Y9h8_PzQTrhs?8rKBky3sk+d{DTqF5xj?W$n
zv@uYWStpSYofLl~KMGmxwY}PtU$XG^^!K1_4z$SRw)<ldOH_$QN`Oetz<9j9J38&-
zVLH+rWS&f$k}GrpV=AcbQ#hI=OEVe*evk=$k~l#ZZD=-XQk`yL_M$_IG$j&Dfspu_
z_*`X@V2z<!Ag+C~-Ma#%PPBi!sdkzWsWiHle~%L3vg=4?@j$%@;}asLEhUAaKMmp_
z4yCYvDbFSbmHc46KfS(}cpjok#%YAkweDlklU4II*Bt!4gyt#}9mEAH!;TYxyL<xN
zY19SGv;rFTd~j$Ysh!CF@v+gl)jqrQr~78ZFx^t{H3vPd&gMj8k!*vRk)#W#d4lLF
zU=rOE6qNlmj#oJ{cH`yy!WY_oeJth1pq%^)%R}y7vuo&|@oYaK$_yvxL2>Hr?ForU
zz#}cGHcGu``p0v*P6Ci6#%En=fo0WQJ6!*!*DhG2?EURoJ`(8U8XvrqiP`CnEM
z{M1@sR?)PI->3_W&zPYDJKZs*?Kq*o=E|k*Kf8#E9>tc*Y;+m2?OOYk%NWFocZsX6
zj4eYRU?tw;x^B$aQB}!+e=0K8=B0KsOM>_r!=Uzf9QJW0pf0q(Oo5RA*Cp6Jma_6K
zu1oqxSKgn$0Ubg9ut!tFRCe&&@ixDf?r><P3A<dwJmr7A$ut*dF|bVx4R+rk<%Yu0
zBbXQ6tn&ufBk%AotYHG{Fom%rA`k9^Hrtd$ppZ^;_VX_N<EWU0H^gm3-RKYXQW}Dh
z4#<MX`>P@0!%2*#c^o7Uc%N%*n4CL(LTjeHh8mA?{%+Pp-_spxEiaghM)iIaM7dI`
zQBWIf<?-f=d{PZFBWkrI?w9bq16rf%Fym1P>^4sy6!JUc()fEKbx<;#6Us1yDnh5}
zTbscAHQx8P9bpr&!dQ$-+UknPt{89V4UR1c*S?{l;jwd>I+ZN}@K2wWZf+KB6)Q^E
zDoltaw1p{#uFlf?h$w0hDH@1bnjvFrQ@a<toM(xwQ20=(L{ah-7S%N+!n#ZvN_VxC
zcr4J)L83NK9&seY7nW>$zeX5l$KbTEdxf^j>E;Qv^S=MdL82rPqz@#Tdo-PSE9F*Q
zvUT^52U14SF{YRV;1&wM$G7CJddfG$;yJ(Msnos}jndwD)lSF6@jZ`st$;0_%Z+~v
zaj$!FXA~gauvQ5QrI+iZYwbl2HFaWdOdl+FX!Qp4y*SZ7cdLB@FD&)cidr5pjBS2u
z2F=aEBpq_rfyixc-FZ82=zIBIg9Wn^G+)r=S+GD`@5ojI4&ZN$ApOdO^p};h7qS?m
z0zhL)Kw-s}Cm(EON0@(jglgpeKrql(lT5&(lPuKzx`^aNNJKp0Wn05t7}~lO0XZDc
zY*L2`wge-0Y$aU*c8!M%!>fe1Bd18sVUg&Xv0hlrITXRc_H&d1y~Ai*(dNN$UAvOH
zG*b8@#<j#xCc&M(%z4R+(Jx`?XmlI*(O2Zt-z|_j%r5@?@W=y72RdI&E^8`hX&EV8
z<r57`H0~A>nXW9_?jiSWoYZnPha$j-YZZ%KLql>yuF?*8O?n>d_5RDSIrL=gh9%)J
z(Z7Jj1OrE8y2N2sTRTHgL6_31k=Hz5ldaf}y<%|zX*2sUHOtelT>Aj?n^{eP%49=r
zg$Ud3d1w5PM$?I-!RLrV17-zT+Kjzq8%b@UT5Cs-AZ5}<1`HxH?n`wCpJ31wDwB`-
zKg~9pSdX@MK((}b6a}nmZ5>M!?hfLf%iJ?0joZ;rg;u792t35{Fhk&0%4_d6H3K(+
zvP_A9NwSD4j*_cZxdWVLTz=2EY)jTbrU;3cD0QszGu2DMn8n_5(>vqYK4wT8@DwZF
z{zvy<zRe(BQ0^2lE=j=~a<qz}yxHv)%rQ3aiFc`K)?KDwuB*m7<^mZa-6FJSz6d?F
zw%QlnA|A-#wC4doWhhwp2)QmO6}(8M8`L3yuFpc$ZSq^$tf*NnQ<!-0#ggB2o<c3*
zF_W=rn!j0Uh53E%ug!<)=4@ZjhoNYP$icQV4<iz;OtUzyyxkL-{lgycZ<z#nuw1r%
z?CK9_)pPAvR4Hf)P4YZbmX}gRA{qp<jNk%Jsd~;^k>7Y$oZ31|{ZFaMc6|LrnSCCB
zC1cuaR|;^fhNOGDUN21*;q#Utcaz(N>TxTOJ(sN6f91xro^0+gQ@rui2o`%!5{<6a
zx-AtaMQ%zO$La~*iZH=6M|XGo39LF`x*8&d@S}qEaL&h-L;@pyB`8RL;H5kxZW>&i
zrC#gMkc(?t&L*KC=aE}ihZNvP_;+*xdWkF{tmo3_9a@zTgA+~#wYyg33QIIjzQBFH
zJwGgpTrodvrl9rA5P+P=LKUs}YDZ|pL8q(<&pGZ9exP<l<G|!tpe^MV5qK)}&`t8t
zSQ}FtBx(bkw=xA-?fW9;8)vGieEEF({8;R~@>b%pVadif%LnOagTvh1?-nb->}zz=
zYFI7ve{3;9m%*L^55P;Z*-eoT_0Rl$aJI!G2p3WG+3S+*&dkjcWO}JOJsUO7*)qQU
z)5<t>Ffym*ts-R8qVL=*5L!6i>H|)*YW739Z6zN}cHE}$Wa4hq66Ybzn-`<3fB9v@
z{#%=-(#*(#D$+`=<K<<XU>jh$<Ad^_MK&@eNDgA1-Hbuji-O+c(XkSPEV^BkOWZ>{
z(bpHz{@;ElGFn2at1YyYrS;{lEw5;i`W!I_VNJ!AhWU_4y`;zlI;!!fk)ghb#SV8d
zTo(iwT-VMx_LCd;+1Lx0Nz`XTGNiGQZiLrBys?5H`#CuBQT5uS^+$j(RKGgADM%+)
zl7RKdtUk)&+3{><+<T7`A&=9iFOr^dt<}G&GZA1Rr{Q&<VLBZkODmv6uwM?D2NH&a
z({9!N)&_isA%C<uNju;xHAYM>V$4;i%QAL=l)2UJ&u!l8s5eAknw@++vPgSJ08J@T
zyd@PLzS!yX5RaL@;_84n`nS2P9~*^?+|Fr{hxH?|)Ao8%7RJnh*aOW%e+{h8ULBA5
zoH6Hiv)%If_WoPVammDTtaPym5eXs%MbQVfoNAxz%nQU(JoaSyG1oL6hOb486$U}=
zUKbnBt3~H(%5=%9>%9<0g?MxTwsCnfOQLe%C;Tz(L}T~f6czP=qQpZ%_@!99Kh>z=
zqbk#hbW6RgruMvFDt3g$Uy5?=r^pEMhwC`2^hC8Q3uxdN%4!IISiGIYkt->Xv!g`h
zYjqF+OQYpA02pwm!Yw*^hPut0b09i_vwqaWLdEPS;|F3aM<aU$An5&wzksT2wpfGJ
z^iXtPvy<J;@k)K!OieRER6)R-4DJc}P<3p*8t<x6eWGEC?#39K(EieGv?HC};H=j`
zB)yICpWSu?b!-2<Y5Io1W9|%j3z5ZZQ8!CQ*3Nc8+61`icyp^RyHyX{9m2AYP^QZQ
zcW?+*JY(_13X5P6Rvzg%DoJAsOG1{%iXIUvSB*|)4z?H^*CY6<#fUT?4l3yFjC}Sc
z((>pehsCWauI3){H2Gdd;3@Fl!iaePq!uaM$O`Rk9Kq{+Kz{$F(t;=w=0@lT@}xqg
zfIo#<TMmeLR(j6n+=ni$w{>f$mr`oEw==FPZxNq+oBj~5MjrQ~+wDtcDM_Q!V5Z3F
zS)1=5Nv#vD^8x#7pXrWflh9`5h8E>g{S$ESjTQkGombZ7urta{&FG{>jmR^iSff}<
zKF+EX<$`ntvyWC!n0KDv=HY=v&%+M&)-i*$A_Z7#T<kX%V(D=H<i)oD5$;c^DTbo*
z?%-w)o7om*EAtajq-(a{8Tb{^t+dw+vq4{ITjc4Gx)+P(Rf7|Q<?m|-v@W{jx($54
zQZj$kg8xy>V9V_gzD!oqAA>nVg1UAQ>dkIh$<C9(+n5>`gZ^?Our>~+f49Sy#cPPe
z`wPJR@n!E2WKa8EfpFQmwWy=^g&L_Q$myyUyG`H#&0mQb82j$ke?kjfnQE#Ee%^rJ
z2z<<v+9s^XCa%RGe{q*+KOFacRByZl5KvIY=ZLYo=FqM{wf+YRI*nt~3Z}SG(w{b^
z9K%NC=#~*A8|4(Zer8)~z<4r+dYh^BDh_zKKrNerEO~@GovUT}v`j0q*G{Sw-x1*0
zNubWfTQUvw#8xf&+ipb=ImVkW-&v<QJp0m)=?NAX>x?dNbdTN)#xa5>EXDf0aR;KG
z`ZmK5kqmLlHfd}sa1PUU=n1LwPoe&z`Gqokj;1+s*|mAC10)%w%E;x!Qf{rv3Ic$P
zW}ib-9lMe%StLYQDrr!$$nqddfOm<Y^m0G@VEHSpr$4!x+S-KvRktPlZ?RBS8l2%Q
zXP5P_D4AtlO+IjFkvghbk^66C&+)x|#3n)MGk(m@A)JY?_likNr(gbsfp&Mq^-+f6
zEhh<ZGPP3>x2aurVIvcUuNPInVzB{8`Al_fW-lEbKHORb64~H)g)ZtfRHFrBu^NF!
zkx|WVMFX&xVwWr@8CJ!*D2}Nl2uL!0D5Ql(p1prL*WvuF&DzLAVmT3=MmDnuxfqdw
zvDtd+Ra*IsMtxdKVzY<Y4&t>l4su6Qi9`Y@WANI9wvSg0JE{j%wYFGuUv2=JJJE>d
zPW&o58n!s=J1CvD2<i%dh6gns_GB(X_6>RLeBQl-A$fRLhhvJ16Xp=t@-5i;43GC&
zK_Ras9c2FqfX;7#^ruWlk4TNckhUhU>!g^TF|utl;u+1cb52zwD@7w0T~*PJcZ;}`
ztJ1IRBVSW-iiX+6{GNO?VLt?Th8BB@msYk@ZvNh1))CY`c%iUCS!cZuEzTsHtz@3{
zT4j$N5guzSH@dGzaRiSgc=405O4FR{W_#3jh!PuHIy)N8oRvP$SgfdC9%g%0{nR7+
zR%q|?FUn21tM}S6!St)m*`d@pj6Hs&aQc)YsxjpIx=40{&)&j<zQF<5$p_`)?VT0!
zx`56t1;Cr~VGW=X^k5szB%dWGP&6w@U-n9Md+9v_sNav2+m*H1LUdV2&MjN8w?8-6
zt2+xqP9{Fr92MnpolxEz?QKiz1>TR}8V`V_CqNfFvSTK$WB-`0M82B2L@xf5#GZAZ
zD#;e?p8GraB)sytJ_ro3fO|*$$<Y2ZR)56tjmu>_F#kKl9&ML{8GM4_sZudKSQy=o
zxC3&Ey^V&LLP)+tBXJ#>S)u6>8A*oQ=RPS&iO*On7|3-+%A8NF@>9dy(X<Lrmo^>P
z;1;H!xZZaR6+t?e+AjH*fi{-ts3o|T!AE~ALf+%(9rMN*mfrxfqgC@d(Ng|62G%1%
zQoiD`bh7uaKAO%3)hG*85!kVU5@QGsY~41<2kR+M#>hD2yN8^U<p_XjaGK=!)qIf&
z#K_MQ^PI>G37hbvCFB*Tcei6p*kh++=5EE%AB;_-dl$=EEsu+x`_O|=1oA@6r0;_O
z<_S+Q3C7i`z4!r`h0!B^w>BzU-bP@T%CEVZ$HgG4ncxzH1E_{R%-R9<c_@R<8|#*E
zv*S$sSf3BXAtzSXlgS4oe@_wkV@@$(whRr^>9o1d>2=rwZ3D>G9kE(gF4bwy5#Il;
zqS!nH>Wl1OF_m;gq9H+*bl{vB;l;$~tGRNDhwASL<@N#C)xlP^DVSMj<uM_fTuDUm
zT?#-O#7!j4x~4@#i-dQ}&r|HntDB6>%PF%xJhYIC6G2H}3tSSy8^M*hr4*6fljJcD
z#YF!pqwQ<Yb3_o;kSdn596Tmq<5|tmU^Yw4(pK=_Dj42adtU_i*J=hD{DRk_^%Uli
zs5=75sV4_mrq1!5fax&Om1Of8zydDWJf#{+A8@jRWmjD(6P;=@SAP@Fni<`QHO8O1
zOO432LbS+DLZ9n)CW;~f#stO3-E}(d!;L?lG|Xt%=+ie-_NoCC5?^~8<9O8@t^|%^
z<}+-mk#l*6{VuqT26+rI#TaiD!*#H!>1-Hn<c$EEXpr3WBs@8`O~EJ%XC6wI_#N^O
zb%Z+{@ApZZSKE|&Vh^NOIxIibeCX@D_ZT@3G4><Y!fHgGrW<>!^xdPjp00?8S((t(
zkilFIC`p?OrdcY}w4pp%?s{jf|Ekn3e0%--Lq|uyQC3Rt1-;${n=EEp*XV>p&azv_
zYQS2{&RT8Sq<1&9ZptibYj^oG`*_trE9H}<I<%k!?K(%VQf67l3<Z_o;I9H^>X6=t
zVtAJ2W_l)g2BM0-pFv)Q$a;m`{b71HSgif-;5RGXm*-b!Xd=b&92Oj&-#15FzfxaM
zg~)piY_ZyrKtSlQxT^n0Xo%p9NfDf*D4^XtEt9(w%-n$_I}a?KJ43M6vlUw;j{F{n
z?GGv_UB9SL)2aqBzEsh72Q5<a$(D^CO=|TSSGnGz!K`Q^gat#b_tMp)zk%s@U5i0H
zWN#_1%C!1rf$LINhr0GpBb^IIkW1=UrhHWax(I0+Aq@zc(e_r08}|KGkrj7<ISKJY
z#cx6eOUp(u(=L)EB1^CwjH^oYFvX(rI?V)e2bPuk=hS!{U^GCe+Ng5w8hxQyvyO#*
zX6R*Es0c*G5#b%EH#Ps=ia!1Bn(O_e*CxmHFfsE5-C)>LHRGIIDbfXB5L!JA+PqtL
zLl)^DNzhJF&<a~?zClD(Fq2>ctTdvy^vK>gWqJk5cdsY16uC9`F3v*}T(r|i!KNeu
z9|r>yXI^4P1QI}5wmkhaU*an;Q{eT*7UC~7%)I`~t7Gv7yneQtwW30;rpr?j5X<n`
z#eKVbDR2sJ>7Y|8?{B$g)+-H;&aQZ=oYQqwvf0>0LXk`+@P7>kj#u6(%T#eGQV=QQ
z_}3ySMbF06q#_^~xomon0(>7xQQ3c|%?}+9Z<9TJrp5sb9dB{j`+KP%oqcU>)!a=#
z&%Lu}y1^&Y;H0Frq&3a_x<%-+IDU1sF7bhV{8-%Bwx~&WP9YaJi{7pQX^EcmABV`~
zOIDWFw~G9yv?Y_FYg{gF8Z|@>=^*I<QDhraU5_qCy}R0cyrCPke)@rG4@R*p9^H8g
zt~8k<Xcs`(h;OZXuA2|Yw3!~0D>G(g^kCs&kO=S|w=dPrV=11>edp~}E;^!&@VXl4
zf?3hgk+ol8N@26w7K89?V$_Bch!eZebrED_qt@(SLRy8KJ|j*dtT`)U1ay5&X4V1s
zDX1{n-pgP69!;397CZmYHn*{A9^WcHq5lLXsrUnyrxS8Ls*gzd(TZ11q9Nr9SgSMd
z?|DV7;7W$Y!n>t)y~&V6o@u%L{mTy&VHvN(q)xOQnw{E7_u*O=Y7H&{q+<p4+V5eA
zZ6_Q0JczQ5#-vd0-yU2fhp5PYM|XSPXnwa0s5jhtU*mM0<*+}`#Ko9E4ep|}osz~|
zJOcnJXG;=?(7j|wXu0yr)iG!GaBM{~EF^MsU8vrLR2JZGNjMrWLO*Vnk7VD!7kat^
z*WS@%)54$7;Z(g?lg!=Z*!I=5WQSHS2r|+n@b72W7ELV!!Sl+?%kAXruqzhOdsW<s
zTqOkhSuMpHH0WWLAvZFexIauIm$K~=rV9XwUIX!*OiVOopK-I*HT<&G^r-CO9AT=U
zai;X_8iq?H3Bx#z`XFkjQWoKG{1LoU(yk^=mh(Mw671>i?@2W!u})Dbco7eJ0WLRQ
zB;uXK{Ri$37;K}bOYI6Q<ZJ8#dI8ZEP~!SW_B^j1eY?`sC?ndtrOn=BBh`^2tqy=e
zE6EbLAglZ3w%teWxmbwf<h&0eQBXb0jN-&u;9WWgk7qW@ymeol@U8eBv=eTB26N~*
z{0|fwl4NI^Z&EGE$kbpAp<Ca(zic=%=lU)nmIXVlrCKOCcZF~E{@_LK0k>M=62wyP
z<?>-{aBhzTp-)8g_n+|b9G@1}u=SrE_TyjmqQ9boZMykj`Hzj#{7LBF^VT1>m%re-
zM&okS{8xmN#t0*97fSqvjp3FGf<1$R|24vHf9BOe%UjEYW^HRA#ATsGWqIh4j06k0
z=6rY~t~Ay@%*qA~%O^}B9Q|~%;q0}BWZW=O5O`I?NpmmlhB9a1ufs1jOXdNEjAycJ
zoHB$o7hMmFY$Qq0yB)J&!vnw*(|C=WF6)Kjr8lAyhKs<{;SIJb9CTxXetwI%k`oVO
z#Y5vq+3(92PS3(Cfy<8DIM1E&Id1xh_kmt<tRYIk?A*#oz~%5<)qJN`@6gA7W0hg~
z0o1^CHh<Z+`U^>fMiL5x(L(_w`Y?9W4>NZ|uy;c>w?qGaiX;8qYUuZ~UfIf<flipN
zGs?Jkge7}Bl3ItWa3gU4UR?pssDfX>9Hs-Oe33ER1XFa&&%aTTqUwD$X>svLDa*IP
zM6V?9$^OdAka8l1NRuXs5Y<6LiAx_Mt@!G~(i6oWD`fy2rHR1_Bq9K$6`~o%`oJ0+
zD{u=5$&>2nPeRaCz-}=?z9gi=(=<mUyV#|ya-JHj@asM0^Q_Lis=S2Qp6rORW%LVx
zzvnJAggCSppVVZ`&z#D4hscB?o8ciiF-g3yp>0wq{(L>(W#CG%q1OFlBm=mJY-b`u
z^MBru9*OqNsC>h<9X<iRNeZwz>oLXfFo;&~<>u)k+g!Z7G*z%H2lA4Y85G9unw4)A
zG94a-;w`!%!C?F>v9f)b{x9`Wrr!LFRoWX=KAmPfcWte{JoCJ`GE0iVLlW|u6`?4U
z7zzE#Y_w`3|00U5Bx&RKL1dQVa@gs8jA+zE?xfy@?&!#LC8+_FmW=%{pcCPlbh{9s
z6U5+2O#Lv;gyfp}{GywA{F{cGzXO-#t@=Gss}k}trX<%<ny0Yt!`h{J$T=J&C++fa
z5O^K%wT)C^bH_p&wcR2G-H2l0;iF9y{-7M!8<N{LkOq0$3>?<yKggz_7fl$87_DU-
zwV-<1NGd>|8=?a`M(M824zs6X5W%F3Mb3~3scGynNE2cy5ATn!o+JgST0?ck*cM>?
z(pxfNu~AnhA&-=mM8iwh#b!YBT-pGd$PJBm@mcTm*48r)SdoEFE8wQ5x5(hdf<SqB
zqCydY%23p4DLHc${F_rI=12!rk!V3^sKQKn_9xH}L3e<?etw0x_<<Zv^QL~*wo%Ap
z<!*9fllcV%Qqcw7jp-n<K2sU{&g7%bXUPq@pOu44vdRe|Vdto<)NT`H9?k{5P_9Ih
z^dMl$brOQyXh6%NFi|*F5oo|bOx|F57-(X!MzKJPVc|H7VVxz2i5h{L>#btFsZhmR
zn&+KtKE?pc)?Vj^#p&v9-M)JsWn<WSRcldPXLXi{*6nalsjYm+o%1b$GK`_gjS9mw
z1mK0tm3-1Nhn?U|$or7N-<I7HVZV-@b9m=kxSOafQG)&=gw+@~G!Hl<bj~eRVS$2j
zaUOy2l&rtsDm6<?e|1ZEt;L*`P3?yY6!ZS83<3s-oVeTw7C-TUVMgg=bPd=p<#%uV
z)ywJo=P}f?%p4YU3!jb6cfvHeb9l8{iy*7x%({^FCH=kbJ9_b8@uYRm8H*J1yVUBp
zT`e{|G1?bh%Q^@ko8sVQIBJU+aYG^|*cqQKv+f%&adk1-hEE2MH=#;BFN9YK+61mS
z_csqfcg>vHQ)m$~dq4&Whr#Auwz3cl4)`PT#aTCycdo`#>4mm={&0f{$G;)_fAo<o
zKAbA7+Smp(kURYUeCTXDpJ?039_?zrUp|%oRZ$kD9Jk~wlV{AcMTl)2b4(yyYE4_5
z4<cwD`Bq?Cbad~rCc}l)c5h0;JkJ2!1sTBQ=~(ENHZh+OMdYqcsNT)oJeq7W9=UBi
zDWtwA_BFNMka$HpPMG!ZR*_bw>PW~I<-aN3JM)c;-KQciRk55BSY=Bu4fbn+#n)Yf
zdOo<^@VyJv_n^bSg9B{S(l?*?+q8^MSy~nh5tCsc?+MN;8GiVn`Oo;wZBamH_1QyD
z;hJqE_d`!Dwn!*ni`E6>sf8^LJ3$NiU<zWi=JDu+^srMiX^{fx)6lsrsDmglQHM3T
z!fG@TcoU<jLZW3rClj$A8j$*DnJPCLb9E-N#Xnu;EYYMR-`3OL*ess=hSnAq07NQG
z&0-w~x?T)U_x7w*Qr1Us0VlxsIQ<E!9mz8s@l(KC3B)B*c7Qo@bEy?XV%m?UBhfpL
zB>;mA9NGA3r#G-iOqd6G9FLq9|1Ov9_ZkVcXNroB<I}@S7csZb!&dDzhX`A5wNIDs
z-N30w#OCwT=^-)Rd4M6H`Jv<lG+y~MPqBMX08yX#f1eTN-P=ZhU;!cTe}kBkq45Gn
z+Duv9C@NvXx%qg=Jym;^@BwvUpZviwwqf->({zfp&jj|}+;}=>C+gKeoe=JQ9e!pS
zX&p@-lz}t}3TPlm`oWFW*fmeD-em!I|1y?!ja%F_*K3o-REz7lz}-G1(ec{eaw&d1
zL?}y6N>{XnAJ#{oUI1faNWB-D(WB3x1IE2yKDs`8lxmBf>81l0h;F>kHA)97vF1Y9
z=^WT5w3O!K1}=G73*DFsZIy2Qzn;pAn}ecHO@~ttHMNk|o=L~W3AJ)sF-1_YPM_6w
zVMX85`I{k|s>``8S@;|CD>)L|JJ$S+C~Ei{71=geckAtIY5|58K@8D&LvZ>jb(**Y
zm@@B>$ykoM0;>YtWg!s<y9YGk#yKM{39rqxAvXH{y+1+sypyzbzn^<lbtc*=&W;;X
zB+v&$e7GfyB6~eT)06THGx{(jFXaZB)XKZjy*7A7qkQqpOj$N4gwl~H(n`5M#UC|F
z8E;qg2+c*p9so<ov&ST$lRk5n1U5nRgXx2_`WU7@BiT*g%_Rf5?P(Yx1eu(f$}j!V
ziL=Mgs-G{PbftLs;VwsP3hT)V_Qw>2p41cyR~U_h@-J2@hcRj5?aR^1^15u71XRN$
z0n0cwR*i?H?KRUPM|o~pZS5T0m+^LS<wr9KF&2zb3V<>FQ>eeCPc!siSt-Q2NXK17
zsrdxEPRGr=@vzwu&+Iy${hS7@OGaC!buDKaw4PcPPL66Ojj}@Se7an0Ix7>Vm0t2z
zn69QgVH=MvI_+IuZKTr}<A?e9P4MG>`W;5cl}xcN2o*=->G#akwB?q`iwu(I`x!nJ
zUo~;(3ILe)3P1I+>!o{~5MABnWEnI<ohFj~xe3VVKLv~KqBO9<QX5Q=epeicIR?>*
z>EFBBBee`>e==a##zvdy4<*dlZYIvXp0t|b+}LO9c)siz+x4nfGFPS}mo*Mz&rB=V
z-Z)<gefk&-uef^SQQmLVAbNm%j)R_QKCBDR{on&UDw>1N(iM3@xr#eddys)K0Cd0k
zxrj1^I4zIN{v<BRhyDMf9J28lmSTu^-3ur1Y)+7R|4iO)@|ffirK7rEp$E^=g^h#B
zAImvclGb_LE(a+3pTg}-y}I`JQsD?#E7`CESAm0Vb`JHI%kutyvwy(fH<bAR#61xt
zT#7QHI@~1(DIG;n0KoRR=V)8J>{tp(aw^-;=wKVSmrNkwvIL#{xi{9}>xGF$PB;fI
zbA&IvU|jrW?#+XyWE=ebpg4kanZIWxdBTruaVljU%sbrLzEqa69`md|z$&U?m$SL_
zBb4i|(d=WY^3SDIN#Ewe+1LBs+Pt{V?Fbk%nhYlGFIa?6K&QD73gGiz5C2|M-Dh=~
z4?}#iC^`1aZ}M|X(mWxQSyu^7?3EaprTZ*GG}-Wo1_xfnLG~ZuHor|zc?W!9yl7Z^
zi0k*i-`;aIGO341xIIh35g%j1uf!zFccg>;Q$v6fT^=RaOOAX=u#<4w-fY-<de7&m
zS7n8+a5C0s0Hq5Zc^4`J)DE0}0bfT!feDvR*(&AoStAx2F-M$pCgHkTXMPLbLZG^n
zp*;0`eGpw@5z13#fjhL`72C2NMtA>ceQg8dWb`6lEh^iP&MOrhcX)NYQ?<SgE`F$z
z{msnGlkzD106dCakQ+(obyfYhz7l&OuaO+L$7m)b0LA$fF0@v>5T^G7O2RAUc}UF_
zN1W})tLdFDkRoL&3QZmA!s?w@SxCkzXAzPRwvV*USwVnCBQb`PDc8Bmi`PxUFc*s7
zaA0X}7n3YOm@r_OHhb4Roo)ce04pqym*^rZZ|bM9(xX$H&ka7fIGy7YE;Zt^6MZv4
ze)(q=piV$#(N>Op<%EG>AX$1p0*&j;ELL<hJG~tEN{^FmicVoVxf#t416<Q)5-M2l
zMhOff?mOLfZ8ai0sOh<8Odc2_>_icA_`RvhP%A@8F+4PrW5=%o%Z1LBoX#TMttA#I
zt}1_NogE{eYPeLWTz<>n<m_{U&`|L*)Yp~(xIZk?LDNke&6gM+RCX;?ft|MyecKM4
z*A!ACEu+RpfUsaCE_Eubf1_xy+?UzGd0YZVl_|On%149?F_{QHB*@Ls`1akgVN+Bk
zXP`cb9Je|s%kn{7C)@RR0EUr5OV}<r#7r>91Qdj$Ve<W=5>$V*%y)Ivdk>zXW^BX;
zlq~p(#zb4@E)3Lba2UiHiydpaRE;#v-Z|5z4UX0B-_bN!$?DJwRCZkPnW#IaqYsdb
zRgP7rFGOaZ-<LRfhE!3L``NJ^&&{vJuBUgJaz5?0dFaC8W#D%O;qsK&$7`?B3hgDf
zD7V_G0JesI7N#TwWVOkfoQTWA<5WQaws<wF@;gD4zLA~;L)cUKOr%nwN>kT|Ux!W4
z)O0f#TUM4_@Z=V^n3WV#|IxK|)$P<?5a6~a-`JDG+ejoZTGFOLUhZjMz{e)JnS9Ci
z%T<(UzU$JKXP5}7?>>m-&`mp*3AtQCcO+OaBD7Q^*h;g8)wxr58c(h;o;3*qzDRK`
zGxE6?kFzx(M8ZCO@kLG*1}>GCu$UV{pxfEuK{_2Dv+i2RjTq37F7es(O{HdV2>J{L
ze;rwhJ8q<#_^c>9Snw)KO_Y;%%tmi?OBFzz%V<@dxru%qD~WE7gyE;KijZ`f6ZTGS
zfOp^_+nSvGTH}&@8Z{ptd^UytITFszB)|z#Z`iTT6o)4JKuX)mj$iWaiPU<)4O+HJ
zM4y`)QSP=*%xK6qa>svqFw>Cw?OVd6qEI^C(nu)F(83_h(&Ja}n~K18af<Y6-?EUz
z1JUnO=dV%?!pt@J@BvcF+wpM*U3aXa{)$rpxbd3_I)3QC3J95SNT;a*y5f}+M-i2o
z43>M)RJJ;`Zscs7k`WE!dfBT9qh!>UT)w^1vGGY1AE&n%{aWs5HOs{va^0Lz!F_8x
z%qmDnyj1AU-``7&__q;IdWXWa*m{Sj#5-t~`H{R@+`^dcKyi7Iy25J21ie33(PP0F
zLCjZ#LZJV-i&h~I5UC4<TO_JgSR;<<sS7lILM+g|akuLrtBk1xCBJ#+ec&cHiKfJM
zc68t*1~Rj_)GtVIYcznxd0*rRda&IgQg~@m6938a>?^c+G)qv)BA53@jv+rlJrrzt
zHku*2Ti)1&+)th%9&DGjS{b&{;w%-7&}?xMxn5|Fp_cmsfXrTS58m1pi_@<r8NWl3
zRBO%O+^P-oVKji~_=l9t2glbcDbWbo!L6-vML13;;nY?*et8NZ?Ukq;rr#k!oY}7O
z9*Pr;lXME<>6_?g5tP$<maXO8UQ_>wV!^Yh0dE%bSl(YnU)Mlurl0=lFLm@yf<}lO
zBU6WjCoZxHkOuQ;(`xT3*7Px;UrxrN!?j%jBal$Wj9ScXj=3Kj>)tUhg+b@Vl4(*B
z`oTKDKqB>%!8n1@^2%e*+pT-05x3b%nO?O<=)RvY;B+xCIQBrgYJ1`qUCI;Cq+|q_
zSE4p;sT!8r!!ryoHBWg8&bS@%sXX#@lZ{Y++ACiGK2_H{Njhyp%uxRQSr@iRw{T0v
z{W66`LD$BXs5telCb`K1+ffxRRP+Z#!aNWP#ybUNj4)P*#o(8D$?8lpfoWR}+7X)w
zOSf>=mXZ{n$ig7)JLlO_!#VB?i>hWdU%cO>^(wnjUG8qkT4sdE9e27T9pW0ZKh+lQ
zD`GQ1;3c{$SRw!j=G=vvNdM_SrT5C}_7XDobZ10tEX3jC>C}*NI?!&wS4EXiQXS~7
zF6n@>-2_!n1XjTBzNxD7NH-Z^#nbfCvFL^!c`qyJC<x2pnNe+h)S$*k(Hz;qyz+3H
zhX$oFadb3HX4xW1E-+I-EqMRLJMP2w;|Q3Wrx)&ox-8%bs*ll2ij$39nw9zCWBxxp
zCTFsCSRS^f<W04kcm)$^^CZ%%abESTu@1WFSoT9`K1f_l>Ff)y39*&pCtZA*1Ev@I
zf5j7aqr`|CX{#79!97Y3Tjy^$SHAZuZSff2z^z+AP&&twSGOl%tINWd?W;_`C8Ihv
z5pe)AO%?}xO8@eI<r8{Rx#_Mozen#tFFS|Ewwg8M5=;IsK83V_McBh&)`}C23Fb;f
zW`$~9D^&z`Q01(DXxD@b1}sn%)wof)UU{Ovb5vcbJlVIw75vS%%@T&3srRzw{Xf%P
zU7_!%s0-*V!2c2sphJTw_~FrsVYF5hk7)ggO}eGx60VEFD@GJYy8)!gFjT3CJ0u}c
zf<*J^UXyS%;>>H7%&&=SmMZ0(l1!3Js7v=J-75^#lBB>WQa~N9EQ)Van%~2dT(@_M
z2@s}<Rnc8hUA&W%KSzx6z$7mwh9{P%CxvJG5x~7#2Ao5JbJdTGs!9^5?60NFky9<R
z`_ZtbiGr|yftQ0~&Glr3jAHUo%jiEPGD{{n63H)2RkAYaxjYFf+6pxM)=`Nd{Ng%J
z<yE>#Z@<M03M=%NAGbMWvbzj*p>32hR`DG>WB7j;VsgOA(W!9e!bVHE$X;A_w(cY#
zK3D#Cok4SQ`{X?YI))k#$=FyCUIBmF4rRhm$ex1yPi`^T>i<fhhV+u&o-U;X3goFi
zv=C8Ii)ac*^zb6h6Y!Yk$oohcESt&@@uXDY%_C)cI*8sTP9yf8NO~o_#p$`ZFZ{nY
zI<6M6Sg#$H(@7tBLu;0g2W}k70M~2<lC{VJmzbk{q5sr{>_MI}H`qLG{AA|EjM)0S
z_P;tGTHwFRY;p83rd>Azwoxe=w<SuNLD=gqOzXHwz_d&Id-H~BAewhWim>Ve7n*c*
z=s9oj!hP`8Y4Y#L(gDCdrWq3X_EI&C`>gw==TBP*C5b<+aTH>K=`nYJ@09;-I=Qh{
ztwxXx)T?ZauAYxN)JpdRdbvLJq3r8<ff|KuL!!d;vcyqE-{G*q#q$4*s=c%m+I&&j
z=e)rpq!^`sX8AWc#Ha;0&lrw7H&3JoF=U3-!YKJz4>;jQMYK$IP6tE&2fRq{t9pRJ
zNpN0w+0q+^A5S>P8(=}#AuEz{HJxLIENvq(=as&Ex~GF~D;^LB-Ae|w31K$WO@g8J
zNOc1fz}r!WmoC)|OY*bmGGjWdug!UMsz!jVL@=Yj-&n;Pil=Sfs1yDoujs)+`WxTs
z0t1f6WeP~#92s{S9c0>8DAD<z^Z<ckR4CB#EZb!4_vO#@60il-eBBDPv}elnn_v(R
z74phow+>$v37FWUz)b=SXopAJ94w!)^`2p5pvXnAdl<Z5ZYXex%2Pj_zu9Y11^Qw}
zmEn8CjeX%qrex^fw|w0MDj4`<GNf<fd8Z+x8qQ8{&K^bBYR?QHEd0&s+x)j#!$=oL
z!`QG}H}pI$0N@e>o?a``=H}g8982XWhYIz>_FPXyHOT0XkwJZs^?G<q1F@BCxR^WS
zFG75W@T7`z3Tfx8q8y&^(-Xz@n!Zp88Agn62*tC{l5jpnLQ>~{!?)1ETTi+P>()j3
z>U#F)09|1W>y{{39}0$UV|-Shky}vPXg5&~*KWEO1N=Y0cZTY{FD~&dvX=|=sqxC}
z*WeeZ_n;(z_6hdz&C%i{!tlR#TO0QJMPFI{b<Vb76E29POz)$G=JEZIJP>T)$}Knp
zgKI&QBfG(?@6Q@rY)#bXz$&P^kj7UGK`Nx0<=kls$PxKk0jlkCQVDF1YHYYuqDM0T
zUPJR(v6HX!8nIev`=m^<+w=ipB8%J)u0R$&d1ek?s^u8bamPxNRQ5APFV(WOE_KXE
zMq8+w)85HxrWZ8BD)9C`ZCUyfEX^LMgloJ}+294%5}-~-;8^GI)FVv4pb?YTLdO$n
zzh0gLvWZ&*Wf_&s5gZwTes!g;gj@$yHk_ZqcH(zsI8)5EYt9aQa`y5n*j(<g{+L_2
z=hF4DX>^iUd2j@&d+|Ln^HO+AX>$igQlIr<NbX=g=^BqCij4|2D`(ej_w7&*^2xj~
z#z}iobYH|lJlI`7#$p*haLEO8Z0d^JImxIKnN(Wo$n_~-M#}r=B7u8VAwB?#nbmaU
zq>E-#W`E0n*xRicev4led77eQg3_x8?J^KW=T~3>7bgUs-OVM{l5O6TT6Zlj?y1kh
zOBABbu(Ayc_|0ABeUB%6Y^k2}KC)?(D&_)jE|6p_c7yy$#@319!A>?E#Z0MU?Henp
zeFg#;iv43904@dQkS7vb0cgOyEC{rPHP}P6_C*vGu-vYvi4H4rjZIr4Chu!N;e@V1
z(42WPbB>yulqlr+T<3Cav<!5+3ox3q0{b|soN2G7cmZ;}MTvYjNZk1CUcIVG0=wEZ
z7k>$y(6ibrf^>D9pj)`0yoitf_HUr;rZ`@%3j$SyMA9(4yUftZ$Qpp<qgrW7^h0FI
z^_7!n?fW1!(|T-0@?|AMBtPR80_W(qyKD34w%MOJTI{^e%d6eYfvoGiKM~m-c(Vp4
z5YW+vx!T&9sd32J6?o!fhdYbRp1vo2%=xMl%Fz^VcwBa2U=Ez4rZ8B@XiU=EmsI;9
z!We-HG|*blpw7XxKlR_CCXFSId#a|jUokX<E$T>2kr5@c*`zg$=ZFTDC}QeaS5%3u
z5_wvLG~C-o1bxowNhHgEu(3i0>iazI8J>~SwX+=p)^!7BSp}wG+W7HHqE;GNtevch
z@V_>TJy>S#3HPE(trn4{ALo==V*aHY$iK>;!D&z?xlS5986cv2TaW_}glb_SovD`p
z@vic%0D8^?fd#K+lq!un2&_pCggOjW5ewQv1KNUnrQ&i_L3n7QEnOID_&4>ke0-FS
zQKXU4ksKU3UpQ+cl{h8w<!Kqe_Wiq@6zBtvmjcy$So7x}-WR^3G^-XX%<9VHrRKjC
zpJLQXKoe2}s{lKzMi9FoSbeo@LyijDOIEkS0Xx-9R(Ud}Jn{#YS{5d^*fpx$R~Ldb
z>6aJaQ<{THqN~+gaX7(?=?2S<ad~p2i;=Pb$4X=lMoSS`*wzVua}5u=&XaPi3zgpd
zBLJb?U725@pGH-TOeMbIKqi+7&y}LRa3z*7-DH!bIbdw*q|uZabs?Ip^BW{na2rmg
z4VYdSxT8fhLD4_-@xC(H)sW&_=JzfpPr**>^w)0BCbZwkWsSp0%V~!0QOw`Y&79@@
z&_X7Wlr3X48_v~bUr!?x6ES}}oAVwZ=>Ufi+bxof4vo6%_bSohma9`q5sCGwv!JP<
z7*^Kr1v=9&*j@TT!|n}dhPK8|$KMQ2JWicxr+y@@_w!RmH(cUkEfF4mGfQww`B$o`
z1USIbAcGC5);Pf9fUnqY219urt@SS&XUQ{+O&P|>RL;`<T1J_DFTAXVZ102#$95A|
ze|^{p8fXR%`>%HnJ{AxuagfHCJcT3DJoxE{1wOv+5i`ocN@Li`<gP9lpU{x6WeI!a
zb*{SU6Z(ZU{RhEs7th<vbN7~PYx8c}v>?DSk$~iK5)(BCz|$$NGvH4z)1z=b=e&Hs
zRI)S+r7$~<@Va{xc0*A*Z(=UFNP_zN!GV);FLu97yT_Od5PIohF=v*c!&x*5d5uXV
z6nYGoL`Ru$>LnFh4E1bFB`-`I4xOr`9qBXm7+%#h4f<ME?LpwzAB$BoR@wR#Q8=<o
zo8$M(f5XokfJSxHzna6TmG%b4J;C%r3<C{!2g53fXx-1ve+^$XhsP5Or7N`|i~1u*
zBLGK3EC{1NUnG<g|3qNY*j?^_{CLtTCSyS?OZ<=&44sLz@kLO@sxOr&aQp~6fvzGx
zA@LLMEA6AI%3yf36;btYl%o-nMDJy)U7FY*^8{f5;?ftmC>~=|ev~HSY@B%<^67L|
zT{1Oz!P5%H-{gp5+L*j~UN%6)&W$BaxynBcr__5M12M*s$qo8^h|5b!JGi$UZKuk=
z>2O*;-8dLgw-SWEqrT1b@#R1|hs>quA~9mW7?K%32;xgJxWoRMHbRVQgnq*kB@{vb
z{`e*bj0D_%OQufGfggM;ok&5q&kIKXY$C9yX=nN(n2+mP(USiFobPu$aS?G4aw!qs
zgpZ#v77F&Sj4~RCQS@l?QZ6TLVn%!LPOE$uD+yG#{FMirVpxsa{qO(UVT;JUE8jtg
zh^;sd1w%ATntnEv^0a9D4#Kjw;E6Z@o6-b`kV29E9>E?U0)lL2US4+oKTN%2bY#)i
zwjJ9}I<{@wwr$%<#kOr*9ox3ivDvZv%Q@%y#(2m2G1tG^wX15?p7XxvHGv)ukpA(1
zGch12J$Nq{5a3M2dO1nnT$8`hSN1w|ERc)7!owY>ibOz*;Zae_*3Q^_OLocRCi60#
zgR&V}Ftx<|gR6w<Vra2jawjHwX|K3S0hb3ESk`Sb<l%N(ZWt<*@6hMLB{wEP5{AXY
z0<3;6*EGl(fszQ@nQBC!&8sd-7h=*}%&{g(M1GPjgUl}n{M?Uv)9<6{Ye|vk-r8Sy
z!53h@QuC>LZKX>QEp{&JZIWpiouO2~#^tv!mt$t=5}Lt<DeUdz^pDSNPtljMagX73
z5;v4v(Z6R3XCp?Q&5vgNe;fxAVf2S6fCH>|mU((zX`tgLd2Bm&s0WRB5NSlF?Mahm
z@0W8{Zch5BezeRoCveCFl7I8>!2+OYI8qv{<=6P-ap|i9{LEVRXrq>b$(!<l`))#Z
z#lkj9BnnU>jcH(UVdjnM1c#zeZ;|l+GS|`ppFJ|4d`y-O#*Gp21XAL69;1lcfL~6m
z#^y%T1=^tyG~2ht9VFm4^Zc3Qd|DhWy>{sDs@b(wag^3eFzDUT_z%^`q8B?6O(maP
znGCVk(RAat5&yQ~YUXao&vf?wa&X-%RAvbXpyST4*v=b_#X|!~{%MbhnC!C3n_vhs
z;Newi4&Iwis*=KA+%<UWqHkBP0tyazw^-oF={`GGx>}bR6|QV(1a_ya>n1%^8S<EA
z{NH1&Jd|izUw)-dMwPiDBPz>|FJ+eu$kIY|FItb$U>U)ocbv-7K5{urY;De$MuKQ6
zv-4t4CVh}rpxUAu!lzs6UXtiu(j>svOXNxnm2L$eNvSKa+fO}1sra&$19+}freKNI
zTgO5Dw1oT-+XlLhp4IBKAvXI~!$P2y-Zgp6H1-*LGF6JGeo}9#C)NU%sRPIcJ~ZPs
zOf#W>nm{3_)p}ra3U!`JN`(jD^dV<Z!p<Ze8XSPG6QDt6D9J)}MN05eB<a*IIqB?_
zj$BOU;T|GeRIyFlmm};}0Js*Demul<{5C}TwT<nXpM^jofa%J01COhyaf>(|Sf;`-
zcZ<>YB#ntmw<ShCZJ=nLNf!0s<5gW9m<JA`u0|!uvd+e}_Dax&PdlY+)xHfVTeA<$
z9WyPx@K{QW(D}}wBxNeu9y6(Xl7Qc}a;Gnq%Rr0Xgx^_7Wiq)Jz>Xz|us-&81;@=H
zRE_Kd%wMsWf_~>{g5~2mCw!ZqJo^*1@E+f=WPd!@GpT2>-yNPF6SVJ?plijhN2WPG
z?B;3xZME&e#XbBVdV3IH7Ip2FAyq<ls0jQu57Izlt1kf%#!-srE_%OgGUs?(snQN<
zC~{R}X5riy)!pn0xMHg-Z;qA@4L+KB-$d=Yn!fm)MV-NYGz{Ap{^nA+Dzsn@LEFw_
z570o|+LP#z?%1wZS99&8Pxp^^c(Cw&w{yIT(||%M2SH2>$^3@Pc<uLdZngNZYv=T=
zKV5%m-lf~+y+;D@Tlhfqy?fA0{J9HFHy|cVrdYPY{6yCR@b8di4W(IBW#XSJg=6T;
zdRI&HW}mTpl>M!lSg4KXv;I3Q^^G)R8r}OnUH`X2pHOaSQ8w8rCg1*Cac2RaF3F9G
z%wxHQpizERzV?O&`HGo<up4$8DrMfhgPl^29d`UTUlM3o|GJl<ti}T~(j)|q{t4vA
zyxY}2P;Uehpbe~)UW;Iw=pD(AA{pHsY!m_b@MxrtQuMoD&=5;vEH(Jh@~DKjJ*%;n
z@a7KQt0mVbeLd}Mdd7=T?2TV-c)zDYz7ZK;@Co3@8(@~`5&g$*%iXoN%jMX;E*Bnm
zDtKqS0Y;Y890}X1`DYSP%mmG-bPXu|weVS+!*gf=pqsOrVHeVOE}7!a@UKDxfuweM
zWAz>P-+?nC%4E@`r9<gj*8*ax?{{DKCjqM)4&FZ)W43NzxsE5Z%bPEmoC+hbYMe!w
zH6GIHMQ;bz>>P`&%5zTPpu1LKRR~qw6+f`SkHwua-)Oa5G>&u$HApo)RkssmH@NEH
zs#*IW00{~nx$xTe!qYdY*mSLUtp;-Ki+f3K%#(rF)y3A@c^0E~#%eSU>xW$>eGY}A
z`aJuP|KK7^1-`>>69>nuas_bDB#LH%cY0L;NwINA)B*yfxFxA*QNhn1nOdBhS{%5m
zkU0t&2XQSNsYbe4<tVMySYJ+|P!zBYW2XsV(Nuc=*UxUg1q1FfxLD~-rq(na)3oiG
zds&H7liy%acPE`poXJ<xn*>O@rxZdUS6^m?Iq$T}lE~<z>QNIi|JzuOO3>is)yR^G
zRMGG18W>k7<5rP0)jo8oG-nA31M=7cDGi4xFQNvlGz~f886m0Do8;i5ERfc?Q<Djx
zNm(YSYKYle_i`i+Zwo4WFsV7ZTV=N{IU=!VkN#EJ(2GPp|19S!(kYZvU~x07k>YbB
z(waeWFehWi)r*>Y;S<PFl#?#@HE8H>;YK+Roek>D@i<<*|1{i?{_{&Z*%z`>y)=|C
zE%&|?$UMr90)1j-uIA{@#E~qbZny^MtPB&=W)lf$Q?H8qqhG`m_NX~?2T#Vwo$LsM
zb7y&2>6DAxmOi>q;p`AdHGBK7jDNlR(<J}A;ECYr^KLQH^sr8SuOIv_3}nd8rA)EE
zx?QX>*jN1&lol$#z_i^+sL|;%_>Q8eQGXsOPbs4zWHFnzsL{xy55`#-4<q2Wg|h??
zyQ?%5E;G09b#fh8grP_QEgV`7+yAqE<0-a+;GkD26k_k(+o|~quz))Tn5VlP07cwl
zzq|DJc6h-Rl-t*0K|zDq$E$;YVdXa33n85aLEj5TE;^-t8DkqI7>DPM|5E{y919<V
zD)|jW#gr{tkqy|}a(aw{F$#c+fd@4S!$<_mq7Vpt_VRwFEwVmUA{(L*mQ?hWWib`}
zsGVJ6t*I;#_80T#`wNSo5{HZc6|VHIA*tuf)1*c$?hZpz{D}+{K>S9M-6~r$t@Rt}
zt&QQQzYK%{{63T0wOh$~D@)43ZOD#ixwy@52FKc*eGKp{hQWIn7nR>$Y!~Zy$09cp
zuOjz-cH#vc+jDtHhTIx=?~-mAm!=1XqV0~1Wdi~66V#?8Rw`J{q4xtEIkD9wVnY}S
zIgxNlSd2-hr3Qx)ePWoHqjHl(AQ^5ZP^TIR%+5->8PY#u6GX-f50UZW$Lpy;0;h?^
zBv6IH0C;lACoUeia#HZP^WdTMlxR&;$W1WIPyM*XI}e=1(e?2s8OkAyf@3ToR#Jk(
zKj9F)KV$4K?)DojfJGR(FyzFS^^~NqEYg4}-jZXVk<LsKn6ZEeU}yOAkCb(()IcAe
z&S+x#Vi_041BQZggY=&_@e`z{n86D60rYhLy`v*7^dX>SZbY2sAdo-dNFAbs3Y!SV
z5cmt~Od{j?<V-?PAjr78M0ovQ*iQ#bkxLVhcB_F=6BdpX8)i(%wqS<QB;H3NSTxeK
zd8KAuT8b(Dyg&(Qn3JuenzkjD*PuKc)%?g>KbP0NlxihDZp!6H<$!0EEg(+lVBA`U
zM8vz$j@h5?4o?}O-QM!7U&y2$AGaO7VR{pB*=hYHXmr8`r!F17a?v;ZDXVtNvKgZ%
z$Zq1`8k9lV)1~8j>3|f|N|p??N7~;^J1t}P%4E*+C1U@++1UGts%*u{g4R`0J|#3&
zys^nZ!%<oOyGp-xRy$u=8nBd%Xo5|-5raCqbW>T7&UUq{GzOm9J%?~_@`;0~Z2);|
z1hy(EVdF!6CBsziT<&URyVB0@49kN?>0hTBy|vNb$m<c^m3hY;Ua{^@1T=|ksa$aJ
zYR6m8&__2v^3dM2TVpq3-4ImUnt?l_k9qbP_Snw}sm+Dmi6lq@2e7;S@7bFs_sWjV
z7NUoOKohxV8U)cxjWiS)wgs=lRm7Cz;v*#!K4Kmm9l9KBoX%^qB*HdygZGbNq=Zxz
zn_)+mQZO&F*RQH0HJ%zZHpY*MdLlZ?DO}O1zm}6(4kmQ$h29wydYw8H-qu%btMJOe
zctPS|G4RAP&qxPAU#IT^YOAAOA9#%u5L)nhAJ0T5al3d`T<G(|0)s34e2{fIKE7D6
z>Oc{i<=^5`9d(2ur0{){Czg<x*G_P;(BxMv@mQFiuKgGW1r?Kq2`uEp#zifVAS8Cj
zN3JXXed`9gotw%2oA-i{9tkruU99X>e8j17k#k2vRaO)bnv>H~K#b$w9YXvF6@MK#
zwuowsgi8e`AsqQ$S~5AEOx`RRHH{JI_%>=_Mz$Qe)l6W<Nj;?gpQA7$c29Rm6QhxK
zG;Dn&7E(O<ex1`S(&>IcK^VB%9?J}Aow4Z^=Mx5*zMN~vD1Y#BOJpt-NiDW>19xHD
z$vax6X&YcnJ6t%54|SnlCs^krlAe?JJ^!>$<gQB+zu9~%mY;OZTs|)%;v6)uvUccZ
zq1h|P`Ju}g`#pCL?<FxjwkQ{O<+K9_;skTG8RW*n!0*lp6VCVN>{<4??=;`Dtjy{G
zvJ8t?Cqoho3hFNznO6lGb?5;kxsp#70`N4#^%ejz<?ErJw8_Y+aq74}Vc20D)Gcp<
zgbh~`<H`yVg2&p!IA5PW<(^b$GFClEBG`$v1ot&=i}pk9dVt+Evm;~bK`n?c8dB1W
za2-CKfmv_sL@NQ`?VZ>&ud?~4qYOzInjw=e9smV`FFjn^a@(};=$9eav}*t0)5)lL
z^8`qvH*+@_OB2$%%Qmi@c*yjMnAruUtYO_T16P!!YEZx$2&hx)no{VernvQteqa$O
zx|GX1L;IZ66-oG;#)TY6^DL41s~=>p=$NY>h#3Nf-3WB+KrwOP(?J*~j&Bb^s`8&?
zFE+*ANu*uoobWz2+4W?L_8XYzE-w>&^a%j^X%ig%5jEyjXA31ckI+eU<XzFob#Ni;
z+d#U<Y<luu!ditYxRqTgMKN?$qg_Xr0Hl@o8z-8{L6frz3lN(c$qpBV9n@qX&ik<s
zbx{r74Ff?SB>faLp*qxHD>m5Vq_o9IQA0!PlL&Qn4H}sP@+8R2wazWCKB$<LIt0)*
zQ%iDw^VBG8qMYoWF*f9KI*f?878+(g97V?53WhzejH&}%^n6QI<FrYZJ0B!|Bz%kl
zua5)%vuq#(2`1vM!mq;XLe+ZgX`x!V3H5gff4>I2k~$kg?R!@Qb3s>7*=-8;mgR(8
zM+!@CDEA`qGhPENAuwJGQsn{zmJl2xHv)GK$hrA|A$m@M)e1J2go!~swPVc{rX<8m
zK+$y6&9({!4N%Y4S?rxj=%=?cwLkb--tN6{_9G%#IVjR}>&NQOw>lS)2kCt)&qAOi
zhx538dHIQXpBUbYakug<sq7cU6zmb+uzsnZnfyB13>7aBts|-m%6`HJ7){M_bx7dR
zITjijPR+GAUA6ERl(|dD6`T&!ls!Q|!Oev<D<;k|!yMKm#P_1pRP3MHo4Rqo5?e2Z
z-bAJ4$;@o`btV}I16I%|S;+kihkX*G@-T?lnI}pOt9HwLl4izxWoM-Rlo*&5V&?w_
zXPHDxp`uh#EStVRSTFShG}XTYceNCcV0X1JNX+-!PPA!}gkdB{OWvep3SgpOI|L>2
z@=AhuI|nBtJ2i-y-=P}yooFUtTsM-%0NQ(g;gsc-UVZ;$U%FXOXUSvgIQFFROsVPo
zA=d|7y~!-U17Ts*!#<-;1;f2zflao`B*8(meam2&w_Lxe@lp{1@iNHYQMhn-8n1Bo
z>B^sGu1$-g)97cKpg=K2zS_2FQOKQB!7vCjD-fU$Tpzhku7XiVQV%-Oco%TB?4p-u
zeW(6bt1f9g%^R4ExfY*_jyKQLoPGk5cOKepsZ1kH&Q^>b|B$ouk|(7UhEmd%xeqC<
z8h+0nKc_^WS&KIV3d-tK;#>JTtZrGzrh{GS>RKRM+8P2!8)&N@0(=*pityhewZ}wj
zd!N70TAXA4vlY>ro=!&RN&KYxWu&^1gfj_t4c0m6q$b)D9^8!{arh;%_Q7&tb1!3@
z9&+6N$@4-}c$jvvIDA<v5l|n{PQN9kl$iQx$@5~^@iW2+zm-fSeI5309bw!YM;KzU
z-*j$%VuxknhEUBE0U-fIQAk=o_?(ia8mxIJc^D2~JdYJJ_Up@BPYSgMuG@&x(vL@g
z0twRK84^PM>blT2=G$241V!OE82nGE-BysVpk&(Ocy6WE%eU(^BYGt^8^K+%$wNxR
z1bd2Wb0a{u5Yhmi!gkD2H{L?`nKiyWjN=GBy!_JPV`WI&#CT)<F0&=%-&|!8)xEfH
zExLF3$ry}`&Uv)wcjcMhm%k&`wD)SK{r^EN9HyI=sYR<t|D)1#*(A#Pn|3CRUQO>B
z-9*Qjm3IEQk67aD`rdB$?Ey(ax$^61w*@3z&aJ3B1NB(9ME#_KxrFCMLq|-Ek@KDF
z+G&+~zHiz+-QSCrdgU=z{2Kpqk!pi;n$?X}|I-OeHZygR4)GRU%WUY27V2N6A&buW
z@3~Y=`|4<QG1>~=)=o`Ho|c4q@AK*+%QRaSLqC57knldjMshJ?_Eqz9Ug#df0ED+b
zrY-&agyer6O^JQgc&%1Ql#39J*AcEg6lhtoUVLM3o76_9)L9^Y5~7t={Im0m`Gg!}
z_P_rbUgG4(|IAzry4sv*bgkq<OQ}0F``Y(2h*G;gUoT&;<-65%`|MS`eP9j|T*o<b
z$2T>QqThsn++aUG7Lf?zPW8tL08mLaB_K7iEYl+VUwV;od_6R+LX(~a_dtWa=q%#N
z?+*qF7p{(Q;B`Z}a3c#tz@|q*?^h6Kp2Y8_S1Y6E{>P_e+4zM{ug-9~=Dq`L$x7eb
zfS0#M+!CJ)%e6La)-h{J#EEscvlBS*FZE-m;3>x;vt_rc8I>xOU<yF^gDd?5nYw&O
z5Qr${MQeM7ZAJ#kL_6O$-v6r6MfRd+l#mbm>90{t#5>y2zY!CDDT4L-6q)jB<I_-x
zFs00BQL`$!t>qKSKii_ax;^Q`lwBP~R|wYOzs*&%SffhKlk3eE#F%^`XxgYo$`Zwt
z{POs`K1em};o)%oF0cUCkLje6Q&$RU84mgS<j^5fiac~_(lkxkwA8E;WTReg&b?%r
z^q}$4rC-5LB~e&rUxxqA3fQF}!WaOdaIP`-@qT`769|aS3bZL&#yU)1G1|BMxkbJ?
z53%WtyMN(6es5am$Z%y%cc3gyB0idaqz9*<hzHnBikqhvYh?jGqjs5Neh|!(5i385
zL2F^huN1^7+_D<|RPOs6wDI$K62I%rF30iy##`CV@N1p$h3Uf;`%iH)?l-`a8s_7l
z;fOu7DvGIkPvuH9oA6@Wj@;?UWR-&T%h9L{F6JO*c44FLpiSKYVglK<%f+iR%RD%`
zLje&S`_tqZ$7=xSAg1SOMU3s=<gSV1fu%>ML9(kD8y-ahQBi1Fxm1}A*QimEf7mz;
zhL)=?1UQ;+?^B*>Y)ge%-?E#wlvzd{#s{rXwiHFsOK_mlux4JCW9@@14lRT3C~dfF
zZ9z5NkYx&XMpXEiN+4!MCOpGWtaEe;>%Egp7-=oC83=$}%L>s}qu7PMQZ=9@iMC|K
zM&m4>f7e8;c5HH#v#eJ-B&IU3;j09nR6Y<<uwbK=W{6#U>pL;VDEI}RgzeIKpAteL
zLG5Z+VZ=blvEQ`hB9zB+NSOtusFQWD-E-UTTIY|BMP$e{iEqipgz5uuhMVzll-gS?
z_!+8!{pbK-NliDtaG|S43A!ScnUDYs{C?)N_0ENJ#y49gSsr(T@zPR}vopUAU+;Dk
zBxOW8nWdAJW60v<;{_vRaDIvJ1S69}k;E!qR44p={7-L5ht;tf{FF5aBPmfgh{kE$
z(-o!zlylTsC;3^NuoA+?g;}9jHF#$T$*&rDZA`%0QIpfxb(2`tl~8(mthO_Z{-mge
zsHq(d21uj>i-l0-%nU54IGuvg;EI`(a&M=J%I0cr>4~2ad0N)J8%d^S`-9GJ!J*vU
zPP}BxS82H;Wv-*bXi>J~G4|#BYg-80Qo|*`{jw?ESU)$Gu8RXs%G6otR`+%^UC!R*
zFi61ti~cB9XnWO<c|di+#BFdK-{6Tp7mS&<H6nfjR0<6|Pjp`eCMz+4wmxL63q4S0
zzw$1JhBOh$N47RO!ul<p*gSlrTUJ(axw=*%b_#LOu3xX4_;2d@`W)D2Kb#xs)Lbv)
z=pbycN0H4IcejXW2IhDs<i7c{pKXE(QV-z&YW52{!6T;0W|ta-fy%Ox_wGu@C=O1m
z#=b1nUcXY%4&ox*!QkdR;hRpweWS-WG!LcxvM@Wc8VoEpnO>3Knmu7f1lasj`~)u2
zP6r2vcLT<r28pu2j$@{K*Euff!Q$yOHvMjOMgPS2xD=zpdY?9U-kQhQYIXxWNSyp!
z7OcMydaTOUCwHQ$m@;f>{7#)1sE1QDO`U93g=w4G>oUdH@G-P>kMFS)7*HuB8rQ(N
z=Pu!GR1xAXP-$igIi~Y}ayt%n-EJbeUG^zb)A-g~uQEAJ<eKpV+4wN%!C^z2#6v42
z1o~v>2zYe30asA*A5*EaQVyV(f&c{hgD+NR!`m>##Mq!M^vO@OUeI05wH+qT_R0b2
zE4!U}*v97|2tDi1H3$48eaawcKB@VIMCsywZ&b12h1NN*)_8?Xkd|y6jRhC2LKnL?
zq-ibd+WXs8aRrEy*&Bt0R7Fcp`gcjZBJ5nly3)nCjp-SjZt8gVh&iB9J>I^5Ik$vY
zM-?wjwC#fZcdG?Y9qnC~HvMjA0vUlvlQ4WS@?>KNQIaqh`6Lr$iPp{Ol!zf0HgrXU
z$D}|GMJC8Dd2K&bG>|fuplz^?>tX=(c6<#iYBJ`pKb>IOJK?R=k>tpwFVtq+)mKRo
z2y5S$oVQu&R7Z<c#gc&S4O@KH)UN|_8X6KyV<FV_Cu*Q%6D1Vn^mll=r^P#DMX-_b
zdw5bvB0+a3LJCw{{lVG2a1UF2gbzscJhN!`CHRTxxa&u@`n1^J(P<6^KoypMKNB^t
z^G-}ZHkVp{3G<b%zr<C#ZLG;654sDt>)gW8A3geja*5flT}uIcawTn&M;^s)f~45+
zcys=h#?AO;gN}tgl1Vh*Y&adY<Dv8?bJ44eS2Q3MAL;E1^Qw&pJ)Elvt8XU|nko(3
z$NgrnJ-k7&AshQFT5=y+ma4>xdfK>0!^KzAgjg6V<wmr$=ShJ!FG7yymtFuTGFF@l
zh-MjT-D9SjiTu$&!^`Axsc%u$5OE>1lp$Dl(2>loSUyX&GVJoUvBpCdoi?KtA}y(Q
z$NBHYEqsR^C+5-JxWuiVKTBrxr$do8?b9s|MWEvhO{b%~^8Q#Uguy_+Vx2dz%MU1G
zgUxdTtLDKKFoRfX0HekHw*L4|hBh`!S>*<1!ixGWk{|`3oTNQyWJEc8TKa_$E@`uM
zMO7TJ(r{R{Ose4`HB*3DakaQEP;*^hVfrQ=Hc92STBX-gH(OWtt9BEyiGZWuRTxVq
zs7AfN_Ab<*`j^p2g4+zMI@~}MQMIa$N|7MA7Rcr4ZORO<HaKaozyF4TW4n_C#wg^!
z?8C*@bi8!H+-@Vt+aTAuaG+hHRX+)BYe#zh1rr0oIQF>}qODyqJ*%)B5EaiD{eovO
zD1xO|kzlXoT!VP)H9wh$_D5cQW*`lUT4->vv!B|8K8>J@HuMZyR_n?A=JT=>q41vT
z8PmZfL_-;{bPVOMIr@28C%N|7?qZD$98&>B-KP_PzPNJxg&e)0UZ!e5)+fP4l0d(|
z^OWhpUTclSEs7bF{ry6ewm?Vh2l>nDeC08=ZTY|~vy!Qo=8Ctw<j*syAYF|$pIHjb
zg7sFlc3)G#lO`(_=Ob6CXN*$5gGp;Zzh*yo)0Gjh4XeaY3;zAH(TR`?>&<ejO?lYK
zSxY9M7_;fDo5)ZdK860|i?;9(i?wB&7eiV?OdlOj3qYaSr&@JI(vi4Ld9Fcv?skT0
z)efrSBYw{y>;J#{EZV#b%Dl&OvgH{K80!QM9;f==S6^u?F$4D-KMws2>Wpi}sH<B$
zEbi@gGj}l2-C4V{Bd@z#WM(9;Y?xdnK#7|!S`$X~ko{U4&qOp$Idfo3i;q56oh#8i
z33q>r3yf6%fUp7lSKCVWMvySbrm#?gY{W3bowsfct9%<FF*&gfTCsQyg|-uM4)5kH
zUnAW^<{H6)lAEl*s6_Ezw8SMzDgG-Gq=i7K;mH!Uqr7QyGxB`lqGO=0lC*aofWuMX
z>e>yyo}-(Fv9c4gYz`7ie;f4}chV>95}~q7gJ05iCkF$YO$k%e7n4a0Z@Ym$p-E5l
ztTdh2jCGBzGwoId!~f7;BkVM$w>30AJzQH1;X69T*-LA`<a0lGYgN{Js+Gzv-21V$
zUQ1+V+Irax?gZPe;ypDGoD7r<@co|RCwG)<+@Y<k+y*hSS)yls?pv2cR?w*v!fQm4
zfka|tU>^cU17D=iU&etg+JnSKY$uBqp4l4ghq?CezQX_k4=gf)B8f53-}f-7wD1oL
z2S<mle2NehFX5GPq++9T73*`n@{qw_wK~vX=w$5;<UH5#FodajOYlQTfPJX#+-BUY
zf0U3{vXn}+kk@2(eF`(pI(m=Mq&V|LM$%2gEjWA{oAFQiGu2!<nV+#YMSHfNJ-@5<
zsny-d-)TY>YqqQ)Z#xr*!76zwk;7_cER)yExpoa#$zI;y>_e96x#o<=zWwtmx4)MY
zT<of1rw{x$B+EJb-**CWKvtHf>u{4W?{yxGcVtzSeLEbH?qOUN`lJt5;BT)j=L2&@
z4xjqXE2r^&dxgdweBiIvQ-0HEFXC^@lY;U_R7TZrt{3fG4~SAmx|kpw`zXa8Hyrv*
ziILc!30GL!mMu%E{V7$F$>peQn>&k^*n`)F7C0CTY(Q<}vG|HPfCq?<U*1JKFc#7C
zkAY>74&j9}Ta}nJD*0$H!auXR{v?>)hJ7A`^*WnnLbGcXRMx{o#7qu==hE%86_Lq5
zPoxKQ|6xXJ^}^3CCb!!9Vf!Pypj@zS)eUSlf%(q~xL0p^r<;F;>7MKICQ&1`_2%Y7
za>ot4&kCGI+I;@d6sUVMO)f=%dmo?zS^-4=c!k_RoacX7lOh-RK4Crzxr2NSj}m3B
zTJGd8)tuJi0)KJVmNvvn2Zip<{H`PQ+|AwmPe-Ij<vaQ8fa+&&hyX|e1{$g;K$uE5
z8r45g-VU_(nX&oDt#x!qO-o5%<2}8oLs$@tPyv!V7L=GJ003MP6*skD?D1m{OBc6$
z&E@K2;}!vq_6HI>+sqei@RfZzPa-E8K&?=*M*sRA=G&>*==LAAl&JtiKcQ3&d_}y?
z3ke4C7H{W$y||k_$y1Uv15=}3Z&6ddNfw^9)zB7SBBQs*NF-fVMHrt6UAvu_ksU7P
z9LMIwN1PH+ok?&Nyqm!1;tf2O+_GkwZVR?f4`SQI9QR+zblsPT+8rOAkc3bsx0cbi
zw9%CeXNH7&wGAEw=(FA~Ku(6(@ZoXH?ryZZTk@8!yp1w(lII6$jS3NWJfLW;30_84
zF<+0e!$rjr(b2M1zB=x3=&i`(a!;Od>tFh$58y`pq)zPX-EI21z1FIxnjYPC(7{~$
zJ@+Y?#|sTk{&)4q88p;32;4aLy;za2rgPQo8S`&t*K5r7_g5}wjN~x4f_q59k2W}5
zkci|`i%CucT_<D|I3;O`UD#Qu)gE!ROx%?Bde)(yc3T{J(3SAv1cF8W>R0Qk$*-RH
z7jR_UI<R8$_KH>8BlR<er*2uAhWfJ`>;D8-D)PyR#S}bMSH*=5F0nB@gilM7Wp~9b
zAv=r6Z3>UCit7pyl)~$hbjphBg4W>8+3n3ZBR9pZ4LL_q;!81dAO}UYoYL>>Rtflm
zgX)k2A0B1JQR)U>_owSiS2L_@S-_<jJkGyX4ZPW8%)e$8L=L-?930=u6<|G+`2SN?
z$&2knIu{Vm#4V|RRMnq7@`ZTRg*fnKA#*2k7SfNZiq2g?+_7fIbfW^lxjDB@1@9pu
zEo6v1W2p920MW{{HEQ8({gp2M8-2Vke&OcxUho*^;|g;$6KO|43;-*etPIIku#WqG
zh8Jn2J#+ro6zXb<VrGNd3sFq|B^_|aF#46k?){2;=Yl##1)qZ9yFFGkiX^p|35$z)
ztI!-5IEVjNMT5nQBq-1NR7y#AsTZo$VNQl=uyY$IdPxNpU5B8PD-06rEPS$yuC|j-
z0e}iR+G5~NIF%JBeqmiI=hHLv`l%ITARm}FxBq=Qz*IiA$TMxv%jwVpRvh#La|ffm
zFgh?zBH|Uj0_rVK<f2QE=m>XKSWwo9h?*%9p7~GwT^mlFwkf<c`+in0TuE2bCVk_$
z4qFK8+ol*uf7kLRfJxNG4KFfq8u|qgR%^xO1<Q^Ia=3T%6L#rHamS0gB>gSfH7bbN
zmHEM9EF+@E_Z-D~J{pRJc`$-$94De1nTjQDxWLA}v6n@?7Dsxq{DZU{@<R`Q`b$EU
z>yYZ6@&PWb6u?}+5-0k!+YjnLSF8`lz4dq0nYkkMQ{)oyn^cQHh})0y?lSYoi3dYE
zPV+jNpKp(d#|fJYO|X$<DA1XS`zFAA4lRXMqelG${MUkg$F;|VAcL>Z+X*sqyRyBp
z81-`xEXn*OKi=mneB#_E4dO_GIq#q-qEZDIDSM$UDzvdL+*!gci&UZ@byhNv@WXp@
zdn}Ys;%dK<KkmUZ@K~}2<?#Z5CMh)MO;AYudV~TkTEK6kY=vAlws0e-$`nnZ*eFMi
zcmNAA3)ggi1$HD^nP7Q(y^c?*uV@uJiVcw?+geKU$T3(i5m1bN;k2Nsop&G6mcI$x
z*|QVDBo^+-peUV@F_%5prcmB!s^wb`n@u}mq~&)+a#^>O_kdcV0xAXkWZH_5y{@=j
z3eqJ*{V@AT^b_83=1gf87F%;2yp|woyx@YNteLIXoGsUxb5~q9{mXe`>a(2J;w?`Y
z5h2CtM@wxiNue5-UVr+(8rs&_y8qn8ouhs6&CTa$>R&AKRkqw<*G;9Q_S}C9acL0J
zWg}AG$;QGxA{g_Mt>*z?m*TTbLa%%SLH`K@x2+84*SJB6F!T!&3*$txXtl1!EhJi8
z9F|XAtj$@lDLZ_A)T|Qj*5SB0FA%HUuW42L|6N1xcz1H!c_m(5@2kC>vc9~qd1_jy
z`Xa=XbN=cOnw`^*rEwnpZmIfx*$mLA-(Z>5KF~c>DORIc!#o09njP-OuDb0_JdJ9&
zBgEzUe~30|#EM&^7pz5H$X&MA;~B&$eFy1&b~$Nvy)GK2m@S)ACZ<e-+DiU*8=&+*
zC!v~J&9#kVWuV8#sH>~4)h5A2z}fC^KScnD5Ot0Sr_>i1Nm;q}gJrR82eGlv(CPxg
z{E@6X`GOrupWX$m?y8e}3N0IVB2O30SojeiJT*GODz&O^NK96VY%B`Za%EbGSa6yh
z6NyoE`P%d^I34e`7ZIA7T(^+SVP>2~sldC?;OzySAcQ|(Lpn0^#l{#l8Hbw<DP5ra
z_;YGCOn6xz?SQ_SMYEES=3TA4SGe(g=ruD%Yvz`gmf8Vzuo*vt=M1Y4sDZ+2mvoiM
z!PE5{!F@07)zulIlFJ#DeoLP>R33=tn$m6+sXRAOkvy~mVI`S<Im`u%!O7V8j0T@X
zDuOgh&rt=UKF4*n<CcR%QXi?=?X-%RQIM_;g*F}YKuE2g-BrOlN7|~-)#G>>vt;h^
z;?Oe;(R~8W9n&S;iguW0^ucLVHVcEB!~VNk?V6u6%E*vmkUngP>a4m%K1!Mz9iT*I
zxfUHux327N!|)q#ACBUl1N1*L=s>Cj8HA5Yz?fX5po^2q07$!3zlz-UuJ?Cr!b`uj
zwMso8-_)_zjkc^|PIx(F)`I_QZuK-Tg8>-iVMsiuF|Q2n2TOiFqU<7SMoN=~>N|NO
znM{gW%a%zlI;(SS*Q;7j#uq+aPgxz_Q#(<{zLZWnsgU7U<m>tI)qh(qw*`Qdcy}yN
zZgxN+UG_;W3`@Wi$>WDygfI?f5?84lfEly48E!7MCkNigpXa}05xpyQ8Z3^$djZbi
z)qh;0b<Ce6zUz<54LJcHXUq8*)nsgV?}clBvW?n8ev!C&jJTA5kq$h!duvkHwVW(o
zdH^!|8=9dwxGjbB#(c&uv9RaxP0g*Tb!hSW7$nwf7I>?0F({g}&YYiIrqa%isR^z*
z5H-{=th|;njnle#M{tsdBg3DR9{`Lv=jGdi3WH41iA*`{2wCL|p~5{(mPU}q+|Yjq
zGqQz+(YWJQ%Nt=+s_Nl!d%&CXDFntP?*FI3$}I*&%^26>qlR`50?%{_9QHJ9z?`b@
zkk?N^nEffhS;Ii0bDE+x;NXR*6sj?Wo1$Cw6!*?TDD~My2o>~-y(<IM>q_2Dlj*ZA
z6f11tI@ujOtq*P*#qXp07P#h%!NF4hYuVbiNNN9*_N%lw_ytBzrYVpSuY?b~%^>u9
zKPDnZwNp+{pIoXuO9~&po}v<CT<Itz?B2kiLZgpU<v?GD3uiP1f<6JZ!sle68_O$j
zEgozcXO)%^UPX`ZC=MO4<LacF$BUKK5*DGqc&FEf9asRXY{}@uV!NT-&ExZB4Teg*
zOB|!X8btd!sFKTY{@5Z~Lx{|b%ZgA98KotEc$9Ua@~!?FQMQf;7A3tR{iaGqfVuSa
zo~7Y4(DKV)49dj3Dw0>c)+1k@g1OEt+nvKK=aPinPH_Tt=L`pczqOaTAu)!J#wWod
z+Zt3BYo;<*O5hZx!8>HwJU%p=E+z7Zh`~)Mfud+abX(`JsZTegFVquB_c8q~YOCk0
z8ukt~z<HA~W)sSqq#~BGCN@Oh(;-RfwneE9U!MKkh{?c>vLk2G%;`0hNdpmK(k=CI
zv12&GJLOkLL=rimZ<Y74TD|gqbMXc1@<7q8cL?T*#w@QSn3pAb+Q)!PvU*x2!g3E$
z?jXJ-LDww|`4mBtUPP0hw*s$nSjhM|qPJO?fpg{|%e+Ojh*QzORM`K`2sf~|8b>bX
zI03;Wbks5Xv2$$3xpYzS+)ahOi&t2|D3hCvnvHDn!D<p<T#Zk!Ps&35Xus=3tr4~Q
z8Zo2FwDW*gmRvYWO>{hlVMNv+6E$=?ynIt3rJqqp5hLp6YzxYk1Zz@3v0IKlDml^O
zU}6;GD*FWz%CvkKrep-yM=##(0|QZ@zb-Y5*Vtx#s~SazS9wJ9W6d<nB1$K?^J1F9
zSk!Uz{@??6Fng4(_RdWU-$*w*Z}0tPEILBS-#<zVZ%x>)Qc07mgs#EWGf;p1BXbQo
zB8EgTj9ZXW8D7+XSV!V^P*Q=g`{y5mUc_FcO8hEYhSx(Em#-0=!<!^KUyND?O9HY-
zATmK~81kEB8Hwl0Py1u}aH6+)mSk!B@7}-8m$Jiv*kFhDKermu;gj(ooVV8=%&wL4
z-phr>+Av}AbaR$A<jV_K6y$et)O<6?bgI3WNmE!HQK?_(=zN(B3jgXa%r0x5sLWn@
z-hfi+XeT92JtD5pmJ{(ZIyQFk7U152?}I=c@*`yU<VpO!0$Dd!2(@DoiYqPF)${a(
zq~;y~5I5mHeByi0Jzs*kaaICN7LPCAEG6{1r#C<9EY0mp{0qKM){A`Gu9Mz*uKD?G
zdqbGWk1Mq2(&j~0wRh={P|j#qA*_Mu{OIh|!<)t!{N$4trc0b4zF;nvRFik`r*c~-
z^J`ZwJRE}pbCqglP8SJtnjJc7d+8*GLN*ydv)hgDHdnDbwQV=I)|ckS4$ZJF6i4Nr
zZLoorp$Y7!?xtDhJIirbNC|wpC0F-m4Pt2VWQ4_*g-|E*7GD(AX>l#Dpgj|0UR>j7
zGR-i|IH1nrY|hE8ja~R*(m(N|G4W)o{H@(kYM=qG;}|=YiI&qF+{-`vTws$9jEexU
z_>}n9fT?(2ngQ=r?}1s&Gvof5B?1~K4kXBU$aBM-V77%F9Vog@A@o#nB&0vG9F2NV
zA90elOBnIl)>$Hx-B$S(s`Ujr7;?qS(uoO1n)P$)*SrPZX89M-vvT*nXNc2lZ5XBN
z&Tl(Ctc#9=+JIUFja~G*Udcap<P7Nm_?!h9WqRwKI*~5LZTv-=A(SJF6E2rz3XcTP
z=gUgLT1YR{rCC{Pw;ug8On^d+Ts=Xmbhz|L8H-<&YcJQnz^=@xe`eSvS=KyFdFshu
z>1^3L<H#HCXUDyCE*!isZ9BHvHqy}h<0f3Zn>pV7n8#*Um*ih|0m8ItSjPnb()iTG
zv4k;o!P2!xm8%Zs2AsEKM+Wb-dV4P2KPkdaHyS+I`|GjfIie8_2K=-u%ZQ0Hj&U+r
zGF27HMmg!&E;w~MzjWKgeUn(XRyKv2ao{@?px2Y$4B}*ok|fm?ekI+L4z3)oBr&A<
zW`5>U%s9}sQe6E~&#TP`FK6%ppcFa%)IJfKNq2?aT%pvc3`NGje7zzhaQH0jOXyR9
zmxw{7GtiN6bRc4xKqf6U2jv*-y*U^SS!s#liQ?^2#unKvRa|;xtk0JV-!*Dw6!5Bc
z9=eL$*;}$py)F%?ZU}BAc<dcUR{wiJB`%i)950r~BI*+AyVUA{T0p9Tk1)+{(f@x1
zqH^A520h7NmHK%Wo}Jg6?tT4sew)cK&^-|eZp25Sc<r>;{YJVWv4dCrvxlbD)mJh5
zihpG=w;Ma=;;chHe_D!1*+i1k{yATtsaCREC%a);p=277RwXl(nsV(+Yi+tRw?;6t
z(e6nmcQ=A_0$|{*A+dPjRSh=*Xb#64f6I;vCUyEL$ML9tI0|v3#<&FOzdlx=3MPNZ
zB35F@&%+fbwGCh~2y~O%Ra?uOdDo=sBT2z34!AC^Hd5GyC|#$7dhFtuj6S7uB|k~>
zQcq?q*q9*$KMtNKNnjQudTJEw(sbNpk9j77(K)aUK>7GuB@ee*Oe;qch4y%I!Rbr0
z6xdoZq*4K|IJcEON9d>MD|Vjs0zcXJrjJFKhsB~qhmVg}rwZ)(MFWW^QmI2kLS{z1
zgr_AaTs<i*-nebXLg?XKd_PST7lwjpr{bcQ6o|j3+P4DVcC8q1E-C(pCpgmoXIh4h
zDmh&XV4p=tUsHz2FnYeW^(2(fBhm>}Dh|Ufj2-*hqV{t1f2^b@apxC#Ch1VimG=M8
zk}T+wCX#38twjc0^f!OHAOSk(<?B)pTPqu4(YmZ-zxPGL?0;CD!C{ihwJY@Wmlm}O
zNAJX%3jD5^3`(dS$pk!I#I?~jVIfmf0P*WiLc+ft-r$Hlb_ooaPt7M<#rV0Jq2#vU
zHxI$)r3+Z#;Dv<xm{fW{Pgs8EA8k)<PfYg&xKpplBeI4rW$``JXM&G<s|=U#6<io#
z1`RAfKqW5a+O@el?6EJq33b%NU;7ZFG$PS-aC)~2%ElZ9LeUFwyeGk*=-=y9fGo@F
z0`IDf`)T$#^T1a%;eP@?y9YV!Nlzd3j|t0djv`PFJb#+1JtKzQ>~d^!a<eC=Ppu1p
z?Lvkrptr8J-*z25WI&`Og(EcD&MNgFWdhvZKWB>-@+D%*UtkofbuaexzJ(+=>rFiT
z;7!pLEsuTm`u7~6;2wiqD*~vP0dSn+rmW#_Q3+83Z5}<ui_Tamfx|srRjISb)F#U#
z`nS0cFezFk&2<Pxkb+{3*?5!ok`4}2q0KKeb$Zm5JQL=BA`+ds18HTVa??o<=Y4c3
z`WgD?pkHgJCsLs}J5uUsSW_2)znH_5dVvjySfo)XlwlrS0=~07PQzS00Cf$aF0ZYq
zv!Rf`0$ki#<n8{1Q^53zNevSX<i|90)5MusNY>IjX4g~4$VbJ>d+XIT2m^M>P2C1o
z`Kw`XccDH9czE88r`>S;GW#(_A@j28apvFuiG#|P)-1|Eu)D7ks%|EK(XFm)k77D6
z(dxu?C(|$nP+NH@5L;G@0?;hcOjkrr7+xwN#-JQ`o+@9qFNUAg*eQU{JIhX~kRY<+
zm^hYHKP4bcR~ylDd_a*d+1`!HA9_KvXRKGtl{nsbfvs0ZkQ4v8s)}^#lOD(UYi5nP
zSl_0zyIXFwR%C;w-L<aAc~GT&A}M5|Xna-7b?-LU`*G`DC3H<B0*q5+a(v{7m51xs
zT8y$hOZ7Tz{hu43S^lWADf|f^=h;H2B<N#3r0UxZpb_!6IlxAEE=@~Z0MBK&x>7;L
zwvj6=u{#qU33nCaTo&$q78P5x9(;sZmP7c&%$fZ@cZLWpMM-j{r9KlE)TH?)mDQwi
zuT|>|rS6tZp_svJ0+_YfI(d6hbi)+_$18{(5e3{aholpk%8su?lm~a6p!KRl=gT`4
z42mjUu-iXEkS2(=5Ztd{?UJB_p>MI{8loLbb;340JVNV0H&i+4LT8rD0*Za6%g;it
zwl@)5q6gMS`$+E|)j)bid%zBcV>^g&yHZv=_>AaLz1Sp-0JfL=Hy?hO|AJGcU!+>R
zIV;ro_COu_UXXGL<C+(XP(#kZoS<ww9;Nq+7)e34Jc8CElaJp^_l}r2&zJOn8-Eq;
z7@a#s+C?H$HW2Uv`TpTS^QET_#o=n28??g<!3&2<#_ydCa8ECMq;?F;z#O{JZ@s+s
zZdggB&gEV)1q4}9tl?j>c`2E<tJNI%fyr2#Ldj`jojXQ#LmuiFFOpBkN`1^2WgM+z
zxr9jV8rAGkL+Yv(81WOkMYytlhH)Iq;SCr(st|pC1J{Y6p9<yOpEAR^t1_X`xgnP0
z=5kV6;j_)7$<1Atk@R>d&+3Nz%T%|YnTqNkBM(i60L~H_+2qoib?XgQ>9w?HuN3iP
zo1%k=6<pNs`o?eG$tT23<_P9!SHtw0Ll1cS<0-3q4<%RE*f2OlPB63non_@OfWu>8
z#S0mF4n)=-OfH9olwq^Cr4a=bMv6ZJznRr8&^MP*=1DZcpogucmZ&4a(qOpn!u}!&
zmL49|1RQ47>-EVXoefA7J8QKf@Oyf&+9`t+oc1I;pK(1lXH1@tmI7qG=MAR>`F-MV
zaouhf=<QDomg)I5dZsPjTO8u?IPDg(2PoCVl{&}AM1I`dS{IHA4|s&LxaTqE)>w6@
z8?T{{ygioK?x(AYEF31h)>I&j_=Y-qmuc290G9ChY>%6|rsvGo%anDOc1ig>eWV4z
z#xdGDuVMl>JH=~Sl}-H(qUb54fwU(T4*&c*Cbl*KvyOA~#c99-)3#ClUn%0TQ{!sR
zg@*;Xx8n5~Bu7Y8)>pMxqf2s2G&DO|9iH}VgMZ^j+3fSnm?hZ(rfm$<&|z2;LH_~)
zfQ+ov2gD|Mf(3%%!Pt{1kQU@u#KqrVnA>-03^P(3PbKaM`>Es!z-Y|t6HJLjo_Y3p
zD*lLOCT0Dhdv2Xxd?N3XOXZeO(;8j@b^Vg7@X61w`aqwRT+C;c&u)qCaq4;+=+3LT
z2G1F*s%F51jEwPUrajPtVhj3zJ(BCQ0iQl`eOOf_cf$I1@HH;Al}1OAP;Kljk@hPx
zD;O$&-7l_WkyVHAvlo{85`cz(tAt<|Q&ue1p$n+Yf0T~-giFW!QOSCXrhFUn{)SCS
zv?lH;C|1e=^E!$9tvNfAIXP5_lBqKK?v1b8EjDmI!1?AejUr!Id#=(j#8p_U0Jyh(
zQ7)!&b>ntp6OoNp(y=C)=`h8{s?@D#Q@2CW%X$3M7<a0!Dd(m+M4p>C2Dh@aVDv@l
z-YkN>5m=9YDw?R~uslV-GDNMlzy<2tKt5aMD^rT%dO}dEs?4ILPMLa0w03Wee!X(M
zs0~gFmmw8s8F&^FkvD!AiMjaQ1ZZ3m)b{iTS=@5aG8Rt?i6)w#N{luln}v}O+2b~g
zgW&1MxCsM#e!dws-%FeN9qnv}xtBJ1T;&Q8X;2AdkJg0^Qg>(-Q*8M+cf3IwmW}rF
zfwZZ-h8O0nAo+vl#F0rSxM6lYe@Y5$s`zj`Nw4=!dQnV>$#7_r;z3uD7r?;32)2tA
zCx}Ln8$F0D8B5Y1xlWG<jN%?)XB$Miod{Mn&)&PX>YqJA-r#6V)7Yrs5xRay$e!~$
zm-pVEuLS0FAX@(@$lZPZONPMDHN8OMzEZ17itV2&dEVQwlybBQUd|8Fw4iOHN{nf&
zgR(~3x(0`$>Fl>P{u<-c1psX+gV@eGpJ;SmG}XJquW_-GzVxtX$ba)mUOJozzqi;0
zEu0yH&26uCB5FtoHtXET1^{Rs{?BLeXr<ftY;;DoD`7nvtzGO?P)9$3{{q=1lWFOQ
zt97his%~%@Jc^zNT49vSa0>`P{B^S5Fb3jrb_3A*#%UzmL#0Fq^yn3Myg=$M!vgjk
zzk#e6T5=VT&ip^<J2fwVjsOh?N2QE|7r`YrR>lD|c(V!+Imi+oNcZdAZg``NL8}NW
z5<eHi7=HG1;L~U8k9lv3Orpd}?1j<2Hk$;c-?BN2wYBYMD16V#aw>x(u`YNb@%QZT
z%yr9`wbUwhq*uTI9}LTSCd<El$Fle-59?18UoYAk<YD-HM$cf?IS~tY%4a^Sj97<^
z`j3`SNCI`@MV%d9<9BXNknzPI>t5TU1Gum(rQ)UAwv8>1Y59L(?DQxb{6T7(5wdu(
zCQUZL)`rJ$E;ef{FBH`q_)q1ny>#Af8V4cujhG{e9L5*`jDsx2oF;wlh~0MU=+XUK
zLij9bt(TE_H3CeL7!p%BK1_2iF`hSh8@}{(`znc`7$f#!q)PZ^g`MNx53(+#IpSAF
zIarRhnthfY?gPJV)WGVr#@v3smV>{+ExB7v_>vc*pM7ImI(AOI7~$`~zXfOY$ANId
zc-5O(EHf$qmNuP#+Y1J%oS%<g*8<r!@M>P^{een#@ngnV#8{>@G!hq;s7>AsBj1@8
z%jTHCvI->-oI$l9GdU74#uPi3Lto@^-G~rmUItj1bCXyKLg9rXTQ>L|Vh-2oHFP6c
zx^*bQ-_hU-9bqh3x_vcE(l7{!4>z)QCbzt#7#Vi~Adldeb2(m9uSbz<D+adnt3Tsb
z#6^i8g7^PoHM%l<Xm%(W5>OHHo$}fWZvY^sZk%_I?(@P)R+F|l?RA4p@`)XlG%+be
zz7YqX13L$g+;9n$0|?Cs3s7apv0V)UgAM%qD3CyFm1_^O`fu#buRBPdktvR8OI!lt
zFZ^BrI-~e2s0%VF5yMfHsthYSf#?<%H5pf8MtHre?H6a)GR;a3x~;*Pv-s0=qNq)O
zR1O9y52NH7O`DZ$TQC2bEj_qXXFrn>W!p05A|xnO+bSQlvUB3*kKZs|2lOaP(7U$m
z?B{#tR~js2qM%o5R<>dn9h|(3n!L1rgf@==`Z_?WAXG!b1b+d`5fJlblUR8KgiXWE
zOMr56Af4Gbto~j2;4maa%|JEn@oPS?T&pV89xBHgYMcMl7X67pUIT8%CwIws#TzHI
z+Ia%W8;qzxz=O!Vd?aR-s@|h&hv&NPqKsnxLpKtx&o#XRxy4$6A|Bza!$74P9b?%A
zNSwdZ1<(X^IqcOPkJ4;js#pHK_O4X6y9TlO_%&!qH~N4V@dm>>Em3mN1B&AxY_hzJ
z{3#}o3U#L>Xb5%3lzh^NH9V1tc_u(pItx9jpa|dpo@7glyeID0lgV^{hgh3Vy+Vv<
zM)jC9FT<lO4ujVJyEZU_DbA&d;*RbPFq7vTCtpp0ea<?RO)6pGzlZ70eWksW!>N@h
z3=#t7D6Ey_s{rf(>>y7mlQ7|Zrr99Kp>lRYf`OZhVC6yVFVsneSa1*$@lc>yu|Tjl
zWX&uh4;6?6LLX|FX^a)>!LfWETAZU3E!imep+q@#d|>v~NI&^Y8JJ61x_lA=fc8ES
zoWW|>PQ31iG?|mqU<!hi_cAW7ye~ftPKxe4T@@5HI-kM>_WyPDmO*(nO|&R3!QCAm
z+}$O(ySoH;*Nr7ef(Hoh5Zr@3xI=Jvhv4pZc+Xe2PSu@XyK44K)lALwbg%ASEya^F
zDPWyE)}$r;)B=&(u8(B@M6LwcBlv;+;FTPBALiT4Rgdl<zTNK7Q{lZXmdhs&&DOf3
z{HHyu#74CX3(vt&BcM|uaiEiqDc`C`8<Y+<2-E=c9vKyHg+nz9KhPKu7*6U}tOWA1
zJUst?QTH$Y_ve{f*o(+J_jWQR_~zl^0>P<`JPE#_MS#spsgZM-1Ndz=kgf4WJ=(dg
zGQx><BqpKkRy#S(ZkvzkR9J3p9!+%zFFDE^YfHa*zEpOa<A>+E{zEVtxYGa2ujRkP
zM*R%HKHBZ_Jy}bNUTiugqJ^4sJ@jLpn(9GxV&K=-^xm8<@667SWP^gWj=<Kye{Xrq
z;=Ob5!|<7gOSO+Gsy$?9Rztk;)h%`JpI(<Q(w##qrOW4SIJ63~;h}%i!MdOb#I$8&
z9~`#V%`v13BrluEF7Fg$gQ*62>psynxOL3}Vq}nuI_SP~1Mx)vU=LLxH7xO6e#lDB
z1xU&E=Loi6dmH<Q^$MaqFB4HqN|)+6$%SlHo+hZ3X|{04616z9qFTf;E}j~<2*X97
zj+|xnEXsvSR%$nb9-oy0S+om5Rv9_(>rFW{@2CA{iSM5Xu@DsVqJ=~0)h%wm$O}RM
zn2eJ%5agFTm?EPEC@~jHemD52-(mlSvQHUDi7EyLWy^X@VJ0?T;oaSoPy<M9_gIAm
zR_5XEwQ<sf9mLYy$z99+R(q7X-w49#i+{5vYW>ER?UyTCB;fLT;j&v;4@PYBr=&h<
z%k>pXjTjn=wfy?iM9MZyyGZk#ZHbQqD6nH#o;-}=<cUCQAn!BeDIeqb$U{}g(_l=L
z9xD1OlQB?sQ7o9e6ppQn#O(c2vM~#jvUKWfLrmhI4y_Rs0?HrmuVcvI&^&3ci_qQn
zk3YvG+V$|WbA`&MBp<+TyGKV?LdQn>5gie>`I5hVsiTxh6RCw&J`kM#<#E*xfcyce
z8LuD{b^=jWwjUdedg)A!zwNhhhp2rJiwIg$S#>+9wLpm1mYn>R7lLRBjofgkm;k@%
zP6ic8Abvq!zHbO>6o8%lJhXD40ud|&5w5kD+mr@%xgS$_ZtRHQGOK{s_!RQZ@8sKA
zl<oMBa+REcI{vhKB>d?dMc-y0K)f|XWNB(mrOxbc!e!}Iiyu8imcH1`^p{GsT#;-I
zqLLV<wtKJ-=_YOJTni6xT?>ltdBf4Kaz%@^P){?&o6zDo(L<YXk3!T*+VB5xhQCJf
zYr$M-AO%2EK;V2{fp9pi(`CWqSKDqi8;_{Fvt<*X<N_h24U}}`--;>?15r6|Q8x&$
z50pgiC$ldR%QbO(5~XZJe%1zqkgbl}Wqay^XTi!LZ&<nE5G0I^6tj3;KjAyUG*_4W
zM&-soi5kh3{jr37b{aerZQkdU;WbP=Qj#eUd`JTf5c(7xm#BA6FmTgO>qgXaS+k$r
z^$5OTycM4yn;+-UkaY190|!f^-Q)_ka56T=BtS(2;wNQAdL!R@RX1NSq7F76r>x*C
z@&iPGlw)m5=+c&v?*$r*I00p>fjeAA+O$-J)OY~Il}%+*mUDAlT#r|yb|p?AwzjCw
zh!p7Hin;Mi7cP4Hm@N315V@{jh|Zi|bGP(I&J!Viy3-dt*cZVLK;A29VV-olxwTHh
z=3m+_nFDLliFx;tO^qSzvgDy};ZXev6f3kbggrkvq758*r9_OfyNBIYOw*eF(}<M1
z#`ffjJUYd$QQuat4fc$AS=^Ri5<k57ej_wb8jZuoSrQX7;2B}V5*qz$XN|GlgPCR$
z97_JR!YR###LT(~Kx$@mSC>aMy9Tw~<JCfa6tFx9XcL9d|J1VQRKkl~MV4K?V*c(7
zJ$71$&8ENHl>2-E)8V}`ZE;>Y<rr2{jcFsix}mT}d!gm`Q%u8-yW^hvq79}sadv>0
zjC5rpOYkwnIzgmJs5o8sHU4XD&HxgDS2B1_Hq=KVNZj-su-!==d6>(<IWu>8ZK5|b
z$CEn8X`bBQe<sjOxDpBz$Rrd6Qr>>BOR0zdPE!X(xah<d=z2vrvwqU<YZns=@A=40
z-{$=Kr+6<BLnpY*HxVHO+0XJs*b+idNefqu)OC<edC5aV)yVo`(MX3I$D?y&&8#!4
z#!S5U(r=v&_$hPqZv}?RC?oVo8I2Q43MJ0*mgLAQx38qR7d~#Mk--UCjHO#?flYEu
z)V)=!f3I}gtNjiKxghULzNRI_4Q<tT5!%U>Yc<<1)q5w_d1^HwiCH6MID_NRIJh2|
zgGKCb#19DaEsPTeTLwc0atRHSg$FQYYs*9n(J|9UK%^{PVsO7%{DEe|A_I(pdI>9t
zOUdYLqSnBH%)-Fk68HRBAhh#`A<Mnaq$iTNyH)~<`?a^j#^=*jwSMAYY@1(kvLxns
z0S_p#YDqOILD2$V&_73seR8tN?rYAw6%`7bkfY{sh#CIG8-4q|6>#`l<l(9(G+VmG
zz76`Q=2a*27bPK-*e7``iig*c_n7LGwBoDN>`YI+)dVw(9-d-S(NvE;;=|6`SQ%x_
z%HlGEzxq_>ck>RZ%ytNkL;s8nIJnWzi<3y_{}7~OY}E4$Xw8H?&Vx+VDDMk|$p*aP
zL~?}Fan~ooz1UHcV^zN>U4O2P{4vGVppI>vHV2~nD2inxyWllcq?=QHm@NI24f#fQ
z7r(BlWmiAr!?lG@+}u|%0wQQNlg}{&JtGyW&xJ6Mr55hyU*&+%jo`-K!p{A-zI&bX
zHO=nvvndh&!G_}{u_9G^?9};rH+CeA2WKUK=fZ>}KAVOUmh}$(25-ITt55z32Jw$y
zP(U+D2nO-5jAbX{hA)=1(r0L+V2-IUW#uJ&#U;4)x`~<$hH7&h7J`yXX33O)dM%0c
zL-nTd^%c}sXOfbTCOJE=<$GI+9*QA4Av)hK1!iD$?@_dke|1ujJaD}nFhiw22qn?$
zo_J&*Mjyl*>b<6cj91i1jJc^|q%UtS<N&>2v~rgLobp5^-_<(K5G62>suO4^C3+fJ
z&ni_$U=o*G?s30L@O*W+0%ept8Z*GoXk{=JCe^!KRM8fRqdav9mUJe>7B3?aG{M15
z)<{?19$2WO3MX!;{^+)cVphzvdT({zpmMYI<C~XUVxJy@<Fm+Rr|+KF?WQ!%=m*w0
zidIq0dE&(#La_#aupe|28M}IWjTndz5~95_y+)nuAtQFg?0xsBy1<rR_IBUIYG&ea
zg<)!Vz;Nu)68s(`RC`gK{`MW&p{~57r!ahS_V?U~V{Gw2w(7R`c05mhY>FdhRIjHW
zqOj*>7lE9OuG|rZFtfR1ti^^m=1+i&D?j?G!J(Ih&y|?c;eP%=p4l)v<@5<|1NExm
zq^)O0Ktn}=ZM8o35H)^PHLV102@wyiuFBpwo<EjhBMRYe+4W2^)@Itrm_wGgiMk@I
zkx@d{3ewqpu)Idk)8ZYrq#jr%(X5toTJ>!e(S?em@-*L&&?lJLexu}XO#-y|*!J)Q
zoY!olU~ovfx1f+gHW%NG$!uGB=ke$gW85k=7@wuC>Wq!Jvt7Oy-k*Z`OR}TL`pxTg
zSIoC%wuQ9q+4*VXHW84(M)57;u@AY6O6lbf0yqu*a(RVB_^PoM&GuRHrQ#&3y81oO
zUS%{V3O5-GjgmemY48wPs=&=X4FplTYx4G<^d;?mn8O!6dIi6IpQeEa{U7Z`=&?VM
z2IWyl{t)B4@Mz#3a)vc5T&a`G;<V@xyZKH&uEQ>P*)wd+Zq;MsQc#mpuuuMFq|!Lf
zK|XYpg@gGWhB!NOB!;QsYd3u-jY)DzzSxh_)&;NXdQ%_!#dor;{T=Y~UU{rN$-ygX
z-=RBS3xmC*c^X@xJEwv}3YTbtXfy(h%fCAQVpAJojn2}K+&l2%@A11!+^SwXzgIfM
z5c254D`gbs$u7Jb=2i8d;ZbR-d|wk3^a?|T<KH@si;H>pUx9uA)*@&p{d@v`>Z|C$
zASKwVGx8ROp~|mqC<EjIlc`W2q;ik00}VrPE#Ug^M|0=xD`$9=A;O4Uq@4jJGmZY!
zGguwOm9foR=8^luUSwj=f9_AKE}>TyVw{}Y$ztMm-AXj~({};xvknCbE`F;GoKrzk
zDKAZ?f5DdLft-iK3m|`aTD=wWwi>OA$+oSY(WIcj*HdM?8=z3gC(%!36Y}^}MxpGp
zC%3m{bl^2bUo=y}>#tSHumgS!S6Wu$Y<lgUzahdgz2he6{5-DwG;R)F=^1TW3^X#J
zz1+#IioEYOoWIm@i}S}!Np-2XgBO?tM1T32-`S1atHdx4*rLRm<uI3)CdsBwN6)y;
z9Q-RDC{b#5w*t^p@(sBwGjRenT4u}goy+2tvaK|3lyIh7Vm#bJ?|Ql0g@k`JBb{C%
z6_^&atj91?&=IB<Eq{fOVxv3h--5+1q@UBbNa-6wKMMWqnP+No9XU%eJ#|4uTmV8W
znpXL0CVg`#+_DP7)}Tmm%1%w+OSwrS$|kG!-B*^tTLd0O^&fs&g=_e19|w*>;z23j
z@EhG}Q7Mw9WX<592@>Pt?pH7&^JcFR;1d8VCaBGIJkXRe+6V!rIam~Opee_~Ceb1s
zGb@o`aEk2M3+I4%j`bWY^<(Jn<DZ5vskBiB`sW&O8Vl3uMnSYnqw*MSr^zc8=euEb
zf|onro`CRkh^6bVwoDSL?OJxJXj*%9NaD4#&H<XhhxM>ucBPe@Zm$`~wI+Ik3?A9<
zvm?tHy#LUGxlaQ5dXK6gdH_nnu-1?Z(BT-&f-**d;H(%U)`I@j4xk{VKHsd^p1X8D
z;XHw#TU;^T*n**!dL~XDmbg!AzXf7U^?6eTq9w=chx{>G!tyEpGeXV<6>Lc~<gSzN
z5P#1)!ll7#)}VUJw`Nx1YI7$*3@kxgFqEgifx`#irc+^Lo4I5@omjBO_}S}q%A`Dh
zKSJ3#8kx<r6S8P>`84JrO-kut{}=XdIFont80#RY^kL&`lc5v;_3(A$9{vX5{=Wnu
zS?FK$&g=IT`mFgZ7mU6|H++*rrqUvrt4~%Z*VdK1PJEr__K@52_%K`=?WZDgaccu4
zHo^@wrj6RS9)vMajhdBBWkOo|&CA8=e*f1DJ^yo0?P(w?CTt{xmU5zq`r@up&UILW
zqWmYtHnxpOYB^lHa>}8uVcON7eG2%eS~+X$soMYv$QYR0&$ZXB{m)R0T(XEf?piCD
zJ|jODl^m&}3Sa*c5As6!PmSG|unN6ov;0l|&!()MT+A7gkK@v$0q7WpQ{63fsB>W;
zzY8x}8`c%;ax=9NAm9rJCN7DR0QgpviuVYPJGYwg98+K&<RZYU2(V3hC_X6mLiF94
zA}IY^J)2Of>8h@sa@qGDN8!STa=U}dw+*Bux$7V>DGu?~(vaG`{c8wExS&rGJl&_J
zV5Wa9SWA{L6$RLm*RAQnb?`Je>`gR^y>q5s%CPxL##E8$E!hWa(NC2@S16UTNShYh
zFXH4tIl|zQG4qCp1N7ahAgmGezT@wKA859Ib|?j94i8%m(xxp3@0IEAse0Rr45ZDr
z5aO(uPAPxbzP$PXVz<PxV3+9Yg#yG9K4($ZAZHdYj62;zLx*HHagE9xcvap6iqG5%
z4oJcZG$0X2X`vs)5{jj2&b+ADr-Cr-rRFiCa{81r9~;pNVE6x-7_)29u#BH10%IKf
zl;H)%E9DmCp_;T{r)8id<ALc}aM}f8DmNU_Uv@70IHPlCx`RIVh|^4ghL)a?FN3Th
zE|Jo^pA)j{9NY5b@fh+Y>u12tzbgj(bz$VQ<gcd*Te^^VoW!3)#+zT(9Tno*OQf4n
zvOCtL6V_h<Lp#q{_2L>{1}Yi&;_ze&@{Ux$_5nP^m$%zHWvHf2e-)_8h={>E_wvgJ
z>RTtGwcq{x>jIgL3trc#$k@Kpt#Eb)YTqQgK=H&4Q{f7~Ss}7+AsbqvO2vblT^2*|
zN7IigD=#MB<@y+>+x6CL)8i3TU52lFVd$iFp9=*6o?2R1BGTQO`6A<T&)9ksk(!;F
z9I6z$jnK}bR{G$TKOSg=V-bKaEgn*1hUDodc$!nx=nEPCYbCGM{&-S&B*t1;#k^00
zkqu(-OOTH7Dwx*KHid@>L|QW(b>-esz4L3HVY=M4b`tEcbRgK6C?|beqC5vL+>9Nl
z57+_t4|iaCK;hey!NvbneKnc6EBS3uPn?3<Vojn?Ry%Jyy<Uh^G%n%MVQoyGJ?Y@h
zP+N9_5Y535No>iet+~Pw2Kt-$WtVcAlz)gSzBGPnW|34Qm(Vx8FAEC-G^Nq2tbcR)
zm-tfBnA0t=*93lMaYQ!(#-ZL2-wPZ^dF_Ey`6B(&2!uTMsiMYqXFN0KyUUt$-3K2Q
zw1fnb;pjT?&L)N;zlh;sF9LO`y7`%8d!B<3oGu(Dvq&1%G^JeAVYzIPzzFxn`@Yzv
z@9x{w<#qHHDneC7&dIEHG13kS=YefCH;N%d&U1m!9<7|iOO;}_lYINsm~Xof?c@N?
z5LMOHFLMW(+}5FSEh!#F=U%xWzI{oAZ*}Yn1nzDP2*E=$hd7Q;AdT8Go2G1OLUc+b
zEEoyzdQC8scYtgyD@POl{+Jz_>_>rKvJ{<~&m2+{tm#63i&-*5n|k-5et7a_n3f<p
z7i`5BKGtk|v*)4msX?z$uCJ-b$kzkMJ@BfSe^uD8!)`-xh^g2vxGVlHx8E{(>~iwE
z&;};7I$qGd=A5ga%h`oF+~*;+Zk(S%942zY#SF4;oEM#8`S>UrIjnJn4@mkOB`hUn
zcg^&+;`KA)x&gn(&Q&&3R6%R^T{8=Cpo?;tjx}MSkm?xHe<FNzHPQWr&(45~Xr@BD
zb4&`1ew=z(Z~=WIVd2GY-setpL>%SH(l7|WAaFQ@wL|CQ=NQg!@^ro(%wU})_$D)>
z!&fUo?PI*<DbJ-{?%!=ka%{ble<bDEsW`lnGQMHe@t4wIo$NFJ>Cix*k)OnEiGNP@
zt+g|s3-3Wx<trSH=|opWP#6K$q7y2n71jOk&Hh?b*O{)apj_3Df8DrDfx7M)s!|Cr
zBua>%t(s2ejboJI4F3<1NVJ9vfUwjy&#aWMS7+hYF2QCA@IB9@={TV=MK`f9I>tkO
z2o)ms3SzshppaorF^#ADHTmP9kYG=ZhcaxB>jZCDN#-U(dQsK3j|zZ_uAuBqe*AOP
zRUDHdjAuC~;5#)X<_}p&&?sy*(CT*gZwrQ7Zpz%c**gB|N)ahB{?P&YgFZ443F$#O
zB}!xt3SOowWDvtxdOtOm9WG4qY8QHwlHAP+oglt4fr#oR6e0>jjt4s8^AF?~jV^J%
z5=Nh2)r4LQ>qEheI7Wb(NwT7_xM^8}MyOCTtQT1-0l}aIsBtr+PnhQHL@`y1)3>mC
zmZ_<50*W)h48+%ZIo@vVsx?#1^&Mx?{oN4h%Gagg4<(PGk6r>Fh62ZlS6X_AmOINm
zUKE<1lE~#bu;cwg$u~$=^A+{@0x|Tn<PC2YX+~3DO|D%zqb^YE%;X}v>ju)0hTM<T
zkX+q`Sh_n79)X^Ys%v<();*y#c>ikjEpv>y4VyZPhep#joMBJV6?{G5FVS!)O7|mQ
zMa_#(VW}eR0(jT8Ezt^>u%RVwoN<f4ja@FCD)TIiRuMGvI%=HYI+&@>N^hJ#7*Ti5
zD)OqsixB=5ZVQyK%{rTlhJ~8mB8(mlWgc642@2=dmd93p|4L_fTq*xJopU?F(zr9U
z{x`FB+`SOj7)P1D?e`x+Jg_RRe)9n_j$T)vT^bYQTQ;Kl1X_h*?JShNYJX!K)0>!_
zeOPk8UExnH0!wmiTiO89kp9kPs}^lDw~I^~V?(#IVpE{S)im-)2+Kqy*#Sj3A80o#
zgEwu<iP$?saiX>Ee1Im%aAkPO8E+PW*u$<7*UCYWxG?V#+Mfw+ets0W6~B@=|6!cG
zkJmcm8^)-Bm4y+hymK*Xb=A-))T}2HLtX+rs&A?%M}&pd`KR8Wq`eI@Oq^!n_`DK9
z{_fiQAW6WH)zfIbYN+0iaW6z*^5?M|sp`bvW>QOqQSZg^bk$hvVq)HUgTCd!<EFf%
zQCn4ViHo*vA=OGx`6540seQdHAKLzw_Addd2@r1;Ic-jNMEHEODknB4obWWBd$#bf
zR@;MXzIdRkSmplfENl!aZrelgiL_i09lK*h=og?H_~2|w*<t>rqMeMjPiy`(E*u7X
z{b==udm3V!w8-)XoFDg|8%_SJ6o4JH6<|>9X^Q5Pno+AovO*JtNA@nsT03Zjq&cPY
zw#TNW4(#{)?~eQEH-0Hye*_D)^JDG(T};yR)6K}J_nr3Y>Unar3)H}S!}-Tg>334c
z4@}&RSEaj~)OT%l?uaY1_~N$m`E6qhA8$c9V?z`uh#xIx`iM)8L`QGFLq2EYN#C8W
zn%wa&zx(8R&Ppv?w5seIAKem~6q5cE5?K{2I2J$fZ@Tq(o;)>zY_;Lq4(-44;5vu<
z0Wp>U@2>Th!+*t2^qD4Uv?R2Nemf&a2EeGewk%dHrRA-_1HN}{q%A?G2iFy;)OMGm
zi+sJHH-E-HIOe*rb90#4zQhif!#FbaPui|0!hn<cg>9xTp%}dwT|8X&z{}KAgHTk%
z!4$fc?P-~_6-Aahz$2Z4CN}C8@VXUr-Ha$l41@QHMW9i;{%-<n4bnY<WkWIUB#`0o
zP5)3Sbc|dMCK;a~_C3KYzM=hrdKRnODPpE@wkl%Oa4ATCMEA&(Kj4N-zfrn=7=6^K
z<{bv7Xp`&R$lvc9sTQC6@YHagW8Bt=R*`w5{&nq&_f)^rc^22x*(K5hftk-Vq5B}2
zm~(xw_8xM+UO@~A?>#?bDx)ImFwoGR9EziE26TUpb*~Po7=i5$rxJFFMQwnZ@Axrw
zuvQToe&A}H9U*k(nTZ#H^b83R2L2<z43${%*loYd=l+bac{Jj8xtcRN;xaeQNl|tD
zK`WtuTPAw{nX}5(@j4ODu#-#z>zjuxZU7$wipMYz#PsSb0p-Py_lYDn7bqyb3;j3r
zH=%+El)LD5#P|_!wjne#n+K^F(}Cnnsz|^9!8vCb+;J!U^Y>(4)YRT|9vGpQp;F8y
zXU8^&_~CT9lnLJ^U8JxCLApYt-L7EWjeFGt9!A*P9Dxuk>-UnodSbU5L{<uSR9qKo
z+;aP`^p&%un?=XfkonIB(SZAAKYDfH;9!J|%L<A>&+})icni5(#Yk;Y7H`zjfBd^q
zMbAy3-%F*&^0cY>h1Nv5Q;yC6!#LQqWsIl!ecc~Q332sL(b<e+`Ie*lAlyeSUcH*x
z=LKmrAz}3GGqUBTEQ8Y1l9)Ve<<%#~fP3|0P3qFqRSf01T3y>;%YZ|gqNJOBRp7gC
zx{ukxsB#jDuYt?=8pSV5giK+9q0()E3Yg#DRRL!qFXuKBZ8DEWibBK%nwKr(fhtx*
z&^yd6=C#~M1r|<7m2;eI?UvcnS=7(dK~&TWyIt5H;f}KCg>eukjFDh!cz-xQaRE*3
znbPN>0I5jgOzJttIl!$nE4CJLexhAks-oZQ#1%0Ii-&&WYrE~QPyI;#r3+tFxN3L^
zyfg=vJKGG~X1=#~_1pgWkRw4FL+hL}*(u-j+`1!PMXyzi@dOoDE@AFBs>F-YA|~b$
zbqD<GyfGV@!HraY_MvMBeNJ{H4oC;J*q;nHb<V9-rADrij{q0DmlwS!4V$p~&<I#K
zBC=?Qhq4pp9$>4FEbg7_a4&to!)Neovkf^m7sK2{av0opqPl9l7XQgGfyoCI(qA1M
zdP%l5N_=Ff-f+tX%b&6-q6-Y_ukqNY2f0bp>Z;sQ*Qi+NZt0l(dy*peJs$QGLQMab
z?Zr<m5O0mqe*t{XiulHo_)us)DI4)Zu0OtaKM{=hK_lPUwCZ6ab4|{gb$|F<_!>8P
zVFLnVBYmoz-TLdubVwbHcikieKb`t;hB2tu7{*?BCKZD6YP<UNwzlCqzS`{1xV+V=
z??hj(Ge5|_FZ%AHqZ9o`m?LwBB>`eRAd1fB{GYu+9>7pkf@Sp^=?dWX#bEu@rxU8L
zba=iEiq>C?OGjT@4lTLc0soB!j2El;5SevGZMzKjF?=!Db~38#rKe?wvvVa9PqbFk
zs7HnDhqXGXFMWQdX&j1RFR=kpl-%)>z!w<3Wjtsb0er<=RCrJeZagaE?7i=&wGXes
z@}-?j3y@JhOB4B!Y4QfM9o}1mn1htlYx>R-@1fkP5c2Ku|6wU=bT=A#zoYi#ndUXq
z-TP1FnarCpp@Qi*ZduG%hLv(Z)hCrtu*cufLNU<ZjY>9a<&uA1i8S}DFT-g>Vo!C~
zz|0M|7RwC$(RYM0Btx}l<vt#IJ*y1FDVLPyS)sRmsI_3wL_bYW!RV1x+uuT+8XkdE
zJYq+LaJf@AH33bFJrZa$RG%(=nWnJHcV!i@wqM_{dIUrS*8<V83lBwzwDa}aSn*Jb
z<@u)vme!M```8*4#lw!q7ge~NDQaf){Jl6%_+X?NvX_4>K=75-9@-DjN)v!>6UmJq
z2H63Sw4J%6<{r?~Y}W=mXxyG1RNTjIGHGNsT8h}ys7rfomL`v$>VGHGA`Zi4P2#)0
zUGL9}7dChL8%2ENQSy~Hq>W5uF)3&r<|N_4GMS`BPPq4BcbvecCD&Hdkc~E+G%`!I
z0!tG`tT%q}2)i_@1oOnTAPHzq&^l@DT_HPb<y&Ez6U=Esj4U!M7Pk0s2i&8QgNGoM
zz|fC+tVWvA_S?tp|JKL+&JaL3DZ?6c<)*nP?Ph(<dps%9`;_l&cIuUAo5%-ba9$#j
zd1>C*`W^gC+L9GRBHETo&wf>-9tf<WB%_wOA&-u>#ypicG{7oV9B>)^ZrWnVtR8xC
zyi60M^#0}$fHusVzKm>Aox<|Zdw2)&vgE|%Io;N7X72n?lhr$qxJ%^4MmybfQba;=
zT9wJ5d(xZTdrL@hJWUO6_^$BHl`2udl-1GjFvAll1N!A>vcT&kZG_WPT{Q~c4eZ-c
z<_V$mTPMUvdw+*++W%m{f&<{Ub#?S{As|?sARsV4dc2+8ELq*HJUncjtle3B932{r
zR@@9^yaH9U-o*P4Y-Zb^$91!h?6>I!lRgQPK_te9bFeT$G*rm#ZPcU6>DIOTjU<%{
zMfLO?&RB0a2VTsP0n3giugxOaJQ1%ejIZ#Xw|4EFf~(GV=Nrbaz~1wvfN{G(md^9@
z++B@HXZurwh|%liG4NJWEn=KAf56${<@c55uH<-aZKWLT;JWuVgSVs&?Rf3zCZf03
z5A9-YtJxsya%1P2w{7k+VlZOCJ7TT(2;8#fz<Z$LEJ+XC*8SZ&o!fB*UhDdf*Y?kR
z_(;~XQWdJu&et7*vw7Bc!z#YF>}L^^X;kmHw%fNCk3rtSTU>v>6BRNZw31P~w)bN@
z2vI}a$4h77zPPs2J%6&sCz815OBe9_WAsLS`(9|o&X!Z4K!|wTsa06U>jBZq2Gh-T
z`+Kl|r_lC{db449NoU7u%kwjC{07se%5kSN;(c9T#!LyY_Ea(|QF3}tG0b^$x_{R!
zAcC}tB<$tAumRp6i!EPa{sY|#?kQ;ZTV9)6h`;J2MQzg|t0tQt6s#d+$e*3dfNkE$
zB>hvaV&!??`@FN|3INw;w>3fE=Fhd`R<7^MS2C`*Aa&lGdq81eL*IKdPs6pWg~5!7
zITCzLv}fS@vZg)Y{Oy7)!u@L~ad&4bWA^OcwF&P;Sp?%<Imw?_B+sWa7qqnppI4vN
zm!KyWJfStC6;|iRV<Hk$hS-ef+k2!Ir}3OW$01`I4sWgF&(EU5+2ceN4~3fVU8ryK
zaP!Z5;{aS(=le|!>G9knhUF8`x`ahL;B|emwh#CS5qB<ae1>_O%4mN~%&KX-FBv6!
z_vFiDHPMoXwJHGC*F%Fs=(6%%BwvPz*@wY3cMFjk$s01q*+?>mB*YlC6fS+dTY_v1
z^W7MT<1T$=?0RGKxcuAl2ea%V`+W)IwHkedNqi_3!%6LW8VsFrC{Ou*of4Uv{obdF
zJU{^Vfrkz8<!3%X=y%uo4hnTF)x5Vd$$6PKF=8HAx5tFSJqm3Zd3*-lZ%c)6?gC3v
zbEi$Yj4mjrFlpakp;gI}E2K2j2@!c4GbhwOps_-JM{sD_|4m5mM6x~_wZly^VAD-i
zk=4+v><Fu}T0n)mBid#>hXI{07Qfce3rHtS(<qT6e35H&4Xd6X`z7m)CgQG-rbW~Q
z-y6LrM8floxNTU(H7S2D>s^^_spOrTOc3QJ&Y0SA3qOt3C`-t2^03~3k@o~m9Wl(U
zOu3P9*JE3`WhG#uRESjc8+V3iuN2q%3Fb0S^|d=JUA_oU)>{*3K(y`QM>0^h0yKL^
zVLG7grLK((h-hD2%XA6(Z5FAV=(|X@_*JrgaJ3A`ZV7n~aI<K!U@JIA-r0F{KvxIu
zt=^e8v+9MHxs_fG_$!k<@N>3+Jht36d)YDt#1*!<5Vo-n4CBc&SJZsZnmlKzTw0|{
zvBt&S1WLr!=Uv~Zk3W@g3vGs%0K<2Gz2gn%lk5XZS39hRh!%1j9JV}0i<S9O9SJj$
zmaMjBhdZo-a<<L4^-UVHE=u%avWYLF{gu`l>NE3|KE=^{)aP9s*cua!&s2?uI~n;E
zxiLq!P!`47RQm2RvyG;WaK{fdT8cj;eS(s8!h$^-dX0;;Od|(f*`N>o27bD`=>5@n
zi)`)+#EsAV9Ul2$&gV%@y`^G@zIgfE#mW6v2x{o6cD0incPv4funLw`IQ`AXm@tE)
zUI{9vaNESb)pixeIak`6*a`H=oELeJIE{tb5!x`QNsyTm1NlZt&V*~wQb=rFrNE9S
zPz^!yd)8r%=5X~AyBuM216+;f>V-0ILj4p!4-gW?Se$Vn@k%^3Tz(T{IJWeKWv_C|
zaeC&LjQM7hKp|o&Os!H&B<w3}VovvLVqAt^fF%Va*qvnB>{b&M7R)FYgnx|a5Jjps
z-#{H^I(?2n#QS!f3HN0<ovsPxch@ypf#Nnnr<%5pCUl=CgP>SI5zqjac(N<fElKEz
zUpcZVI60&UTCnM5&Y3E{{x?ict*lv<K-Pv>NkeB`4Q0*=s27x#U^*icqaVbDTprwa
zOF6lbA#F%vAbsxk-qb|O%)bx?fBIxk(n7;)tm5XeQ*_~n6CdTwMQTg5k#X-Sk(Hai
zbB{PctDLpT83(5n3Xr?B(pY@_J*;K?nH>?chdzBv9u$dT{0fEXyEbiE4r*Yjc{5y(
z9!Yo4`;`ESR7nxFy-a>)(g?ly4JW(pnqNA?qnuUdmt$D46278^M(RnKGzI=+M!1`9
zQ23<_jEL!bhgx{;Fv3L#oqD{VprBg#xxM8EHOVJ%@CSq+z}d%gNnRAI)!|-_EQN1~
z$*dSzY&;W<vpxv1?c;!G*~8B`?oy3NE&W!w&0RgGix}cf%JehA-^1Q;G|66~el}Xq
z{%CWeUhKuU!du7$BJop9a|KG&iv4k)I}*}6p6{7M`yX&CTHzid)cH`(pugafr)r3S
z6_E$)i%4V^;KO1Ob{%z8ieiky(%y~c<n1tvP)IAg=}Apgbm4><-)-N=BXRt@2!f-)
zrXge@+rb0jnGe%$r@VXOGM!|*wTf?T6H+j>3_JQm05x9xTKzHw?y%T`^o@1m<VwD#
zH5j$e;%Vc`Gq_70Z0CW`YDw8uB{4z4-h72MC~QRpFqz`8F4?lJO>x<2&tsPed-^E3
z3kd??m3rgd`d~;gR=x<w%{#isdglg9u79m(_7VOJci$baI#wV~KJVsxJWbnCnDO%g
zbu-n+2w665(v)0c>xna-_{s=P@X!b9@Z0D=gjnk;CwdCiCCF`oMp-eaxQh@)N*4I`
z10l~5KrY|VWh6p6XV$jJ=M_cvz*D3|>hkZ9ZApuvAPMGzG%bTmmV3T%j=Kxxm>R!J
zWO%bM#I|n<lGBRbI9cIb^m*6szcf<>LJY~q5idXO5w|M`j%CHZWmmv$?KON`*;fm$
z7x$6r;!h>KEkQ69JXdOAtA|IuggmE!mRo&l1A<>7sMKhkUX9eFp2<=hb{^vtKn%)Z
zmQ?4BEfs`0_#edPCd|j<v~Y$gUG|V-A8Ti!!aI=d59C8BQ#=|$4T@cmG5R{VIiX=B
zpJWf-nqwtT)<H3nvFp2qAKEkwPEC_Fzh81iIm=U~CPm2UcImar4um+&5<PUWGN=Cr
zoP!6UED>Thz@e8#_m}$c*(83aSaIaSEL;B2+dgX>-~WIKw_v-;8wJG#CIB$Z7S31^
zeGlUb>9@@Lv0(i5*ZX;7mWB1@zrso03|C7+Xz+d4e&lI7nIW1^kHN^sGFRhDcE{`G
zKTGHRYYg1=BZ{~=#o-n($-Yb_p|Q9FuX@t^KE~Sx>_XB|9JQAs0%OPKV#wzR5C2Xj
z6-;}5bYKL`ebN3>@$TGpQB7>)Am_AS;13_5w@h5Y)?UHXe$(L!`SJH&+jA$&*+lB{
z2{L|Q2ihd&Vx+Ws{_-E9>~1nsp?a)LR!3<*A4>Z8Dl`;9w!KAt*gcUj2bD-3u$@7+
z%KKD>lp}Ftw98@pPGrf^xs&jE@rX{IpwjYqW|w|KPG<~Uf0iQs{)i#4;TimT5X3^)
z7xmNK3~|164@qB&g+iQ4wP*sX!FDwf-Vx~>9{v<Lt~rz(w_uv6Pe}kx4D;L?@^F=x
z1zJsL`_q8;hYwI|cOFxApQOhW=q4>g5+khkg+GSMNk^FXHoirW<)JO7SjrTNn@Kwu
zhdhLDDi8y?Qle8QV^M>~H4f~vR%r_n*T4w(>0*R&cA+vI!s1=dESDGELhFbZ4PXwu
zP(<(!L6=j%HwpM)$}f^KU<4v^C(S1kboCL`wpW5J(dYLeI(B*3#ry$~kdht8Gftwb
zkO+dFeLpwf_pKyhii|$0xp=ep7Q<Al>{u#H=nc<=?(*C`rex}9&B|u$PjgBPB{joI
z!{L*f+ky3yKQ8#UCo8tHswP)0;m~Ebv(6{M7qMO2sXkdk9=vIoD8fIYittCp3lOIT
z76$U3!kv1xSfVhtxDNnZO}OzCsv3&f8R=cU%y}`t62DJhIfarU>u%IRvd#g{(tE?)
zvSGe>M36z7*UnQ9J%ZCy68|1iE3kTPO+W9<!^(+oYK8uD*x~G+QaGT6#0^&&r%D)F
zbsnVg*=j>=y+F*54E`lUgn>J+o`GKwC*&XJT8o1%$B}mMeHa0V8@ABqzMhN5Sf_{M
z@X=w%HF#*SV5+(rF=V<332^qr@Qbw()vHXOeLyX%2d@)l90{St4vBzT*A(|&6BjEK
z8wx3|is#8>_vc=l|1!B09t%w6IJxhs&m~x091t*Em!|M3?$=|u`V3xg@};QSgxah(
zLaF<p(9k<Rw(tPq*jYIyvZGTn@=b-C^}n-0;n)FA(6X@s@XLHG6mlznpM&KDC#<<b
zkVzS75rih(5+g6hKVud=z>uPE=|fp^q-CYBOTHC;q1SSeoDFw^%P43Kj%QWLo^2j!
zSF9Ti*o2A7zMdWDxZG`U3gD*ol2ALqiQ@^jSvQegr!@xVl!AtX=`b(E49h~R10-m~
zLmmoY<9qC<=;aQw>6smJ?+9hLT+QXZibZV?<=p#*!<~lb5P?J@@Ig9y)MY&@J>w{|
z`bg`=Ck+WuH{%z2|FKGdVdT30N^Dy4Ao{G{zT)D@l_7GTU#fimWmg!zS6Cpv`+8IJ
zb@%UQi94X1v7vNnfHA$)K26qH=IpP|F{Y1nTC18+E3CQiTT*M5rl*E?*2Gc~DTw4Z
zm&g8X6BqiBdnuvzwfmfHbI&on7())R9F^v}%!E9AcB9oEZITXwnNXZje565k?XJ~i
zrW?gEc>omacLpKOk$fD$L<~30<EsAeQ;A;11u?+(oe2CbCq`4`I6G!4shuFhhnJpc
zqlI^Lk+6xy_fju_`xxZRG&D}WwI7KU1jW<)e!*$PFS~gjJOqgwrJz+4Gbqb%3O@_I
zze&~P%+Juf0h?Ih74V64X!oaWta!7@kiz0{jt8RPV^tCh_)j(#$K`Nf=5~8rX3>?g
z@;HD%^00n2&73PM{(Gb)cr{C9cfX8F6f&b6_slj#_pHesC+bD6e022*ngEQ~N)Bd8
z$;eVfhM*5nrt>a<?)>sFB5bNxyjH5&J%>~ci!Heu;4DS8vR7{Vn>V?MHr%bshWP~s
zHhyS_B(hr)HQFnEA`@y@2n}x9x4*?klpjD*gJH)6ruTFqllv&YV6H(Sg3nA+s2-E-
zEB5E>B98;ibD0hdY0JNI<Z-)!oOV*{kj{H3nn}U2;Tej>r{Cw2u*}7ns+oT7krU4G
zho_`1WRFY_9b~$LF8B)h@O&G8Hy07fV^niC3HJBKyC3-+u4dpkbLLFbi{O*?LIIcG
zM#WW=9*;4}qduOm1I}QYva}!4BtEI|vinBim}9#?#6q~ym9uQFC65anU#KDCyN_9D
zo(2Nt<XTack1ZL1dRcLi!SXGd@*x%CpA{>8+EzKfv1;)dmk*WLoQF6+&DSJ}^2D%E
zSVXQK<EMY_7)g=G+$+dujK!t=X#iO1r)#-8!m0?*FR3(hz^-K;%{jw%r~*Rbl%i{p
zmWqYm|GGGLIV{bM%IeZ4aK#rv*15sD#`o3v48VdUjxcg(964pNx>i5IdLU$?Z)I_`
zcR)((2*;2VMggr?384k8Kj)-$5ZTU4cs}m;OCtk3--9-Ry~p9%qnq6dbHGz}{9!%w
z@a4w(R+f_w1^h?I9d_DRQLR1A!=n7&uTFn5sh*X4v8xeg=+}urbDujWd6+>VVZhb_
zcZlLTnR<ft<ss+Cldofk-OE`+sI-H{pfa?Zz7(Jp!*V_16_a;?U?uLeR|2v;pS@y6
zXd2<B(B8k7o77Nl!Ul;n11y|KFLLg(FH9=Tqve0;K9ZF@t;kabWyOer9hu6i%f&iv
z(KPSU(L=iN(_*;l*#(eazB@{B=nUZ!R2+E-wFsw<!4TNMxJ?OsZWxgcZm&UId&D*;
znfBdlpj^mYT;GDP_T_B^hlfx_^3bV>PY$=CXYg%dh{X34#C$OYHt5!Z@vCCS1V&pX
z<C8B4EyLt?KRQLkGmnJyot0JA?H4oWUfO-dK<aau8bX-*#wPtLpD3|s0%FU%Such$
z$P;uj4cO8r_#te;7Bf8+8msx9FImFOeuK}!%!g4jGIhC+VBmB3gnu40bG6O3Y)wE=
zgO%vv<{xwTYGI(Ul{j)UGFuY0@>`FvhCPeQ-JhC}ncRslZ2G(@1^{_TXL%9I8VFOg
z?;`D#$6?EFIXOGi<7h;MLDA^@KH+Mk2KXM8`szPhpoFDWc5g{Aew=e5RyVD4uaZbO
zt?5J>8!%8bX<htTB1W9!52YYj?clvbT-^zYDD?bq6hJZt30|ZuFt_3KzN$1$N{^G-
zGpDMNhviV5%=>1)dmJ;0Vn7vM|H@}&#n{Po7r3ThKcjZZIv!WruWr*x@>cSwhL0Qe
zuSw!%yxRoTR|+$1Y4wucQfr@0Svq<9P4{dZOeVzye95Cdcs#LGG4^3@wYGc-Xx!VS
zN_}u(21I+OkR-#e8%B03ZQ7rDCZg^^(F<_??g<OY{yIJOMD5@Auo&8@Ts9ldL@xEk
z$cirnq{!-huWG^hac6!^&fNt9ygxHC1BgfI>4M0ZlL#+$i!&YqZ<vCJmU*4fzM-af
zrdbEO8g55Cbi1e3g3EI@2AKxaX=S$qm(2q90Au$>^2`zo{%EDjQ5S?^{)0?gaGQ{j
zx|1?AYmCYOg&83yHNtr;<fV`_AtV9Pfvro=#&U4(h-<k}zRGF=^dY!}H&JnYfj^NQ
zj3<DZ?>T<D3+k}!>bNY!jvs!W4%QVZ5m5gJ7Uiv*TZN9bI!ZooE$b5=`2A6m!-uO9
z@STS%ym~B~qP{#_o>JV@`V-<2ts^hZo8~PfbD!kh_;IQT+5ParL2Lt8vFx$B+<8RU
z$<L1DJ=YcNVE?M#4&QIeCO~7Gagg4jXk2P%3R$Laqkl(!l~>c?*wLK#s55K3UWcpy
zOP<3W-iz1knTsJ1wJNl3+_g}h6EXuhHLk_(9GyW4)q33DK#MxQo*jO0A(ihuPaJmy
z?8u6?n{+<UOxQDv5;lmutz2F_T>J<Usv^w>WcROdUO5n&+SX4dHk`atCsg8^cvH*o
z%6Cdwa|d5va{wWcsY6cR4-iwd!dpdj==${NP{$#=qiwzOZFG#Y_WaLa#vU+eH@{Iy
z`Z3?X{k!%c|Hd`&yUYCO#BAne=ko`gS@OQxk&367&E`9h{Z`*<kd3?%^tf|v?e=)`
z{XA{ddjHz`?ker|C9N%BUj*1^&3W9bN6R6dA3Xi?-n&ws^KK{tcrQAkkuBW6zY)BT
z$xKM{F^kU3W&?SM+nzpez~&xphH`Zf*!bN8Ztjftpj@XUV(iuFcIK*FWkM-9)!A7m
z2Q}`%B*42ng;n&$?d$WLujk`dj)~z5^>*j-=+&s2H&NuySjpPy0a^G{>OqV%Z^`x8
z(+AF&g*J$ESFQ5v&%%8~n{%$*!?7N&64U9`o9}7Rw>8d}4Th&8iU)jS>w+=+l^q`v
zCC6&P9&q$eZo<R&>-@-6GQa0105)|KfW&F4%Y<CPhav9S=S@v$gj50SdfCt=&%eHf
zEw)h#YSv;gMHE+2EKEyOMKi5HDcDoDH2i$?xAK#Z6K1aOJtHa>2wIE++mj&+Kt6(?
z^Rs%!o5j0U>=hKqDdZQ15wmbN(PM94jpn|7rY%6mXcv)jl+*vkH4zic`VqKe?f58p
zFEuq8f#rN?J3(f<e!-!8Al04pib9=d<c9_GgMA!+Ae68%*(|KyYxrc!fFS7xy0?Q@
zp7%Fyxsl}x(+YbdHMo5d@rZlk{Pz1<Z>3=Y^ZHAw8~4KS=H{MI5L7wi9em?a2E!5A
z|6MK2J$!~+)8rpWT1db|p_dK2e*?Dj^RRzLVHStPO2~-hqH0b418!m)^I{=I)bsVJ
zV_T&=U%+4CgEzM`rK@4>g(<>Jofvv_C4}g%NNI+8rbz?tm_fR$5TfDZ0kIIT&8b3g
z$H-T!eAkO@LL?Tt3pE9fY(#@xErb-alm1U!_j1Q<mCZJp`+0zHE6pFnfJ>UqpYaA2
z6fVQigCuN!pfO0|)sbbNPmf5+VZRY_{n}(#q7(6j<~wEOxfx+C(KfT*%D<&UJ*(6S
zbFE*Z&Zubm^GN^pYr^<h&BChH2vN+61r`g{$Hwq+C~y3-TA~S@{><il4^|~V_iCq&
z-dCw#a!=mr^jlEcHmz*+W}qiXSm)Bb>Ro+i6q9x|{*!a|8*F`#Hiw-|FDIuc%|6DE
zUYGF$<7%l$@K_Y`mZJB)j|rrgImJ-KM3RFQ7hI<j@Mb;ozuj%pX@S&$g(3CPP;aX0
zfMkONI(X}LxKN;^`s2<2nHeDUIZmW2()L)&#V_VAEyUFkO)Pn(tDGm?%wWk~t~8BX
z${?r-whfQ!C0Ls#+c&H^UzI#v&oN9;%CE@oFgaXd^}T2ZymXO;U8Adh{wv!vpcEu_
zV?U5DAV$0MV>*SS5-CeE-)zEg#SYe6x!ubYNErKWKD>$2%`<8EsK!Qyy&&^qGBr@T
z%PO)!tKt{BFzHK$(bsfSlE#fHI6gpEO(L&xjM{hW>G?S=;rfFFmo9~I9InsA&?f&^
z^+<nWeaOYBI9zG`6Wxea?Qe#05XIZDe?hXOUEM>OmdjM*FX5Z<dg|__hVU6juUz9W
zU?7Q(FGKxJ%D_!c8z)P|v<`n)L>7q5Z`A`8P#p-;pg5Eg<R^omtUIA!NG%C(3TB6Q
zF&1Q0|4HE9su11^O>~SRlzz>4p$kjFz0PwW7v>Q$M{gVuTc$eSYH*0YmG~J588X_F
zeM5?1(prFp+!v8@_U)a`KzZzr6s{c0NKnK2fb>t#w>MLFo%sKJI&@N{5%Xt=hW3
z4?(8lyVQ=^L6JO`e&v3DKdEA3fQ*`rP0fz(07Per0!-3JD8ngfy8GBhRD<3`?{QIo
z2F}fGxkv02%Z~~97pT<cZph_NGK@h#+`J$mmh@9IdmvRHXH!plAnAzy|K6|vd}IG>
zA0_pAAw?ilQk{Asg<!O*AR$sisvt>I|Mo&MKpLdp_d?SAPaKi=LE=KYHbSOmHbN4l
z!t_F-6a9C6H6bA&f}#HBQ~Uqsgn+0?4ea}vRWKFY2Pp>mIrX&<QWUZwRk$CLmgv6&
edGayp6dD2o{r?U5_=-&h`XQ;{YPvsqA^s0&ex=3$
delta 98386
zcmV(!K;^%hiwCHS2e3g23QJ`gGKF>l07F}oO9>lB<2JVE_pRFh0jtcNk#=NSPs`Ta
zcFNC8S7mx~yOWy_Q**l@5|S8GgqnmbEBnvyIRHqJdQfV&(@oGwRoXU1LIlna=Y^B3
z2`_);|NdY9xg2`jUCdZ02n-R%!{yw4Q=1AgAD*7Z?v%}F?96;O;xQi!$K|tAJ|6on
zJ6-a~JMFaEE&1C#;x3D0_`Vw&KGL|RhjX8f8_kR85+23@d#CP{MuI)9$7p}{ApO&e
z)AP-NX4_Naa~8sfV;;?@fIp+j>5N7Xi}`;Ej60{oANheVRxo7iEE$HssV$;#sE0U7
zUj-i-s#noJk|&~LzE?eRtH~k1@ibxqyaNy8sXtHGboSiQ;KOM$$YaqY9%n&v-*VpW
zeHkEb6;;*)9`pK|l(Rs+dGUzt))5rJA<`#~d4>FUCT}vMez^YPXDv-;aohdR8=!x)
zHNaWSK5vM=9^y1!&DL9EIiGwPm4Ar%V!j^D|FY5Eh7ajj$ge(QERB{dg5xiHnGaJs
zhpjwwhi@k#kLW0XHv-xdARmzwAh=6vm%vR&+*{$#Iav;Y8+-5H)LN~Z^TG86aA1Au
zrwA|JUUb^Gcj?7jHl~X}Y=80-Uh03H_d0{N{D%2Y5&rN)4{iw97#``L4e;(M4JVS}
z<KL%v({C<Zex$*h8s4a`Me6zJo`)iak7?}sK&>0Th<p~2cWf!gx(eg%t8SdXBnKR+
ze{W*>)8zq=l5f4gZ^3`+w)pqtYWqC7a)U3ByB5G4l4~qH`QaKbpX#?hO=o|P->|)w
zhEH!f6qnzTyC~w(khlSjV*)sYcL}*56V8F)Qx+1cKl5V}u^E449`P282u|Kz;aEbA
zsFrIBiyN?0>({#<^!saoS}cA67WG<I35$UrGScpz5kDlrK-~w@X#t;Xch1Pt7gIt#
zkI-l$HI2_kU<Pb=z5ZFZZy0~rzK9C12Tdr9hw+@cAUo#~i&^x@Y5=hhJa`1=HTB~m
ziTR8Pf5u|M5O@TBi|GXZbZJONjLdk1x56J{3V+cj;`#ABpes^8Zx31xhx|NU#7&J+
z2KLa3<nZ_nmiI;Afm4{%Sg=;TcK81MKi`wL??|ml#*5HJ^S}w|j5U7=*mp!kaP2`Y
zkXk<Ck5M>`{E0)}hPYXMe5R?kt&q2l7;GTeLWGay-%A?FKa(L~(FO4Z${fKt0V8rE
zzb$6?86$tf2MAw?`9cs-q6u100Tby<>>~pb;k?)HblbZ{k_nV?$Q7<+5OaxR;F7T1
zK$?%SONC(3VU~E&ZJmEz_l_3I`P;2f-o-`@0M0&^i2Ksx!imxDAm5V@u*sC1eWZSX
z=Eq*HhEN!sb#7Zm?3~>TKv@hdMfmR4EDe~_B}gL{#n05kuiBl?O=s7Z&wpaK{9(;W
zubAP}Q+jxWvOn@;HYDiCh=-@AZbU;TI+;iOH|7fEuwtWA*i3&9s4|^SCiqZv`shzW
z22v<KeJ=<3IAMGiJ5w<W4uf<9k7{Ah@6PV}5?q@g&3|G+dKjd7#VP?(6kAgs`M<*i
zXpkC&Qcv_4UI|yA7lz}&cZCvYprHew&)n>g4}wPe)68IR$h%*D{E^TYMv`y?Rd!7N
z59pnxJgPec-c_RLX!{eCifkF3;*r$abG4C+k_al37b#~Xjx5z#o*_}@R>Y^fU
z5VT39Rl}ZK<}T2BB10m5$RifIQ#>&un)5nRU6aOuACmVU#KQBr8etA|kggOkvRv*J
z+C<$}_u~4t0?W5s$IGnJ5v!0#R%MpvGLhx60PJw!S>u0zFXf5Erv)g%c<y&P=%2N_
zXPwg}Sl}lv4dMSq%uXmueh~4q6Twfw<Ug4$-08_!iue;ypHE^2ywE#A;2masJJ(t7
z;N)V48|H7f+;9gs9C7}DY(a~&q3^*e;Txi-=1uM65BwTvuHR4JdnZ>+-KhrMrc_=K
zRYpX;;M#xhT(;JEr?uPXod4wYE?b84s_oyu>0S4)zXqFqA#REux5?z=raUoc0wex3
z4|x6r#dxypmjC3>f%w}=>c6fZ7Ev#_gWK({be`HRYy?(3Drmcz*Ap#7EJQL8Sy^~k
zcpyA3T`JhbSQTJ5x}O1VMZLRz>*~DwIuTz{Xghz!+M%X+$!M?_*)ovLQ9*9X#cQ$t
zM_}DFSV*KRN6qoD=nQ)2gR5N#$ba&><+~X#tj%F3U=tR4GQ6pn@m0huR%o~Si{<H6
z<LS7Y$9{lEx%XE;ez>!su%M8jSo)rr0xDWg-(tdILSjN*l$dyq<IiHEikQI22`Bb{
zM_hmG(*<#A7p?xqpfs9bW@?u$XVBmG=0=jm?oGQl<=zara8ZU^&Ca4?jS3pfrxZ|O
zWw=FzLd1;G5CHM>`(G@Vu$a*H-_(yESmZn)W!{ilEWDZphXqFt9I2DQBEur%5|bm7
z)1e$3G7~GeDL9GPs@`%s{l>ocw+5lzod$pJPCUW2NBS=cijut95hu5ZfMUL8gKxh5
zKK&}eH|<vEs(o#D>bF)na7!K$OtF{3m5#62F?+)&YGtlf#N?hAzPGZDc?*gyP&gw$
zbixr}qyK!T%Aj|4cfGFMWr49{aZCcnZ$8#5J3bia{$g;~yVwN9Rj1oqBP9ch{Ox}d
z6#CNZ0fkx|lRyzOhK~8pv$;fXaCU#YGcen7iDYq%0)z^}=~_ToKuAC&2mN0X!f7#4
zEliB0V=3Vk&qIa<f#HUR2EpfMa=m64R56q5$qDEvNA@jn+x)Ha&gz&gdwbU%oDVi+
z`bDdImnmzVwFJ)wXZ^F>KGq}1k*j~n&W(WqY*@G>C_E)7B6!J2P_$j2<NLDm$Z&YC
ztURi^JhJB)6*n(n5BoD4VPpZ30R+d8vs%b){I~@K0z&xigF551T;k<GQ9k+usa3ga
zN%3OE&M*)w`0ksM1l&cp*Dd3T;$^#1l(6i>$`oKUe&_}Zk2$}yh}*y_3ypuQy20lT
zdlC_KW;6mK$aAljt!iV@f#?`<A^7Yo0p#Ya-TSO|aaJ+?LsXzxP~psZz8_!)%ZEs7
z3cL^KsQpgw?7UUN*<99uY1gVw9m`;<&0w&s#w*}3R@Z((EE^35iFzGc*88#(+_ORd
z>Z)%V@yo}+p2fI4KNgsQQbK>`_0<G#J{0C4v)U0kWAXZ}=qo`iLuG7jnlI$_RS`{T
z=iz6UIkVwKWmdkA2rm-sNognh#F_$j=em1!aaI;!e?f>*yR$h_!{_vDM!rAb)$Zhd
z{JmT;qtAtm@P$+YYR`{7vEX^t;Biv10WdnZD6%NphoXSS;ynvJ7BPSCCpux*5u*?C
z!9DoWg@58HUp`+gweYG2ybf|BjTYON<z?1+FDwi*Y$@8cQpd67yDcOnBqouMl|ha^
zm$BtyJ{J&%m5ZSs;=!hQzX0V8V+9ctiwFano_k1Zqw32>XiZaRGMNV)kLeU?4^#HM
z(>rgcu^|WLe*X4Xx!Hg95|kJNf{wQH!OQo)&x%gF?so_0rOco}O}qSyet85>u(m+O
z6#y+GtZiuVAn~xIAU5WaA0jG>xbMY%uYFsZW6&&HllsoSSAQ*mz}CZCW_A6DXoSEY
zIddwe#X!F3oLybqlm*CN5R9-@@8o##qu1aikdHvGCh*OM&1HY%|2-ER)j9amE9xJ;
zu7_dpN1kv!`*o4d-;t}g|0n^;2Q679-;(?fC;4v4@Liz}de=JZT>Vix=ojJlr^46n
zcLukAl;h&%X@C~u0WGAod_*}xJ7mP4@E0Sga=AAR)yOSfyrWA?guhmc2p$)O+0BOW
zDDqc=*_8Pyy@Y?tphb-S<dvul<)b<%0{2C5Euv}(XTu|sNTztsTz~AlRQNoMn<Qpz
zNTx!}<KgM4zDag|dSp?|93D+hbx2Q~e0+jq#LiUAf)~fXwUSD0CH;E!{@vSmKYS<w
z-L0wg73uz-FJt1u+fYA*)h6$*h#wM<3flfxleqO2{DXh3ZyWz6OFsz6h>?iR_#^Y+
z*D;S6nMd4ZaSRVP;TAC^l%Ve)2de`Qg4+VV%(po|9#@^a*3Eg};%X<Z^x~8fSAT~k
zW-*}vkPys1m(S)40iX%|2Zjg}Q$}P1Vwo$ct*Uy1j2EGc0*vr6d0!-`Z#(_#!TD~u
zly61$6nB3tG+{QdUv`>*fW2O<ZbWR%A{M&rbi(-Tqb7P;)D0_kzO{$$XHKT{k%0g~
zX%aAG3mYev8(YLM<8mG_8Z%RUV7uq!Mhx@=pxKzZ0?ZMY2a8#lXabs$lG76k+f7+1
zE6M+{5jpaCG4)Xgk<TTf0d)?L9+Sn4g~B2CFmiu7TFeAKHi`IR4kD!pAg!zR*_k=!
z8~~nG%Si|7<8uL$14SMXgvMm-N3kF*VDduUcbL<}>+;TalRSiciAt!LQlTz($ZP?R
z&>-fh$7+Ka5F|kdUl;pgA<gH8Lr|QlFRc&*O4rX&j9p4&!YT`|%SQbf1j4$_Xo_K%
zhOmE^v0pVx49}0}0bMD1!jN+SuaW$eET=3a3*<Cp?u`jw2(U#CgJ`FPu^&YF+bxL7
z&kesLA28cK0aQ%tfEOq5L*`%_ep7;O{adD^>3*$LEyR7ld)xn`;`wt6p>VF}eSZ(U
ztd*?C;T3}K^(WH+{ujvyD;5BU-Q0s|y*+<Z<wldNt1F<Eu~BiMAsrQ<2Fzwk^8cNB
z0b8NlLb4k8Br$DaDclDRM(r5Z$$=YAKP^}+eeS32LATw$Xb)0<I&h+sMd*tYK0d+k
zQG-hb1jobS=$tuzICg+PIqnn&^WBG&jHRqbI+btfkY8Xh!biU`SERlb>bh($nAd+K
zqXl|eLbSNig@Ozc^qfTuDo&j_6VQ(^V{<rE_Xr%UuCCxq)>}@eNos!RPFY-Qz^}7e
ztw~@-7wn&5u+q`pjU#+{*XP~d_0Aa5{3rGptYi$aNY}l%Zr`1M6{hwgleyIjLCn}J
zCPJ$G9uFB2OWy^%GbFzP&d~ksu}6Qn0_<NpCn*_$2zY?a_IJKyuul##dkyLGt;=P|
zVaAIQ*jI;QR!U3TLoq9*UHm=a1pqtHK`XS)lHKEgn!bpeQu&q}2+xVAAI4<1ia|;D
z`QnJ6itDrX)!kaX&e1rzn3X2E+p8!|zI8^zALQpP+5p$>Uhn$Km<^zgL$!aYiMnOc
z+^#O#*H@*~kfrCHqnd{iT}{*)4{%<!_e>!Z5=eUx-jLQ|PGrMd4(qi$7pH{S{*GL|
z|KXQ^+`aqR#<y6v&vz=kWmu(yBb*T#M|5VYhh`7c&O|1m>88(v__&aEz4O7%t=fMk
zO!Cu$hQb$A_>UDk8-7IBQLKN$z$!#AG;u0Lr`7sUMMdio)MIhO@rZ~e*ZVHUjVI4U
zIlPjkYl$Xwxp6+O$mo#U#XP`}aONev6N4_+ad{NI{mipkk=2UGYDnBEji`%9s<DWq
z&{e0YQeny>h>U?VtWM~Y4{ShR&&cW!P#F2HIy;B~hwpM1(oo_U&?$cpFnHw2SPi}o
z3}uqt=(F54asf0N&^tqgaEJ*DS%fhsMH|{cC9itXK~m00FeE`a@~{eMD9Z^+=xyeg
zS@u+UYh7;XA$epnU<{Rx4Zf7JhTV)QtD~$<hIEh^)fyFzW~BB~u{>T75C6cpJlOrr
z2ckyXny2FZ4tYDygbaUXh+ZErBKc&6xV?-4h&FUH(`k*YJ&n<9$kU=wk{e_jnZuW>
zK+wd_XiJiB;=q#INODVIuL5xoQ@+zA%c<{9k)O|C)5~D*LyjL!@)A<Ff~p&+-;4r*
zwsve0g}QgGZtu2?6w(Q>m7>uQY<$9IbFoTIDsAvPdy;LwMmB#3sRQd~O?)>UmcJF>
z-}vH;56c6-0>1vZ<c=Z=w=a7A>rxhLDo#lOp$BuNp6AO1SMBSd0W6`nQiiWKTvnu>
zJhjzY(P+Tz$h67L@6_7%ufn!>Buj8)K>d&e*acks^;E_dnt$+7>Hu8(1GiL35;2Ld
z5M6?}tuX#fWfp&vI{u+HB_^QLNXU(ux(L)bG9G-2LdNCrYx-%YA+3+C7bb6#7AL7t
zjj$@h`Zcy3nlkQW#8hKol}125@EIDh>1!3Syo-zOb$3ukf>una#gKV3XH?J>@N&c?
zU?tKy8qOALCBRx(9Fkq$N)IZFWrt$F!B{ne_E_vj{v3a$y%qMaQrKgTTF#v>lh(El
z8xcO}4JwRdGL%J?dPnbJP%^&bIorGhN`0quCUbG^KK}~)ya@DnUCfI%2lR&O7?*2H
zMKagaM)A}pQao3hP&%a)9qjPHBipf=5AWZzPPfxqC&$~ZYOp5yUB=9n;PHzcaE6_%
zg*-e77eRl%#+d0elbcnh>*&p!ccT`OPjB54QVNs{U2akXQD?BLuz=y0aHaew$8e?d
zuB^Rh^Ul8p11iF6r{C+Gmr~oWw;Q>56rPwe4!J61phgv$-c7S0I5xbpgoG<RimM8R
zRA8k%<W0`oc$Crl_O}Ep_pW0YUOZyTldyR*U}b;AtCSIjmF=&0P;jgrV%h<wY_xng
zT~oH@-g*}*BzJeH(BAHv2GUecP*vm7*$psR?)r4&M9@s8t7CO?=b)D9TBd8dl2q?z
zIdPH}u+5Wo;rcQ01zFNqg{T)tqZ-DlGnrN}F_l=cPAjiySf_z<X1Hl`?g*PFGOi^b
zf0uuJxVaQ1oMKzeNzP7|Y?fU|;<=fk6L`xp8MgPGv-`G`Y?~r7|A`fm--?jmksArg
zq(@026($i|)f-JRjUVv`6E22*M!L{vQl9fL0zUIh)M`$~YEIXk_HDnE%<3l|`?3&;
zUm=khg4n~f&#gU4{4f@bdOLGWW$1RmK?i??pLB#p-l9c-;hrPD5F}vX1f$$#>?a1c
z3rwqcn|xPd1nTx!*e`2^oa5tU@^MZBCIqWDbX9Uxy=L^OXvNDL^5W0v-lMguSP6g=
zNmf<AfY6ylg?54K&#*K>_VCI`Y8FKTZGzWE`MiikGkRm#&;bLPSsLe)i{Gmdze0bR
zTq%;Jt%{nd)KRL43c4Jjhgm8ps+P)p9;`6+L{m1a<S4RZRSb*<OOzCkf!;IoL#EPS
zj@ZE^+^m(%v4(fY^h%rl{_S4=2tB7W=$#L)HpJTg-nIGLZSUIh@5Jw9`RD-j{LphS
z(|v!fG<B2iFoWvR#*@Wo2Bl5<@ehCOU(=EsRCKhgLb6GqKL_G(Cuv;eI3H#i6P@ST
zl*&`VvmJbPThBt}L=RDfgziPR*KX}*DaI`F&iW6A;^@*Lzec`bq*g=1hCJEn5&N|8
z3o7@NeO5M^uRLP0%*lMn>c(I&3`xKzn91&td$b>P#{Ksw>##wX>H(8=3Z#FSO6(0;
z>>^vK6URjtsY={0+DSLJ{npt<8CR%cwuda9kfvkCKsHozMgesn8t4&UGBh=@53eL0
zUx)zT3F~#LXW=)ZdM4^;i^yu2V+d>AMjR(zEuxQ9EvHPo%lr<`+d{@{P0+&)rPJj&
z_4vr0CACLjk$8AjPx&g+OA&ucmUn>LX(%;ZRcLROGG1(4nJ{c!Q1kxk#}A*wv(?8N
z%ps|vlHme+?-z#ITf}@-#B6|J1k#s^=^77*HM(}Ydo_?cmsQ@(fkcr{W9fThTHFh#
zw9$QgoaHL&tx|$HS5TkS#}S{A7INcuqqtU{+OOrC<|Q8!2|aY1>9T*%s)Zg1m(<&R
zBv%^T_3sBeqs#OB>Xn=*n*!?M7%5FuQzr8(dJ>PAPjX4Iq0;Wp-ILsK5gAFo%PB3?
zNvlAoDs8NF7`t*tCgoMDL&M9unHx#fw~g7HN*|s!DPP2$Y&Ja$y(HzOr#=qbm8yy7
zUfBw#qgAeO_~v{|I5~d|%|*Y6fEmTCxwd`Q5cSyD4-dsDm?jA%HPKTeCtH3(?Vd)n
zTIQU#-%O=OJ>+Xh?KeQn?kGd^*;Epc`iws9-`A#)V6UVsyNCw?vcUG4u`2K_=|e_L
zESU-@!7fEAqt=tI^O&^BNk-_PI+Xa(<-^z|@t+u0AV4@h&9Hw{0H{e%NM#*Zq~q`P
z8EL(N&h|OH1juC`sb+aN+K4Ygk4Ccj8IAA{@}wFyF2cg3p7JUtg0!2Y(<I#_xh}0J
z0TX`tG=#jiX`M!;Vtn6`LQhK--74jqMv)Jt8V(avUYx4#cw2_G_LA(+#xc$(Qo?ss
z4v?fPm6ZC0rvHD&>8X)BrO0wNb{C=Uq^A@F9JkQnL>RM(c`4PUjXr7z%OIZhTAkZ6
zW|Vxcmmo8lJi)5rI53!I=u1%Ny$8Gr=8<rxgTY`@DW5}zSQR2wq1>(%8#GLA6}VY)
zV(d6~%U5)@>~~shOJUmu@kM+XhA^9=a6Eb0hU1lo{}g{k-fi@(l)hYb8jcNK{ji9N
z<@L708}9ACWoA~x(e{pEp)pv@-A0|6v8!y<Sy?G_$c1XE<Z?hx%@_@f8(oyOX2>3h
zg<Kl}NT{}&pEdyEX|xC*swKHV&%o-`k?I^B_#u{*n1npS+J(i{U@YgioZoW(1Dt<n
zXmM^br`CTMf3?QA<hQZ^yEVwmKBv5u&c{+z7830i+tO~b-SR4PCP(@0kr_#TA3;@a
zIrZa*1KHwck!;Vb{gBM^?K!Q4skDR%Xe{2d&|{#p|3oM3I%4!eK9v;J3Au2mnW{SP
z@b7gsobSn7p$qGHemoE83Xd+bcQo|{?C}=?)aHLYl)a|td>-*9e+Jr(DhP^R%8UMg
zz-{5!_gLtv>eUgvcyjbHW1de#b($haUEkryggsGLz*udke@>ocweyJl*Mfq90wU!-
zfQga%+y8psAg3h$6p4D+Xp*HbrbJZ&TX*i0oH|w+88hmsoFP04kwq!;-;Bj))R7Nb
z>WY79cpPt%1uX(PZ(?5_-7Qu=1v^gm-2$`FpM?GxRu&8hJvq-GkAWO8{Uef#?M{3Z
zx*iSYQ)>0R(#)yw;6<qpL_{=%Y2!{_!5s@Mdy-xfc(1(1=k(KpH3@P?=3;k?VAXJn
zD1CL&zP?&-Z?#nVqABDjKXaJzj2|)25>kKvQ3?YTZgCS2^w)coydf>iwO<j})(je5
zy%{Cx%JZc6SMi4;kauqT_jjfAKViv4L)r5_o+H&%S|~=#Tc#Y8!x^Z~C-Icdt5(_1
zLo=aJ7IfOJjyXLZq)~x3!<0w<@9?5vpaA_QJcM5=MY_CAr>(d(>uVnBxndY$wT*v^
zB}K7Vp`oNy@%CDUvFgg}Q&+S@(|G_g3`rzCBihB1_&ObOrwX6dLS7>n2%mh?Xkr<(
zS}Z)ct{cr^oixOhzK5_+3*dBU4>|opSBxHPMxSznW#5EgxizfXxeQYV!()N|CV_qv
z5FR!})p|<u$UdTSWNB6J*LpIx<wk$WZ~>Lmq20AAbO;rW3|k`Wpd0C4);V)2C&Iyu
zgabAxsub0C<mXtHU3tADEdxFzkIWTV4t%WZb-PnqAx52Vyc8{hBm^Jpj_clbNl9|N
zq-~0IaXR)yXLDfnG5Ui!9vcOGc`)Vou8SwoWu!f$F^;ytV@6cjq^YRc`(}TqK+rhz
z{<3ev8Eos;ugMwSj&;K;kmj-~ysijuaq#MJP>bn|)l|a=2?f~>U`ihqXT(oa7K-Qd
zX?t_*3ZI<GJQFwVn_jCsu(&Y`H~Wmif1>kZ>0>obBc<l<c~RNOJrSJ8%*<#q*4vFH
zsdpOa|EYJ2%P$y4$+gO(30i+0TB^*5jaEHPP-|T_$NY3Ek~z<L9Qz|b@Wl%0tN6Y|
zc5NO0E{B=J+vUst64asBcjZ5mx8s8#OFRx5CWd1vF~TtnOG^#xQ-pdoHle1W3%o*l
zF{PqTL-hbnBeJyiURaHxyjr+JZuY&nk-Q<(B)m!t9;-=IicTJzV<Uf3u6Dfi0^|~>
zWJu-uvL9!=-)^*m$L8_A>hx8-Mp~CMWsUMx&2gPDFc)XPn1w|4?nQp(k8$$AI~9Z7
zTDYQpu(O9@X_x6T<lzb8z)&(@HVdG;P3^sePRXmhL)tU+Tnp#C-yPg{(u>x2x?^$5
zhoyZMPKu2o;j&2u4N`w?Xh-|^BIa<_Zujo4ccaCW1=%0hW#n|SETKMLMDi^Dvl)D8
zCw&<)(5VX=lN(7inGzo>@!T!66RNP|66xhpLEEW5S2XLhPPfzAOp+@vMji6=)W^If
zxfNlyYNi`aXRC$awCgz~0h^%ajs`ONVk<=0ChAty^L%-}rh|V2GSih=Tu!wJTOIQ4
zo?vo%x^6d}YwzVTLH!^mbi@~`NMg}~Y-q}5$Mce^*613-z_UgRKM=s7lCx*AEX=j3
z0sykU1z3b_92_W?RAxDpJtEaab|WTBfhVB^+TKJdwGq_2iS2Its@*jP+on=&Z|oB&
z4{M*8MrjefbohUZDfGe(m((d+Z#`1jMzVF&=_-GM5mTg?Yd#OCA4)Gxb%?jmswt3`
zWv5jt1}aabLk3vcDfQeS{`33pRqr;vXuX;{7N>;d&Nwg~=?r&x<gqB@%*=#|Zum1X
z3L;nCSU#G1({VJmJ`L^`YD0PSlzi3pZ2fwiHGXoE_dtIWL&IkJ0%u<3-4Vx~d6|aI
z)E3*^>FcB3WW&;kCDG99xEO8jP}ha0GD)Vg-ol8f;-hlFT=mhd6Xj=07n^TTAYF`$
z3M}Fl?N;Ziz3GxKZ;%xNT<r}94~dGIMtP@^k@ve!Ei)WI_#$A^mv>mI8y59b?29x?
zL%DpuE@FQeH<7xCWhiEBus3hCuJQRht=z5+++fur)uT)X#y(YezFL<N5cxPM42;5)
z*oH%XjeNmKt%fS!+BY7tPYWLu!9PSJ>|n<=8%4ESBh-sy3fPnrLipY)TjJDrRc2-k
zH&V1Yuojjs9|fS4P@FJ6`v^Db9&F=9sFF2NKcRml#33RkzbF*4<&twu`9?z)^YYiL
z_wU}m`=OZe7>0!*Dxg@HM4p#Miv#5X@?5~k8Gl;P5VUG4v*#*BOP5P$0dV_b4^b7U
zs7`!iQdb?nSE|Wl(X21Joo=gd%mk%EP$fEEqL4@%=V*^tgN&F<QM_OQSwF-oCWh`w
z890BpC=3`YEd(!{m12ZSSE0UCnkkFnPe7d?&rk`bam-y`Mv=(6IuvxESZ0{Q0C1BG
zj>B|4UA!D1yCVJ!+ssm(xO0E?;|Hw$jtmIhw-F6JJ_}Y_cd9z?P12gM$WS6kk^NQ*
zL#Xs-YM3~``2wAEX?UIV_{bt94f4R)JdJ-jtCkLxSC=vxMsA9y$Db@H7MNVDj2)?h
z?)0~|<bU`iAY#UD@Uu5H!Jb4rS@PqFfNQ(c>il}r<d2)&5jLs=YJn4uhL|_)OB7-|
zi3!65=G<}kx|0Pwk!ptF2(PT00LN*OwUrb2GgSxDA$Lg%v<y{~X_&zKvBNkB1|EN=
z&KMY4*JC?E(7z&jVZu0_F=UYiX;-gcArK_02;Ukppfmu81ST^rfq}*tiI0)2+N+|0
zYXP-k;K^<LDxh>JxT?Dl&u9=Zm3kuE4q;;;m@c*|O5C}~6j70tTIh4dusz@}5UeFV
zJ1Fj3wN_Gx$Wd59iBV;*NO6~|)gFJ(S%mh_5uB)Wi?cUM?6cXbVIGtN4AQJ~uwAuo
z*SIA4YPUs{-5CW};$!H8d(X^cO&!jbZ<v6MqLhl1w39m|>hKimu%zo<4|><@go=z%
z%YUMTnz|$hu|n-zVqb}_P2898MPpX67Bt(X;!C*d+S;!cUsQ^j0jn=P;W2+x$-`Q2
z#C_n9UsCs|EKsVASm{1V)9KSsQPot+DLj+}uwXa}Dy7o$S=XCO?^88{gg?s+ghlJ3
zg^D@=!4NIbxXy>We4fy-=22xNNs%W}^^D(YN{+bP$60W$hV>**eQ?`7t<53h<;!S;
zc4JpfMbr&}4>&h)OMgilT8n=yD>5Y9Mk>E*kK|CFR!x8;X1Tf2V_({WQaOKT5tq@b
zs_TNLVwzx?l`zFo^X=Q-;Ck~Ezr1u+ux$}+KdsveXaJ*2O&(2Eir$r@-GSg5)5sIB
zq`QTNA-a9BMip{fRQ*K615(%V=1I6Yqhb*;E1|7~&Piz9U~8)ktU7<P)oGO;8~gIq
zK&RBG8VfqQD?wp>-D^eVG^kh*c^um$%PAEMJK(}4UngX8m}=Ze1xWUd*6CLnoa<v`
zT}&}`Yv{f%_$u-ahg>D|Nuyn2BI~467dr~bRPk6a>ftnKX4XZV&#+SwMY^I14f?(A
zbtyAK_eRv3M~A&Zw)B5M*&Wknlx)j+#9bC+BHn0)NlqUplaF&6Fd<moN}pHed3bUH
zIvVC!Y?7%TVMR26k35@3dGVyuP;^4^x`5%XB!4MB+C^NVbJw~#H!0L2NrKNOz^|(p
zv`JbducO-^$}$K??5W$k?%;fI^q$J!F87qaWcO5AHM*j$aDRU`IP0I4kwH8;6xFm!
z3BqBjbV}PZQIs*hk;vJ~Esd8n!`qy_DHBzPmT@-ML#pGdL96OJH<_UM+1a1TTy_!m
zQxZ2Xi5V+)%oiAX;|AP)z<z-w;woW#NLuoSbzESRT&PP)<XMxn&()R19OjQ!%Q7TP
zxDLGWL?w!3zv_Re?>O1|l9PSkVimC0rGTwILjluyz(*-yG6!UL0a1&p*MKU2HYA<=
z$<9`dO_?5)qD7*sNKfevdhPT3GS1i`|CA1>8O7+D!bx;GXV=}U5>Db7zJ5KIJT6<k
zR`;rm6TH-oIZ+B?m3u&2VMCoRXvVE;V<>f?8jPBZA*6rWJ;PMsRETQG`KnI0l+9bZ
z8AZ1zGYOV!bjQb4r;;jMSD~$y>xNc!>TO8vQ)?T&O7|=nOnfpV%$IrWwUF1Eqz0Ed
zHBwJ)rwyYz(?w7oZ_7@C_%9hp$oi6Pgu|!^P0)X5y1$dQ<#YGME)AI1K+7M$yWM)3
zFK@Sw_;!D|Nq_xORSnBW+2aZr8t1DHxxm^Wu|En}nog3*Yc8UdK8P<Ntz<XGN>OTE
zZfhbf+a~cAl3<jK7L$ytT^%G&g_y^~)6)q&wHP@rpPgcOCYZ)CJJold`f&_<|MdL4
zeZ(2!b*J0Dl~o(8kgBYZ62AK&%LUQ-JmOFO4D)}`)}?_w7GsU%#M@WI8!j&TH@7!s
z<P8BGvBK_o8tJCcEpfIUsNz|6r?Rd%HN(P#2*W}rt6?Onlt(LxQ!y22;abN{j^;7y
zW+B*ch~a8dP0iHjF7zQA21Iku;k9p=pmpJol|6+~y~>mlSaJ@@xRzB1*?f5=R6*FT
znYw?g))#<Wm<&H!t;0h0l2zHpYfCjl<07I~AvSo8VKd=tu7Xvx^QwZbWHYX-3RTQd
z2AkMS@Fn>&>}k$p8e;KO8Aq6S=c+{}RY2BEN~r_SI&&sqv9w$N)0Y2sq!fc+y3Mr8
zS~p|Rs2D3b?Ki}&U%*41R?E~9bQ{f=chi5)Xowa&s>_Sc1CHvdkY~I8mKo%cZO2sG
zUdb^0!V~N&P^wU^FPgm7alfV$QMc@<IvTN7n(r<GS;+=FjwFKIahzf}mY1irTUDpp
z|8y*E%1axkZ!UFEU5Bl2Q<I;+khog<Z43djJnf8`%R_H{=(&B+sqUcBN?ULvCYFDU
zg&CtRS3on>b5y$u0fdweYEsAR@?e3W<5S2mm|tSHK8lE#SVSQhhFCp`pk9dQEPukg
z|CE2zN9DgsVl~iXpf6>bbHS$@?+!0|ufwautq(2sUmN!Q&<z$IbFijYrjhL}2OMR3
z`(UpXypOcL-wE_Bh2A3R6(Ol0kc5BF9rh$5>db(}`C(dMXdZEF28bz#^@N+YB)@An
zvgu<0GWk4F&&Oo8hy|J_)bkX7lPFcSgVO59s+?sLZ`w{kJKW^7-ENgLPky#2dhdS!
z?Cz$Nad^cCu%%sY;m-qK7O>g({-*k2Huq&>`_fTdmmBI|oqv-PwYUD&{&#<a{NEi9
zHE{dMzzIIb&9x)5({lb-phJv6ljXAwKJR;MhQ%LtU~ROJJ{MKc4Ij1Ov1&s`Z732J
zH)rkMO)2|I#excF&Z~8bK1@}p8S{KFW3_EeM@a?Tt*%54xl`FK@?@h9My7ryp7Leb
zXp$N*1TclEYKNg^$H9P}UiW|c=Aw*rN7KAo>OsUN81E>pIZ0@wmL$0BB?2_IPO?|T
zrwckJR*-{Z#74zfc<R+DWUyvcwY^o18w-JU(*qu24%@99@`~9&S*erMv&)u-&M7~p
zYIv957ty2N?VR=c=3p!1g*I5)6xa(U62*_D)}Ncwsnrf&r4=vny{CWgkE{_2pBHZ3
zcDK{Lx!sKsQ<h;2?`CSQ)t<CJ>@D)yWV`QoZ~I?`4eQ<zYEJj}z&l#WTo2D4zSo~j
z1NdJgAFNmqaQRJH=3Us_$w1DX3tzDE)XGzwh?S?`1jt%+dVVa5L??buLw9dF5Kgjt
z-5T60qMCvCkjz=+vQU4}&4RJ|48MNFbWI_2O6Dq&@D1rpPex4ACVATb?<toJmWC3f
z{~x=^TbN5^MXD94FD6pu;RYT=9hR-SZN^Tnl3dKl*8J^Kwq_b{SlL=eTXhrQ<$H6r
z7hg@66xAT5{AAfZDVPM3%XUPu9Z{^2Wt1RDaFRJR{cnBgnA3mL5^mG#mB9SIxQd!B
z9Qze%F-&Xw(uLqNDtAh-lJ%VgS4m81o=BSHw4E6R#!~1p=3!EjEktVq<-d6$S}Tn!
zFO9KRV$l&|5ih9B>EXcxx9h>#*?rfTNom^E+YOb8m9~$pcN*0?Dm|EJR$9ubx+Y+%
z0za&G4JFEDLo$Dmw5h=)qVs8WSjHuAL)D^@)a7xsm6@;Xm{9m40MWRwEvLl0y2&EL
zYEudc&LN#j-c=#ZDx*Yg2kqFc@H)4GZf%SiX&F!72l!Ke^gVgUvG)<Yrp$XmCx%M}
z%R4bt8I=)p=_1CXZn#7PEG4!gFbIoe*9@+QY!de5vN?ZNWr4x;8!UYft?0~{MLW;1
z9F3&Bp`rTY-eY}KCn@lhIdlCn@K2Wl_3H{ADJn7$!;5J-pB&*Wz036ejV4ftu-RO!
z63tqYAIapxwuY_ike_jv>k^5u>&J_LEU_ZJEER>?msGoA6sPP7)Usf;KL3+MZ^HdB
z)FVUpCtH6h2dDbF7^4!xjdW5gqbje+XL-VBSICj|ZCIcVNEKVrs$7C$<_f@7ohvgq
zlF`lj7WBI|){pC|47pM87Ki+|)Dhb{v`g|ob!X@SgY(#<?<UV-dxv@8W8HGnX#&23
zu{>~129tBhUDfl~U((WF0+KW0e712{5x*Q<buWLqrK}U%tdtA{4(7X4b@ao5kp)yS
zIZ0iWJ?@ZSBOlZs8EXZw@<ZT-{v&EcThNpuHD17oC`p^?!GRoqMnjARmB>XjMC{W-
z*5u2>B8e_smt4<abOX(D+o;!+ocs~%-z8g2vF|28dd^f$1HEt1a7tWBJD_OU^y@Sw
zC`Nw=pc^JNBi@dswujL_RccamS+(qBO*!1qpqtf`KLh`PH6#`9uYUZX$w-MC&^QKV
zU&=~gKZ;4IhgA(v8Mo$nYiq7BR=u>cYWHfX@?fTF_DGgDr1n=WS%yPNwvU>o^+qj~
zCQ@fliJc{~<@T>jDW62Xm#v5z(IxPPaNU0-dqmxbNyHbSEJF$U1G?a4A$j>Jf70QK
zyL?Frvw8DIahVEn3R1_FBk?L0Y#k6JKM%zbXH>oGLGOA`63>oZl)qi=B6Z2`q7v*P
z;JiCds3_*tN+q33kvZcLOV$1{qhbMYA$5-n(8T4YlYReY_;U<+6HOVii(-16V{?C8
zrsN+DuTJOe+`{Xds^pu@w1gYO>{!stp$y-VeoeKZWmV=_fLK#;fwjNZR6x(>J!3!g
zV{{$hO`vzF2$P1YESI#}O^ZAORb7U4o<}QEOO>~pL++mFY>rk}?XL;n7!F;|Bk$ul
z@aOdg$y`^;-e?JWp5+g(OZ>c5UY~z00R-BZpjb{EKV2hBBBiEp%CwqI)U|BKXzUR^
znS2C24<81^$v9V8C$WJ(P+v<X9Vfe_5xS*{6uqnSR`;rm4Zts*BVIcXihiqiQOZ#4
zedVM=R78B_K1~wy*_zhrX%Bijmyr)@euzrR10zo=A+ONM^Yw`OMU_vo)UJQKQ|3OP
zlBU707or5pyXBr=lY9Ohq_c96<sDm+rMYw=Wp(U_Zqkk+5#Vais54XKwIGvSoDx1K
zz3>rZPkyXAJYdFPNQ1ThpA2H*_7ZR_C9<^sJ5<scISoiuKKhLzOnm7nksp0paKYqZ
zIsy<u6-WmQn2jM}Q3MRnS0aBt!~=G9$P=@4C<=C^<mUSLM+@yjhJDj&w+Ch1kXqH)
zeEAZ-DQH8f)L5r>X#yw}UmotMuqlkp(>!1u3AHZ1i8o9FK7x-~_~=JGR4SMxacT;r
zI@+HD@wXFFqqW3Ox8%_SGMeneXm%*4@Lw{9!ek<&ACsei#$Pbp15ba<;|DTjkqiV$
zQqojFPpqRV$<G{c7RZ7pm<uJ(4EBz{4}OY&UG+OxgHo0{pD<C+n^5J1pQfLw%M7No
z#44c2`9T8zE_~c7jZ?xGZ~W!3$hL<hRnibuyTZ&d$$QnmQ1Wb<e=rBjd&Yph$NBQZ
z796kBIja!kD4DniIO>1YRSEb+it~k-F9g`#vB<R`)D1I>G`fDLbKAe!jVe<XE>(<*
zg_>cr0)0vze-^hUr~>^`gQsYs*Jp$7o#8plG+5G=>_O{K)XuHUj6b^(%9e{bwSJOz
zd)ivrys@$7Y?@Q%azs>knJl4!6_AR1ZdYOVczl87K+@pN>TG`^WPx)Qjd?U<g|W?5
zAfvg(&OTrhZoLz=Lh}CZ=U?8xlOfEwqem>@OBqHcgBd&~s2?2R!aVN{ZadxGbWJX1
zRNnmUR^=@fN>c516Xqp+*NLDbV{1ufn_6ud4&`6`J!g>G;Gr>5#6johB;uor6^=S!
z&=tz|es^$Q$^w61yMSjlnX(G!5k^{RNwa%;*)s{{s7hmwP{~xS<tJFhPTl~UP-Ym(
znx{OBP1j@$5Ktz|r((|cLYkv>mR3n~+;E5fr1MS`bMoEq(}W~~XP4URx$P9tx6>fw
zc$ZJmIOeV|Q<roonmQeyNBq&p*bNNM0GXT`*%pAW3xI!!3TGbqVGf4)cLp#DlbCO-
z59Zkub7dUR_hb#xX7U7?u{fp^EP4)53uVy*`4uR7M*udA=!k_bAsaClW9(23)T!zc
z<?uHui4OUY3FO%Nf;yl#M(!E-YK)P}N!}k`gfR+Op9M7TIcydg*n|O}>!R)H_L6r0
zu2dbnFDie(F9Lt$%qbRT*oq?FsKP);F%K33cq&~doTvHfpbb1Iq+*<~6#5M($y+H3
zj(Lx-5MhqGr$7U`Lf~!oq5U>UY<J~A7KvX2iT|IyZ*guEN&5U(YSptFa-4_J!;<Wt
z=#J2{$9HbI&yU&tVtTFvi?Yl%0v#Z?HTUiRepP=3NPq+a2}Bjjjg9Fx!s^P(Up^`;
zACBLcIoAiZTC*M;SW|xe!zF{e0p9wsxr?j(Q4?_ja&Ne(+S_`o1>gp73kz=Qr3Ra?
zs`|6xOHv7={eAHk911FqDFZ(#vMoDF@2alaDmj+WCr)96dvs@@F=^$z!D^C1*TR63
z@}qx*4i9rs;$eb5q4hG8*jbFU?5^+385BZcR%eDq8zj;r68S}{8EMp=9n`-)EmTdZ
zo-vX6<B!Ile{#^@9OU4ra$sUQLspSY<A<a_y?5Krk)JH52IGk~Y;#}o#?Opn{fx^&
zyUXW<pkJ=_=ctv7=?*E_c5gUT9W4<JLOXvwawmqinCTX(vgUxqJz||6e|Ve(IX_`J
zx8AP=n#nm}1Texd;@pq<eInXniz*d`b=NXXMb(LV;UFs7xNNon8OJ+Q88*=xfP<
z!Aw?liKvA4eiYDX%;xAtfWryE0V}GkzemoWpczgW3f5vSk&~nK9h)1<!8YdfR7rn7
zBfjR6Wnn$haURsMSV}a}fj+`-HgP;vTg6G5-~fI~g&$Raj>ONCVcW(GAOsMKg^*7L
zNm!ZEp?#5h2+<b^lAOcM8^I6Y<%CtvcDw}jjsqD$%!wi<s@1|zbQDT_#kpW3D2OjV
zGoohzi5VxSTnfl{)zGyijd_xztHggk4JQtOe4m;{h!f&|yMEDc@VIb#Z7t1>*h}kX
zuhtnkFyn0X8&;Q+<ISrtmkwH~oO0q!Or|6q3(Kzr(c%iBCxU{V1wR@sB@0i8+bP-V
z<U3U}P7Uy;d0=nRLJj(&&yNd!f&K&opG8u`PLJWGq#42K--`PDj9J;(vq^u>;uYPf
zfW82I5!M&4YzWwUcNo|fJs~+mQl07Wpe{gN993OF7E|G2y1A@l&B<+gl}(kk{-N#c
zEm{J)9(2rJ3ueSQkIv#dvowdb=EZ<V1t9zstZ~;H4#OBq8_Q27%qL`{?Yxrn#e8bY
zbfSTQUYk-=s)5{}SoltUqb`2{mEyOb<u}!7$+2|)O6z?95MT(<Pqe9pgOYH23unUg
zL}pE74cbJ*n3MImL+@P=(y<BduYye|$R=!bCh@l<iQ~ydr`5jVF}xb#=*D+f5tM<E
zp;#e1#eh;js+ISK8UzOz*e|lv=!m$9D~I01tPc{Z(k?ITuaQ%MDA|9#AyE%pUcE??
zR4P$-nRrIe@r$`a2iP$l0e3j!j(@r@A@OYO07W;=cYB!LQYXpAwD*1-OCglTfz=Il
zT=#VhrVOQX{cM$nNn~9&medr}d2HmxnXIexh32$SU=2CQ>+IK<rgdK0=-9i}LSHs6
zF6)iN7CQJkSZJ<<gj#>-uz+y5%<?t9-ONGcaNC7$h#%ikezyl2PqwSocx0NXD#JJ1
zl;6Lnf0bm@B#Knnu?8Dw01nqEu1o3n?c+(Px0<biKyuFdM|tz>SvZDutdBiXx-<$x
z_($3_)$7HN6g)9zULua?9%5$@@Q%n6zZ9N{DpwJp+<qhzlg59T(QoU~jNTzLPU<e3
z%}z}mCQ7JJR>ztT+eYkx*(FR6$a<!rM68OR0=Shu+*0^aMqWf?%b86GCdD7)#A8X~
zVNSb})cEC?o=6{v&9CI4GBJ6m7}#Prb?k6kdUhrcWDaZXMt9W+J7}N1hrU2&@O2i*
zbRV&Ac2)(W0E&MBIUNP?zaOvfh6D7a+y7tPPs4i-002`-jtBtv`fE?N*W2}We?4>-
z*uG_R_++~m?*zu57UMNMqhsU44h@HEB`1OjZGS|Z$%VBe63^|9$Dej&MOmd5B&gv4
z%UdSPYfa>EkhvJHgTq~{Ht>1jqsMXo;re!bk4AU5pGAMT?SA-eh$eJaoqK=)Ep}R3
z?0KPoo4nx3_bM2$Q)Im{n}4e-!2FYCegl|)lFXk@zx{h**}(i0W&WI;UThl!|4)(s
ztX%IK>pB7eI7I-^wi3ker#Z3!fKvnjok9<sKSj=)#zF_5|0G$@Le@!GAF4+`r1TuZ
z)5qlU@Lzx3&tGm5L~;A0_Gr*gEZo7@8Qa}QQEV@PaC6CF3)_-~u~My{p<j{lWYy6>
zH2c?|*#L3r*(8o#WVwgKWgp}CqHg>3%7Z$?=mVNmP2DhO)kf_c)obiOXXj}BtU;f(
zg3rSHAPUJXN=rLP3!|CPcNU%B%{hBN_UY8$I^ln%iRYrSraGxs`rU`hIjRh9KUD}f
zoYM0T=z{V~Xx20w)=&~RhG&byAIg{>{ZF5<h%yMvlNUl+LumdOnqj)4L-{i?LaAQ@
zu}Gtw(bVaS{iH2$c|?e^$R|SYu11Y|?UEAvu32jn{muSb3pRZeh;N;X&J`o!lGvwy
zEi8XpmTeM8&+1wud14zT<tH0aL%fug&q51%=mSxC?8eTYj5nHfTcs`+6-w%boueiB
zTZMWnWRsi$_vB~C<|XOy+rRAeu2>Hc-&XYM<aD+5AQpVx@yMM=?3>eg<T-EhgbIeY
zr=t-$L)N^#PQLqe%iLvd-62uv@SJ#zUTl9m=ml*>#n#Snt;<HMS=)vRIG%f(!`X5j
zz7K}I$4{TaZ7q{CKKg*3p7EuNzH!U=sI<W(NBPj{*LUb8e?|WTHDWv_rXDXZ23$51
zbx(uwo`7I1T|0lDsH60o&qX5Kiepo=*Y0yUQfr?YbC;MPE4iicV}#=>C^A28b+~`2
za`}nsl0WM2>$N{!Ju~i-kNi$7`El*Vk{>)bmLM9G3@5Tzi90|=9wdBc0}+U1z>_AL
zY*~_FD&$}L;PjDkF)2CD`062@kgDM+))k4SHUvL-RyED*#q2)%p(-|2%QdOxK4D8>
zPpA~I?^AUwS?XWT(~kF|ZrDtt`@erq*5)rV)$;DoY*?$KM!bK}o#OnR`d~!DEL))h
z=KpB5CMuMMy&`dH;$^iaHCmMM>;qRST@qK1w(l4Hc<a{C4{TMT0`Jk{J(8YOoemuO
zfLh*a{;k?J`&wtq=p(9O=;`14(b=k|`=hrf>-V47%GO&NdLCjaVSr3mu=;<III0@^
zMXIHOACe!{S>Q*5oxXL0Zt`+9K*{$;Xta{UyQQS+6K$bj=`U;=zKtPYVaz2=D=wv(
zY!Z)|QBb2KklkWaxFbG}6;+`pww6KBP?QkXQkV$LD5`HxfK#3{GMZgAa^d}~&}Jn>
zVR=9M)x|3|iJ;5W3b;DiCc=N}eMOyWFk7|R>lF$G_Jibq=aM{iwW#%C{8)dH`!Hxw
zWctssuXEp`_1ZoHXyNEe7dd^=e4hpzrENZE9fj84?Y`yyM8{4@PDju6Z))n3G?&=|
zH@ZXr0%51Jhn>7(9Bi7{p3H9yI-^lJm><~FOqlO(4rj}yeD+xH_<n!Rv2QM0Hm+4=
zOQH>)sxz55w8Vqdv?_j^%S4$Gr!3a+(=Nb+H5NGEg9vjHMIi4S{Q#WdlrzlQo}K;i
zNBz$~&rzj%mgL&6J*f3+;b2*`vJJk@l&$-See)?;T7CgQPJT?!TCSpHf3H3p=1kVe
zp9|{bSxZaulya5+;0z;@s?yIIXXJkcqCW?x{hd3()Obe3zyxMwCFq?|Yql@DSBaCD
zM>qj0lhH>RD9|SReX5G~ov~h`bFW|)=)j-{COe-+-~*ywF#zB>>Sf~pyHM%4-IEeX
zCj#h%lRHRE7-bh+Xj>@23E;%}IC9oy41!pU1t0_v+OwZX76*T`j&;Q<aZ%OM_6Cl?
zEnW|>C1aD51(G=Xfxn~7QEUR7wu@mevH$iR)`?$(l`rxX_e?B*XTP=o1edafSuzd%
z^Xm-;L;q1)iqcT8HM;fQcCK?mSOUfTWV}flo)YkLp_cb$8(hi2Sv%ob8)TOgm+H9p
z^SPhc!8^+hDgS?giv+e5F?b9Y2?uL-xJUr!rZg7`*?BUQHn?2?Sr!=SaJvB9Dw<nx
zyTIE42hOkQ_pLyikox?(o4s&{AhzlEvpd-xf~Y2OJ#Jbg$^zOJE(^-7Z<#+(k2*X1
z5S%mwy`@?`Dk>c%6m+NRmyQ0_dib%x-UvvC;L_1ZCmny!vMU`R2_Z>nbz1FqGqEHD
zUk6Em(|>;Og;)*5YPe&QV|_{<tO55(T=$5a-ktM<*W`}QBW%4>a3F0LH5zB)i8Hb7
zWG1$4I}=VavDL9{+qP}nb|$v<=l#xKb<V}P>8|RF?yBzntiASn*4~|+iTD!4o%VU+
zP+;NDxBe=gVh|QAn&$~qJgi%Gt~`6ujQGbJcS@t4`1ahWfRm`0({&Va?7IGT4Niaw
zLpYagC01LLRAVk2AW*lJ;}n@oh~bOLy~Qs$EnTQY=mS?;4|@Clsz4F#v4M+OlYzCF
z;=dlkdvF|rHH5~7(T$AGMNW0ybe_ppTZFXxKyr%@d+BH7Vie+_;D5R!`lhKscUuS?
zxNTfRzzh-7BO)hFsQQ4>j)vz6+2CfD;G5#Moy(T39E1b|!vd*iMl5FYr=FRKZK-Nq
z#@(-#F|~#d$I^Bj48!IDdmQW6B*!B5>rG0x&(|NI_kqPyktFZX#G?D3?^~_T`$0Q+
zFP{H+!sfpD;<j|IZ|d>A@uFRHJMws8d1*3{#A|!a-<xuQFCz40w-{(pbF5}laK~U`
zh{7iR#2JwT1}(1SB{o1_5{mX|3xeP`$PCg8Htday83qKbO}quX7=!Ud`>k{pZwW5c
zpNt$W$CN$<C+jJHluW5;=ndlUG>T3?w>?VRIDH?^3cHthoj4pQ9-2D@p1l9C8TMpt
zkfyLaqEIQw-m6LkH}>@`rPw|E1@Etn9KG<bp@~!lw0)+dzEAs3%Y_K?wSV=(W-<@D
zN?xev2ZhT=ikR4DeuwwoJ3u(brN2IixV7m&@ub<R!%c_wn+-LxF1CiOFaGWm=Rp-C
z)XHZ9(>3b=+|7*iFq1?<|8NAx<1{PV_!6OCp-XgSRrk{!hYiT_D{}phoG_t9W+Y11
zR|jH%Er|WIR(4-$s~(R^Y|fv1byYv7vN~yv-PBA$wlOf*S5<Jyanlr?Z1*E&+?{Rx
zNov2J9S|i#B1i90uYjjk-=0p)TAfan7NU22^mSZ0Ht|j*m!fKr$g!5oonzjVXD<9p
zj*C8#cCWM3mBc2SR%Y}n4t=+aJS=3=yB7li#6j~Bz0vBZL8!cyouX%z@uU)8FeB?i
zUJL_e98qdRPGzZ1f020eUwO%mye=TP-+)~(1m6poQRf-NG(3mFcfzW}R-=t8j#roa
z<$#nxmC(m2f4V4CTrS6VqPm1oYz(HuQYKtVH00t4C(<NVO!JxCXdS={<9KxU31(LU
z4*Zm8*$If6=Hyv0Y6fLkzX<LdUhPajTTC@VN#cL+A7b}U@o4QdC6}1uo}(hE!t@jB
zF$Lq=G|Ir+VOx`9><h(>?*=8dL`g<nlxf;8w++X|4Uo6NqJ)Sir^2uA`f9Z)#s&PI
zTWrO%P0TV}#|9R0(;MzyG0Z2QelvsvT3nFIXPC8w7cHJaj*w~U&%|=JQ~fv24_ZGE
z3{m?t3)x4yv3?0~=g0qEK51CI3LU6<_lnQ{y{v8MVv6F+WQptQ1!l<=ZZLL=hI-uE
zjn%lPVS?4?)ZYhLU&~urgY?)G$&zp`>uG~txqCQ;+vC#mmgKI;GuSfXJv`U}1YMi7
zvmmbOX4Rs`;xq5E6ESYW>+?USiZGnXTTTz1Y*U0UbS~qpo8u-dv^Oo^o1`E!Fl>(B
zu(esXsf|v7jdA6L=iQ$(MO&U$NY)=nSIH8E#^JO{u|-=JZKBibg6s{4YB7eBp!!IC
zPonz$CHGp1xD9_hP&L9x8oAL15OJp>_Bj0YYm;2C#1bLP3~)6{$bJmQB*cA%H8Pgi
zU}7xZn?A0FiMP`p8)GE=dJaTt`P<&GlL@T?wgJ|Pxzzrm%#Q!{%2IS6BlEWE;kvJZ
z5o5UJ9C<fm?fNoY-|%eMyX>#q(_2U!8s@4*#MOXEuY*Xx40)|X^ujQJeEVu|`N1l5
z#d#7^i4KCFFmb~D4#aTf`&i)c3jXqukw_VMn|`NItGd%n|H0wP%z+U6NBz%{|2_1(
zA44kkwknvF06f0oRoX95!>g7WOv9_=0WXTQfUq8^anyKtr5^JBJt_RLFoX^z@%}VQ
zubvLjgIt&q8hE6fM*tN??OVq!KCAaMm;WY_K2)Y63=f$klz)SOWK@2g5(|Fss)!Q!
zx@0%qHwz(k_c?NYbuP9CL3OT<<x8VFN`rGs9bxn0CF~8iN;)be38tAVv{P7268c9n
z@JggnPs&Ngj8FC(%4Xa{#~_fBw<4-8o2+OMudl-xGsy%ruujqKDfp~n4ONNC*H3yM
zM@g{_1-gGDuK9%pJ5V`hf4sF|njzV~+4xnPqi#bHu|4!62nL=76p{`tba@df@olIk
z7|)zeF-MpDP;w-;Xz^zfQbbVmHthB=t;A0NJ(eJgc3Fj@bLSWuWbxdel!Nh+V#1Ka
zPBfCT<4ZCEWLUiP2Qn6%A|1FBhIcWNy{?Ph?fJrejN(~mWjZbA83NC$DS9Wx(&=Y|
zwTtW(s_vUYw6Ee~*Q8}tg<A@E)yC$+cZ*ugzprHEAZbI-Cy#!gkfdlimm}M}AbB9u
z>Q4)zT=v08Ah|$hV!*ZuYHg^L;LFuEwV*f_UWJ$hK!R}D4{<j->SBCPB;q?F($A0F
z@|hJv_UP?|G9<)a5TGiovLd!6(W<_6X7Y1ja&N<tL)sf_IZ4At#*Iby5jIop;%YL|
zBn$mntn)=3hPmtyw;tk)BCxiScjop!9uz^@i{Qq9RVDx~H@RV*83SEsDGodep<(_@
zHB-R&p+t~A2<}nbp2m0_ulDYS81h??^upUy7U3%qnfpNd$PU|l+ob{ejVANX+2X`b
z^afYez~>ji{xvnT&U#o@c6L@rP4AWwru!t@wpH4|;I_ty?y=DmfBTJ5g}pFVMT<-M
zP82h#kBC8;bXbav8M#nAeLxCh5VmOSu?k>Oh<Q>?K>iyzTNaM8P6o|Z^tCr>u}kV>
zQER+qpwmOH+BvMW&QkN1@opHu5xVr#Bj&R2^<jGSTB;qfW&6ANDXQ7%-%v#}Ry?92
z1(5t%6}ZvGsOcbsSFcRrU@|>h$+lnr`nvyH#o0(gU#qx*=FZ@|$UW>4PVb6e7I2WY
zy5ffdan8)|i9eEj2x@JX1o|J}nx+R|HMU%ZFiVQTaVM%E{9m|tn?wGW9Zt8i8BCUy
zDRR6WN>N^fS~)?UM&Wri(z=FQit0h~WxpxPSxRFR|LoSc!t$@D*2TP(1V+?}W#A_$
zJw)v)sf-v+{RtY9CA5Q9fa4c0x)**^-$~k_N$$5mlg|`Jg?gpY)BmViFvX~=O-_#}
znm!4(KFO0F_j2%C@My27<ru+c28&0mYW{+G!`j4OD3T`_7Oelm&G;9VTEk(rGg0)v
z!ghGff+VHddC32z(S%k)+_c7DC>W;C5&IgLZyNUyi5BYCfDQuJ8tqc{MoE(v=$Iq5
zScY5G41ryOKJr{?l5LIi%%328)2F=NkgW<FI|{;(yag_N`u|J)c>X-Ohgm-iz$onp
zV~e4Y1?L3a34v&A3T4fH`>Fu~qt56g^SJ+}v!gdnRMsSrXztZZZB|*(3R_2ZJ<UaI
z+EDyM297#a<g}|YEE~K6TmLofbhY{!e7@K}Lfu<i2RCo<t?NYbq02ZFqRVp0D!d(^
zyarutfbW2vykojKM}AW)MHr<E656{sB6@Lnf3=b3GsS8sHJ!AOxmm?>?a%=(tym8q
z#Z3oYmYa(kT!^__4YMkn>=g*^nl@AvUE00~4NL~7r7VLe|+J?HfHpOup5`w6XF
z77n!fI74#%6%3}%i&(1GncJf{4?DqSpE){g(~~jMZ_tkGxJS$E63L>G!xFLT$&zlP
zWt7i5s}Dlnaf)=Q+#}H+6AQaU(=h}JE9v*2l_!86Ug!*vR}ylh=}14fILJAn_sn+*
zP`6#E2o&-c$|@ELUi)|$#5?^x5>FztKO|4;nZ!6bGyxu+SB#h-n_tH=yKEkz54oBK
z{GKPHiY>Jbn_p3f<-FUvDoz91y8JN5`!@8<)7$N~-XRVCx1z<mUj5d>NNj!zymB{J
zqeq)hcf?lo=4GiBz}B%l^&y$q?gO>s!$P#<yWSeODP_7dCS?5%Pd4vcE_ZN>w{SX=
zgo~b*rG~#Z;z_ZDz!LYwy@c^Wf|y9VD{@;Pe~atGj}*#yGm(DfoWW?LVcm~i2XoE*
z+taTZ1*vb!ce_e7lfuuw9C~Cz3=3~qxLcZO28+)9z1H(%HOfMA%WTPh!T?0`!zdyp
zLeHJrnK?D=dC00s5SuTFY(|ow#B(ubwNSjQ*~>^Au`fo&bZ*19Ujku^z26(f0_oN1
zB`K2VG@b9+4$K-PQd2J6_oJwgxi=;i<cX7eVv(qj_vId~BOq?-I{gcbuiNOQd)5P$
zhLGhis)n+x0*gPj9xK<rx^FfUevirJ+(naoM;_pKTS{u%d4In@XaBQwoGG-i(E}&D
zy`UGN*)g`ibFqCoZg2Oc9MabvDW9~q{l|<w?6~7v+gOiWD0eu))N=gGXm4Q1wA*%|
z$+TN&S#B6X$h75qRlFA3+C*uLUE{J-+#QbPS-^AMNCz@fujN^k0M?(~6%gybsXvNS
zR_bBoS>kZqQTzF!`b>_Pdn;CYH@8p2J1$5vSK6Xb(ML?IJUih#93_v6H_V$>ac3nw
z9Kpydt{ke*v~TT=7><@*3Zs-a29>0<s0Mc>`eH35E?6WMS@)n-*AtI>PT=w6$ZnA6
z8Q%?$_J+g%+|l&z0~^$`vD!Lqe;Q8m`mu?hIOo29;mCyXFOc?(Ett_Wu5y~?{!vWV
zP<QgguDY#N73-m#d0Htg&7?MO0dHCcsG;QbVYfDt(N&3I^~r)T!i<^O5oB1|YzJgC
zvBt1KYI)hK%&0=Bq>xz{#{lkQhhne*>S^L-2$k#rBH9r=08YJ<F5RDcx=%Gt0sY_N
zt+fNX*`IDfbThB-lsf2?T&98vyVomVDxuFaUxyE!B6mcUP-uo^zu{l=<p<^~EM<!0
zS6868Q&D>w%2d4^aTUHKmE^~NGKl5~7Y@bK_u-6T%FvoPA!bTCbC2PR75%9Plm@&~
zz8Ht=6bA}G;?TLLP=+J`;mXK&`~ztr=>M{vVqUcB7e?nakcFVH@FsUM{t9m}{Db6W
zk#$Q))&D29LvUQjFw)JUPP^l4FC(LGnksykXmF=7Su9IY0Z>JfGR1X)A`R<moL|wp
zpw%+8MrgI3>-*o9CPR9YNZC&|*D1yT6lqgSUw)@m@p5OsrL+U^HF2B%e|W>;d*nfO
z<fmimc5Z%7MI*)(a0w4iE~<_TgT{v6SWX1oF^G#7{wjj^@2vh#qQfE(Ow~fG5l>!m
zVbxUBQ+RRZzto>dDL0pL`@wZVo=yC%N}y`)FDpAKov)1T<A_JyXi>yiUqRFYpdK+u
z$M&EGmdiM(zI+>iNBA$v1B`>q<8+KXO%8-^6}HxLhdF~iyou|+N2M8$1VBb<nx%}4
zwQ8ID<K(L8U=+)zV+BkXFTHZpv2Ap7%lZ@bbdX~b^;qgGsSId#ap7;p@>vZb>GZZ_
zRo$Bkr-*+%b-3TMx68#-qOyJi%pJSv_%trE@bRQO;s_3*R${_5k9x_*+*Qo%YrySz
zX^11kjWj+%%{U!djTN*|TGN(Ez}j66Y$+QF%{+v^Uq@enCTY5Iu`{YgXhq@=j(9lA
ztTyy$|7?su+lEG$8i0JiDN&aUc~|I|X+I0|duJ}w9lq4;!#XU5u`Xl=&{T>Ob_CG{
zjN`=DeMiYbY0~VPVB}Zgaolrise~Q``Fw~~=&q+C%-h`#YCd|C=hm!F0_94-Hm%b0
zU~}?zJ~XOSCQ%T*CD>pQ{56$x=w(`RD`Y#R+$1P+dfumDaAcx;3=yM73S(X>N{Z9h
zek!PN^A&ry&OR9#%GW#tee8v9QEK^CRkRVg#1JgH+E~SY8w5?fOnbov2c>>G9OUDB
zf(?7k>+;&YFrP>a^gC69J!$H3m5T!0J_u3u0y?anczM@*69_MM?!ddv`)hRcC*vDy
zyB~_rcnTO9m^V4U5^id?u=iK(h(Jt<Y}44Ve;op0iD;5{F{}hQ5{THM(NEZE9FkMq
zF8nlKN~{(p^sm=({dN3>VqpKF7(W~tScnvaWaNMEu33(!gBkR@8osoO+n`Vi|I9o{
z6N(MoC<Fv8>hK0Re+s|VSpc&S{0fbxsBI+N#@0;ZRsS^lq4m(Iq!*9HuxDU58ydV%
zBV}2mH|^hHV0P1rh)_z45=$u2iD?qU$ow)&D=XQyf7VE2HT|!#A?6=ULXP|~DJIM~
z8iLWjkl<==qYu-3h=9NzDwB`fp|sibyd2RSbtnD^uxyxVv>@_gg>63-Fh6k;-66b1
zbW6j7Fzx{!)UmA<2EqGY-pq6)FfFzKmVR<07G(ysZ@n{p>?u_kl5r8glR*E}kr@$y
zf?+$=i5e?_0yawO{}-Oq1e>YW>tSq^l5yO33K@kSdg=OX@2d!g$r~{Xb?;7ga=#0+
zD+PadSaw!ds}A{pbwbGAi5<a$V~5Hgzlw7z{uFQiX@rtiAXOCVSrS0-p#U8vFSfLN
zhKbGVJ_0o+DX#^!-l>OVpPNtK{I?6(vF}43O629?5Yv^?ww3-1vOJkxS9SzQZt~zp
zi#2c%wTh@HxuP+t_%1R-Nceivg=9Qq4{P7S^7`#(DtmMClvjVMm~!>}ID)Ay4rDaX
zEhF?I&eu7J#4;QXg>qjd<6?WYpL3bLg7>uH+Pcwq!-;q>j`5bsh#Ud6VW|N`=kZWg
zOg|Au`U8}em3pm9jkPSSnL~-8`oHWcJET@NrhX0@%pv-<CU&`YWM`uU&d2U>cKQC<
z&cnU-yP)z~QI_B%Re`01uaI+#fOH)86y&IUV7^rok~n#&rhH=Mo1)}I^O#Rgn`P}c
zXtXB0m1!nRDb$rnvx5t00pLGWvHyu&^82FJcu%u|xxKBeLul#uKCZ~(QIx&%b1B>(
z=0+Av8&9?~zV*#_%$Hfur-*6p<_l+nKyb<TK5HR%ez<O-`Ht7SCs%eae!sOH9_%gN
z?47R4OM;6nU;)PWN2zmquD|g<M=Dk-`4k<75aFGuTfw@!gZ?k2OCXK?@P-5@Z!ccb
zEr8-w?8wZRouhdXdD5LT#R5-r4z+*!WQ2oj@+Mmt7Lob9!hZ}r&hyJO+>VWLo@lLy
z*IOkN0|Ghyk@x)zmn1IvJjxMPf$9PyXg;$~1#Riu?VA&&ey_k%OlI?^FnR%UgrIU?
ze7a|9;(sr;(!YeofW{oLF#h$gYtwngUxjy6;`(x%b$XTMUKUHl!wpxmr71nFo|K$j
zRu01w8<r`nyP2~re%D)w?1=s1#s%vdZY5XmJ#~1ZAM=cv`e^z{YGeL&Nr(N6Bx?uP
zYrcgS*>r7$>%zn?wPu(RaX>=Vi`u);Kj2QoIH_)eF0K(kJt3v4U?KicPYK{-Q}PHc
z;-O>Ad!{U}39Cce@G4t7z3vAABQ``M-B;NoRricWeHZndAE)X~`HRnUovVz;q~apV
za-7AOyP>bH*pW*J*JY@*I1R6r$UT7Zy#C=+BkNVgPkX4K(Cu>`G&eJYHrpAr14q0P
zAwac^_njCpWJMU|eyDQ#GojgZ_;>FjVuKB5a6`Ih#2yg^L!%o)jpqHaiyI}w@cl+&
zaFqf4cWttP;4FhJdHzOMGj7CaHBy%HD-IJ@;-7zuY->-A)i$&T!cf=|W6biE+eHKM
zqfA6=)8*DvfzK0fh1*M6dZ&s<m@iA+aA!3RnAXC;7zts53e$)7FS;RTii-r}w5?1d
zsSFPi{C0Z+*~c^5m-BmfKIPYgwG-@(_XcP2%;l3ZOH`yok%s8Pll~kc%_PE@1!y;P
z&SFU*3;%V5jgvXFxKX4wU@(e}ZTyE_t;!;UdZQ%+?StnD%X=%CTZ|r)ZD_FAzV2K!
z5W)zoICmlOl-dPTUukVTAsW=);+ssbE1TA~I7|yXc(Gw=I@%SR1$IwkIf&*}=zrB*
z-P^p92vEpamsSu-;Z0ZlggAe(;coQyTnFq68P!eTIc!{v$3XmJ!HB5AnJ1C3!%zIk
zY5c!~ov>&m6(t|Df!)flYdgqRoWENkci;l`ryGt4{!*7Jzvs1)e&2_fT{)8H{znf7
zLe2E~>W~#oN!YdM4@#8y#jwr~;cM!#om#}-gq3Qm|HhqfD&VEkxVri`e|Potp<5-{
zQ&9;nd#N|#Wh!{Cug>)2*hN3Jt-xgML-l5yea_p<Ye=5E*ZPc?$=L2&wKb){5&~#l
zd6yDZ=&pt&Wis++_L9@Ri<WsQj>48Qs1~1<vQj;zq-L{Za?OM&3~kvTuW?IW;C`uK
zhuc^Mat}@)mfW0BXy{o@4-;|Z-Vjm0t7T3AB7_2llF@V1sRfP;dBwlQ3S>JrJGWyR
z)4)<<!`lAAMOxkem=Rt)4qz(VlmcRTAcx4DP5bSL%;~9QI<+|>%J#=5NJT$XvlxFf
zWd#smDZm#}plGBG-x2${;w-RG`@@#y9q``~qhfMYXF`T*2NpFr=CwyG+7q{cOIX3N
zaUG+}7-+6|GN4E~fiVieQUSE`S>|mar47jybZXUEmp@*H=06f5<*9J>UV+rZpsm2i
zJ{7qx_rc=PKI^5&GE-T^@-k-CqZ~d}ty((c#J8p`yeMme=}(V#fWL#NhF9>f0vK7`
zwr;0`s1hUa^B!g;X@(#PzN@yVT*RW^!c?Np`*sU~Udbyg28(^?z)%!rzfX`;kk&#(
zN-SGLQUN;x1%e9Z&4xxs5&#P}FX^vuCw_6MqtW*=6x6hKs-(ZgP*ji#S)bUkY>A)B
z(ax2B%`sfoYb{AxujR`{Ni%s}>|<i-?v*e!fMEy0{f;Ybgd+zE=MCu_K(Qy|ruvg}
z1aBL}CfnvIhx!3-8}w>>*M|p^8w6jQds@+CMDY_$Ivs<Yb*1*Q8mQDqrP14`x=2y~
znDnASq-!;h>rPF_P~5#Dw7A9maRuUHbIsUyBPxs8z2ksHz)<>SteSQ1#rB5mCWe4x
zPjkb`cu#PsY-a!0`+!$U8Aw;NDewP$8C~kWkr1y!=c@&t&%lZ>4XWt}HmHi;d<(+<
zv_r^K(wfhA9u=xu1T0up5r9!QT1LtjKQ;YXOHNJL@NUMM$Ii0}I}j-HS}~NMH{fS|
z-DhhB10{CP>fOMdOvHf+eqwE6e+UyK@@o&c9^8?{UGy9u`{XiSz%N&F`vu@{z!YCQ
z%hw1|Z%ghCZ|{tSaDU^54r~y(&li&mQT{S|QP*z}m}T=g1A2@qbvWqOC@XFV(;#O0
zDQ)$<yvP`WMKd~L^V<~gaJ*dvk;NiG9Z9isV_LNfBhD07kTcfuSTJaTrE>KFz6D*?
z=HBR_@{ID!gWA2;jZ{)BE2P>W`XG#0jG6Fjzf6v6Krci~)+0drJf(`@E}Kp<-=U)5
zisqv8Taam;0SvRfo)Yk%c!I(PzAn?XDTK5BlP(fy6WqRW5VEsFu;6UMW}rx3+?1up
z;P@a&`1pioNZwZ<*P$|68N>3LNMBz$yUwo%0O2mb%3jr{27$An70)IDLHANNa|v}6
zsnrc9@D9E|%#<8S8}q8#M;7eQW_ButPr>Ktt^i>L7+Ixd&_n-$!lJ=`@htLvcMz;a
z{piBE78Cv_Y{suq6f$C0AmkvZ5UAPsvPiH5G<-(6(1(SkYdx&-`{{h6@t6u6S*NTq
ze(YKL-wm2J&9wt>dGdxzA@xkpoCpd`n!cB#TO^<SxhdqDSc*Ne|EsZ(&ZoL3JUR2v
zHk>ybplX~#Uep`W1LvpG$C)Kw)6|UpupDL4rn7O|HJEjcRDOp{EA2=HKV}M)-O)9}
z4z|`9XnJaSgdVIF+S>z)AHsrGqxmtuYP!c*@OKqLZI*gwMiyN{dl;5II8)H^@F{&0
zZamCS7khhO@I5J0CP@1`MFM$!{WmwZ#<FW59eS{DrdT~>Wht<``$<Rx4tx)e2d|Iy
z1pO$r;=!0<UBBT!u~cmh;^z}5s`4Z9t4R-pW6&NZRoBHwus{GRVk#Ca(<(!4#9^Vq
z9*jnLKt^MIe>Ezqb(cQtLO6xtc+E#?YM?AK1PB-i2MDpaK&{D-e{elf0<zx0SpR@5
znKw-#J)>Q)Kk7=KvF6_bbB|>e!$)wk#klVv%tpTPoY<pxl_dUEp_$Dnrx_eS4Vq9!
z;9!-=N<R5<Qe~QU?O0<>abs4%OY&(&I6!zru~8jUr*<UXfP8+Y&*7%U7Co{lI+&i`
zlAPZ$eAh1$skJ{+XD~V3L|Y>RDZdCL{flIgnY0JlGcuZiF=ZFGvpHHve#&vtR0r+A
z3qTi23Z}0ut2HiB@)UBl<{ueTxw5#Oy8-3D6gD{KyR#!RTkV0(XgATw5HSBvo=+Po
zb)dl0rJ_Q_qe=x4_|Md-?w^tW-1bX<^2ASRU7Pu`$O=@rL+>-;KeHSB#RzEtonHP1
z5$oMFwEs3mE_jXyuAccwwHI0t1gBjd|9K{oTD6_w1s#NVUibET%mIdRl{0pRC=EpJ
zv=BkCZx-Ws9c^7!&Phi*>hCaXroAg*U+8d*-YHZM73}6aG;<BTkyYCIr;HXXh5y|#
zEotIBmHsLOgb?9uJ(KXj(pVX&(|Ev}(fR-CFNPkQ2K5YL5uz+rh+EL|#(=|s#B4Qh
zgC4tMx>G468@t7LNwvm8U6$l<WW}Gng^~rW9aQOmIeb2pS0f?+Vz&>!Td-Lox$JiY
zZ4yFFLpx|(&ZD?YH;jq?WrR1#VQX#1tt5DntMgeJ3l0GGbsMnY9?*o_?d&<|;U#LY
zJxPvfVQvDTUCBc$9aqeL+E*NI4mC@l{?2iSRBPBM=Xn!8;@asBi5x=JQO^jey=k`8
zBhpZq&2#Knyr^F+KtZ&iUyTrGYf}k;&~;W0z76)Y$3`diZM9+Z6~gZl3Vavrw7T)7
z*cusx1sMY%lA^Ra9F|nA1xVN#(`n<(@rqV_YLhKa{C~Ao%rgHeD;;jsj_OP->Su+X
zFkoO%s>WpMN!@S}8YH0UeXbf9#zvaxlBBj!nD`O-8}dQ(rqsGWQ4~(kFESJa9*f(n
zrR9I6!hBbU>l?S|mx{c@(~3t_c&VCjW#;kf4YabcHGSeDZq{k)50-gby^%<o29EA4
zkV#M*Nw!!;r1tG>3-70rKp1OsdPS}eqUt*1yJ>QebnWa!yx|Dnwfgnk_uZdAm3>TI
zY&^NWnZJj9T=^|!?PfkWW*Z+TJYID5cK+H-bbhU<Of&0_pp#Qoz0~rQcX^3;DNc!V
z2Z&`0c%BY-U*IHW-@QAC2|A{?<Q+pkzO-a9P)smcumcmGbO_i&lNP6YKEBPmLlvFR
z6n#h1V(&|@Xi~d=`>TzphPmxFze}%O3|{k@--)jH+tmlB)h(0Q*Iu19aNLI#sANO9
z0eq7)H&gZx&W9K?(_6FlRH~a0GvTRkz~{;<#!-EY!xm5wWYn}>In>wp6hqf0=^fkx
z?T55&bVRyI^}}BVlC+9+_nN2e^Yz@Sfgeob8<9ZMQ(<8&7R1HH*3#CiLF)cQ*2(lN
z!rN$gJmNNH{j>B>@;=-ML-=bi^l^<dc_@{Z^s0L^y|prmAxT4A1=PkjN&!y~;HLvE
ztqCZ?AQCa!=z;y}Bto;eq&CEOr{DRYUf697BnMQ!pW3R$0^W#kOiru_BdL|)@<Lnk
zG_n29NO^EnH$4gj@_H<CR?2<}c`o5rC&AfAc@SN1XY0dqo#iBo75OPkRmmT|$t!_)
z<tyNqft!s5*Q1A5>ymm#4ol}FfSC=Aqx=fr0`hKZib7^L<=T>jp8}Na1PSH~Yh}pU
z{7(-|%Lr?GsI}39;;gKs6XVDSbQ>h%vmUtR0uNga=`y7rUg|Fk@T{yzi2n_&Lv00b
zlln~3hM3A{jN>?C86LI02TXwfBp~+-a|F@OMF>0P$h*KqOwd(oAaw2<04M)$8t%=5
zH2^ju#u)m{9GVeaS%vHoYGrIm(F9ez;GFb4bLmapX=F_=#tMdU+bN4pYf_yYrA-q2
z{f+wPXv5&i_`1GJN7UN6$5|4{W=CHeyq9hHZVdk0#d5mMv7v%tNXZs4W13<go4v{0
z?jVfQ95JULN3Vg<n-Z%kfC<8XMo4cXf-J2F%!@QC$vqwXFz`dlO)1k)^SzE8Fryzb
z<oyk+5+BU*nD#A5@JXE=pov0%npBO~ibtS*N+@nJYQp-JjJNv-ayxuS>+Aw!{SZq;
z!Is!yvcewHTL{WtJTe=74I2Cc-o}*Fna&d_Ag>M9v5-o7P6GW9z$-dtEcA}jV-x*Q
za*T|HW%d|(4*<jYz2{WCLf<H45o=3P#2N1?Nx8=5H_`xC3yswmcXpEV>@?T_f#nM6
zjKGP10j*CN#BpU6>9UW0_a^1<`!&Y{sKpI6&OXvB^%!`RXKw}LcDZu#W{X_g_GTQq
zw_8pzjigmqE%DX>qR%ZNZIMu{(&NsoMtI+d1Tyj;3ifs;bqwzhY@B7|izR6DJMfK7
zqL6MklQ1=#vzP2$QEQm4#PYb*Z&|Mpm8xfAKSJXcu94&<xI{2Ha`RnqDD?+I)s;?y
zlT{YOP7sn%@<wHA$P$-5o_xnceyRnxokCEFD{TeKnexs7(`!bY1sJKfI*mueZVI$F
zG{F>R5M~6}e-ZQ9%*IPXAQ{6!b-mS;UH)!0^ET-o$&!XkBa_D7MiFt?Sf?Kt5taO{
zz;%N%S!KpK74=di|D%44dP=rOo*aex7iCsXjkS(nKuHHMmIdss<cqor-sDR{U&>EO
z@-0f)4q)bil<=5#iqf-@)wWKPn0~TrAT6GN;K$ls`(tSuhAXNW*;sw=O~a<2_-~;q
z+Y7r!!#iv_N2FIP8r_O``pUDk{v{JD#uS*4UYT-}f0kUEr(4B3;>NbvL0r7$@H+T+
zk<AzQUfWnQg(4fTP5e|tZD0_}G1w~2N}H4j&ALy(nxr2W2;cARwZ{y?&RD?=Q}f7Q
zMCtpmq^2uB$G8bHFSXchjsLo7Ou&rhXq80$sa+S~dG4fJIDjgBmu1fNTtS+6Dj#t?
z&SA*YE&J5lUs}NDC3z!zzsMM0+}6pO@0%L+Y<YwPo|mkue6EU)tA4DHdW|d<KTns$
zl~1DqCQG0r_Jf!0{TErR?d{lM^^mX7sX#lSYM1tQ-!wcsjAGsoL@-M2Zm#(vPSCKA
zM#CD_a*T{URIo?kMS?jdg_y8}y1;L3Z3f230&U0$6=`x#48r+QHKEy9Q@1Ih32SN_
zy?{*o@g3felT)-j4qx|7<6n~=9ZvLgPwq+@E8tJ=cz?hFh9`HVF0!;0pQ%T25&VEp
zt>S+0t;-oj=qIlzthaNIE}A&Gmb=f&a%7Kg{+AvPq^}dp+BE!=_qjbd0i%xUa5BXe
zV%P~@Bl@?i?*w#lalGzKz?$gskZV3jF)0uA4zD7}b`kW4Q;aVe&JLI6cAabu36u@w
z?7>$IV0kMM{Y>=<2JMCeCAzTvnjJ5`pSe>#rHH!EeFv^H&pa^+x_P&Ku;~N(-#su8
z!!zGBPJUKr-^$h-RzmNRvFA*JywqC6E|lIH{xw1W32I%yaFYr!ko?mMmimp9SLLn9
z@mopbjs;{QUyQ|RcGOoeex}&_qeI+K!}<Z{)|y!kX{z63<TJz=st~G|h*oMK{D3pI
z`o%dC6&rNRXcQYcT$X3q3j2n?Fopyr>jo)mrvgPLE}T|dxcJ2ne^Dj`mKxz|$c?83
z*g9vO&TfO(UYP>!6i^A0E;U@e@KhwOhb)*&w<I&B?DpD3z0N(Wv@FJ)XR}ovE2AJr
z%t#R!(D;^3TdUp6Em)0{&#Q<KNaxQa9@uJ!2{%#P*ESJc$2`A3LAZ6TwH3OtYH6K6
zb{jwanUmHdrdT-H<{NQp!_(?}gaA8k+}P^iTp4~Jcwz$RMdxA1`8Zlj7;~MzG8M@m
z)E^3K?VNmNtV;7^{LXUcu)<e@MF<SZC(r@TA~ee|BZ>#`(P#&`ZUjYFwf}?j(><lI
zeN+iNd!G~*y{lL^2Bb_2Wer{iRY^5mg@UeM=G0YHbB}L))vN8T1d+1ZOqnI%U}>Wh
zL5R9EfTKbt;b9&cd`N;%awVh^%YN-_ae;~>hD8fSx#}r4f*TU^kda;Yb3YR%t^nn*
zX+mpzy^7A;)+^${=NZ`x+38yr+#1c~)7ks5PqSZ#^CY5%&vN17u0{>9gf~}H^DEpu
zU9AWPzWW>EkoE#9*zz9dp01dp#-7W|>o8&hFdP;PVjI1p;A3OZQ%Ml?Y7dRVPM#Jp
z`9SxUEua7;!ci+YG_%_NbIc-WgyHil5a-$S-^XK&zl3@DIMv+S>S?UF_4%ivQxyKo
ztm%)sH?J}x=tcP}#Q5rEZ_YSEbm3u0kXNGZw_)>|1)JcroLR@736Jm0JIvw`O#G2M
zfDBL7NB7m>g@hwkvh#_@18B+9envl^Fv{ojl?dKPH*{ADN`Balh%MFl`NS_NvJ#I2
zF__Jvs92QcohvaITj~y`J^H0dSJKn0Ql=kb>aEk;meqtU8xs+{y0<UF1`NdZC{rcI
zL#kH~7==H`kPU-64N25}mhmlzAJ(96fU>ioE|tOEwDruEPb)8uC#Oa-ytZg-jjp8E
zqsPm`&*zVK>lRdEOu-k0qOLq6mfaHah;qz<UZB_squp3P(f?Bs9*(CYuM00zNASYk
ztsY-K4oi632=!jHMY;60K19256pd#f$Qj8~(TDOL>Ys&$O<3pA#{<t}h~+#YU_8|@
z(sf9!@^|;HV)^F6N)L(RYU3b~RPb<<zhHf{l1zD&OpywDFyU!%0T|X1(>JuOO@mKX
ze?B@|DzQrV<WVtgRV9R4Dw5NvYeM{T_Qgv^752pMBB9P22`9eLwKOGTcPplukHt7j
zm2IBGleWKJatucEdcI@|J!y3UN0g?ye7lcnJa2>}S#bp~bT4nuof~-Zm|fs!b$PW@
z-LPw05`O4Vs_KJi2-Ur+3=HZ9?mGn*s#pzey!dj-G|Dc@We0;lKG#s;^V6<{(~=oZ
zf*~;D)VzC$4~<gvk#9prT1VC_9W~#zm~Ae(FhIU*L9C%$E;-0zTQ0EzmTEf_^LTSs
z9i+WAEv<S+B2vZV=J>01x2dJ?FD;G0O3b$Jo`4l9Q~W>wb(<Y22Vo745^gxu8Q(-q
z7zq(0BcuFO+^yXy`{#1y$G=d}16h+hHsXT>)6z55ZsJ9Ls}SB3@)L^W*dq!Azp-n)
zi6L_Q)zSEgOzaK+5-1)4IU7*pb>Xh<sU7pkQ_}o#Yg)2-tPga0r^#^1rttPBGDc=o
z4afcUH-*N@RdXQ?={aIR{#?cx823$*bs^=m{Q^bDlF+h!rr98s9@@E+=_uQgT>R>>
z#YIX?3!qr|G?bRpekl7LW_~ZLggAUld!M`&Ka}eYzL?xy`PLGU7R4zE<b_ZMSKgCH
zAWw44HPDzEqwxM3`YT8nYM`W<*cZMuG9dP{JenLP{bm$v@o03JD|5Du$3Z{7f0nOg
zJ31}}XZ0Z|4Ru>)_}#QPMeVxirYh7R_D4H_vMH1GnK&)u6+TabJ}jkuqxsk{oA~q~
zd^9U2tvNdWCY}W_`=HfMnafh))KC#M8GX;kvI^h;VZsH~vvD;we^}iSfMy}&nZ|4o
zk-GPBGxAG--j!8X!?&aWH!I9exyVlmM8-5L)S#$xoN!2foRdL#pP>Ct;`LsU!~4@m
zI#S7k%(AzvL2(eY-v)vkynZonRx=8JQ(CO9nq#+faj6`Lgnd^@>G;5V_l-ZEclADj
z1yalagVk>Fns`Nn-!g5CRKz(U$LKBU92Pe9VK}M>6w5nX9-;h-W`?si$ZqZmKedMR
zr*_#EYgN>uOaI6JKaS~o@!QpPM=_H`ILHobE;*RZbL+JNxrwI0+|tw;Ue*m~#`Mfr
z%0Ea>f#e(t$Kr7r73qI(kNYMBD?OJc#b&8iF~r-E{?*1-nkV0=<X+^^rEiKV<l@s~
z39+^Kp`$$`|7|#pwAH_EBZ2_*b^p92u+_aNDt;tZqSlV#o*=oY>yQ*NHYaraWwt;9
zci1{zT)n}2e!?tSioHTIdoFl(YkId?>T!OT1uo)DEoF||L_5d4q^)RqmxuJ|fLs~8
zvq}<r{N_bRe?$JxKrgbJH{zOXnA77fJ3=eRxliGXwOar4?98`@CG26iaja0qBA=}j
z9tXwY4ZlLVpdH2OdgHHTCZmO7z6xfgV%xxuzg{YD<1X%kGw|nnyoo8wMjT%a9CEe~
zfJmhTQE@2&+lvxu38B*xL~d+@Swp`~F+oA-{#8kio%ou}O}oMP8%5lvZioZ}<n0~;
z?~BF?f{2lMtghDG#}=_7^I0=UZ0E#zXm-EifMptWUTeSliE5R6g5n6ovw3i>Z2v9!
zIYoa^uRVj0fn_{~%(<Z8hO~tWJU*-e`FBq)f<!s^lJIiTe(2jf`%XENeL6B1$d@<%
zE)p0Y3cFN4WYOnHBRjIFk=ve9Qh0MSJ9oki^%crvmsk(tscgy>V>nCkV6UFa{UXD0
z)sJhnyZ+n=PuXt75&rG(KvG_f7g+VK2X#Rt`)f&pL<%SV^*a?f33$g*9{6{2pmb84
z(vSRLr6i{@TEjCA`V?buDqjp;EYYKv0HpGY$?O|+5J_NQbR7l6f)Qy>p)!H~YX9ew
zbpiedDDW>#S~o016|BztA2oYxO|)ulRa{_w?A@$nZC(QfR@A;6kNRD*`qIWZS4<9Q
z{<wRX<&YIbYbR$L<+E(}btiZ(V5>JDdVDAGd8?e#*-7~?$wK+7%XxSkvG)Nb3`C&j
zo(C-w#F>U*-pirmicJ~piUr<FynHu4x+heOXsTX5jZ@YR(y*66)@4OY)}h(eMFP7@
z&1Io+pjdwG!9P))_FP?6%#P;1rh>-#YAS=lE=suszIFVHM?g=@PisCA=o&ufjXk-y
zsuBpLxdPvB%YS&UP>zGHXq_MYWhWH*8y%cwTMfm<y1mPwZ665^eCfkybr`O0WlA?9
z7s3jSF#8AoVB|^=HAoMcH)i|y*V()DcGS{`>3(Pmp@6{Ab3^H=*8p&8G26Lrir@Lt
z2r551NCM8!{GX`nP0`I;fqP$xh-Sm23%FYdnT0I%J0fHD`3PhxLc*`<{HS~-i$=xL
z$X*%|yW8F#w%ftJegA(X-?}dL0+`X2_$trTP9*M_$|w}z7pN!%ehX#gU@lx0BIA*f
zk?Fa{Q}2+<M<oj0$INqAtu>BQ^SEpQ$N_cz*Bk72AkYxd@x7o6Q<JF;x9GecWGa>P
zo~OPYQMbS!m>WGO%5>Vf!?sQA?UIjh>GJX*lj~8nqXRohjdqDZHFRlVy1(J@j)i+j
zRu~wa@!E7c+A5wFDN&)ZN*XZ}F@_M@e#3Kt<r=h0p;QeV5lu$S98m}i1akF2NC7=A
z<YiO<n3SkfVH!;)+Y*X5`|9GLF#PL<jo?I2`feWzmSuS|Cw569XaDJ$cowdD<G|l*
zyw+cy6dsh}1%(_pHrD65t~hJMYxqv}(X1QE22wA0pMDNwq#Zg*4jSW_#qD*+jDp`r
z)D|Hh&zE%<1=b4YmoFw^C_y@b=54MVL$3uepc99P?XZ*L@jzCGya1{TWg;WKeY>kS
z0banZ%qwOU$!_a79h=<$4`u?~TLJXf7LFk%{Pru%s(f!BG<TXaYBt^S5B_wW#^tsi
zOp6s#=b08Z+-}7R?WFTNVp(;<V=b-A2gau6ODD5hm8#c<D7PD($FOyP|GASkFKYfo
zO{^&J!>N>KMz`r=NtJxzW=h2>cR!-yn^W}88?_D7&EOOIGaFY?{c~x4!mZ+Sc`Q5!
z9PY!>x1(>!Ucg?im%?AxI&ab{-Fe}<))HSE&KdG>sTJ5hs1S3Z^hu1l<g?$JgGOdD
zTQf%af1Dy?3+gIL0mKDB4Nik0w4w2@f>ZOi6u8i}39giQ5kW;KLy!~%A?7(ohHPGy
zx64PRn+Jv^%A#ZBL#LP8Lc@bxkK;6p%f8g*zPq$9yGnadZ`N!V(@ES%?C;v;G<|CH
z?e#om7N|5lQ@eu`$!7n19XnE7?Pp>E=gUPxSO=n!EkrO}Y|tE_<vsWe?cvr(I*e60
z6;;CNXOE<WST3{mPyglv8MHaj=#I4Je8obov|BYnkV7>~>OK2kw^OBLjm3MP4;yIQ
zH7|^j>M_&@4VrC+&*ii2;?Um7*E`?bw@q6>*X8C0#EA7RN*_>lNNzW{7X|~Fm2Lx2
z$G4fPveaeEvaV);iFN_;ajD)C*f85NC7n;7!PXixd9m0=^G&{E3dwT|`{FK9@$;!v
zUaHnD1|xC<?^A<x3My+HZX|eVt48yUH^IPZMVaR<P!2uf;YLQ@*iPTBJfD`@O_KsQ
z71@xkAx-P>@>=D`XcN_y#dOYV=`UYs`sTnMZv=ez77He@mK!yLf3V%?uyNsK65;k@
zbmCCP^3M?m$*~2wGUA)Bf|&{KW!TWyu>CYn{p%qro)&k5*vx{95D9hUUryURXPI%s
z9O5;oufoj=$kTq7Qp1h=zn9!68zEHKcqob1>`)KLv;M;9E|J=7@~+*ee>HQ*k7s?4
zNMjpwiiLCm;x0|&smINY(l5mF&-RfwI}8Rzu5-O?cf@Kpoe3A*^~RyGO|EL`%#vf|
z`@;X!Y0?y;ac-*hg|j|JUsq@U*29WB!hGASIslgpIp+|_79<HSav50powkT;ztNO5
zaz!Q&5$ne=ig`5qhe6>Z-%xsTw2nV~L~3+Fu|U`n=###Vg@_=zb_p5bqtKWafnq|{
z^~~OC=YECY3B2^)V2};w7DnEHt2q-QK|5JDkAUqGBe>5D6+FmAeqL7=TOo9i5@Q&Z
zODL=f3+&};72UAx=5GMk4FCL<B0G|;Pd<e)0R55~o3rb#5)@b(T^ejzO=>J%xER}N
zGA7Ro*h{}bTC}~=)$#)5m{KZREeJzpQ$@A8Me27_2j=WMp|J<#fe}Q@8e1N(j(I*k
zJjVW69DDL5XT%|~a@!3WyA5D3SpJ7if-er<N3h-Y0aL@PHIPHFxd$f)#-&Y^Rtx29
zLNps~sLm0j7LKn@(%(HJMAI}vJ6lI~+Lc>@Vw(hn6<4#S-?7&s4WtRF{DW4^7{P{q
zh8|Yy#wDbfuGG&()Vn1cjbxTP4R!~)%17oq`2!`5i%}yThmtkx#kZ^tM<x|lzLzA4
z<K$^NW2;ZWBCEEjjLF1D?Jj4U^rkdgYG!#PTGomCc0U!2o@1)HWEwZ+znu_6Z=s?C
z4q85j@8Ewp=UU~!IAy}x4sd4e;zm7ZAu|TOf8tFz2t_Oev)D_cmbwZT9}+1oI9L4}
zkw;D?+{cDHD|Zq<Itum^#3g-vnHI|$S3SG4RYYT8q>?f5^|4h7o-yWg-Awlh+{%@w
zvWS)pNoeh_RIp9>roBd#7Bg9DngrGW9P%yeI?;NPG^3dfr13UI7p7yg+@0!WRdkWO
zi}~}oQdKLoMUNUIvSEW@OBJD^w0YC5I9vXYqK?l*3a7rM8l^_x<bNvfxpkxLx33(3
zkOXJ`ZW{YREqkP-kbqajcXaZ?p<TLu8dI2n7tf`^8qBv4pCXxtW!viW%?lu=znd^3
zbJj28RB)0{;>@@J+4vIP@A&Mhq*e=@_NQjE1N8JKxJ5c{{v!;ls?&`rnCkZjpx6#0
z=P1TdaGg(C!XiGubn@1h7I);P<+EfH)RaV)D1+>3(yDdPY3wGNs#{jehwb*n>tVl|
zbqHDM-hW<x)10-sbUWaa1K@bem8vT}K%<@?@y9v#{Q>C27{$C9?E2P>%T=|KC38n!
z2EKn6tFqy-C?7U_Vx2x76BG|xZ=9g5m6!{Arz$0bDuOhf!lMpuClIrF<(uxVCkKjk
zv5MJrD-Rq?OGfO7WEEg3oMGoE2j-=*0CgTR^Fmf>j`WQ5PniP^;OF)0Vp{2+C;O0F
z^ea@3ps%KXn8{BfXMB!5hxHA<D~m=bZwacPPkMCwfX@P84W)#iPg0kPivg{>FMeE?
z-Lf)%`+YK!jriT&6T}*#YkX8ezmetMbyJ7=fv+j}Z|$f1&34Wb(N~X{LHmPbXLPBy
z;=VN=mDaRy{l~Eg5cg87m$b@U>U?=Y0ENOtDPJasZ`jyh3TC_eF1Er%h0$mQUjR<K
zXGDfeK?64Cl0|`#$fQ1K4vUKkT=RTc9i-@fBW_PhGm|(6Dq6av-K-QCCEbIz(**S*
zx2I{%7Ip3$op*a<SYEWNF6OD_d$tj|^JSRz9ed<we()^-(;?~jclcms8!lw+%OQyp
z%osjJB-fGFoI(+x9?0EDx0RyUe{laPk0h4Y4#euGuMuclF3%an`NA#`R`igVvw+T@
z6cD$9OO-*L3HMY|u-p}6!Y=H$-g$r0uW~qYv$_8M;q&vy<xZw$9?LQ-lJ0jK@$?Ak
z_M*xUEF}v8pa)s3CxmPCSB7g1KMQnDivO8&TIeFzA}$nQ(@-$TqJL-Udj+d-pS64P
zU>&@eYMN9#4kr|G`fYO*dfa-YPi~=_T*z3my(?#8(xrn=-jo4@EnKWvsr=?a`ENe<
z$v<6JRg1vVx9lvtnCc3UiUCG%Qf6|(xsY!lPsH9`fW2_Ht*v94xL`xjRR7w|+Z*RX
z#SM(1Y=KFe<5b;c+2VW9I;ONdw3$NFhVCiQn&C5V^=Wm~EBWtnF5s0WR!F1z&sjh_
zip+xMBQ~lA&YBPmyxO<<mK%9rIH7N;A=^2zRg+@}hp_ExiU%i(H-1a6?4MWU%c2Q*
zuoPpYKyxTt-jB4%o!P`TA;jh3FV*6iOR1(LFY35n7PSn;;=H4I3)+0JU4=laB|K%F
zy6YPT^yW~`J2Tr@!5g?a>=!MRgp;76W8~z2j;V|pT(>S)>`%vWKx6!|#66Dy4nWAL
zoUgbMRUx8Fc}8YSJ)z3wDbl?xBJ`8v*A$WiRyLl{D5}>dxugUhMq=7S@A6rbrmM&Q
zX>Y-dZHJ|b^t!4~TW1s6X>S(z+>@e|P2G&2vatJC2b;+y8trC@vwwzCNV#7lP71J}
zIaxynA{<5j2GD7G-<afU6*;&C77wH4I%s1alv-Q%%kJc+O1V5{mMPwAccOVW(ftDA
zk##$!Msmz&*U5KAj4#4YbHlH_64eIo=K#UegJ<~_?zeLrc2cdeuI6J|J=@v9G}XJj
zP$uFCfodxmS{6<oYWRG&_jcP6rBATcSkTMy#Qb2{FuQ$fw>0S@qqOpgCp5l)=#5<>
zzqpJ`=8N&`R*us-IG7tl-*tkPEknNCbtE1VJ2DZE-*&6DDB>ZX{>Gi548ZJMvjvk!
z67*q9yDe)_hsmlsogZutqVgbLR8Ss;JNhDL5RP2CzA|{`8mv@?W30kupi*H`x}d6u
zF_nyID{aXK{mxYr=2}C<#x51S>nd`_cEdSYl|yIHSQ5^2j9;oojN)Tbn~(>zN_8uS
z$v~y!gwBZyCVNsJ?cSWCgDFW>3TmZ&PbaCyK{}hattV9x_e|6V>O$lHI2f+I%h!^%
zEF}B<-1pHY7)FRy)wygWxZwODp?vXcMc83BJ%983e*eR>Y0k`%H&6G`g5Z9??E<s?
z(nBwCMl5wQJ5m<m{ao2SH_I02GQr3-n&`#DOzR;aws6v8?eiOBnuB0njCjkJ<~&N|
zU4fCq$z9z3z6MSmGss!w32o49<_6+d1Z<_EyS%t&7g@*M{4Q?FqUBN%le9yFoXkcu
znlvteWv0kz!~BQD&Wak6HW_4|l-j3=^Aq1lk@8O)nE0LwTO6r$(A_KGU}-UvOpYYV
ztv!Bs6=BjJB$1|BqsYMKx~kMXCeVyCoZ$x%UUxSgsi+G7QMEVtqRmUQkknTTV&Ues
z-YwbU*c@;0f0%m5;L6@FSU8>-6Hd&Dor!JR6Wg{<Y@gV+Z6_1kb|%J&F}eBu?|rM@
z{b7IJPt~rcdv*6(3-+$@FBq+}^X0B*y=oF3?^cDRSl}kOe=1*gnz~;_SC9Noc5i6l
z+sQM}u{|jrr;-Fd0EZV#UJ;ZJ2&%E2nb|M>A5-%grvP01tl^)I6v@JFBppJpN<bBr
ztT_~Vj*^Xqb<-_z@VlU;oV=Z5k>TUrSoFT;n<P%ICjV_%CwwX2QdivQF8L=j4ZmK8
zUQHTKEe2fTFo-MzO%_&*W^5Rt24{M~q&po;;v79aC{qV?Ev6Q2LCMi&w&Kvljz&P5
zhDA7-re3YnPDQ|LJlJWlz*6Uf@Y}Um({8aH_r75S`I+Bj%!WophC>#ENe1Yc41`c=
z1j3|nLLj071yhIt_Pr1ya&B|{{8E1E*p)!`gWE5XW*0I41)?N;C{z)v)0FenDht(1
ze@l&1(aHQOG>3HX_m^nVk)~YUnQi&Km65C#t+9L~aT4k`tO5m1db5oKs0=P7E%K>M
zs*s_`U`GznqJ{7%HV$jW9$}anaIC<aS{rE+^X#K2)l3B5-sEDVs|TKfIkkR*r?+gB
z+sxU0OWb?fBagZylDR`RD;dy6z07#n73w8cuQ{BK-&kdUVK~lrcw;Z;<;MaNrp^ND
zZzO*k|HmMPkL{3;j5r!0--KXS+cQwXubfCMLW4>?)=ur=ZiJbk`w(t^LSM&wJj$OU
zdj4FAdIv*>BQGxy7>?9ZSQ4+ukG)DZZ#F9%M|myB0cQ1`tq<BBku^gll`n$jMDJw~
z5JI!;54!Ox^~1jC{3(HK*WV-ki45T7;Ct>DNU-z}D!TKBz${-`X%YN5-mi^QDza`=
zYIm3tUUT{EiVJc%Vr-Mh7a%Y~Sma$ovI+2#43skT_6dAd$<9E1J-}D=#yH^+lp$^+
zZkevF@}V>E!LqHAbj`gpsmKu9ziisW^R<00z!{HE;`pa3g}yMAh;gwPEk&o?*6MR0
z!pN#(G19c)pvSC$jg9@x!12u7;~i*20i(-P;HazhU{M*TLtY2ONymq1xCOGO(?BYd
z%>s?n0{{S7vQS86K5J!y8v4&HEF(^cU2L4eTeYl0D7(G|Qo6>FzNxvv%-cHalmn;u
zwkc@%32myXm$H97f4c3+)|h58?cSN@OfI$w91+|J*KKWb<Yd`Ys<C~8C$W9`3Dz3P
zBi78kx9{r<ExWqQGHlNb`Tb>mOB&oc4V3eYiU6*B1GrW!17Igr7Ab^9^-<^G(4AT4
zon5;GU*zltr-)=zxaSu9y2L<d@o3A%IwL+L$8>vKg^d00gsVqY)D-J!S3}@KB!@R;
zl}s{g->c-+ufbQvn+6*%rLML5R2heV{;Dj7YC>d7%3;f*E2ux(rTN0fF^(iUN=W4Z
zB7hY6yUD3`p@j*{l5jhmXR^_&KdqA7akNk8Q;9kyC5kZVA=yTQe!uHAY1N~UxifFq
z^Tc4333!x*S}`q%eFWu1a_4UQC?AV}zQ||_o)a90j|p-K?FWCwUZm`D`6$}RNZvDf
zq|IGhuPT#|yAB|Y<Qo>YS8VwM980=b766jlS#31Ycfk4&^pEV`RkZ46smOG)-%gpj
z`CU^5N>({5Yi(x~WcmrI40C^db-=d9|FO1n%St?paZMI-b8zO7BbRw-F|Z#dpKEs0
zY0!%Gs(|?Y5KA9hDqI={zrw!3mx;KqrU`WlkEX%!EsLiltc}p~r9n8)5>^B=i~#7`
zxr=;`hD#WDQIIk5v-)46!+BFm**>CuH&IyQZk7r6WG61|hRt(VZxcfEE2x+gT-V6#
zL}WM@oiqy#yKY{MGhe?pAP=O=(`>1+7{#L99>6uTjNY9e#V+A}2SphVsbhNPnc(%;
zPV?_}%ED!^=GTjEg~KHOYQnVYL_mG7{-NGy{&ipw^Xkxxb+cB&(MZCLMyw+Hf2{vT
zfu;54i}laYiA3|`+2h=#eHIO6v8v;IB2PjTix>W~aOK%)u2rsGIP=l-bKr^~_;^@*
z<)PU_d2&9)8(r}+>K(Q(DmWKcQfbsnw$d5ylV|G8lvkMhWhH&tgKzo(*q%^fOwCA6
z@^K&gnWe9fzC!aw{-bWG6jYMmRer?8m;X~mGL1B=u%wx(h}db}R#h9!<>}gn8BzAq
z*cCX84YJFzj6PLt9>)?{5)6@12ss!)ot9-_N!>2Buw~jyEDr7G@RsF8(V*v%lY0(Y
zvrShl1)hgU9xQ<QIQF*!s`Ue(BmXeZR4HYmehIT|ZOOL1DS!CXueY~ky1^gf(X3mA
zvuLaN<up0Pl;8fTSBwRz>sl4s)sj5TuBdm)ZCN}$U8Zb~Qd~QNLmY(m4TNIUqG$KU
znMxHP=tq4(x~|aia{AQ(jf+a4Ko0H38haF0k1pH=jiO~?+Wb0bR5nzx(jc7u5)y?G
z$@KjRHsDn@9^Uy+U*zx=tJl{8-v0@zmo=~s0iqp(5?`4b@*D-|v~la7OhAtuRX`l{
zJ?)eq$&p;;bw0<iD7vlDf4K->xdT2DwI*ELF9u^XH9!6vsMRC+19&2tY%Adu={N>*
z2F_)$=ko1Q-V>FUHNR-^JhIVK;LDAya<<6$l6_`O(P*pDu%A^{TU$>xPFVTg7Vtz(
zf}WLL*w*qLT;wPZc$en+dvIR?3#!=(O?g7sLb2beLBo8j@9Tt5mCmo6Y5HRaJ!;Z>
zG_)rcL`3ut3NmcNBy@b}-+y|lLCwpi-J2J0V+#d4osF#{GIG*<<#AGFJnA8;EUsVX
z-d&|_$XubMyuxCFLMl)nti%{}Z<{P^v}sFWS~APl$k!7@#7#!l@KpBzgdQ9{QX%qM
z)c{vJ-7}XCNEce)1f_$$o~;TQ$o7CU+wz^%x2CI<0ocT|y2P{K$(byg+Mf?kh4?6#
zt)w93Sg_E@jgM1>T|w#U{T5BS6^8fcapugt$FE~TThL%MWU3w|PnjB(+Z*URW%H10
z{w&!c2f;?9nJ6@`bM*iue3)115mmQQZ%>M$?=?&xU)@Eoq?u&dqa9L_y;65;F6<wm
zZ;t&r!We*s6hz$|e@>f6HaQM0+v(o`gZnC1e%85Vj^^Gz5Q%XsylD3hna{henhvG)
z|K0+NtygPp1U8kru;Uu_rF(z6CEJv%*SyUnfiuE+NcG7;=p_P*UdGY9rB?s@TDLQq
z6ylM!a?%6j1CL*~=hvOb%AvGrr@4JOlK`PSlOKfNL@Dfm5F*XZCd$l)3tMx}1<&&^
zCeF(ytYvzn{dgKwXst2rS3#(<Y+D%N7)IPf!j`-KfvgKRSU5>2UrL1*(#>oC#2_yt
z)5jjXbD(2^Er4ga5VPeTOAb^w@d;}GvR!@Fg=cL?rb(fNu>)Z)3`X;*Iohx2ALYpT
zoC53`Wm{d$L_MR@(ROv@kfNR=__Z1}(6bFDXoo|aa~>yPscYTPF=Ki(gt?F8E+3vv
zf8kR(J1F#vbaaO`b?uYT2Zg!3HS!We2WbgMXmHM@0+{hrw0uojz_W@D=jeDdfY^DR
z{*dGgSw90C|H;xMGg@-GV@h4~6cDGEJr2hDHy(XWI6HU;{yU*27!tDcc2qDsyAu@r
z;G+UBVg(?D3rQNSdJ_KDCq&fFp4o^t5GevH{wgRx82;6Dra`Or`wm<e!e4DNK-cte
zI_;u@jBeELN96VosFJ0S$DrrkTd+~T9m0dzcR3I4D^MED?Wof&M=ljO`v~vmjK0EA
z_}nNxvTYS;6Dl`7rQ4NJDI}VBI6&VDa!V9&$c`W&^+R@9Be*~gH>gTC^Sfsv#Xna8
z%L>S_RN%D`@?m-I3I;FPsT1gR?FZ&@4qt$K1v(I_N<e`^Hi!XIplhK8crI|ePyxbC
z8OT@^24SZKY%3B1WLh)g-|s`Tih0crHU*M_loGRuZ&V1cLs}0)JXvP8tF30iAKCd1
z5&rJ{T~pLAebInk2olN?X$SZ@lw7RmQdPx(?VKM2r<`0!IU_@E`s-ZafkTcZuXsEp
z3(9repZBr+P?s4M^wh{13Jx><@|r6@yDa|a=GxiR#Q=B^XPl(bOSU-K+S8!#+3WT0
z+lTKP^iQJ=KO~l!MHJ2y(=*Q=hsGFl&?X^jI8eVPN=c%T6(wwTP-420C$*|BC`(9s
z&I2lDmAt(PM2OWam}&irSDlkv{vR@yEs;<}=G@>{vmkUNbwTW^3l?vmgz>bq3c90w
zfCFqB!|aX#l1S~_9l-UnZQFwwK*D*D-SzB-Yzvzj+w3c3xrDW)b+7T1))|}MVBhM^
zs#tUGZ~a4L&lP6M0TZ!@1{XCsnJbF$@7vj;ZZ8fi`5WZLgGEqTv2lV=$|$|;@hI{c
z8-b@4t~u5~z?9Y)E9>o};){;0x=FhuIRGMoY*$VOFvSBAw@9g9`+iccH6q$So(4$>
zstup!8VdQ6(6s*l5?Vi<$%~M?HL}rp{PCr4sk`?T`WwAp@dE9;XoW_xcEu6x2G2^^
zY6*`R-8O;g!~ch&84i@^;_W>@Sv#pLG2@HTleIlFDh_i2;}*fP52aRADr_opDxT_c
z?>!GC6}bO&_I;pzV)1psVOdOYx5qeZEv}PZXbC^|`s6kf4Xxck>^<B$wo!_8r8)3v
zR$^G-5kZ%Rf8sMs@K~!Lx()!S*yy*H^MUk7H#TUSGN-!SR~u8{&!+*sVw7C^jGEmW
zKP0Q=iCCin_-*;DGn7z&8DVHRB-kLa)JCi$r82M<F^Q<3Wp*$9tiZYq`u-T7wUCCB
z=*z0Q|5^YE&In-IuPDY-6vWoU$exF&Wq7+I`a*k}3TFmH%*x!n-*tJNPPlhn`?Gio
z_5>L=dueVdBDuQM@>c#5QS+NsP?}-r^kkd<h%p5NG`^y~FCQ2Oi2AOIs60@z>j>u{
zxx?n_>nuj%Gao)L@Lpu!#B{bs(1TWML-(OVsCagvc8Uk3l05Jtm49@TGO=6M@+${-
zi}rfzM*8E?^7**CxkEnh2ll$~)ihA}Vf|Q7=l7YFIoYfE`6M~5-%bDU#*&Utit`ym
zMeV5%U=j){HZ+3(D=nL*SXWStHP)nph<ZZ}4v-u-s(nkAhrr!zd5vxvXi;NGW~{a0
zNj|rg${raZQ5#m4O7R#^x!;M3`bgvj`Tfm->JK}LdxHTK=R_B|;f;NM5H~9nYO=mx
zJeGW2Q;_JH6%<+0#7HpR>X(MZ97EjRpO=z=2d~x@Vobc?-Ss={cDWbb;A$?$+X}Z=
z8HM_*iHK*;p{IeHo-lcA=Yyk<)6lEaDrH+q>JY;3o9KHGUqcI*)!@3<0<-))PM}-h
zrms5*%3YYZ^5`AUqweXRTeFQdc0IU@R&G(pocj-z%2RPQunF%*?JR&~(*8+pbd-Mp
z&j<^qK3){zKln&>pLZa+zaRVz?=A}k;vH|j42hog9*-v_=_J0_&zbO!%vfQ~A2(9I
zS7u+t4C<#qeq|O*QDKyM(Nl~~El$NXwZE1BZio*UvotCz6tn&bBrlkkw@h2U`Pyz@
zkp`v4BLF-+c0^O%)EjxX)OUMA$SfEI^eX)Mve9fS?pzQ=SNbu24EdF3sP#~-XnYWz
z+-a5PRIG5@Wxk=8y5^a%pH>qC6-4oozGsvTU(pFn#4Hp}PPpT+4&1BDM${$RFcPKd
zRGvzzFgNNI3Rf`2)5$L=SE(TBkC_*xMZ0FEP0WlU;yfD5s&CV&RZNM|V$UK0JdW3h
zwz@oZ$sBrp153uy)eE|VvW0&P!BcpQ2BG&2*r8eaM(G#B-y4lE$oU{ISLmIXECzj`
zt<3EUoUq2Y#OV5dJHN!WjK4FJrK_4y@QdH!AmLN8;hXrN^Yhe#HOgemuZ&QBH+R>+
z>8#3ekF8)&>P*2H>U(g@S)K6#{8$ls2KUn{H-o%EG*g23@5dEe0PBP<(?8Q}we0PZ
zq~ywX{4{I*GV~~vWO=v_&>y@usy}(>{fdu>9^!Yt>;+ZeQ7q3dqge|5&D88H$tMn$
z-VJd^k?-^{0U0l*rr%Djchzj!o%)RD-8o57!dFaQA3wu%T$`8$(MbWgqL~cee=!vP
zc+Kp-hRD2dD2@ARe778Rx9|y?3*@$Vve2BA(W1wiXpRzPFm;=ha-+i69k+ddsL2gv
zAYD6j^!WP{^xe*?#J<AXfTgpxN}zM93$3S`J@rW&P$QE`D|!bB5d$kjW|M@sM5%MX
zpYqHv_kmCqAQT)&Z#e~!P}wz_cQu=Izbcy$;Qr3WLg~X0^Sd54wefw8IjW%Qclivw
z1$XYZ)}bjgYnARR4Rw?k-AX=0#mcyu{Qrcx*Srs&#MckIZVKkGbh;&bTfo}9!pZd?
zXYYko*DUJ)!lFK)d=Vehd;0fqXQ`E|zjyR;nwriXd-_Ae1^|?RYZi%n_#nPV*LkK@
zk??*(Mc;&N%shGiSxA!9v?v`TCOT0A+<(F&wxm^WJew~TJ1)jWp-LOZ4nc~3*J+w0
z{!qX_EY5Spo^;A1V#QwK=a~VGKao5%$uzDO#{KE$4<I|I3nKPkj0gZJ5k_BmUB;Df
z)r@z@@=WjjCV+<VG9a09&xRjp#{Xi0>}~QmH=vLW?rxX(6H!McJrsK$K_%E-#4BH;
z*wr@NhH~l$$!&{s-wW|A)}+`yQH7|A*72>EuMlDB2ov!GTj3N*!KP|kk`HM+p)2#E
zMy)sbaGTIw3bSfKsW^>dgr7+lIL+Kw!kSzdhEB)78PLh2MXD9>)fIyD*8uXnoW<9s
zmUapAEk?65s9^9!1n}7iC^ku<l-bm)zijDtaTB{>s2&}gNRbOK1wUd(A-n#h_k3&~
zRtMT<Ho&v$(5l_#O=GXX)fQ;$a$bWy(}ey9@~@v4z6j3i(k)l|r*e;3kgi>8{<&jG
zDing`09CXb=&Z?_Ar1-=<8vr-@x%j<<7q%|xAu2Q;-NuU*C<yj`4%Jy_a`rb*WYT%
zhZ7<GL8ETjwQYr1*qO5HOcf?e%Z3Lh#q(dGBSAd<U#b;z8l6Se?`v%0MU{SMKI%o4
zuWd=(x<wd7<A1qsqrJ_Yr_^1)#@;_h9+H7RwWNUh=?8jkpULf7>(rXdK?;8Ao!!45
zo8~nH=mfgC@prpLFFT%uTAwUV5AuK4(gwo+4CBykE^V=<x#+5v9L~57cp*3Lz}#0o
z-)uR{lk(rN>&Ui}`A7nG*SrBlm__iHAI15eFE`X_JJ5Crm=5wm!OWh*z)grW-b#E3
zCExbs6_`Bih|J|C_om9&RV(qGeN4Eu(X{SEh4mE)#Q>u4<@5Nb29G&%g#JK>=-_Iq
zPR%%s2k1oiR%hpK)$7`1>7{wkF#&$+zdflBkd$3;?U#yoM?GC;U9te#DAHCFtsiuy
zxxYF&CsabO_=(B#)-|iyJ%~o59lO5coAi>T8gSl3q2OM(k`nNV7<$s`Y&%7vt^8XJ
z$-5hq{VaMhR!^Smmha+(+xPVej>{xQzx?KE`t8cEO+Zy1))hwVa}>UjkwccnCnMJN
z8Q~)8k1;46St+Ct9;Fg+V@i$0cAsEQFdm%say%@|k&X8p&Z%R1iV}CRB0y8Nh(2c(
zZAiuQ7-43C;sQ~q|88e=7+iP|%!G|7C&5P8SLEC<0nObB%KhMV>H@0UX6cq!P<8qz
zaUn=|t(4vV2|L?AF7VVQJ%eQ?#`A^+E)E=HplUZUgQf}l*gF9gtDVoz_d^0kx|7M+
zZDzt$;G*f$X6ad1p?X<L8@;f*pMLj6Gfs*0+!Kdq;8MORf9a>zcrI;iX|n(eF}-Mg
z3LyUp?B-jc*18?l62tF7^CW_)f+I@C;^sMk`@K3d^>8}mAt{L;BssQ5Rk0RfWx^<C
zhbgo8m?-mcP2d2fjX!pX5by2PRf*qS<ptL0@?iZvIBT4Ul0*f&M6%f+_NBnX!}4vN
zz8aQlBJ|Qw?{@>L@Wu%op?;IQ0$WE1(4CE@QBJI3&n~9VQ}R+Mh8(1#{ZJ;1(bSxJ
z6$|6$Rl#%QHxAUrW^Fn#=Z*(t?wt3&k*?W&!)V%FTMq`@@e<C_N&j0}L@MD(JGi@H
zBFL1-k-e@f+9ZO*j{l(~W;$8?eYZ#8yTI1Pg}BDc3tddO39e<!xg3tZ(vyVEWb!{c
zqHp>f-s!`8(EQ=G6&1GgYWCXFF}@wI*yK9h&_&hU`q}ZuneTen_o;WA1<p{plJnQ7
zN6w{Ml(~z5t8d~NDX&7d&hWm^4hv`Zv~Y+`g5AWZ*hOw!yc@j0k4`>X63P>CLu5`a
zZ={5uA&hhQF8yzEe<!sRT0JwwK}sNxzsCog3GcfJ$bNOO@|_$2WsY%BPnad@0`7WQ
zKa1@H*4xo6_LO!44grkgC|-4KkglVCP_LjI6NfS2G)tgPa2xRe5Bz?@nx%*IG<Azz
zQ7~**lWnnvG{fp`-!2NP#TRWt#=3=7CUrT<trLBrPclheL+uQJ<}YW<o&nml=Dg1E
zaz5C;nBXW}tEsf&OOs3^&}fw4r*_4hPa#U4p?PuHIODL_rZE&B3rh<DT~yHLl$y=-
zYpDTvKK)Hfc)Z&eY%BO)=y29^Z8mbd-877P3(Kf!F5G#E?TZV*+|a?n4Y(4z#u8Gk
zZF|ii&_N!3W9WnlritjSbpwTq)&f{)$H=34-bM?(z(#sz=bp+d?^B0^K4_E9pY6FA
zRzj1?3X>#Zy14-z^(%<goCZ-VX-E#%V!Qw+&?!Fr{(iK<ONFxc2I{G-=#7FBfTFUO
zhW1{gs?*I+ubh%?*0Z$QhAT++FD`EeqSh#;J&R747#oTOA^9(qSE_5Twq6B#U`Qi+
zxN`tt3}6X7-PtM<Grg4~iH~3^Pe#=kiYek^sR~y<s8UsMLACxq8^-%^l|er?c?p0g
zvX8}_Q?&9GmwW78mnfd_Q|dfygs-iZ&z4p*Ahmz2(MEG4As7y-LkQ!xq!TgtL2B6j
z-IEF;0xX3jwieBqD;a~ilH&f~fZSe?ozKc^2S4e0S_tuA>Y9HPdRnUyZ(kF}NrJ-f
zfOI;)mhGIFqB$7I1>7^H!SHg4v{b<KV*a#E2oFBwFVau!KNXW6wuJniTP2O+DqD|X
zmC<z0!i43p=#LJv*Zp^Em5Lovyx2O2ucC-Uc3r+nX~1C*K~}xHMsQt`>2Ig$iz|-z
z-#<&b6IPafLLeNIY`v79A#q}xw0B9H$eDCo(*!#4@X;1?{h(PGM>5P)*_HzoDKOjT
zKiT2mJifeM%1wy4ls6~oDO`4Ek~HSYNpoRZ#{OAfJSH$9PX#L)S$^?JZ!Qrm8us}I
z9s&z``F;puUX+!EGGiJ)<VgJH|GVkzRLMBx-U&>ZV+lXmn$d$#Rj_+Wp?${*V==^5
zwGvylG`tOIZP1xyAJmHd9yJRfy~rKF$&Dh&eUr1&6P(5yNo5!SuwtFyP8mNIU+YCu
zywv|%O{me7?(BJ=s-&NR(ZA;Ch2*rc(4qJip4~chtqU@Uj$&pQX~Q`vxtcSG&dh?n
z!NIPSUJJwDu8^=@?soOXSE^U#LivFQOMlk!hY5M)h?|X8OPy;KKHC;>2fzOdmSiCD
zm%g2hwM84Klio9xkr;7MvNkJM2SxrZh|=hw?A5g0hva+7uy;$YlMKtu?#G!>V%_#3
z>-$@T49BWS8mh+Gk(!j8h4Gt&o^RtA^6<u_w|fR9F;}KStOn4r)G<S#LB4Sfb)lMr
zhJnw#LQC3hvg>QzY6Um|?EERI2{X~X?DE;+48ow-VDS2Q!sh`sQIUCUYM%Fp@s^u%
zZtdOK;lzN4`QgQu)=x3yKZgf3?~LhS#&>9H3hdF9H;tJIKafWd=d^7nz-Q*RwG}R(
zGA~h>%nN-ttZvowJeQ-pUt>zAdX6HC7OE?C|89*1%W3k%YuP>mQhyfW`DblyHW}z3
zvKe`*WS>uM%gMZ0@5QdX`Z2pW$4xKqN?IJ|uiT(M9zr4ChNBC#SaSJY*O|l$i>@+O
zD)?jR$X`Z9R3LH0MpXFPL!ztweYTwecTBrZ8xUqsr;a3VP!lU?vg4;wYu>4%re_oi
zIYl*DTB)Zg5s422=w&0L`ERbu<czW;bb*{jU@hWEAW&yX;-I+?Jq+bo^?sI!N%_HW
z$lLre3Z?~vd3oROvYX)#;!QEd4Aj67Es}o6gf4b*^vs8C+9v3T?&b@IODLy>k5Hyg
zriItaTNBs72&UMI6ry20$|g9A*jkBu%0+*WG*BLn$MsnT$oYY{MSPmq6A|`rHBO<!
z5~kkS_4uf61jJ7Mu+qu<1qwEw<Qr;kxswW+njssf$ZI#t{up6B{y_e;kTJBU^WlGA
zBZcdqnd;$<m)2jzLPK?oB8u?C5Zco#R)X5sg$m(Wlp>?T4;&z9E&V>l=*)KCboo#3
zYqw*I8Bg;BpmF4=+<(J!2EXAN(wXH$kMOvgXTbV;6J~uySOw&l8$u&niHH2A#eRZZ
zSSou?9-U(np40O~?;Uh1e){;bksXTnDGKQ}b2VD+H<Z~v99ZquIA@Tr()npO*oz(>
z$F32tG^c*}9r~~DfCXY9bMy!kuFMvw--3<{tq+D8@U&UCbz3%?tz=1<uC6BlEvN5?
zeaGkM;M)RM8>iem)LAK=u~NUV-QPm%j&S*Ux;1b?u0_4~#0uk$z!HQqI@&}dM9tHE
zyttqG$|}Yp&e~IMgJx%16anYZrA-MDwx4WZ68eMn!hu3l`hb-Y0qTlz$7PAIR<!Bm
z*u?Dypice`+uc{VqV<C-lK5H+B%U+idnKRSyQsoneqBV%W*g4@EUz8kKb(=26xenM
zJuV%y1TBz+Cv+sPeV!c9N0l*A5E8ydlKg{|!l1l}5^q(bt~$F#+RmHsCwy1ldr<d+
z8lS#sfOK_JU??$tClPU0ib+3YU=uM)cS=|tz$)TU+{rw7^VPx(L7nTD4`gwqvV4=T
z%?gs>C{qc_BF-I*juu}dc?J}3fh~#0X~xoJ<`o14C9E9y#e&C;e&GlaQH7!MAHx8<
z(Ft0uy(TC1N(yd#w_1sM8p<>7s^8aoT{!4TmHF7vn`3&;P@vz7Kl0XgTn_B#sF3UP
zxFpi!|8P-otXA-LI+fZ5cLWdU*{x@Ftk{9NJJE2mjcdVJf|`~+Ctw0OhpE&t+Vc5;
z0-QSer`SN%PHKR66~cv|U!oUbdKLX1X1Qp}7#TA;<0m%So^I$WbQ`B9ikZE~Q($}U
zn6fQ8#^?QTua6c@p__taCj!eB*7=`r)kK5IVlzikp~Qo4Gk=EB(}1F8;ZK;4EGJCi
zD$7^*?bmyHxmqqwP)TUDYaV*s5AMJgVB2|U&kwtQ%ozZ6!CdXqE$ii_n#@-#_xFp`
zT#QQhWJX&w?j$8X11xHEek!vB7CF61QcuL&P}STl%#;%?qBw8|djnj7a%dGV`~^9c
z&4v0G*}M1_rb+WjxxDF7Hc$N}U2o32EB4rPr2LDbDQYlgYvcW&x)EdMp#w<b3k?b2
z4O3u265N1ip)3h$#3|1PD#ctCLd?#SOql_&PR12es4WA2us30ii#-h>FRxFomGK$p
z9w}mm=T|o(gcfBD<uYOs#$r^&b_yOJD4nFP`CZYO&57^Zy#UE3QRv%Sj>XV@ctj2(
zPKLshvG(FcL2GIOyO|xY^LedQuXm-i_}mjE(=GrDrqQBf&o&?~X&2h~QP`qmsAB52
zT35}=9*@*kjytP+r!-|O&AOp5qKtjIX7MFzJ~N!}QJ|)YcsqTp9$^<gqTVlcYNwgQ
zo5WAzYc)u?m-Dd~>UYziYTbWGtGh9|AP^Y@BbJ96w?Uk=9yb;jE`@+|_SSfkiQi=8
zBQF3J_1MtCui!)5c<hiO(*(*n2+Vr_<uhbpWljESzSShHMl$wBGnuntlU$X8Nx-uU
zVrD>M>KgbU!o+XHdNKpN5u`Lz7@8ig)K8hfHYc@>zbxHMoccE+;!RZ?HGyC%v|Y0}
zQJKgzr)a?1sZ)OIMzw9W9aM)g+IYpAp#X?Ip=kFFJ&vndh~8WXcr;PrlEQ|>#Q5!%
z5a)IMEdyLm^#7q7lCJoA_Y2U7tbopMOFmeC6#dz_VgX6$iKhe02Yp2)#1H;&jX`Eh
zgc&IJTgfnCPR2-lJytshAY$Gz;IehhvHN+&JN`KW4G@*d<9x~4Sq@S<O#oC>w19Vp
z-t!#d#rgIe_5ApVYwbpl1?+Esdnxk?g@e2*!&5$Q;@%?E!P|p$<ld@T?>ucf2Lq^F
zz8{n<ogz3oLj7P=ss;{6k*3*7#hO2dxa{jG>5X=_G3D|?{(+eMlpv(zCO9e0I8a2u
zb#(fClAF%d9B*U_8U8)_Z42<v&zHMbMco;e2LmOuALi4}hTr?dm?vXcI3pFBcdV}l
z7|Z|EcH$w)HhEpt@?-Ma!0#J~=dUw7!383l!0dx@w%9h7#h6v=#_2%UBECIY&J(ip
zH%>m3FF8##I6l|T+gA`_G!;RVglGvs<=VXbUevTnoZzEw{UOhB83VX_*ba1QeDLxu
zp2)YX1SD`!1}jnMQ+wQ7HhT0(@Usb2+Inob_ivTTBSgEtoqcQGIAFYi66~Gmp;^vS
zr8zMtRTE+r9`STLE?ifWLXTJ94lue6+dTX9aWZ%7V4k0^8vV%p0~#r>SdJUwg&%@%
zF_s7Qyab7kKMZ_^Bm!tBjl5n`Fyq8Z?VR|n>wEj@(v)jC3|Egi4x;95SqYdv4Va*j
z`i0Yd+fsw<{cAl>K9bAuX9~{BvT2t@`^j7REPsm9QPF&_{RIFng@u%=Q*+4A0N3XI
zK&UG#q8za1)ew0sOy7QY5~(~Z;UP!J0hDF%fN;&WmjUY+zJQZ-<sjd$WHI!D+ZQ2s
z6En-`nuRp)ayY7m?g~qTqSdfIDYeoHWPe+HycwTX9c=nJdDB%#L_7sf&E@}qe;Udl
ztU^=5m544$_m_zIR$pVb)^**tc<qWgIRN_k!WxdQk8CE7GS_A(3*OWH7Wd%ik4}zk
z)WmbxHPYzeV}PEy@BmRrhdwi+a5Olo2MVcB0D$7|_;l^)XhV`aY-i8qQSUo&S}W!H
zZ!|W#*XMM_vBgpC#FX3qg~5lvb9wB)8n9m&*Y|(!DG~m}!@@DV+qI`raYuQyj+^pW
z#+4468Lc5N(KgX7E12%?%a&QQ0mEiz@rG~_u8uo2jRD?7s=?sGnpML4<}uHp`2ZIz
z8z7ha<%WV<vkW(qvNd&g&bqOH*}xr~&3OU#g&wQjmY<dR;6u2e54QQ(kEn44NqK3%
zT<cuB6NECt5?}_OK4OxauaZQ2>fMX;Hu;2uv;VwW#Jm;S!{;VVHL1?klfXfokLs72
z+32+q21tl+)-Ii3ydP|BUYxOt0&qkUMebCDuu7pnYbwmTQ2GqmmMB4Z6%ML})pos~
zzp=19!q_su(WM&<CE`#loMo&>^4-8MfpdbFE}Lo1t}Kh2KjC-bSzE)i){Tw4SiT5T
z**@ZFaj_ED8T3p2ni#Z)s;9$8Q*X0eS<#}t14wzi{!_E4ZD0lQT*Ld*hmewGkB&;<
zwj)Xf7Y*6&?w@tNKdKfXNpfr|h7-ynvY{7V&lzAkva2vmj28?3A+k06kLwi`w+P$|
zyjnVqEsk&}wQAM$u0=H$C!$`clp>T3O5>r5WjNPS>-FEDM}y!c+jmXzI*XL!r$2H4
zE1G8NtBj9=o?efnz>$GY`;q9s;IMgX)-tmKI>9G9=l`nvD6u=#ApQK~sf54dF$8cT
zD+MFF&WDpWVPoV+RW7uem*Sl#-yG=FdN5Yc(|S--Goz&i0BXPP4msQK#?r~se^A<n
zveNcIMQ+EbfP5FDq7$~K0gLB$&IV0@;#q^R!A~&Onu$#`#&GO2t@f0%!aA}WI%k|N
zX0XVuSr}x*pRT276D3;g;aH@m&U<1JrmP!eD}wuexf6M`#bnbBHNn$6yd=h#IiBFe
zW!4DTWA+}sU+yM3m^2Cq(yUWQ_>ev^79?41zEwgOpHD}{G+Ouw9B4zgO4<T^s*Zxl
zKw&556&oh;Gq+E~xK4mowVK)ADZ*bbtTfK=o1rldz&V-ie{`meLz$jq|7LET!lvtC
zr*BirUD);^5;!)Ea5ZnZ2jH8+lKmt%x6e|K?m{Hd1-Drl3pW#U@#pwe_jc-sw}b3$
zH5O_9kc(8r=+;?hS{BxGoCCP++*4DJUX!1b6G&eQv|u(CIyJRDJK+|j+vt1rk@+{3
z&W)#9qDp=hHF8ow7Lj3PrwN=ouoKT_eY^F6;CbrOOhSeOo9=YBkNS9HW8MtshjfW6
z_P~-vawBa*ap2g6Bq_aU(DV8obKg5~ZGe*FG2#T`q>jz4r7>00r31_(;9wY)QNmK7
z#t2MQz}TY`7E)-Hd0DzS-jr#{$|+g1$1v+ayp8h}modP!Wh8w`VZV$TsdnPeVP>-R
zJ~2iW;JM%anvyMO)kIT<6)8)hsr9P`c*@R8J|Ze{)4)Ks4?(%i&1<{hcAcY6T>bSh
z&-gWaJI&_VT}kQV7XzSu%NI9r5{7YZ7a(a*S0Ba1s$n7`v&N6uX&?O#&fs51v&aOE
z?syk!%6|e`g_*TccQx_cY6F7KSAR$=?+EnLrR5=P<@V`yDToWVjMiTj$T@)FC`9y=
z8g-=m_&1g>a&uS4?m@m8?cHci>VGghHBr(q^Do;|YC)%e;|MV2R=sdp(d>85Sa9!^
zt*rvSy6P8JCVg3mkVeom(d81c*17c_tACz!Ubb&W-+^7h*UULrvT!TY<G2yJvG7jM
z8EU%01YoWb99*egQ`-ADU!fKXNcy(j%fBdf@NwR~**hYsy)Ozk${8qcnlVyKI1)6J
z%IBpG(-w<kHwbw5Z`bDso$YaL%|?+>egqrS{o<}xKS9Xrm?@QA<oU=s@3e>FzgPNd
zAN-;UK`K9WU`un(P*&mm^ef^;N7n+&o7n_6=C%@6w}kHQ09%tWPb<>JR;OKuM7bC)
zI}@(~=(~|Uxuf&81<)Nyn^-DkG$O>NoHq#97V{Eh8~`}E5E&6N`-tJ+2%I=sgE}~f
zty;sEKx5g%j$el;IYvUUchsa(<xVRj6yx&iS;DS@c&u0+yS>ga`ziew_doK!=y++3
zGSf?-FaveW)^a2Bg9v6V|Fr%z;$(t;?@1>O=q)a^w0{&<yZ2-}@iQEmozVfK{;49-
z26<cVYgVN`P&#s|zmwjJ&yc1pnx!hb1qblUUPoK9&5`|ud%?;b-%@2D=T^dM&NPee
zX7*GdH;v;st<fNk&ysV<BV$wLs?vBSK{T*|7EpEg1j{riS#My5X7}%RbhZmE7`lM~
z^N2IyuWugosHlW|BDS^j<W7*S5|z69Wt`tm3jj`9<;hr@kk|H<^6GTVrutS-p~iS)
zg!YUx^0mjlV&L+yz0RsxySBQ-@&@vE-7l48F{N?1FP9lf$gJh`4yb5Q0(`V;iuXX0
zHZVC>$@ix4Ufl&*yEQEy5-y8SxYl`5jw$>+Ei>DyhPdq?ho+90TDZ0>2(eS#AMUE#
zu>iq~00QRplz(Xv;2;e9Xv6qRy)(0PT|cGN>yF)K9UqpkSJ>_SAdVD)ZY|}sE_NV;
zKa&wR3A5oQ8IFJrD$wsw=Di3oJ#Z`<U3`df<4=L{?Svm0E`kPxRbog5yGmX=4hOVb
zc@hHyBgU<Jdq3g8VW%=<t+bUe9;oS^5P%o5ZPOrf%MK!JtLb}louWLxvlO%5_l)_E
z65FV^q$IkW=g~HZbU#5(`MU*qORvL^@hrlO;$LpROEH)Asbkuxt<{!|_bYBNq8F-0
zD=SGC$Ipk9Bw5`2mgOSk$|QdLgN6=>Vh?TSP6r40sCxZhtb#aRp;QCc0Wi&fmfe5B
z^Q~U!SJ|)Fc~iII115(ucZuqKD!sb{DjxgCZ6D%Kai646u_0BjL<C*YiRkQu|BtjF
zgqY(}6;9BhiL5RGQWRTWAU@rb@IS(-tR~f?1M5L-GxH)HfaiNH2KN1UEYhtNRNQKH
zP<IJZKAq2WV;E`CFxdbki|bz|w%nO7;3U+%mV>kss)L`lix*Exi+4G8WK6mcdOP@7
zY1hqlasHCNjN;4AAO4-+oC5W-VCUQnAT-^y&sep(Pvoe*o`r>*Yj|beXcg-|@&6@N
zWAx>PvhE!)H)ZiyQ1iCxEE(w8h*XV!A=Ff0N%>78+dOSsiR=Y{^0+M7C~sL*;2Ij+
z{ud5;tV1j=mUS^`=`u7Xo^>JmAbpq*OAfL669A=Xb0x_9_r`6DZ+oR%bw_k<I?aYL
zWnLIPv$cJ~7ejV8C+TSgm3#T4gCNg%F3&`})Fupnub@|NW<+y3N#2YYVv4BW5@1ap
z2D#+9+xF!#J(vOh)yI#2<U0wMu~H=--*KcLlt%Omsc!jE#Cn`$UpMj-21y9il^xIS
zja8LuaKOCA<3f)2JgxZ4XRqOUhK}dV2k_6I#vj^BuW>|Aoe0lSsvEX250Vd-o@$0E
ztj$*0@h^~MAhF>gm>po2%^G<W!op`|9ibA>%cgh1zGefsA(Iql6noGU?LWN?y>hZU
zZ*+NzJ`g?MUn^r8X@8Yxviz<k@(R*KJnj~c5#U$FZf$N!*LCT5Rv875HIj<MNHw)l
zc&g7B!>y%HoK$H!s2-weC3IFrp;WKa?O2r;B!zT=L;QB0VzIACNHL-=LEcQZ?=}M0
zzGP~UitPam?1%~OQ;NU;?b>a@#_(XTS&(zw?5lKfnsmJvQ^9SOVav5lpm819NWsaU
z;Kk=^axYxYh$+#gT-xwkY|b@{YqI}MpJ?xHkjB_<>H6y1tS6c0jEvbNSe3Yhz>+p0
z9cwN+sum@vM`!1Wh;|W?*8zeBMB<@S#bh9-$I1cz<PSmwtQmhb`@NK(3N{9_6ZYCL
zyJ5Q`vh0zfGiYe~+Nt_Km>n(q=yWH`r=ufWnBxZAKys$)zrn^ZcJTyo$Ufuk*A*5E
z@HXgw3fepbU*z&<cuF|Ck}KmPa1k3Kha+$6a%BAO;Rv`Q4y*e_jxg)uwPq~)85=4E
z<pcx_=l|-UC3N@T2PJ-od!5O56Fr`q%(AKln3QcS)ITQb&S*pR@CEi1{Xh2*$wwTu
z=m52mGwjAlBv{_?w3eE?4GE-&0D*XpC)D}W>~6W_O+e@p_8buBCMP|te8hXHYn+b{
z%_6B!m-JPkw3bDL{egSM>>_-Dh^GedH7j7G!Eh=B>CVu2GX(2*4-$s57?f_kMs2#h
zUM$EJi*dJpsH<FdT(4wyXQtexYBTz<9&0bDR49_$u>G!H;}mJhVJLTdC0Y~sRP@GI
zqIiu$I2FO{9$9Y_KU^O)c(r5BK=k|`-s>nltwWB(k=(X#A@EDU=K?)XT#W*do7rvF
z3=JZ%9;fHgE`BIqI0yP^SU%ZdfN3R7$r=uGzL~+(j*PNy+#sq)v&wB7BT!s>R@7LW
ze-_-hNwK5HB$%`uq0PyuY$JtQlv~^`WiOM&$VtC@RAk%fy3UBP{EOT^$;xoDr9|%K
z8%<3&8V}4RH>fE1<0_mRL4yvEDIw;ipM8P2T-VbBV~e!Wb_m(t2jUN$qM+SqnYu|r
zk#g@h5}p;I<*LE^sLS$_Q$l1OCZ8p@#;hM7BJnYRd%6=6Wg@5R|GIocT7W?I)wF1N
z{6w>==Gh{@PgCdvq6{fo78a8WVveZ&^z?Y<Um96-97xrOTQR%%eq98x;BkXt$2}Ue
zx9*qO)Ey1acE-_7AKK@O0Wv2_B6B1QUgmkJsaKS4lt~~i>35P6lc4l#Fz<77M>fV`
zif;|-`LXmk`vZ`BCykD(pE9AdiRz_19~(yyO~M>*Q-lZuf+sP)UG)6tq1k=4Qe2x#
zPoZ@k4m(^l=fAiJlmNu07`$pR`R;8VHNRA;SIE`XT2no&LrkH^-(|u$?gmGd(wDX(
zMU88}7P{mA#BcjtDY*?b)zH<9h6nh5zAdt(=gFIOGo?2$)<=MBG*jwka$d1o<@c&~
z_Q&V@``G-H5kmPK5R5y=ax}j3uI2~5R3Gu7CaU#^q(SNEw*WUxoC@^bUs^`0;qoV*
zC-0(fA#joyg+bv7CJ;kL(jv6l=!`6M7(E4f|2=dF<GL38fReo>GtPcuE|~+ds>={7
ziidh4__uuJ-wd;BV%PmSWiIkW-UY&u#a^z<iY?Ty--slJNz;s&*;tB@kJQ);m{~Mk
zj2cR%{48(*{#Gv+4~82GSkQ}1{z-UgDZ~8x8keh;nGoY*tO_6ZU5ER9mr<UF5J?+L
z^z_}`bd^%4lfKn{#b=ITT-cr~p)11)1y)<R(gcUjgqviVQJYdWwBtu&#me&8!9v-n
zSHP^DRDBCr&?lPloQy^e^hwqdh{}{xmH7t;K86&a50X0eX5+fKn&7ghBI*3(kImBx
zuE(uMiq^L&kG&_h=3?9w!Sh2_QgRj8xw{9~=C8yKHjdM?$-<I*2<$hiE(?WhiiW>X
z53b5ioyHBO-J9c1(>}OEWTu9VZ6^fXE?ad36-Zo?oU?^xc(1q=<oHUfKSu={J*Nlq
zW{T(mObgZx*|wR8bmK;wB<%naV^IHjPowKXe9Vf}b{<Nw?|#I3JwZV;NTr!BfG1~}
zP%k@ztr{-Zz%Y&JPgLC1zMYwc2%sb}Q5>;TGzHGZ_ZKercYVEm`+(4CRbk!B%H|&J
zZ_j<&rLJ$~TaY+H|I&YbB;k+|_-9bg+6gQJO4xO_#?fNCM7fbx!VU$4o8?<8AMLm=
zxpy($c=Wygmv1p+n|e}BexI&XaM5g<JSlLT5kU8u+P0AYWd+qfC4^gc5Vrp#Yb2Ek
zGDeoRRs&4D>U}zMFS3N>L;257hwoAod8ny%bqxNl;8h4F;`P2uwC?rI;5`@XV&woG
z?3_X)6^V!|lFstN@ugF)^(+$;d(%f^TZ#tSzgP#lgvhk?%Drk*y$8iy#1m+$iFq!8
z_02ZYD#65r(5zgqc34Ayv@)$uo7B<ZXDIoPh_j*KQ;GX`>A0-y9dr>v`V#Wz2oF^{
znF`2)+8_{mXjMI`F$sKR<6q6bX->d-EseQ3w(!)h2g^NxznYc>UIMJ;qTY_@rJg-I
zR{#AIk$h$*!hO=3NqR{0Mi1R_e{Q$NK^V8y*6GsB&#aeE;4J9RbArHrd8Y1%BisJA
zJ_?Rw{|}CJNrrnN(M;I@9JjR+SicJdO1hgluY}hcntUfce){Xv#AHDl!#F@{)u9U9
zBMiSwvy&I~@`vns4l}SX@Mj}Dg2-m1YYk;41~s|E8MJn0^cvX6H^b46zQkcwP0ArR
zI<t*^bzkj@MeCYj43j093c(8z^@~uLLNbF$QS#$1L2F%S!yV`5?^-v0jQ;R`w2nZ!
zc)Bq98)^_j#gj{3J&_I+<pN;-+xqJHuR5(=Lmsw^hL3bJ28acew-w7*s@?)Q?L0B*
z(`$@T`<0?5=L1l>Hcf8oBdLI&t?p}|F7eqo&Vr3v{9vQsRzWYrR1K<yqZS<Tu-2A*
zUTaRQf(dpfy9z+5!?rDZOlv3x0}OkSi2xhVMKAeASHd5Pz&dvD-z&hsT5kb~g?a5y
zbm<tMtdUb%x#P16*+K>#F;1b-W`;Zjo~U4?P+|B<Oz3TVl=z^>VyI(WI#vSW!Q&<t
zQ*=QTU2lnB$M7##8&V$8akCSfDSlHX)~{aG+lQ{s^FxmP<`)=*bL(2ILW2^q*4i)o
zOE=(Mj^p34N-WQ?Bntps@>t1yslsq-KsQPshd*N3`rEmym%4B%GYJG`P;&TCYQXc{
zPX`3BVKW}r$~Ibtz^K4@xLoKw{8=uv0WLUFi>&y663J};D_RddtmunZRJ;!h@3bf$
z%oN(&m6B_;DWwZ*-K2hNZPp2TzcpG$H;~Zs<4E_c-6Sa50lXRh(Z-*DDcO*F8GNaF
zhcb;zq?hu!s$6q++T;3G-8ZoZLLF4~IJ;xmyS~GH_>j)zYkIajx_fqT)mr{Cr8olQ
z5^nkN$;`S8&@-@LKY;`~RCA*|W&>NrBk|fU9)*0f6=Kaq?<&Iiuq1n|)GOhPj>Ovb
zNa1nv&){XG0P#}r_2nVhsyM~T`BDgC3ZOOC&fR&;)zAYz`-_S8eSxzwILuAKF7wCO
zzW$^voII!dz<@?kis<6NVr|>;O^t)Zwg<s^*ON|XYx$lads?|T*3UlcAc?7YnAx^}
zKnU({xRcd0zX^kW^nt-@j;$_t|L4UgpuUdSc^k+B^xBi*Fs1*=WXgWZLq#mPU#{Ke
zg_$nI=YU23+F;07j@Q-?N>pm2#TW(faRMlh271%6TxD5`)>pGRO<0@RN@@t@^!1IX
z=^cN<4SmPThH*WCldjF1kAj|%l_`ORmLb13{Gf<t94<jY;pXGv+SiQpoMM<Jm7PR^
z6%k+r2!L%PkZ+7O=MKPyhLCD1R{b_z4<z+OCu2;Z5X&2=qT^yCppzyH+O2lb^}REe
zQs$1sl1bD|6ivJw#xRm{N(D{d!4?ThIhm2w6H|){B`z2<&k&YH7PlVh27IWi-$oX3
zktV!BpLBmY`3bzaj8ZO{tBfrolo^od7$b~;n(=uX>H9v7XCm4x)WJis!XNH4U*6P7
zW>3ptppjFD5i{~?C~I9ovgLALq<YF&6ej(T(;!TGt-q}e1;65G>T;4zp`$c(6PB5q
z{4lj9O0RTm$*mv7RtsIV4<FV!O{HEgyL326L=39}#X}eKAtgAFAe^y0yfpF9%{q_(
z(uklRckE9|s|r{Y$D?v>{{vv?$(xFe=XNs4WJcOlOu|<aMXk0MnCselg5+r#e%Iv%
z>zI|c#B-~dhH-h-dE074*zNdGQ~76ERQvT863TBBT}MyEzID_%?4pFtxx~I##K0Ee
zRed|_%LfQ`Z*M(@Ze7&6#wh6zVL-(9x-aRpuPb#KcC|rvEH9=z2-T*Y`P~oaar<+;
zzlp9!_q%czM|wmfEXv@+QTaUt11E2!pL4UKVM^1yVDm0fuzyjA6CXCU+hWPD=;LuY
zDnHpF%!JtW)q?e#5Qkdr|KeO2>lg6!X}!A8tuAWROR2&|R>dXa($3GffWqkd?m@H^
zbQ^A_0Fp_{M@Fa#LPpe`1IkIq4676vAx@Uj${$b)ND4^FO2I5fO6w?>;9k5Ozr<re
zP6sqBaf}4zB9v78<?eb6@h<l!KHrRL+k;jAZ-x+W^%t$h901FAx<?P_ikfN?#8mw~
zRUFMAH%=7S83kpb{uH3<RO!Jg`1>}6h~5Q3m*aPX^>a3vp@x=Zrgz<a{_8}2(=dtE
zoT@q_!+65c&J9o2__oZCk_G_s0By0DDfuq$AD0GH)C2HBE9@gMQw%TfyqIzVvnfdk
zbG{n^(h3O~Ps4V5?f7E*SsLc$Ypu}}-jR(^o8VS7X4_?0iW<PcW?nIpN|CVTINzdm
zivo}orD`ugP96!x;?{o={vdBu8}LlPn>Tfctbo+KG+pYZ&ehuyIq4j-!}T4=usW`D
z&Nt^0ggCheGo_XwT=z<Y&|xdAZ|Z5N%2AzfXMx-tA@=Q9!Kyp{y|3T`vjETQcKcoJ
z5GA`!kmQCe02z=K!L=yCc;y?Y`|$yVBT@5a*SW2laP0OtaDxS>n8?1G#I`GicVUWd
zGBae#aisI;Nc~~%`<ItxSRh?C7k`_#y<aZ8s!{N-$*_4qb}E7k3~)L<Z$CeHQcsYd
zlbwIp(>V@F`f8Hu7zr8wgObzV!FtWF$>reNo04-lJ3iq16Z+GlXUQTlO3Djcv4{bQ
zRc>ACw{;*vEExnP#7TZuuEtq}_DeUGk8;@9T5?C|kDtiBpHUEgIxU2EcNW)iIY^r_
zpIuA`M)IiGlrARPs7o6OmS84{*$=fY(|wwa*$gWGhpBH2@|=&F9ox2T?AW$#+xGl-
zY}@vZ?Hzk|Y}+>PJnvg|@2z}DKBQ8qB$Z!xpYC%oCPm>Knjp2C%b$V(<4(6<yqE!?
z^wD&7dj){xyta#j!rBCzwAmi-T7UZO%^@!k%#;b~YP2c-{+#&xuizB~mk<KmA$vzn
zJ|Nq34+k|ZzTljy2h78$HR?>@u?;_ltX{~&#T2V4hBFAC*|1PJ{stBU%ssF^%f_{|
z<J*`{4}yPm6}0`=sc&9a+wGuozoNv1-b4v)mY@OH`~e6=sMf#(g<#|}$0Rf=USGes
zRYvly4aTTcp3LYj#6u<jrb}7+;B#kW4uypk_UT&uyE<B_jV5^eN22ROd$pz)i$}~M
z0XIoGaLZaZ3OaI-VAE19fb~iZ+havdIEPG0mMDaw|3RqCkc~9nlj|2@rt*Z}i-(co
zy?p}M&i8ws{v<XS%|Y@@UcM~6{Y7xxyj!RE;=%At$lY?<yXx>wO*fq{aA8HUcPBC%
z_$h#Y2gfN2gh!5IjZ6B}6tp^HqTDrW+dwImJ%P(cxm`vPRpljnX)!E6Dw-uv?BA6u
zP^I+VnWZ)U{gbw-KY{i#>g~?<bU8Y5K=TBUjDG;v!6Q{}-QN`bkXmD#5WsRjSGZU<
ze5R^lRvl|b3%c$%^z87w#59C0<%fm%k0TAHsWO=(;|{4J@N8V{^aJFQzcSwpeen8^
zKjGQa-$H~>{@G~CBMK(70l2&(L?W*omoT0@B!ZMbOE`|1hst8NL{MO;43;KX^N;{*
zxL2dGD$*5P1+)_s$Jsr}J*nQ`KeH00)rDV@Jig#vuGYqF|8DlXZfQ-Yw@+>aKs0#8
zku1&?YF~^|ZW(l)?}b=WZM8>_f`e=Elc#QL3WVTxCy0iT&H~ga)kwNt;%)LKb5X_`
zJ<UuAs`*!4PcR2JfR>(oL?VvbhBN@{vjpij@3N~RgTIgSXDT<d6uu;c!=5P3MVN6r
z+z>*+A$jj#&*&y43F8K&(gUO<Y8t2Cj|tu0A)6xwe*2~K{lhk|xw)R3WR3P6b`QNM
zaK7dJs*iYz;#>M9&KxPabU`PeVZg>|d(2e*f&Bpb&Zt4^d(*BU+ZqyN-NFy>&p3Aa
z(X?HkJg7}T9F|hI-|)&jWTapBNT~C(G#2B$2H358a~30f*A%j|k)X&*gTZ8>!LMhH
zo3fVnHZ3^>gQxau|At|}b8)xsRXuBHxgwH8MQ)>qa>5k;utcA_ba!`R3}d?%Su9xe
zK}|t3#<GSHp0vA0LCe`rQ6j)B7VN=4%`oQT@jfqEB}j_IoBDG0r-K1J<Vtvgc9~+_
zgJr@sM#(p<4j193h_NObNTPh+D%7?~eKNawBZFV10&ExuXQWuK+0D^$55*Xu&!=jt
zTCu81PK09lp-=B8t3b7{_)9j4Gh;4Em!t>~JMCWjm0OReoC9<(9w~s%&ZI-15k>jz
z-kkT``@Gd%+8v970h7G}&fwTf&J%m&nE^BV+J}QL5a{bXS2#6j#z5#E-0d@E>tyRk
zuAm5m-$J8^s&I+4p&CN|`9(fxw+P&wqf|E7;LP+hZD3d+%=Gc3>W+gz%=EFzkSLcX
z8>};8nXLx~R*}f_AR&M&L17Od*(exe?a}(`oj2rp5-##M8YpIZq<P^#-FS$lVm}uO
z{_ktsr_U2TGYz*Qj>km?%t}vJ56f+6Di1(yCZyhpogf5XaWWO`G<7YGlF*_EdEDrt
z3VU3L*buo&1XB^Yj+`(2yh6kRo+m45qz=%aw_uE3a#sl^z?bkzEMLZ`>%u#2)g{zs
zeNpjMfof)<KwX)zgD3=~o^U&tNpCgKEJE=)0?Pnuk5;Np%e!@Jb(3VZibh&CuNC{J
z{-ryQ-kdG!QGIM~G_Y>N<Hr652kA7Q@;?S^3n}<;S>vi~<^SqjS8P6h&3f-q$!5-l
z>?_9h-}18nuYFau^YR_T1ZW0N9gk7>$qK?H7NJjbUB(Z>uGD)I-O}DR-dbN-!T_)A
zM+jb<)V}^LJRggioA4i-#QT)|d)BSkY0HmS^B%Du@`LHE@0EwT5%Jmi2L6Wax~sRp
zmz_VQc40cj`s_>erkEHBJ1&YY*p{j~w`1&Vpg|2#m5f_<JZ5XvTOo>}aR#ybN9{M=
zE}tsua92ILww~QMudSUd#X?InBn&w8|9B<jfqG#!?TI(99<!a)`R(eiqYMLoU;#8k
zmDyooPb{?QbSq2?OMWi@c+&PLMT|*v)SXs!BALNe2ju!}_TGZ7um_4`MTlHHjD}1M
zC4fYzg3B(uM~zjl1Sw_z>v_yw9XdK09i0&&)k*<3of_lKAK>}IKwYv0nileSckUMY
z%=DdTmZMamd&Ag2ZZ7RSI_-z2W`GvY(@t`5K9x+Nd*US;ku)dGnij7S=7qCg2iDEa
zClN>>t`1P1n1x)!QpWp@*Bo@w!EIe-2vD<qyDsvkBlz5wh`3`FuLw(EjjwG>LM(PL
zU6G$=E^9yRgrB4P-g3or0rB!&ku=(*kNMq$BDwiDavKT2*r>j2@g(pUKWs&Ukogdy
zL}rWSpAxla81KWt_KzuTQb(Jfo8;q&*UNtaGH!+tma(xYgQMGeeuU(-k#LF{6(F)%
z@PX^H);)%RW(TnbcZ-n+p0!J@o#wF$@It3-MZgue^mD^<?y^pCTuaQofeC7Dc8mWl
zZM$ih^;>gN-Yinz$y^I$+>u^PH#ysOmYf&>#X9Z0fSQ`AJE%i?Wcoaq1k#Y_<B-G^
zGO6m2Z`yCl^QPPeKyaqckP~&&1I%MR!A1zJ!e{nO+Z;P=Pn#{3T=YlvF&xbB=rn<v
zA6ut-fCbVo!@Co*;c`nDJwd?%2UkE$lJPWJPId~&gi<u?6~jbXPo_1=y7c2q`}5#0
z`1ylYD^}$h<SrMkkbT60*(NH1|LvR>35Kg<RXn_0S8gUD)0R(&yUMWa1z@BxZfTp~
zHf`uMIsIz;lOm&L#Bc*<_4gh~>=ybaw|?xR;|?}&qbcB!hn_k`^70Tm<Qc)bR<(Iq
znh!}x=Ju&hoy~J#j4Zx>Qh7f(y4eRNT@u%J95D6>J~3`pl6fNET7u%TN0F%_63RVE
z(AGT$w4NPb@RdIR7XkA=3t%ZDADMe#W;H*ZGZQ#t2L*%Kz7XLq7K3cHnq6$bGqv8W
zeD1Gl;NMlTz3dV~*nfPj737DyH?TVDEliolg@##~rG?BcQFEsBrn#$&7#-!gJZzkw
zpAb(*y7n!@za2_kUM099b?}^tnN@yL{!8BIc6J*`bG$hh!tA_#4aj@AW$NX1XPD-?
zDOMD$bP`NSsV*&yis*c^<Xyb$Wb&j5^CXCCu7JlxcR2t^cFlXM_jXa${)S2j3DIa>
z88EMrXRI_MCKhXiyCs4I$50|H#)y6Xo+|b$9pPBf2-I0|KV`*a5;+J@vAmT88q)$+
z00_v-ckPqdoB7^%0oo@IA~<&TBBVdaV*e;ZQ$!D5PT7E=gv-+wh=-U~X^e&@e}J)C
zAMBMe&2inSSO?!kzF-qcbb<ZMNV85O!T*?ppV)B@p_S|KO)Nl74X!W|L?lyYspo>1
zqAK`?o%_uzWzv}E<vi0w#Of)q1R>x|X^LLDYQ)jG?7M^a4xsCto+s69NKLUlH{vFj
zeg2r1N(9bH&?|V25GKu>aZDVvlib+Qwbhf`5U==-)oE!f$-Ma-4l#?;@k&jWT9So}
zu-}nQgnD;qCvh<R3xS^~VSVd_>&tZghgymiZhjYv{X4IlaaSI973GU|agYzR)`}o1
zjnnUf3rn;g8vtq1^>D}a<!ee+mm4A~L&DCO^v&-kgF-}Cua!^Z^!^YbgreAbrR@Q4
zJ1CGgEw%PH8-7x1jrY()w(M^h9)!ibaqL_w97wp^=2q%eYWW$gS?8Koz3SfQoB8V1
zOMVyNV7h7*zXcU($OK{C=hjm;1TCGvxyjxA>_`{>08pUCd$Z(p4<W@aI1;FY0d#9$
zxtle7V5*~WNq*F`jQCW>1J$NDt((2Kw1Ynuszl#gKL^*Z<B@(GT+pkkGybYvB+I)2
zi+F2QzO&~j4pTcNf`xlK#hT-XT!-#rd5^?Q$FDeHo=GJ%7mYfplH*_Wwt+Ov%u|nV
zTaGFA2au08x;jJb=QbEdniyclf6|1=N81S(W3QkTbr&0d!TD?urG`8$=9@(Wv&mVn
zfk?JXaQLRm=G)o0+-RxbW{KgPMS<d*Oo<quQ}`1wB46=I<-$8C%XK05%l&1qePQ*o
z$IHABxcE#%y`Kk1mvjF2(*s_GTgX}G*$@;R8_=SW4?Gy(>E{;myy-u-;RTldGnPR|
z##Kj@W|fcT6>6?jF>_{obtq4gMv^9>SULA+-H?@}`{_K;7<*nGt1^KqeE4UMvu02P
z3i|nFvjA!sgkzFkfO4wQT4F}U!5?K5&J1i+j0voRU_y&gHLSAZGL{-eP}&&u!ZgD~
z6<{ea_k_yRT;X0|f<Wkc)|~#34z7RQyed?G%%AbB?dOe8^(r7K(J3O)Va=1au!B&>
zXdRcUrRukr7nxs2y#}l>0MnF`(UFpYJ|St|Sv9fAYhRu9hzk|Xc<j8bv-mT{=ki@T
znf)tpax;z%3jR_=3IT?8W^j|fm!tKv1hD)pFDQAhG_eH|$(~gAG_}CJ1;i+FDFT1j
zz<!Z^6l?^C=ZS}{N!6fV>R`f>3VcLu9|MI!hBZpL{vncXBAmWVAgs(F8x3YPl9D1&
zJfr^3WVG_bCv)aF182Q-?T{B8hl+g01RkOWu${>%$;S!KJG^x<U$LHh{`oow06Hhh
z4+$7Ur(znE0|o!IdJ6FOr2%xbIfgJn(Uh(K7<TeZ#|c6<@~tEmfIe7-BbDQ9-^CS7
z<SLIWG)+pWrN(Hti}0-d$(rq;%^n$2vT`OTgdzH;UUEcEVNX({5_q0}**_l(-lTuy
zN?i}lDyC{V2t@^g@=Je@O*_A16F{GhRX%JRGdev{t6Igp>~rwf6+^?Z*?#&T@;6Tq
zVE9d|8gAZO+V(sq_ns=7UWI|MM*;6M(aYF)7OvJ*WDdq#FKPfcnIyxn9*TMvx;=28
z6t7N}ct1}4kJ-R@xkD19r`ahta!E!1Vzqit5bJp3k`qD3qkR*h8ZE5L3IN$jnTSC#
zX?)AW4LuaoG%`b%LCUn7xuVw&XS@9HW-RDJwg@{`ir3k+X<SmR%o@_U_)CsHiO>fk
zmCKN}PIVu;rkC_$m*4<<rk-wG2qciBK#?56@2RIpux3?dOToGnIIgdJfZ(0~eHQNw
z-&pC|<;Kr$-uN27e}dLf3xJsHH$r*B#=eUqX@#}cBtql>EKb^>^OeRzT3x+{hJrn;
za8Dh@Uy=A{JGj8^sY0$Jbu}#2e4laOAL8i{k#r6p=Q(#hAYezcl5Nk?xslPU2oVuT
zC()JU<qz_*<)K2p_VRe1q%>zg3ow0FpFjwVmJ`!F8QPFk<WK}52;f|CV0Nt%p{4ha
z>p3*SD%fxpfr(cw5A|q#Nw&xP;y@;f_AGuEX;hxQoH{C0*}kv50>005RlADeQG}|K
zAZ)8ZX0^>>gBl-Yb5sXQ>+nX9GLbHIS{i0r@hZtq2M&%MCxo|2I;#QvD>DRp%5Ozm
z$#I$Bw2~~D@vxF`Du7$Fnt?cHcx>Acg}*h^)9cY$W;S)PmWKB7lr|fddMc_PxQ2{h
zrGCOWEYQ`xSof+W&7;-|n6?YW7wf7}Q6ZJvH^N%zx^T&5de9#SB!9LZ97@*jzUF8E
zlp#A=s|X3<e8&um;ReHwRx@1rn}x^6wqdDUv%Z5q2cxz@3_zeVt=jy2{~+iFxHKdb
zqEXFf+M#%m-!~=T$87w%^9l34_Bt<8*&KA1p%|S@c_CVbISOs1`mfgf%{{c1f0Vb`
zxk71GvGvKbu~%N6DEhBdR2X-D$yLxaWWM0V-_q^!lCxq3JDp3VlY|2d?Od?3>S1Dy
zndKlO5Lvr4bine+P^2?EL0Mp%e~gVo7+8Pv(xHTu#CfzJ@{R9rH<z!yLBLrhBS)OK
zQKh3vaZvF;_}gbh<TQj-S|ea7r|Z(XKT9oFS4%e3k&kqNsQrN*sWA+?7lpdXwo+0p
z925}p#Y^3^d-*PkJLT&kO<ZBUKK`a<I=O9-)B%F*R{*zB%nLybeBU5*CaxCml7$*f
zVW^e{YSfjf{0}Ww|EEME4GzFo@Wyir=xW0Gb<hcpkD82yIw1^HBJI)<t^F#9qzY&{
z+27ym>;f>LRxLK*y6<PijH;9U#Itsq-7FL)9=t`?;)@>;@pBcK1{UjKYO56ewJG}p
z`(&?dUx1=!(*tI;q4W7sSLX8V3)Y4}*V(WmRYnSJ>o;-AA)PABg!?6m!zM=p#zKP(
z1b4la@j$(wAFOv%8$o3|bp2zI@~PtJOaB-&b+0r8x?>J2fuNV^fHRDzJZzX4VP?_q
zp%EKShpB0fHHH?mMm+aT$@q{;C6oMNP3yx+N8V&ZKu|`+ovj0>OC(bVvLE?6Nni?P
zFay&bnc=dNCZC#ZXW}9qYN~qEMTs~G&bt&%&Zlu9^e4|jeqNH$l_hjR991>MZ&>`-
zq=qXg5apw!&ntD1NTx=$YXC67(b#8UWOhiW^RS22AE%dGAYio+o#MGS&frVZeR5t~
z^HKMiU_q~i7`3fzi<}>qoPxpBxWOc2rY~-N+2cG{>0H{Z7iAvEGT<WSkp9EXM0;yE
zqT8D&!UL>pxdpdl9Gnzs-eV;qsZ*L`=Spy1EpUE3>q1MOtM*)RIWiAm?}jIvoe)N~
z*sld7AqiE&pOog54njg^_D9DvqTNIidpCL35-(YLQIlFEJT!R&dgt4^-cy~I>aDZW
zvllZlq}8V3FYp5@S9|>GPNhh;#8cd5osPbQ@ZML$IMM~X<L>nzCk<M^LH^-|n}L}E
z{BY*qW@_U}koQA2AG>~l1wYEzo&E^3EWH{T<>;mGbzbYrN5m!x)?OtW(FXmjUygUt
z)aK)x;}K;J?oC&t<aEfkBmuv+kMy9j$ZFE{ph)%3MH*)a#7Knhsc1abo_k_pqIFZp
z)nb`9s29AXS>(`2@q>9HIK}9oyuGOy2nd2FV&MaOYO)613?AtKZa11U(O0^N@sOFn
z73)fDsD;OKYhou08aWi<E4L9<WiHoSnXHW*R6VQvTP7@Vt?JgzUQ9xB&+|<n4D+ym
zvn#pfctm_OTe-GZLjq1^vJmhJ-6E{&_CxMRMcF%dbLG}5r(!AoU62>kf%AVTxU&SL
zeR#lADy%>th9dL=zHv8pa3^{yMc(a4Zq-x12aVB@<n<Pdo*{Ju|DA>G?Dy#3aLN3I
zF~C;q>-aNb`}=j0yaq`%MrkREsPp4Mhxq{DrK<I~{VyqbB&KNXJtnnrP@CYd;C*N>
zJ@7({6%$2cvWc8@cFqxzL{WBri}(5&<|N3y=!dy_4>I370Ic#pz={vFW93{HfJ1Sb
zg>hIp`}}XJwRqe@!Y#uv7b2y?wPtOEghiozo`FvNmX+W}j38iVUw25sD@cr9C5CxQ
z9%bsgB|2dFu<m|Byad>L3PpMKUk3<-*H)kUn+lx|JwFV|gY;#go1R@ujbI5-71pMg
zwhDVyrVtqTPr66?eE*RW#R_SZdM=G7432MJVx&(5?dyZp4<|Iz!O^U094BLfB#r);
zs})iejK~Tr!Zi-Wej*#Dx`KQ^($CcHg%5zJzH{3PD1Ch5+UO9&ZD_-H&zW;39>h+0
zepZ(+ok@BE{U5S{Iod{{5Axdep*m+xejeK4A_!4SKrU?!c25mMo_y+wl10D=RZfb{
zcs<qKeoFodiAgnn#f`9!()(n4sWx?*=*D3<=pafR*jTydR_(7?cF>(n>>8<E(&?aV
zW)4b81X<DF;xP^v3wCiU%-hvZCKgUpp2ew0FJ-r8ql!e4CXn{=tz7Qu_Ek(?Y8+FP
z{DzAjfc=4t?0-2+YU`mG^@H|VL5oSow>Rj1FDO0*o-47q+g}8`eF%u|^(IyoWDg?l
zRGD%L>Fu0Te*<_>@RIia2|lz4)*U(*IVIMEj8zv;rJ7}M%c^t8hG8|qBe>Xzs+xdR
z@X*RQUnA+!q)aq>4*I|#%ob#kt~m2$z<cEy0jzRoPpuhXIMUl5G2)jvzo4^%*{8aU
zPR+;eD<|)fTBeHXk?w3OSA45Pb^G=qd$tpCC@@?d<hn8NOpu+My<cyS8s|DFnystc
zoaFe`02-s;Dh!N7r)4F+fAl$4L$<4qImXdni@ZJ~bOFlYHkxq)J|(&$&o1I1AE8<E
zfE^2owl^xoO(0h{LlG^7(3`=q+Tk>p67P}&smmngcL(KKeT~n&asPJJnq+l3V$7IZ
z@675@4}n&9m0HW)c4tHvJPOpX>_LJfopq}Vqn>txBhTN7cR<bdh{bpBMaHX-#y!}Z
zB#(lL!}s`&R+NfqO%HY5Gj82ajzBmAfUh7cXG^#YwNG)v1B<DbjHX7pqO4=^-FC69
zWb4}-OOvaCR-lehj-ep(@UiFd+4sFt8jP(yV`#{mO%|j`$VuvW!&sgO+46B!SoOS*
z@oL3;>Pt@Ck@6DJ%`OJ!)4mNW9X6t~zkg2EQ%v!#MMwo6`#!|exZ+GSX?!h60q7?T
zAtlDyceI1R(*7fpHFB?ReyjKSRSSscVYpMj!@=VnJ-Ys=sH814?4#(O=<Rw(93w`e
zBV?52RRPB0isl<fbKg+vkunfN$jZyr9BPJVvxX0cELw{uIGtUF^r@3F-JEB+^JD@V
zh~ffVO56S#{2F~7l5ke5%KbNF2`H*J;9XaJ&czbyRQ)<G^{N1RGVenUzY)b^j#f9M
zD<8bsXmQ6GaB+^t5*O%}+-+ZbcRp;Z|J4x`N7@l0?4hY?9;H6rF`*t~sACx6t{Zyk
z*10&|G2qYL0*2e2zZ~D@6J2pd0uB~faTVI38D?T?sfHh$P_XPVLs=Jt4ghXhih!GH
zoF4+V+Z>ID%sKh}2N^pN+krKKxB|)Ztm9C}nzs6<UAi<Sfj)-l>A~O8K&l+FJzJq<
zc@)(_{E{SaFJz?-w2(IS2RY+#SP@;Uy-Y2?crT{G=1|?fbcsqFJrhwCeb;|nWf-zm
z1O6kA<u}Xvv}t5K61}tNqkv$&Fc#`#?jU%IJ6j3}gI~B2{vP4_7V7`V*|3D>r!h;<
zr|ByBZxz6GK-WtTgWYO2rS8H7Oo@tQyXZH)2ATceX<3VG(`4-@ZkBqJNWX9BPhyuY
zJL1}e*^Y7M#4Hu>47p=h8D}s@lwtiAjaNb@CgovuleEsn1O7!%#R5uk?1_exhVjux
zMjcT7X(3-@x<3zNKG-KTk$J;EQsH_dW`aFl{YEIdNGQ3j#B~VWEqAvUSo*%5{Jc<4
z^U~lLVZ#I*km6TXOmaKNnIeQTT#YGPo=EKky!f`dj>h))K4PsDpGrIZ%T_tfG|zCz
zp>u~%Rv~<KZCWlpo&dB*clxz3X@~cNb`EFVax7Ih^pSjtY9KSnQBPA23lx<#_fjx3
zOrhn`(z}d)Rs+#))iSaJGT}6JxECR3@h#T#yk6#veVBMJHv)1|fZXqz-Gc}&R|t`?
z?QeK{N3^=yvzeZAT`RR$g?yuWWOSllBjWfhY-$lar7MD?QouArANGbMC6!QVEX9n?
zR`oDa@z{rW%-*1&3==XT{ZmS~1j=bI1FYzw7l+RBxLK9Ayfx<IGV5$H@Y=+=ezOnX
zj>f9MpG%E{zH90c)kd{WOFg#QniTa*M&(!#MR}CrQq(HTAtY#u(MX_>^n}*xoZ)ER
zicI;P45)4zEWoIY_8OfK_BE85Bu+qC$h-9rF`5+%U1~A%#-!T?-v-<N+j=r*rjTvh
zYm64_7c73TfYK$#+Ip!GPvvfWfHhb6$KTw@xR2&ESWov&-)@5EDWCdqIG>4|0zX<f
z*Li9%pMOMR7cgQ?dbM<v5hQbe8D@W5uLHFI-3)*MWA92pm_wN!?J*W7PoVza5+ox6
z7d9lgHy;xHAtK=h<|<wsRP+Fpby?Dc-#=4-!RQ?xpJz~rA#h8_&d&A(TM5S)8}?I6
z3_G5;a6z0s(&n~xU*+|&+&Loe@hyM~ea!pf6oZ3lB4x*u=-53e+vtorKvt;ZLL>V<
zx5N#m*z8B&X&8BrCqMm6hZ&3iJ!B!b+^2vj0A^C=dXMde=jCfgK<IK8Rl{#u=J`_c
zmw}1Fz6#-TGxbVW|40KcdBZY?Gq)z)#GYBuoFHLCnl}2PL&ieZz=5n)du$myEsObr
z8DX`YO|oHZ#xpfp-D6!2;4^2#zU7gKot9o4NSVu5CQ<^^!Nw$Dlui4vv4mvi6|0MK
zq$Q9=K1R@ZkU}^@u>#pFaN0iKEW^(eY}C?_&6yms-oH7y*-;d1lQ)3z{j?fc_^|JK
zw-_2ojCWuB+k|c9^_uxZ)Gh7Qo}*^&$@W{ae`m|h@SOJT*)BB#enCwnQPyF}OF}ed
zhKqzOhrq?$;IsA<&pYshauQsM@vnJsgSUEw+I06=0|E<)4$<=68V@M-ZMY&3#i-e}
z_JxwD<j#*ico7qDf~=g7jcZYs^`%62`Jxbr49_?hKqlXf=GrlIt92P7ID;-9&Nbc%
zp&L%JmcDjDuU=aK%hRCq7g*5!n*#dNP_LrF2JOBt1R(|=6JTBPX#nR5`?G$=Vl<w+
zI9kZ&M4g2c{{z@y3ywL6(VSC{_{T~gz3gLFt~<6lqg|3#cSSmU=y^gzoKdHPc$o$*
zszDvcHsUunk(wIDtm?Sp8eQ6En-T;&ycz+!W?V74_}|QcO9k&Y>yPpCiIGn>e*X_=
ze<wYNzx=etPV<#QA#W*J1SwMq)>S?E4)*QdnvB#WC?sLKJ=G$jUG%j0<_6F77&$xt
zv+8FQHeqF`Ve@_Jn{6afE@NJhw6_~)yFOtalRdr7m5ox7=oD{)74x7QgL31u;{N~w
ze}p;?0YD1_LrTZ*{2pcsq%gTahzh|MKfA(U56%p%U;FZuSGZerW*Y+Jf1IG_qIZ6w
zrln=J`biNyo^-8exBW#nId6;(#*01KqIMNASgMzO=1n{hSoqrE*vskwd8Mwm_-+yQ
zbQ!J*A%xqW;yYAJHa0UDjcwKM>?t3L$`!Z^hyy_4q_<QHEoLvrOyA$U$erR<D_nwD
z>AhT@jt<Q1l7a$Fft5O^UyNDExRg)TW?c}<1Ph6b-mEuXnlLaxx1BT~R?1!5U2ew@
zz@Ey3d(w-JK_{-TSHn|n49!qVr*lZA^LOrSBEn?tJT#h)p86dEjZycdM=pmL$zrJ<
zj{%yV9r@m+zbDb?F383%6l2Xe$8InLyTIIucmIlnNZzepiFciD+{CWLn&I%l6b+~b
zHG(ztPs=Fiu?lAZ)x66p(&6QAY%ovAmGN1-!YH_+iQ~^~P_DDP%?Czr9ZO6FkV(Yp
zN@weCwL45Pcrd!sTMiv{JN4q8S{*+!F#;4JrBtxc4U0&@k>l6m=huR2TJj8IL%Y1O
za1v2~CMfjg@ejCAOeZ;{HH|p;hH!m)8+mU7dFyR>ow$D(5~gQWZ_gX!JWbaP&8G(X
zTl=-5+!6aQ%yBH0I?&6+W6%IqB(kFlMf6tV$;oHm#-0ZvJ8&P?de~6^tWaR$89+|(
z!2dvr<g!UL@LsW8RG145B<r_fu_%Jm=1B7n3W^m$$tz|VnevTOvSgujvDO*7W3%5B
z6TMcut(p;Gay*LRG3QE{5XnN9GCxR-lk|MDhuD1nWfqPc>xjq@XkmiI{Z058%O_s<
zbUjEzU%!5(GKotZDY*gxFw0<!CZKIsaxBRqJc|r?W&b@+8>!i_4I`SDWb#(Ah#w8D
zx*So7ki<T9F034Ud0XPOX{X{+b1nZSza`H*mFpm<ZJ@EggDL1TxT(^M#XYRKvbG~O
z3ewmVRz*^BhxKF>%ojMEa6+@?7<8brIj6tXriC=lXT245s;yoXUQE*W01#YaO%-5F
zj7_IDpv;z>t63R3h(gU!rwV^+wck(KqRd8?*F;FRt=u0{9GD1!`iCh$x@{H2o++PB
zSr8lbk0PvbAo`ieApF??{xCd+=4CNPG)Er|wsl{0akUbxIoTyfkCWtteF1JPo8#G!
zhaNU>G^A16Jxb7>SO<P80$}<t2*te0sK>T}ENIob-?XaWVFQKs4=<-&B`-T!QT3`T
zPr^v(LvmfHdV$ZzoxS+h*u{%r{4e%m0^q`iJ98nD*KlEehb#Lyuw-YOQ8iW8>YX&J
z&h~s}r*2<G26VAt&q}=mULfhP_b_x~9$Lb&_Une0Be=ABDk={>ML;M4p^_pD7!Zs!
zS~3+?NPeKzDRlMOz?7^z1aoeKB(o$lF&gNbd#<1W6(PaJ{Q@@iMTDC;u56HxuOiK&
z4T&%Y-=(1Nuc_uuUQICFmWLJ{t!clwrcE-kPmL)uaxKp`exV}cvgk+-%C{&*%)kQ@
zK_YM;uwoHlL%HI=ZGgT^Nn{|TMhPHmA*CjwCn!O`@HQd8Hk&slFY<6PfX;(YgyKVt
z+FzXk4h+9{9!eRp&9w<|-d<9+79^Qw@j+$_wj|H<nDn%TADOj#>odq&sH>|QC-fAF
zsoM)*IuPbruFZ?dfD<lt$;UO^i2ryD)UHY-E0Kbk>eBIq8$h8$%X?f0t2dR&%oHD_
z!cb>YIZjBZ=Cg3I?Ngj~Sspu1XaAxyp47vQ#pEgviKuG5E#laBV%A5yp^m@SNxyjr
zogFK2VMFi2iM2gbG3!Fm_#t-{`+4@aiA{nv=Ct;qcGF{0KF&O^Irbh(3Cg_^;^?Vz
zmPmMa+qjDU2C(eK5^FHILVs81cOc1mtkekozResVr#H6LxX?#BW(}@Aikc!gtoRPy
zGLYg&k%TGgH$&Y8R)5>y@~??Ivk&QSZ@9n+`6%dRCPv6VWn8%){6=7^_16}wmDurv
zKEY<ikggmc$L0Us=2~q2CF&?&AHBtG6Q)c@3InXI?9Z+23bFN)G@I=Fi!Nqz7o%JF
zFMg|Sl~o3muH(w9j48gXO~e#CUi(5mDDNz=%-c@+IejxNJjkauIGBe?{N&DSpHn>&
z4*(>wDJ6(~ti?VI^NRuSPE&9^%EFfqfQDXNZguaGt`+$dVoIq2*R?P5FC4>SJ&u!!
zJb=k@J*72z?(Y``td-D=F+axGb*fN)6CV60#R^BJ@A{s%egYeuO~Uq5xu*3>`D>oc
z&6aYJ>-S1#(-o7fA%vjVr52-mBO4am*O_oL|380J=`>`7-+mb?bWQ&Pl0ZW$>@>d%
z-o#QCgcW)Cm4VTQOFAb8Y`7RFT_Qp}-vPi5NS!7hk`mS0@`yqxWlo|bXbBB{dX9Gv
zQ0o9+zOxB%Nt^JJ5>_#|A$`ufaF*YLaQR1MOjzz<J%ccd?TMk}Q)$i=@hS<=GS~d|
zBIHP9*+q)IMr4yz?#mu-VIQpzlRA#}$HMjnV_*epb$&5{%k>GOQs~jg+_Bv6Jrz*#
z(Akaro<CdEddS1_Bv*S=Kc^S_;gYf)6jF2R^EI+^P3(7#<QHZGSEty<$cLqpF@tOw
zts`#Y(NOuje7?~nQQ{Hz@D|c%<yz!q#U1N>eFNmt`}?-^&wRa^yZs_eosA>ppK}ZM
zkP4ZoFp@TsS5ac1T`|t}%3bTc-Y@_TRbGwN6q~tCSjnfhmZ%y`mWts>oa$^q)wh>0
zfe4KfJ?7yw%XqK)RxJmG^Gryuv+kAvCjx40-^dVVtg={6nifS<mf48QH4dBqrzgA2
zzKIj3%)uU`-}MmcZlxYmsGqgfr6H;Jpfri57E<r?!H_tSR&Efc2nzP}Gdf@scJLu%
zsR^>Fx`Ny4ywXlY!+}D}t?_ekTFuWq%(}(uugSJ<T>lJ295#<VcGrtx{R|&N>JuUj
zt8lA-9l%u)7PX^qL<6aVSL>AQ-bM=sy6dO)OQ6<IJjbx?%CDj&*+pSt%7Q+QCOGWH
zHFgjKa0|yuEi~{efIfaLD;Qu^rR+od(Bc)2_0IcKg>6v?WFeMkQgC~VIjf!4-mC2t
zoDM}ets>2Blz>Qm&7bFAfzS(O4a=*e8-I!JH2$`c3lVT(riT$=cVaKO3Bsk!o4T%e
zyM5P@=i%Kr8Mn#Jq|Mu!R1myVmCxOvHxJ9X87&<>Wr}gG#x2Qivj(gQC`U?wRCDMq
znvW^C;HQU;3te(Lxj1;QlWr2JOyrQ`&l+Oo#diZClSy6X=zVa}i?tC=dWkTI2>d;q
zwCN+o<VL+VY`F_`>anaG>X<OJTdbA2bDlcbs~k;D54`ejbGB}&NtsZ8%wAwP8+S)&
zJ-2Ih_VRL)%A`*m69Ft*;3~g$6%S5om=K)esZPYO9GfMet8;p*FB#7{3}yp|?RM4|
zMy5vcNPPx2G1QEeon6DUe-+19omqr@==1d|jSiXVwTmXSi%n1?{Alh<O358RE`0ZJ
z!Sp74m!0D#R=?Xt&Wu;Y8ncfMEAvdpW|Y_TrI4<Fe;}No^Z@_(t5Oq8@(lm0`easW
z*K*WmVOG};6E04uH$FPu3BCL_$lP@CCnbN{t%CCf^__ye)_7SKUuFfpRkeX!WG(Q7
za5i)67L=DP^7b#GYkVWRUl=bDKQv?|8q!Jka~A#;<Ty7zg{D`PgHV6UVO_y}s<LjL
z2`62hV<8Ry1ZZD5gz2aTGY00M_Lak<jVT&8Vul;J#+9%LqxCxD+e}!R@jV$P?|KVy
zHu1;a<4r`uXQ|=AB*TG1*zed~Xwg9hdE=wSxNwj$`iyv?h&>RbM>aT1kJaf<BKh#L
z55V6SXCc;!Rn@Oad7t)l`AGc$Yspei-}vVDf88IM1SG?Gx!dAA6Gc+s_9a0N>o7ku
ztUNQy4c0&1cGsvr(H5AuEKsb7==$)O1x9o$#=)zaB!g?z^Br<bCgid0Tj<l<DL9iJ
z<*Gk#r~Qj%Uo+;Uh%bQZGVE(}Ig#OqO?)}eyS_^wY1kWRxvFQ<rl|IPc$R>^5C=*7
zmAo5S2%s9rgib$IQy{B^qcvEyOb;}X{*FQ%x=egyNEf7}Um}?XmMOyoyX<h4Lg?Go
zkxL(qqf2IFF{W2w!JCx*uo!PvnV<1TjTCj{AHQ2~M><dR0MB529E{Qwo=+5BHty%S
zMR}RpAzv$^rIAi;42g^}uIA4YB6c?6ZEY{o12p4WuQStICSV>Fqu}$bz(~^=_0o8!
z%^d0v?3m5s`r^Hd!8UG4Zr*Y$iFBpp^#g^i;D|1t4Gr%aVLd`zU)aWZZV+t{?Xp{P
zG`vsaykDc6v5u226$g2AQIjx-O&h*gA5`5;#5opQc-0!HwHkq;cMf*4yzQ5&iYMnA
z10*FHAv?IWh3A7)NxY~Kc4La(gzBAxyXse)qNe6&dG0_iABlN#-BT;nlF;M_d{b+c
zW<DAKT1d`k>BT0_H20m0Pn$IGi_}=9_D=^QvMi<V_Q9C!RvLpXZ<0a-axso+jW<YQ
z+&LWbJLyT(B=i9L7L3X2)syHNPHLSaz*nadl;aRND_CT+2(%*8na!}D2CKRD!T1CL
zD>5BgA`dm$_i?GWm!2>eHHG_=>rcdLv|_YkGF$2FX9CZ!LT77(b63|6xGI7a>6qt&
z?z<q5c(ox)h~boMO3KZ`oqk>fJ{p45O5B{`aB<SPXN>4!m`V~MwOL0d!6IZXKniZm
zqCkQis=?b<c`ZZwEJ+L@oSz{TnF<Bj_sc@p+x5G7RX`z&mlBtOtU9j5;epQ#12AMT
ztfFLL`~wDgZ#-}33#wRg+ex1!a6_d6Y<1N68l|avK*l0d&J(G#t?YX?Mr?P-Yakvi
z%TMbCwo<>;Jd-{=aewqQg9J4bz?$)^)}q@rabx7fA0z@HeKGy1Z2b-0JdTtJT2nRV
zTbC^6u-Iw;h3O6YfqKZ1p?&R>^p_p{gB51KsD*xWXqddFln%SBw{wPAft+}_gF!PA
z9u8;g6+^a@qjqEXP4w`$usTSZruGYBnGR9T?gfTvMh2DIy}97}?wZnbfMwxTYJ_)(
ztV7>n$fv*A_s(c_Fo4y{kS8%%%A}9i5^>qs!LzuD^xgu-UYTuZ?bujqkqov0q>S;-
z)+$y6zR*TtCPg&Jsm{*LQl*e9xLaivU#BNjsSNy%a#wO5Zn1#<x{C#i`{Mc@OBjG+
zpH?{?pFl4=+H8fi5>s^yNN#0A_9^&n`CJE0FXO!R0`!G5Or^jYxjs#{-<cXHvY#NW
zEKfe`XTNbJhr*_5Fm9~YN_xi;N3zGx|4>(qjkC)K`l`3ZFmoAhNy;-aIxW;7z)wri
z!zd&8q|L!Y1C;T*b(SfJL>~f!bBdmM1kn$+;*S2M;gX%aqbw%{5P!|jp+mj;C7Wxy
zVb6aveu+UsEWEO&5*S}6kAxDhB<;R^917zY6zp8_X2FewY`<Zl|4$(iJ<;jW5=u7l
zE;jgMFQtqaB-j|?Ap9V8<F4v25_rTak(K%`i?$krg6^iT6s&@z)w*{xYek=sbTZr7
z*<dO!gOb$5>ARXYAi9`$S0b(zYPzGyv6*4f?rcbi2yFT*H6xJfSgIoZ{kt~wHe5mU
zgap%g_Jl+N^R-kGR_|bJ4!L6#{5P210ZJvx>kGKv0SODFGg!x{2NwAMoMr9>qIUqY
zLqtA~<Hpu8x(_1BkNJAKnF<+ZlGqV0?6{Y@joWIYT?z=VRAMAdqeXEntwDfz3&%vA
z{+mG=gNyaNgpXtQ1K=<6+OJ{v7yw_IIaVNx9QBSU>ckYXDgsMnAPPApF;MKYzers7
z2le^l2YH0C69rd1(PPLaVDZ&9Lkrz|*KYfKu}?}xRG*k!mq_rZ2u{u{^-cqWoAHcx
zV<}pTZ~;^sa?+<>Quq<JNAj1r_DJ@Mg}4W95^DwU-dmN3=9h;Z!%H&x?TQ9$3j~)c
zL0Wo-W?GY7EbqWc<KGfgf+QPBhQ!>_p=~KpH;#?YUNZGBJ-UBrS+zOWYM}XJiy5#g
z1Z?n+6B2xS|H-4%ywIjvrUsG`p+SRTbmKsuR01w_8yd-*EstT7oGmca@?OfaRpfEN
zEi3oEuhwekf?DBCWXn#SCVIQULDR&Bw1X|Ls~E}H^eV~3=1}4v*+@NfB5mCm3a2%B
zFy3OzJLIz^V0x%ER#!xusR{syYB{_t?J7i=q5OOQT-hev!>tte$`uv_#hO~8<K>ZG
z&j6)%+CO?}?s!IdJ^%<9oiiW-kl4Uk98g3t7$<JMN%v}H-)YQjE+gA0Qe4m0yrG4M
zzmS;c!w(;{WE5szU43>AL>iF;Qg+<k7&XcQ8Znb{%(BGR@uLpl9gG6XKl>a^$$4SG
z6gA6Kpl=(VOV*U9%jyRhMO)G^QL$k=0J{@ONzI~|)1PNXa?toz=v|G%fk`)|V&U+_
zNRRFNrE8TAS_rD^1w+dvE%Tb$7Q&IB+HGU=wtBQ_)n{B4dJ8G-rE!oYf^EtSjEoFY
zjbbdXP8e#ynXSiCM^y<R0kQ7LYhsp|-PqA?7lpy5-hce{@BTjvjn0(zqpm-_yS5|S
zV%Zsbdk@eKzrjLQOsR5Sh+ICK#U5fB!7rLf<>%{szc#)EON53VrI*DQ>+H!7$mMiC
zmKM@>`X4-%c2m6yZc=`}YO%=Te1Uoq`;9x<m3V;;FkPE5e6s%c8k4*dR+}$N4{C7V
z_m2M6+}?gyqs>#E3q5q=)sI%HPefU)#Mi6*Gbt<H%lc5c$hi(XeowZ^6Efo~Q;5^*
z(C}jcl>976ez#=pG@4TNvBIv34`!e}`#%izAB1{qwJ=pU`CsP)ArV39ji7Bduc;D%
zr=kohx95<Xjk~f4qXUD78WNE#LQ(QRk(F8$2qxmEgP6G{bK;nM(pcW4e3tZ(P^3^~
zMtQElb+^Bg5D9d=B*;v4R=}La@EfE4bVOQM;xDQ!Q@aDRgF`L-o{rZ<6#b+2y3vWz
z37)YD`d%A7nl`Tfz9(8KBQX%c6nTISO`1<iJ1yfdi4O`0+G0?Uv!8*wUSK6z3!i)(
zjZ~Bome5^qK8=uCAOxSZky6P`8y`Q;169aSLchJ%)_sw=fKt`p>q1rWiY^^xY&(<W
zajKNo0HObOn9Q#{j1rhQ`CBb=_%LA?7YEw0AFd!lpOw{<dbu3sb>(Z=03mUTOQioQ
zjtSZE*}l#V_))}vYu4bKFVj<}etkY3#w7Aa7($d%k&y_`^F~w&k_~Y)I{wkiHqae6
z)S>@X*oC&okmhW~{8BQ6-1yTyCFU&O{(tzX`Ff>@&*bQ`oK5KgB>A*_6=7><Lgl$H
z&X_)0i3=Sj;(vI;5P$=TKTjNf6t27F@4+y)wJaTWXaXIdS{dM~M71CCZDrE55X}+O
zkFzjS8Z~>A4`*0`ff$ESh4MF%GE}?n&1l5hs^VtB0SUxj^M|;{DZ;?r(9iS2_{liu
zpqC*F=(S$EGv(;Mgd`)qT8a0Zn?OYW`-MH>-HoFwJZj;5065!g6mGjxtC4(ECbk$i
zz^vvrO3d;7iS^KEfKxDj8MpFp`KoI#&nFIEX4M63kxI%2N+l9uhdiTYAZ@m_hQEil
zQeu11LEE4wLQUmw3!;&lMK~qlQbOQ81gwl)z2WLJ?6jM3hXAZ%2YP1njso{}Mf;|^
zoEZ8xavvr=08(~Oi*~26A3?G&^g=uAOng`P_2rcc0UA&TvmuwGvXy#RTK97Ew)|kj
zIg;k?pB2pDb8xX_S!*IIeK8p8c7~ATC1EOW&x$6khH!-@5KP=rJC;8=c6->&?5v+V
zv*n7#idMNM6M?W{#JstHDEI3HFGpaE0)EH3O6PP0NE`<~5(Ppb^`SQNkN~}G&2p1M
zg|z1Ym@z0yK+otIpzKL7{>YEr3qMpW7UfDCdX##<ZnrdM{6LeLhs@T;FihV!kS@=$
zgR7N+=yWI_`y+n_1>1RN4EOZZC$OXGOZO0~0NsED@G$Zohp#be7|Usj#kt+xQt_TH
zDKRF%!~E!cZuZL@oV#vjzQtV8@(7xxNTOL7#WS(r3dg97Q8Ml1kdYX*`qMed-i(bo
zBQ=JCfM_JTd!iG;RDp;f!)v;C{(sP>pYUmp|K)xQbgNBg0Pl$)!WtDdbhAHP=jmQV
z9+dG*10D<MN+QPSJD}U>7jtSDxbr7x(>-ADry^<vIlW`&o;b&S(O&VGFRiB|F=nNX
zo%+hFl%KEd6`*r-rz}y86}FVJt$~127Qp7j_){v>;cT)8P6pYv{w#2FHoSOvOWMmg
z=bCG?S~PTqui!Y39~NauInSEFs9>4Y)2C^+As|Y}dVf4~OZml6m4}XZKS+KyZUV?v
zEVP%ukYst6()^KYG}A7Sr0LgQ3!hFh#1<*PsE2tt>tG<&ciTzLjuC(pN02txMOv$$
zAh|Em^vM%K@&t~dN8gkxT-#=sM$bXUObw`=<10_F#{F7DAq;~i2|l^R@4ymS<VR~&
zB6wzmQuH(oRvvd2vw2LXhrBVaMgXseUdA@xrAh{7vjNi&bDFD##jC4WO0SQqoj}b8
zTxPFm>^)u2%2){oqc$0A3UuhWL)v~z_NX3NScvqqsge}0DLeffC`FAG`;Z>KyT?qx
zccww~Q$y5B8PORXcFecJeG>}sq59FMB`l?3YqoaG#0Bgo>`C%JX516@Yk<%IC-4x7
zaH7&rZ!J9*B0WNSC{ux<QJXwAJF)&vo$18ZlFrU9OjiNoN<G8GoTu_bKF}J0>x%Zt
zs3Vhp-CXYX*)pE;NGG4W0z928QL<!{dA+E1y7A4P9<Z;s`rj}|P%mlsWGerew3CoN
zN#cLEhzo9)4^5||%z))e09wRQcgI6{eEO0IIV&e0*`WN?srR+a(nMYB7P@Rc*V>Zf
zWiSPqpG}i^XH}n~%*b$%Bh1ehXn`{D2nl4wD6CW-bN5Zgkz5T@uJbctpiRS|4t@<D
zA3lCP%fpT(4SWe5GD$hF5cgWOb)96Y8@O4oO7>d5UNNLS<M3u90g67$wO4!I8csmx
z@c}Luei|A+7j~skV}-yS>sJUp)RV6WXZ0%;>$e|n_VF`VPZcH2UZ+^I6>CPpvj4e=
z(;N}#P$PTj7CnuZ6ZYLDfx=vLOPR7xViGwHBRvb^Lw4q+g_l16;t@xYuyZX*uMKaK
zFJ&571q!VP*OOKNup*;Z@6IH1Z`B}X2THgZi>!2#q0I|Xg7|$3qbT2A_heb&Jtvcn
z2K|49d538(yk}>L4C9`Hzkxy#O`5uVjL}UdN^nrH6u9a(-GF1$AM(sC(ybF~dpL_V
zj?K9HWIilXD(v*hCDBiYCJyR5<YyrSB%hv6rfcMRzpD8GX2DMA!!i)o_t9iigh19P
zfKvvb%cH@Xs=$8b*epKnQxY4SZ2*%58#AHXlt~WL*NZXN-%&s$5s2bUppl{_xVx%K
z)V=0376ZS*>op~R4y^f$5q#u2%d+V-M=hz{pJ`hyevzb50UeSV*=9Fu0k`&n*H%uG
zSrvqAme=6|(AVZ%kVztd*``odNX^T5_vbhDX?9(}@_nLfZQI_5v(SN%*(XZvD0#5S
z>u^~?hvCIGZi?VzXg0J#az%EVvGU4f>vlgvQ@;a#jTODcymi-dGgNyALpvPBU$%XB
zLBpFtHPg+L<Pd8l{!1N$lj1PG_=2?sS!I^3hG>HVfS;_PNC^YuEH&4nEV1Q&Fb0h2
zT@d+iv%d$uJ5#=3w}$oStcTk;r*w*3JNsyd;lvJ4s=3E0)$JPMz8ywL#iRFG{p#ps
zWG^=WD&Yh&3VJ(%ctp2V6ri=K7vkfdn@M2*Pjbp9g-3)q<;H^AksR>qT6f`X+i!QG
zV06aiaqdJr@h5G)Kb<hX;To1{iSYEFUi@K&SHIFAae<{lOnTE)aDm4FB(%v!r=0!H
zq*0gw|LSJ9pKdNo-4SFzzgON-j+#<RE_+$RitYQl!5TdyTxh;v8p&#w`>5C3DJ$^O
zWI}--v?X<=JlnnQw|h@BkR@4A(%s13ROLa|W@H66=jYE|;!bTDz4HMbT`y0MJnPfV
zjrJImeFFFKTx2%mCn;F~Uarwi!J+MN?*h$i%d(wf=@M)-;&pW5OCE7}tvT7;v44rg
zPF0_`PVMyu@Vh0tyr$g0BUSE{@urzMABT~VH4;gL!A+(U7%FGT`AUYB4y8KBi-6i^
zg+qRN@7D%xe64jUCro*9Gn~|hhw2Frz}ZNRD$Y%t_iX3t`}XnyY}kln)O_3Dp4j$e
zc356W=x7D>dD-M=eGF*vQ{&XKdATZ!E8PTfvOTk3G~{{r9e)ly(byu=J?r<D{^Rrp
ze>y&>;?0jBZ_(H>3lEupDJ`rqG&lA^Ho*Q2Rt4-ZbJe~LuS8bX6@jzO#t^Gr3)lau
zU69tWQNe_1G6WP4P7?=&O<q6>o2v$adhaK%7K(Qstog5eEId2hDfYOHfmV({5V5q{
zNWW8)FEzPv)!wT?skC)nqFB#t#U2dje=j8Jq)eNR?qzM(8Ac0$0GoWY-rrfGtkCo8
z@DKN@_7edHldPq2$Kx-@<24{&VTn;%w@i}1*@pv^z5tSGmowl+A4<nkQ0=pDF+UHj
zEM)`hFwXL3%h(;Z-)-=_m7&Ha&%_yY4;9=uF5Mr26$Z`M5AI&gbuVft$XIR+e?EOA
ziTBX}=dsb6_EhxmM<6{k!GDiSFX;t3@6A=xSCy@m%#*3ewjPmoTqNt8a8gsGN*ayQ
za2SUKAVdVrx`c$l&sm;Q-;x2Ejv4myd=uy86rQ<U1i`l;X+Iey;#`)s(OLY~b10q#
zwA;#*tbssGBI))gpQ)L>^OE?I!A<^dFduQ@ch1o0!Z&Ln2~qD%3)}?4|6%H#f-CFV
z@9kI}TRR=wwr$(Ct(|nzv2EM7jgD=1?CiL^zdXP9fAG~jn6q}(s#*tY?zQH9jWKTM
zqoblGHEeEpC^5I39~NE}wP65ckExl>17<XWU{vk1frj5e3I}Kh1U+0dTe5CZ^8B(S
zb%b7R6(D6IzpOcDA$Cw13^`YlAHyS+m7^4X6G~0o?ut!#5EFb?lNbFtJE_AoE|Ppw
z=}$uw$)NS~k3a7&I-_W-#?++@j7@UAe;ocC@+OmoBpxO4O+A}Bm@S)(nEJ7~S_vQ_
zO;eDCyTCUBL9=Z0jN0a4Cm=;Uhc>uJt#}C4b6m$07TdlLcYGp390}tn`NfV;$caRt
zb;v=!AVO>@UDlFkyc(6<<@fKI^lRTR*b8JF$_MVc3ff%Y+Zqz7f(oVOAf&{awX2n!
zi{3xQVfraNDTM#-QvA)sZ{cc<85xf!Cwt{Pg1(6b^5C;Hvs)_HiiTj_cqMKZE_zw#
z%O~Y+FSG_*V8f_q*H^_++b$ts_S}DetU3w3*opX2`pJ{Y6l)vJFmW64vW-|XcRTT#
zeS6Qv^Pp6jB_xDpKeNIxZ$uRjA4v93cU+8Yk6qRbTbKy|sM6kkFdtL@g4TBp-uhVE
z)vE=-BK|EmL`s^^tP2A@(+sMI*3|r44GygnzA7B0Oe&#(*_Li*?5vMiSqlZVt{7Mv
z(&KZ5ZR4^uctbnDF-HvZkEm@oO6+&S&SD3L<9TgxdK!WpM2pFQ!!`ItDD52*{Iz$u
zwReQ$p=-4d6)$Vw1pb+e$uS3AMw6&|%NI!?q-_^Clpdu|0h8VI?E$BE`gY%x#<cLq
z+E@ZJh3xm}@+(Hd-^>|39prVkFz%K*f5F<qMMHhzKz@V%#5uZ4L%_f<pHUQo2ZM8`
zm={VC!DMgWn;b``RlE9KEu=P#h(|1j97&B7aw_e|R*D$B8y}NJgr8UjH>m?<xc&~1
zm4t5WS}p%AacjQ`GWIJ>v4-k_DJ++$n@oz`Q}2w`7#^#}O)qS2h?O!}H+px5RU5Ob
z%S71!``$6Farodss)8))jLTDACV=%M4ErRoZH;c=d6h1BC*;J!yh{}g4)BRXbMjEK
z7D8VC5RM{Xi{xlAtCcpL5wE|T@?Z`uKnhQQe0FhdmCV&Maheni{+@E1CdcLT@T*VY
zl%zd=lJZu(pa(X?iQBb2&%B<!g)nzoV(->x+>uYST&g+Vcl^5fvDWGI^a}Zw&Kde&
z4prP=BieY}E}3t40w{fPZC)h*5S?VZuOf~s$NO%!)w-Qg2Ex{LmZpvav3%x$=M#2>
z?Zb?;SjdM=1lCGdO>E5{d`j$Q>*07|-`-C78zt)oQB|GaH&G1*tV6z^(w?~X>uM}O
zcI&?jbk1boZ?q3K@)?o{=R63Aqgy_+86O6`Om5`ewjY@O>#cLxnFF@_KhBHwyye{D
zeO~N!68a3|7zRcL$>%Az8{BCE&EMR^tvU7bDlI!o<~-4U;w0}@p|6nwqWPA*SC3y;
z#|1fj4#|NLmJJg9kH6|&Y|4eRx+?Ktj&PZFk{nd+uNTO5!c|?RkS@_K&99d)`mhHX
zAHjcg57Y|7*JcugEV?%b>2Hbg7{kTn!j9Q<FhLgD7aUjwHlPS>;UgUYqv2elRW1%e
zgM>vW3tp@SCQ`;%sLYCnS5XkhFGx^fF7Em~+{jXjQz4glTlj~_dkIq0eO?h3_;cGi
zu&ODyY7&II(HEF{2jJ@exW*y1v3=UlcG~E>hrPVww!dDteP%ul1m~8)kt2wtWHy|;
z76~i?quS9P1BC)`f1ZB<`%tTJEI=n8LAO2+P(<{9;h!O0F4;Y?cF6^C1)wYrrCojX
zD^rox$tR8S=j#4aP5ud^+B%G=t!u}a-Nw`X5X3mC^e#jQfBG?_IH}8Sq(6f#sY?qY
zv|@kCv8=c#s0yi?Md)PO2>7K|b3xwG$zR3$->=OHRmIr`>K;H(48p=QX0)#7_`DA)
z8dFCO+ukVa-gdKV^P+!KW?FlFv#X&CLoGVX1shDIUCwy}IwD($AMnk|A|UR7>D{4y
zxdNCcS~=rjPhWLt03H^ZdW@$qizpchI`n^QWfoNxmWPe6h@_Z#?+%_&<KC=X()Jdt
zM_xY!iuWT;ptV`nU>EwI@HD}_IxF9I940UUwbn=0jcKf}9*O2Yuur@XN~%Owaf5ad
zhl1b~%rd+H%<QZMcg&2;c!9#Mi%HDXfGF5}ntBKTS-59`KmBmhR(aj-v&Ga)E3B+L
zj^bB?_zKsM2ZsX=vS2y=&E}oPhfB|Ep<w$LVHHy-;P`9^ncxiud+v7(itrbI6*4V=
zOEby#ND6Xp9ChVXA1c>8jRHGrmk3lL+vSK_;m534TL#tPoE!&lmrwTlho&L;bcrDY
zLp>hPa!aTKWG6xAv5MD+={nu%SHF|H0(M4}1~OF*f!BO_w^Q+8U+l~kf?a(992FVq
z4@%B9pyQ<HL_B9qY@*T6B!IM2>Ss&AL$Q-*yK->fhQa1)C0ZOcV5F%AB(+$RXT;&!
z-?umAZ=~|DzIOHb!fng)yjtyK6w*EfZi4o)Sdp)xchtapdr4c=6Uv3UB;sPS&f`&7
zOjpEgOc0-|ira8L2g6X*VCrk}m#>SBy~WBEDAkS4j&lcC?DoG-u7iSm7cHPi!p!0L
z|BY6Fa+^Os)>rWaPvNbNwhKA~f?K$Gn$iVq#0xarJlEG5fLKuOSd0q?2jLj62?2$h
z+h`-QZ$}9KARK9Hm-@#P&m_S(Ja?j44NQ7Gd>pPM7L0~-PP`&}f2$G5hlMo+hK8#L
zGe&6B3YJC1)cWk>X~<Ayd#XY)Oa&pW>@V+jEa|s1n9N?2St1%J5h!pkOOg_Yh71?(
z@~$Op;Lq2lK`QBqKz8(r1{Os6Mz+-^PyS1%74vNgXTQt%JRRaq-hp?6n#W<LpdGMd
zv$b5>4mm?;Bgr}bEI|q6KZ=XW?<jVN4Y*@f7>!p`_<Q#310UO)eMEuQ7Wd$mZXK6q
z0EMpWiH1u61M@X$R7<UNSX;s$1UYl#ttlY=WG3cDB{X9*rT!%|H1f?ahM6@gH%TF!
z>1GmRsg20utfYr2{UbI(Y@+Z84G=$34-XOii&R1iLlg?2umt>#0Z<_Db#rGgET&P2
zqlBJ_%@pT5)e^_vBb;GzfinrZv4C2%4SKpTL_hPE%$}Vh{EF!BzvCiHL6x<hm2wk&
zuuFQydW`VIKyFqI!vurGe^^Kmx|~@^h}RSx^@eAY^o;*)y(mUpt0W^e41j?A>Th1^
zAqtP=6-k2iKnHxFEAt>BWUl=-$b!TDHIcM)PRvZesepYulM)shs^O9nf_O*6Jfgrt
zhiH?(0ifqDLC;tHL0B4{*RJ9*CO?K5LR7n1j~~$vHRhBXb!{yne+>FdLctPa7G1rl
zIy`~lX(}Gfm<KaEnH*m%3)(Nx-%~;y!?19B!jRI`1L6}besc)9w+p^aa2@a<>xCp_
zzrPp^)&rle0SP-~2QXRZ^n~4XYy{EHcxl&fbj5Pn9nh_((QgXgk^baLm&?bd>XbI4
z#XHk@pj&Dh`Lz80;oGg`9-fc2M5e@28^>o>7~)z(U&9`i`lsthvg?BusL5mXJw-Vy
z&p%^A7&vK}!(8X71l{{<VLxsYx#AeoGvWKu8u$GBCJ=?JL9$DCOT)w{Y9o!WRL-n=
zY$j1}y-@hxtweWw_C4;TQ*V0`DxF7MV)G{$wN!yjaMe-keNW$Kn>fzg(Nth_TGWa$
zlAZ$#PgF1C{2S7FhzoLyE2}GUkR<Nr?w{h*zd#xJ=sO2iTexm=!d3LaNhl<L4dO5i
zq;|bF*HANVoadx8<med~oNtk^ql`XdU&<Jm9ll+oC>fawR>Q7L)gXS1zz=aZy6+m4
zgm@pO>Pa|QN63YTL3%FsS(pg%rv}F`=nWbO1nb9DZ3-LxBPH=8g<><S`a7%u{a$Ps
zZJ@4Zec{Pj5On|RLmUf3`BL$QRPWLAh7WVf!<^e_YI?O)`H3tX&xie~a^}Efc+UO_
zUnC(9kBrD{uA{GT;;sZ)bHfb=5+WuIJXF|oiJN>7QE<e%k2rVTYTxbI{>`tJ%5zl$
zm*9?x9(vYZX4<&u)Uk8HB2!x0<70AYEZ{-I5f)~lly?a%5uH+mh;s=nVZD5W4mqA>
zrg#RXhy#ey(4x@u@Tpb`&wZ+4<-b2c(j#^*<}{0|@Wiib_EGQxIX{G=j%kknovOls
zH-R`_C{xUJ7jM5P)ToW86MMnk`|5-TF{(zfBBvC)Rno{|0)6|pZ!Q&$us>8&fnO1u
ze<w(+%$Z&FJtF{XU;R(6-lnXMTj;5u=Jg55o|Zv&JLhFqZ!>~8hyi!a{$jgm_l@q!
zWPbXPA<o$l-EGFZ3{mlbxK@++HNSw6KexVAd6g#GpTUvPO7h^3?3C#55Tg8evP85$
zWeZ<}CpY_6gTXAbk!xV5{`wd<0d=`Lg?}gMOq_8Y2XD?DCth%pe|v6)%>}e}B`PuD
z$oeEPoQ&Cx6wi8NsUq`_JEZ-odNw`>WOimuKY~I8qG6>wi61<|nS=zU4|Nh4TVYAP
z^Ju!dDmzhC;h8cSlmg)(h-60!-S-;~oE0(^npPbj{d}3VZ$N2Z{nU-tfJq`cciE<B
zQ;(TG5x@4pscSfPERd9?sT-7V2ZQQNx~G)}XsK?^A0OF-$}Sc1+^JtvJ8y`O7~Du9
zw61bkxq_hcB&OXA!OaoL?T5nBCJRYJ-u9r}zuQd!l2qA}{Mlp%W-zAN^M2B@D{iLR
zv_8P!_4$~dQO;mow0)zs1~TH_x3kPp@Q55nM9mb6-og}f^!BItPDiAk#E+DzzSlYz
zQ5Pa8G&+Cp<bf*T|BD~Z;-te}g$s;Ljch}V;`z~JB+2i00C!Oh--7`2T|^Z0<6M2X
z!Cqph$wg(0mCBx$-Y*mG>M2-UG1!+llgJ)GL1#ieGi6fS#3<A03+$;@*1@#c^<-(t
z>TnSk_eE`->Tns6@O35;&^Q1o^{xroXcS|gi!1WGes|p?2P1ex`5I0~#CN9KiGLFQ
z%(phwt;Ir#REeFeAgM+pr^b`PhM_u!@n+NpWi7TL9TQAxN-JTi4y8Sm-UZvhW_SkK
zz{;K@e$8^fkgtH)?F;Ad%x8iql@K#|Y3OJJOSbHOx&o}CfP(cV+AZX__blP@Jegzy
z7n9$!^P4Z3=jlv~a8lwWJUorZT>+jm0~cooBv(JuqZA{8#IG`&Q`fXgtdJ><$j!Fc
z_^=p%!66_YDqe0Q1lULGcQ3=GOmK*6ICt-o*}ruXzf=H=p&2<4?cXxl<8oJEm*;OP
zz@Kt_M{5KN>u&I!v29l}eNB?E9u}HS-#9+EV{7zajl^5K1`PTi$;<AoAvAqL1RGR(
zCl(YDyy6`+;4?1TC-cn7T1-^jlG@LmwJ%0buN7igp)C-mFjHtAd$`+}@^3~``5^3#
z^7yk%KU{%<@+2aV%@li<A-KAtjAJX4>IIEH2z)qnbn?5eAx7T%;4O_X{e*|c;q>EF
zL&wvN#IXYyM`-_?{kRrmzm%vS&0;g2)~lsTjCvs*20TMu`tPXh6sNC5bMs-y6^3{Z
zOiAF^7YrlXr3#}D;}AabCsu76pBlWh--*&iKe2$kXGit>c*jhouX4ARr5dT#tBGac
zxDszI>-1P+?&+{tgjvN%;bU&kd`H&#n3KuB+p+nU0htbP&eMT&e-?k8(!cy`VlsA^
z^<G%oR#R_)HPqj^Epg-~yO29cGKTv{##&5~n4A|%!$jderj%s-(_li48fO6%V=1H1
zD`o)P^gQtl97titVa@4Syjj})QAV)CZWBJ<kX#4wG*w#REwcr+zDSj)nk|1V0aK=y
ziQ<cu$4cvP!&7O?%4OD6^QN)Yq(y7^CBDLEmqNZb`6f&$S`uC4_ERT&oklFz)#~Y#
zjzBgDf20wQb;YPC@w~4S3~V-~QeuOACh&ULFeqG17-AkS$ukVbPcnR40OK0Di4J=o
zj0Oy=<d{Aq4kJ^RnUB9-_B3(L#ch6l&uKN4eRo<LE9}Q=`=c8~;gN-tvGJZFiUrvd
z4n|Ud_cH<g9kPQSWy!oqV4~y=;!Mv=nOR(=^skDypzjXRRw@eZh2+_>7OOnoE<kRR
z?yl<&ewoJl&XI*3G^Ry9J>XV7(JH<gT`kNUIfZGU2$n)3*P&hQJRdt#kLISVQRu*&
z`0e{k2%X7l^Qy<u{}L{I&GJe$Npv~>qw$kE(dG|kOR4OZR)3LQjjZYIRzR9kIb$23
z)3K9Ftb$PE+v!n@5Pe`>8}QI<R-;&>g@XDVN(LKH79T7Vx+-C-Q|5VpVh4J7mn-(j
zWiETu|KlZ3h~hdc8L2|?f2@hA+6e!csckCgUS)Z#(vU@C|8pxH+omzOvJ__te|@v6
zC`VgDec)|lg=3O4lfFl=`X4bU+D>vgdiq_b+IOd83M;hjC36Az{{AC}b0R(ZUFWez
z1w|=bG{Hd3_gJKP(R#U;tz&!>lLoMc?<+zrukvr}6Zah@&Z5U(stxDp-T&Ca7pKO`
zY<RQSGF$obXYPGq2#a5<p-{JAxAh-~sffkNSm%&*Rrt1J^zJuWNTr~0|AhXb?*ssS
z#Qn-u<f?MoNkM7g(mZ0ZuwarU=(CDtZVNWET$7Ol@An#O$x7Ir|0f&_E^;m5$m6z3
z(GDJ_plvR)%Nb-VM+joYk+r}@!{ZHEDP_0Qi7RxmP3jzLhQj0G$Kinqhxp^XNWUG2
zbJ&tTQB;x7h3a*{k;a)v@T?PM>ae%RxGJ%ip*qS(XTk>%Eh=_L7>q=HL}zz}V_FW?
zL^t0tKJcp9P5z>Hj935wS}=);c!x5Fku(!j{JvhFB3FKCdRht-rjj`=Zc(MMHDbxM
zyB)fx-<v){-TkxZ3fVTi)lxf)J*w0)x!&SHg2fvqI+td&tWZKFAWy*OgIvoI36T)e
z_VW4|hfW$eb)}S^;goMk2@fTs%*T)>YuA)bPscv4(di@N)JKuY02v=$`X@xDBnsE!
zkMX~=0!{@O7$)FP#1@cYen3F`Oc~sx5`D>OQ*8#n<cwFoqKY8n>lj_et##NRT?dZY
zQo`6%{YaY=Sl^_-C&Y!JXvW!%i8`m&nw0%T?TE=h4RbPd(?4Vn7tYqR*eAoZ;WU@J
z6mk4i(5}3$lfr(#83|ciYWYHtjXzc`*xh^pg!S!G;h+5*Ro{G_NX4BYR+3k=_$$?;
zT8CZQwiSPmOwuS{d5}qfAn-)s2@07FMOGMri6~{4AZt&5b|uNOzxilLo&%GX9natg
z-+DHHs*;|glRL)``!?^~C+MDIjrJ8Nq(xAcWm6RPyb|?!|6<&=nb{wGzy$L7|5&h2
zXPKzgKFV*}Q)fBynjWe`wP7r@TgQP@{A}WHF;m6Ne4#Yqi`0v|)DzL%<y<UoYrs^B
zq7G(VXth7=$hyRoHm5t(`6j1ISpzwvS0Vm&{#BgMUwjXmEZ&+7mu8vi{kIDDo`VmA
zX@!sUi>0abrx*d^zZ8e(5om~`<rc|a!7Ilx7I+lp3{-szrQKp;QITz0Pcf39h+S{W
zWRjGJzF>LfCU}drw_PifKQ->Y+$%{DsS`buDyY@QFw8YlFqpO17bx;o!uwHR<TYJ&
zz!~D_^>WH{<(Z%$Y@z|y#C1ULmc_${`IkE_I6;mse174>_3g=doVbKYSF>!UdK$%-
zYr1$?6v034lVo^|GF(){r|giQSKt+tuv-_eBS7thIFuA|foPh_Gka+^g0)DMaYUHU
zfhZ$lTAUklSB-y+nDDNX`=6xR;^-Z?Wf85u5yHqs(E5tm6B=2UFd<8a?H}pnW+hTN
zGb2YXS*vI=v;wV#6FHu0>1EQFnx*Pa_oms=uh+gl^k=7RC*FEjR^DHgXFvSgDB}rL
z+G75-Jq&%3ac96m%rw6OzpESHaS=ClA|qUzCwB^0VtO4eQQaO8PX=?p%Jv+1r!3LG
z3{U3g?$B+HF3q(;DoBD-B8%x=6)Htz%_G{>vkSP@gqjU0A9AZhl@h&TX_X<ZI*~xY
z!zp`BO5%BAnaM0mwuqXJnH=_Q1y#DdiM$GT^y`}6H`R`?ftPcdF(#c@8EK~lGw$1-
z>uAE3@wQlEO=Ny+bXyHDA1MRo%P8&LuEkH&vf3c6{&HB|Hwr0GV5XQlFB)OrJ**jh
zwbbulV?rGTkWio=;~#NQLo*-pnaqyi&nYi&&##33;oX7?QcDqv_Og9?_#7{V8dCrV
zXanB}?!J1tnK$-dH6jsY2kk)bCqDE>p4uW#eneKg_?yaTk!h0d#xVfV=+NeHOGR6B
zd(d5yXxcoDY(%d_ZAx!R`&55spwmf~Su%`7C1z*YJQ<sgPIxfp3%;>>xMKPl6g(Cw
z_Di1ZR|vM+6Y>7}dc?l=-RLO6;*))|yy&ydM_xG+G}d5L4LhiUfLPwW4SS;wrtz9}
zI6_-F4o#lR_*lkfDi(P7B=EK`Cv;}FJ+%r;Mu_nNkkj59e|jj5`WarmKSAk;wGb0U
zC)T4(!>Ap6uF!9z+_sDv4C7*27N|}OxT)qwD9cNoJ^C5bMV>K!+~t`ztlLdc+^)1L
z>sFhdBZQoXN>L1SO$%*W@Htm{hx_@*JsD8i)*~qiH>lD0OAly|Z3nu8k>8P-YL-~B
zly<LDRI}?&yPmLZjXZf+maz2cNIvnzja80gKum<1Vo}lCq?&ORG9rSQp41kG?p518
z;Ge{N<+MSP)P_nJ0y8Dh@6Cpi-w!lb%gE?kzZ0Y<@6m|lh@|e-qB%1BKmMO!vKF}3
zBTt+@iz{&joVENYsJy~y*P+B0!GOo#tJ4C{AdG&G>sWTOsZ0+;$tR^2Om!lLMF4LS
z1LMgweMI+!Vd^paa9$UxxHJFC`gN2sbZ77@=xntwF=+9JT#=XPzla~Pf8pTco6ob{
zLA6d8?ejva9q+S@LT$qs*s-*7rYYYepdKFg+^K5;u0>u6Y~TqWGvcaW28BQNFSm6#
zxmoKalv>#R7T}8`Y!`#@<{h^{z{A2eP3g(ji?Bk_aTe^AoroeZ4W*A-ziwP@^Vl{p
zt$ocfa^G~!<b}r)OBB@0`!QUMFiq^+p?(TJ<B-idD9>)XC`HpnERHD4>FiRbN2yO)
z%H#45T%9;W&7S%YcY)msL(cvi8VDV#vxo?k!M5C@;)40&|2d#THd5Uwu9E7lIJu{r
z<A|GtM6#*)n5C;XndsgONRpObqPekfbi%(A88}`7y-RuSSm<{wiza3{KMGml3KSqJ
z_yNKeQ1f*V6W_nk|0k8&$P{<22ZAXxrd>IZc(}NZdG{2QjEm?iZCieeR~)fiTx`2A
zvSu&yt028%Z*l$0<zHX<_gyz^ipFEL%Alogwyut#b`z!PJI8>zDDF34jn+Wz{ZFIr
z920{Cg&Fo$=)o@HOLawzBH=e3h-~ny1PlJMMYjq<eTp&#;SIg04i~A_f3W|uujku<
z*}3lU>y3h7Lp<lg0GC9Y0W$i<?F?;DMmoxI%u_3D+l2~jSJzljO0HSDbx%AbYzw~%
zu~Cbaw!qeEP!eBlz?_!a9#*65$e>7PU!8e9M*&Y|sAZL+o|`v3&~^)z#F^Li%jnMA
zP=<UFOHDAxI4|#_&@kJxQ^^cH`31&1h+xhVT|rj9;1^RZ5X;B^q|-jZ(^B;)zlF7*
zD84ePU>{L_ud4thZ*@4iI)RWm405kU)^#YO<Z-HX=TK-QcHt_1YSdcAsFLWG_Ev%D
zzG*9oC;t#LQjU_!_;}-_goYY}SS_?b`KDc5h>x^V*p9-Af?wrQo>rHOk6#5$wyZFm
zDtZhH(pk~!%4ok1jWe5Xcl*$$24MMUxSRjUHU6Vo*%bf9g^Np!l1pxd`=xjA@Hg3#
zfHn_DH3wg#Fvu`5sINIsT+E21Kt}U+s1f4!AA<v?&%)%(7jet84pZPLs~$Gk_dd;A
z;Xw?R8cz*5imaCVC4Xkj544w!U9`~|Q7!oDTeEfnMb?xuMYubA;d0(G70I4{3}-k?
zLVS-79gJzez4~Y=hX8N=4O)a19KC<w(xq{cTR}uzUV4>UGFDot<xrg4r{&7eG;@rt
zUTCEFBI6S-UUCozWlc(!|BeKC)>n4m7nR0-&IF~ES%FyT0Yqm}3h>Fm>&$<B>+;+Y
z=&og~>VYDkkAm9MK{dsb^5Q;@r(#v_kGj>xL&IuY#n|x4Xd1@bVPQaQ(j74%S1&$g
z9asD!KUYrwIo6wpIEM#x`1YL%r4`|S%&loi=4}|ZycX{%%|UIG)8qVFm`y4xaiwAy
z_t(mnGKdcHn=BAU_7jQv1Am(DztUxiBT`hW$d?E7t}`k<=)w{0AvD)mGzKc5lZ3T~
zBf=Myv1^G6QeB2?WicVN)aHCP*#4Y84g88urxMMR9(sMhSCCDE@txb=K6d3%As&1Q
zDv+ZPAC;~A+C;L5KnbnRXCz8#TMH@gMS^pHcGwsl5Ld{V&fIUciSMc$H>Ew3y_GP<
zs^?9Yra8=DfuPKOBsqrWob$tQ-dKn1s|>1RL&<Rlc_dePg2-^xX_e_@hjWUPF8}ku
z9^qm#x9~oR^9!&gFZ<`5e`Nvq&S0PXKGtfR!!(<V>O1Nhp4)}LidIt|iPH_yQ}$y{
zb|k0={xhkmjFga~ryE(hsr=gSRTogxs6!mH9lC`*;b_`=EeuqS&(6&+RWn54gg4Ka
zTi0mwPX7;r#9JbM;PZito#eaKulSrQBP0(|R~%5ntyC^KPm<C)N(bbQ&5IW2)<RLL
zOJoV=RxI44Nlv3W#_Ef4`BZ{;NH{(LgAQ}JCUz#Ut~I&!pvq9#1-$tX9TdwAYvfN<
zx4${~7<h|m_7Xg#VZ2VIT2QW=2bTqN60*{M;JCNB??t6?Z%`>gJorv4umAQjjms)?
zIQ5a29FeJ5vghG-nm+sxxLtP`zj(4<wVPOZ_YAzboP(|=`5z>m7k*t02g)o#_@DlL
z_z#ovODqJXmm7GB!xRWSdz|KN{`4~rikFvQsg=Lca@p<*xZsG}GQmkjfW1#gYN7Jn
z$lUmoi{qM~>;4}d&D|0EOKj*_J<$ytE_<U@O?xcddEEVfgtU=vzhR#0b!4C$lM3f`
z7U8o0){6Yx@*hIN7*L2-B!1&%kfmcCSZ}BI^0;?Rka0^wlsn3nROvCYVwBB6=l|K?
zi7c=x4wZcj@394~w3qNmp?-zDf|&laaf@XLR;vNMQf78fj7hZ1*9U4;@^K))Pf%uN
zsx#~^X{@ox#J9B{To;UE4)B`}W2`KL;y0yjah5Q)$HQ&r0IvReiBZ;M6IzF@C-M9J
z1Q9oGQ-8p?0oPyvwf=Ms4PkZ~%woY8S+VY;9uyNq@6k5YkUDlny<knG(%9*M3bqeq
z0NCrIgKw1!Ifk_VK9TS(&)F>!r@b}jxluUdOM_jicf`&}D-i9Mbw4HFCjLFY8<b_%
zAA2Nv{p&p27})ob`WNmT`Myg0?|b0%bAP*4Z5cBGu;0Nze@*Za(&vF3Gh<z^zApf2
z7Xfxe@I$URP}8At?vQ0y%jp!*xbp0I$V`fM$-mPo_E%;~EkqLHSF27&4MhjcPiRK6
zV2e;s_n8q1^K$IOnGq?bmL~u2OqhE=x8u<Vm<Mm|N`b=<jZraFIL!=oMAhTt-q*2Y
zljkm_n!0KSrzg@6Yp2cC|74g|6gA7P3W`FaW@l-5XRXghl?vNJHj!=l=#B+DFQpu$
z07-BTRGs1?4zR6&Wl!u?Pxt2N%~{7EWGQsSt_0p8Rfqf_rzIkeps0HEsM~98k<5yL
zhxL{AdSG*^Nei0;Hiz}6Ts?0N71QCgvY6uDR6Fxu^a`lnDI)EHTp|q-1<4&ak7B@l
z?7Vt}xX9O<Y&jNlCDwmc%)*_Fox~BDgw|bH!qsWhl)nJKr8U1>4gV%A<;MW)7hJs%
zL1GB#i=BH~e*aR9Os5-sFWm8gj-SGM-k<{k*(kbzVb~eurO2{x4Lm916>m37HW@_&
zGyZq*8k$OD7Ja%am5lyn?Fhy(gqy(+VMkNbeO;mf*TLvJKbMqqq%~P6^D7msuv}+Z
zdNS`~_-F$U<Jvf$2kG3&19NO2q*M$UdtfM>C*?hKioT*MM;5TJWrCZ;0R{xxlv=aE
z6zO*<XL}sN`-PGM&OaH}^7)KReE}N9hp2~^-5vKWdpN2mR(a+foH?C3kjg)HAUvU{
zFH8>2vpV^N?Z5X~CGyZDNOgw0DlPobjflD~5}o;Pj;#%+#a<SLoc(=PFDk-N@=|sN
z(0UEb!>7?Ev1q^h!FV_M%Y^-mk^mU?WA59>&nkO0?>jCu=)L31_t4+2@D4;6D>Am3
zp0Rz5o^CHzBWYn(zE@Z_i?QEW7)Pd=MhL?@(CJtZ_ll~$n*VZW)B#+UE5E0HWi8Mm
zUmi)R@+zfzrhGulCdRYYuf&OijP@V{nTiZweL?qQuB;WQpZ}d|$#qaf0Kj+U{WZ23
zF-++Mt-Dwup&g<PXKY^v!6u49Uw2lXhc6=s#v!wIwfb|mY!kM-qdX1_1yX%p?hi-L
zTKgNTF(1#Ml1u`{iGF_3->&_#5YA?&^G?cQ7*#-tvKRW|LOaF6oi+QiNEJR}R}~|v
z007A2sZKGOr{iY!xEEmL1x&Vu<nw_{Qew-Wq|zgJhKDTL&1<1<3tKj~;*(cpjigp;
zQZhq5g@>DFWU1YU+?U)WnOi<-7gFsj(xpt~Lg!4iSCZRx2{cLmE3B}4lvCRxx`k!O
z(@6mOY>y?3z&bI_OKD@uWGS^vmbRE~`;T3;vBR3&2Zv+~OE&uf$to1Vsjts=7+VkI
z*4ki7#Jdn{P^k|RYV7PN&3ruD{^U%DP#RCEfvHO;+vv3^Y}MWW$~!_ty4Ep2kzaHa
z*K-P%=Ju5l4B#Wv@ow$AM9xL=^Ap&)j=#xJWLbCnl6Ni10lKJCR|R%lGMbvSc7>=<
zzY>@3Mc(o%6HUs2(YQ)*Z8$?uUqv)<zWm#Pe&vDEtk<PhWRo*!TxoG>G8f9})lGQb
z2l;?ccbz})Z#9w^vB3Nl{Nt@JqQt0MBKw!uZiVS@7pa!e*JrWO2>wUAPk@etK|rk`
zr*7-_<06?lA+CuxooW|}+4X$QR?mRv+Y1iAF&()aJAYeX%f<2g5C2~K&+dh;XMxV$
z*QwdT#wDkG>94Q|=^BV9U6o!3z)S1VG|QAxLNt(z(GJH5Kc*>W6Oke*$tMV@vW*dU
zlu3ZxVxud0Ch_+u#qiL|S8}i2@sER0J=~X}U>9m}HG1(k1pJf~UmW=YogJDCvf+s#
z=z{&&6Wd*2x3d4_r^8<d%TJt8hBCcD#7%!rDpJGm1nrm>a;X6&HM}VdfaR<uA5P~m
zHBBPbl&0!-7(##+avU9kD(9ji-?M*kWF7YsbNebdqs>jj`G7AN)zZ>BE+w631~y?S
z^7;B^@tbW7Y*-%5e!XZ34Lo=)nL@qpn#CM6U2+5v<m2m`wd?`jj6Do#uR#bskia`b
zVWR4M(yBkueq(L{Dx&s5z|g2pLC&UCT$UMYk>@o-$!2C%LI@&};r#c^uPx5i+Ey)O
zT?a>jTK)6`o!j!ZBYN6J)ww{_P~)NvK+8wcNyM1KFvlX@<eR=`mLO-|>>Ic;fe}3k
z^`Qdv^2T#KPzvwX-z3=tEL~|duu=ecx$XWpY_eO&$r&P*gVy!FxhQNgY>MfpFwCd{
zqI;KiCMZ?|zGQlW%0It1i?3r^3q{0-?wgYEpM81PLcHtNz-j}WP;L$R=&#qNXnXmj
z8;9l*bd@ofPdj~l33}>Nk*CMq*ffB54<#MdYE$ZRu<)e!$#VWo^c3`|n7*SMg;DSr
zm1u9oF4H<E&i$&DG(usk?M&sd)79&R?7Qi-;|i(X1%aL*P|tg@iV`@qG|08OvFRHc
z@uFOEK_m*6c&;Ga3Vb2#qlkL>2)wvynek?FM{+P}{AB(+9Lc*1uTIh^k`M3<OjD@3
zt&a7R%zyn^wIQqF{cbrQyPASy=Q((7H`}Z|lz_~`YxEn`-|@lc4qt8By4I$}OD|wX
zSwl12TDP^x&WNAXB`)3?zU6OQfF3=dpDBF3W`Vzo5WBodXWtdXHlcYoP5b?t3uR5?
z)7oPh$25(Pa}*zAJTe@l`UqquoGafJR{D_`S;&&ZiJVn_@Kdyx#aaZ`lokGdC?i`~
z6tk<1vmo(XN>x1)VeXHOx#aK1WIl|z@B3D7l#arqmW`V65gdj`LD)O__i=0XKi#Sn
zleLUOOdXZo=%B@;cUY&_km5vaQSI=CZRJ?=62AZ}gn&b~D0h#f_YzQxk=#2FohkNg
zvD`k68{6f>-sHMz{Ek;ZxnM5FzyyPZk3~U;bP-FT!g|@!jY;S8m7ugZ<OKnoWS2Y(
zkvU%;e^%7U9YzmkHckRy__tDwBZU9L(dckF-EXoG$zrBwx7Bc=Qv33UD|-yJk3KPu
z^4v_R56c5YeKfp()f~`Rm1Tf<Wku{pyj2N%{A4nuPUa*2EDvdq51S0t-3tNH(kV{C
z_Qy+cy%Eqv^jHt-KGHJ3)X2N6n<lfbG+~EIJS=3)1SHI&=aQnY7BIDkP`{2S7cHz(
zsY{bjd$MA-c`fW_$CTkYT@Uw8t)_7Nf5KMYR2PNm24DCipgszVOo(ir`%~Uc6N5u$
zKufL3LMz9PF`f0IHm8gJJDQdE3>%_m7XK9}ll?gNA3Dy94{4T_crORzN43POUPREK
z1TeKe<3_^BASfR!B{|GwSyGum#6jG|f&6aBZ%N*_Jk}ND+$Dn&jae-=xuR|!J;W5#
z>FcaqS6z}0WF(hdF5X_3z~p*s{avUPE0?;Kw!12g6JGTQP_Hnec_arMXZo1$eoTp|
zTI7j}LjtV{fg{i))od};Uc&x9qYnon*U}Wo=yX!Axmdn~I(cj4#T1yM!4Gt357Xa{
z?m)>a*7o$_?iqCKVOt$*0*+~PsbRA9*$o>fERhJn>18~Z4*0}8B{pn5kn=rhfLfu~
zN1R%xW{aehJ!RB+o)vR0Vx1;DjgV?6)^|2q<a`XV?qV1plde2g^p(j(7~7F_2o<Hi
zIa=tX1REtYngnzCKj@{x%ST}@G^q9H(k*@nFa?I|G82HtcE?-w9}IxVV>+pSOcq%r
z>EG{wK0MRdi+Ucue!ZcrUSX?!bHBuHWSd>L_g935j*;^Yj?=<br5#sjrpuPWG?D9>
z?EG(2pF0mpBT!7im8X`)R2E&=5_vsT)x(|s0i}?|@5C#mvhjZv;awB<F^9GLlW!4?
z@&3Y_i0B@OK&dnl7fjlKGxWM{dBXHios-7^R>ih2a2YyS#8$Z6A+3G<vAtJ*Qvo~e
z{i7&}e4QZJdft)tW4ExZx}5`(He4PZ!y6^D@Aq99%ig#9pV<VXQ-8Cjdg#;2|NTE%
z4fAKNf6x>*r3HCY*GLoJa$0U_=f)o165>1I!w*QO{0K1vMY2GjVD^m_VqFkpF|e{)
z&oa+IL}t$;d^WsSKyv@N7bJXLXClyKh4}oJtq58F^a_xQLU;QT|3dVU^-*Wmd(^ea
zH*?i<G=z^V@Lc)kSg^yU@}}qq>w<qPiR_OiLcqr~hhqe2r(VM`_{9U^1Lk2*KKYLH
zK(})-wSVim%GJX^S)r=scAz+?4Xn_VH<nFh$m5i2(7(3a<tx)?aH8Wk8r0q1q8@OR
z<Jdm73w5-0w1(d{*s)6g<QP<pE<(sK+34J^X9z20h_YI@6mCP`6NvbIW?mp5;=%@9
z5L-9V$}osH3TB{n%P+OEvxzW6_aSjJE}2!I_dEFq1@zAHNt%`ZSc9<_EpXz|rtF`0
z`~IoF^qSNda5M&nuGjtAYi1hiz+`M|j)W478v!ng;fP{JFh?hr2MpUOA7L&y3ce3R
z30^&PM=(XlGnD8`_c)H#VZGoE&Hh#m2Bqq8;@A{3#rid!B~q-36EHsr@S`!b6ByzC
z)HJ~Cy3x^;!oBD`tPQF~25Rkb)b&a4vL~lc!_1yh(BQNh&XoyJJEEMYioidxJ?3;y
zCi6{ze}L2reuwl#+E~GG_&EwqNB579m9703rc`RWlqsmgyO(!obXDrskGSJvrf`<J
zB>U)H>%g(rDE?w^$Nn@$7#km0+lGHiBU9+#Ngp2m!KTDb_J@84xP3fEPyiM^D#=4V
zX=ZWEa@@$FeC~0D=~IVTBl(wnJ38;AS`Rs$t5iAXV`bKo+jAJ6iiGqk9Yu}<BxcT*
zb7VS}M15h7dul<M6Lz_Zy;jSTKQiOl>N#H%CU%1X(dPX(olGr)JZU94tb`xl1!UfO
z98F<F2|Sf~)Qi3b!ozlDT3uQV5=}71SQGmGX&I)UY*z*VL^U2ZQ2#4*A0|r9WfD}%
zSq!vH1fiQlhe}Qru!sobA<1=|k1E_^!^DJ9{CC@<m7!s!>Wofq*Rgb?e~$h*%U!5{
zMZ-^ElFG2YjH$TATQZw_n1j?C-|c3MH!-pX({epCD1dL+RmEiXkF<Ulx%T@{5B$SR
z4qu<a(2j^pdFm715~23!But2<7B<vKhosgV7O<W~RF#ZkY{6oq)7SlGZutP5g;yF{
z2l*)55r%&!n+uhy0b^yC%!`)H<I?I>Mxv9hL#a(A=jQfk7Pc94OXNOe(A*D5wy?PR
z3beTLUcl}WN-@l9{}tb-<+4qIemd#zZA@@vjr>CBsZa(y(Db4H#SjVnHxXoG|FZyr
zSLyT9r>?43D#q9@9EuN|&F@TC@+#C`>w4OY(C~bDf*OU3lS9#H+wKt;E$rOEL$nvg
zb$P2pZe|<=xnblU7G8<7P?ke0sUM2*Bt3!pG#u0JaLq@}Y#O_QCzC9CDWj3xgQ|6e
zfVFrH`~nzIG|ckqmdvH`IoEZNW=f6EUeTxC)lcxl#s$ok!-ItbU96zB{-!;PlnyLb
z^;in_okD2xhN>D1%xVM909PumI(x!>>x#H}PWEvUJZlsMzW*lz#Y;+jnKc3S?ENP;
zNVWOqa3?=yr%D55kG8zBx?P~e#92f<3tc=rUsn95#$%_$USm$?x@b4T$)85D615ip
zzeXCzH4>~oi(hJx3ar^`(l6(~6WbdmpG{ylZ?|<~^zV`y-vKDas@kqSRGF&Q%~6X#
zHK0g+qgS~`*qg%@15vLBGoY1LiHFNfg0s&?g#iu}xu914zDYUK!%0!#D!<+GFh=!!
zXzgHQ;Cu}`{*f~Y=14Ya>5=Ym4OPHD&VQUjVShu+@R$(N;q7Oi64TEOBBrN(u~fcu
zY=t%;dX9Y{QA$;T-ZwaoI{FnhN=;nJwg<c|%$t4|p8l1Qz4}deHVe!Q{+}#>PYk0L
zpss|ambWpsK#f{I@SD)-yLp~&=dyYCXDgyjYt+to{D1wLOcV(xSO3s$sE-1?B~-2q
zDX-wLRV4Tc*4Un(sw-|TQ4@m7LPt_V9m<UUy`*O*38QbK>Xl8z;o+o#T^_&9CQ;2n
zkVB(dpYS8Kj4S}*&hD^mix4f9*GAz-)EHv8;IN)LdoQu_8pIOe$Q}JOYTX&vI!lnB
zyKZx|3VxC2dU~J=^3lZXJSlrdZ<%H@=Cm5QT&cQ9$Z|f$#is0tn`y+_^^bH$+#K;D
z2O<Yb4mkZ*uag*<ZF1KqkxAn`)7nTqMmj?vx=rLBO)3WFgFo#Ba&zVIHAg7qMBnlq
z<oGoRa+h=AtQ-b7Bi#FCh!diJPQp#|9cpWaEx$uFXVz?=m8_qYteqg(BJ6L3)-Y*r
zS_K>&@r4P!8cP^G{gf<XQoF}W(kUFvMpz!~KR{KXp*c>9i^=5?OKD*P#&g`KKKzWq
zhn!CEazz4$75(5FJ%ZchMUz<mmSj2*nf)OiLI%Zs<GbwV7;yMbiKhm}p|J7*1t+E<
zmXTeJ@J=SiPq~gb+Y5<y&hcQ<ZPSaCZOw7HP@y6iAD`vn9C|7QSV?e9Q{pN9UiRB1
zchj#lmPoga;l(nDqK2XE+TejgXhf}SL__F;?e+zDWtWePBXBIqqnhFx=~5pl6}1k^
zB873$+Dx7Pof_V%Wv#cu?-Ne?qRn05|93N{{4)?T4)LuvvYdN8T~{&;$6dE%K}o{8
zhT~@v_CkIX(m8@lMW_FDWK_vY=s8x!7U3(C3+KP`VZ7tCD7nSP3St6q$J+H|X2;sI
zR?TxDcGW(sN*cS-K-xmf==llYg|!2QUl6M>9Bg}f-w-C9h0zR65!P*nhQAiQFXvGB
zXH?O$!}b{*`MyL8(Zl-H9vK!c))psW0p^KJ*SGn{CwM*h`6?Ge_{@%3p+x~pHFpS4
z$7|Td(S5xmBM9$z%Amj_Lok=av0tch`m&F}Z6dbxsGh81<~ES?i~pY3KjP9wzr$K0
zWLpiC*MY5D0dJ~^qZ;;Gs6jpvLI^$N-otKc%*cV~Tw>2d^UlCY9v?(S-xjS}?SAVo
zcay%oo+%VU4eSee{s%I6eu!+HWZYFVvmUI;D9MkK@LINl9SiDSgdEb}qYYi@*S_7r
z8z+ySvgL~GcvhQ}t>cyoh8cK{Sk>0wMUwIHBEz(C?G6#UP{!IvN+dEcl2@}sm?s-p
zEa8&#hP7ukJUibZx9@akLikVSG-@s@hK2}Ei4?W3tf?H)IMgjPrmxH3cf3?*^|J%j
zs=3cf#0^VXMyH@I6Nx!u)0_3{jaC_fHoCJ{()jVs(?95ETrDH|rElLUCwYqJzT(%p
z!VH#v9`XyvQ`6*$No}riU~_l;KF#`fmX*H<4Z^`q7b)-_Y^*h%T84otpy6yUBSD2+
zimWlao7OEhD3ej?iJ_24p)u6T5e{acH(C#1vX9}XA-XS$waY8}L>3_)Cy1Q_T5Ry|
z8t*K$NZ$wNeJD;9S}iG=4V7V}@0y$i9?=E7T?v*nuXM_Fb7ulox;v`6GL=A?yF?%M
zx+Q8qRElDT+!MpY8OKzcmIw2G!v^K@Z2$YEjHX|n^!J;skLv>a)pKp4t+*M#J&ix}
zjhP<cGR-zdEj)e;Wp=l5b+YvcNWbn88ljYDNU{ptSgBd#Pbg$%DLYFms&tw~3AF+@
zLa?U6Cz{vBq0#-$FT$z|VjDQay=mBbB~LtZYt(3I)WY^SLZc<C7+mmjfyl<k1STp`
z*iL<ifr=s)$Qe4QA3~9{i}V%Iq$+6*X?_F66E=B@Y54ri0(bWOSj->=-W|}tem@H@
z%;Nb+Z1;lpC)i=nn`BxT5b{r0VFx&fWcRih<F2M;3!b=-N(TpLp73ENocqYX!%y`|
zB=fG1ou0FH{u@MSYo?Jsh{n8ILec|cCbNXJc;p8^UyiLzb-KePvB;zAqMv$C;~ltS
zrmJyGff^j=O)mDRAe>?W1R(`*{p~vM$2p6Zus}4tudWUDsN>*B;Ya(eDV}|%*{klL
zf)z<MJBt`4J8!0zg^7!r)zKKuY=#N#vDtcv1>URWyX_V6q@Dite2?FvjHy)%<I%z_
zBj6K`%OsTF3`GB?&&_1VpDf(4Y^gsT9L>hbA&N-`j?*6;Z)WiWp#^e|Hs8tTJek;i
z^|i{?wA4mga9c~U7q8^Xg3+cxx@J3+3xhH*fX98u*cJ6~4*EqJpI^c|0HReCGcJLY
z1Hh}~h9a&GNV4}zS)e5eD^Fnn#_rI5s$HEna0Bc>mVzVMqEnTJ$W@_UQ*)1yu~uhO
zG&uA4D;q^I;;a(Lp4mlm%|OkERML4mPSX1)jlz;VvKyDM7qJu9QkKDsox4u$xAi=v
z{f(ouvD2-iIAptiok0p+H(0wmqt;J0=}%c`=izk)G-n4TGjz%5Q}HlO-3Swte5yhL
zi_%6Vr`&BLmhfmD{7_HHzxoQK+5kW}_G8nGRt_UVlpq06lQZ))=+Ngrk^FVc8EWX&
z+UPh=*p?7na>VllZofgy-t36#pp6{$C-$46+=oPTtkc1Wrm0!(jccQch&}Foz5ys$
zXc*3PB+~FQ*xh@ny-e`^ie3@rM6FpJ!*;h)p8hd1u>^aIcYR@yU6^UJ>L<&1-$bph
zZ4EwI(^(tPmT`?4bb+~$LF!<eOENYup6c5f(70NOTzb?e2HXTG%7&8?1robqN};23
zSe(^OMh%N#WSyH_8Ux!#NOP0MpRD!kp9{~v%2T#u(YnPh1$B&*L@%(ta+%i7goY=Y
zrJ8$Z31gUf0TqS0Oy7Y)N@&ThXJ)}{?l1lFKqTN6`W<vi)Xm@d?hi=hi%ubDZXj4Y
z&gLxDokza_4xq+kPo}f_w3}M}-mk(IpAg>|Mk=WSOarom57za1ZwJYwV#p@QW;noY
z1UJBb5pwo=<+%`~$SOvP##W>_;KW5-T#?CLs;B3&K;rvUnpGAWo#+ODjDIMC!PB|`
zX#!KLIMG+n1Tb2-;9Ac1Tq#kee2(9b|N0fvVMxU1G5h_{R2;GPo&*Uv;KsP%&iS#w
zMtoNrR?Xe!H-F{b2pL}pc;a^~GLDPPR4rC@Y_rz&T~cy_Zeu*w76M<jfmI-iDTy=>
zBDgY(W%n>-XIDu|6tq&b)zNz==o^AHGy(D#lQ@ksp$@SfaYGJzqVz~yMfvPs6UXDh
zZOx1zZ|37lMGsrV_GO&%Nb-Bl*$bwp-BnJ2e>3BfNTQByE^7MK^(gPgofCF#l7s8~
ze{Uhr!B#U3?mC-s58Q5=p;mZn))q6i<b~L0|CpA}ol_rWq=&)3!iq){!pj~uz#{Y0
zBFBNE(sRn>AEdJdy;M^D$SXfh%|_ksF{n=-j9D|Mt5o{>kW=GS@g`vvmX!*4{US-`
zF$J3P38eWZwu4)^!xjq}x4jN4z6EM`p_CnTrpACXSi{Ly%shLWA&z@y9?Ir4?&{Md
zlo!DLWOEUenhqDYwYZn4=+96y0P65D-NXLwj_)h@lgW0A7ti0=^*#;fa7_&=7AI#F
zq9%$*lY3c=Pu0^Q6vit#%?Vee_M0<4H@Ml--vv3Z>mCw}$I3BZsl75HTpyOm{R^HD
zMAgFWk2?}`MJ+*uGXDWD7(z60c$dC*dp{~%tzOMd*}#{r(|vOnFe1Z42TbA_kOK9=
zG6ck5z+X~`ikptASEXMt>_s)RY09q_%_AGR>3h6Bmu^&WF>d{pFGu-JS;V6A9o|JG
zg=Mr%yJ>@(a|`s^bneTSsBnp%uE3k22s2Tx!3po8M?e^+Wd4%jDQr|hhQqyibEniZ
zw_JZG9~q@wqrQcy;_~5l1Z-Tp4zRGlcd8FAf`A@EQyv#ykyM`k?Ys#fCSe00?knq`
zp&~AOJ-(hD@y!>4$I!6v5!G^Uw%S&%-cgV3GqikM^Y@1!*okN>E%Lh4#hYbt)cb%d
z9SkRbIU5mKd`xspHJCK?U;)oLDWRQJYz^}SRCqN5e3BdxN-S~Jz)|n0`}<!nDqVqY
z`>y*p1RVsO_f79@8n*u3hE?i%-2<ENVZ_>x_x|jIyfHhNgS?iu{1ARQzr5pI;#}UD
z1ApWIH`B?RP=oM5Ajgr3HldcU%c9MVDc0olnXaYr7{$Q2(qM+hxM$x0<6Prh0aHBu
zK18Rv$^4Ev5V>!_U_))0dV*S)!(%~L_<i&NI18C3UY;JF9=t+&k-m#UvOdBc^}_7f
z2q*8w;uWV?EZZ=4Obb5L9N1CO*iW$h)khpxeYiz>sHO^ncx5~hq`1CljP>P$*Jyv*
z8CX)!D3c6w?w>*W+*6$#@g#0$&X`lKo!&aYmS|UTT4FJv?78|zu)a_yYI0evHe5G~
zXl5>YnmpK#N1}6S+U-d0{1VYH9S!AuadvVjk-VAl)>$2kM+c4gK*oX6`qiNvLFuHB
zd1Ob%=;@`$Zg&;-%eB%;%r8uo!V)WTr7<c3VPR?%GId%%lWb<{q@?u!b@kRkc|1Y4
zFz)W|9$bP33mV)Vf?IHV(8b-|J;5QkLvV)>+?@w^*N@-(ez$Jb-G6qgwr8t$cc!Pi
z&zUpakZ4f-!+|#;()DVcINO@QkxCWXIL{hgg$UyZ#l$oSDH`cm-6O@y>Zd7bea37q
z<I!Di@Q~pSS_9cK6b2bNIhj~9Jf|nSA;Z_Ns<@wqn6JaI%uWc+=?Yp_Y`@$*8QVuI
zS2dT<s$&lsTffU5H2V1ywU^3wWFgG=HY!SDXc|{u&-cRnY}&1Htto>6cg;_#8~_7v
z?)ydKxXmn%A}z9a7VdD`O<-O8-bq#|BmWJe>(CpqOe@dw>6zMn!F`wsEb0PzKl$%^
zEBZkZF+|^%yq*pJ?)~MbPrJ53wp|=eL{+*)vKld7WGIq4tp3D*tygbD_>|65t2A3@
z%VyEO{v+f4xd|=Ym4G7(<flM~BEeyVLlbVNflyk}j0)&Rzr(p1WQ&rh@T^m){{<_a
zzvL{eZ(b<&b=|=sCaBn?>IFK0Y`x8rnKXW(sM6e54HTR>@wexEY98ABE4I|BMj$8~
zUpiMl5982XR$(G(h1KNwc<%SCbG4yM!t}`2hZy=tUOir#J?L9Bur6;6FKPnoMFc_P
zr$26KO)`y;S1ld4^*i04^+4?w^|`MfY#AW|&jK0o37}L0La&?Sy+uNZ^l7CQ@!=gS
z3&+INu@Nf`^fg&u%+tlwsUnd~Wij`lswHJ{1z!ha^Q2C7iP`Nvl!AkO(*%_8{vjMK
z)za+rR<hguEl)lINSTPGEpRjfFmrMVOkFNSk>$tD>zA367UA1*mNjUsgY|Vk<W4k0
zc-9!FN?L9*ZCiIleAThFZJN6SoLqOU(NGUHxG7{=Q*lP(C6<;ywTBOM!N0L~i7A$p
z;L%fzLYt`9dZR;5!-#Qgl!Dk1CfS(CfVl@9C?lRO8=O+WI&-QjRg^rE)AhhAo-{JD
zP=Gq0`i2-SlyAM!H*l`iH1OM<X)}rE2?A7$Y(nYO)?bK3w9um;ta4v>TjTu02?8!D
z7zf3B8wFthhW%ZGjEDA@gn-f5`*YvQTsT3jxX~Gl;5aLX-}n>|>U9!&R%SeYd(37;
zm&jp&f`sr7Fha3z@CnI8>(-uLV@s@N%YXantkJpaugH=wYh5n@QTSO0gSaGCq5Zzj
zhp>=7Ejgs^Z+$C5rH8ItzeahjeQ(=uC@--&IwNkrP$KovizwNf%-!DE^bwMWGT1IO
zN(^&@7>FiE9p<#CXa*+*UOZ~qSI%tl>AxiyL{Dh}KqXq&_(eqC9jpiX>kHE%^6u<Q
z*y8W0J@GPj@>WZ|A;>oK?eaZU!83ow*f;Ea7-&+)#)MLq07_J#Rc?33rA@Pwf!D?_
z+nwI)_n`GP&GgfU;B;Y^7279C4971IO&H;6%UHBKH<);tr*)Gm6l{iY$g*VSluy4-
z^d;s+fGF=EX%eu`m>8v;ES&UrLsIX`281gmc}9cwdSz$N2E;UTr|KQ4GQtZ)P~@@+
z3v6Rw`_(47d?2SNN%KAmC)dv?w3zHinBq$*dci42a`cc>n=0K;UJR9n8l#d-;H#>J
zUsHG(T~kgS$8ae1140Z`jLAPUf^(nX4$3XefHc?}!L~?`B;I{8)$Xp(U#%`+!Q?;K
ze%_e$oLK$VW&0;_XwEEmeS*aTtqbA8zZ%wF8GdC)g1Wnp)A@_GBQx2MjOMrX%@sv-
zs!gM=bw)evKFhM0HNONwaPhrIj|?q5VKFZi8e$iKw?Rw#J*1o4sQkbfCkO_$_gb!s
z7I6GJvn)(zY;ads(DwlYTN}6QVwrOg=ZjRt_Q)sWxNs@pA#B{pu3j-mSwc^o)Zt+0
zE*t#y20=}AHeD<NHaE+ghglH1==b;H=ZHSoWUzm6bYs9>5PtZgN*K!r`+cU*KV9g3
zJy`ywB@d}%SCDtG&(E|_eyvGtCX)TG1Pp&dxcOrDqDolf#noqkQ~my#R{o~&pop1u
zF67dQl}XtzBPx?`26$tBB{c1#L03`xDUY^QO(I=;g5zX_Hy-W{>HVSXS1z|`iS$EZ
zjE1@zQstTt6Y6Mpc+qzlqOP2ZEr8o1);PNEuqmH!@*<(Vx)kZ)%f=dIH)*|b1OUEi
zTW3!k+&x%<FjdG2h%ThFM@^-|J>HfWedV!^Hg!k9>t0JgL60`$EGv>pi3zwf&vfaN
zYJ06n;`}4XdsC=h3~@tW9VJZvS1(CT)}rR{#8R^JJ0z`O5)M~v4t%8cUq_O({s)&$
zE{45o0|(p<==I2`;#RsZ^vb96>p+X<kK}o23H^izX0#9?`pAA&%HhOiUk=H>zr{UJ
ztpoEMP5japk52wWeuu64XKdZabb)x0%!g7p9zQm|p027$Qu<?9Nx%@GkZ=@AV(snE
zK40Jn)2FuQ^9+7kWte9>THj(%>m4w^RJIHn3XgqImLcb8)<$yPRN(w|)C>I1E}JTr
z{!P?Es)RhHnbVkVmLsC@OA5J~;Cq}$^Ko0Zp{ec4@i)GDwkt+FCn3M`#G67r=%=x-
zf31-3{Sm&!Sg98FfenOi&ip7;dhh$bkdM9sah7C?$hKDN#+nkFsi{+ue51K$dhFLa
zm_xeO!k@M=>Zw2<oGkjjRXITDh2smDDSFTL<c~dJ*{yVGbUvK)Mglu;t)PT3?h&?N
zoN;{8gSg+6z!mr!q71r*UnesIcN8LxLe$(ueuDi_>4KR3K6iIvHSgf<sZ#~_<c92Y
z$3?y(7gZf8Mcm0eOaWZaj{RO`!zS=l@pZM{jJ0ThETHG#YZC-{iZBrPim3*%#z7GE
zmAd?NP|Q}!-DLOe_c#-_!GT$F%v-YLMXF!unx+nJ#rF}un1!BtiK)>Md9hsBknEqd
zj4t$4NC!_)r#}?X@k>mdJDfXIqZe97d)gd+*Y&=HyKc^0<TWnpZzn01f3Ka9Euqd0
zaxrhjPXyUXx@pfv(+~jz|N7|7jmhW->L(c75?Q4@+vpu7$2+Am!x0b`x&)eq8L?$d
zz`~h0&P%&>Bbh&{n?1{L<fZL6(-a4Ld)jl8pFRkw<R@=ZMA>CEpj9G*$Tog2yWi=X
z&Ih$OXr?HJJ5~iqEYAxu&twU5SVIYPql)>FynhHu6&(@%=+J>w;T7hmRK`7bj9N%^
zlbvini)eoI_322#dbM?AqJN+Z%R?pCDYNi*I~t=Fmyinfe{EUNMt{r`BB{Su55!qr
zPb}-0?be0>YK=yq?@1b3xHPoszoe=(?YX#l?t-zpvBPFLoEn&u!bz)V<POTlkS1ls
zgCaHJ4y=uBT}XiEuB80p0!)qc5_3ZL$%q{c<JM*}Et|uO2Ihr@_oloO^R>O)`3x`J
z?5%1yc@O{H)L|ixVfPkLx|{x3(72QOqoTy$g;*DQXHe4Mb)r~Z>wxiTr3Pl;2N4`w
zP%~trlKA<53ZQdhx1r#{oRZ@pnhQSFp?j8=6b{B`fNi@-P!=;R^yb@s)yhPogig@5
z6=J9w--~2*oW=y{@ip#<RO@_MN+*@4PEEC*Dxc)PSNHjBwT1pTlUkk14<$%yC$fsx
z^ys88r(l?Mrs3##>dy@BiTey)im-N0sthA=aLGFaXSyY-HW=`{si}_LIaY|rSdaS(
zESMzTfCZ!|J<h8yqNqexwQ9#I!`-f5`a~s@xf3tx{XBs|RBiKaZ-Vod_L$gGBD6vF
z)Smg%IK^RO2Nr_9<QZO=KACH-_vWCD?p}s~Pik*(NIxx&Kz6&inZ;XDj{*9nKZH3S
zZexQ${GxhpW<zI!gp`n@J4YYu1)}<o*UBDGfb6FIe&f6?hrD9a%XnEZ_G<l$_ICrS
zjgFWrVUyqfpIot(SKQ8cvR2>_u?t=b7t3I^{VdX`OS9O>-j=<)9FXER3!uA@zHHTA
z(ljV_1uSPZc^);rdAy%2q6#4FrZ<ZS^S(JWqyK&PLRZSay?9_~$gSqU6JIFSv`2s^
z1(Mskb3{S;Y_KG;*w?1f)&*5AI+pm;6;rSF=buvlbU_fs8Rd<*o_1Z_1ha-!P+PPR
z<a^e2!v8(H>)zn;^Y<>8K6bb(x{TL9OCFU^dZ`&)tN$aJq;hAF6uWC|7B&!wCUdvW
zn^f&%*HO}t)acfMtOt+2M$FnEbhxmv0h|X*84U-~7reue#jpEu{}fQx;*zG@;3XHY
zyx`Q08)4?u&ZWTgpzGVpFrgbKS)AcJF@wuB#ZFTb8nP&9ZPoj!%4w#GhD16@)OPVX
zh|%1bX&GfdfL|55Wuox)!^!=s`Q`II%V(0kze(`4l$a?H;mTOW$HMz1*51Zv83-2C
zLNXp1)0i36S?5iWtr~s)<-BC3^VxGloi%4ghMw9=M1N*%rZ2qpFIhYLl~!ifS_@WS
zp_5Lzfur(6P_HhDrf5KxsvWn5Y&1$W>%Ssa5byfTHAMltbF0f$$1HPm@Fxq9Uk6@>
zAYzUK@b0)(l#1!@8Bx;51Fe6-4>Vi4E-jq0>S()5X$c)5r0b>E*RhX-+%3PGbximY
zZjKHXhjHstUPSmQ!W1V4^G2<|F{i@EEkRsKwQ=805y1OaYk=d;kQ2cxEt!V7H1_(P
zN`&$TJ2qaAIoyv-k|#}?_Hm?%=%Z)-al{AMeh{E3{Nh@6v0KeD17UR*V2l-JK(+f)
z#aE*eVZzP#lQa)<X{zKJNCF|0h{PA4{&z(E>qrUIrLZQ?`ERa^4>+dY*N1E^$(3C-
z!N>%?q8$$7_3}i2)-}9I=^XB(GD?smhM=0!G95|ws>iflH>hz0JK_g;0%Cu8Xv_;(
zZ{pir@jo*ri?Qj*(d)DV{nuftG||<P>rw1vIH(ci_}88rI^VL=zh%}mD2e{G&yr!u
ze{pLu_-F3X$X*e_$396$z$L5Fn1(BKm)6xU)?3V<H~@L|FT6SR*2}E5JAD0bO%1Ao
z`VIar-lPO|R)Q495|L?y59c%L!P9J)5!0K;)|WKB2_I))JO06D0FK`aM2jwP272Fi
z|5oBgum8Z&MAEOtDQB~n&=G-k^;o}8Os&{-pzGhl11CJ8-rh;SRlCpvT@}^@F+N{j
ztypB7k5_)Hney`+vh<3&xI^=T*THT3D}BMj6Xen1c5AnprSoQ<O4YyMzR!G1y1xj|
z>~U<cbsMGXWoNz(0jC2J+ft3HC36MSa4)3x5fd67W9}9DN9s0VlooN6YtSBX-`ayZ
z-ZvRLV=;X4qG<MP(^>Y#IPe*;lfx*XVa0;DZgHWUk;6@)UnP&h?ZwbKnX+)GU|1g|
z&~i>RA`A_DTlrSN*MobKc8*8%`~}e`fQFI{{_utI3d{lpSR$`Md?0JVQyMU$X6RCd
zl*`TV$k5Ewwr1QXk2%Psu`T}Do&Kdq5OQIS4pM2d-wjo8$v|JY(gOM$=i&2de$J|=
z@4qPSN`KfJ9bq_lXa>}Tr&gV`;#~lESWgI4=oQm3)Sqlo<Cz9@-NG9frw1^`d2m~|
zx$<LsuIhoq&`ow)0$GqaA<py@mC=B3LaN1gn9CA3m=h>aChLt5LD}vPqQiYC(0oBv
z{d9Aw1B9UKueczkIz|jdzc(-LtzGabc;NhilfXXCb96wH5uXO}*_^=!ZkASM#AHQ$
zQnfZhDGL*w3Laa{W_Be8TJjl9Ouk%u$1zcJxB=)O*<}x@JuTN^@rcC1@{0Pr9es5$
z50MDT&G)aLmrip3b0J+2&%n<=yzRBOVF*1UWJ>x)2m++Lyfh^0SoVP@RZ|G39-&lT
zVw@n6B()|xUiCw9$#g6COnm&5TM&AZXn~rwVJ0=cc8?T(1Nm_D7}!t`bRxpzWp{B?
zMGQ!JU6;=uk^J=k*y=qr7EK=U6SSxg+s$)K4b;P{-n}A(!Nn@R=<(K8?dv}qAz{Q<
z`y%`%z9GG^`nzR&5&r__38w{7H=)T*ghlm!csrUc)!9`4@h6C*UeQ@me*?Z<QF$5-
zrv=THgZJJY+{5+CGj4@&c!u=dM`I`)(_+B)A8FQNQXndtbNaDr&78o{5*zuV)8Z7S
zT)IQgy6PI9Xfw-dkks{-(b>p={wbYG`>L31dr<GI%AijYsRu{PbI(8dACO!snDiLU
zqVP+U*70%JmLG)y8w^5?KJL0>kITOKH8<%0(rtZ?M+Q1V#ozY2w#3yx-0`w@pa6=?
z9TQ=>9p(qr#XV^{0wjlj!|D5=&><Z$N($38iGFQWi6st8PfpJa(Vc;gEFM!jwxAH2
zom?K)MLs<L-|g;BI;|J*C?VSc*_=stP`}v2+3EP@B5h<rD7E9|HH~tr=GMyTQG?vh
z%v=WCLkw+=jDqGk4(}Z><PccWV?e63?di9lx@GVP1-{b-jcX2IV~3~9-{;y7W|T4c
zxukM+Bn2CKDXN`c_srT+s;QO^?nb$@uK%EHI;Sf4W2xjSNlqpv3Hd&uf#c63Nb0qo
z`(;&WzKZ99^yM~~jAn^q7E{+>-R%#{pm>+dz3&dqEEDT>0}}I{#tCUpMgT~kkdI|B
z@_QTui?QLOobAeHvb?LP^h;amq?81*PeSJ7BMDRx%t|F%4To7e1AY|D2xsYS7G)rv
zGtk9%gW|Z|m0QKQj^Tabs%na6Q#d0-4eMkDgTF9#UNN-kR@*+2`kxwf@TB=N!tl-`
zkqRs&7MmqI>Ya!ZEQUgq@`3)0Jd^$BV`wgzP~%N&xr|1EgN%a@3HwdO2d0nQQsqHp
zO8i~cD(J^~0le3ghX=%cZ-)Qi&H~uG;2wsIObuU*7qviGV`JXzE`<K#=J(;J+Q^Vq
z@^9CVh^`#wy}sl^zP1!l-H4mdYkk-c^9MoeK`~JEH1aL)Z#R8iv%veh6=MD^12;Qg
zrg%lbm>ikF?k7!U<Jrt*1d5XWPYCRTcPk>ve5R!>iIyw9?L4hO{aoX^5sv{6K<TTe
zRi*#xRhkRKrM@dsjKd|w#@lMmN12tRQx{*LNP;jvFz<n6l8Lx1gzx;m>|aA<#8d6)
zgM()8yu$*s+nadB1+3N<$IGkQ8Wpnb^X=zv=%HTK--T>UTR>lmPuVL5)95Ap&sP6y
z6pZ^M%^7U=QHr3MLV19>sO;y<O1Jo_Z&NwNM)Kgi!7t~dBPUAPMVBeSaIpQ!)oJlf
zY_1-TWHdc6V8>LSD>um^d2lHnC3WU^9z8GVG&vFV2XibA0T@n%a+BU)X@kxZFuc`|
z$GMi53i^7ByJ;~ypG<f?x>OW~IZGoMm9mu^FnWy4C=)ms1?w+QcF)3`FQ~)xr0zmO
z0twG54Z^KA;vYmn!J16E4?qqZZWS{NZ<bPwjz=b;A)#4{<|Cps%g-Z0Tje+C>jSAJ
zs9naw>oZ;u0gvUNBSaW3+&rvZF??-b{e2J#a_(%Py~#aJd%cT-YV>YGmumegRyCi+
zVsA9yx)bCwwO#tl$QF<5H~6I$bJu0d%2blM<#!#G6ICi`@s!CLx@`X=Q6?eh%<?JR
zc$YeV2yu!P{*FlcZ%d6KmSTRx%<IQGPG4YQbq&P;K&G?lH@qkRE81rqvnae}0<z<D
z0U`mu)Y#nmQi*pdr1?#*0);<I&y7(=z%H`lABM(g`u4+S>^+Rt41hrpl2>@*n2J@E
z@fUd4wk>fB4z#7mYn-u(zl~ikn=W??j+7QOa6fANl!$sXr#PW|SYG!}&$2A1a-aa6
zPHdSGK)6*oDN)84Co|STB|=7>vZsgV)|{*Lti_PB>(pR0^13!Y{OOLhoRz^b-x@m`
zSka4Ujz8xP4#XXWl6yKSqQXv>`CuoCZg7Q+J_e*Pre=P>t!TN6A0T6po%`LPAD7H&
z8|sSi^)z^hn*C9$oq2&t9W9q@AWC*}4NsmIK#R^7o-O9T+tCmHJ_OUv<&{KuGRV<9
z;#&3T)n0#ls4+YH)m;p=N32BC7ISd0UyLYI<nNF(VAnaCA2q#88GVi;E+nwR9j?91
zm}T`(2E@yK`9##s9G)2}LCb#ihvK}>ec!S2#K1oNpJ}>#rukqD#-7x$t;6K#Dop7q
zkWxLShwEvv@KZ=RwA@E+5_&u1khkxL^)1?%&d%uNc(N&XyJzKEy&vWmL&YE{vcL^o
zaF<P$8q-{bE$7rxzaZme)koPr66T`hb(Lq?A%9a@q_(JbiX?e9rGykGIfC2+Y(Ow2
zD1bZVp(>F)Tl^FLi)A2DcYgyZ(g)@b5bnH7#qwGT8)`_U=Y<~%dSLI5Tc$ngaih_l
zntC6+zdE3I--{M?pHY&OkTOamt}t!moXR}1CJUdCu&?I0yXP&y;WQVmR;iGr-S8Yg
zmS1X^TF+(v^a9(sdAZPyX4KJh-TrQ4-;XLj^>4j3pMCnp`Z6}{B5|W_?oxdU<Y@4K
zJ1heGyoW-v^{<#+{cidhygv8Ao-sg(r=g@oaJU5_q~YTByhG1_;f=0bY3;6bXn1oH
zJ1&iC7;?=U@BDkt+lA!&*VCt^S$ZL8(xv8h*7xAH22zI`%Sp_{Qy>#P{%E&I@#=el
z%zM2*8O-nHFLXcDrRkE!N}zgAfIgQH3AQ7sKjAvyZ+|F9Q8(C)UM6<3EG_P2awk%&
z)q>Ca4d~AV2HbNd7kEwPcC~*E>^(as_0IL&(G8gLild<MGOiZGq~mn$C?;uK+H1EM
zZ+$bi)8^|lIF=FV!xmwUu!~k8_g5$PT;6=$cg9ZSLqNmPceSaq$e=X(4&a}u4O?k2
z{_z+=X!xfRs6Z)8kb*$i^qx=<-_ZF$(~m7?AGQ`X$Mig=uji*bs(s|nFLcBGKjACp
zn0>-K&8TzFnN!E*4bB%PkNw1=B(W8;zLW~20h`8s<7RMS(At@x_08JO!h%}wMe)y@
zCJ~4YurTQoqeT6;CoL(U+2vE(C-q6F#*UOgLe&DG2Rhcp!M|7rb~2dyi(~BgDb#*f
z^gnQnrr7E=AKTPdB5$JO>%Ndz2!C<ItQ2qI*4>j$9#@-oHyB4>yDktRGmU4%nSLh5
z!mULaL#5tT-g5!rOiL4J1gTmiR^ls)70kq=BL>lM;`@vK({(TabK=a3!v`(?Ul^S@
zlK&rfMD(|LS^|m&YNuy46E!ITlPCVN5J4gXbicYOBHWRnW}$u<omAS_usSM~;|8c|
z-`Emg=gnr~c7K!7^5yVss)Jg^+wvH%v1zSYLJZfn2udq;?$uvYva)bv1y&yWvOX~G
zpxLv5SyykRUcj`*30@c7j&d>pU$O)1fAKA_NAP`^IOR~{Q3gbnpZ*z%>NM9dw%Wae
zg7SZ;nIfyC?9^w`qJ{N0^=z*m=S(}t_f-H&0n&9v{Jd<%rp5bmTI{^Z6;J;5t!f%x
z2|c~#In2Fz26x$TnZawnpL8<NgY7>oZ2689I8!H$N@**Y)EbfCYu+Ec&a2QObndF;
zUh;2#^bj92(<J@NIZSWWuwsy{{StQNz4ISnYXJP6wo9PVPx~A8Ojyz7nDVl-z&Szv
zda^hEAk?V`(%n-nQ58gy{gC}!-Go*X%}?nQi-&~S77cx%6<(a#`ZO!y`6bvJB8C@0
zxa^Tt?Nnt+TRu#W{r<LUtKP3qGD?Pj&2P+hXRw$Rx}{b5I}P+9i~{G9WGrbu{@UKx
zDA>8^qMvQCB8#!b6LRy#<-poHo)+x0_|Eli=2jcjKq}|>ehOy>w|y`m1Uc5Cbf;L@
z)Y|MW;Sf{*oV}<}8DzetpDK=*b}$DFwU&xLnzPz$%fCO?-_S3>S;C@Yqu>df$=<6k
z<pjU4Mu?ET%l;cf9r1Nil63m(&uFDyu9Xr5x1Fe}9FN0zFv4i$3%rl3;f_eMuTdSK
zL#<(4!c4FyFdNM=iND6<oPzU{{;Ddg>$pwHZ#rjU@taEs-}kz@ObIbr9q9pLgcOKw
zMw{t;4)O=~5(gyctEn5?LQcU^Tl<8g7SJe9R&54&u6*h#Dn0R`-2{!B&9JV%khLIt
zd*{bGaxF4u!`+UxsaAI(xl;xvWhrNVsRh*ROc;6+e9Mq1y~{76TzR3_X(>c%*&Yr(
zL(AYv>LCB{d@5z21E2ebe-(gCZqXvI+9>-=NiUVy_~iZLeI(t^lWlk#VpO|TW=BJy
z!ipf1TbsaLb7ts14qB*NV#p<DRcn0q^K+&!j`@QVR1E&LZGCHZk-!m|YY)~nzQ|>m
zM$~xxttjVDVyjdCV80_#opHDW#JXZOIAtF8?8r<$?hBqgSMBPqDK+3=znnE8R!eYn
zO`MWdY#7{eHH0}t8p`0q`UNfMR!|yi!2p4{mLzm9bi1yGk2KUAB`lzidCz;r{D&<8
zY&nH(%Nq%7nXk|fXA{)HpmGve!hg&-Wm#^Lr5g6FnX!oww9L@kC)AV{@S>lWX=`*H
z@lHyb1f7<vkQIU!y}N*Rmn<RpH1;^w3j9;f6vLiDe|=3y9LzJU<-J13(z_AC(Dok}
z{xMy4@Otk#xuBvy;R!#{Akgd!c&Gaxal)|ISlo*g5@<)xa4+;-7wPXw?eiG^eKJn!
z<GuP?=IymJ|Az&mmo|xG!5^{Y&-*lKF4Wf8vRb;;QGR|@&EGA6N%=R&_D_YOq*($>
zm0R7*It85WwE8o_?0R*l`Q*pS3>m`ZfDci!W?L3_bte?vRe6(f<QI%E@u%=so?oi@
zg1LC>4`)$}-<6&`cj~=Ok~B2s>2Fa?lLRgE_g;RfaP(wDcuDLAQ|08B{zrHz9M4Y#
zG4+t~3X~D+NY(&?9j~=DLG=@=oi2?ErOc>Yr;Og5<DKXbg_3vH+oxkwUWbLMs~AT2
zl3@FJw=k~92Kn5GM5xfCVN$78ReMuwGrBAEKDs$C2t}v20tavqL8hm4fq7P+kK{w-
ziK%4a>Vk{GudkrTLv1=zw3zcx*I133!7sApB7?+FL3@C6qYQ$0jcwWi&*Ss;NN0HW
zv@-a>tI<`gOD<EsR>b^OKpFLGP8HDH!E)Tph$D^hx)w#n?@3TmzV+Z%$39#$pGREI
zX$WQeHGJbMYuxOXmI767cJZI{L=Fihow6i!-`YbuHuxheS;PD|=8NjfyLV&=2#EK0
zXb5FFXqconXr$(C0FoaL`1wu5K?4s00>>T#0`tSf!@=2%&Bff+)!N?Dg%xD?qrqUs
zUVp^R7d;-pcp%ZyXt!AisU0k}HR;2KpMHSWHIt(XHN&2mx7ww6&vgS4S`Su4J4Fjc
z9L<#|=J<Bc9d5jx4P_nUi=4#WYlW>WSl;pOpA5X+Z996pJ--3BOL^T{Y%@zy&ogIt
z&K|xkYu&=n9o-_&YrO9-O5Lxne%&HD7md&O+S_+;FZ<iKOJOsIXD@RV&r#^lS!=Hj
zXdcgc{^w{zS!;;zU%CLddO^SU%d@?Kt$llsHZN~CU$>{1Z_$XBN@FA+(rrTPxgso=
zSNliXpcau1K|3HVn|!^qy=_tC_1b6Pa$)uUGSRQ)0aV}p<;&{joD&f9g~a|`M1O5f
zq{jUkFhJc5155fn=%HWsP267J3+r5eBD<g20zJ;)c3XI_z<Lbz4ZOXPp|rL7t#8hq
zrV&4P>mHPNzr)@8dG&|=bZq582YfqSUZ3&eyLBm6&w=+Y+8gT#t@}KOI}u?vSK!rF
z<_h8U^61pb!w08@-fLAq`~B_pbgRYNJLc4%mF>ccjm+KS4z>7&Ev#=MN(t=oyaTI^
zitDt0G6$z`xVB+%F1)ZdaDN^b7T28SAbfIm7x(vV?QG}vuzhWXx1^7>`pq~@;RErx
z+U`4R0owUa;~dW1@xLnzuI9#u9fQve$li7wZIt7wAMRZTg4%o@k0*+bwjx*7P@7)4
z+@9_n5!W7E-!4J7$A|3(7mgms-CcWZ4zB)Xe1-;R-7CYl`!|nXBDIgaTEJ4;%9w~x
zhlqjk0Q}D<c=wCu&%e9Z&R*!*AKIrpo?AC^0O3IScO_o$&Hj$Aw&%MekPry~cq3vy
zNITpe*}C_h8Lo@GUmAt=9X?hJrd#<S#jULTt-&yL!HShh520plr=NerQki-1tt9>F
zEU~g19v+uKU4Xn1z*VLYE2BPy>9B9Yv*EQJKHpQeBhHjTt@1BF+=JDH2&9GQeO>(-
z@FOQbtv`B&Qn3y_*EMkR;n5%#l<viu%!6RMc!q(G*a=4uQlqy*9!(%PPNIE*txJ8d
zTH6(haZ-OP9vS~F+V9$R{G)v9e&n-WSM!f&aVf6!(Zkdp3f4=08*l}#n&5_5E#(E6
zaT`BV!ww~e8jC6|=tyd>Zf0ED%D3JepuAM*cYfmz_~X<c0j`^wV9pjWxY|_`$X4uH
zc66caqz>)1{-SWaN+!>id+qv!g%@s9#Ql3PR>H$B21m~0drVe_a}N>A>Jv0!hAs^<
zu4WhSu|(+`1f!Ev%(rdtdNIB#mX7hwiU^bfoW^ab5~0RId**nIPjlo#rMBu`Kmf|m
zCsTuQ<Vnv(XQm=NL%J(c5L@c`@^iyxT;`GW?swz3mY)#b@;gEr8J<otNu!?Sih^lO
zF>`9fCP5iN=M;;7`I>|H&g4E9*yxuBA_u6!`%SV`M|^D|3Fad$QEX7<M=cB<=f|f-
z0=shtJlkcRL}%N}E(f~AXZKjg12I~Yc_)p|x_!{Bpv+eWA9$T81AT0pox3X0^_Djr
z@TU?zC%c~3?dx5A2Hjw_l3>FJ-|}DMja@q3n@ZORLi|`L_nA$4x7mdTOmU1q?rX2W
zhdlz5Gsee(_FtunoLRzKv3|yC+j{P@u#bg|^2GNyntgppLV}X9$A&!`243UBadbZZ
zmKDbEk7O4|9Y5u_aI0NmWSJ3laS3s^YyqtL3wk$%lLz0;3;{qD-+OnVG$X=AuWF|i
zC4RSz6!$ifZ;fKkqLzpXUU7O8bwLfWN8?S1l4h>~jYHkWgGK<=$6=bDOcGjWmo`x!
zUoj^dA!JMslTSL90)BTEU}VY_u@2zhoGr7^wHYWLm3i?jr%DDRB#N>+phDu8xbZrc
zl3*UU_6Oyza>;tw6_gl2PoV|$hx|Nf3s)`<BWex4;q#Q}pcG<D2vCk*nKl+^-sSwE
zKYSZre>q1-g~Qq@3Rkky;M5aR7But6P6vCh2^tslw(}tqxZ^PhAjjGGALQ3T({O*Y
zrC4G+!!{_K4z2&C*aaOmZsru@wtB^X3>TM6BEBuZNAy_BYQ-{r;f0G~^pGSl1C;^-
zZ~F5AB+(+>=&b(+e1&|lC52F6Hv%%r_$9Xh5H8NVfRo%=puz3|tIXal69w|d0o1?G
zUCkKFfdbR6d-o9ltC?aB0a6^CK`4b|n>o0Z)<cK5rl17{aSMmVkrufhvBnQlw!{7~
zk{4N5OB-Nyn8O)sRbCrMrZJn!YX}|mO|4J?sYBCT^G);Y2$m>vnKD<``u3b!(8mcR
zjA$FKIFdR~u&8=`Ux$(v@`mRGeclsD4j6MoAEssC%wGrey-LP9x^^sJItjO%LGh|X
zS?nzup;Yp$5oC1zsx^lL$mgaIDr9<4I*yZ30%tq{#r=8efqRWaY#djUL1CQEac4Pq
zbuD!6N>%Ci)e3Jy#Qk|g@OzI?@%q;Nd%okVhTbWESeRdowp;7b=dX{1;|=i;I;eqM
zj2DxIX$inS#kZm8>iJ_`No#Z*5$Bv5c~FMFmudRy*@GFT3|sv0v5c_n-Wm->(n7dz
z;Jk_)q?zROE_Kb9$6|zMJ}f<OMbFe_Ch2yYG2hxIBz#&qNyQeHQRPMYDt_(9du>5_
z#-1T_r(BnSrfhS%tPKBF1rP2R8WpnW%YFMXss%v9f`A?^>o(CsuoD#--37`x_5SV}
z$A*c%c5y6s(0RTdfog2aFty2s@8)#dd3gskEX^fr_BqEQE@vxxXs|9BD%54}*h+lu
z1#REnxCcac|FMbaQ6L;PCelJ)#BTh#*OTNB_OPSAl%;xZ>yf7TM`x3OZ<G<Gin|D4
z2B=s=)?ISTRYsDLZNyJ*Wao(bjvYkdYOc$0`?#nZZCdp!Vlr%tA|v#{>OVGJ(3t+E
zj0R9)ZQnu2Z04}G*xhD}$W)+y`1=sKLIEMB6hleB(MFg{O|Tmc#SE)v(8Y&qvAbpv
z^~G7oRGwQc6On`v1UY=$86{)bhF<>)z$LccE`+~?QIA;Izw%^_zs6Zq2)$3AByMpJ
z3tt*$;mthuL&Wnx+6<rxbL2}>)xbhztis!hu}&t0K06X|>&&L$`o%6tH};rbfUPsH
zw=*|Ex5ytU#8*<8n3gw)jBMl!PGnh<0)~Z6%oXwNfD1yDoXM*b=wX5v*^+r6<Y&6^
z1sQTYBex$i++f-|y*9C@JHd}(p+J<D;B(aQt2O}R*pr6}AyCZ5!yhI09VVjpQ>LC;
zuvQZ^3jcW)q*KQ;c}JFhb<ll?_pf}q%cTwo`2K4ziV&^r0B-w7e|bY`r1Gd`F9bUL
z@>|H0rtEnq+X?3Qkw%(+jT;=G5U*NfWte12PTV<mNJbRzvoK9#2P<6vWvr-74_gDw
z=V%YfeCpi$KTytG_UKSo%!WM(v<Ptt;t>(gmCBf(*f7pPlGww{J`NM^>yKy(C^h5|
zheE;#6Nok0q5CP)N}^abW|S$aWNxAM<y+hbO^)aYW^mOpYf9@5D8tdfL-4l)W9JQm
z&?+A!4iwBjYj(|RLC7WaJaov!hh#m1<tr2T>5C`5bh=Az=5fA<YU&e_dzWbn#p3KJ
zz2Ax~Mh$dMh!J=JOuo5R2H;d7T_aBsK3zAV?Z`mw=x+`<2CiiOX6sW>oGlKkaD||L
zTmyn^k?E}dD%$v7!Qg2i=!-hOzpLSOtRZz?X1Fkl;cd9gXZ#AvC4Hf|<z5$X_)XA?
z3PltjCPLyUY$7MPEOZ|4KEhM1nWDFoE`G8olOW!K4dWt9PRNHn&Vx#brDlBKfa)A1
z^?T*QU<d=$K$e7%#|cp=gdI0Ro0|n`{gNy$ukGNZAiqi{Wi<r^mMk$_bep)3?gVL9
z^5_Re@d+<sM~w-o#=zd?jk&GuAM#N#UKwa*bRZEOYswbN)Q5WiT69(64^c3br|Y-p
zJkJ_93!cIpIwL)I9jJ~X6s5@U=rTp`6@<z%+IG9*bLF5VlFmk!<7f_&LM}$Hj+u#u
zUHkQ!H3D&q2W$;+qD`h!|E8Rsq1)BTo);a=_d*JB5lWJ&yH&*-KJamvOdjBo3G&1z
zhV<LLb{Gj675q2y_23b$BXWoPqSoa&u$bbCNlbO)QQi@W^Fh`hbt~ywh6d?=#Twc0
zp}MHbCy;@XVt-mHFywZY?iUW$)VkX84_L`M=KV)i_g+)rN?rbwPvcRrM`VEfx`zCm
zmhfqM`DeonIb7lR^C~;>DNJI#3ZAr&FiLIexU(#)=Xx{v#I#^#jc1)rc5O^tPJqh6
z<~0Dva7}4t97;OW4*8X^i<?ygS_cluwMNRbk)6R6CQh(W&V?^&4G~A~zpBQKAGKvz
z(w>@Xq$~yqUS7o4V}(`Q%%SrnZ@H<9H(iKDzikWtR%{J6J4QZ-wx|f0vVzJG(wxKq
z<?fkbZsmkAPhKDjQS>,ZHYI+%vP$gXLYZ-%GCu919}c7voe(h(|~8SIq5Tk+Y1
zk`1_?t>L_^oOkcaj5JbK589fB!x(!;<_{jPXyXTd5MoGDk%h}?pu{MZnlWJHH9)9(
zvItlbu5#_gpw1dXmkBA3FV)=8JAAQ@EoDAPZDe^!a=Xg4m7*D(>e@9CYL;nT9Q`Cu
zm;qChzK6x!{MMTJXKECB1UaX|y|VhUw_>Q3N*9b{H-D9MFG_NMAWAnC<boW<g-*Bx
zU-K8(KNGC6+BY_*?1XORGP0A|B{V0Syg0xM2R|y2`KioJe1*@eAERa!Q1)EzJ$CS<
ziU+Imbnb!6uV+V(;YEq^NJh9muS>HHO64}<V&f%g!5Rz28N`Qs=hi0M{mphRSY+^l
zstGR>;$kvE1&l;7bzHBaDxXRuJ1$6mhbsbxeQb(Ed2VczO9SiKQyp3A`UI<4xIbd_
z(&`?WyD}FBh>;@&XjVy7w&=ejzo3iEXcS7kp@m}^C$y+bZg@tkQ@M+N`5r;(^sJfa
z^kP6ktFxzeA&OTbFBjSSD!$aK_*Sg9IO36Gx7T=^m=M8sRup<K{4HV7oBt<;>!vsG
zNw3+T3b%j>4CU-0oS>Ik`vUXBTC=4DcDr?hRe|P`-cGmW_JexQ=K2+6Q0dy8P5`0$
zn5|4WDdjhT665`+O`%<_EU*IK5V<sb_;I~lvT01KUfF@k0Ucpazfto65s4yVNDw0^
zghag}bt)T*Q3xH56Ex7e{F@I|1(pNA0{)$9L#FgI*<-FjMRc4QHB&!E*>>#B*F}Cz
zILgf~)lqXM27ih8v70aTmO?zXF!YrSrF#|dX71)z1`s(Ya<%Y|+%aN~NW{l_ZI#??
zcU>mSqJ+@O$|JO*%I(*bBVqJf*2*A5v(@N_H`goSj2@B|QKv5n@MIkI(Fy^baiawU
zS$%zMs65EZkxDb}rQvoVQKWOK*<CzK7^cbq$0HgeJl#AWFg@hQT;fs2=z1n+(`4tY
zYq{`{CCPNfZ-`nmK;yTakGF!~R36;x5*@i3J><~XCRvlOS%YjB48_9T650>`YQsC)
z9w{nto;KT+NnYh^You!S-4^hH?{i(>kuL25?WmJFibT!f2y}>IiL61Iu@-wQ4|DAb
zm>U~pUWQEJi7nz;=KF&T?;T8tfCUL`LDKFx3aVeKa}uQIT@Z{Nnlm&Ec|YyzP@Pr!
zmqOO8Cm#paNg5J1hOD)fXH7Y}Y-=Jsy0S9=DE<1}7*!vskdS@ZSq2cl+*l&ZaPgrA
z-U_+Ea)RWi1NB@@^$^@^bsM7U*;t;2KZd#fiGa<1D`ETyi)vKC)pe#Q-Z{GUaQ(v#
zVf<jlCzgmELT$O~Ys3_IGp7lgu5wzIj=D9~N+Izj48uoj!X?2*AL8CB=a1b@9(_4)
zl4n?kLeT9$ycO^d3*ZtNn>o5;;)>*U02vU5gE_D;_8eZU6a?c~^pK-G)0%Q(w^z?B
zuD<ymo8Sv97&GxzC9qr|V9D%rxl|4Hw(r?Jj6YA>We%($uQUWHQ8qCKX(<vrPlTN2
z7++<2@UF-a@C8~0UE#nObRgG8A$<g0>ST7V@Xu0*aQ#kpz=`1(u(-5luWdXjU4rz3
z=pd8|7pP%<j&<F3aZc}TU5Em??5I3cT72cW;z3p{*d%qz$?XAFm>-JfGSVe(@`@jx
zBFE#0m%dx1_toge(u|t&I{e8JtB^n<>=^h}kjiHr`P9=}5?i_ud|lKTED7JNCE|Hn
z)_f`oBW<z=yp?#cM3MgJ-&YdQOv3Z!o3ay%AKn=LS8|Hnn!EjA=APH(Y)3N4I?08K
zjptTuJmCC=R1@|5H?*vfJ7nVHQY7U+P%N6+#fvKi)&99N@g(anrZDWj4MeUcL!LcG
zjJ+9!?}wYW$6M;2DX22L{DX^zJ9Ud<7abqVjrh*YfzYr?r#H}fYcy2GOY!Cf5h#_*
z$LeJjKE8)KthSRW+C|ZBtG?|kt#b}>c@*O@=J<9D7WLu?^*QG2_G<+7kx8H%4Ryz7
zzC;6we(KiV)5&4Y2R&k`y9gz^=*j>knOKrwt!!yA!zrzmNnYm&w)N{Iq9Sn#KBX+?
zb>GjrK<Nwj!+{A1*3ng=!%HX>)3Ar&t5DuoLg+2Xl3Rof%NNtO(F#n{>R*H4J1XI}
z;}4aD*rQeMHogtM=6b~!VNJZ0&DII_%jZRn<j-~oA9Vs^7T|pnW~ZfJ2{Fl%*~Ob$
zq&sc}jg2jSyuEfNWUzDpMukra?7o?)n^uMZbnt^`-PXV6LPqeEh{aEWH{$UoaIr$}
z|M<g@Ax?yM1YdKPUwCj)xT@NxSR!S3yHW&soLQs}=<!>+$9f1^O36>Q=D2Oi(VY<2
ze1X*Iz(oxQ&y;cv^|U+IgT}sWu3G3lR%eZ@nvUZM#d%vcr-Cg$CXK>O1J1mHoHa?n
zP%cX*6ZFLlO$%h?68jrOjT}E|i{{clQUT*)?|`)v&Wqe8rqa3rM<tY%$#r1bcsob!
z`aa>{FxkAJ^fa||ZL~5q+R@_KQFv;<PFCa2*0ttmd^mR((>!#3Ja@|V=Kg->xC+E{
zJU-kJ`aE7?wsbEU7)|Y*Z4-jNA5H*$Qx7+<?P1+D-D{*9fX@9PvGmj7-rE|vpRVn*
zb^hz+Mr>G|N8CZl&e_=|*d({xByVudezL}13Fv6^e0zD@S>c`1T04u)>kbrNH+(w`
z+kwvMiU-d;9`?QMZ&`Z0wRk^NWrm%fIT*b?PEgmfRmV9r<rOah?d|Q}F93g5^ZDs<
z{c*)TxuW|sM<({0N9#ug^CGYLd=D`RUY@Kr?EQqbiN3En@9p6#LkPH=yI;MwJR7ro
zd*piG<MMrz@AkpV6+vFHBp2Q|ja$%a-uS4X9!{NJdxRYy_m#Zvbpt)`M@7<9s}3TA
zv*bV+;<g*;W%DpB<ILy<aO`@&gef;L%$YP?-7qj%Kk<W!8#gU`KU`U8p9+gB$@BH-
zYhv4Y^$8hUv%Y`178YrL5bFnO(@yUTSgR>w9fUVJUa#tv-mh9Nk1L*MvR>EDS_DaB
zrxv?~zt86xk+J%rEA$$n=TUd4Zsfhx&gFgg4SruK{+&XwGqznx;(aKc$(CgMx+j{x
z5MM_}zXRmrTt0$VyB>`oo8z(}F9={J7k`bX1vNq{0pI%BF+$IKyS`?4f3`L-ZRa*<
zL+v$`?6Li<up*k2OoJ=w<Dn*0C9TxQ+c$pCb$i%1zSMptCOAg1fjyj@QoZ1AcJXu-
z{B2kqrwPBlJ~F_~(Z=1wjXbt9oJs;bN6VD-GgR@mm(a(}&WXWVkJ670RzTe#MAvY?
zbccn-Md!*<>2QbFOxA8D<Ind<Cw>!>-Qs8j?`DRq(4cFn{$Rg;dx8e_)sZ;{Vka?#
z0cQoTYYPjjCZX<?DI0|57D>I%x0=23ntJyl{IMIvma<Foxk26<D?f;&-_STP^NL4*
zntPid=^+6XxjuHBkPX=PuOr@B#bt#Br=sRmKNz%Ce2@><G=Kby@1J}1Ua>#^Od`CW
z>(ZU=o#c8|bo3o{UL$4_BL)FUbnI8<4d+*f0qzd5fNSxzLVIpAD`+%@tFb6`B35E#
zwkD46zObwZGRscZoDEm&j?p>#0a&a@ByHIEF&e#qhje?t)G%8u3<<V#3@%6oiOmrm
zWkN<m(2P;K__660f`K-a2*>K2J%<^hJAb@-xb4f|`b(>1L%HTkILRR?J|NT~R9P
zJgdk6`SsE<yN&jtpB9#KZfc?&axd>^07tpxq4Y0X4c_Eb`xiDQhV#!s^a%S(^-C@Z
z+udG@8z#mEx97=fz4q`k+Oi%l4mJLq2Ul08uHJh&Ya%#m$wM@Bl(OQZNJQ741`!`m
zW^!)G{cX~=04iie<elPtM9UFIC-mX4{t|%h9rnMk+br7(sRj#^)hjF1oZkh>4hgjJ
z)+Nm%LrD(An;aPHLHFBDWy;g{n#sn0Y<jv7SBI~(<esT?o^UgREnC~(Y=}>PA*NGL
zIaf&oOJJ>Mjz)Yn>(i!_KqX<UTTm5%%Kw$Z<K<Pb>3TjO4oN%!i|)rThg9<~?qTX1
zs&RHZ_8FaxsPI|x(o+H2t@Y6bGI^l*x~`J3Lz11Pf!7|3rfB;K=UuCzk@FFGYGSE?
z%o6oRF$&?u_DO9@m)KjXgu(U)PMgY?ixqR<sEmmE96r&_+sJ9mTKwacKi~?Rh!ASy
zm7)uAsT1m&Bj;9a_RNq)X>da#l}XYgK5ZvzQ`ErDW`_(`^gb<$Lp}WCkp>`ioj9Fc
zH}yfNv8gR3B<0Y(+1?BhgzI`xrZ2*_^k(G#QA^l?EdWu}4SfPBL3E>7YIcRQKp+1>
zSS=;zJK|^Tihw8!A$G<xM8qD^{+tMDi(d$ii6m>J7yi@1JY+LcQ2^27wj~OO9$vGy
zg-FzE8s-u8&aSs-0gqlZH*TPKcH%rpUaq$yX#9J`ReW*#d~1Z~PMBr1hRhJY{;<0g
zv?@qB6RcU`$v<^ZAy@ZBs$if;(KG|<1d?sbO#teh2i}T}2cZ9F@g=SXAKyW9o44{G
zZD>3DmrrllY2`hT%SdwOM4Tb+kPu(>(qeldm7u`@WZESFiI;ZQ3yDGe|3Y6M=-2;$
zP^3}zK?*|_r+x2(6oNEO%jtuZgS1XN?1Q8w{m&b1eb{M0LO>Awp9cSP1{xvLVjCd|
z|M%(tjb`-^8-J+(1=jwrX;+#<|Hsp1)2jO+MIlwv&if%nAbZo;1|aE)|LdP8AFWQI
ZAs{gRZ<CL!>@=qVNNTvQo{zf_{~vwXVL1Q*
diff --git a/fun_gg_donut.R b/fun_gg_donut.R
index 8dccfee..47981ff 100644
--- a/fun_gg_donut.R
+++ b/fun_gg_donut.R
@@ -28,7 +28,7 @@ fun_gg_donut <- function(
return.ggplot = FALSE,
return.gtable = TRUE,
plot = TRUE,
- warn.print = FALSE,
+ warn.print = TRUE,
lib.path = NULL
){
# AIM
@@ -43,7 +43,7 @@ fun_gg_donut <- function(
# categ: single character string of the data1 column name of categories (qualitative variable)
# fill.palette: single character string of a palette name (see ?ggplot2::scale_fill_brewer() for the list).Ignored if fill.color is not NULL
# fill.color: either (1) NULL, or (2) a vector of character strings or integers of same length as the number of classes in categ. Colors can be color names (see ?colors() in R), hexadecimal color codes, or integers (according to the ggplot2 palette). The order of the elements will be used according to the frequency values, from highest to lowest. An easy way to use this argument is to sort data1 according to the frequencies values, add a color column with the corresponding desired colors and use the content of this column as values of fill.color. If color is NULL and fill.palette is NULL, default colors of ggplot2 are used. If color is not NULL, it overrides fill.palette
- # hole.size: single positive proportion of donut central hole, 0 meaning no hole and 1 no donut
+ # hole.size: single positive proportion of donut central hole, 0 meaning no hole (pie chart) and 1 no plot (donut with a null thickness)
# hole.text: logical (either TRUE or FALSE). Display the sum of frequencies (column of data1 indicated in the freq argument) ?
# hole.text.size: single positive numeric value of the title font size in mm. Ignored if hole.text is FALSE
# border.color: a single character string or integer. Colors can be color names (see ?colors() in R), hexadecimal color codes, or integers (according to the ggplot2 palette)
@@ -67,7 +67,7 @@ fun_gg_donut <- function(
# WARNING: the call of objects inside the quotes of add can lead to an error if the name of these objects are some of the fun_gg_donut() arguments. Indeed, the function will use the internal argument instead of the global environment object. Example article <- "a" in the working environment and add = '+ ggplot2::ggtitle(article)'. The risk here is to have TRUE as title. To solve this, use add = '+ ggplot2::ggtitle(get("article", envir = .GlobalEnv))'
# return: logical (either TRUE or FALSE). Return the graph parameters?
# return.ggplot: logical (either TRUE or FALSE). Return the ggplot object in the output list? Ignored if return argument is FALSE. WARNING: always assign the fun_gg_donut() function (e.g., a <- fun_gg_donut()) into something if the return.ggplot argument is TRUE, otherwise, double plotting is performed. See $ggplot in the RETURN section below for more details
- # return.gtable: logical (either TRUE or FALSE). Return the ggplot object as gtable of grobs in the output list? Ignored if plot argument is FALSE. Indeed, the graph must be plotted to get the grobs dispositions. See $gtable in the RETURN section below for more details
+ # return.gtable: logical (either TRUE or FALSE). Return the full graph (main, title and legend) as a gtable of grobs in the output list? See $gtable in the RETURN section below for more details
# plot: logical (either TRUE or FALSE). Plot the graphic? If FALSE and return argument is TRUE, graphical parameters and associated warnings are provided without plotting
# warn.print: logical (either TRUE or FALSE). Print warnings at the end of the execution? ? If FALSE, warning messages are never printed, but can still be recovered in the returned list. Some of the warning messages (those delivered by the internal ggplot2 functions) are not apparent when using the argument plot = FALSE
# lib.path: vector of character strings indicating the absolute path of the required packages (see below). if NULL, the function will use the R library default folders
@@ -77,11 +77,12 @@ fun_gg_donut <- function(
# $data: the initial data with modifications and with graphic information added
# $removed.row.nb: a list of the removed rows numbers in data frames (because of NA). NULL if no row removed
# $removed.rows: a list of the removed rows in data frames (because of NA). NULL if no row removed
+ # $plot.data
# $panel: the variable names used for the panels (NULL if no panels). WARNING: NA can be present according to ggplot2 upgrade to v3.3.0
# $axes: the x-axis and y-axis info
# $warn: the warning messages. Use cat() for proper display. NULL if no warning. WARNING: warning messages delivered by the internal ggplot2 functions are not apparent when using the argument plot = FALSE
# $ggplot: ggplot object that can be used for reprint (use print($ggplot) or update (use $ggplot + ggplot2::...). NULL if return.ggplot argument is FALSE. Warning: the legend is not in $ggplot as it is in a separated grob (use $gtable to get it). Of note, a non-null $ggplot in the output list is sometimes annoying as the manipulation of this list prints the plot
- # $gtable: gtable object that can be used for reprint (use gridExtra::grid.arrange(...$ggplot) or with additionnal grobs (see the grob decomposition in the examples). NULL if return.ggplot argument is FALSE. Contrary to $ggplot, a non-NULL $gtable in the output list is not annoying as the manipulation of this list does not print the plot
+ # $gtable: gtable object that can be used for reprint (use gridExtra::grid.arrange(...$ggplot) or with additionnal grobs (see the grob decomposition in the examples). Contrary to $ggplot, a non-NULL $gtable in the output list is not annoying as the manipulation of this list does not print the plot
# REQUIRED PACKAGES
# ggplot2
# gridExtra
@@ -290,6 +291,13 @@ fun_gg_donut <- function(
}
# end management of NULL arguments
# code that protects set.seed() in the global environment
+ if(exists(".Random.seed", envir = .GlobalEnv)){ # if .Random.seed does not exists, it means that no random operation has been performed yet in any R environment
+ tempo.random.seed <- .Random.seed
+ on.exit(assign(".Random.seed", tempo.random.seed, env = .GlobalEnv))
+ }else{
+ on.exit(set.seed(NULL)) # inactivate seeding -> return to complete randomness
+ }
+ set.seed(1)
# end code that protects set.seed() in the global environment
# warning initiation
ini.warning.length <- options()$warning.length
@@ -628,43 +636,49 @@ fun_gg_donut <- function(
}
bef.final.plot <- suppressWarnings(suppressMessages(ggplot2::ggplot_build(eval(parse(text = paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + "))))))
if( ! is.null(legend.width)){
- legend.final <- suppressWarnings(suppressMessages(fun_gg_get_legend(ggplot_built = bef.final.plot, fun.name = function.name, lib.path = lib.path))) # get legend
+ legend.plot <- suppressWarnings(suppressMessages(fun_gg_get_legend(ggplot_built = bef.final.plot, fun.name = function.name, lib.path = lib.path))) # get legend
assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::guides(fill = "none")) # inactivate the initial legend
- if(is.null(legend.final) & plot == TRUE){ # even if any(unlist(legend.disp)) is TRUE
- legend.final <- ggplot2::ggplot()+ggplot2::theme_void() # empty graph instead of legend
+ if(is.null(legend.plot) & plot == TRUE){ # even if any(unlist(legend.disp)) is TRUE
+ legend.plot <- ggplot2::ggplot()+ggplot2::theme_void() # empty graph instead of legend
warn.count <- warn.count + 1
tempo.warn <- paste0("(", warn.count,") LEGEND REQUESTED (legend.show ARGUMENT SET TO TRUE)\nBUT IT SEEMS THAT THE PLOT HAS NO LEGEND -> EMPTY LEGEND SPACE CREATED BECAUSE OF THE NON NULL legend.width ARGUMENT\n")
warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
}
+ }else{
+ legend.plot <- NULL
}
# end legend management
- # drawing
- final.plot <- eval(parse(text = paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + ")))
-
# title
- if(title != ""){
- title.grob <- grid::textGrob(
- label = title,
- x = grid::unit(0, "lines"),
- y = grid::unit(0, "lines"),
- hjust = 0,
- vjust = 0,
- gp = grid::gpar(fontsize = title.text.size)
- )
- pdf(NULL)
- final.plot <- suppressMessages(suppressWarnings(gridExtra::arrangeGrob(final.plot, top = title.grob, left = " ", right = " "))) # , left = " ", right = " " : trick to add margins in the plot. padding = unit(0.5, "inch") is for top margin above the title
- dev.off()
- }
+ title.grob <- grid::textGrob(
+ label = title,
+ x = grid::unit(0, "lines"),
+ y = grid::unit(0, "lines"),
+ hjust = 0,
+ vjust = 0,
+ gp = grid::gpar(fontsize = 7)
+ )
# end title
+ # drawing
+ pdf(NULL)
grob.save <- NULL
+ main.plot <- eval(parse(text = paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + ")))
+ main.plot.output <- suppressMessages(ggplot2::ggplot_build(main.plot))
+ main.grob <- suppressMessages(suppressWarnings(gridExtra::arrangeGrob(
+ main.plot,
+ top = if(title == ""){" "}else{title.grob},
+ left = " ",
+ right = " "
+ ))) # , left = " ", right = " " : trick to add margins in the plot. padding = unit(0.5, "inch") is for top margin above the title
+ if( ! is.null(legend.width)){
+ grob.save <- suppressMessages(suppressWarnings(gridExtra::grid.arrange(main.grob, legend.plot, ncol=2, widths=c(1, legend.width)))) # assemble grobs, ggplot, gtable into a gtable that defines the positions of the different elements (as grobs)
+ }else{
+ grob.save <- suppressMessages(suppressWarnings(print(main.grob)))
+ }
+ dev.off() # inactivate the pdf(NULL) above
if(plot == TRUE){
- if( ! is.null(legend.width)){
- grob.save <- suppressMessages(suppressWarnings(gridExtra::grid.arrange(final.plot, legend.final, ncol=2, widths=c(1, legend.width))))
- }else{
- grob.save <- suppressMessages(suppressWarnings(print(final.plot)))
- }
+ gridExtra::grid.arrange(grob.save) # plot a gtable (grob)
}else{
warn.count <- warn.count + 1
tempo.warn <- paste0("(", warn.count,") PLOT NOT SHOWN AS REQUESTED")
@@ -672,25 +686,22 @@ fun_gg_donut <- function(
}
# end drawing
-
-
# output
if(warn.print == TRUE & ! is.null(warn)){
on.exit(warning(paste0("FROM ", function.name, ":\n\n", warn), call. = FALSE))
}
on.exit(exp = options(warning.length = ini.warning.length), add = TRUE)
if(return == TRUE){
- output <- suppressMessages(ggplot2::ggplot_build(final.plot))
if(is.null(unlist(removed.row.nb))){
removed.row.nb <- NULL
removed.rows <- NULL
}
- tempo <- output$layout$panel_params[[1]]
+ tempo <- main.plot.output$layout$panel_params[[1]]
output <- list(
data = data1,
removed.row.nb = removed.row.nb,
removed.rows = removed.rows,
- plot = output$data,
+ plot.data = main.plot.output$data,
panel = facet.categ,
axes = list(
x.range = tempo$x.range,
@@ -701,8 +712,8 @@ fun_gg_donut <- function(
y.positions = if(is.null(attributes(tempo$y$breaks))){tempo$y$breaks}else{unlist(attributes(tempo$y$breaks))}
),
warn = paste0("\n", warn, "\n\n"),
- ggplot = if(return.ggplot == TRUE){final.plot}else{NULL}, # final.plot plots the graph if return == TRUE
- gtable = if(return.gtable == TRUE){grob.save}else{NULL} #
+ ggplot = if(return.ggplot == TRUE){main.plot}else{NULL}, # main plot -> plots the graph if return == TRUE
+ gtable = if(return.gtable == TRUE){grob.save}else{NULL} # gtable of the full graph (main + title + legend)
)
return(output) # this plots the graph if return.ggplot is TRUE and if no assignment
}
diff --git a/~$te_little_R_functions.docx b/~$te_little_R_functions.docx
new file mode 100644
index 0000000000000000000000000000000000000000..866e9a8776f5c8fc6a7c738e6231617be8801463
GIT binary patch
literal 162
zcmZQ^PfX2WAQiAMxHBX&q%weX8ZqcGqySkUcF$g2M+OCkjt{dwY5uKeU|<A_f$)L;
oc|86=M%P|_M+QZP4xkViBp6<+2Z=*LL&si4M+PN?JSR{B0EC+q(f|Me
literal 0
HcmV?d00001
--
GitLab