cute_little_R_functions.R 626 KB
Newer Older
Gael  MILLOT's avatar
Gael MILLOT committed
8001
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
8002
8003
8004
8005
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
8006
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8007
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8008
}
Gael  MILLOT's avatar
Gael MILLOT committed
8009
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
8010
8011
8012
8013
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
8014
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8015
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8016
}
Gael  MILLOT's avatar
Gael MILLOT committed
8017
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA1 DOTS\nOUTSIDE THE FRAMES", text.size = 8, title = "DATA1 + DATA1 SIGNIFICANT DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8018
8019
8020
}
if( ! is.null(data1.incon.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8021
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8022
}
Gael  MILLOT's avatar
Gael MILLOT committed
8023
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
8024
8025
8026
8027
8028
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
8029
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8030
}
Gael  MILLOT's avatar
Gael MILLOT committed
8031
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA1\nINCONSISTENT DOTS", text.size = 8, title = "DATA1 + DATA1 INCONSISTENT DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8032
8033
}
if( ! is.null(data2)){
Gael  MILLOT's avatar
Gael MILLOT committed
8034
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8035
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8036
}
Gael  MILLOT's avatar
Gael MILLOT committed
8037
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
8038
8039
8040
8041
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
8042
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8043
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8044
}
Gael  MILLOT's avatar
Gael MILLOT committed
8045
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
8046
8047
8048
8049
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
8050
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8051
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8052
}
Gael  MILLOT's avatar
Gael MILLOT committed
8053
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA2 DOTS\nOUTSIDE THE FRAMES", text.size = 8, title = "DATA1 + DATA2 + DATA2 SIGNIFICANT DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8054
8055
8056
}
if( ! is.null(data2.incon.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8057
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8058
}
Gael  MILLOT's avatar
Gael MILLOT committed
8059
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
8060
8061
8062
8063
8064
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
8065
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8066
}
Gael  MILLOT's avatar
Gael MILLOT committed
8067
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA2\nINCONSISTENT DOTS", text.size = 8, title = "DATA2 + DATA2 INCONSISTENT DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8068
8069
8070
}
if( ! is.null(data2.unknown.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8071
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8072
}
Gael  MILLOT's avatar
Gael MILLOT committed
8073
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
8074
8075
8076
8077
8078
8079

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
8080
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8081
}
Gael  MILLOT's avatar
Gael MILLOT committed
8082
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA2\nUNKNOWN DOTS", text.size = 12, title = "DATA2 + DATA2 UNKNOWN DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8083
8084
8085
}
}
}else if(( ! is.null(x.range.split)) & is.null(y.range.split)){
Gael  MILLOT's avatar
Gael MILLOT committed
8086
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8087
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8088
}
Gael  MILLOT's avatar
Gael MILLOT committed
8089
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
8090
8091
8092
8093
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
8094
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8095
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8096
}
Gael  MILLOT's avatar
Gael MILLOT committed
8097
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
8098
8099
8100
8101
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
8102
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
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA1 DOTS\nOUTSIDE THE FRAMES", text.size = 8, title = "DATA1 + DATA1 SIGNIFICANT DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8106
8107
8108
}
if( ! is.null(data1.incon.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8109
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8110
}
Gael  MILLOT's avatar
Gael MILLOT committed
8111
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
8112
8113
8114
8115
8116
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
8117
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8118
}
Gael  MILLOT's avatar
Gael MILLOT committed
8119
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA1\nINCONSISTENT DOTS", text.size = 8, title = "DATA1 + DATA1 INCONSISTENT DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8120
8121
}
if( ! is.null(data2)){
Gael  MILLOT's avatar
Gael MILLOT committed
8122
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8123
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8124
}
Gael  MILLOT's avatar
Gael MILLOT committed
8125
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
8126
8127
8128
8129
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
8130
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8131
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8132
}
Gael  MILLOT's avatar
Gael MILLOT committed
8133
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
8134
8135
8136
8137
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
8138
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8139
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8140
}
Gael  MILLOT's avatar
Gael MILLOT committed
8141
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA2 DOTS\nOUTSIDE THE FRAMES", text.size = 8, title = "DATA1 + DATA2 + DATA2 SIGNIFICANT DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8142
8143
8144
}
if( ! is.null(data2.incon.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8145
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8146
}
Gael  MILLOT's avatar
Gael MILLOT committed
8147
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
8148
8149
8150
8151
8152
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
8153
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8154
}
Gael  MILLOT's avatar
Gael MILLOT committed
8155
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA2\nINCONSISTENT DOTS", text.size = 8, title = "DATA2 + DATA2 INCONSISTENT DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8156
8157
8158
}
if( ! is.null(data2.unknown.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8159
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8160
}
Gael  MILLOT's avatar
Gael MILLOT committed
8161
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
8162
8163
8164
8165
8166
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
8167
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8168
}
Gael  MILLOT's avatar
Gael MILLOT committed
8169
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA2\nUNKNOWN DOTS", text.size = 8, title = "DATA2 + DATA2 UNKNOWN DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8170
8171
8172
}
}
}else if(is.null(x.range.split) & ( ! is.null(y.range.split))){
Gael  MILLOT's avatar
Gael MILLOT committed
8173
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8174
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8175
}
Gael  MILLOT's avatar
Gael MILLOT committed
8176
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
8177
8178
8179
8180
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
8181
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8182
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8183
}
Gael  MILLOT's avatar
Gael MILLOT committed
8184
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
8185
8186
8187
8188
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
8189
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8190
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8191
}
Gael  MILLOT's avatar
Gael MILLOT committed
8192
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA1 DOTS\nOUTSIDE THE FRAMES", text.size = 8, title = "DATA1 + DATA1 SIGNIFICANT DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8193
8194
8195
}
if( ! is.null(data1.incon.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8196
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8197
}
Gael  MILLOT's avatar
Gael MILLOT committed
8198
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
8199
8200
8201
8202
8203
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
8204
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8205
}
Gael  MILLOT's avatar
Gael MILLOT committed
8206
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA1\nINCONSISTENT DOTS", text.size = 8, title = "DATA1 + DATA1 INCONSISTENT DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8207
8208
}
if( ! is.null(data2)){
Gael  MILLOT's avatar
Gael MILLOT committed
8209
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8210
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8211
}
Gael  MILLOT's avatar
Gael MILLOT committed
8212
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
8213
8214
8215
8216
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
8217
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8218
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8219
}
Gael  MILLOT's avatar
Gael MILLOT committed
8220
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
8221
8222
8223
8224
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
8225
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8226
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8227
}
Gael  MILLOT's avatar
Gael MILLOT committed
8228
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA2 DOTS\nOUTSIDE THE FRAMES", text.size = 8, title = "DATA1 + DATA2 + DATA2 SIGNIFICANT DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8229
8230
8231
}
if( ! is.null(data2.incon.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8232
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8233
}
Gael  MILLOT's avatar
Gael MILLOT committed
8234
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
8235
8236
8237
8238
8239
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
8240
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8241
}
Gael  MILLOT's avatar
Gael MILLOT committed
8242
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA2\nINCONSISTENT DOTS", text.size = 8, title = "DATA2 + DATA2 INCONSISTENT DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8243
8244
8245
}
if( ! is.null(data2.unknown.dot)){
if(graph.in.file == FALSE){
Gael  MILLOT's avatar
Gael MILLOT committed
8246
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8247
}
Gael  MILLOT's avatar
Gael MILLOT committed
8248
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
8249
8250
8251
8252
8253
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
8254
fun_open(pdf.disp = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
8255
}
Gael  MILLOT's avatar
Gael MILLOT committed
8256
fun_gg_empty_graph(text = "NO PLOT\nBECAUSE\nNO DATA2\nUNKNOWN DOTS", text.size = 8, title = "DATA2 + DATA2 UNKNOWN DOTS")
Gael  MILLOT's avatar
Gael MILLOT committed
8257
8258
8259
8260
}
}
}
}
Gael  MILLOT's avatar
Gael MILLOT committed
8261
# end plot
Gael  MILLOT's avatar
Gael MILLOT committed
8262
8263
8264
if(warn.print == TRUE & ! is.null(warning)){
warning(warning)
}
Gael  MILLOT's avatar
Gael MILLOT committed
8265
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
8266
8267
8268
8269
8270
8271
8272
return(tempo.list)
}


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


Gael  MILLOT's avatar
Gael MILLOT committed
8273
######## fun_pack() #### check if R packages are present and import into the working environment
Gael  MILLOT's avatar
Gael MILLOT committed
8274
8275
8276


# Check OK: clear to go Apollo
Gael  MILLOT's avatar
Gael MILLOT committed
8277
fun_pack <- function(req.package, load = FALSE, path.lib = NULL){
Gael  MILLOT's avatar
Gael MILLOT committed
8278
8279
8280
8281
# 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
8282
# req.package: logical. Load the package into the environement (using library())?
Gael  MILLOT's avatar
Gael MILLOT committed
8283
8284
8285
8286
# 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
8287
# fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
8288
8289
8290
# RETURN
# nothing
# EXAMPLES
Gael  MILLOT's avatar
Gael MILLOT committed
8291
8292
8293
# 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
8294
8295
# DEBUGGING
# req.package = "ggplot2" ; path.lib = "C:/Program Files/R/R-3.5.1/library"
Gael  MILLOT's avatar
Gael MILLOT committed
8296
# req.package = "serpentine" ; path.lib = "C:/users/gael/appdata/roaming/python/python36/site-packages"
Gael  MILLOT's avatar
Gael MILLOT committed
8297
8298
8299
8300
# 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
8301
8302
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
8303
8304
8305
8306
8307
8308
8309
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
8310
8311
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
8312
if( ! is.null(path.lib)){
Gael  MILLOT's avatar
Gael MILLOT committed
8313
tempo <- fun_check(data = path.lib, class = "character", fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
8314
8315
8316
8317
8318
8319
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
8320
stop() # nothing else because print = TRUE by default in fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
8321
}
Gael  MILLOT's avatar
Gael MILLOT committed
8322
# 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
8323
8324
8325
8326
8327
# 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{
8328
.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
8329
8330
8331
8332
8333
}
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{
8334
if(load == TRUE){
Gael  MILLOT's avatar
Gael MILLOT committed
8335
8336
8337
8338
suppressWarnings(suppressPackageStartupMessages(library(req.package[i0], lib.loc = path.lib, quietly = TRUE, character.only = TRUE)))
}
}
}
8339
}
Gael  MILLOT's avatar
Gael MILLOT committed
8340
8341


