cute_little_R_functions.R 568 KB
Newer Older
Gael  MILLOT's avatar
Gael MILLOT committed
8001
8002
if( ! is.null(tempo.graph$warn)){
warn <- paste0(ifelse(is.null(warn), tempo.graph$warn, paste0(warn, "\n", tempo.graph$warn)))
8003
}
Gael  MILLOT's avatar
Gael MILLOT committed
8004
8005
8006
if( ! is.null(data2.signif.dot)){
if(graph.in.file == FALSE){
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8007
}
Gael  MILLOT's avatar
Gael MILLOT committed
8008
8009
8010
tempo.graph <- fun_gg_scatter(data1 = list(data1, data2, data2.signif.dot, vframe), x = list(x1, x2, x2, "x"), y = list(y1, y2, y2, "y"), categ = list("kind", "kind", "kind", "kind"), legend.name = list("DATASET", "DATASET", "SIGNIF DOTS", "VERT FRAME"), color = list(fun_gg_palette(2)[2], fun_gg_palette(2)[1], "black", rep(hsv(h = c(0.5, 0.6), v = c(0.9, 1)), 2)), geom = list("geom_point", "geom_point", "geom_point", "geom_path"), alpha = list(0.5, 0.5, 0.5, 0.5), title = "DATA1 + DATA2 + DATA2 SIGNIFICANT DOTS", x.lim = x.range.plot, y.lim = y.range.plot, raster = raster, return = TRUE)
if( ! is.null(tempo.graph$warn)){
warn <- paste0(ifelse(is.null(warn), tempo.graph$warn, paste0(warn, "\n", tempo.graph$warn)))
Gael  MILLOT's avatar
Gael MILLOT committed
8011
8012
}
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
8013
8014
if(graph.in.file == FALSE){
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8015
}
Gael  MILLOT's avatar
Gael MILLOT committed
8016
8017
8018
8019
8020
8021
8022
8023
8024
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA2 DOTS\nOUTSIDE THE FRAMES", text.size = 8, title = "DATA1 + DATA2 + DATA2 SIGNIFICANT DOTS")
}
if( ! is.null(data2.incon.dot)){
if(graph.in.file == FALSE){
fun_open(pdf.disp = FALSE)
}
tempo.graph <- fun_gg_scatter(data1 = list(data1, data2, data2.incon.dot, vframe), x = list(x1, x2, x2, "x"), y = list(y1, y2, y2, "y"), categ = list("kind", "kind", "kind", "kind"), legend.name = list("DATASET", "DATASET", "INCONSISTENT DOTS", "VERT FRAME"), color = list(fun_gg_palette(2)[2], fun_gg_palette(2)[1], fun_gg_palette(7)[6], rep(hsv(h = c(0.5, 0.6), v = c(0.9, 1)), 2)), geom = list("geom_point", "geom_point", "geom_point", "geom_path"), alpha = list(0.5, 0.5, 0.5, 0.5), title = "DATA1 + DATA2 + DATA2 INCONSISTENT DOTS", x.lim = x.range.plot, y.lim = y.range.plot, raster = raster, return = TRUE)
if( ! is.null(tempo.graph$warn)){
warn <- paste0(ifelse(is.null(warn), tempo.graph$warn, paste0(warn, "\n", tempo.graph$warn)))
Gael  MILLOT's avatar
Gael MILLOT committed
8025
8026
}
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
8027
8028
if(graph.in.file == FALSE){
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8029
}
Gael  MILLOT's avatar
Gael MILLOT committed
8030
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA2\nINCONSISTENT DOTS", text.size = 8, title = "DATA2 + DATA2 INCONSISTENT DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8031
}
Gael  MILLOT's avatar
Gael MILLOT committed
8032
8033
8034
8035
8036
8037
8038
if( ! is.null(data2.unknown.dot)){
if(graph.in.file == FALSE){
fun_open(pdf.disp = FALSE)
}
tempo.graph <- fun_gg_scatter(data1 = list(data1, data2, data2.unknown.dot, vframe), x = list(x1, x2, x2, "x"), y = list(y1, y2, y2, "y"), categ = list("kind", "kind", "kind", "kind"), legend.name = list("DATASET", "DATASET", "UNKNOWN DOTS", "VERT FRAME"), color = list(fun_gg_palette(2)[2], fun_gg_palette(2)[1], fun_gg_palette(7)[5], rep(hsv(h = c(0.5, 0.6), v = c(0.9, 1)), 2)), geom = list("geom_point", "geom_point", "geom_point", "geom_path"), alpha = list(0.5, 0.5, 0.5, 0.5), title = "DATA1 + DATA2 + DATA2 UNKNOWN DOTS", x.lim = x.range.plot, y.lim = y.range.plot, raster = raster, return = TRUE)
if( ! is.null(tempo.graph$warn)){
warn <- paste0(ifelse(is.null(warn), tempo.graph$warn, paste0(warn, "\n", tempo.graph$warn)))
Gael  MILLOT's avatar
Gael MILLOT committed
8039
}
Gael  MILLOT's avatar
Gael MILLOT committed
8040
8041
8042
}else{
if(graph.in.file == FALSE){
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8043
}
Gael  MILLOT's avatar
Gael MILLOT committed
8044
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA2\nUNKNOWN DOTS", text.size = 8, title = "DATA2 + DATA2 UNKNOWN DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8045
8046
8047
8048
}
}
}
}
Gael  MILLOT's avatar
Gael MILLOT committed
8049
8050
8051
8052
# end plot
if(warn.print == TRUE & ! is.null(warn)){
warning(warn, call. = FALSE)
cat("\n\n")
Gael  MILLOT's avatar
Gael MILLOT committed
8053
}
Gael  MILLOT's avatar
Gael MILLOT committed
8054
8055
tempo.list <- list(data1.removed.row.nb = data1.removed.row.nb, data1.removed.rows = data1.removed.rows, data2.removed.row.nb = data2.removed.row.nb, data2.removed.rows = data2.removed.rows, hframe = hframe, vframe = vframe, data1.signif.dot = data1.signif.dot, data1.non.signif.dot = data1.non.signif.dot, data1.inconsistent.dot = data1.incon.dot, data2.signif.dot = data2.signif.dot, data2.non.signif.dot = data2.non.signif.dot, data2.unknown.dot = data2.unknown.dot, data2.inconsistent.dot = data2.incon.dot, axes = axes, warn = warn)
return(tempo.list)
Gael  MILLOT's avatar
Gael MILLOT committed
8056
8057
8058
}


