cute_little_R_functions.R 711 KB
Newer Older
Gael  MILLOT's avatar
Gael MILLOT committed
9001
9002
}
if( ! is.null(data2.signif.dot)){
Gael  MILLOT's avatar
Gael MILLOT committed
9003
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
9004
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
9005
}
Gael  MILLOT's avatar
Gael MILLOT committed
9006
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", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
9007
9008
9009
9010
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
9011
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
9012
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
9013
9014
9015
9016
9017
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA2 DOTS OUTSIDE THE FRAMES", text.size = 12, title = "DATA1 + DATA2 + DATA2 SIGNIFICANT DOTS")
}
if( ! is.null(data2.incon.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
9018
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
9019
}
Gael  MILLOT's avatar
Gael MILLOT committed
9020
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", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
9021
9022
9023
9024
9025
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
9026
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
9027
9028
9029
9030
9031
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA2 INCONSISTENT DOTS", text.size = 12, title = "DATA2 + DATA2 INCONSISTENT DOTS")
}
if( ! is.null(data2.unknown.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
9032
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
9033
}
Gael  MILLOT's avatar
Gael MILLOT committed
9034
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", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
9035
9036
9037
9038
9039
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
9040
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
9041
9042
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA2 UNKNOWN DOTS", text.size = 12, title = "DATA2 + DATA2 UNKNOWN DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
9043
9044
9045
9046
}
}
}
}
Gael  MILLOT's avatar
Gael MILLOT committed
9047
# end plot
Gael  MILLOT's avatar
Gael MILLOT committed
9048
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, warnings = warning)
Gael  MILLOT's avatar
Gael MILLOT committed
9049
9050
9051
9052
9053
9054
9055
return(tempo.list)
}


################ Import


Gael  MILLOT's avatar
Gael MILLOT committed
9056
######## fun_pack() #### check if R packages are present and import into the working environment
Gael  MILLOT's avatar
Gael MILLOT committed
9057
9058
9059


