reorganization

check/check_dataset.R

+################ CREATION OF THE CHECKING DATASET
+
+
+######## object list t25_20201108 (25 objects created 20201108)
+
+
+vec1 <- -1:3 # vector of integers
+vec2 <- 1:3 / 3 # vector of proportions
+vec3 <- c(1, 2, NA, -Inf) # vector of integers but stored as "double", with NA and Inf
+vec4 <- "pearson" # vector of characters
+vec5 <- c("a", "b","a", NA) # vector of characters with NA
+cpx1 <- as.complex(1) # complex
+mat1 <- matrix(vec1) # 1D matrix of integers
+mat2 <- matrix(c(1:5, NA), ncol = 2, dimnames = list(c("ROW1", "ROW2", "ROW3"), c("M1", "M2"))) # 2D matrix of floats with NA
+df1 <- as.data.frame(mat2) # data.frame
+l1 <- list(L1 = 1:3, L2 = letters[1:3]) # list
+fac1 <- factor(rep(letters[4:6], c(4:6))) # factor
+tab1 <- table(fac1) # 1D table
+tab2 <- table(fac1, fac1) # 2D table
+exp1 <- expression("a") # object of class "expression", mode "expression" & type "expression"
+name1 <- substitute(exp1) # object of class "name", mode "name" & type "symbol"
+fun1 <- mean # closure function of class "function", mode "function" & type "closure"
+fun2 <- sum # primitive function of class "function", mode "function" & type "builtin"
+fun3 <- get("<-") # primitive function of class "function", mode "function" &  type "special"
+env1 <- new.env() # environment
+s4.1 <- show # S4 object
+call1 <- call("call1") # object of class "call", mode "call" &  type "language"
+
+t25_20201108 <- list( # test list
+    NULL, 
+    NA, 
+    1, 
+    TRUE, 
+    vec1, 
+    vec2, 
+    vec3, 
+    vec4, 
+    vec5, 
+    cpx1, 
+    mat1, 
+    mat2, 
+    df1, 
+    l1, 
+    fac1, 
+    tab1, 
+    tab2, 
+    exp1, 
+    name1, 
+    fun1, 
+    fun2, 
+    fun3, 
+    env1, 
+    s4.1, 
+    call1
+)
+
+
+save(list = c(
+    "vec1", 
+    "vec2", 
+    "vec3", 
+    "vec4", 
+    "vec5", 
+    "cpx1", 
+    "mat1", 
+    "mat2", 
+    "df1", 
+    "l1", 
+    "fac1", 
+    "tab1", 
+    "tab2", 
+    "exp1", 
+    "name1", 
+    "fun1", 
+    "fun2", 
+    "fun3", 
+    "env1", 
+    "s4.1", 
+    "call1",
+    "t25_20201108"
+), file = "C:/Users/gael/Documents/Git_projects/cute_little_R_functions/check/check_dataset.t25_20201108.RData")
+
+
+######## object list t26_20201124 (26 objects created 20201124)
+
+
+vec1 <- -1:3 # vector of integers
+vec2 <- 1:3 / 3 # vector of proportions
+vec3 <- c(1, 2, NA, -Inf) # vector of integers but stored as "double", with NA and Inf
+vec4 <- "pearson" # vector of characters
+vec5 <- c("a", "b","a", NA) # vector of characters with NA
+cpx1 <- as.complex(1) # complex
+mat1 <- matrix(vec1) # 1D matrix of integers
+mat2 <- matrix(c(1:5, NA), ncol = 2, dimnames = list(c("ROW1", "ROW2", "ROW3"), c("M1", "M2"))) # 2D matrix of floats with NA
+df1 <- as.data.frame(mat2) # data.frame
+df2 <- data.frame(df1, CAT = letters[1:nrow(df1)]) # data.frame
+l1 <- list(L1 = 1:3, L2 = letters[1:3]) # list
+fac1 <- factor(rep(letters[4:6], c(4:6))) # factor
+tab1 <- table(fac1) # 1D table
+tab2 <- table(fac1, fac1) # 2D table
+exp1 <- expression("a") # object of class "expression", mode "expression" & type "expression"
+name1 <- substitute(exp1) # object of class "name", mode "name" & type "symbol"
+fun1 <- mean # closure function of class "function", mode "function" & type "closure"
+fun2 <- sum # primitive function of class "function", mode "function" & type "builtin"
+fun3 <- get("<-") # primitive function of class "function", mode "function" &  type "special"
+env1 <- new.env() # environment
+s4.1 <- show # S4 object
+call1 <- call("call1") # object of class "call", mode "call" &  type "language"
+
+t26_20201124 <- list( # test list
+    NULL, 
+    NA, 
+    1, 
+    TRUE, 
+    vec1, 
+    vec2, 
+    vec3, 
+    vec4, 
+    vec5, 
+    cpx1, 
+    mat1, 
+    mat2, 
+    df1, 
+    df2, 
+    l1, 
+    fac1, 
+    tab1, 
+    tab2, 
+    exp1, 
+    name1, 
+    fun1, 
+    fun2, 
+    fun3, 
+    env1, 
+    s4.1, 
+    call1
+)
+
+
+save(list = c(
+    "vec1", 
+    "vec2", 
+    "vec3", 
+    "vec4", 
+    "vec5", 
+    "cpx1", 
+    "mat1", 
+    "mat2", 
+    "df1", 
+    "df2", 
+    "l1", 
+    "fac1", 
+    "tab1", 
+    "tab2", 
+    "exp1", 
+    "name1", 
+    "fun1", 
+    "fun2", 
+    "fun3", 
+    "env1", 
+    "s4.1", 
+    "call1",
+    "t26_20201124"
+), file = "C:/Users/gael/Documents/Git_projects/cute_little_R_functions/check/check_dataset.t26_20201124.RData")
+
+
+######## object list t8_20201126 (8 objects created 20201126)
+
+
+cor1 <- list(-1, 0, 1) # vector of integers
+prop1 <- list(0, 0.5, 1) # vector of proportions
+int1 <- list(0, 2, 4) # vector of positive integers
+int2 <- list(0, 10, 20) # vector of positive integers
+angle1 <- list(-90, 0, 45, 90, 180) # vector of positive integers
+log1 <- list("no", "log2", "log10") # vector of characters
+logic1 <- list(TRUE, FALSE) # vector of logic
+path1 <- list("C:\\Program Files\\R\\R-4.0.2\\library\\")
+
+t8_20201126 <- list( # test list
+    cor1, 
+    prop1, 
+    int1, 
+    int2, 
+    angle1, 
+    log1, 
+    logic1, 
+    path1
+)
+
+
+save(list = c(
+    "cor1", 
+    "prop1", 
+    "int1", 
+    "int2", 
+    "angle1", 
+    "log1", 
+    "logic1", 
+    "path1", 
+    "t8_20201126"
+), file = "C:/Users/gael/Documents/Git_projects/cute_little_R_functions/check/check_dataset.t8_20201126.RData")
+
+
+################ END CREATION OF THE CHECKING DATASET

