cute_little_R_functions.R 895 KB
Newer Older
Gael's avatar
Gael committed
13001
13002
13003
13004
# drawing
fin.plot <- eval(parse(text = paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + ")))
grob.save <- NULL
if(plot == TRUE){
13005
13006
13007
13008
13009
if( ! is.null(legend.width)){ # any(unlist(legend.disp)) == TRUE removed to have empty legend space # not & any(unlist(fin.lg.disp)) == TRUE here because converted to FALSE
grob.save <- suppressMessages(suppressWarnings(gridExtra::grid.arrange(fin.plot, legend.final, ncol=2, widths=c(1, legend.width))))
}else{
grob.save <- suppressMessages(suppressWarnings(print(fin.plot)))
}
13010
}else{
13011
13012
13013
warn.count <- warn.count + 1
tempo.warn <- paste0("(", warn.count,") PLOT NOT SHOWN AS REQUESTED")
warn <- paste0(ifelse(is.null(warn), tempo.warn, paste0(warn, "\n\n", tempo.warn)))
Gael  MILLOT's avatar
Gael MILLOT committed
13014
}
Gael's avatar
Gael committed
13015
13016
13017
13018
# end drawing



13019
# output
Gael's avatar
Gael committed
13020
if(warn.print == TRUE & ! is.null(warn)){
13021
13022
13023
options(warning.length = 8170)
on.exit(warning(paste0("FROM ", function.name, ":\n\n", warn), call. = FALSE))
on.exit(exp = options(warning.length = ini.warning.length), add = TRUE)
Gael  MILLOT's avatar
Gael MILLOT committed
13024
}
Gael's avatar
Gael committed
13025
if(return == TRUE){
13026
13027
13028
13029
13030
13031
13032
13033
13034
13035
13036
13037
13038
13039
13040
13041
13042
13043
13044
13045
13046
13047
13048
13049
13050
13051
13052
13053
13054
13055
13056
13057
13058
13059
13060
13061
13062
13063
13064
output <- suppressMessages(ggplot2::ggplot_build(fin.plot))
# output$data <- output$data[-1] # yes for boxplot but not for scatter # remove the first data because corresponds to the initial empty boxplot
if(length(output$data) != length(coord.names)){
tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, ": length(output$data) AND length(coord.names) MUST BE IDENTICAL. CODE HAS TO BE MODIFIED")
stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n", ifelse(is.null(warn), "", paste0("IN ADDITION\nWARNING", ifelse(warn.count > 1, "S", ""), ":\n\n", warn))), call. = FALSE)
}else{
names(output$data) <- coord.names
}
if(is.null(unlist(removed.row.nb))){
removed.row.nb <- NULL
removed.rows <- NULL
}else{
for(i3 in 1:length(data1)){
if( ! is.null(removed.row.nb[[i3]])){
removed.row.nb[[i3]] <- sort(removed.row.nb[[i3]])
removed.rows[[i3]] <- data1.ini[[i3]][removed.row.nb[[i3]], ]
}
}
}
tempo <- output$layout$panel_params[[1]]
output <- list(
data = data1, 
removed.row.nb = removed.row.nb, 
removed.rows = removed.rows, 
plot = c(output$data, x.second.tick.values = list(x.second.tick.values), y.second.tick.values = list(y.second.tick.values)), 
panel = facet.categ, 
axes = list(
x.range = tempo$x.range, 
x.labels = if(is.null(attributes(tempo$x$breaks))){tempo$x$breaks}else{tempo$x$scale$get_labels()}, # is.null(attributes(tempo$x$breaks)) test if it is number (TRUE) or character (FALSE)
x.positions = if(is.null(attributes(tempo$x$breaks))){tempo$x$breaks}else{unlist(attributes(tempo$x$breaks))}, 
y.range = tempo$y.range, 
y.labels = if(is.null(attributes(tempo$y$breaks))){tempo$y$breaks}else{tempo$y$scale$get_labels()}, 
y.positions = if(is.null(attributes(tempo$y$breaks))){tempo$y$breaks}else{unlist(attributes(tempo$y$breaks))}
), 
warn = paste0("\n", warn, "\n\n"), 
ggplot = if(return.ggplot == TRUE){fin.plot}else{NULL}, # fin.plot plots the graph if return == TRUE
gtable = if(return.gtable == TRUE){grob.save}else{NULL} #
)
return(output) # this plots the graph if return.ggplot is TRUE and if no assignment
13065
13066
}
# end output
Gael's avatar
Gael committed
13067
# end main code
Gael  MILLOT's avatar
Gael MILLOT committed
13068
}
13069
13070
13071