# Check OK: clear to go Apollo
Gael  MILLOT's avatar
Gael MILLOT committed
9060
fun_pack <- function(req.package, load = FALSE, path.lib = NULL){
Gael  MILLOT's avatar
Gael MILLOT committed
9061
9062
9063
9064
# 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
9065
# req.package: logical. Load the package into the environement (using library())?
Gael  MILLOT's avatar
Gael MILLOT committed
9066
9067
9068
9069
# path.lib: 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
Gael  MILLOT's avatar
Gael MILLOT committed
9070
# fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
9071
9072
9073
# RETURN
# nothing
# EXAMPLES
Gael  MILLOT's avatar
Gael MILLOT committed
9074
9075
9076
# fun_pack(req.package = "nopackage")
# fun_pack(req.package = "ggplot2")
# fun_pack(req.package = "ggplot2", path.lib = "blablabla")
Gael  MILLOT's avatar
Gael MILLOT committed
9077
9078
9079
9080
9081
9082
# DEBUGGING
# req.package = "ggplot2" ; path.lib = "C:/Program Files/R/R-3.5.1/library"
# function name
function.name <- paste0(as.list(match.call(expand.dots=FALSE))[[1]], "()")
# end function name
# required function checking
Gael  MILLOT's avatar
Gael MILLOT committed
9083
9084
if(length(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")
Gael  MILLOT's avatar
Gael MILLOT committed
9085
9086
9087
9088
9089
9090
9091
stop(tempo.cat)
}
# end required function checking
# argument checking
arg.check <- NULL # for function debbuging
checked.arg.names <- NULL # for function debbuging: used by r_debugging_tools
ee <- expression(arg.check <- c(arg.check, tempo$problem) , checked.arg.names <- c(checked.arg.names, tempo$param.name))
Gael  MILLOT's avatar
Gael MILLOT committed
9092
9093
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)
Gael  MILLOT's avatar
Gael MILLOT committed
9094
if( ! is.null(path.lib)){
Gael  MILLOT's avatar
Gael MILLOT committed
9095
tempo <- fun_check(data = path.lib, class = "character", fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
9096
9097
9098
9099
9100
9101
if(tempo$problem == FALSE & ! all(dir.exists(path.lib))){
cat(paste0("\n\n============\n\nERROR IN ", function.name, ": \nDIRECTORY PATH INDICATED IN THE path.lib PARAMETER DOES NOT EXISTS: ", path.lib, "\n\n============\n\n"))
arg.check <- c(arg.check, TRUE)
}
}
if(any(arg.check) == TRUE){
Gael  MILLOT's avatar
Gael MILLOT committed
9102
stop() # nothing else because print = TRUE by default in fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
9103
}
Gael  MILLOT's avatar
Gael MILLOT committed
9104
# 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()
Gael  MILLOT's avatar
Gael MILLOT committed
9105
9106
9107
9108
9109
# end argument checking
# main code
if(is.null(path.lib)){
path.lib <- .libPaths() # .libPaths(new = path.lib) # or .libPaths(new = c(.libPaths(), path.lib))
}else{
9110
.libPaths(new = sub(x = path.lib, 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
Gael  MILLOT's avatar
Gael MILLOT committed
9111
9112
9113
9114
9115
}
for(i0 in 1:length(req.package)){
if( ! req.package[i0] %in% rownames(installed.packages(lib.loc = path.lib))){
stop(paste0("\n\n================\n\nERROR IN ", function.name, ": PACKAGE ", req.package[i0], " MUST BE INSTALLED IN:\n", paste(path.lib, collapse = "\n"), "\n\n================\n\n"))
}else{
9116
if(load == TRUE){
Gael  MILLOT's avatar
Gael MILLOT committed
9117
9118
9119
9120
suppressWarnings(suppressPackageStartupMessages(library(req.package[i0], lib.loc = path.lib, quietly = TRUE, character.only = TRUE)))
}
}
}
9121
}
Gael  MILLOT's avatar
Gael MILLOT committed
9122
9123


Gael  MILLOT's avatar
Gael MILLOT committed
9124
######## fun_python_pack() #### check if python packages are present
Gael  MILLOT's avatar
Gael MILLOT committed
9125
9126
9127


# Check OK: clear to go Apollo
Gael  MILLOT's avatar
Gael MILLOT committed
9128
fun_python_pack <- function(req.package, path.lib = NULL, R.path.lib = NULL){
Gael  MILLOT's avatar
Gael MILLOT committed
9129
9130
9131
9132
9133
9134
9135
9136
9137
# AIM
# check if the specified python packages are present in the computer (no import)
# ARGUMENTS
# req.package: character vector of package names to import
# path.lib: optional character vector specifying the absolute pathways of the directories containing some of the listed packages
# R.path.lib: absolute path of the required packages, if not in the default folders
# REQUIRED PACKAGES
# reticulate
# REQUIRED FUNCTIONS FROM CUTE_LITTLE_R_FUNCTION
Gael  MILLOT's avatar
Gael MILLOT committed
9138
9139
# fun_check()
# fun_pack()
Gael  MILLOT's avatar
Gael MILLOT committed
9140
9141
9142
# RETURN
# nothing
# EXAMPLES
Gael  MILLOT's avatar
Gael MILLOT committed
9143
9144
9145
# fun_python_pack(req.package = "nopackage")
# fun_python_pack(req.package = "serpentine")
# fun_python_pack(req.package = "serpentine", path.lib = "blablabla")
Gael  MILLOT's avatar
Gael MILLOT committed
9146
9147
9148
9149
9150
9151
9152
# DEBUGGING
# req.package = "serpentine" ; path.lib = "C:/Program Files/R/R-3.5.1/library" ; R.path.lib = NULL
# req.package = "bad" ; path.lib = NULL ; R.path.lib = NULL
# function name
function.name <- paste0(as.list(match.call(expand.dots=FALSE))[[1]], "()")
# end function name
# required function checking
Gael  MILLOT's avatar
Gael MILLOT committed
9153
9154
if(length(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")
Gael  MILLOT's avatar
Gael MILLOT committed
9155
9156
stop(tempo.cat)
}
Gael  MILLOT's avatar
Gael MILLOT committed
9157
9158
if(length(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")
Gael  MILLOT's avatar
Gael MILLOT committed
9159
9160
9161
9162
9163
9164
9165
stop(tempo.cat)
}
# end required function checking
# argument checking
arg.check <- NULL # for function debbuging
checked.arg.names <- NULL # for function debbuging: used by r_debugging_tools
ee <- expression(arg.check <- c(arg.check, tempo$problem) , checked.arg.names <- c(checked.arg.names, tempo$param.name))
Gael  MILLOT's avatar
Gael MILLOT committed
9166
tempo <- fun_check(data = req.package, class = "character", fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
9167
if( ! is.null(path.lib)){
Gael  MILLOT's avatar
Gael MILLOT committed
9168
tempo <- fun_check(data = path.lib, class = "character", fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
9169
9170
9171
9172
9173
9174
if(tempo$problem == FALSE & ! all(dir.exists(path.lib))){
cat(paste0("\n\n============\n\nERROR IN ", function.name, ": \nDIRECTORY PATH INDICATED IN THE path.lib PARAMETER DOES NOT EXISTS: ", path.lib, "\n\n============\n\n"))
arg.check <- c(arg.check, TRUE)
}
}
if( ! is.null(R.path.lib)){
Gael  MILLOT's avatar
Gael MILLOT committed
9175
tempo <- fun_check(data = R.path.lib, class = "character", fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
9176
9177
9178
9179
9180
9181
if(tempo$problem == FALSE & ! all(dir.exists(R.path.lib))){
cat(paste0("\n\n============\n\nERROR IN ", function.name, ": \nDIRECTORY PATH INDICATED IN THE R.path.lib PARAMETER DOES NOT EXISTS: ", R.path.lib, "\n\n============\n\n"))
arg.check <- c(arg.check, TRUE)
}
}
if(any(arg.check) == TRUE){
Gael  MILLOT's avatar
Gael MILLOT committed
9182
stop() # nothing else because print = TRUE by default in fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
9183
}
Gael  MILLOT's avatar
Gael MILLOT committed
9184
# 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()
Gael  MILLOT's avatar
Gael MILLOT committed
9185
9186
# end argument checking
# package checking
Gael  MILLOT's avatar
Gael MILLOT committed
9187
fun_pack(req.package = "reticulate", path.lib = R.path.lib)
Gael  MILLOT's avatar
Gael MILLOT committed
9188
9189
9190
9191
9192
9193
9194
9195
9196
9197
9198
9199
9200
9201
9202
9203
9204
9205
9206
9207
9208
9209
9210
9211
9212
9213
# end package checking
# main code
if(is.null(path.lib)){
path.lib <- reticulate::py_run_string("
import sys ;
path_lib = sys.path
") # python string
path.lib <- path.lib$path_lib
}
for(i0 in 1:length(req.package)){
tempo.try <- vector("list", length = length(path.lib))
for(i1 in 1:length(path.lib)){
tempo.try[[i1]] <- try(suppressWarnings(reticulate::import_from_path(req.package[i0], path = path.lib[i1])), silent = TRUE)
}
if(all(sapply(tempo.try, FUN = grepl, pattern = "[Ee]rror"))){
stop(paste0("\n\n================\n\nERROR IN ", function.name, ": PACKAGE ", req.package[i0], " MUST BE INSTALLED IN THE MENTIONNED DIRECTORY:\n", paste(path.lib, collapse = "\n"), "\n\n================\n\n"))
}else{
assign(req.package[i0], reticulate::import(req.package[i0]))
}
}
}


################ Exporting results (text & tables)


Gael  MILLOT's avatar
Gael MILLOT committed
9214
######## fun_report() #### print string or data object into output file
Gael  MILLOT's avatar
Gael MILLOT committed
9215
9216
9217


# Check OK: clear to go Apollo
Gael  MILLOT's avatar
Gael MILLOT committed
9218
fun_report <- function(data = NULL, output ="results.txt", path = "C:/Users/Gael/Desktop", no.overwrite = TRUE, rownames.kept = FALSE, vector.cat = FALSE, noquote = TRUE, sep = 2){
Gael  MILLOT's avatar
Gael MILLOT committed
9219
9220
9221
# AIM
# log file function: print a character string or a data object into a same output file
# REQUIRED FUNCTIONS FROM CUTE_LITTLE_R_FUNCTION
Gael  MILLOT's avatar
Gael MILLOT committed
9222
# fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
9223
9224
9225
9226
9227
9228
9229
9230
9231
9232
9233
9234
# ARGUMENTS
# data: object to print in the output file. cannot be NULL
# 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
Gael  MILLOT's avatar
Gael MILLOT committed
9235
9236
# 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)
Gael  MILLOT's avatar
Gael MILLOT committed
9237
9238
9239
9240
9241
9242
# 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
Gael  MILLOT's avatar
Gael MILLOT committed
9243
9244
if(length(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")
Gael  MILLOT's avatar
Gael MILLOT committed
9245
9246
9247
9248
stop(tempo.cat)
}
# end required function checking
# argument checking
Gael  MILLOT's avatar
Gael MILLOT committed
9249
# argument checking without fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
9250
9251
9252
9253
if(is.null(data)){
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": data ARGUMENT CANNOT BE NULL\n\n================\n\n")
stop(tempo.cat)
}
Gael  MILLOT's avatar
Gael MILLOT committed
9254
9255
# end argument checking without fun_check()
# argument checking with fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
9256
9257
9258
arg.check <- NULL # for function debbuging
checked.arg.names <- NULL # for function debbuging: used by r_debugging_tools
ee <- expression(arg.check <- c(arg.check, tempo$problem) , checked.arg.names <- c(checked.arg.names, tempo$param.name))
Gael  MILLOT's avatar
Gael MILLOT committed
9259
tempo <- fun_check(data = output, class = "character", length = 1, fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
9260
9261
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")
Gael  MILLOT's avatar
Gael MILLOT committed
9262
cat(tempo.cat)
Gael  MILLOT's avatar
Gael MILLOT committed
9263
9264
arg.check <- c(arg.check, TRUE)
}
Gael  MILLOT's avatar
Gael MILLOT committed
9265
tempo <- fun_check(data = path, class = "character", length = 1, fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
9266
9267
if(tempo$problem == FALSE & dir.exists(path) == FALSE){
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")
Gael  MILLOT's avatar
Gael MILLOT committed
9268
cat(tempo.cat)
Gael  MILLOT's avatar
Gael MILLOT committed
9269
9270
arg.check <- c(arg.check, TRUE)
}
Gael  MILLOT's avatar
Gael MILLOT committed
9271
9272
9273
9274
9275
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)
Gael  MILLOT's avatar
Gael MILLOT committed
9276
if(any(arg.check) == TRUE){
Gael  MILLOT's avatar
Gael MILLOT committed
9277
stop() # nothing else because print = TRUE by default in fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
9278
}
Gael  MILLOT's avatar
Gael MILLOT committed
9279
9280
# 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()
Gael  MILLOT's avatar
Gael MILLOT committed
9281
9282
9283
9284
9285
9286
9287
9288
9289
9290
9291
9292
9293
9294
# 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)
# }
# end argument checking
# main code
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)
Gael  MILLOT's avatar
Gael MILLOT committed
9295
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"
Gael  MILLOT's avatar
Gael MILLOT committed
9296
9297
9298
9299
9300
9301
9302
9303
9304
9305
9306
9307
9308
9309
9310
9311
9312
9313
9314
9315
9316
9317
9318
9319
9320
9321
rownames.output.tables <- c(rownames.output.tables, paste0(rownames.output.tables[i]," ", collapse=""))
}
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
}
if(noquote == TRUE){
capture.output(noquote(data), file=paste0(path, "/", output), append = no.overwrite)
}else{
capture.output(data, file=paste0(path, "/", output), append = no.overwrite)
}
}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)
}else{
cat(data, file= paste0(path, "/", output), append = no.overwrite)
}
}else{ # other (array, list, factor or vector with vector.cat = FALSE)
if(noquote == TRUE){
capture.output(noquote(data), file=paste0(path, "/", output), append = no.overwrite)
}else{
capture.output(data, file=paste0(path, "/", output), append = no.overwrite)
}
}
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
9322
9323
9324
}

For faster browsing, not all history is shown. View entire blame