cute_little_R_functions.R 872 KB
Newer Older
12001
12002
12003
12004
12005
12006
12007
12008
12009
12010
coord.names <- c(coord.names, "y.second.tick.positions")
}else if(( ! is.null(y.second.tick.nb)) & y.log == "no"){
# if(y.second.tick.nb > 0){ #inactivated because already checked before
tempo <- fun_inter_ticks(lim = y.lim, log = y.log, breaks = tempo.scale, n = y.second.tick.nb)
y.second.tick.values <- tempo$values
y.second.tick.pos <- tempo$coordinates
assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::annotate(
geom = "segment", 
y = y.second.tick.pos, 
yend = y.second.tick.pos, 
12011
12012
x = if(diff(x.lim) > 0){tempo.coord$x.range[1]}else{tempo.coord$x.range[2]}, 
xend = if(diff(x.lim) > 0){tempo.coord$x.range[1] + abs(diff(tempo.coord$x.range)) / 80}else{tempo.coord$x.range[2] - abs(diff(tempo.coord$x.range)) / 80}
12013
12014
12015
12016
12017
12018
12019
))
coord.names <- c(coord.names, "y.second.tick.positions")
}
# for the ggplot2 bug with y.log, this does not work: eval(parse(text = ifelse(vertical == FALSE & y.log == "log10", "ggplot2::scale_x_continuous", "ggplot2::scale_y_continuous")))
assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_y_continuous(
breaks = tempo.scale, 
minor_breaks = y.second.tick.pos, 
12020
labels = if(y.log == "log10"){scales::trans_format("identity", scales::math_format(10^.x))}else if(y.log == "log2"){scales::trans_format("identity", scales::math_format(2^.x))}else if(y.log == "no"){ggplot2::waiver()}else{tempo.cat <- paste0("INTERNAL CODE ERROR IN ", function.name, "\nCODE INCONSISTENCY 10") ; 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)}, 
12021
expand = c(0, 0), # remove space after axis limits
12022
12023
12024
12025
limits = sort(y.lim), # NA indicate that limits must correspond to data limits but ylim() already used
oob = scales::rescale_none, 
trans = ifelse(diff(y.lim) < 0, "reverse", "identity") # equivalent to ggplot2::scale_y_reverse() but create the problem of y-axis label disappearance with y.lim decreasing. Thus, do not use. Use ylim() below and after this
))
12026
12027
12028
# end y.second.tick.positions
assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::coord_cartesian(xlim = x.lim, ylim = y.lim)) # clip = "off" to have secondary ticks outside plot region. The problem is that points out of bounds are also drawn outside the plot region. Thus, I cannot use it # at that stage, x.lim and y.lim not NULL anymore
# end scale management
12029
12030
12031
12032
12033




# drawing
12034
fin.plot <- eval(parse(text = paste(paste0(tempo.gg.name, 1:tempo.gg.count), collapse = " + ")))
12035
grob.save <- NULL
12036
if(plot == TRUE){
12037
12038
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))))
12039
}else{
12040
grob.save <- suppressMessages(suppressWarnings(print(fin.plot)))
12041
12042
12043
12044
12045
12046
12047
12048
12049
12050
12051
12052
12053
12054
12055
}
}else{
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)))
}
# end drawing



# outputs
if(warn.print == TRUE & ! is.null(warn)){
warning(paste0("FROM ", function.name, " FUNCTION:\n\n", warn), call. = FALSE) # to recover the warning messages, use return = TRUE
}
if(return == TRUE){
12056
12057
12058
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)){
12059
12060
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)
12061
}else{
12062
names(output$data) <- coord.names
12063
}
12064
12065
12066
12067
12068
12069
12070
12071
12072
12073
12074
12075
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]]
12076
12077
12078
12079
output <- list(
data = data1, 
removed.row.nb = removed.row.nb, 
removed.rows = removed.rows, 
12080
plot = c(output$data, x.second.tick.values = list(x.second.tick.values), y.second.tick.values = list(y.second.tick.values)), 
12081
panel = facet.categ, 
12082
12083
12084
12085
12086
12087
12088
12089
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))}
), 
12090
warn = paste0("\n", warn, "\n\n"), 
12091
ggplot = if(return.ggplot == TRUE){fin.plot}else{NULL}, # fin.plot plots the graph if return == TRUE
12092
gtable = if(return.gtable == TRUE){grob.save}else{NULL} #
12093
)
12094
return(output) # this plots the graph if return.ggplot is TRUE and if no assignment
12095
12096
12097
12098
12099
12100
12101
}
# end outputs
# end main code
}