check/check_fun_check.R

+######## fun_check() #### check class, type, length, etc., of objects
+
+
+# 20201216 checking each argument separately, with default values for the others
+
+load("C:/Users/gael/Documents/Git_projects/cute_little_R_functions/other/check_dataset.t26_20201124.RData") # recover the test list tl file
+source("https://gitlab.pasteur.fr/gmillot/cute_little_R_functions/-/raw/7ceacbc07ba1cc65b3dd8db53ef0d8db2a2823d7/cute_little_R_functions.R")
+
+# performed with check_dataset.RData commited 20201107 (25 different objects)
+# in green the values that are not the default values
+path <- "C:\\Users\\Gael\\Desktop\\fun_check_test1\\"
+for(i0 in 1:14){
+    Sys.sleep(1)
+    cat("\n\nLOOP ", i0, " / 14\n\n")
+    res <- fun_test(
+        fun = "fun_check", 
+        arg = c(
+            L1 = "data", 
+            L2 = "class", 
+            L3 = "typeof", 
+            L4 = "mode", 
+            L5 = "length", 
+            L6 = "prop", 
+            L7 = "double.as.integer.allowed", 
+            L8 = "options", 
+            L9 = "all.options.in.data", 
+            L10 = "na.contain", 
+            L11 = "neg.values", 
+            L12 = "print", 
+            L13 = "data.name", 
+            L14 = "fun.name"
+        ), 
+        val = list(
+            L1 = if(i0 == 1){t26_20201124}else{"a"}, 
+            L2 = if(i0 == 2){t26_20201124}else{"vector"}, 
+            L3 = if(i0 == 3){t26_20201124}else{list(NULL)}, 
+            L4 = if(i0 == 4){t26_20201124}else{list(NULL)}, 
+            L5 = if(i0 == 5){t26_20201124}else{list(NULL)}, 
+            L6 = if(i0 == 6){t26_20201124}else{FALSE}, 
+            L7 = if(i0 == 7){t26_20201124}else{FALSE}, 
+            L8 = if(i0 == 8){t26_20201124}else{list(NULL)}, 
+            L9 = if(i0 == 9){t26_20201124}else{FALSE}, 
+            L10 = if(i0 == 10){t26_20201124}else{FALSE}, 
+            L11 = if(i0 == 11){t26_20201124}else{TRUE}, 
+            L12 = if(i0 == 12){t26_20201124}else{FALSE}, 
+            L13 = if(i0 == 13){t26_20201124}else{"test.function"}, 
+            L14 = if(i0 == 14){t26_20201124}else{list(NULL)}
+        ),
+        thread.nb = NULL, 
+        plot.fun = FALSE, 
+        export = TRUE, 
+        res.path = path
+    )
+}
+file.list <- list.files(path, full.names = TRUE)
+tempo.df <- NULL
+for(i0 in 1:length(file.list)){
+    tempo.df <- rbind(tempo.df, cbind(loop = paste0("loop_", i0), read.table(list.files(file.list[i0], , full.names = TRUE)[grepl(x = list.files(file.list[i0]), pattern = "^table_from_fun_test.*")], header = TRUE, sep = "\t", comment.char="")))
+}
+write.table(tempo.df, file = paste0(path, "/final_table_from_fun_test.txt"), row.names = FALSE, col.names = TRUE, append = FALSE, quote = FALSE, sep = "\t", eol = "\n", na = "")
+
+
+# 20201216 checking all the possible values of each argument, with default values for the others
+
+load("C:/Users/gael/Documents/Git_projects/cute_little_R_functions/other/check_dataset.t26_20201124.RData") # recover the test list tl file
+load("C:/Users/gael/Documents/Git_projects/cute_little_R_functions/other/check_dataset.t8_20201126.RData") # recover the test list tl file
+source("https://gitlab.pasteur.fr/gmillot/cute_little_R_functions/-/raw/7ceacbc07ba1cc65b3dd8db53ef0d8db2a2823d7/cute_little_R_functions.R")
+
+# performed with check_dataset.RData commited 20201107 (25 different objects)
+# in green the values that are not the default values
+path <- "C:\\Users\\Gael\\Desktop\\fun_check_test2\\"
+for(i0 in 1:14){
+    Sys.sleep(1)
+    cat("\n\nLOOP ", i0, " / 14\n\n")
+    res <- fun_test(
+        fun = "fun_check", 
+        arg = c(
+            L1 = "data", 
+            L2 = "class", 
+            L3 = "typeof", 
+            L4 = "mode", 
+            L5 = "length", 
+            L6 = "prop", 
+            L7 = "double.as.integer.allowed", 
+            L8 = "options", 
+            L9 = "all.options.in.data", 
+            L10 = "na.contain", 
+            L11 = "neg.values", 
+            L12 = "print", 
+            L13 = "data.name", 
+            L14 = "fun.name"
+        ), 
+        val = list(
+            L1 = if(i0 == 1){t26_20201124}else{"a"}, 
+            L2 = if(i0 == 2){list(NULL, "vector", "logical", "integer", "numeric", "complex", "character", "matrix", "array", "data.frame", "list", "factor", "table", "expression", "name", "symbol", "function", "uneval", "environment", "ggplot2", "ggplot_built", "call")}else if(i0 == 8){list(NULL)}else{"vector"}, 
+            L3 = if(i0 == 3){list(NULL, "logical", "integer", "double", "complex", "character", "list", "expression", "symbol", "closure", "special", "builtin", "environment", "S4", "language")}else{list(NULL)}, 
+            L4 = if(i0 == 4){list(NULL, "logical", "numeric", "complex", "character", "list", "expression", "name", "symbol", "function", "environment", "S4", "call")}else{list(NULL)}, 
+            L5 = if(i0 == 5){list(NULL, 0, 2, 4)}else{list(NULL)}, 
+            L6 = if(i0 == 6){logic1}else{FALSE}, 
+            L7 = if(i0 == 7){logic1}else{FALSE}, 
+            L8 = if(i0 == 8){list(NULL, "a")}else{list(NULL)}, 
+            L9 = if(i0 == 9){logic1}else{FALSE}, 
+            L10 = if(i0 == 10){logic1}else{FALSE}, 
+            L11 = if(i0 == 11){logic1}else{TRUE}, 
+            L12 = if(i0 == 12){logic1}else{TRUE}, 
+            L13 = if(i0 == 13){list(NULL, "test.function")}else{list(NULL)}, 
+            L14 = if(i0 == 14){list(NULL, "FUN_NAME")}else{list(NULL)}
+        ),
+        thread.nb = NULL, 
+        plot.fun = FALSE, 
+        export = TRUE, 
+        res.path = path
+    )
+}
+file.list <- list.files(path, full.names = TRUE)
+tempo.df <- NULL
+for(i0 in 1:length(file.list)){
+    tempo.df <- rbind(tempo.df, cbind(loop = paste0("loop_", i0), read.table(list.files(file.list[i0], , full.names = TRUE)[grepl(x = list.files(file.list[i0]), pattern = "^table_from_fun_test.*")], header = TRUE, sep = "\t", comment.char="")))
+}
+write.table(tempo.df, file = paste0(path, "/final_table_from_fun_test.txt"), row.names = FALSE, col.names = TRUE, append = FALSE, quote = FALSE, sep = "\t", eol = "\n", na = "")
+
+

check/check_fun_gg_scatter.R

+######## fun_gg_scatter() #### ggplot2 scatterplot + lines (up to 6 overlays totally)
+
+
+# TESTS
+# 1 tests checking the all the arguments, using a single value
+
+# b <- list(NULL)
+# b <- list("a")
+# b <- list(NA)
+a <- fun_test(
+    fun = "fun_gg_scatter", 
+    arg = c(
+        L1 = "data1", 
+        L2 = "x", 
+        L3 = "y", 
+        L4 = "categ", 
+        L5 = "legend.name", 
+        L6 = "color", 
+        L7 = "geom", 
+        L8 = "alpha", 
+        L9 = "dot.size", 
+        L10 = "line.size", 
+        L11 = "x.lim", 
+        L12 = "x.lab", 
+        L13 = "x.log", 
+        L14 = "x.tick.nb", 
+        L15 = "x.inter.tick.nb", 
+        L16 = "x.include.zero", 
+        L17 = "x.left.extra.margin", 
+        L18 = "x.right.extra.margin", 
+        L19 = "x.text.angle", 
+        L20 = "y.lim", 
+        L21 = "y.lab", 
+        L22 = "y.log", 
+        L23 = "y.tick.nb", 
+        L24 = "y.inter.tick.nb", 
+        L25 = "y.include.zero", 
+        L26 = "y.top.extra.margin", 
+        L27 = "y.bottom.extra.margin", 
+        L28 = "y.text.angle", 
+        L29 = "text.size", 
+        L30 = "title", 
+        L31 = "title.text.size", 
+        L32 = "legend.show", 
+        L33 = "article", 
+        L34 = "grid", 
+        L35 = "raster", 
+        L36 = "raster.threshold", 
+        L37 = "return", 
+        L38 = "plot", 
+        L39 = "add", 
+        L40 = "warn.print", 
+        L41 = "lib.path"
+    ), 
+    val = list(
+        L1 = b, 
+        L2 = b, 
+        L3 = b, 
+        L4 = b, 
+        L5 = b, 
+        L6 = b, 
+        L7 = b, 
+        L8 = b, 
+        L9 = b, 
+        L10 = b, 
+        L11 = b, 
+        L12 = b, 
+        L13 = b, 
+        L14 = b, 
+        L15 = b, 
+        L16 = b, 
+        L17 = b, 
+        L18 = b, 
+        L19 = b, 
+        L20 = b, 
+        L21 = b, 
+        L22 = b, 
+        L23 = b, 
+        L24 = b, 
+        L25 = b, 
+        L26 = b, 
+        L27 = b, 
+        L28 = b, 
+        L29 = b, 
+        L30 = b, 
+        L31 = b, 
+        L32 = b, 
+        L33 = b, 
+        L34 = b, 
+        L35 = b, 
+        L36 = b, 
+        L37 = b, 
+        L38 = b, 
+        L39 = b, 
+        L40 = b, 
+        L41 = b
+    ),
+    thread.nb = NULL, 
+    plot.fun = TRUE, 
+    export = TRUE, 
+    res.path = "C:\\Users\\Gael\\Desktop\\"
+)
+
+# 576 tests checking the critical arguments
+
+set.seed(1) ; obs1 <- data.frame(km = rnorm(10, 10, 3), time = rnorm(10, 10, 3), Group1 = rep(c("A1", "A2"), 5)) ; obs1$km[2:3] <- NA
+obs2 <-data.frame(km = rnorm(10, 15, 3), time = rnorm(10, 15, 3), Group2 = rep(c("G1", "G2"), 5)) ; set.seed(NULL)
+a <- fun_test(
+    fun = "fun_gg_scatter", 
+    arg = c(
+        L1 = "data1", 
+        L2 = "x", 
+        L3 = "y", 
+        L4 = "categ", 
+        L5 = "legend.name", 
+        L6 = "color", 
+        L7 = "geom", 
+        L8 = "alpha"
+    ), 
+    val = list(
+        L1 = list(L1.1 = list(L1 = obs1, L2 = obs2), L1.2 = list(obs1), L1.3 = list("a")), 
+        L2 = list(L2.1 = list("km", "km"), L2.2 = list("km")), 
+        L3 = list(L3.1 = list("time", "time"), L3.2 = list("time")), 
+        L4 = list(L4.1 = list("Group1", "Group2"), L4.2 = list("Group1")), 
+        L5 = list(L5.1 = list(NULL, NULL), L5.2 = list(NULL)),
+        L6 = list(L6.1 = list("green", "blue"), L6.2 = list(1:2), L6.3 = list(1:2, 3:4)), 
+        L7 = list(L7.1 = list("geom_point", "geom_point"), L7.2 = list("geom_point")), 
+        L8 = list(L8.1 = list(1, 0.1), L7.2 = list(0.1))
+    ),
+    thread.nb = 7, 
+    plot.fun = TRUE, 
+    export = TRUE, 
+    res.path = "C:\\Users\\Gael\\Desktop\\"
+)
+
+# 1 test checking the data frame aspects
+
+set.seed(1) ; obs1 <- data.frame(km = rnorm(10, 10, 3), time = rnorm(10, 10, 3), Group1 = rep(c("A1", "A2"), 5)) ; obs1$km[2:3] <- NA
+obs2 <-data.frame(km = rnorm(10, 15, 3), time = rnorm(10, 15, 3), Group2 = rep(c("G1", "G2"), 5)) ; set.seed(NULL)
+a <- fun_test(
+    fun = "fun_gg_scatter", 
+    arg = c(
+        L1 = "data1", 
+        L2 = "x", 
+        L3 = "y", 
+        L4 = "categ", 
+        L5 = "legend.name", 
+        L6 = "color", 
+        L7 = "geom", 
+        L8 = "alpha"
+    ), 
+    val = list(
+        L1 = list(L1.1 = obs1), 
+        L2 = list(L2.1 = "km"), 
+        L3 = list(L3.1 = "time"), 
+        L4 = list(L4.1 = "Group1"), 
+        L5 = list(L5.1 = NULL, "LEGEND"),
+        L6 = list(L6.1 = c("green", "blue"), L6.2 = c("green")), 
+        L7 = list(L7.1 = "geom_point", L7.2 = "geom_line" , L7.3 = "geom_path"), 
+        L8 = list(L8.1 = 0.25, L8.2 = 0.5, L8.3 = 1)
+    ),
+    thread.nb = NULL, 
+    plot.fun = TRUE, 
+    export = TRUE, 
+    res.path = "C:\\Users\\Gael\\Desktop\\"
+)
+
+# 1 tests checking the list aspects
+
+set.seed(1) ; obs1 <- data.frame(km = rnorm(10, 10, 3), time = rnorm(10, 10, 3), Group1 = rep(c("A1", "A2"), 5)) ; obs1$km[2:3] <- NA
+obs2 <-data.frame(km = rnorm(10, 15, 3), time = rnorm(10, 15, 3), Group2 = rep(c("G1", "G2"), 5)) ; set.seed(NULL)
+a <- fun_test(
+    fun = "fun_gg_scatter", 
+    arg = c(
+        L1 = "data1", 
+        L2 = "x", 
+        L3 = "y", 
+        L4 = "categ", 
+        L5 = "legend.name", 
+        L6 = "color", 
+        L7 = "geom", 
+        L8 = "alpha"
+    ), 
+    val = list(
+        L1 = list(L1.1 = list(L1 = obs1, L2 = obs2)), 
+        L2 = list(L2.1 = list("km", "km")), 
+        L3 = list(L3.1 = list("time", "time")), 
+        L4 = list(L4.1 = list("Group1", "Group2")), 
+        L5 = list(L5.1 = list("LEG1", "LEG2")),
+        L6 = list(L6.1 = list(1:2, 3:4)), 
+        L7 = list(L7.1 = list("geom_point", "geom_point")), 
+        L8 = list(L8.1 = list(1, 0.5))
+    ),
+    thread.nb = NULL, 
+    plot.fun = TRUE, 
+    export = TRUE, 
+    res.path = "C:\\Users\\Gael\\Desktop\\"
+)
+
+# 16384 tests checking the data frame aspects
+
+set.seed(1) ; obs1 <- data.frame(km = rnorm(10, 10, 3), time = rnorm(10, 10, 3), Group1 = rep(c("A1", "A2"), 5)) ; obs1$km[2:3] <- NA
+obs2 <-data.frame(km = rnorm(10, 15, 3), time = rnorm(10, 15, 3), Group2 = rep(c("G1", "G2"), 5)) ; set.seed(NULL)
+a <- fun_test(
+    fun = "fun_gg_scatter", 
+    arg = c(
+        L1 = "data1", 
+        L2 = "x", 
+        L3 = "y", 
+        L4 = "categ", 
+        L5 = "legend.name", 
+        L6 = "color", 
+        L7 = "geom", 
+        L8 = "alpha",
+        L9 = "dot.size", 
+        L10 = "line.size", 
+        L11 = "x.lim", 
+        L12 = "x.lab", 
+        L13 = "x.log", 
+        L14 = "x.tick.nb", 
+        L15 = "x.inter.tick.nb", 
+        L16 = "x.include.zero", 
+        L17 = "x.left.extra.margin", 
+        L18 = "x.right.extra.margin", 
+        L19 = "x.text.angle"
+    ), 
+    val = list(
+        L1 = list(L1.1 = obs1), 
+        L2 = list(L2.1 = "km"), 
+        L3 = list(L3.1 = "time"), 
+        L4 = list(L4.1 = "Group1"), 
+        L5 = list(L5.1 = NULL, "LEGEND"),
+        L6 = list(L6.1 = c("green", "blue"), L6.2 = 1), 
+        L7 = list(L7.1 = "geom_point"), 
+        L8 = list(L8.1 = 0.25, L8.2 = 1), 
+        L9 = list(L9.1 = 2, L9.2 = 0), 
+        L10 = list(L10.1 = 2, L10.2 = 0), 
+        L11 = list(L11.1 = NULL, L11.2 = c(1, 20)), 
+        L12 = list(L12.1 = NULL, L12.2 = "XLAB"), 
+        L13 = list(L13.1 = "no", L13.2 = "log10"),