diff --git a/cute_little_R_functions.R b/cute_little_R_functions.R
index 2ce319c04846ce0337365f11375c899a9273c284..967bf8f32cc55c38c0d2c0e3ffb36cf343d2e0a8 100644
--- a/cute_little_R_functions.R
+++ b/cute_little_R_functions.R
@@ -1,6 +1,6 @@
################################################################
## ##
-## CUTE FUNCTIONS v6.0.0 ##
+## CUTE FUNCTIONS ##
## ##
## Gael A. Millot ##
## ##
@@ -2782,9 +2782,10 @@ fun_permut <- function(data1, data2 = NULL, n = NULL, seed = NULL, print.count =
# 1) n times (when n is precised) or
# 2) until the correlation between data1 and data2 decreases down to the cor.limit (0.2 by default). See cor.limit below to deal with negative correlations
# Example of consecutive position flipping: ABCD -> BACD -> BADC, etc.
+# designed for discrete values, but worls also for continuous values
# WARNINGS
# see # https://www.r-bloggers.com/strategies-to-speedup-r-code/ for code speedup
-# the random switch of non consecutive positions (ABCD -> DBCA for instance) does not work very well as the correaltion is quickly obtained but the initial vector structure is mainly kept (no much order). Ths code would be: pos <- ini.pos[1:2] ; pos <- sample.int(n = n , size = 2, replace = FALSE) ; tempo.pos[pos] <- tempo.pos[rev(pos)]
+# the random switch of non consecutive positions (ABCD -> DBCA for instance) does not work very well as the correlation is quickly obtained but the initial vector structure is mainly kept (no much order). Ths code would be: pos <- ini.pos[1:2] ; pos <- sample.int(n = n , size = 2, replace = FALSE) ; tempo.pos[pos] <- tempo.pos[rev(pos)]
# ARGUMENTS
# data1: a vector of at least 2 elements. Must be numeric if data2 is specified
# data2: a numeric vector of same length as data1
@@ -3183,6 +3184,7 @@ fun_slide <- function(data, window.size, step, from = NULL, to = NULL, fun, args
# parallel if parallelization is used
# REQUIRED FUNCTIONS FROM CUTE_LITTLE_R_FUNCTION
# fun_check()
+# fun_get_message
# fun_pack()
# RETURN
# a data frame containing
@@ -3194,15 +3196,17 @@ fun_slide <- function(data, window.size, step, from = NULL, to = NULL, fun, args
# fun_slide(data = c(1:10, 100:110, 500), window.size = 5, step = 2, fun = length, boundary = "left")
# fun_slide(data = c(1:10, 100:110, 500), window.size = 5, step = 2, fun = length, boundary = "right")
# DEBUGGING
-# data = c(1:10, 100:110, 500) ; window.size = 5 ; step = 2 ; from = NULL ; to = NULL ; fun = length ; args = NULL ; boundary = "left" ; lib.path = NULL ; thread.nb = NULL ; print.count = 10 ; res.path = "C:\\Users\\Gael\\Desktop\\" ; lib.path = NULL ; verbose = TRUE ; cute.path = "C:\\Users\\Gael\\Documents\\Git_projects\\cute_little_R_functions\\cute_little_R_functions.R"
-data = lag.pos; window.size = window.size; step = step; fun = length; from = min(a$pos); to = max(a$pos)
+# data = c(1:10, 100:110, 500) ; window.size = 5 ; step = 2 ; from = NULL ; to = NULL ; fun = length ; args = NULL ; boundary = "left" ; thread.nb = NULL ; print.count = 100 ; res.path = NULL ; lib.path = NULL ; verbose = TRUE ; cute.path = "C:\\Users\\Gael\\Documents\\Git_projects\\cute_little_R_functions\\cute_little_R_functions.R"
+# data = lag.pos; window.size = window.size; step = step; fun = length; from = min(a$pos); to = max(a$pos)
# function name
function.name <- paste0(as.list(match.call(expand.dots=FALSE))[[1]], "()")
instruction <- match.call()
# end function name
# required function checking
req.function <- c(
-"fun_check"
+"fun_check",
+"fun_get_message",
+"fun_pack"
)
for(i1 in req.function){
if(length(find(i1, mode = "function")) == 0){
@@ -3352,7 +3356,20 @@ tempo.log[min(which(tempo.log), na.rm = TRUE)] <- FALSE # convert the first left
wind <- wind[ ! tempo.log,]
}
# test if lapply can be used
-tempo <- fun_get_message(data="lapply(X = wind$left, Y = data, FUN = function(X, Y){res <- get(left)(Y, X) ; return(res)})")
+
+# new environment
+env.name <- paste0("env", ini.time)
+if(exists(env.name, where = -1)){
+tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": ENVIRONMENT env.name ALREADY EXISTS. PLEASE RERUN ONCE\n\n============\n\n")
+stop(tempo.cat, call. = FALSE)
+}else{
+assign(env.name, new.env())
+assign("wind", wind, envir = get(env.name))
+assign("data", data, envir = get(env.name))
+}
+# end new environment
+tempo <- fun_get_message(data="lapply(X = wind$left, Y = data, FUN = function(X, Y){res <- get(left)(Y, X) ; return(res)})", kind = "error", header = FALSE, env = get(env.name), print.no = FALSE)
+rm(env.name) # optional, because should disappear at the end of the function execution
# end test if lapply can be used
if( ! any(grepl(x = tempo, pattern = "ERROR.*"))){
left.log <- lapply(X = wind$left, Y = data, FUN = function(X, Y){
@@ -3490,7 +3507,7 @@ if(verbose == TRUE){
end.date <- Sys.time()
end.time <- as.numeric(end.date)
total.lapse <- round(lubridate::seconds_to_period(end.time - ini.time))
-cat(paste0("fun_test JOB END\n\nTIME: ", end.date, "\n\nTOTAL TIME LAPSE: ", total.lapse, "\n\n\n"))
+cat(paste0("fun_slide JOB END\n\nTIME: ", end.date, "\n\nTOTAL TIME LAPSE: ", total.lapse, "\n\n\n"))
}
return(output)
}
@@ -7612,6 +7629,7 @@ fun_get_message <- function(data, kind = "error", header = TRUE, print.no = FALS
# using argument print.no = FALSE, return NULL if no message, which is convenient in some cases
# WARNING
# Only the first message is returned
+# Always use the env argument when fun_get_message() is used inside functions
# REQUIRED FUNCTIONS FROM CUTE_LITTLE_R_FUNCTION
# fun_check()
# ARGUMENTS
@@ -7778,6 +7796,7 @@ return(output) # do not use cat() because the idea is to reuse the message
+
fun_gg_boxplot <- function(
data1,
y,
@@ -9670,8 +9689,6 @@ return(output) # this plots the graph if return.ggplot is TRUE and if no assignm
-
-
fun_gg_scatter <- function(
data1,
x,
@@ -11799,3 +11816,9 @@ return(output) # this plots the graph if return.ggplot is TRUE and if no assignm
+
+
+
+
+
+
diff --git a/cute_little_R_functions.docx b/cute_little_R_functions.docx
index ae8a83ec2f309ab544f3f3a2ad9aaf3f5cf7742b..e37d6b20d065716120021a7578fb1bd6929a4a61 100644
Binary files a/cute_little_R_functions.docx and b/cute_little_R_functions.docx differ