Add attribution option to plotting functions

NEWS.md

@@ -6,6 +6,7 @@
 * added preview argument to get_phylopic (#59)
 * switched to {maps} package in base R advanced vignette
 * added img argument to get_uuid and get_attribution
+* added verbose argument (calls get_attribution) to geom_phylopic, add_phylopic, and add_phylopic_base (#71)
 
 # rphylopic 1.1.1
 

R/add_phylopic.r

@@ -25,6 +25,8 @@
 #'   clockwise. The default is no rotation.
 #' @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
+#'   used silhouettes be printed to the console (see [get_attribution()])?
 #' @details One (and only one) of `img`, `name`, or `uuid` must be specified.
 #'   Use parameters `x`, `y`, and `ysize` to place the silhouette at a specified
 #'   position on the plot. The aspect ratio of the silhouette will always be
@@ -72,7 +74,7 @@ add_phylopic <- function(img = NULL, name = NULL, uuid = NULL,
                          x, y, ysize = Inf,
                          alpha = 1, color = "black",
                          horizontal = FALSE, vertical = FALSE, angle = 0,
-                         remove_background = TRUE) {
+                         remove_background = TRUE, verbose = FALSE) {
   if (all(sapply(list(img, name, uuid), is.null))) {
     stop("One of `img`, `name`, or `uuid` is required.")
   }
@@ -97,7 +99,7 @@ add_phylopic <- function(img = NULL, name = NULL, uuid = NULL,
   args <- list(geom = GeomPhylopic, x = x, y = y, size = ysize,
                alpha = alpha, color = color,
                horizontal = horizontal, vertical = vertical, angle = angle,
-               remove_background = remove_background)
+               remove_background = remove_background, verbose = verbose)
   # Only include the one silhouette argument
   if (!is.null(img)) {
     if (is.list(img)) {

R/add_phylopic_base.r

@@ -27,6 +27,8 @@
 #'   clockwise. The default is no rotation.
 #' @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
+#'   used silhouettes be printed to the console (see [get_attribution()])?
 #' @details One (and only one) of `img`, `name`, or `uuid` must be specified.
 #'   Use parameters `x`, `y`, and `ysize` to place the silhouette at a specified
 #'   position on the plot. If all three of these parameters are unspecified,
@@ -82,11 +84,11 @@
 #' add_phylopic_base(img = cat, alpha = 0.2)
 #' # overlay smaller cats
 #' add_phylopic_base(img = cat, x = posx, y = posy, ysize = size, alpha = 0.8)
 add_phylopic_base <- function(img = NULL, name = NULL, uuid = NULL,
                               x = NULL, y = NULL, ysize = NULL,
                               alpha = 1, color = "black",
                               horizontal = FALSE, vertical = FALSE, angle = 0,
-                              remove_background = TRUE) {
+                              remove_background = TRUE, verbose = FALSE) {
   if (all(sapply(list(img, name, uuid), is.null))) {
     stop("One of `img`, `name`, or `uuid` is required.")
   }
@@ -101,17 +103,22 @@
     if (!is.character(name)) {
       stop("`name` should be of class character.")
     }
+    if (!verbose) {
+      warning(paste("You've used the `name` argument. You may want to use",
+                    "`verbose = TRUE` to get attribution information",
+                    "for the silhouettes."), call. = FALSE)
+    }
     # Get PhyloPic for each unique name
     name_unique <- unique(name)
     imgs <- sapply(name_unique, function(x) {
-      url <- tryCatch(get_uuid(name = x, url = TRUE),
+      id <- tryCatch(get_uuid(name = x),
                       error = function(cond) NA)
-      if (is.na(url)) {
+      if (is.na(id)) {
         warning(paste0("`name` ", '"', x, '"',
                        " returned no PhyloPic results."))
         return(NULL)
       }
-      get_svg(url)
+      get_phylopic(id)
     })
     imgs <- imgs[name]
   } else if (!is.null(uuid)) {
@@ -139,6 +146,9 @@
     }
     imgs <- img
   }
+  if (verbose) {
+    get_attribution(img = imgs, text = TRUE)
+  }
 
   # get plot limits
   usr <- par()$usr
@@ -169,7 +179,7 @@
     # grobify and plot
     if (is(img, "Picture")) { # svg
       if ("summary" %in% slotNames(img) &&
           all(c("xscale", "yscale") %in% slotNames(img@summary)) &&
           is.numeric(img@summary@xscale) && length(img@summary@xscale) == 2 &&
           all(is.finite(img@summary@xscale)) && diff(img@summary@xscale) != 0 &&
           is.numeric(img@summary@yscale) && length(img@summary@yscale) == 2 &&
@@ -182,5 +192,5 @@
       grid.raster(img, x = x, y = y, height = ysize)
     }
   }, img = imgs, x = x, y = y, ysize = ysize, alpha = alpha, color = color,
      horizontal = horizontal, vertical = vertical, angle = angle))
 }

R/geom_phylopic.R

@@ -38,14 +38,16 @@
 #' - vertical
 #' - angle
 #'
-#' Learn more about setting these aesthetics in [add_phylopic()].
+#'   Learn more about setting these aesthetics in [add_phylopic()].
 #'
 #' @param show.legend logical. Should this layer be included in the legends?
 #'   `FALSE`, the default, never includes, `NA` includes if any aesthetics are
 #'   mapped, and `TRUE` always includes. It can also be a named logical vector
 #'   to finely select the aesthetics to display.
 #' @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
+#'   used silhouettes be printed to the console (see [get_attribution()])?
 #' @inheritParams ggplot2::layer
 #' @inheritParams ggplot2::geom_point
 #' @importFrom ggplot2 layer
@@ -61,13 +63,17 @@
 geom_phylopic <- function(mapping = NULL, data = NULL,
                           stat = "identity", position = "identity",
                           ...,
                           na.rm = FALSE,
                           show.legend = FALSE,
                           inherit.aes = TRUE,
-                          remove_background = TRUE) {
+                          remove_background = TRUE,
+                          verbose = FALSE) {
   if (!is.logical(remove_background)) {
     stop("`remove_background` should be a logical value.")
   }
+  if (!is.logical(verbose)) {
+    stop("`verbose` should be a logical value.")
+  }
   layer(
     data = data,
     mapping = mapping,
@@ -79,6 +85,7 @@
     params = list(
       na.rm = na.rm,
       remove_background = remove_background,
+      verbose = verbose,
       ...
     )
   )
@@ -94,7 +101,7 @@
   default_aes = aes(size = 1.5, alpha = 1, color = "black",
                     horizontal = FALSE, vertical = FALSE, angle = 0),
   draw_panel = function(self, data, panel_params, coord, na.rm = FALSE,
-                        remove_background = TRUE) {
+                        remove_background = TRUE, verbose = FALSE) {
     # Clean and transform data
     data <- remove_missing(data, na.rm = na.rm, c("img", "name", "uuid"))
     data <- coord$transform(data, panel_params)
@@ -113,20 +120,25 @@
 
     # Check supplied data types and retrieve silhouettes if need be
     if (cols["name"]) {
+      if (!verbose) {
+        warning(paste("You've used the `name` aesthetic/argument. You may want",
+                      "to use `verbose = TRUE` to get attribution information",
+                      "for the silhouettes."), call. = FALSE)
+      }
       if (!is.character(data$name)) {
         stop("The `name` aesthetic should be of class character.")
       }
       # Get PhyloPic for each unique name
       name_unique <- unique(data$name)
       imgs <- sapply(name_unique, function(name) {
-        url <- tryCatch(get_uuid(name = name, url = TRUE),
+        uuid <- tryCatch(get_uuid(name = name),
                         error = function(cond) NA)
-        if (is.na(url)) {
+        if (is.na(uuid)) {
           warning(paste0("`name` ", '"', name, '"',
-                         " returned no PhyloPic results."))
+                         " returned no PhyloPic results."), call. = FALSE)
           return(NULL)
         }
-        get_svg(url)
+        get_phylopic(uuid)
       })
       imgs <- imgs[data$name]
     } else if (cols["uuid"]) {
@@ -139,7 +151,8 @@
         img <- tryCatch(get_phylopic(uuid),
                         error = function(cond) NULL)
         if (is.null(img)) {
-          warning(paste0('"', uuid, '"', " is not a valid PhyloPic `uuid`."))
+          warning(paste0('"', uuid, '"', " is not a valid PhyloPic `uuid`."),
+                  call. = FALSE)
         }
         img
       })
@@ -153,6 +166,9 @@
       }
       imgs <- data$img
     }
+    if (verbose) {
+      get_attribution(img = imgs, text = TRUE)
+    }
 
     # Calculate height as percentage of y limits
     # (or r limits for polar coordinates)