Add PhyloPic base R legend (#99)

* work in progress...

* Finish up function, add tests

* filter problematic args

* Update NEWS.md

* reduce x-axis shift

* Add to pkgdown index

* Move news

* Address review

* typo

---------

Co-authored-by: William Gearty <[email protected]>

NAMESPACE

@@ -12,6 +12,7 @@ S3method(rotate_phylopic,Picture)
 S3method(rotate_phylopic,array)
 export(add_phylopic)
 export(add_phylopic_base)
+export(add_phylopic_legend)
 export(browse_phylopic)
 export(flip_phylopic)
 export(geom_phylopic)
@@ -54,6 +55,7 @@ importFrom(grImport2,pictureGrob)
 importFrom(grImport2,readPicture)
 importFrom(graphics,grconvertX)
 importFrom(graphics,grconvertY)
+importFrom(graphics,legend)
 importFrom(graphics,par)
 importFrom(grid,gList)
 importFrom(grid,gTree)

NEWS.md

@@ -1,5 +1,7 @@
 # rphylopic (development version)
 
+* Added add_phylopic_legend (#83)
+
 # rphylopic 1.3.0
 
 * updated citation

R/add_phylopic_legend.R

@@ -0,0 +1,84 @@
+#' Add a PhyloPic legend for a base R plot
+#'
+#' Specify existing images, taxonomic names, or PhyloPic uuids to add PhyloPic
+#' silhouettes as a legend to an existing base R plot (like [legend()]).
+#'
+#' @param x \code{numeric or character}. Either the x coordinate to be used
+#'   to position the legend or a keyword accepted by [legend()] such as 
+#'   "topleft", "topright", "bottomleft", and "bottomright".
+#' @param y \code{numeric}. The y coordinate to be used to position the 
+#'   legend. Can be `NULL` (default) if using keywords in `x`.
+#' @param legend \code{character}. A character vector of the labels to appear
+#'   in the legend.
+#' @param ysize \code{numeric}. Height of the legend silhouette(s). The width 
+#'   is determined by the aspect ratio of the original image.
+#' @inheritParams add_phylopic_base
+#' @param ... Additional arguments passed to [legend()].
+#'   
+#' @details This function can be used to add PhyloPic silhouettes as a legend
+#'   to a base R plot. Arguments available in [legend()] can be used and
+#'   passed via `...`. Note that not all arguments in [legend()] are
+#'   compatible with [add_phylopic_legend()]. These include arguments for
+#'   modifying lines (e.g. `lty`, `lwd`, `seg.len`), points (e.g. `pch`,
+#'   `pt.lwd`), and shading (e.g. `angle` and `density`). This is due to
+#'   [add_phylopic_legend()] using [add_phylopic_base()] to generate the
+#'   legend symbols. However, arguments for adjusting the legend appearance
+#'   such as text (e.g. `cex`), legend box (e.g. `bg`), and color (e.g.
+#'   `border`) are compatible.
+#' @importFrom graphics legend
+#' @export
+#' @examples
+#' # Get UUIDs
+#' uuids <- get_uuid(name = "Canis lupus", n = 2)
+#' # Generate empty plot
+#' plot(0:10, 0:10, type = "n", main = "Wolves")
+#' # Add data points
+#' add_phylopic_base(uuid = uuids,
+#'   color = "black", fill = c("blue", "green"),
+#'   x = c(2.5, 7.5), y = c(2.5, 7.5), ysize = 2)
+#' # Add legend
+#' add_phylopic_legend(uuid = uuids, 
+#'   ysize = 0.5, color = "black", fill = c("blue", "green"), 
+#'   x = "bottomright", legend = c("Wolf 1", "Wolf 2"),
+#'   bg = "lightgrey")
+add_phylopic_legend <- function(x, y = NULL, legend,
+                                img = NULL, name = NULL, uuid = NULL, 
+                                ysize = NULL, color = NA, fill = "black", 
+                                ...) {
+  # Get supplied arguments
+  args <- list(x = x, y = y, legend = legend, ...)
+  # Remove legend object to avoid issues with do.call
+  remove(legend)
+  # Filter unrequired arguments 
+  dump <- c("lty", "lwd", "seg.len", "pch", "angle", "density", "pt.lwd")
+  if (any(names(args) %in% dump)) {
+    args <- args[-which(names(args) %in% dump)]
+  }
+  # Do call
+  leg_pos <- do.call(what = legend, args = args)
+  # Extract arguments if provided via legend for plotting
+  # color values
+  col <- args[["col"]]
+  if (!is.null(col)) color <- col
+  border <- args[["border"]]
+  if (!is.null(border)) color <- border
+  # fill value
+  bg <- args[["pt.bg"]]
+  if (!is.null(bg)) fill <- bg
+  # size values
+  size <- args[["pt.cex"]]
+  if (!is.null(size)) ysize <- size
+  # Set default ysize if required
+  if (is.null(ysize)) ysize <- (abs(diff(leg_pos$text$y)) * 0.5)
+  # Extract positions
+  # Adjust x position slightly to account for width
+  x <- (leg_pos$text$x + leg_pos$rect$left) / 2
+  y <- leg_pos$text$y
+  # Plot
+  add_phylopic_base(uuid = uuid,
+                    x = x, 
+                    y = y, 
+                    color = color,
+                    fill = fill,
+                    ysize = ysize)
+}

_pkgdown.yml

@@ -39,6 +39,7 @@ reference:
   - phylopic_key_glyph
   - add_phylopic
   - add_phylopic_base
+  - add_phylopic_legend
 - title: Modifying silhouettes
   desc: >
     Functions to modify silhouettes in various ways.

tests/testthat/test-add_phylopic_legend.R

@@ -0,0 +1,43 @@
+test_that("add_phylopic_legend works", {
+  skip_if_offline(host = "api.phylopic.org")
+  try(dev.off(), silent = TRUE) # clean up any stray plots
+
+  # Get UUIDs
+  uuids <- get_uuid(name = "Canis lupus", n = 2)
+
+  # PhyloPic base R legend
+  expect_doppelganger("PhyloPic base legend", function() {
+    plot(0:10, 0:10, type = "n", main = "Wolves")
+    add_phylopic_base(uuid = uuids,
+                      color = "black", fill = c("blue", "green"),
+                      x = c(2.5, 7.5), y = c(2.5, 7.5), ysize = 2)
+    add_phylopic_legend(uuid = uuids, 
+                        ysize = 0.25, color = "black", 
+                        fill = c("blue", "green"), 
+                        x = "bottomright", legend = c("Wolf 1", "Wolf 2"),
+                        bg = "lightgrey")
+  })
+
+  # PhyloPic base R legend with legend arguments
+  expect_doppelganger("PhyloPic base legend args", function() {
+    plot(0:10, 0:10, type = "n", main = "Wolves")
+    add_phylopic_base(uuid = uuids,
+                      color = "black", fill = c("blue", "green"),
+                      x = c(2.5, 7.5), y = c(2.5, 7.5), ysize = 2)
+    add_phylopic_legend(uuid = uuids, 
+                        x = "bottomright", legend = c("Wolf 1", "Wolf 2"),
+                        col = "black", pt.bg = c("blue", "green"),
+                        pt.cex = 0.25)
+  })
+
+  # PhyloPic base R legend with default ysize
+  expect_doppelganger("PhyloPic base legend default size", function() {
+    plot(0:10, 0:10, type = "n", main = "Wolves")
+    add_phylopic_base(uuid = uuids,
+                      color = "black", fill = c("blue", "green"),
+                      x = c(2.5, 7.5), y = c(2.5, 7.5), ysize = 2)
+    add_phylopic_legend(uuid = uuids, 
+                        x = "bottomright", legend = c("Wolf 1", "Wolf 2"),
+                        col = "black", pt.bg = c("blue", "green"))
+  })
+})