Add hjust and vjust arguments to silhouette plotting functions

R/add_phylopic.r

@@ -33,6 +33,16 @@
 #' @param vertical \code{logical}. Should the silhouette be flipped vertically?
 #' @param angle \code{numeric}. The number of degrees to rotate the silhouette
 #'   clockwise. The default is no rotation.
+#' @param hjust \code{numeric}. A numeric vector between 0 and 1 specifying
+#'   horizontal justification (left = 0, center = 0.5, right = 1). Note that,
+#'   due to the enforcement of the silhouette's aspect ratio, there may be
+#'   unexpected behavior due to interactions between the aspect ratio of the
+#'   plot and the aspect ratio of the silhouette.
+#' @param vjust \code{numeric}. A numeric vector between 0 and 1 specifying
+#'   vertical justification (top = 1, middle = 0.5, bottom = 0). Note that, due
+#'   to the enforcement of the silhouette's aspect ratio, there may be
+#'   unexpected behavior due to interactions between the aspect ratio of the
+#'   plot and the aspect ratio of the silhouette.
 #' @param remove_background \code{logical}. Should any white background be
 #'   removed from the silhouette(s)? See [recolor_phylopic()] for details.
 #' @param verbose \code{logical}. Should the attribution information for the
@@ -86,6 +96,7 @@ add_phylopic <- function(img = NULL, name = NULL, uuid = NULL, filter = NULL,
                          x, y, ysize = Inf,
                          alpha = 1, color = NA, fill = "black",
                          horizontal = FALSE, vertical = FALSE, angle = 0,
+                         hjust = 0.5, vjust = 0.5,
                          remove_background = TRUE, verbose = FALSE) {
   if (all(sapply(list(img, name, uuid), is.null))) {
     stop("One of `img`, `name`, or `uuid` is required.")
@@ -110,12 +121,15 @@ add_phylopic <- function(img = NULL, name = NULL, uuid = NULL, filter = NULL,
   horizontal <- rep_len(horizontal, max_len)
   vertical <- rep_len(vertical, max_len)
   angle <- rep_len(angle, max_len)
+  hjust <- rep_len(hjust, max_len)
+  vjust <- rep_len(vjust, max_len)
 
   # Put together all of the variables
   args <- list(geom = GeomPhylopic,
                x = x, y = y, size = ysize,
                alpha = alpha, color = color, fill = fill,
                horizontal = horizontal, vertical = vertical, angle = angle,
+               hjust = hjust, vjust = vjust,
                remove_background = remove_background, verbose = verbose,
                filter = list(filter))
   # Only include the one silhouette argument

R/add_phylopic_base.r

@@ -35,6 +35,16 @@
 #' @param vertical \code{logical}. Should the silhouette be flipped vertically?
 #' @param angle \code{numeric}. The number of degrees to rotate the silhouette
 #'   clockwise. The default is no rotation.
+#' @param hjust \code{numeric}. A numeric vector between 0 and 1 specifying
+#'   horizontal justification (left = 0, center = 0.5, right = 1). Note that,
+#'   due to the enforcement of the silhouette's aspect ratio, there may be
+#'   unexpected behavior due to interactions between the aspect ratio of the
+#'   plot and the aspect ratio of the silhouette.
+#' @param vjust \code{numeric}. A numeric vector between 0 and 1 specifying
+#'   vertical justification (top = 1, middle = 0.5, bottom = 0). Note that, due
+#'   to the enforcement of the silhouette's aspect ratio, there may be
+#'   unexpected behavior due to interactions between the aspect ratio of the
+#'   plot and the aspect ratio of the silhouette.
 #' @param remove_background \code{logical}. Should any white background be
 #'   removed from the silhouette(s)? See [recolor_phylopic()] for details.
 #' @param verbose \code{logical}. Should the attribution information for the
@@ -101,6 +111,7 @@ add_phylopic_base <- function(img = NULL, name = NULL, uuid = NULL,
                               x = NULL, y = NULL, ysize = NULL,
                               alpha = 1, color = NA, fill = "black",
                               horizontal = FALSE, vertical = FALSE, angle = 0,
+                              hjust = 0.5, vjust = 0.5,
                               remove_background = TRUE, verbose = FALSE) {
   if (all(sapply(list(img, name, uuid), is.null))) {
     stop("One of `img`, `name`, or `uuid` is required.")
@@ -111,6 +122,12 @@ add_phylopic_base <- function(img = NULL, name = NULL, uuid = NULL,
   if (any(alpha > 1 | alpha < 0)) {
     stop("`alpha` must be between 0 and 1.")
   }
+  if (any(data$hjust > 1 | data$hjust < 0)) {
+    stop("`hjust` must be between 0 and 1.")
+  }
+  if (any(data$vjust > 1 | data$vjust < 0)) {
+    stop("`vjust` must be between 0 and 1.")
+  }
   if (!is.logical(verbose)) {
     stop("`verbose` should be a logical value.")
   }
@@ -186,7 +203,7 @@ add_phylopic_base <- function(img = NULL, name = NULL, uuid = NULL,
   ysize <- grconvertY(ysize, to = "ndc") - grconvertY(0, to = "ndc")
 
   invisible(mapply(function(img, x, y, ysize, alpha, color, fill,
-                            horizontal, vertical, angle) {
+                            horizontal, vertical, angle, hjust, vjust) {
     if (is.null(img)) return(NULL)
 
     if (horizontal || vertical) img <- flip_phylopic(img, horizontal, vertical)
@@ -209,14 +226,17 @@ add_phylopic_base <- function(img = NULL, name = NULL, uuid = NULL,
           all(is.finite(img@summary@xscale)) && diff(img@summary@xscale) != 0 &&
           is.numeric(img@summary@yscale) && length(img@summary@yscale) == 2 &&
           all(is.finite(img@summary@yscale)) && diff(img@summary@yscale) != 0) {
-        grid.picture(img, x = x, y = y, height = ysize, expansion = 0)
+        grid.picture(img, x = x, y = y, height = ysize, expansion = 0,
+                     just = c(hjust, vjust))
       } else {
         return(NULL)
       }
     } else { # png
-      grid.raster(img, x = x, y = y, height = ysize)
+      grid.raster(img, x = x, y = y, height = ysize,
+                  just = c(hjust, vjust))
     }
   },
   img = imgs, x = x, y = y, ysize = ysize, alpha = alpha, color = color,
-  fill = fill, horizontal = horizontal, vertical = vertical, angle = angle))
+  fill = fill, horizontal = horizontal, vertical = vertical, angle = angle,
+  hjust = hjust, vjust = vjust))
 }

R/geom_phylopic.R

@@ -47,6 +47,8 @@ phylopic_env <- new.env()
 #' - horizontal
 #' - vertical
 #' - angle
+#' - hjust
+#' - vjust
 #'
 #'   Learn more about setting these aesthetics in [add_phylopic()].
 #'
@@ -121,10 +123,12 @@ geom_phylopic <- function(mapping = NULL, data = NULL,
 GeomPhylopic <- ggproto("GeomPhylopic", Geom,
   required_aes = c("x", "y"),
   non_missing_aes = c("size", "alpha", "color", "fill",
-                      "horizontal", "vertical", "angle"),
+                      "horizontal", "vertical", "angle",
+                      "hjust", "vjust"),
   optional_aes = c("img", "name", "uuid"), # one and only one of these
   default_aes = aes(size = 6, alpha = 1, color = NA, fill = "black",
-                    horizontal = FALSE, vertical = FALSE, angle = 0),
+                    horizontal = FALSE, vertical = FALSE, angle = 0,
+                    hjust = 0.5, vjust = 0.5),
   extra_params = c("na.rm", "remove_background", "verbose", "filter"),
   setup_data = function(data, params) {
     # Clean data
@@ -225,6 +229,12 @@ GeomPhylopic <- ggproto("GeomPhylopic", Geom,
     if (any(data$alpha > 1 | data$alpha < 0)) {
       stop("`alpha` must be between 0 and 1.")
     }
+    if (any(data$hjust > 1 | data$hjust < 0)) {
+      stop("`hjust` must be between 0 and 1.")
+    }
+    if (any(data$vjust > 1 | data$vjust < 0)) {
+      stop("`vjust` must be between 0 and 1.")
+    }
 
     # Transform data
     data <- coord$transform(data, panel_params)
@@ -258,6 +268,7 @@ GeomPhylopic <- ggproto("GeomPhylopic", Geom,
         phylopicGrob(data$img[[i]], data$x[i], data$y[i], heights[i],
                      data$colour[i], data$fill[i], data$alpha[i],
                      data$horizontal[i], data$vertical[i], data$angle[i],
+                     data$hjust[i], data$vjust[i],
                      remove_background)
       }
     })
@@ -360,9 +371,10 @@ phylopic_key_glyph <- function(img = NULL, name = NULL, uuid = NULL) {
     } else {
       asp_rat <- aspect_ratio(imgs[[i]])
       height <- unit(ifelse(asp_rat >= 1, .95 / asp_rat, .95), "npc")
-      grob <- phylopicGrob(imgs[[i]], 0.5, 0.5,
+      grob <- phylopicGrob(imgs[[i]], x = 0.5, y = 0.5,
                            height, data$colour[1], data$fill[1], data$alpha[1],
                            data$horizontal[1], data$vertical[1], data$angle[1],
+                           hjust = 0.5, vjust = 0.5,
                            phylopic_env$remove_background)
     }
     if (i == length(imgs)) {
@@ -379,6 +391,7 @@ phylopic_key_glyph <- function(img = NULL, name = NULL, uuid = NULL) {
 #' @importFrom methods slotNames
 phylopicGrob <- function(img, x, y, height, color, fill, alpha,
                          horizontal, vertical, angle,
+                         hjust, vjust,
                          remove_background) {
   # modified from add_phylopic for now
   if (horizontal || vertical) img <- flip_phylopic(img, horizontal, vertical)
@@ -401,15 +414,19 @@ phylopicGrob <- function(img, x, y, height, color, fill, alpha,
       # modified from
       # https://github.com/k-hench/hypoimg/blob/master/R/hypoimg_recolor_svg.R
       img_grob <- pictureGrob(img, x = x, y = y, height = height,
-                              default.units = "native", expansion = 0)
+                              width = height * aspect_ratio(img),
+                              default.units = "native", expansion = 0,
+                              just = c(hjust, vjust))
       img_grob <- gList(img_grob)
       img_grob <- gTree(children = img_grob)
     } else {
       img_grob <- nullGrob()
     }
   } else { # png
     img_grob <- rasterGrob(img, x = x, y = y, height = height,
-                           default.units = "native")
+                           width = height * aspect_ratio(img),
+                           default.units = "native",
+                           just = c(hjust, vjust))
   }
   return(img_grob)
 }