tempo.cat<-base::paste0("ERROR IN ",function.name," OF THE ",package.name," PACKAGE: DIRECTORY PATH INDICATED IN THE lib.path ARGUMENT DOES NOT EXISTS:\n",base::paste(lib.path,collapse="\n"))
tempo.cat<-base::paste0("ERROR IN ",function.name," OF THE ",package.name," PACKAGE: DIRECTORY PATH INDICATED IN THE lib.path ARGUMENT DOES NOT EXISTS:\n",base::paste(lib.path,collapse="\n"))
base::stop(base::paste0("\n\n================\n\n",tempo.cat,"\n\n================\n\n"),call.=FALSE)# == in stop() to be able to add several messages between ==
base::stop(base::paste0("\n\n================\n\n",tempo.cat,"\n\n================\n\n"),call.=FALSE)# == in stop() to be able to add several messages between ==
}else{
}else{
.libPaths(new=base::sub(x=lib.path,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
base::.libPaths(new=base::sub(x=lib.path,pattern="/$|\\\\$",replacement=""))# base::.libPaths(new = ) add path to default path. BEWARE: base::.libPaths() does not support / at the end of a submitted path. Thus check and replace last / or \\ in path
lib.path<-.libPaths()
lib.path<-base::.libPaths()
}
}
}else{
}else{
lib.path<-.libPaths()# .libPaths(new = lib.path) # or .libPaths(new = c(.libPaths(), lib.path))
lib.path<-base::.libPaths()# base::.libPaths(new = lib.path) # or base::.libPaths(new = c(base::.libPaths(), lib.path))
}
}
# end check of lib.path
# end check of lib.path
# check of the required function from the required packages
# check of the required function from the required packages
if(base::any(tempo)){# normally no NA for missing() output
if(base::any(tempo)){# normally no NA for base::missing() output
tempo.cat<-base::paste0("ERROR IN ",function.name," OF THE ",package.name," PACKAGE\nFOLLOWING ARGUMENT",base::ifelse(base::sum(tempo,na.rm=TRUE)>1,"S HAVE","HAS")," NO DEFAULT VALUE AND REQUIRE ONE:\n",base::paste0(mandat.args,collapse="\n"))
tempo.cat<-base::paste0("ERROR IN ",function.name," OF THE ",package.name," PACKAGE\nFOLLOWING ARGUMENT",base::ifelse(base::sum(tempo,na.rm=TRUE)>1,"S HAVE","HAS")," NO DEFAULT VALUE AND REQUIRE ONE:\n",base::paste0(mandat.args,collapse="\n"))
base::stop(base::paste0("\n\n================\n\n",tempo.cat,"\n\n================\n\n"),call.=FALSE)# == in stop() to be able to add several messages between ==
base::stop(base::paste0("\n\n================\n\n",tempo.cat,"\n\n================\n\n"),call.=FALSE)# == in stop() to be able to add several messages between ==
# end second round of checking and data preparation
# end second round of checking and data preparation
# main code
# main code
win.nb<-dev.cur()
win.nb<-grDevices::dev.cur()
pdf(file=NULL)
grDevices::pdf(file=NULL)
tmp<-ggplot2::ggplot_gtable(ggplot_built)
tmp<-ggplot2::ggplot_gtable(ggplot_built)
# BEWARE with ggplot_gtable : open a blanck device https://stackoverflow.com/questions/17012518/why-does-this-r-ggplot2-code-bring-up-a-blank-display-device
# BEWARE with ggplot_gtable : open a blanck device https://stackoverflow.com/questions/17012518/why-does-this-r-ggplot2-code-bring-up-a-blank-display-device
invisible(dev.off())
base::invisible(grDevices::dev.off())
if(win.nb>1){# to go back to the previous active device, if == 1 means no opened device
if(win.nb>1){# to go back to the previous active device, if == 1 means no opened device
#' equivalent to ggplot2::geom_point() but in raster mode use it like ggplot2::geom_point() with the main raster.dpi additional argument.
#' @details
#' can be long to generate the plot.
#' use a square plot region. Otherwise, the dots will have ellipsoid shape.
#' solve the transparency problems with some GUI.
#' this function is derived from the geom_point_rast() function, created by Viktor Petukhov , and present in the ggrastr package (https://rdrr.io/github/VPetukhov/ggrastr/src/R/geom-point-rast.R, MIT License, Copyright (c) 2017 Viktor Petukhov). Has been placed here to minimize package dependencies.
#' @param #classical arguments of geom_point(), shown here https://rdrr.io/github/VPetukhov/ggrastr/man/geom_point_rast.html
#' @param raster.width width of the result image (in inches). Default: deterined by the current device parameters.
#' @param raster.height height of the result image (in inches). Default: deterined by the current device parameters.
#' @param raster.dpi resolution of the result image.
#' @param inactivate logical. Inactivate the fun.name argument of the saferDev::arg_check() function? If TRUE, the name of the saferDev::arg_check() function in error messages coming from this function. Use TRUE if gg_point_rast() is used like this: eval(parse(text = "gg_point_rast")).
#' @param lib.path: character vector specifying the absolute pathways of the directories containing the required packages if not in the default directories. Ignored if NULL.
if(base::all(inactivate==FALSE)){# inactivate has to be used here but will be fully checked below
function.name<-base::paste0(base::as.list(base::match.call(expand.dots=FALSE))[[1]],"()")# function name with "()" paste, which split into a vector of three: c("::()", "package()", "function()") if "package::function()" is used.
if(function.name[1]=="::()"){
function.name<-function.name[3]
}
arg.names<-base::names(base::formals(fun=base::sys.function(base::sys.parent(n=2))))# names of all the arguments
arg.user.setting<-base::as.list(base::match.call(expand.dots=FALSE))[-1]# list of the argument settings (excluding default values not provided by the user)
}elseif(base::all(inactivate==TRUE)){
function.name<-NULL
}else{
tempo.cat<-base::paste0("ERROR IN gg_point_rast(): CODE INCONSISTENCY 1")
base::stop(base::paste0("\n\n================\n\n",tempo.cat,"\n\n================\n\n"),call.=FALSE)# == in stop() to be able to add several messages between ==
if(!base::all(base::typeof(lib.path)=="character")){# no na.rm = TRUE with typeof
tempo.cat<-base::paste0("ERROR IN ",function.name," OF THE ",package.name," PACKAGE: DIRECTORY PATH INDICATED IN THE lib.path ARGUMENT MUST BE A VECTOR OF CHARACTERS:\n",paste(lib.path,collapse="\n"))
base::stop(base::paste0("\n\n================\n\n",tempo.cat,"\n\n================\n\n"),call.=FALSE)# == in stop() to be able to add several messages between ==
}elseif(!base::all(base::dir.exists(lib.path),na.rm=TRUE)){# separation to avoid the problem of tempo$problem == FALSE and lib.path == NA
tempo.cat<-base::paste0("ERROR IN ",function.name," OF THE ",package.name," PACKAGE: DIRECTORY PATH INDICATED IN THE lib.path ARGUMENT DOES NOT EXISTS:\n",base::paste(lib.path,collapse="\n"))
base::stop(base::paste0("\n\n================\n\n",tempo.cat,"\n\n================\n\n"),call.=FALSE)# == in stop() to be able to add several messages between ==
}else{
.libPaths(new=sub(x=lib.path,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
lib.path<-.libPaths()
}
}else{
lib.path<-.libPaths()# .libPaths(new = lib.path) # or .libPaths(new = c(.libPaths(), lib.path))
}
# end check of lib.path
# check of the required function from the required packages
.pack_and_function_check(
fun=base::c(
"Cairo::Cairo",
"ggplot2::ggproto",
"ggplot2::layer",
"ggplot2::GeomPoint",
"grid::grid.cap",
"grid::grid.points",
"grid::popViewport",
"grid::pushViewport",
"grid::rasterGrob",
"grid::viewport",
"saferDev::arg_check"
),
lib.path=NULL,
external.function.name=function.name
)
# end check of the required function from the required packages
# end package checking
# argument primary checking
# arg with no default values
# end arg with no default values
# argument checking with arg_check()
# argument checking
argum.check<-NULL#
text.check<-NULL#
checked.arg.names<-NULL# for function debbuging: used by r_debugging_tools
if(!base::all(dir.exists(lib.path))){# separation to avoid the problem of tempo$problem == FALSE and lib.path == NA
tempo.cat<-base::paste0("ERROR IN ",function.name,": DIRECTORY PATH INDICATED IN THE lib.path ARGUMENT DOES NOT EXISTS:\n",paste(lib.path,collapse="\n"))
# source("C:/Users/gmillot/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.7/r_debugging_tools-v1.7.R") ; eval(parse(text = str_basic_arg_check_dev)) ; eval(parse(text = str_arg_check_with_saferDev::arg_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 saferDev::arg_check()
tempo.arg<-base::names(arg.user.setting)# values provided by the user
tempo.log<-base::suppressWarnings(base::sapply(base::lapply(base::lapply(tempo.arg,FUN=base::get,envir=base::sys.nframe(),inherits=FALSE),FUN=base::is.na),FUN=base::any))&base::lapply(base::lapply(tempo.arg,FUN=base::get,envir=base::sys.nframe(),inherits=FALSE),FUN=base::length)==1L# no argument provided by the user can be just NA
if(base::any(tempo.log)==TRUE){# normally no NA because is.na() used here
tempo.cat<-base::paste0("ERROR IN ",function.name," OF THE ",package.name," PACKAGE\n",base::ifelse(base::sum(tempo.log,na.rm=TRUE)>1,"THESE ARGUMENTS","THIS ARGUMENT")," CANNOT JUST BE NA:",base::paste0(tempo.arg[tempo.log],collapse="\n"))
base::stop(base::paste0("\n\n================\n\n",tempo.cat,"\n\n================\n\n"),call.=FALSE)# == in stop() to be able to add several messages between ==
}
}
# end management of NA arguments
# management of NULL arguments
tempo.arg<-base::c(
"stat",
"position",
"na.rm",
"show.legend",
"inherit.aes",
"raster.dpi",
"inactivate"
# "raster.width", # inactivated because can be null
# "raster.height", # inactivated because can be null
if(base::any(tempo.log)==TRUE){# normally no NA with is.null()
tempo.cat<-base::paste0("ERROR IN ",function.name," OF THE ",package.name," PACKAGE:\n",base::ifelse(base::sum(tempo.log,na.rm=TRUE)>1,"THESE ARGUMENTS\n","THIS ARGUMENT\n"),base::paste0(tempo.arg[tempo.log],collapse="\n"),"\nCANNOT BE NULL")
base::stop(base::paste0("\n\n================\n\n",tempo.cat,"\n\n================\n\n"),call.=FALSE)# == in stop() to be able to add several messages between ==
}
# end management of NULL arguments
# code that protects set.seed() in the global environment
# end code that protects set.seed() in the global environment