Commit a8ec53ad authored by Gael's avatar Gael
Browse files

fun_test() improved

parent 58d00c51
......@@ -1861,18 +1861,19 @@ cute.path = "C:\\Users\\Gael\\Documents\\Git_projects\\cute_little_R_functions\\
# REQUIRED PACKAGES
# lubridate
# parallel if thread.nb argument is not NULL (included in the R installation packages but not automatically loaded)
# if the tested function is in a package, this package must be imported first (no parallelization) or must be in the classical R package folder indicated by the lib.path argument (parallelization)
# pdftools if thread.nb argument is not NULL (included in the R installation packages but not automatically loaded)
# If the tested function is in a package, this package must be imported first (no parallelization) or must be in the classical R package folder indicated by the lib.path argument (parallelization)
# RETURN
# if export is FALSE a list containing:
# $fun: the tested function
# $instruction: the initial instruction
# $sys.info: system and packages info
# $data: a data frame of all the combination tested, containing the following columns:
# the different values tested, named by arguments
# $kind: a vector of character strings indicating the kind of test result: either "ERROR", or "WARNING", or "OK"
# $problem: a logical vector indicating if error or not
# $expected.error: optional logical vector indicating the expected error specified in the expect.error argument
# $message: either NULL if $kind is always "OK", or the messages
# $instruction: the initial instruction
# $sys.info: system and packages info
# if export is TRUE 1) the same list object into a .RData file, 2) also the $data data frame into a .txt file, and 3) if expect.error is non NULL and if any discrepancy, the $data data frame into a .txt file but containing only the rows with discrepancies between expected and observed errors
# one or several pdf if a plotting function is tested and if the plot.fun argument is TRUE
# REQUIRED PACKAGES
......@@ -2069,7 +2070,7 @@ warning(paste0("\n", tempo.cat, "\n"), call. = FALSE)
}
# end second round of checking and data preparation
# package checking
fun_pack(req.package = c("lubridate"), lib.path = lib.path)
fun_pack(req.package = c("lubridate", "pdftools"), lib.path = lib.path)
if( ! is.null(thread.nb)){
fun_pack(req.package = c("parallel"), lib.path = lib.path)
}
......@@ -2368,6 +2369,8 @@ window.nb <- dev.cur()
invisible(dev.set(window.nb))
# end plot management
# new environment
ini.date <- Sys.time()
ini.time <- as.numeric(ini.date) # time of process begin, converted into
env.name <- paste0("env", ini.time)
if(exists(env.name, where = -1)){ # verify if still ok when fun_test() is inside a function
tempo.cat <- paste0("ERROR IN ", function.name, ": ENVIRONMENT env.name ALREADY EXISTS. PLEASE RERUN ONCE")
......@@ -2377,8 +2380,6 @@ assign(env.name, new.env())
assign("val", val, envir = get(env.name, env = sys.nframe(), inherit = FALSE)) # var replaced by val
}
# end new environment
ini.date <- Sys.time()
ini.time <- as.numeric(ini.date) # time of process begin, converted into
print.count.loop <- 0
suppressMessages(suppressWarnings(eval(parse(text = code))))
colnames(data) <- arg
......@@ -2393,7 +2394,7 @@ sys.info$loadedOnly <- sys.info$loadedOnly[order(names(sys.info$loadedOnly))] #
invisible(dev.off(window.nb))
rm(env.name) # optional, because should disappear at the end of the function execution
# output
output <- list(fun = fun, data = data, instruction = instruction, sys.info = sys.info)
output <- list(fun = fun, instruction = instruction, sys.info = sys.info) # data = data finally removed from the output list, because everything combined in a RData file at the end
save(output, file = paste0(res.path, "/fun_test_", x[1], ifelse(base::length(x) == 1L, ".RData", paste0("-", x[base::length(x)], ".RData"))))
if(plot.fun == TRUE & plot.count == 0L){
warn.count <- warn.count + 1
......@@ -2401,26 +2402,90 @@ tempo.warn <- paste0("(", warn.count,") IN PROCESS ", process.id, ": NO PDF PLOT
warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
file.remove(paste0(res.path, "/plots_from_fun_test_", x[1], ifelse(base::length(x) == 1L, ".pdf", paste0("-", x[base::length(x)], ".pdf"))))
}
table.out <- as.matrix(output$data)
table.out <- as.matrix(data)
# table.out[table.out == ""] <- " " # does not work # because otherwise read.table() converts "" into NA
table.out <- gsub(table.out, pattern = "\n", replacement = " ")
write.table(table.out, file = paste0(res.path, "/table_from_fun_test_", x[1], ifelse(base::length(x) == 1L, ".txt", paste0("-", x[base::length(x)], ".txt"))), row.names = TRUE, col.names = NA, append = FALSE, quote = FALSE, sep = "\t", eol = "\n")
}
)
parallel::stopCluster(Clust)
# txt files assembly
# files assembly
if(base::length(cluster.list) > 1){
for(i2 in 1:base::length(cluster.list)){
tempo.name <- paste0(res.path, "/table_from_fun_test_", min(cluster.list[[i2]], na.rm = TRUE), ifelse(base::length(cluster.list[[i2]]) == 1L, ".txt", paste0("-", max(cluster.list[[i2]], na.rm = TRUE), ".txt")))
tempo <- read.table(file = tempo.name, header = TRUE, stringsAsFactors = FALSE, sep = "\t", row.names = 1, comment.char = "", colClasses = "character") # row.names = 1 (1st column) because now read.table() adds a NA in the header if the header starts by a tabulation, comment.char = "" because colors with #, colClasses = "character" otherwise convert "" (from NULL) into NA
file.remove(tempo.name)
tempo.file <- paste0(res.path, "/table_from_fun_test_", min(cluster.list[[i2]], na.rm = TRUE), ifelse(base::length(cluster.list[[i2]]) == 1L, ".txt", paste0("-", max(cluster.list[[i2]], na.rm = TRUE), ".txt"))) # txt file
tempo <- read.table(file = tempo.file, header = TRUE, stringsAsFactors = FALSE, sep = "\t", row.names = 1, comment.char = "", colClasses = "character") # row.names = 1 (1st column) because now read.table() adds a NA in the header if the header starts by a tabulation, comment.char = "" because colors with #, colClasses = "character" otherwise convert "" (from NULL) into NA
if(file.exists(paste0(res.path, "/plots_from_fun_test_", min(cluster.list[[i2]], na.rm = TRUE), ifelse(base::length(cluster.list[[i2]]) == 1L, ".pdf", paste0("-", max(cluster.list[[i2]], na.rm = TRUE), ".pdf"))))){
tempo.pdf <- paste0(res.path, "/plots_from_fun_test_", min(cluster.list[[i2]], na.rm = TRUE), ifelse(base::length(cluster.list[[i2]]) == 1L, ".pdf", paste0("-", max(cluster.list[[i2]], na.rm = TRUE), ".pdf"))) # pdf file
}else{
tempo.pdf <- NULL
}
tempo.rdata <- paste0(res.path, "/fun_test_", min(cluster.list[[i2]], na.rm = TRUE), ifelse(base::length(cluster.list[[i2]]) == 1L, ".RData", paste0("-", max(cluster.list[[i2]], na.rm = TRUE), ".RData"))) # RData file
if(i2 == 1L){
final.file <- tempo
final.pdf <- tempo.pdf
# new env for RData combining
env.name <- paste0("env", ini.time)
if(exists(env.name, where = -1)){ # verify if still ok when fun_test() is inside a function
tempo.cat <- paste0("ERROR IN ", function.name, ": ENVIRONMENT env.name ALREADY EXISTS. PLEASE RERUN ONCE")
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 new env for RData combining
}else{
final.file <- rbind(final.file, tempo, stringsAsFactors = TRUE)
assign(env.name, new.env())
load(tempo.rdata, envir = get(env.name))
tempo.rdata1 <- tempo.rdata
assign("final.output", get("output", envir = get(env.name)), envir = get(env.name))
}
}else{
final.file <- rbind(final.file, tempo, stringsAsFactors = TRUE)
final.pdf <- c(final.pdf, tempo.pdf)
load(tempo.rdata, envir = get(env.name))
if( ! identical(get("final.output", envir = get(env.name))[c("R.version", "locale", "platform")], get("output", envir = get(env.name))[c("R.version", "locale", "platform")])){
tempo.cat <- paste0("ERROR IN ", function.name, ": DIFFERENCE BETWEEN OUTPUTS WHILE THEY SHOULD BE IDENTICAL\nPLEASE CHECK\n", tempo.rdata1, "\n", tempo.rdata)
stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
}else{
# add the differences in RData $sysinfo into final.output
tempo.base1 <- sort(get("final.output", envir = get(env.name))$sys.info$basePkgs)
tempo.base2 <- sort(get("output", envir = get(env.name))$sys.info$basePkgs)
tempo.other1 <- names(get("final.output", envir = get(env.name))$sys.info$otherPkgs)
tempo.other2 <- names(get("output", envir = get(env.name))$sys.info$otherPkgs)
tempo.loaded1 <- names(get("final.output", envir = get(env.name))$sys.info$loadedOnly)
tempo.loaded2 <- names(get("output", envir = get(env.name))$sys.info$loadedOnly)
assign("final.output", {
x <- get("final.output", envir = get(env.name))
y <- get("output", envir = get(env.name))
x$sys.info$basePkgs <- sort(unique(tempo.base1, tempo.base2))
if( ! all(tempo.other2 %in% tempo.other1)){
x$sys.info$otherPkgs <- c(x$sys.info$otherPkgs, y$sys.info$otherPkgs[ ! (tempo.other2 %in% tempo.other1)])
x$sys.info$otherPkgs <- x$sys.info$otherPkgs[order(names(x$sys.info$otherPkgs))]
}
if( ! all(tempo.loaded2 %in% tempo.loaded1)){
x$sys.info$loadedOnly <- c(x$sys.info$loadedOnly, y$sys.info$loadedOnly[ ! (tempo.loaded2 %in% tempo.loaded1)])
x$sys.info$loadedOnly <- x$sys.info$loadedOnly[order(names(x$sys.info$loadedOnly))]
}
x
}, envir = get(env.name))
# add the differences in RData $sysinfo into final.output
}
}
file.remove(c(tempo.file, tempo.rdata))
}
# combine pdf and save
if( ! is.null(final.pdf)){
pdftools::pdf_combine(
input = final.pdf,
output = paste0(res.path, "/plots_from_fun_test_1-", total.comp.nb, ".pdf")
)
file.remove(final.pdf)
}
# end combine pdf and save
# save RData
assign("output", c(get("final.output", envir = get(env.name)), data = list(final.file)), envir = get(env.name))
save(output, file = paste0(res.path, "/fun_test__1-", total.comp.nb, ".RData"), envir = get(env.name))
rm(env.name) # optional, because should disappear at the end of the function execution
# end save RData
# save txt
write.table(final.file, file = paste0(res.path, "/table_from_fun_test_1-", total.comp.nb, ".txt"), row.names = TRUE, col.names = NA, append = FALSE, quote = FALSE, sep = "\t", eol = "\n")
# end save txt
if( ! is.null(expect.error)){
final.file <- final.file[ ! final.file$problem == final.file$expected.error, ]
if(nrow(final.file) == 0L){
......@@ -2431,7 +2496,7 @@ write.table(final.file, file = paste0(res.path, "/discrepancy_table_from_fun_tes
}
}
}
# end txt files assembly
# end files assembly
}else{
# plot management
if(plot.fun == TRUE){
......@@ -2466,7 +2531,7 @@ sys.info$loadedOnly <- sys.info$loadedOnly[order(names(sys.info$loadedOnly))] #
invisible(dev.off(window.nb))
rm(env.name) # optional, because should disappear at the end of the function execution
# output
output <- list(fun = fun, data = data, instruction = instruction, sys.info = sys.info)
output <- list(fun = fun, instruction = instruction, sys.info = sys.info, data = data)
if(plot.fun == TRUE & plot.count == 0L){
warn.count <- warn.count + 1
tempo.warn <- paste0("(", warn.count,") NO PDF PLOT BECAUSE ONLY ERRORS REPORTED")
......
No preview for this file type
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment