ggjust.R almost done

ggjust.R

+#' @title ggjust
+#' @description
+#' provide correct justification for text labeling, depending on the chosen angle
+#' @param angle integer value of the text angle, using the same rules as in ggplot2. Positive values for counterclockwise rotation: 0 for horizontal, 90 for vertical, 180 for upside down etc. Negative values for clockwise rotation: 0 for horizontal, -90 for vertical, -180 for upside down etc. 
+#' @param pos where text is? Either "top", "right", "bottom" or "left" of the elements to justify from.
+#' @param kind: kind of text? Either "axis" or "text". In the first case, the pos argument refers to the axis position, and in the second to annotated text (using ggplot2::annotate() or ggplot2::geom_text()).
+#' @returns a list containing: $angle: the submitted angle (value potentially reduced to fit the [-360 ; 360] interval, e.g., 460 -> 100, without impact on the final angle displayed); $pos: the selected position (argument pos); $kind: the selected kind of text (argument kind); $hjust: the horizontal justification; $vjust: the vertical justification.
+#' @examples
+#' ggjust(angle = 45, pos = "bottom")
+#' ggjust(angle = (360*2 + 45), pos = "left")
+#' output <- ggjust(angle = 45, pos = "bottom") ; obs1 <- data.frame(time = 1:20, group = rep(c("CLASS_1", "CLASS_2"), times = 10), stringsAsFactors = TRUE) ; ggplot2::ggplot() + ggplot2::geom_bar(data = obs1, mapping = ggplot2::aes(x = group, y = time), stat = "identity") + ggplot2::theme(axis.text.x = ggplot2::element_text(angle = output$angle, hjust = output$hjust, vjust = output$vjust))
+#' output <- ggjust(angle = -45, pos = "left") ; obs1 <- data.frame(time = 1:20, group = rep(c("CLASS_1", "CLASS_2"), times = 10), stringsAsFactors = TRUE) ; ggplot2::ggplot() + ggplot2::geom_bar(data = obs1, mapping = ggplot2::aes(x = group, y = time), stat = "identity") + ggplot2::theme(axis.text.y = ggplot2::element_text(angle = output$angle, hjust = output$hjust, vjust = output$vjust)) + ggplot2::coord_flip()
+#' output1 <- ggjust(angle = 90, pos = "bottom") ; output2 <- ggjust(angle = -45, pos = "left") ; obs1 <- data.frame(time = 1:20, group = rep(c("CLASS_1", "CLASS_2"), times = 10), stringsAsFactors = TRUE) ; ggplot2::ggplot() + ggplot2::geom_bar(data = obs1, mapping = ggplot2::aes(x = group, y = time), stat = "identity") + ggplot2::theme(axis.text.x = ggplot2::element_text(angle = output1$angle, hjust = output1$hjust, vjust = output1$vjust), axis.text.y = ggplot2::element_text(angle = output2$angle, hjust = output2$hjust, vjust = output2$vjust))
+#' output <- ggjust(angle = -45, pos = "left") ; obs1 <- data.frame(time = 1, km = 1, bird = "pigeon", stringsAsFactors = FALSE) ; ggplot2::ggplot(data = obs1, mapping = ggplot2::aes(x = time, y = km)) + ggplot2::geom_point() + ggplot2::geom_text(mapping = ggplot2::aes(label = bird), angle = output$angle, hjust = output$hjust, vjust = output$vjust)
+#' obs1 <- data.frame(time = 1:10, km = 1:10, bird = c(NA, NA, NA, "pigeon", NA, "cat", NA, NA, NA, NA), stringsAsFactors = FALSE) ; fun_open(width = 4, height = 4) ; for(i0 in c("text", "axis")){for(i1 in c("top", "right", "bottom", "left")){for(i2 in c(0, 45, 90, 135, 180, 225, 270, 315, 360)){output <- ggjust(angle = i2, pos = i1, kind = i0) ; title <- paste0("kind: ", i0, " | pos: ", i1, " | angle = ", i2, " | hjust: ", output$hjust, " | vjust: ", output$vjust) ; if(i0 == "text"){print(ggplot2::ggplot(data = obs1, mapping = ggplot2::aes(x = time, y = km)) + ggplot2::geom_point(color = fun_gg_palette(1), alpha = 0.5) + ggplot2::ggtitle(title) + ggplot2::geom_text(mapping = ggplot2::aes(label = bird), angle = output$angle, hjust = output$hjust, vjust = output$vjust) + ggplot2::theme(title = ggplot2::element_text(size = 5)))}else{print(ggplot2::ggplot(data = obs1, mapping = ggplot2::aes(x = time, y = km)) + ggplot2::geom_point(color = fun_gg_palette(1), alpha = 0.5) + ggplot2::ggtitle(title) + ggplot2::geom_text(mapping = ggplot2::aes(label = bird)) + ggplot2::scale_x_continuous(position = ifelse(i1 == "top", "top", "bottom")) + ggplot2::scale_y_continuous(position = ifelse(i1 == "right", "right", "left")) + ggplot2::theme(title = ggplot2::element_text(size = 5), axis.text.x = if(i1 %in% c("top", "bottom")){ggplot2::element_text(angle = output$angle, hjust = output$hjust, vjust = output$vjust)}, axis.text.y = if(i1 %in% c("right", "left")){ggplot2::element_text(angle = output$angle, hjust = output$hjust, vjust = output$vjust)}))}}}} ; dev.off()
+#' @importFrom utils find
+#' @importFrom saferDev arg_check
+#' @details
+#' - justification behave differently on plot, depending whether it is used for annotayed text or for axis labelling. Indeed the latter has labelling constrained.
+#' - Of note, a bug in ggplot2: vjust sometimes does not work, i.e., the same justification result is obtained whatever the value used. This is the case with angle = 90, pos = "top", kind = "axis". While everything is fine with angle = 90, pos = "bottom", kind = "axis". At least, everything seems fine for kind = "axis" and pos = c("left", "bottom").
+#' @export
+ggjust <- function(
+        angle, 
+        pos, 
+        kind = "axis"){
+    # DEBUGGING
+    # angle = 45 ; pos = "left" ; kind = "axis"
+    # package name
+    package.name <- "ggcute"
+    # end package name
+    # function name
+    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)
+    # end function name
+    # critical operator checking
+    .base_op_check(external.function.name = function.name)
+    # end critical operator checking
+    # package checking
+    # check of lib.path
+    # end check of lib.path
+    # check of the required function from the required packages
+    .pack_and_function_check(
+        fun = base::c(
+            "saferDev::arg_check",
+            "utils::find"        
+        ),
+        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
+    mandat.args <- base::c(
+        "angle", 
+        "pos"
+    )
+    tempo <- base::eval(base::parse(text = base::paste0("missing(", base::paste0(mandat.args, collapse = ") | missing("), ")")))
+    if(base::any(tempo)){ # normally no NA for 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"))
+        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 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
+    ee <- base::expression(argum.check <- c(argum.check, tempo$problem) , text.check <- c(text.check, tempo$text) , checked.arg.names <- base::c(checked.arg.names, tempo$object.name))
+    tempo <- saferDev::arg_check(data = angle , class = "integer", length = 1, double.as.integer.allowed = TRUE, neg.values = FALSE, fun.name = function.name) ; base::eval(ee)
+    tempo <- saferDev::arg_check(data = pos, options = c("top", "right", "bottom", "left"), length = 1, fun.name = function.name) ; base::eval(ee)
+    tempo <- saferDev::arg_check(data = kind, options = c("axis", "text"), length = 1, fun.name = function.name) ; base::eval(ee)
+
+    if( ! base::is.null(argum.check)){
+        if(base::any(argum.check, na.rm = TRUE) == TRUE){
+            base::stop(base::paste0("\n\n================\n\n", base::paste(text.check[argum.check], collapse = "\n"), "\n\n================\n\n"), call. = FALSE) #
+        }
+    }
+    # end argument checking with arg_check()
+    # check with r_debugging_tools
+    # source("C:/Users/yhan/Documents/Git_projects/debugging_tools_for_r_dev/r_debugging_tools.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 arg_check()
+    # end check with r_debugging_tools
+    # end argument primary checking
+
+    # second round of checking and data preparation
+    # management of NA arguments
+    if( ! (base::all(base::class(arg.user.setting) == "list", na.rm = TRUE) & base::length(arg.user.setting) == 0)){
+        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(
+        "angle", 
+        "pos", 
+        "kind" 
+    )
+    tempo.log <- base::sapply(base::lapply(tempo.arg, FUN = base::get, envir = base::sys.nframe(), inherits = FALSE), FUN = base::is.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
+    # warning initiation
+    # end warning initiation
+    # end second round of checking and data preparation
+    # main code
+    # to get angle between -360 and 360
+    while(angle > 360){
+        angle <- angle - 360
+    }
+    while(angle < -360){
+        angle <- angle + 360
+    }
+    # end to get angle between -360 and 360
+    # justifications
+    if(pos %in% c("bottom", "top")){
+        # code below is for if(pos == "bottom"){
+        if(any(sapply(FUN = all.equal, c(-360, -180, 0, 180, 360), angle) == TRUE)){ # equivalent of angle == -360 | angle == -180 | angle == 0 | angle == 180 | angle == 360 but deals with floats
+            hjust <- 0.5
+            if(kind == "text"){
+                if(any(sapply(FUN = all.equal, c(-360, 0, 360), angle) == TRUE)){
+                    vjust <- 1
+                }else if(any(sapply(FUN = all.equal, c(-180, 180), angle) == TRUE)){
+                    vjust <- 0
+                }
+            }else{
+                vjust <- 0.5
+            }
+        }else if(any(sapply(FUN = all.equal, c(-270, 90), angle) == TRUE)){
+            hjust <- 1
+            vjust <- 0.5
+        }else if(any(sapply(FUN = all.equal, c(-90, 270), angle) == TRUE)){
+            hjust <- 0
+            vjust <- 0.5
+        }else if((angle > -360 & angle < -270) | (angle > 0 & angle < 90)){
+            hjust <- 1
+            vjust <- 1
+        }else if((angle > -270 & angle < -180) | (angle > 90 & angle < 180)){
+            hjust <- 1
+            vjust <- 0
+        }else if((angle > -180 & angle < -90) | (angle > 180 & angle < 270)){
+            hjust <- 0
+            vjust <- 0
+            if(kind == "text" & pos == "top"){
+                hjust <- 1
+            }
+        }else if((angle > -90 & angle < 0) | (angle > 270 & angle < 360)){
+            hjust <- 0
+            vjust <- 1
+        }
+        if(pos == "top"){
+            if( ! ((angle > -180 & angle < -90) | (angle > 180 & angle < 270))){
+                hjust <- 1 - hjust
+            }
+            vjust <- 1 - vjust
+        }
+    }else if(pos %in% c("left", "right")){
+        # code below is for if(pos == "left"){
+        if(any(sapply(FUN = all.equal, c(-270, -90, 90, 270), angle) == TRUE)){ # equivalent of angle == -270 | angle == -90 | angle == 90 | angle == 270 but deals with floats
+            hjust <- 0.5
+            if(kind == "text"){
+                if(any(sapply(FUN = all.equal, c(-90, 90), angle) == TRUE)){
+                    vjust <- 0
+                }else if(any(sapply(FUN = all.equal, c(-270, 270), angle) == TRUE)){
+                    vjust <- 1
+                }
+            }else{
+                vjust <- 0.5
+            }
+        }else if(any(sapply(FUN = all.equal, c(-360, 0, 360), angle) == TRUE)){
+            hjust <- 1
+            vjust <- 0.5
+        }else if(any(sapply(FUN = all.equal, c(-180, 180), angle) == TRUE)){
+            hjust <- 0
+            vjust <- 0.5
+        }else if((angle > -360 & angle < -270) | (angle > 0 & angle < 90)){
+            hjust <- 1
+            vjust <- 0
+        }else if((angle > -270 & angle < -180) | (angle > 90 & angle < 180)){
+            hjust <- 0
+            vjust <- 0
+        }else if((angle > -180 & angle < -90) | (angle > 180 & angle < 270)){
+            hjust <- 0
+            vjust <- 1
+        }else if((angle > -90 & angle < 0) | (angle > 270 & angle < 360)){
+            hjust <- 1
+            vjust <- 1
+        }
+        if(pos == "right"){
+            hjust <- 1 - hjust
+            if( ! (((angle > -270 & angle < -180) | (angle > 90 & angle < 180)) | ((angle > -180 & angle < -90) | (angle > 180 & angle < 270)))){
+                vjust <- 1 - vjust
+            }
+        }
+    }
+    # end justifications
+    output <- list(angle = angle, pos = pos, kind = kind, hjust = hjust, vjust = vjust)
+    return(output)
+}