# color palette: see https://github.com/EmilHvitfeldt/r-color-palettes
# https://usethis.r-lib.org/ and usethat also
# ERROR: this line 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 does not work is no argument provided. Example fun_secu(). Fiw it everywhere
# ERROR: this line 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 does not work if no argument provided. Example fun_secu(). Fix it everywhere
tempo.cat <- paste0("ERROR IN fun_check()", ifelse(is.null(fun.name), "", paste0(" INSIDE ", fun.name)), ": length ARGUMENT MUST BE A SINGLE INTEGER VALUE")
stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
}
...
...
@@ -4262,6 +4263,160 @@ return(output)
}
######## fun_codon2aa() #### convert codon to amino acid using standard genetic code
fun_codon2aa <- function(
data,
display = FALSE
){
# AIM
# Convert codon to amino acid using standard genetic code indicated in https://en.wikipedia.org/wiki/DNA_and_RNA_codon_tables
# WARNINGS
# None
# ARGUMENTS
# data: single caracter string of three characters, or vector of three caracters, indicating the DNA codon (only "A", "T", "G" and "C" allowed). Case insensitive. Omitted if display argument is TRUE
# display: logical. Display the whole genetic table? if TRUE, override data
# RETURN
# The 1 letter uppercase amino acid of the submitted codon or the whole table if display argument is TRUE
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"
)
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 ==
if(any(tempo)){ # normally no NA for missing() output
tempo.cat <- paste0("ERROR IN ", function.name, "\nFOLLOWING ARGUMENT", ifelse(length(mandat.args) > 1, "S HAVE", "HAS"), " NO DEFAULT VALUE AND REQUIRE ONE:\n", paste0(mandat.args, collapse = "\n"))
stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
}
# end arg with no default values
# argument primary checking
arg.check <- NULL #
text.check <- NULL #
checked.arg.names <- NULL # for function debbuging: used by r_debugging_tools
tempo <- fun_check(data = data, class = "vector", typeof = "character", fun.name = function.name) ; eval(ee)
tempo <- fun_check(data = display, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
if(any(arg.check) == TRUE){ # normally no NA
stop(paste0("\n\n================\n\n", paste(text.check[arg.check], collapse = "\n"), "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between == #
}
# source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.7/r_debugging_tools-v1.7.R") ; eval(parse(text = str_basic_arg_check_dev)) ; eval(parse(text = str_arg_check_with_fun_check_dev)) # activate this line and use the function (with no arguments left as NULL) to check arguments status and if they have been checked using fun_check()
# end argument primary checking
# second round of checking and data preparation
# management of NA arguments
tempo.arg <- names(arg.user.setting) # values provided by the user
tempo.log <- suppressWarnings(sapply(lapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = is.na), FUN = any)) & lapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = length) == 1L # no argument provided by the user can be just NA
if(any(tempo.log) == TRUE){ # normally no NA because is.na() used here
tempo.cat <- paste0("ERROR IN ", function.name, ":\n", ifelse(sum(tempo.log, na.rm = TRUE) > 1, "THESE ARGUMENTS\n", "THIS ARGUMENT\n"), paste0(tempo.arg[tempo.log], collapse = "\n"),"\nCANNOT JUST BE NA")
stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
}
# end management of NA arguments
# management of NULL arguments
tempo.arg <-c(
"data",
"display"
)
tempo.log <- sapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = is.null)
if(any(tempo.log) == TRUE){# normally no NA with is.null()
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
# end code that protects set.seed() in the global environment
# warning initiation
# end warning initiation
# other checkings
if(length(data) == 1L){
data <- unlist(strsplit(data, split = ""))
}else if(length(data) != 3L){
tempo.cat <- paste0("ERROR IN ", function.name, ": data ARGUMENT MUST BE A STRING OF THREE CHARACTERS OR A VECTOR OF THREE CHARACTERS, MADE OF \"A\", \"C\", \"G\", \"T\" ONLY")
stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
tempo.cat <- paste0("ERROR IN ", function.name, ": data ARGUMENT MUST BE A STRING OF THREE CHARACTERS OR A VECTOR OF THREE CHARACTERS, MADE OF \"A\", \"C\", \"G\", \"T\" ONLY")
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 other checkings
# reserved word checking
# end reserved word checking
# end second round of checking and data preparation
@@ -8781,11 +8936,13 @@ return(output) # do not use cat() because the idea is to reuse the message
# Error: class order not good when a class is removed due to NA
# Error: line 136 in check 20201126 with add argument
# Solve this: sometimes error messages can be more than the max display (8170). Thus, check every paste0("ERROR IN ", function.name, and trunck the message if to big. In addition, add at the begining of the warning message that it is too long and see the $warn output for complete message. Add also this into fun_scatter
# add dot.shape ? See with available aesthetic layers
# add horizontal argument and deal any conflict with vertical argument. Start with horizontal = NULL as default. If ! is.null() -> convert vertical if required
fun_gg_boxplot <- function(
data1,
...
...
@@ -11002,6 +11159,8 @@ return(output) # this plots the graph if return.ggplot is TRUE and if no assignm
# add density
# rasterise all kind: https://cran.r-project.org/web/packages/ggrastr/vignettes/Raster_geoms.html