Gael  MILLOT's avatar
Gael MILLOT committed
8059
################ Import
Gael  MILLOT's avatar
Gael MILLOT committed
8060
8061


Gael  MILLOT's avatar
Gael MILLOT committed
8062
######## fun_pack() #### check if R packages are present and import into the working environment
Gael  MILLOT's avatar
Gael MILLOT committed
8063

Gael  MILLOT's avatar
Gael MILLOT committed
8064
8065
8066
8067
8068
8069
8070
8071
8072
8073
8074
8075
8076
8077
8078
8079
8080
8081
8082
8083
8084
8085
8086
8087
8088
8089
8090
8091
8092

# Check OK: clear to go Apollo
fun_pack <- function(req.package, load = FALSE, lib.path = NULL){
# AIM
# check if the specified R packages are present in the computer and import them into the working environment
# ARGUMENTS
# req.package: character vector of package names to import
# req.package: logical. Load the package into the environement (using library())?
# lib.path: optional character vector specifying the absolute pathways of the directories containing some of the listed packages
# REQUIRED PACKAGES
# none
# REQUIRED FUNCTIONS FROM CUTE_LITTLE_R_FUNCTION
# fun_check()
# RETURN
# nothing
# EXAMPLES
# fun_pack(req.package = "nopackage")
# fun_pack(req.package = "ggplot2")
# fun_pack(req.package = "ggplot2", lib.path = "blablabla")
# DEBUGGING
# req.package = "ggplot2" ; lib.path = "C:/Program Files/R/R-3.5.1/library"
# req.package = "serpentine" ; lib.path = "C:/users/gael/appdata/roaming/python/python36/site-packages"
# function name
function.name <- paste0(as.list(match.call(expand.dots=FALSE))[[1]], "()")
# end function name
# required function checking
if(length(utils::find("fun_check", mode = "function")) == 0){
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": REQUIRED fun_check() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
stop(tempo.cat, call. = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8093
}
Gael  MILLOT's avatar
Gael MILLOT committed
8094
8095
8096
8097
8098
8099
8100
8101
8102
8103
8104
8105
8106
8107
8108
# end required function checking
# argument 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$fun.name))
tempo <- fun_check(data = req.package, class = "vector", mode = "character", fun.name = function.name) ; eval(ee)
tempo <- fun_check(data = load, class = "vector", mode = "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)
Gael  MILLOT's avatar
Gael MILLOT committed
8109
8110
8111
}
}
}
Gael  MILLOT's avatar
Gael MILLOT committed
8112
8113
if(any(arg.check) == TRUE){
stop(paste0("\n\n================\n\n", paste(text.check[arg.check], collapse = "\n"), "\n\n================\n\n"), call. = FALSE) #
Gael  MILLOT's avatar
Gael MILLOT committed
8114
}
Gael  MILLOT's avatar
Gael MILLOT committed
8115
8116
8117
8118
8119
# source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.2/r_debugging_tools-v1.2.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 checking
# main code
if(is.null(lib.path)){
lib.path <- .libPaths() # .libPaths(new = lib.path) # or .libPaths(new = c(.libPaths(), lib.path))
Gael  MILLOT's avatar
Gael MILLOT committed
8120
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
8121
8122
8123
8124
8125
8126
8127
8128
8129
.libPaths(new = sub(x = lib.path, pattern = "/$|\\\\$", replacement = "")) # .libPaths(new = ) add path to default path. BEWARE: .libPaths() does not support / at the end of a submitted path. Thus check and replace last / or \\ in path
}
for(i1 in 1:length(req.package)){
if( ! req.package[i1] %in% rownames(utils::installed.packages(lib.loc = lib.path))){
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": PACKAGE ", req.package[i1], " MUST BE INSTALLED IN:\n", paste(lib.path, collapse = "\n"), "\n\n================\n\n")
stop(tempo.cat, call. = FALSE)
}else{
if(load == TRUE){
suppressWarnings(suppressPackageStartupMessages(library(req.package[i1], lib.loc = lib.path, quietly = TRUE, character.only = TRUE)))
Gael  MILLOT's avatar
Gael MILLOT committed
8130
8131
8132
8133
8134
8135
}
}
}
}


Gael  MILLOT's avatar
Gael MILLOT committed
8136
######## fun_python_pack() #### check if python packages are present
Gael  MILLOT's avatar
Gael MILLOT committed
8137
8138


Gael  MILLOT's avatar
Gael MILLOT committed
8139
8140
8141
8142
8143
8144
8145
8146
8147
8148
8149
8150
8151
8152
8153
8154
8155
8156
8157
8158
8159
8160
8161
8162
8163
8164
8165
8166
8167
8168
8169
8170
8171
8172
8173
# Check OK: clear to go Apollo
fun_python_pack <- function(req.package, python.exec.path = NULL, lib.path = NULL, R.lib.path = NULL){
# AIM
# check if the specified python packages are present in the computer (no import)
# WARNINGS
# for python 3.7. Previous versions return an error "Error in sys$stdout$flush() : attempt to apply non-function"
# ARGUMENTS
# req.package: character vector of package names to import
# python.exec.path: optional character vector specifying the absolute pathways of the executable python file to use (associated to the packages to use). If NULL, the reticulate::import_from_path() function used in fun_python_pack() seeks for an available version of python.exe, and then uses python_config(python_version, required_module, python_versions). But might not be the correct one for the lib.path parameter specified. Thus, it is recommanded to do not leave NULL, notably when using computing clusters
# lib.path: optional character vector specifying the absolute pathways of the directories containing some of the listed packages in the req.package argument
# R.lib.path: absolute path of the reticulate packages, if not in the default folders
# REQUIRED PACKAGES
# reticulate
# REQUIRED FUNCTIONS FROM CUTE_LITTLE_R_FUNCTION
# fun_check()
# fun_pack()
# RETURN
# nothing
# EXAMPLES
# example of error message
# fun_python_pack(req.package = "nopackage")
# example without error message (require the installation of the python serpentine package from https://github.com/koszullab/serpentine
# fun_python_pack(req.package = "serpentine", python.exec.path = "C:/ProgramData/Anaconda3/python.exe", lib.path = "c:/programdata/anaconda3/lib/site-packages/")
# another example of error message
# fun_python_pack(req.package = "serpentine", lib.path = "blablabla")
# DEBUGGING
# req.package = "serpentine" ; python.exec.path = "C:/ProgramData/Anaconda3/python.exe" ; lib.path = "c:/programdata/anaconda3/lib/site-packages/" ; R.lib.path = NULL
# req.package = "bad" ; lib.path = NULL ; R.lib.path = NULL
# function name
function.name <- paste0(as.list(match.call(expand.dots=FALSE))[[1]], "()")
# end function name
# required function checking
if(length(utils::find("fun_check", mode = "function")) == 0){
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": REQUIRED fun_check() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
stop(tempo.cat, call. = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8174
}
Gael  MILLOT's avatar
Gael MILLOT committed
8175
8176
8177
if(length(utils::find("fun_pack", mode = "function")) == 0){
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": REQUIRED fun_pack() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
stop(tempo.cat, call. = FALSE)
8178
}
Gael  MILLOT's avatar
Gael MILLOT committed
8179
8180
8181
8182
8183
8184
8185
8186
8187
8188
8189
8190
8191
8192
# end required function checking
# argument 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$fun.name))
tempo <- fun_check(data = req.package, class = "character", fun.name = function.name) ; eval(ee)
if( ! is.null(python.exec.path)){
tempo <- fun_check(data = python.exec.path, class = "character", length = 1, fun.name = function.name) ; eval(ee)
if(tempo$problem == FALSE){
if( ! all(file.exists(python.exec.path))){ # separation to avoid the problem of tempo$problem == FALSE and python.exec.path == NA
tempo.cat <- paste0("ERROR IN ", function.name, ": FILE PATH INDICATED IN THE python.exec.path ARGUMENT DOES NOT EXISTS:\n", paste(python.exec.path, collapse = "\n"))
text.check <- c(text.check, tempo.cat)
arg.check <- c(arg.check, TRUE)
8193
}
Gael  MILLOT's avatar
Gael MILLOT committed
8194
8195
}
}
Gael  MILLOT's avatar
Gael MILLOT committed
8196
8197
8198
8199
8200
8201
8202
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)
8203
8204
}
}
Gael  MILLOT's avatar
Gael MILLOT committed
8205
}
Gael  MILLOT's avatar
Gael MILLOT committed
8206
8207
8208
8209
8210
8211
8212
if( ! is.null(R.lib.path)){
tempo <- fun_check(data = R.lib.path, class = "character", fun.name = function.name) ; eval(ee)
if(tempo$problem == FALSE){
if( ! all(dir.exists(R.lib.path))){ # separation to avoid the problem of tempo$problem == FALSE and R.lib.path == NA
tempo.cat <- paste0("ERROR IN ", function.name, ": DIRECTORY PATH INDICATED IN THE R.lib.path ARGUMENT DOES NOT EXISTS:\n", paste(R.lib.path, collapse = "\n"))
text.check <- c(text.check, tempo.cat)
arg.check <- c(arg.check, TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8213
8214
8215
}
}
}
Gael  MILLOT's avatar
Gael MILLOT committed
8216
8217
if(any(arg.check) == TRUE){
stop(paste0("\n\n================\n\n", paste(text.check[arg.check], collapse = "\n"), "\n\n================\n\n"), call. = FALSE) #
Gael  MILLOT's avatar
Gael MILLOT committed
8218
}
Gael  MILLOT's avatar
Gael MILLOT committed
8219
8220
8221
8222
8223
8224
8225
8226
8227
8228
8229
8230
# source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.2/r_debugging_tools-v1.2.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 checking
# package checking
fun_pack(req.package = "reticulate", lib.path = R.lib.path)
# end package checking
# main code
if(is.null(python.exec.path)){
python.exec.path <- reticulate::py_run_string("
import sys ;
path_lib = sys.path
") # python string
python.exec.path <- python.exec.path$path_lib
8231
}
Gael  MILLOT's avatar
Gael MILLOT committed
8232
8233
8234
8235
8236
8237
if(is.null(lib.path)){
lib.path <- reticulate::py_run_string("
import sys ;
path_lib = sys.path
") # python string
lib.path <- lib.path$path_lib
8238
}
Gael  MILLOT's avatar
Gael MILLOT committed
8239
8240
8241
8242
8243
8244
reticulate::use_python(Sys.which(python.exec.path), required = TRUE) # required to avoid the use of erratic python exec by reticulate::import_from_path()
for(i1 in 1:length(req.package)){
tempo.try <- vector("list", length = length(lib.path))
for(i2 in 1:length(lib.path)){
tempo.try[[i2]] <- suppressWarnings(try(reticulate::import_from_path(req.package[i1], path = lib.path[i2]), silent = TRUE))
tempo.try[[i2]] <- suppressWarnings(try(reticulate::import_from_path(req.package[i1], path = lib.path[i2]), silent = TRUE)) # done twice to avoid the error message  about flushing present the first time but not the second time. see https://stackoverflow.com/questions/57357001/reticulate-1-13-error-in-sysstdoutflush-attempt-to-apply-non-function
Gael  MILLOT's avatar
Gael MILLOT committed
8245
}
Gael  MILLOT's avatar
Gael MILLOT committed
8246
8247
8248
8249
8250
8251
8252
if(all(sapply(tempo.try, FUN = grepl, pattern = "[Ee]rror"))){
print(tempo.try)
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": PACKAGE ", req.package[i1], " MUST BE INSTALLED IN THE MENTIONNED DIRECTORY:\n", paste(lib.path, collapse = "\n"), "\n\n================\n\n")
stop(tempo.cat, call. = FALSE)
} # else{
# suppressWarnings(suppressPackageStartupMessages(assign(req.package[i1], reticulate::import(req.package[i1])))) # not required because try() already evaluates
# }
Gael  MILLOT's avatar
Gael MILLOT committed
8253
8254
8255
8256
}
}


Gael  MILLOT's avatar
Gael MILLOT committed
8257
################ Print / Exporting results (text & tables)
Gael  MILLOT's avatar
Gael MILLOT committed
8258
8259


Gael  MILLOT's avatar
Gael MILLOT committed
8260
######## fun_report() #### print string or data object into output file
Gael  MILLOT's avatar
Gael MILLOT committed
8261
8262


Gael  MILLOT's avatar
Gael MILLOT committed
8263
8264
8265
8266
# Check OK: clear to go Apollo
fun_report <- function(data, output = "results.txt", path = "C:/Users/Gael/Desktop/", no.overwrite = TRUE, rownames.kept = FALSE, vector.cat = FALSE, noquote = TRUE, sep = 2){
# AIM
# log file function: print a character string or a data object into a same output file
8267
8268
# REQUIRED PACKAGES
# utils
Gael  MILLOT's avatar
Gael MILLOT committed
8269
8270
8271
8272
8273
8274
8275
8276
8277
8278
8279
8280
8281
8282
8283
8284
8285
8286
8287
8288
8289
8290
8291
8292
8293
# REQUIRED FUNCTIONS FROM CUTE_LITTLE_R_FUNCTION
# fun_check()
# ARGUMENTS
# data: object to print in the output file. If NULL, nothing is done, with no warning
# output: name of the output file
# path: location of the output file
# no.overwrite: (logical) if output file already exists, defines if the printing is appended (default TRUE) or if the output file content is erased before printing (FALSE)
# rownames.kept: (logical) defines whether row names have to be removed or not in small tables (less than length.rows rows)
# vector.cat (logical). If TRUE print a vector of length > 1 using cat() instead of capture.output(). Otherwise (default FALSE) the opposite
# noquote: (logical). If TRUE no quote are present for the characters
# sep: number of separating lines after printed data (must be integer)
# RETURN
# nothing
# EXAMPLES
# fun_report()
# fun_report(data = 1:3, output = "results.txt", path = "C:/Users/Gael/Desktop", no.overwrite = TRUE, rownames.kept = FALSE, vector.cat = FALSE, noquote = FALSE, sep = 2)
# DEBUGGING
# data = 1:3 ; output = "results.txt" ; path = "C:/Users/Gael/Desktop" ; no.overwrite = TRUE ; rownames.kept = FALSE ; vector.cat = FALSE ; noquote = FALSE ; sep = 2 # for function debugging
# function name
function.name <- paste0(as.list(match.call(expand.dots=FALSE))[[1]], "()")
# end function name
# required function checking
if(length(utils::find("fun_check", mode = "function")) == 0){
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": REQUIRED fun_check() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
stop(tempo.cat, call. = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8294
}
Gael  MILLOT's avatar
Gael MILLOT committed
8295
8296
8297
8298
8299
8300
8301
8302
8303
8304
8305
# end required function checking
# argument 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$fun.name))
tempo <- fun_check(data = output, class = "character", length = 1, fun.name = function.name) ; eval(ee)
if(tempo$problem == FALSE & output == ""){
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": output ARGUMENT AS \"\" DOES NOT CORRESPOND TO A VALID FILE NAME\n\n================\n\n")
text.check <- c(text.check, tempo.cat)
arg.check <- c(arg.check, TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8306
}
Gael  MILLOT's avatar
Gael MILLOT committed
8307
8308
8309
8310
8311
8312
tempo <- fun_check(data = path, class = "vector", mode = "character", fun.name = function.name) ; eval(ee)
if(tempo$problem == FALSE){
if( ! all(dir.exists(path))){ # separation to avoid the problem of tempo$problem == FALSE and lib.path == NA
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": path ARGUMENT DOES NOT CORRESPOND TO EXISTING DIRECTORY\n", paste(path, collapse = "\n"),"\n\n================\n\n")
text.check <- c(text.check, tempo.cat)
arg.check <- c(arg.check, TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8313
8314
}
}
Gael  MILLOT's avatar
Gael MILLOT committed
8315
8316
8317
8318
8319
8320
8321
tempo <- fun_check(data = no.overwrite, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
tempo <- fun_check(data = rownames.kept, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
tempo <- fun_check(data = vector.cat, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
tempo <- fun_check(data = noquote, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
tempo <- fun_check(data = sep, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, fun.name = function.name) ; eval(ee)
if(any(arg.check) == TRUE){
stop(paste0("\n\n================\n\n", paste(text.check[arg.check], collapse = "\n"), "\n\n================\n\n"), call. = FALSE) #
Gael  MILLOT's avatar
Gael MILLOT committed
8322
}
Gael  MILLOT's avatar
Gael MILLOT committed
8323
8324
8325
8326
8327
8328
8329
8330
8331
8332
8333
8334
8335
8336
8337
8338
8339
8340
8341
# end argument checking
# source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.2/r_debugging_tools-v1.2.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()
# the 4 next lines are inactivated but kept because at a time, I might have a problem with data (solved with data = NULL). These 4 lines are just to know how to detect a missing argument. Important here because if data is not provided, print the code of the data function
# arg.user.list <- as.list(match.call(expand.dots=FALSE))[-1] # recover all the arguments provided by the function user (excluding the argument with defaults values not provided by the user. Thus, it is really the list indicated by the user)
# default.arg.list <- formals(fun = sys.function(sys.parent())) # list of all the arguments of the function with their default values (not the values of the user !). It seems that ls() as first line of the function provide the names of the arguments (empty, called, etc., or not)
# arg.without.default.value <- sapply(default.arg.list, is.symbol) & sapply(sapply(default.arg.list, as.character), identical, "") # logical to detect argument without default values (these are typeof "symbol" and class "name" and empty character
# if( ! all(names(default.arg.list)[arg.without.default.value] %in% names(arg.user.list))){ # test that the arguments with no null values are provided by the user
# tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": VALUE REQUIRED FOR THESE ARGUMENTS WITH NO DEFAULTS VALUES: ", paste(names(default.arg.list)[arg.without.default.value][ ! names(default.arg.list)[arg.without.default.value] %in% names(arg.user.list)], collapse = " "), "\n\n================\n\n")
#stop(tempo.cat, call. = FALSE)
# }
# end argument checking
# main code
if( ! is.null(data)){
if(all(class(data) %in% c("matrix", "data.frame", "table"))){
if(rownames.kept == FALSE & all(class(data) == "data.frame") & nrow(data) != 0 & nrow(data) <= 4){ # for data frames with nrows <= 4
rownames.output.tables <- ""
length.rows <- nrow(data)
for(i in 1:length.rows){ # replace the rownames of the first 4 rows by increasing number of spaces (because identical row names not allowed in data frames). This method cannot be extended to more rows as the printed data frame is shifted on the right because of "big empty rownames"
rownames.output.tables <- c(rownames.output.tables, paste0(rownames.output.tables[i]," ", collapse=""))
Gael  MILLOT's avatar
Gael MILLOT committed
8342
}
Gael  MILLOT's avatar
Gael MILLOT committed
8343
8344
8345
row.names(data) <- rownames.output.tables[1:length.rows]
}else if(rownames.kept == FALSE & all(class(data) %in% c("matrix", "table"))){
rownames(data) <- rep("", nrow(data)) # identical row names allowed in matrices and tables
Gael  MILLOT's avatar
Gael MILLOT committed
8346
}
Gael  MILLOT's avatar
Gael MILLOT committed
8347
8348
8349
8350
if(noquote == TRUE){
utils::capture.output(noquote(data), file=paste0(path, "/", output), append = no.overwrite)
}else{
utils::capture.output(data, file=paste0(path, "/", output), append = no.overwrite)
Gael  MILLOT's avatar
Gael MILLOT committed
8351
}
Gael  MILLOT's avatar
Gael MILLOT committed
8352
8353
8354
}else if(is.vector(data) & all(class(data) != "list") & (length(data) == 1 | vector.cat == TRUE)){
if(noquote == TRUE){
cat(noquote(data), file= paste0(path, "/", output), append = no.overwrite)
Gael  MILLOT's avatar
Gael MILLOT committed
8355
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
8356
cat(data, file= paste0(path, "/", output), append = no.overwrite)
Gael  MILLOT's avatar
Gael MILLOT committed
8357
}
8358
}else if(all(mode(data) == "character")){ # characters (array, list, factor or vector with vector.cat = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8359
8360
8361
8362
if(noquote == TRUE){
utils::capture.output(noquote(data), file=paste0(path, "/", output), append = no.overwrite)
}else{
utils::capture.output(data, file=paste0(path, "/", output), append = no.overwrite)
Gael  MILLOT's avatar
Gael MILLOT committed
8363
}
8364
8365
}else{ # other object (S4 for instance, which do not like noquote()
utils::capture.output(data, file=paste0(path, "/", output), append = no.overwrite)
Gael  MILLOT's avatar
Gael MILLOT committed
8366
8367
8368
}
sep.final <- paste0(rep("\n", sep), collapse = "")
write(sep.final, file= paste0(path, "/", output), append = TRUE) # add a sep
Gael  MILLOT's avatar
Gael MILLOT committed
8369
8370
8371
8372
}
}


Gael  MILLOT's avatar
Gael MILLOT committed
8373
######## fun_get_message() #### return messages of an expression (that can be exported)
Gael  MILLOT's avatar
Gael MILLOT committed
8374
8375


Gael  MILLOT's avatar
Gael MILLOT committed
8376
8377
8378
8379
8380
8381
8382
8383
8384
8385
8386
8387
8388
8389
8390
8391
8392
8393
8394
8395
8396
8397
8398
8399
8400
8401
8402
8403
8404
8405
8406
8407
8408
8409
8410
8411
8412
8413
8414
8415
8416
8417
# Check OK: clear to go Apollo
fun_get_message <- function(data, kind = "error", header = TRUE, print.no = FALSE, text = NULL, env = NULL){
# AIM
# evaluate an instruction written between "" and return the first of the error, or warning or standard (non error non warning) messages if ever exist
# using argument print.no = FALSE, return NULL if no message, which is convenient in some cases
# WARNING
# Only the first message is returned
# REQUIRED FUNCTIONS FROM CUTE_LITTLE_R_FUNCTION
# fun_check()
# ARGUMENTS
# data: character string to evaluate
# kind: character string. Either "error" to get error messages, or "warning" to get warning messages, or "message" to get non error and non warning messages
# header: logical. Add a header in the returned message?
# print.no: logical. Print a message saying that no message reported?
# text: character string added to the output message (even if no message exists and print.no is TRUE). Inactivated if header is FALSE
# env: the name of an existing environment. NULL if not required
# RETURN
# the message or NULL if no message and print.no is FALSE
# EXAMPLES
# fun_get_message(data = "wilcox.test(c(1,1,3), c(1, 2, 4), paired = TRUE)", kind = "error", print.no = TRUE, text = "IN A")
# fun_get_message(data = "wilcox.test(c(1,1,3), c(1, 2, 4), paired = TRUE)", kind = "warning", print.no = TRUE, text = "IN A")
# fun_get_message(data = "wilcox.test(c(1,1,3), c(1, 2, 4), paired = TRUE)", kind = "message", print.no = TRUE, text = "IN A")
# fun_get_message(data = "wilcox.test()", kind = "error", print.no = TRUE, text = "IN A")
# fun_get_message(data = "sum(1)", kind = "error", print.no = TRUE, text = "IN A")
# fun_get_message(data = "message('ahah')", kind = "error", print.no = TRUE, text = "IN A")
# fun_get_message(data = "message('ahah')", kind = "message", print.no = TRUE, text = "IN A")
# fun_get_message(data = "ggplot2::ggplot(data = data.frame(X = 1:10), mapping = ggplot2::aes(x = X)) + ggplot2::geom_histogram()", kind = "message", print.no = TRUE, text = "IN FUNCTION 1")
# set.seed(1) ; obs1 <- data.frame(Time = c(rnorm(10), rnorm(10) + 2), Group1 = rep(c("G", "H"), each = 10)) ; fun_get_message(data = 'fun_gg_boxplot(data = obs1, y = "Time", categ = "Group1")', kind = "message", print.no = TRUE, text = "IN FUNCTION 1")
# DEBUGGING
# data = "wilcox.test(c(1,1,3), c(1, 2, 4), paired = TRUE)" ; kind = "warning" ; header = TRUE ; print.no = FALSE ; text = NULL ; env = NULL # for function debugging
# data = "sum(1)" ; kind = "warning" ; header = TRUE ; print.no = FALSE ; text = NULL ; env = NULL  # for function debugging
# set.seed(1) ; obs1 <- data.frame(Time = c(rnorm(10), rnorm(10) + 2), Group1 = rep(c("G", "H"), each = 10)) ; data = 'fun_gg_boxplot(data1 = obs1, y = "Time", categ = "Group1")' ; kind = "warning" ; header = TRUE ; print.no = FALSE ; text = NULL ; env = NULL  # for function debugging
# data = "message('ahah')" ; kind = "error" ; header = TRUE ; print.no = TRUE ; text = "IN A" ; env = NULL 
# data = 'ggplot2::ggplot(data = data.frame(X = "a"), mapping = ggplot2::aes(x = X)) + ggplot2::geom_histogram()' ; kind = "message" ; header = TRUE ; print.no = FALSE ; text = NULL # for function debugging
# data = 'ggplot2::ggplot(data = data.frame(X = "a"), mapping = ggplot2::aes(x = X)) + ggplot2::geom_histogram()' ; kind = "warning" ; header = TRUE ; print.no = FALSE ; text = NULL # for function debugging
# function name
function.name <- paste0(as.list(match.call(expand.dots=FALSE))[[1]], "()")
# end function name
# required function checking
if(length(utils::find("fun_check", mode = "function")) == 0){
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": REQUIRED fun_check() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
stop(tempo.cat, call. = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8418
}
Gael  MILLOT's avatar
Gael MILLOT committed
8419
8420
8421
8422
8423
8424
8425
8426
8427
8428
8429
8430
8431
8432
# end required function checking
# no need to use reserved words to avoid bugs, because it is local, and  exists("tempo.warning", inherit = FALSE), never use the scope
# argument checking
# argument checking with fun_check()
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$fun.name))
tempo <- fun_check(data = data, class = "character", length = 1, fun.name = function.name) ; eval(ee)
tempo <- fun_check(data = kind, options = c("error", "warning", "message"), length = 1, fun.name = function.name) ; eval(ee)
tempo <- fun_check(data = print.no, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
tempo <- fun_check(data = header, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
if( ! is.null(text)){
tempo <- fun_check(data = text, class = "character", length = 1, fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
8433
}
Gael  MILLOT's avatar
Gael MILLOT committed
8434
8435
if( ! is.null(env)){
tempo <- fun_check(data = env, class = "environment", fun.name = function.name) ; eval(ee) #
Gael  MILLOT's avatar
Gael MILLOT committed
8436
}
Gael  MILLOT's avatar
Gael MILLOT committed
8437
8438
if(any(arg.check) == TRUE){
stop(paste0("\n\n================\n\n", paste(text.check[arg.check], collapse = "\n"), "\n\n================\n\n"), call. = FALSE) #
Gael  MILLOT's avatar
Gael MILLOT committed
8439
}
Gael  MILLOT's avatar
Gael MILLOT committed
8440
8441
8442
8443
8444
8445
8446
8447
8448
8449
8450
8451
# end argument checking with fun_check()
# source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.2/r_debugging_tools-v1.2.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 checking
# main code
pdf(file = NULL) # send plots into a NULL file, no pdf file created
window.nb <- dev.cur()
dev.set(window.nb)
# last warning cannot be used because suppressWarnings() does not modify last.warning present in the base evironment (created at first warning in a new R session), or warnings() # to reset the warning history : unlockBinding("last.warning", baseenv()) ; assign("last.warning", NULL, envir = baseenv())
output <- NULL
tempo.error <- try(suppressMessages(suppressWarnings(eval(parse(text = data), envir = if(is.null(env)){parent.frame()}else{env}))), silent = TRUE) # get error message, not warning or messages
if(any(class(tempo.error) %in% c("gg", "ggplot"))){
tempo.error <- try(suppressMessages(suppressWarnings(ggplot2::ggplot_build(tempo.error))), silent = TRUE)[1]
Gael  MILLOT's avatar
Gael MILLOT committed
8452
}
Gael  MILLOT's avatar
Gael MILLOT committed
8453
if(exists("tempo.error", inherit = FALSE) == TRUE){ # inherit = FALSE avoid the portee lexical and thus the declared word
8454
if( ! all(class(tempo.error) == "try-error")){ # deal with NULL and S4 objects. Old code:  ! (all(class(tempo.error) == "try-error") & any(grepl(x = tempo.error, pattern = "^Error|^error|^ERROR"))) but problem with S4 objects. Old code : if((length(tempo.error) > 0 & ! any(grepl(x = tempo.error, pattern = "^Error|^error|^ERROR"))) | (length(tempo.error) == 0) ){ but problem when tempo.error is a list but added this did not work: | ! all(class(tempo.error) == "character")
Gael  MILLOT's avatar
Gael MILLOT committed
8455
tempo.error <- NULL
Gael  MILLOT's avatar
Gael MILLOT committed
8456
}
8457
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
8458
tempo.error <- NULL
8459
}
Gael  MILLOT's avatar
Gael MILLOT committed
8460
8461
8462
8463
if(kind == "error" & ! is.null(tempo.error)){ # 
if(header == TRUE){
tempo.error[1] <- gsub(x = tempo.error[1], pattern = "^Error i|^error i|^ERROR I", replacement = "I")
output <- paste0("ERROR MESSAGE REPORTED", ifelse(is.null(text), "", " "), text, ":\n", tempo.error[1]) #
Gael  MILLOT's avatar
Gael MILLOT committed
8464
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
8465
output <- tempo.error[1] #
Gael  MILLOT's avatar
Gael MILLOT committed
8466
}
Gael  MILLOT's avatar
Gael MILLOT committed
8467
8468
8469
8470
8471
8472
8473
8474
8475
8476
8477
8478
8479
8480
}else if(kind == "error" & is.null(tempo.error) & print.no == TRUE){
output <- paste0("NO ERROR MESSAGE REPORTED", ifelse(is.null(text), "", " "), text)
}else if(kind != "error" & ( ! is.null(tempo.error)) & print.no == TRUE){
output <- paste0("NO ", ifelse(kind == "warning", "WARNING", "STANDARD (NON ERROR AND NON WARNING)"), " MESSAGE BECAUSE OF ERROR MESSAGE REPORTED", ifelse(is.null(text), "", " "), text)
}else if(is.null(tempo.error)){
fun.warning.capture <- function(expr){
# from demo(error.catching) typed in the R console, coming from ?tryCatch
# see also http://mazamascience.com/WorkingWithData/?p=912
# return a character string or NULL
# expr <- wilcox.test.default(c(1, 1, 3), c(1, 2, 4), paired = TRUE)
W <- NULL
w.handler <- function(w){ # warning handler
W <<- w # send to the above env, i.e., the inside of the fun.warning.capture function
invokeRestart("muffleWarning") # here w.handler() muffles all the warnings. See http://romainfrancois.blog.free.fr/index.php?post/2009/05/20/Disable-specific-warnings to muffle specific warnings and print others
8481
}
Gael  MILLOT's avatar
Gael MILLOT committed
8482
8483
8484
8485
8486
output <- list(
value = suppressMessages(withCallingHandlers(tryCatch(expr, error = function(e){e}), warning = w.handler)), # BEWARE: w.handler is a function written without (), like in other functions with FUN argument
warning = W # processed by w.handler()
)
return(if(is.null(output$warning)){NULL}else{as.character(output$warning)})
Gael  MILLOT's avatar
Gael MILLOT committed
8487
}
Gael  MILLOT's avatar
Gael MILLOT committed
8488
8489
8490
8491
8492
8493
8494
8495
tempo.warn <- fun.warning.capture(eval(parse(text = data), envir = if(is.null(env)){parent.frame()}else{env}))
# warn.options.ini <- options()$warn ; options(warn = 1) ; tempo.warn <- utils::capture.output({tempo <- suppressMessages(eval(parse(text = data), envir = if(is.null(env)){parent.frame()}else{env}))}, type = "message") ; options(warn = warn.options.ini) # this recover warnings not messages and not errors but does not work in all enviroments
tempo.message <- utils::capture.output({
tempo <- suppressMessages(suppressWarnings(eval(parse(text = data), envir = if(is.null(env)){parent.frame()}else{env})))
if(any(class(tempo) %in% c("gg", "ggplot"))){
tempo <- ggplot2::ggplot_build(tempo)
}else{
tempo <- suppressWarnings(eval(parse(text = data), envir = if(is.null(env)){parent.frame()}else{env}))
Gael  MILLOT's avatar
Gael MILLOT committed
8496
}
Gael  MILLOT's avatar
Gael MILLOT committed
8497
8498
8499
8500
8501
}, type = "message") # recover messages not warnings and not errors
if(kind == "warning" & ! is.null(tempo.warn)){
if(length(tempo.warn) > 0){ # to avoid character(0)
if( ! any(sapply(tempo.warn, FUN = "grepl", pattern = "() FUNCTION:$"))){
tempo.warn <- paste(unique(tempo.warn), collapse = "\n") # if FALSE, means that the tested data is a special function. If TRUE, means that the data is a standard function. In that case, the output of capture.output() is two strings per warning messages: if several warning messages -> identical first string, which is removed in next messages by unique()
Gael  MILLOT's avatar
Gael MILLOT committed
8502
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
8503
tempo.warn <- paste(tempo.warn, collapse = "\n")
Gael  MILLOT's avatar
Gael MILLOT committed
8504
}
Gael  MILLOT's avatar
Gael MILLOT committed
8505
8506
8507
if(header == TRUE){
if(any(grepl(x = tempo.warn[[1]], pattern = "^simpleWarning i"))){
tempo.warn[[1]] <- gsub(x = tempo.warn[[1]], pattern = "^Warning i", replacement = "I")
Gael  MILLOT's avatar
Gael MILLOT committed
8508
}
Gael  MILLOT's avatar
Gael MILLOT committed
8509
8510
if(any(grepl(x = tempo.warn[[1]], pattern = "^Warning i"))){
tempo.warn[[1]] <- gsub(x = tempo.warn[[1]], pattern = "^Warning i", replacement = "I")
Gael  MILLOT's avatar
Gael MILLOT committed
8511
}
Gael  MILLOT's avatar
Gael MILLOT committed
8512
output <- paste0("WARNING MESSAGE REPORTED", ifelse(is.null(text), "", " "), text, ":\n", tempo.warn) #
Gael  MILLOT's avatar
Gael MILLOT committed
8513
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
8514
output <- tempo.warn #
Gael  MILLOT's avatar
Gael MILLOT committed
8515
}
Gael  MILLOT's avatar
Gael MILLOT committed
8516
8517
}else if(print.no == TRUE){
output <- paste0("NO WARNING MESSAGE REPORTED", ifelse(is.null(text), "", " "), text)
Gael  MILLOT's avatar
Gael MILLOT committed
8518
}
Gael  MILLOT's avatar
Gael MILLOT committed
8519
8520
8521
8522
8523
8524
}else if(kind == "warning" & is.null(tempo.warn) & print.no == TRUE){
output <- paste0("NO WARNING MESSAGE REPORTED", ifelse(is.null(text), "", " "), text)
}else if(kind == "message" & exists("tempo.message", inherit = FALSE) == TRUE){ # inherit = FALSE avoid the portee lexical and thus the declared word
if(length(tempo.message) > 0){ # if something is returned by capture.ouptput() (only in this env) with a length more than 1
if(header == TRUE){
output <- paste0("STANDARD (NON ERROR AND NON WARNING) MESSAGE REPORTED", ifelse(is.null(text), "", " "), text, ":\n", tempo.message) #
Gael  MILLOT's avatar
Gael MILLOT committed
8525
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
8526
output <- tempo.message #
Gael  MILLOT's avatar
Gael MILLOT committed
8527
}
Gael  MILLOT's avatar
Gael MILLOT committed
8528
8529
}else if(print.no == TRUE){
output <- paste0("NO STANDARD (NON ERROR AND NON WARNING) MESSAGE REPORTED", ifelse(is.null(text), "", " "), text)
Gael  MILLOT's avatar
Gael MILLOT committed
8530
}
Gael  MILLOT's avatar
Gael MILLOT committed
8531
8532
8533
8534
8535
8536
}else if(kind == "message" & exists("tempo.message", inherit = FALSE) == FALSE & print.no == TRUE){
output <- paste0("NO STANDARD (NON ERROR AND NON WARNING) MESSAGE REPORTED", ifelse(is.null(text), "", " "), text)
}
}
invisible(dev.off(window.nb)) # end send plots into a NULL file
return(output) # do not use cat() because the idea is to reuse the message
Gael  MILLOT's avatar
Gael MILLOT committed
8537
8538
}

8539
8540


Gael  MILLOT's avatar
tempo    
Gael MILLOT committed
8541