cute_little_R_functions.R 639 KB
Newer Older
Gael  MILLOT's avatar
Gael MILLOT committed
8001
8002
8003
8004
8005
8006
8007
8008
8009
8010
8011
if(any(data2.unknown.dot$DOT_NB %in% data2.incon.dot$DOT_NB)){
tempo.cat <- (paste0("\n\n============\n\nERROR IN ", function.name, ": CODE INCONSISTENCY 24\n\n============\n\n"))
stop(tempo.cat)
}
if(any(data2.incon.dot$DOT_NB %in% data2.unknown.dot$DOT_NB)){
tempo.cat <- (paste0("\n\n============\n\nERROR IN ", function.name, ": CODE INCONSISTENCY 25\n\n============\n\n"))
stop(tempo.cat)
}
}
# end verif
# plot
Gael  MILLOT's avatar
Gael MILLOT committed
8012
# recovering the axes data whatever plot or not
Gael  MILLOT's avatar
Gael MILLOT committed
8013
8014
8015
8016
8017
if(is.null(data2)){
axes <- fun_gg_scatter(data1 = list(data1), x = list(x1), y = list(y1), categ = list(NULL), color = list(fun_gg_palette(2)[2]), geom = list("geom_point"), alpha = list(0.5), xlim = x.range.plot, ylim = y.range.plot, raster = raster, plot = FALSE, return = TRUE)$axes
}else{
axes <- fun_gg_scatter(data1 = list(data1, data2), x = list(x1, x2), y = list(y1, y2), categ = list(NULL, NULL), color = list(fun_gg_palette(2)[2], fun_gg_palette(2)[1]), geom = list("geom_point", "geom_point"), alpha = list(0.5, 0.5), xlim = x.range.plot, ylim = y.range.plot, raster = raster, plot = FALSE, return = TRUE)$axes
}
Gael  MILLOT's avatar
Gael MILLOT committed
8018
# end recovering the axes data whatever plot or not
Gael  MILLOT's avatar
Gael MILLOT committed
8019
if(plot == TRUE){
Gael  MILLOT's avatar
Gael MILLOT committed
8020
8021
8022
8023
8024
8025
8026
8027
8028
# add a categ for plot legend
tempo.df.name <- c("data1", "data1.signif.dot", "data1.incon.dot", "data2", "data2.signif.dot", "data2.unknown.dot", "data2.incon.dot")
tempo.class.name <- c("data1", "data1", "data1", "data2", "data2", "data2", "data2")
for(i2 in 1:length(tempo.df.name)){
if( ! is.null(get(tempo.df.name[i2]))){
assign(tempo.df.name[i2], data.frame(get(tempo.df.name[i2]), kind = tempo.class.name[i2]))
}
}
# end add a categ for plot legend
Gael  MILLOT's avatar
Gael MILLOT committed
8029
if(( ! is.null(x.range.split)) & ( ! is.null(y.range.split))){
Gael  MILLOT's avatar
Gael MILLOT committed
8030
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8031
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8032
}
Gael  MILLOT's avatar
Gael MILLOT committed
8033
tempo.graph <- fun_gg_scatter(data1 = list(data1, hframe, vframe), x = list(x1, "x", "x"), y = list(y1, "y", "y"), categ = list("kind", "kind", "kind"), legend.name = list("DATASET", "HORIZ FRAME" , "VERT FRAME"), color = list(fun_gg_palette(2)[2], rep(hsv(h = c(0.1, 0.15), v = c(0.75, 1)), 2), rep(hsv(h = c(0.5, 0.6), v = c(0.9, 1)), 2)), geom = list("geom_point", "geom_path", "geom_path"), alpha = list(0.5, 0.5, 0.5), title = "DATA1", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8034
8035
8036
8037
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
if( ! is.null(data1.signif.dot)){
Gael  MILLOT's avatar
Gael MILLOT committed
8038
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8039
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8040
}
Gael  MILLOT's avatar
Gael MILLOT committed
8041
tempo.graph <- fun_gg_scatter(data1 = list(data1, hframe, vframe, data1.signif.dot), x = list(x1, "x", "x", x1), y = list(y1, "y", "y", y1), categ = list("kind", "kind", "kind", "kind"), legend.name = list("DATASET", "HORIZ FRAME" , "VERT FRAME", "SIGNIF DOTS"), color = list(fun_gg_palette(2)[2], rep(hsv(h = c(0.1, 0.15), v = c(0.75, 1)), 2), rep(hsv(h = c(0.5, 0.6), v = c(0.9, 1)), 2), "black"), geom = list("geom_point", "geom_path", "geom_path", "geom_point"), alpha = list(0.5, 0.5, 0.5, 0.5), title = "DATA1 + DATA1 SIGNIFICANT DOTS", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8042
8043
8044
8045
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
8046
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8047
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8048
8049
8050
8051
8052
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA1 DOTS OUTSIDE THE FRAMES", text.size = 12, title = "DATA1 + DATA1 SIGNIFICANT DOTS")
}
if( ! is.null(data1.incon.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8053
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8054
}
Gael  MILLOT's avatar
Gael MILLOT committed
8055
tempo.graph <- fun_gg_scatter(data1 = list(data1, hframe, vframe, data1.incon.dot), x = list(x1, "x", "x", x1), y = list(y1, "y", "y", y1), categ = list("kind", "kind", "kind", "kind"), legend.name = list("DATASET", "HORIZ FRAME" , "VERT FRAME", "INCONSISTENT DOTS"), color = list(fun_gg_palette(2)[2], rep(hsv(h = c(0.1, 0.15), v = c(0.75, 1)), 2), rep(hsv(h = c(0.5, 0.6), v = c(0.9, 1)), 2), fun_gg_palette(7)[6]), geom = list("geom_point", "geom_path", "geom_path", "geom_point"), alpha = list(0.5, 0.5, 0.5, 0.5), title = "DATA1 + DATA1 INCONSISTENT DOTS", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8056
8057
8058
8059
8060
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8061
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8062
8063
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA1 INCONSISTENT DOTS", text.size = 12, title = "DATA1 + DATA1 INCONSISTENT DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8064
8065
}
if( ! is.null(data2)){
Gael  MILLOT's avatar
Gael MILLOT committed
8066
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8067
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8068
}
Gael  MILLOT's avatar
Gael MILLOT committed
8069
tempo.graph <- fun_gg_scatter(data1 = list(data1, data2, hframe , vframe), x = list(x1, x2, "x", "x"), y = list(y1, y2, "y", "y"), categ = list("kind", "kind", "kind", "kind"), legend.name = list("DATASET", "DATASET", "HORIZ FRAME" , "VERT FRAME"), color = list(fun_gg_palette(2)[2], fun_gg_palette(2)[1], rep(hsv(h = c(0.1, 0.15), v = c(0.75, 1)), 2), rep(hsv(h = c(0.5, 0.6), v = c(0.9, 1)), 2)), geom = list("geom_point", "geom_point", "geom_path", "geom_path"), alpha = list(0.5, 0.5, 0.5, 0.5), title = "DATA1 + DATA2", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8070
8071
8072
8073
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
if( ! is.null(data2.signif.dot)){
Gael  MILLOT's avatar
Gael MILLOT committed
8074
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8075
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8076
}
Gael  MILLOT's avatar
Gael MILLOT committed
8077
tempo.graph <- fun_gg_scatter(data1 = list(data1, data2, data2.signif.dot, hframe , vframe), x = list(x1, x2, x2, "x", "x"), y = list(y1, y2, y2, "y", "y"), categ = list("kind", "kind", "kind", "kind", "kind"), legend.name = list("DATASET", "DATASET", "SIGNIF DOTS", "HORIZ FRAME" , "VERT FRAME"), color = list(fun_gg_palette(2)[2], fun_gg_palette(2)[1], "black", rep(hsv(h = c(0.1, 0.15), v = c(0.75, 1)), 2), rep(hsv(h = c(0.5, 0.6), v = c(0.9, 1)), 2)), geom = list("geom_point", "geom_point", "geom_point", "geom_path", "geom_path"), alpha = list(0.5, 0.5, 0.5, 0.5, 0.5), title = "DATA1 + DATA2 + DATA2 SIGNIFICANT DOTS", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8078
8079
8080
8081
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
8082
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8083
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8084
8085
8086
8087
8088
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA2 DOTS OUTSIDE THE FRAMES", text.size = 12, title = "DATA1 + DATA2 + DATA2 SIGNIFICANT DOTS")
}
if( ! is.null(data2.incon.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8089
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8090
}
Gael  MILLOT's avatar
Gael MILLOT committed
8091
tempo.graph <- fun_gg_scatter(data1 = list(data1, data2, data2.incon.dot, hframe , vframe), x = list(x1, x2, x2, "x", "x"), y = list(y1, y2, y2, "y", "y"), categ = list("kind", "kind", "kind", "kind", "kind"), legend.name = list("DATASET", "DATASET", "INCONSISTENT DOTS", "HORIZ FRAME" , "VERT FRAME"), color = list(fun_gg_palette(2)[2], fun_gg_palette(2)[1], fun_gg_palette(7)[6], rep(hsv(h = c(0.1, 0.15), v = c(0.75, 1)), 2), rep(hsv(h = c(0.5, 0.6), v = c(0.9, 1)), 2)), geom = list("geom_point", "geom_point", "geom_point", "geom_path", "geom_path"), alpha = list(0.5, 0.5, 0.5, 0.5, 0.5), title = "DATA1 + DATA2 + DATA2 INCONSISTENT DOTS", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8092
8093
8094
8095
8096
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8097
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8098
8099
8100
8101
8102
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA2 INCONSISTENT DOTS", text.size = 12, title = "DATA2 + DATA2 INCONSISTENT DOTS")
}
if( ! is.null(data2.unknown.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8103
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8104
}
Gael  MILLOT's avatar
Gael MILLOT committed
8105
tempo.graph <- fun_gg_scatter(data1 = list(data1, data2, data2.unknown.dot, hframe , vframe), x = list(x1, x2, x2, "x", "x"), y = list(y1, y2, y2, "y", "y"), categ = list("kind", "kind", "kind", "kind", "kind"), legend.name = list("DATASET", "DATASET", "UNKNOWN DOTS", "HORIZ FRAME" , "VERT FRAME"), color = list(fun_gg_palette(2)[2], fun_gg_palette(2)[1], fun_gg_palette(7)[5], rep(hsv(h = c(0.1, 0.15), v = c(0.75, 1)), 2), rep(hsv(h = c(0.5, 0.6), v = c(0.9, 1)), 2)), geom = list("geom_point", "geom_point", "geom_point", "geom_path", "geom_path"), alpha = list(0.5, 0.5, 0.5, 0.5, 0.5), title = "DATA1 + DATA2 + DATA2 UNKNOWN DOTS", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8106
8107
8108
8109
8110
8111

if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8112
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8113
8114
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA2 UNKNOWN DOTS", text.size = 12, title = "DATA2 + DATA2 UNKNOWN DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8115
8116
8117
}
}
}else if(( ! is.null(x.range.split)) & is.null(y.range.split)){
Gael  MILLOT's avatar
Gael MILLOT committed
8118
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8119
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8120
}
Gael  MILLOT's avatar
Gael MILLOT committed
8121
tempo.graph <- fun_gg_scatter(data1 = list(data1, hframe), x = list(x1, "x"), y = list(y1, "y"), categ = list("kind", "kind"), legend.name = list("DATASET", "HORIZ FRAME"), color = list(fun_gg_palette(2)[2], rep(hsv(h = c(0.1, 0.15), v = c(0.75, 1)), 2)), geom = list("geom_point", "geom_path"), alpha = list(0.5, 0.5), title = "DATA1", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8122
8123
8124
8125
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
if( ! is.null(data1.signif.dot)){
Gael  MILLOT's avatar
Gael MILLOT committed
8126
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8127
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8128
}
Gael  MILLOT's avatar
Gael MILLOT committed
8129
tempo.graph <- fun_gg_scatter(data1 = list(data1, hframe, data1.signif.dot), x = list(x1, "x", x1), y = list(y1, "y", y1), categ = list("kind", "kind", "kind"), legend.name = list("DATASET", "HORIZ FRAME", "SIGNIF DOTS"), color = list(fun_gg_palette(2)[2], rep(hsv(h = c(0.1, 0.15), v = c(0.75, 1)), 2), "black"), geom = list("geom_point", "geom_path", "geom_point"), alpha = list(0.5, 0.5, 0.5), title = "DATA1 + DATA1 SIGNIFICANT DOTS", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8130
8131
8132
8133
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
8134
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8135
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8136
8137
8138
8139
8140
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA1 DOTS OUTSIDE THE FRAMES", text.size = 12, title = "DATA1 + DATA1 SIGNIFICANT DOTS")
}
if( ! is.null(data1.incon.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8141
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8142
}
Gael  MILLOT's avatar
Gael MILLOT committed
8143
tempo.graph <- fun_gg_scatter(data1 = list(data1, hframe, data1.incon.dot), x = list(x1, "x", x1), y = list(y1, "y", y1), categ = list("kind", "kind", "kind"), legend.name = list("DATASET", "HORIZ FRAME", "INCONSISTENT DOTS"), color = list(fun_gg_palette(2)[2], rep(hsv(h = c(0.1, 0.15), v = c(0.75, 1)), 2), fun_gg_palette(7)[6]), geom = list("geom_point", "geom_path", "geom_point"), alpha = list(0.5, 0.5, 0.5), title = "DATA1 + DATA1 INCONSISTENT DOTS", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8144
8145
8146
8147
8148
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8149
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8150
8151
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA1 INCONSISTENT DOTS", text.size = 12, title = "DATA1 + DATA1 INCONSISTENT DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8152
8153
}
if( ! is.null(data2)){
Gael  MILLOT's avatar
Gael MILLOT committed
8154
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8155
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8156
}
Gael  MILLOT's avatar
Gael MILLOT committed
8157
tempo.graph <- fun_gg_scatter(data1 = list(data1, data2, hframe), x = list(x1, x2, "x"), y = list(y1, y2, "y"), categ = list("kind", "kind", "kind"), legend.name = list("DATASET", "DATASET", "HORIZ FRAME"), color = list(fun_gg_palette(2)[2], fun_gg_palette(2)[1], rep(hsv(h = c(0.1, 0.15), v = c(0.75, 1)), 2)), geom = list("geom_point", "geom_point", "geom_path"), alpha = list(0.5, 0.5, 0.5), title = "DATA1 + DATA2", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8158
8159
8160
8161
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
if( ! is.null(data2.signif.dot)){
Gael  MILLOT's avatar
Gael MILLOT committed
8162
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8163
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8164
}
Gael  MILLOT's avatar
Gael MILLOT committed
8165
tempo.graph <- fun_gg_scatter(data1 = list(data1, data2, data2.signif.dot, hframe), x = list(x1, x2, x2, "x"), y = list(y1, y2, y2, "y"), categ = list("kind", "kind", "kind", "kind"), legend.name = list("DATASET", "DATASET", "SIGNIF DOTS", "HORIZ FRAME"), color = list(fun_gg_palette(2)[2], fun_gg_palette(2)[1], "black", rep(hsv(h = c(0.1, 0.15), v = c(0.75, 1)), 2)), geom = list("geom_point", "geom_point", "geom_point", "geom_path"), alpha = list(0.5, 0.5, 0.5, 0.5), title = "DATA1 + DATA2 + DATA2 SIGNIFICANT DOTS", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8166
8167
8168
8169
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
8170
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8171
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8172
8173
8174
8175
8176
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA2 DOTS OUTSIDE THE FRAMES", text.size = 12, title = "DATA1 + DATA2 + DATA2 SIGNIFICANT DOTS")
}
if( ! is.null(data2.incon.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8177
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8178
}
Gael  MILLOT's avatar
Gael MILLOT committed
8179
tempo.graph <- fun_gg_scatter(data1 = list(data1, data2, data2.incon.dot, hframe), x = list(x1, x2, x2, "x"), y = list(y1, y2, y2, "y"), categ = list("kind", "kind", "kind", "kind"), legend.name = list("DATASET", "DATASET", "INCONSISTENT DOTS", "HORIZ FRAME"), color = list(fun_gg_palette(2)[2], fun_gg_palette(2)[1], fun_gg_palette(7)[6], rep(hsv(h = c(0.1, 0.15), v = c(0.75, 1)), 2)), geom = list("geom_point", "geom_point", "geom_point", "geom_path"), alpha = list(0.5, 0.5, 0.5, 0.5), title = "DATA1 + DATA2 + DATA2 INCONSISTENT DOTS", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8180
8181
8182
8183
8184
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8185
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8186
8187
8188
8189
8190
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA2 INCONSISTENT DOTS", text.size = 12, title = "DATA2 + DATA2 INCONSISTENT DOTS")
}
if( ! is.null(data2.unknown.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8191
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8192
}
Gael  MILLOT's avatar
Gael MILLOT committed
8193
tempo.graph <- fun_gg_scatter(data1 = list(data1, data2, data2.unknown.dot, hframe), x = list(x1, x2, x2, "x"), y = list(y1, y2, y2, "y"), categ = list("kind", "kind", "kind", "kind"), legend.name = list("DATASET", "DATASET", "UNKNOWN DOTS", "HORIZ FRAME"), color = list(fun_gg_palette(2)[2], fun_gg_palette(2)[1], fun_gg_palette(7)[5], rep(hsv(h = c(0.1, 0.15), v = c(0.75, 1)), 2)), geom = list("geom_point", "geom_point", "geom_point", "geom_path"), alpha = list(0.5, 0.5, 0.5, 0.5), title = "DATA1 + DATA2 + DATA2 UNKNOWN DOTS", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8194
8195
8196
8197
8198
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8199
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8200
8201
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA2 UNKNOWN DOTS", text.size = 12, title = "DATA2 + DATA2 UNKNOWN DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8202
8203
8204
}
}
}else if(is.null(x.range.split) & ( ! is.null(y.range.split))){
Gael  MILLOT's avatar
Gael MILLOT committed
8205
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8206
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8207
}
Gael  MILLOT's avatar
Gael MILLOT committed
8208
tempo.graph <- fun_gg_scatter(data1 = list(data1, vframe), x = list(x1, "x"), y = list(y1, "y"), categ = list("kind", "kind"), legend.name = list("DATASET", "VERT FRAME"), color = list(fun_gg_palette(2)[2], rep(hsv(h = c(0.5, 0.6), v = c(0.9, 1)), 2)), geom = list("geom_point", "geom_path"), alpha = list(0.5, 0.5), title = "DATA1", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8209
8210
8211
8212
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
if( ! is.null(data1.signif.dot)){
Gael  MILLOT's avatar
Gael MILLOT committed
8213
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8214
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8215
}
Gael  MILLOT's avatar
Gael MILLOT committed
8216
tempo.graph <- fun_gg_scatter(data1 = list(data1, vframe, data1.signif.dot), x = list(x1, "x", x1), y = list(y1, "y", y1), categ = list("kind", "kind", "kind"), legend.name = list("DATASET", "VERT FRAME", "SIGNIF DOTS"), color = list(fun_gg_palette(2)[2], rep(hsv(h = c(0.5, 0.6), v = c(0.9, 1)), 2), "black"), geom = list("geom_point", "geom_path", "geom_point"), alpha = list(0.5, 0.5, 0.5), title = "DATA1 + DATA1 SIGNIFICANT DOTS", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8217
8218
8219
8220
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
8221
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8222
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8223
8224
8225
8226
8227
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA1 DOTS OUTSIDE THE FRAMES", text.size = 12, title = "DATA1 + DATA1 SIGNIFICANT DOTS")
}
if( ! is.null(data1.incon.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8228
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8229
}
Gael  MILLOT's avatar
Gael MILLOT committed
8230
tempo.graph <- fun_gg_scatter(data1 = list(data1, vframe, data1.incon.dot), x = list(x1, "x", x1), y = list(y1, "y", y1), categ = list("kind", "kind", "kind"), legend.name = list("DATASET", "VERT FRAME", "INCONSISTENT DOTS"), color = list(fun_gg_palette(2)[2], rep(hsv(h = c(0.5, 0.6), v = c(0.9, 1)), 2), fun_gg_palette(7)[6]), geom = list("geom_point", "geom_path", "geom_point"), alpha = list(0.5, 0.5, 0.5), title = "DATA1 + DATA1 INCONSISTENT DOTS", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8231
8232
8233
8234
8235
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8236
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8237
8238
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA1 INCONSISTENT DOTS", text.size = 12, title = "DATA1 + DATA1 INCONSISTENT DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8239
8240
}
if( ! is.null(data2)){
Gael  MILLOT's avatar
Gael MILLOT committed
8241
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8242
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8243
}
Gael  MILLOT's avatar
Gael MILLOT committed
8244
tempo.graph <- fun_gg_scatter(data1 = list(data1, data2, vframe), x = list(x1, x2, "x"), y = list(y1, y2, "y"), categ = list("kind", "kind", "kind"), legend.name = list("DATASET", "DATASET", "VERT FRAME"), color = list(fun_gg_palette(2)[2], fun_gg_palette(2)[1], rep(hsv(h = c(0.5, 0.6), v = c(0.9, 1)), 2)), geom = list("geom_point", "geom_point", "geom_path"), alpha = list(0.5, 0.5, 0.5), title = "DATA1 + DATA2", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8245
8246
8247
8248
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
if( ! is.null(data2.signif.dot)){
Gael  MILLOT's avatar
Gael MILLOT committed
8249
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8250
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8251
}
Gael  MILLOT's avatar
Gael MILLOT committed
8252
tempo.graph <- fun_gg_scatter(data1 = list(data1, data2, data2.signif.dot, vframe), x = list(x1, x2, x2, "x"), y = list(y1, y2, y2, "y"), categ = list("kind", "kind", "kind", "kind"), legend.name = list("DATASET", "DATASET", "SIGNIF DOTS", "VERT FRAME"), color = list(fun_gg_palette(2)[2], fun_gg_palette(2)[1], "black", rep(hsv(h = c(0.5, 0.6), v = c(0.9, 1)), 2)), geom = list("geom_point", "geom_point", "geom_point", "geom_path"), alpha = list(0.5, 0.5, 0.5, 0.5), title = "DATA1 + DATA2 + DATA2 SIGNIFICANT DOTS", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8253
8254
8255
8256
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
8257
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8258
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8259
8260
8261
8262
8263
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA2 DOTS OUTSIDE THE FRAMES", text.size = 12, title = "DATA1 + DATA2 + DATA2 SIGNIFICANT DOTS")
}
if( ! is.null(data2.incon.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8264
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8265
}
Gael  MILLOT's avatar
Gael MILLOT committed
8266
tempo.graph <- fun_gg_scatter(data1 = list(data1, data2, data2.incon.dot, vframe), x = list(x1, x2, x2, "x"), y = list(y1, y2, y2, "y"), categ = list("kind", "kind", "kind", "kind"), legend.name = list("DATASET", "DATASET", "INCONSISTENT DOTS", "VERT FRAME"), color = list(fun_gg_palette(2)[2], fun_gg_palette(2)[1], fun_gg_palette(7)[6], rep(hsv(h = c(0.5, 0.6), v = c(0.9, 1)), 2)), geom = list("geom_point", "geom_point", "geom_point", "geom_path"), alpha = list(0.5, 0.5, 0.5, 0.5), title = "DATA1 + DATA2 + DATA2 INCONSISTENT DOTS", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8267
8268
8269
8270
8271
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8272
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8273
8274
8275
8276
8277
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA2 INCONSISTENT DOTS", text.size = 12, title = "DATA2 + DATA2 INCONSISTENT DOTS")
}
if( ! is.null(data2.unknown.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8278
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8279
}
Gael  MILLOT's avatar
Gael MILLOT committed
8280
tempo.graph <- fun_gg_scatter(data1 = list(data1, data2, data2.unknown.dot, vframe), x = list(x1, x2, x2, "x"), y = list(y1, y2, y2, "y"), categ = list("kind", "kind", "kind", "kind"), legend.name = list("DATASET", "DATASET", "UNKNOWN DOTS", "VERT FRAME"), color = list(fun_gg_palette(2)[2], fun_gg_palette(2)[1], fun_gg_palette(7)[5], rep(hsv(h = c(0.5, 0.6), v = c(0.9, 1)), 2)), geom = list("geom_point", "geom_point", "geom_point", "geom_path"), alpha = list(0.5, 0.5, 0.5, 0.5), title = "DATA1 + DATA2 + DATA2 UNKNOWN DOTS", xlim = x.range.plot, ylim = y.range.plot, raster = raster, return = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
8281
8282
8283
8284
8285
if( ! is.null(tempo.graph$warnings)){
warning <- paste0(ifelse(is.null(warning), tempo.graph$warnings, paste0(warning, "\n", tempo.graph$warnings)))
}
}else{
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8286
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8287
8288
}
fun_gg_empty_graph(text = "NO PLOT BECAUSE NO DATA2 UNKNOWN DOTS", text.size = 12, title = "DATA2 + DATA2 UNKNOWN DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8289
8290
8291
8292
}
}
}
}
Gael  MILLOT's avatar
Gael MILLOT committed
8293
# end plot
Gael  MILLOT's avatar
Gael MILLOT committed
8294
8295
8296
if(warn.print == TRUE & ! is.null(warning)){
warning(warning)
}
Gael  MILLOT's avatar
Gael MILLOT committed
8297
tempo.list <- list(data1.removed.row.nb = data1.removed.row.nb, data1.removed.rows = data1.removed.rows, data2.removed.row.nb = data2.removed.row.nb, data2.removed.rows = data2.removed.rows, hframe = hframe, vframe = vframe, data1.signif.dot = data1.signif.dot, data1.non.signif.dot = data1.non.signif.dot, data1.inconsistent.dot = data1.incon.dot, data2.signif.dot = data2.signif.dot, data2.non.signif.dot = data2.non.signif.dot, data2.unknown.dot = data2.unknown.dot, data2.inconsistent.dot = data2.incon.dot, axes = axes, warnings = warning)
Gael  MILLOT's avatar
Gael MILLOT committed
8298
8299
8300
8301
8302
8303
8304
return(tempo.list)
}


################ Import


Gael  MILLOT's avatar
Gael MILLOT committed
8305
######## fun_pack() #### check if R packages are present and import into the working environment
Gael  MILLOT's avatar
Gael MILLOT committed
8306
8307
8308


# Check OK: clear to go Apollo
Gael  MILLOT's avatar
Gael MILLOT committed
8309
fun_pack <- function(req.package, load = FALSE, path.lib = NULL){
Gael  MILLOT's avatar
Gael MILLOT committed
8310
8311
8312
8313
# AIM
# check if the specified R packages are present in the computer and import them into the working environment
# ARGUMENTS
# req.package: character vector of package names to import
8314
# req.package: logical. Load the package into the environement (using library())?
Gael  MILLOT's avatar
Gael MILLOT committed
8315
8316
8317
8318
# path.lib: optional character vector specifying the absolute pathways of the directories containing some of the listed packages
# REQUIRED PACKAGES
# none
# REQUIRED FUNCTIONS FROM CUTE_LITTLE_R_FUNCTION
Gael  MILLOT's avatar
Gael MILLOT committed
8319
# fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
8320
8321
8322
# RETURN
# nothing
# EXAMPLES
Gael  MILLOT's avatar
Gael MILLOT committed
8323
8324
8325
# fun_pack(req.package = "nopackage")
# fun_pack(req.package = "ggplot2")
# fun_pack(req.package = "ggplot2", path.lib = "blablabla")
Gael  MILLOT's avatar
Gael MILLOT committed
8326
8327
8328
8329
8330
8331
# DEBUGGING
# req.package = "ggplot2" ; path.lib = "C:/Program Files/R/R-3.5.1/library"
# function name
function.name <- paste0(as.list(match.call(expand.dots=FALSE))[[1]], "()")
# end function name
# required function checking
Gael  MILLOT's avatar
Gael MILLOT committed
8332
8333
if(length(find("fun_check", mode = "function")) == 0){
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": REQUIRED fun_check() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
Gael  MILLOT's avatar
Gael MILLOT committed
8334
8335
8336
8337
8338
8339
8340
stop(tempo.cat)
}
# end required function checking
# argument checking
arg.check <- NULL # for function debbuging
checked.arg.names <- NULL # for function debbuging: used by r_debugging_tools
ee <- expression(arg.check <- c(arg.check, tempo$problem) , checked.arg.names <- c(checked.arg.names, tempo$param.name))
Gael  MILLOT's avatar
Gael MILLOT committed
8341
8342
tempo <- fun_check(data = req.package, class = "vector", mode = "character", fun.name = function.name) ; eval(ee)
tempo <- fun_check(data = load, class = "vector", mode = "logical", length = 1, fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
8343
if( ! is.null(path.lib)){
Gael  MILLOT's avatar
Gael MILLOT committed
8344
tempo <- fun_check(data = path.lib, class = "character", fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
8345
8346
8347
8348
8349
8350
if(tempo$problem == FALSE & ! all(dir.exists(path.lib))){
cat(paste0("\n\n============\n\nERROR IN ", function.name, ": \nDIRECTORY PATH INDICATED IN THE path.lib PARAMETER DOES NOT EXISTS: ", path.lib, "\n\n============\n\n"))
arg.check <- c(arg.check, TRUE)
}
}
if(any(arg.check) == TRUE){
Gael  MILLOT's avatar
Gael MILLOT committed
8351
stop() # nothing else because print = TRUE by default in fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
8352
}
Gael  MILLOT's avatar
Gael MILLOT committed
8353
# source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.2/r_debugging_tools-v1.2.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()
Gael  MILLOT's avatar
Gael MILLOT committed
8354
8355
8356
8357
8358
# end argument checking
# main code
if(is.null(path.lib)){
path.lib <- .libPaths() # .libPaths(new = path.lib) # or .libPaths(new = c(.libPaths(), path.lib))
}else{
8359
.libPaths(new = sub(x = path.lib, pattern = "/$|\\\\$", replacement = "")) # .libPaths(new = ) add path to default path. BEWARE: .libPaths() does not support / at the end of a submitted path. Thus check and replace last / or \\ in path
Gael  MILLOT's avatar
Gael MILLOT committed
8360
8361
8362
8363
8364
}
for(i0 in 1:length(req.package)){
if( ! req.package[i0] %in% rownames(installed.packages(lib.loc = path.lib))){
stop(paste0("\n\n================\n\nERROR IN ", function.name, ": PACKAGE ", req.package[i0], " MUST BE INSTALLED IN:\n", paste(path.lib, collapse = "\n"), "\n\n================\n\n"))
}else{
8365
if(load == TRUE){
Gael  MILLOT's avatar
Gael MILLOT committed
8366
8367
8368
8369
suppressWarnings(suppressPackageStartupMessages(library(req.package[i0], lib.loc = path.lib, quietly = TRUE, character.only = TRUE)))
}
}
}
8370
}
Gael  MILLOT's avatar
Gael MILLOT committed
8371
8372


Gael  MILLOT's avatar
Gael MILLOT committed
8373
######## fun_python_pack() #### check if python packages are present
Gael  MILLOT's avatar
Gael MILLOT committed
8374
8375
8376


# Check OK: clear to go Apollo
Gael  MILLOT's avatar
Gael MILLOT committed
8377
fun_python_pack <- function(req.package, path.lib = NULL, R.path.lib = NULL){
Gael  MILLOT's avatar
Gael MILLOT committed
8378
8379
8380
8381
8382
8383
8384
8385
8386
# AIM
# check if the specified python packages are present in the computer (no import)
# ARGUMENTS
# req.package: character vector of package names to import
# path.lib: optional character vector specifying the absolute pathways of the directories containing some of the listed packages
# R.path.lib: absolute path of the required packages, if not in the default folders
# REQUIRED PACKAGES
# reticulate
# REQUIRED FUNCTIONS FROM CUTE_LITTLE_R_FUNCTION
Gael  MILLOT's avatar
Gael MILLOT committed
8387
8388
# fun_check()
# fun_pack()
Gael  MILLOT's avatar
Gael MILLOT committed
8389
8390
8391
# RETURN
# nothing
# EXAMPLES
Gael  MILLOT's avatar
Gael MILLOT committed
8392
8393
8394
# fun_python_pack(req.package = "nopackage")
# fun_python_pack(req.package = "serpentine")
# fun_python_pack(req.package = "serpentine", path.lib = "blablabla")
Gael  MILLOT's avatar
Gael MILLOT committed
8395
8396
8397
8398
8399
8400
8401
# DEBUGGING
# req.package = "serpentine" ; path.lib = "C:/Program Files/R/R-3.5.1/library" ; R.path.lib = NULL
# req.package = "bad" ; path.lib = NULL ; R.path.lib = NULL
# function name
function.name <- paste0(as.list(match.call(expand.dots=FALSE))[[1]], "()")
# end function name
# required function checking
Gael  MILLOT's avatar
Gael MILLOT committed
8402
8403
if(length(find("fun_check", mode = "function")) == 0){
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": REQUIRED fun_check() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
Gael  MILLOT's avatar
Gael MILLOT committed
8404
8405
stop(tempo.cat)
}
Gael  MILLOT's avatar
Gael MILLOT committed
8406
8407
if(length(find("fun_pack", mode = "function")) == 0){
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": REQUIRED fun_pack() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
Gael  MILLOT's avatar
Gael MILLOT committed
8408
8409
8410
8411
8412
8413
8414
stop(tempo.cat)
}
# end required function checking
# argument checking
arg.check <- NULL # for function debbuging
checked.arg.names <- NULL # for function debbuging: used by r_debugging_tools
ee <- expression(arg.check <- c(arg.check, tempo$problem) , checked.arg.names <- c(checked.arg.names, tempo$param.name))
Gael  MILLOT's avatar
Gael MILLOT committed
8415
tempo <- fun_check(data = req.package, class = "character", fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
8416
if( ! is.null(path.lib)){
Gael  MILLOT's avatar
Gael MILLOT committed
8417
tempo <- fun_check(data = path.lib, class = "character", fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
8418
8419
8420
8421
8422
8423
if(tempo$problem == FALSE & ! all(dir.exists(path.lib))){
cat(paste0("\n\n============\n\nERROR IN ", function.name, ": \nDIRECTORY PATH INDICATED IN THE path.lib PARAMETER DOES NOT EXISTS: ", path.lib, "\n\n============\n\n"))
arg.check <- c(arg.check, TRUE)
}
}
if( ! is.null(R.path.lib)){
Gael  MILLOT's avatar
Gael MILLOT committed
8424
tempo <- fun_check(data = R.path.lib, class = "character", fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
8425
8426
8427
8428
8429
8430
if(tempo$problem == FALSE & ! all(dir.exists(R.path.lib))){
cat(paste0("\n\n============\n\nERROR IN ", function.name, ": \nDIRECTORY PATH INDICATED IN THE R.path.lib PARAMETER DOES NOT EXISTS: ", R.path.lib, "\n\n============\n\n"))
arg.check <- c(arg.check, TRUE)
}
}
if(any(arg.check) == TRUE){
Gael  MILLOT's avatar
Gael MILLOT committed
8431
stop() # nothing else because print = TRUE by default in fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
8432
}
Gael  MILLOT's avatar
Gael MILLOT committed
8433
# source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.2/r_debugging_tools-v1.2.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()
Gael  MILLOT's avatar
Gael MILLOT committed
8434
8435
# end argument checking
# package checking
Gael  MILLOT's avatar
Gael MILLOT committed
8436
fun_pack(req.package = "reticulate", path.lib = R.path.lib)
Gael  MILLOT's avatar
Gael MILLOT committed
8437
8438
8439
8440
8441
8442
8443
8444
8445
8446
8447
8448
8449
8450
8451
8452
8453
8454
8455
8456
8457
8458
8459
8460
8461
8462
# end package checking
# main code
if(is.null(path.lib)){
path.lib <- reticulate::py_run_string("
import sys ;
path_lib = sys.path
") # python string
path.lib <- path.lib$path_lib
}
for(i0 in 1:length(req.package)){
tempo.try <- vector("list", length = length(path.lib))
for(i1 in 1:length(path.lib)){
tempo.try[[i1]] <- try(suppressWarnings(reticulate::import_from_path(req.package[i0], path = path.lib[i1])), silent = TRUE)
}
if(all(sapply(tempo.try, FUN = grepl, pattern = "[Ee]rror"))){
stop(paste0("\n\n================\n\nERROR IN ", function.name, ": PACKAGE ", req.package[i0], " MUST BE INSTALLED IN THE MENTIONNED DIRECTORY:\n", paste(path.lib, collapse = "\n"), "\n\n================\n\n"))
}else{
assign(req.package[i0], reticulate::import(req.package[i0]))
}
}
}


################ Exporting results (text & tables)


Gael  MILLOT's avatar
Gael MILLOT committed
8463
######## fun_report() #### print string or data object into output file
Gael  MILLOT's avatar
Gael MILLOT committed
8464
8465
8466


# Check OK: clear to go Apollo
Gael  MILLOT's avatar
Gael MILLOT committed
8467
fun_report <- function(data = NULL, output ="results.txt", path = "C:/Users/Gael/Desktop", no.overwrite = TRUE, rownames.kept = FALSE, vector.cat = FALSE, noquote = TRUE, sep = 2){
Gael  MILLOT's avatar
Gael MILLOT committed
8468
8469
8470
# AIM
# log file function: print a character string or a data object into a same output file
# REQUIRED FUNCTIONS FROM CUTE_LITTLE_R_FUNCTION
Gael  MILLOT's avatar
Gael MILLOT committed
8471
# fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
8472
8473
8474
8475
8476
8477
8478
8479
8480
8481
8482
8483
# ARGUMENTS
# data: object to print in the output file. cannot be NULL
# output: name of the output file
# path: location of the output file
# no.overwrite: (logical) if output file already exists, defines if the printing is appended (default TRUE) or if the output file content is erased before printing (FALSE)
# rownames.kept: (logical) defines whether row names have to be removed or not in small tables (less than length.rows rows)
# vector.cat (logical). If TRUE print a vector of length > 1 using cat() instead of capture.output(). Otherwise (default FALSE) the opposite
# noquote: (logical). If TRUE no quote are present for the characters
# sep: number of separating lines after printed data (must be integer)
# RETURN
# nothing
# EXAMPLES
Gael  MILLOT's avatar
Gael MILLOT committed
8484
8485
# fun_report()
# fun_report(data = 1:3, output = "results.txt", path = "C:/Users/Gael/Desktop", no.overwrite = TRUE, rownames.kept = FALSE, vector.cat = FALSE, noquote = FALSE, sep = 2)
Gael  MILLOT's avatar
Gael MILLOT committed
8486
8487
8488
8489
8490
8491
# DEBUGGING
# data = 1:3 ; output = "results.txt" ; path = "C:/Users/Gael/Desktop" ; no.overwrite = TRUE ; rownames.kept = FALSE ; vector.cat = FALSE ; noquote = FALSE ; sep = 2 # for function debugging
# function name
function.name <- paste0(as.list(match.call(expand.dots=FALSE))[[1]], "()")
# end function name
# required function checking
Gael  MILLOT's avatar
Gael MILLOT committed
8492
8493
if(length(find("fun_check", mode = "function")) == 0){
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": REQUIRED fun_check() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
Gael  MILLOT's avatar
Gael MILLOT committed
8494
8495
8496
8497
stop(tempo.cat)
}
# end required function checking
# argument checking
Gael  MILLOT's avatar
Gael MILLOT committed
8498
# argument checking without fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
8499
8500
8501
8502
if(is.null(data)){
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": data ARGUMENT CANNOT BE NULL\n\n================\n\n")
stop(tempo.cat)
}
Gael  MILLOT's avatar
Gael MILLOT committed
8503
8504
# end argument checking without fun_check()
# argument checking with fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
8505
8506
8507
arg.check <- NULL # for function debbuging
checked.arg.names <- NULL # for function debbuging: used by r_debugging_tools
ee <- expression(arg.check <- c(arg.check, tempo$problem) , checked.arg.names <- c(checked.arg.names, tempo$param.name))
Gael  MILLOT's avatar
Gael MILLOT committed
8508
tempo <- fun_check(data = output, class = "character", length = 1, fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
8509
8510
if(tempo$problem == FALSE & output == ""){
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": output ARGUMENT AS \"\" DOES NOT CORRESPOND TO A VALID FILE NAME\n\n================\n\n")
Gael  MILLOT's avatar
Gael MILLOT committed
8511
cat(tempo.cat)
Gael  MILLOT's avatar
Gael MILLOT committed
8512
8513
arg.check <- c(arg.check, TRUE)
}
Gael  MILLOT's avatar
Gael MILLOT committed
8514
tempo <- fun_check(data = path, class = "character", length = 1, fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
8515
8516
if(tempo$problem == FALSE & dir.exists(path) == FALSE){
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": path ARGUMENT DOES NOT CORRESPOND TO EXISTING DIRECTORY\n", paste(path, collapse = "\n"),"\n\n================\n\n")
Gael  MILLOT's avatar
Gael MILLOT committed
8517
cat(tempo.cat)
Gael  MILLOT's avatar
Gael MILLOT committed
8518
8519
arg.check <- c(arg.check, TRUE)
}
Gael  MILLOT's avatar
Gael MILLOT committed
8520
8521
8522
8523
8524
tempo <- fun_check(data = no.overwrite, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
tempo <- fun_check(data = rownames.kept, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
tempo <- fun_check(data = vector.cat, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
tempo <- fun_check(data = noquote, class = "logical", length = 1, fun.name = function.name) ; eval(ee)
tempo <- fun_check(data = sep, class = "vector", typeof = "integer", length = 1, double.as.integer.allowed = TRUE, fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
8525
if(any(arg.check) == TRUE){
Gael  MILLOT's avatar
Gael MILLOT committed
8526
stop() # nothing else because print = TRUE by default in fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
8527
}
Gael  MILLOT's avatar
Gael MILLOT committed
8528
8529
# end argument checking with fun_check()
# source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.2/r_debugging_tools-v1.2.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()
Gael  MILLOT's avatar
Gael MILLOT committed
8530
8531
8532
8533
8534
8535
8536
8537
8538
8539
8540
8541
8542
8543
# the 4 next lines are inactivated but kept because at a time, I might have a problem with data (solved with data = NULL). These 4 lines are just to know how to detect a missing argument. Important here because if data is not provided, print the code of the data function
# arg.user.list <- as.list(match.call(expand.dots=FALSE))[-1] # recover all the arguments provided by the function user (excluding the argument with defaults values not provided by the user. Thus, it is really the list indicated by the user)
# default.arg.list <- formals(fun = sys.function(sys.parent())) # list of all the arguments of the function with their default values (not the values of the user !). It seems that ls() as first line of the function provide the names of the arguments (empty, called, etc., or not)
# arg.without.default.value <- sapply(default.arg.list, is.symbol) & sapply(sapply(default.arg.list, as.character), identical, "") # logical to detect argument without default values (these are typeof "symbol" and class "name" and empty character
# if( ! all(names(default.arg.list)[arg.without.default.value] %in% names(arg.user.list))){ # test that the arguments with no null values are provided by the user
# tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": VALUE REQUIRED FOR THESE ARGUMENTS WITH NO DEFAULTS VALUES: ", paste(names(default.arg.list)[arg.without.default.value][ ! names(default.arg.list)[arg.without.default.value] %in% names(arg.user.list)], collapse = " "), "\n\n================\n\n")
#stop(tempo.cat)
# }
# end argument checking
# main code
if(all(class(data) %in% c("matrix", "data.frame", "table"))){
if(rownames.kept == FALSE & all(class(data) == "data.frame") & nrow(data) != 0 & nrow(data) <= 4){ # for data frames with nrows <= 4
rownames.output.tables <- ""
length.rows <- nrow(data)
Gael  MILLOT's avatar
Gael MILLOT committed
8544
for(i in 1:length.rows){ # replace the rownames of the first 4 rows by increasing number of spaces (because identical row names not allowed in data frames). This method cannot be extended to more rows as the printed data frame is shifted on the right because of "big empty rownames"
Gael  MILLOT's avatar
Gael MILLOT committed
8545
8546
8547
8548
8549
8550
8551
8552
8553
8554
8555
8556
8557
8558
8559
8560
8561
8562
8563
8564
8565
8566
8567
8568
8569
8570
rownames.output.tables <- c(rownames.output.tables, paste0(rownames.output.tables[i]," ", collapse=""))
}
row.names(data) <- rownames.output.tables[1:length.rows]
}else if(rownames.kept == FALSE & all(class(data) %in% c("matrix", "table"))){
rownames(data) <- rep("", nrow(data)) # identical row names allowed in matrices and tables
}
if(noquote == TRUE){
capture.output(noquote(data), file=paste0(path, "/", output), append = no.overwrite)
}else{
capture.output(data, file=paste0(path, "/", output), append = no.overwrite)
}
}else if(is.vector(data) & all(class(data) != "list") & (length(data) == 1 | vector.cat == TRUE)){
if(noquote == TRUE){
cat(noquote(data), file= paste0(path, "/", output), append = no.overwrite)
}else{
cat(data, file= paste0(path, "/", output), append = no.overwrite)
}
}else{ # other (array, list, factor or vector with vector.cat = FALSE)
if(noquote == TRUE){
capture.output(noquote(data), file=paste0(path, "/", output), append = no.overwrite)
}else{
capture.output(data, file=paste0(path, "/", output), append = no.overwrite)
}
}
sep.final <- paste0(rep("\n", sep), collapse = "")
write(sep.final, file= paste0(path, "/", output), append = TRUE) # add a sep
Gael  MILLOT's avatar
Gael MILLOT committed
8571
8572
8573
}