Skip to content
Snippets Groups Projects
Commit 4231cec6 authored by Gael's avatar Gael
Browse files

release v1.5

parent e2a302fb
Branches
Tags v0.2.6
No related merge requests found
Show whitespace changes
Inline Side-by-side
README.md
+ 5
− 0
View file @ 4231cec6
...@@ -5,6 +5,11 @@ Source the cute_little_functions.R into R/RStudio to have the functions availabl ...@@ -5,6 +5,11 @@ Source the cute_little_functions.R into R/RStudio to have the functions availabl
WHAT'S NEW IN WHAT'S NEW IN
v1.5:
1) Improved
v1.4: v1.4:
1) Debugged 1) Debugged
......
r_debugging_tools.R
+ 43
− 25
View file @ 4231cec6
################################################################ ################################################################
## ## ## ##
## R DEBUGGING TOOLS v1.4 ## ## R DEBUGGING TOOLS v1.5 ##
## ## ## ##
## Gael A. Millot ## ## Gael A. Millot ##
## ## ## ##
...@@ -17,15 +17,17 @@ str_basic_arg_check_dev <- ' ...@@ -17,15 +17,17 @@ str_basic_arg_check_dev <- '
# arguments without default values # arguments without default values
# arguments with variable as default value (FORBIDDEN) # arguments with variable as default value (FORBIDDEN)
# STRING # STRING
function.name <- as.list(match.call(expand.dots=FALSE))[[1]] function.name.local <- as.list(match.call(expand.dots=FALSE))[[1]]
default.arg.list <- formals(fun = sys.function(sys.parent(n = 2))) # list of all the arguments of the function with their default values (not the values of the user !). Use n = 2 when he string has to be evaluated by eval() inside a function. Use n=1 (default) if not evaluation. It seems that ls() as first line of the function provide the names of the arguments (empty, called, etc., or not) default.arg.list <- formals(fun = sys.function(sys.parent(n = 2))) # list of all the arguments of the function with their default values (not the values of the user !). Use n = 2 when he string has to be evaluated by eval() inside a function. Use n=1 (default) if not evaluation. 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.log <- sapply(default.arg.list, is.symbol) & sapply(sapply(default.arg.list, as.character), identical, "") # logical indicating argument without default values (these are typeof "symbol" and class "name" and empty character arg.without.default.value.log <- sapply(default.arg.list, is.symbol) & sapply(sapply(default.arg.list, as.character), identical, "") # logical indicating argument without default values (these are typeof "symbol" and class "name" and empty character
name.or.empty.default.val.arg.log <- sapply(default.arg.list, FUN = "class") == "name" name.or.empty.default.val.arg.log <- sapply(default.arg.list, FUN = "class") == "name"
arg.with.fun.as.default.value.log <- sapply(default.arg.list, class) %in% c("function", "call") & ! name.or.empty.default.val.arg.log # arguments with function as default values
if(length(name.or.empty.default.val.arg.log) != length(arg.without.default.value.log)){ if(length(name.or.empty.default.val.arg.log) != length(arg.without.default.value.log)){
stop(paste0("\n\n================\n\nINTERNAL ERROR IN str_basic_arg_check_dev IN ", function.name,". CODE MUST BE MODIFED\n\n================\n\n")) stop(paste0("\n\n================\n\nINTERNAL ERROR IN str_basic_arg_check_dev IN ", function.name.local,". CODE MUST BE MODIFED\n\n================\n\n"))
}else if(any(name.or.empty.default.val.arg.log & ! arg.without.default.value.log)){ }else if(any(name.or.empty.default.val.arg.log & ! arg.without.default.value.log)){
cat(paste0("\n\n================\n\nALERT\nDEFAULT VALUE OF ARGUMENT OF ", function.name," MUST NOT BE A VARIABLE (POTENTIAL PROBLEM OF SCOPE)\nTHE CONCERNED ARGUMENTS ARE:\n", paste(names(formals(fun = sys.function(sys.parent(n = 2))))[name.or.empty.default.val.arg.log & ! arg.without.default.value.log], collapse = "\n"), "\n\n================\n\n")) cat(paste0("\n\n================\n\nALERT\nDEFAULT VALUE OF ARGUMENT OF ", function.name.local," MUST NOT BE A VARIABLE (POTENTIAL PROBLEM OF SCOPE)\nTHE CONCERNED ARGUMENTS ARE:\n", paste(names(formals(fun = sys.function(sys.parent(n = 2))))[name.or.empty.default.val.arg.log & ! arg.without.default.value.log], collapse = "\n"), "\n\n================\n\n"))
} }
if(any(arg.without.default.value.log)){ if(any(arg.without.default.value.log)){
...@@ -33,15 +35,26 @@ if(any(arg.without.default.value.log)){ ...@@ -33,15 +35,26 @@ if(any(arg.without.default.value.log)){
}else{ }else{
arg.without.default.value <- NULL arg.without.default.value <- NULL
} }
if(any(arg.with.fun.as.default.value.log)){
arg.with.fun.as.default.value <- default.arg.list[arg.with.fun.as.default.value.log]
}else{
arg.with.fun.as.default.value <- NULL
}
if(any( ! arg.without.default.value.log)){ if(any( ! arg.without.default.value.log)){
arg.with.default.value <- default.arg.list[ ! arg.without.default.value.log] if( ! is.null(arg.with.fun.as.default.value)){
arg.with.default.value.log <- ( ! arg.without.default.value.log) & ( ! arg.with.fun.as.default.value.log) # remove also the # remove the functions from the default values
}else{
arg.with.default.value.log <- ( ! arg.without.default.value.log)
}
arg.with.default.value <- default.arg.list[arg.with.default.value.log]
}else{ }else{
arg.with.default.value <- NULL arg.with.default.value <- NULL
} }
cat(paste0("\n\n================================\n\n", function.name," FUNCTION ARGUMENT CHECKING\n\n================================\n"))
cat(paste0("\n\n================================\n\n", function.name.local," FUNCTION ARGUMENT CHECKING\n\n================================\n"))
cat(paste0("\n================\nARGUMENTS OF THE FUNCTION ARE (INCLUDING DEFAULT VALUES):\n\n")) cat(paste0("\n================\nARGUMENTS OF THE FUNCTION ARE (INCLUDING DEFAULT VALUES):\n\n"))
print(default.arg.list)
if(any(arg.without.default.value.log)){ # argument names that are empty by default added now because null arguments will not be inserted thenafter if(any(arg.without.default.value.log)){ # argument names that are empty by default added now because null arguments will not be inserted thenafter
cat(paste0("\n================\nARGUMENTS WITHOUT DEFAULT VALUES ARE:\n", paste(names(arg.without.default.value)[arg.without.default.value.log], collapse= "\n"))) cat(paste0("\n================\nARGUMENTS WITHOUT DEFAULT VALUES ARE:\n", paste(names(arg.without.default.value)[arg.without.default.value.log], collapse= "\n")))
...@@ -49,34 +62,39 @@ if(any(arg.without.default.value.log)){ # argument names that are empty by defau ...@@ -49,34 +62,39 @@ if(any(arg.without.default.value.log)){ # argument names that are empty by defau
cat(paste0("\n================\nNO ARGUMENTS WITHOUT DEFAULT VALUES")) cat(paste0("\n================\nNO ARGUMENTS WITHOUT DEFAULT VALUES"))
} }
if(any( ! arg.without.default.value.log)){
if(any(sapply(arg.with.default.value, FUN = is.null))){ if(any(arg.with.fun.as.default.value.log)){ #
cat(paste0("\n================\nNULL ARGUMENTS ARE:\n", paste(names(arg.with.default.value)[sapply(arg.with.default.value, FUN = is.null)], collapse= "\n"))) cat(paste0("\n================\nARGUMENTS WITH FUNCTION (CLASS function OR call) AS DEFAULT VALUE ARE:\n", paste(names(arg.with.fun.as.default.value), collapse= "\n")))
}
}else{ }else{
cat(paste0("\n================\nNO NULL ARGUMENTS")) cat(paste0("\n================\nNO ARGUMENTS WITH FUNCTION (CLASS function OR call) AS DEFAULT VALUE"))
} }
tempo.na <- NULL tempo.na <- NULL
if(any( ! arg.without.default.value.log)){ if( ! is.null(arg.with.default.value)){
if(any(sapply(arg.with.default.value, FUN = is.null))){
cat(paste0("\n================\nARGUMENTS WITH NULL DEFAULT VALUE ARE:\n", paste(names(arg.with.default.value)[sapply(arg.with.default.value, FUN = is.null)], collapse= "\n")))
}else{
cat(paste0("\n================\nNO ARGUMENTS WITH NULL DEFAULT VALUE"))
}
if(any( ! sapply(arg.with.default.value, FUN = is.null))){ if(any( ! sapply(arg.with.default.value, FUN = is.null))){
cat(paste0("\n================\nNON NULL ARGUMENTS ARE:\n", paste(names(arg.with.default.value)[ ! sapply(arg.with.default.value, FUN = is.null)], collapse= "\n"))) cat(paste0("\n================\nARGUMENTS WITH NON-NULL DEFAULT VALUE ARE:\n", paste(names(arg.with.default.value)[ ! sapply(arg.with.default.value, FUN = is.null)], collapse= "\n")))
tempo <- arg.with.default.value[ ! sapply(arg.with.default.value, FUN = is.null)] tempo <- arg.with.default.value[ ! sapply(arg.with.default.value, FUN = is.null)]
if(any(sapply(tempo, FUN = is.na))){ if(any(sapply(tempo, FUN = is.na))){
tempo.na <- paste0("\n================\nNA ARGUMENTS ARE:\n", paste(names(tempo)[sapply(tempo, FUN = is.na)], collapse= "\n")) tempo.na <- paste0("\n================\nARGUMENTS WITH NA DEFAULT VALUE ARE:\n", paste(names(tempo)[sapply(tempo, FUN = is.na)], collapse= "\n"))
}else{ }else{
tempo.na <- paste0("\n================\nNO NA ARGUMENTS") tempo.na <- paste0("\n================\nNO ARGUMENTS WITH NA DEFAULT VALUE")
} }
} }
}else{ }else{
cat(paste0("\n================\nNO NON NULL ARGUMENTS")) cat(paste0("\n================\nNO ARGUMENTS WITH NON-NULL DEFAULT VALUE"))
} }
if(any( ! arg.without.default.value.log)){ if(any( ! arg.without.default.value.log)){
if(any(sapply(arg.with.default.value, FUN = is.logical))){ if(any(sapply(arg.with.default.value, FUN = is.logical))){
cat(paste0("\n================\nLOGICAL ARGUMENTS ARE:\n", paste(names(arg.with.default.value)[sapply(arg.with.default.value, FUN = is.logical)], collapse= "\n"))) cat(paste0("\n================\nARGUMENTS WITH LOGICAL DEFAULT VALUE ARE:\n", paste(names(arg.with.default.value)[sapply(arg.with.default.value, FUN = is.logical)], collapse= "\n")))
} }
}else{ }else{
cat(paste0("\n================\nNO LOGICAL ARGUMENTS")) cat(paste0("\n================\nNO ARGUMENTS WITH LOGICAL DEFAULT VALUE"))
} }
if(! is.null(tempo.na)){ if(! is.null(tempo.na)){
...@@ -92,20 +110,20 @@ str_arg_check_with_fun_check_dev <- ' ...@@ -92,20 +110,20 @@ str_arg_check_with_fun_check_dev <- '
# string that check: # string that check:
# which arguments have been checked using fun_check() # which arguments have been checked using fun_check()
# STRING # STRING
function.name <- as.list(match.call(expand.dots=FALSE))[[1]] function.name.local <- as.list(match.call(expand.dots=FALSE))[[1]]
default.arg.list <- formals(fun = sys.function(sys.parent(n = 2))) # list of all the arguments of the function with their default values (not the values of the user !). Use n = 2 when he string has to be evaluated by eval() inside a function. Use n=1 (default) if not evaluation. It seems that ls() as first line of the function provide the names of the arguments (empty, called, etc., or not) default.arg.list <- formals(fun = sys.function(sys.parent(n = 2))) # list of all the arguments of the function with their default values (not the values of the user !). Use n = 2 when he string has to be evaluated by eval() inside a function. Use n=1 (default) if not evaluation. It seems that ls() as first line of the function provide the names of the arguments (empty, called, etc., or not)
if( ! any(ls() %in% "checked.arg.names")){ if( ! any(ls() %in% "checked.arg.names")){
cat(paste0("\n\n================\n\nERROR: MISSING checked.arg.names OBJECT. ARGUMENTS MAY HAVE NOT BEEN CHECKED USING fun_check(). SEE THE fun_export_data() FUNCTION FOR THIS KIND OF CHECKING\n\n================\n\n")) cat(paste0("\n\n================\n\nERROR: MISSING checked.arg.names OBJECT\nARGUMENTS MAY HAVE NOT BEEN CHECKED USING fun_check()\nSEE THE fun_export_data() FUNCTION FOR THIS KIND OF CHECKING\n\n================\n\n"))
} }
if( ! find("fun_check") == ".GlobalEnv"){ if( ! find("fun_check") == ".GlobalEnv"){
cat(paste0("\n\n================\n\nERROR: MISSING fun_check() FUNCTION IN THE GLOBAL ENVIRONMENT. ARGUMENTS MAY HAVE NOT BEEN CHECKED USING fun_check(). SEE THE fun_export_data() FUNCTION FOR THIS KIND OF CHECKING\n\n================\n\n")) cat(paste0("\n\n================\n\nERROR: MISSING fun_check() FUNCTION IN THE GLOBAL ENVIRONMENT\nARGUMENTS MAY HAVE NOT BEEN CHECKED USING fun_check()\nSEE THE fun_export_data() FUNCTION FOR THIS KIND OF CHECKING\n\n================\n\n"))
} }
cat(paste0("\n\n================================\n\n", function.name," FUNCTION ARGUMENT CHECKING USING fun_check()\n\n================================\n")) cat(paste0("\n\n================================\n\n", function.name.local," FUNCTION ARGUMENT CHECKING USING fun_check()\n\n================================\n"))
if(any(duplicated(checked.arg.names))){ # for function debbuging if(any(duplicated(checked.arg.names))){ # for function debbuging
cat(paste0("\n================\nTHESE ARGUMENTS ARE DUPLICATED IN CHECK USING fun_check(): ", paste(checked.arg.names[duplicated(checked.arg.names)], collapse = " "))) cat(paste0("\n================\nTHESE ARGUMENTS ARE DUPLICATED IN CHECK USING fun_check():\n", paste(checked.arg.names[duplicated(checked.arg.names)], collapse = "\n")))
} }
if( any(! names(default.arg.list) %in% checked.arg.names)){ # check the correct number of args # for function debbuging # names(default.arg.list) can be replaced by formalArgs("name of the created function") if( any(! names(default.arg.list) %in% checked.arg.names)){ # check the correct number of args # for function debbuging # names(default.arg.list) can be replaced by formalArgs("name of the created function")
cat(paste0("\n================\nTHESE ARGUMENTS HAVE NOT BEEN CHECKED WITH fun_check(): ", paste(names(default.arg.list)[ ! names(default.arg.list) %in% checked.arg.names], collapse = " "))) cat(paste0("\n================\nTHESE ARGUMENTS HAVE NOT BEEN CHECKED WITH fun_check():\n", paste(names(default.arg.list)[ ! names(default.arg.list) %in% checked.arg.names], collapse = "\n")))
}else{ }else{
cat(paste0("\n================\nALL THE ARGUMENTS HAVE BEEN CHECKED USING fun_check()")) cat(paste0("\n================\nALL THE ARGUMENTS HAVE BEEN CHECKED USING fun_check()"))
} }
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment