Commit 3f25c8ff authored by Gael's avatar Gael
Browse files

reorganization

parent 1553bf22
################ 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
######## 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 = "")
This diff is collapsed.
######## 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),