Gael  MILLOT's avatar
Gael MILLOT committed
8342
######## fun_python_pack() #### check if python packages are present
Gael  MILLOT's avatar
Gael MILLOT committed
8343
8344
8345


# Check OK: clear to go Apollo
Gael  MILLOT's avatar
Gael MILLOT committed
8346
fun_python_pack <- function(req.package, path.lib = NULL, R.path.lib = NULL){
Gael  MILLOT's avatar
Gael MILLOT committed
8347
8348
8349
8350
# AIM
# check if the specified python packages are present in the computer (no import)
# ARGUMENTS
# req.package: character vector of package names to import
Gael  MILLOT's avatar
Gael MILLOT committed
8351
8352
# path.lib: optional character vector specifying the absolute pathways of the directories containing some of the listed packages in the req.package argument
# R.path.lib: absolute path of the reticulate packages, if not in the default folders
Gael  MILLOT's avatar
Gael MILLOT committed
8353
8354
8355
# REQUIRED PACKAGES
# reticulate
# REQUIRED FUNCTIONS FROM CUTE_LITTLE_R_FUNCTION
Gael  MILLOT's avatar
Gael MILLOT committed
8356
8357
# fun_check()
# fun_pack()
Gael  MILLOT's avatar
Gael MILLOT committed
8358
8359
8360
# RETURN
# nothing
# EXAMPLES
Gael  MILLOT's avatar
Gael MILLOT committed
8361
# fun_python_pack(req.package = "nopackage")
Gael  MILLOT's avatar
Gael MILLOT committed
8362
# fun_python_pack(req.package = "serpentine", path.lib = "c:/programdata/anaconda3/lib/site-packages/")
Gael  MILLOT's avatar
Gael MILLOT committed
8363
# fun_python_pack(req.package = "serpentine", path.lib = "blablabla")
Gael  MILLOT's avatar
Gael MILLOT committed
8364
# DEBUGGING
Gael  MILLOT's avatar
Gael MILLOT committed
8365
# req.package = "serpentine" ; path.lib = "c:/programdata/anaconda3/lib/site-packages/" ; R.path.lib = NULL
Gael  MILLOT's avatar
Gael MILLOT committed
8366
8367
8368
8369
8370
# 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
8371
8372
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
8373
8374
stop(tempo.cat)
}
Gael  MILLOT's avatar
Gael MILLOT committed
8375
8376
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
8377
8378
8379
8380
8381
8382
8383
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
8384
tempo <- fun_check(data = req.package, class = "character", fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
8385
if( ! is.null(path.lib)){
Gael  MILLOT's avatar
Gael MILLOT committed
8386
tempo <- fun_check(data = path.lib, class = "character", fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
8387
8388
8389
8390
8391
8392
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
8393
tempo <- fun_check(data = R.path.lib, class = "character", fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
8394
8395
8396
8397
8398
8399
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
8400
stop() # nothing else because print = TRUE by default in fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
8401
}
Gael  MILLOT's avatar
Gael MILLOT committed
8402
# 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
8403
8404
# end argument checking
# package checking
Gael  MILLOT's avatar
Gael MILLOT committed
8405
fun_pack(req.package = "reticulate", path.lib = R.path.lib)
Gael  MILLOT's avatar
Gael MILLOT committed
8406
8407
8408
8409
8410
8411
8412
8413
8414
8415
8416
8417
# 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)){
Gael  MILLOT's avatar
Gael MILLOT committed
8418
tempo.try[[i1]] <- suppressWarnings(try(reticulate::import_from_path(req.package[i0], path = path.lib[i1]), silent = TRUE))
Gael  MILLOT's avatar
Gael MILLOT committed
8419
tempo.try[[i1]] <- suppressWarnings(try(reticulate::import_from_path(req.package[i0], path = path.lib[i1]), silent = TRUE)) # done twice to avoid the error message  about flushing present the first time but not the second time. see https://stackoverflow.com/questions/57357001/reticulate-1-13-error-in-sysstdoutflush-attempt-to-apply-non-function
Gael  MILLOT's avatar
Gael MILLOT committed
8420
8421
8422
8423
}
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{
Gael  MILLOT's avatar
Gael MILLOT committed
8424
# suppressWarnings(suppressPackageStartupMessages(assign(req.package[i0], reticulate::import(req.package[i0])))) # not required because try() already evaluates
Gael  MILLOT's avatar
Gael MILLOT committed
8425
8426
8427
8428
8429
8430
8431
8432
}
}
}


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


Gael  MILLOT's avatar
Gael MILLOT committed
8433
######## fun_report() #### print string or data object into output file
Gael  MILLOT's avatar
Gael MILLOT committed
8434
8435
8436


# Check OK: clear to go Apollo
Gael  MILLOT's avatar
Gael MILLOT committed
8437
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
8438
8439
8440
# 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
8441
# fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
8442
8443
8444
8445
8446
8447
8448
8449
8450
8451
8452
8453
# 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
8454
8455
# 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
8456
8457
8458
8459
8460
8461
# 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
8462
8463
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
8464
8465
8466
8467
stop(tempo.cat)
}
# end required function checking
# argument checking
Gael  MILLOT's avatar
Gael MILLOT committed
8468
# argument checking without fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
8469
8470
8471
8472
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
8473
8474
# end argument checking without fun_check()
# argument checking with fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
8475
8476
8477
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
8478
tempo <- fun_check(data = output, class = "character", length = 1, fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
8479
8480
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
8481
cat(tempo.cat)
Gael  MILLOT's avatar
Gael MILLOT committed
8482
8483
arg.check <- c(arg.check, TRUE)
}
Gael  MILLOT's avatar
Gael MILLOT committed
8484
tempo <- fun_check(data = path, class = "character", length = 1, fun.name = function.name) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
8485
8486
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
8487
cat(tempo.cat)
Gael  MILLOT's avatar
Gael MILLOT committed
8488
8489
arg.check <- c(arg.check, TRUE)
}
Gael  MILLOT's avatar
Gael MILLOT committed
8490
8491
8492
8493
8494
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
8495
if(any(arg.check) == TRUE){
Gael  MILLOT's avatar
Gael MILLOT committed
8496
stop() # nothing else because print = TRUE by default in fun_check()
Gael  MILLOT's avatar
Gael MILLOT committed
8497
}
Gael  MILLOT's avatar
Gael MILLOT committed
8498
8499
# 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
8500
8501
8502
8503
8504
8505
8506
8507
8508
8509
8510
8511
8512
8513
# 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
8514
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
8515
8516
8517
8518
8519
8520
8521
8522
8523
8524
8525
8526
8527
8528
8529
8530
8531
8532
8533
8534
8535
8536
8537
8538
8539
8540
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
8541
8542
8543
}