diff --git a/README.md b/README.md
index 931ccde1a4d0cee217ffaac2fb43c52329c3da3c..ec4083ba7587ec4f86d8001c8c2c17a486a31b7c 100755
--- a/README.md
+++ b/README.md
@@ -171,6 +171,11 @@ Gitlab developers
## WHAT'S NEW IN
+### v12.6.0
+
+- minor corrections
+- files ready for starting package configuration into cute and ggcute folders
+
### v12.5.0
diff --git a/cute_little_R_functions.R b/cute_little_R_functions.R
index 821affc18baf8b285d3f8d692d478f1e0f2ed9e7..c4b08e51825b06826b4c0fa17d74565796b10561 100755
--- a/cute_little_R_functions.R
+++ b/cute_little_R_functions.R
@@ -729,7 +729,7 @@ fun_info <- function(
# fun_info(data = 1:3)
# see http
# DEBUGGING
- # mat1 <- matrix(1:3) ; data = env1 ; n = NULL ; warn.print = TRUE # for function debugging
+ # mat1 <- matrix(1:3) ; data = mat1 ; n = NULL ; warn.print = TRUE # for function debugging
# 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
@@ -4350,7 +4350,7 @@ fun_codon2aa <- function(
)
tempo <- eval(parse(text = paste0("c(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"))
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nFOLLOWING ARGUMENT", ifelse(sum(tempo, na.rm = TRUE) > 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
@@ -4513,7 +4513,7 @@ fun_codon_finder <- function(
)
tempo <- eval(parse(text = paste0("c(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"))
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nFOLLOWING ARGUMENT", ifelse(sum(tempo, na.rm = TRUE) > 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
@@ -4828,7 +4828,7 @@ fun_open <- function(
}
pdf.loc <- paste0(pdf.path, "/", pdf.name, ".pdf")
if(file.exists(pdf.loc) == TRUE & pdf.overwrite == FALSE){
- tempo.cat <- paste0("ERROR IN ", function.name, "\npdf.loc FILE ALREADY EXISTS AND CANNOT BE OVERWRITTEN DUE TO pdf.overwrite ARGUMENT SET TO TRUE\n", pdf.loc)
+ tempo.cat <- paste0("ERROR IN ", function.name, "\n", pdf.loc, " FILE ALREADY EXISTS AND CANNOT BE OVERWRITTEN DUE TO pdf.overwrite ARGUMENT SET TO FALSE")
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{
grDevices::pdf(width = width, height = height, file=pdf.loc, paper = paper)
@@ -9139,6 +9139,10 @@ 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
@@ -9378,7 +9382,7 @@ fun_gg_boxplot <- function(
)
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"))
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nFOLLOWING ARGUMENT", ifelse(sum(tempo, na.rm = TRUE) > 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
@@ -11361,10 +11365,6 @@ fun_gg_boxplot <- function(
}
-
-
-
-
# add density
# rasterise all kind: https://cran.r-project.org/web/packages/ggrastr/vignettes/Raster_geoms.html
@@ -11604,7 +11604,7 @@ fun_gg_scatter <- function(
)
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"))
+ tempo.cat <- paste0("ERROR IN ", function.name, "\nFOLLOWING ARGUMENT", ifelse(sum(tempo, na.rm = TRUE) > 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
@@ -13731,749 +13731,4 @@ if(return == TRUE){
-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 = 7,
- 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.text.size = 10,
- legend.box.size = 5,
- legend.box.space = 2,
- 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.text.size: single numeric value of the font size in mm of the legend labels
- # legend.box.size: single numeric value of the size of the legend squares in mm
- # legend.box.space: single numeric value of the space between the legend boxes in mm
- # 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.text.size = 10 ; legend.box.size = 5 ; legend.box.space = 2 ; 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)
- }
- tempo <- fun_check(data = legend.text.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 = legend.box.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 = legend.box.space, class = "vector", mode = "numeric", na.contain = FALSE, neg.values = FALSE, inf.values = FALSE, length = 1, fun.name = function.name) ; eval(ee)
- 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.text.size",
- "legend.box.size",
- "legend.box.space",
- # "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
- }
-
- 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,") 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)))
- }
- }
- # 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 ==
- }
- }
- # 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 ==
- }
- }
- # 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)) # title of the legend
- }
-
- 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())
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::theme(
- legend.text = ggplot2::element_text(size = legend.text.size),
- legend.spacing.y = grid::unit(legend.box.space, 'mm')
- ))
- }
- }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::theme(
- legend.text = ggplot2::element_text(size = legend.text.size),
- legend.spacing.y = grid::unit(legend.box.space, 'mm')
- ))
- }
- assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::guides(
- fill = ggplot2::guide_legend(
- override.aes = list(color = "white", size = legend.box.size),
- byrow = TRUE
- )
- )) # 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])
- ))
- }
- }
- # 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.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{
- legend.plot <- NULL
- }
- # 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 = title.text.size)
- )
- # 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){
- 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")
- 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
- }
- # end output
- # end main code
-}
-
-
diff --git a/cute_little_R_functions.docx b/cute_little_R_functions.docx
index 7e021f6107df3548ee36ae3a260260764952fc75..c8b584c80b8586c0a2c6971fb92d9af365e829fd 100755
Binary files a/cute_little_R_functions.docx and b/cute_little_R_functions.docx differ
diff --git a/examples_check.R b/examples_check.R
new file mode 100644
index 0000000000000000000000000000000000000000..2f6c1f3f437d19a5bc31f7ce315ced4b791c4db3
--- /dev/null
+++ b/examples_check.R
@@ -0,0 +1,160 @@
+
+
+######## check() #### check class, type, length, etc., of objects
+
+### Datasets
+vec1 <- -1:3 # vector of integers
+vec2 <- 1:3 / 3 # vector of proportions
+vec3 <- c(1, 2, 3) # vector of integers but stored as "double"
+vec4 <- "pearson" # vector of characters
+vec5 <- c("a", "b","a", "b") # vector of characters
+mat1 <- matrix(vec1) # matrix of integers
+mat2 <- matrix(c(1:3 / 3, NA)) # matrix of proportions with NA
+
+
+### Datasets info
+vec1 # vector of integers
+vec2 # vector of proportions
+vec3 # vector of integers but stored as "double"
+vec4 # vector of characters
+vec5 # vector of characters
+mat1 # matrix of integers
+mat2 # matrix of proportions with NA
+
+
+### Simple examples
+# Check that vec1 is of class integer (means that it is also a vector) -> ok
+check(data = vec1, class = "integer")
+# Check that vec1 is a numeric vector -> error because vec1 is a vector of integers
+check(data = vec1, class = "numeric")
+# Check that vec1 is an integer vector of length 3 without negative values and without NA -> error because of length 5 and negative values inside vec1
+check(data = vec1, class = "vector", typeof = "integer", length = 3, neg.values = FALSE, na.contain = FALSE)
+# No result displayed because the output list is assigned into res (see below the print argument)
+res <- check(data = vec1, class = "integer")
+
+# with data = NULL, the function systematically report a checking problem
+check(data = NULL, class = "integer")
+
+### Argument class, typeof, mode and length are the same as the corresponding R function, except class which 1) has also "vector" and 2) remains "matrix" for matrices and not "matrix" "array"
+# Example
+check(data = vec1,
+ class = "vector",
+ typeof = "integer",
+ mode = "numeric",
+ length = 5,
+)
+# Warning: the function does not check for inconsistencies between arguments. It just checks if everything is ok between arguments values and data
+check(data = vec1,
+ typeof = "integer",
+ mode = "character", # the mode "character" exists but is inconsistant with typeof "integer". However, this aspect is not signaled by the function
+)
+# Error message due to wrong value in the class and length arguments
+check(data = vec1,
+ mode = "integer", # the mode "integer" does not exist in the mode() function of R
+)
+
+### Argument prop
+check(data = mat2,
+ prop = TRUE # Check for values between 0 and 1 only
+)
+
+### Argument double.as.integer.allowed
+check(data = vec3, typeof = "integer",
+ double.as.integer.allowed = TRUE # with TRUE, integers stored as double are accepted
+)
+
+### Argument options
+check(data = vec4,
+ options = c("pearson", "spearman", "kendall")
+)
+
+### Argument all.options.in.data
+# No error
+check(data = vec5,
+ options = c("a", "b"),
+ all.options.in.data = TRUE
+)
+# No error
+check(data = vec5,
+ options = c("a", "b", "c"),
+ all.options.in.data = FALSE
+)
+# Error
+check(data = vec5,
+ options = c("a", "b", "c"),
+ all.options.in.data = TRUE
+)
+
+### Argument na.contain
+check(data = mat2, class = "matrix", prop = TRUE,
+ na.contain = FALSE # with TRUE, integers stored as double are accepted
+)
+
+### Argument neg.values
+# Warning: only considered if set to FALSE, to check for non negative values when class is set to "vector", "numeric", "matrix", "array", "data.frame", "table", or typeof is set to "double", "integer", or mode is set to "numeric"
+check(data = mat1, class = "matrix",
+ neg.values = FALSE # with TRUE, integers stored as double are accepted
+)
+
+### Argument inf.values
+# Warning: only considered if set to FALSE, to check for non infinite values when class is set to "vector", "numeric", "matrix", "array", "data.frame", "table", or typeof is set to "double", "integer", or mode is set to "numeric"
+check(data = mat1, class = "matrix",
+ inf.values = FALSE
+)
+
+### Argument print
+# No error message printed because print is FALSE
+res <- check(data = mat1, class = "data.frame",
+ print = FALSE
+)
+# Error message printed
+res <- check(data = mat1, class = "data.frame",
+ print = TRUE
+)
+# Even if print is TRUE, no error message printed because no error
+res <- check(data = mat1, class = "matrix",
+ print = TRUE
+)
+
+
+### Arguments data.name and fun.name
+# Example
+tempo <- check(data = vec1, class = "integer",
+ data.name = "OBSERVATION_1",
+ fun.name = "FUNCTION_1"
+)
+tempo$text
+# In fact, these two arguments are interesting when check() is used inside functions
+fun1 <- function(arg1){
+ tempo <- check(data = arg1, class = "integer",
+ data.name = NULL, # if NULL, the name displayed is arg1
+ fun.name = NULL # if NULL, no name displayed
+ )
+ if(tempo$problem == TRUE){
+ cat(paste0("\n\n================\n\n", tempo$text, "\n\n================\n\n"))
+ }
+}
+fun1(arg1 = vec4) # error message because arg1 requires a vector of integers
+
+
+
+### All the arguments
+# See the examples of fun_info() to test different classes of objects
+check(
+ data = vec1,
+ class = "integer",
+ typeof = NULL,
+ mode = NULL,
+ length = NULL,
+ prop = FALSE,
+ double.as.integer.allowed = FALSE,
+ options = NULL,
+ all.options.in.data = FALSE,
+ na.contain = FALSE,
+ neg.values = TRUE,
+ inf.values = TRUE,
+ print = FALSE,
+ data.name = NULL,
+ fun.name = NULL
+)
+
diff --git a/examples_info.R b/examples_info.R
new file mode 100644
index 0000000000000000000000000000000000000000..a3bc5a1f7ebb6283e4446f28d085540c14311302
--- /dev/null
+++ b/examples_info.R
@@ -0,0 +1,87 @@
+
+
+
+
+
+######## info() #### recover object information
+
+### Datasets
+vec1 <- -1:3 # vector of integers
+vec2 <- 1:3 / 3 # vector of proportions
+vec3 <- c(1, 2, NA, -Inf) # vector of integers but stored as "double", with NA and Inf
+vec4 <- "pearson" # vector of characters
+vec5 <- c("a", "b","a", NA) # vector of characters with NA
+cpx <- as.complex(1) # complex
+mat1 <- matrix(vec1) # 1D matrix of integers
+mat2 <- matrix(c(1:5, NA), ncol = 2, dimnames = list(c("ROW1", "ROW2", "ROW3"), c("M1", "M2"))) # 2D matrix of floats with NA
+df1 <- as.data.frame(mat2) # data.frame
+l1 <- list(L1 = 1:3, L2 = letters[1:3]) # list
+fac1 <- factor(rep(letters[4:6], c(4:6))) # factor
+tab1 <- table(fac1) # 1D table
+tab2 <- table(fac1, fac1) # 2D table
+exp1 <- expression("a") # object of class "expression", mode "expression" & type "expression"
+name1 <- substitute(exp1) # object of class "name", mode "name" & type "symbol"
+fun1 <- mean # closure function of class "function", mode "function" & type "closure"
+fun2 <- sum # primitive function of class "function", mode "function" & type "builtin"
+fun3 <- get("<-") # primitive function of class "function", mode "function" & type "special"
+env1 <- new.env() # environment
+s4 <- show # S4 object
+call1 <- call("call1") # object of class "call", mode "call" & type "language"
+
+### Datasets info
+vec1 # vector of integers
+vec2 # vector of proportions
+vec3 # vector of integers but stored as "double", with NA
+vec4 # vector of characters
+vec5 # vector of characters with NA
+mat1 # 1D matrix of integers
+mat2 # 2D matrix of floats with NA
+df1 # data.frame
+l1 # list
+fac1 # factor
+tab1 # 1D table
+tab2 # 2D table
+exp1 # object of class "expression", mode "expression" & type "expression"
+name1 # object of class "name", mode "name" & type "symbol"
+fun1 # closure function of class "function", mode "function" & type "closure"
+fun2 # primitive function of class "function", mode "function" & type "builtin"
+fun3 # primitive function of class "function", mode "function" & type "special"
+env1 # environment
+s4 # S4 object
+call1 # object of class "call", mode "call" & type "language"
+
+
+### Simple example
+info(data = vec1) # vector of integers
+info(data = vec2) # vector of proportions
+info(data = vec3) # vector of integers but stored as "double", with NA and Inf
+info(data = vec4) # vector of characters
+info(data = vec5) # vector of characters with NA
+info(data = mat1) # 1D matrix of integers
+info(data = mat2) # 2D matrix of floats with NA
+info(data = df1) # data.frame
+info(data = l1) # list
+info(data = fac1) # factor
+info(data = tab1) # 1D table
+info(data = tab2) # 2D table
+info(data = exp1) # object of class "expression", mode "expression" & type "expression"
+info(data = name1) # object of class "name", mode "name" & type "symbol"
+info(data = fun1) # closure function of class "function", mode "function" & type "closure"
+info(data = fun2) # primitive function of class "function", mode "function" & type "builtin"
+info(data = fun3) # primitive function of class "function", mode "function" & type "special"
+info(data = env1) # environment
+info(data = s4) # S4 object
+info(data = call1) # object of class "call", mode "call" & type "language"
+
+
+
+### All the arguments
+info(
+ data = vec1,
+ n = 1, # number of element to display per compartment of the output list (i.e., head(..., n))
+ warn.print = FALSE
+)
+
+
+
+
diff --git a/fun_gg_boxplot.docx b/fun_gg_boxplot.docx
index 22a22884a2cbf50f5652cbf4da37495081cb8943..1adb58ee33574e4e7fd1042ef7d66cb5139df181 100755
Binary files a/fun_gg_boxplot.docx and b/fun_gg_boxplot.docx differ
diff --git a/fun_gg_scatter.docx b/fun_gg_scatter.docx
index 2fa8d7c2384012325ed7a6e54411ec3bb931e1c4..a6a2e9bd538438248d750f08efa80e0fb945bc87 100755
Binary files a/fun_gg_scatter.docx and b/fun_gg_scatter.docx differ