From 030b5e8502e817d34f73b3a8a96968ef63d00213 Mon Sep 17 00:00:00 2001 From: "Lewis A. Jones" <41071747+LewisAJones@users.noreply.github.com> Date: Wed, 3 Jan 2024 16:54:05 +0000 Subject: [PATCH] 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 --- NAMESPACE | 2 + NEWS.md | 2 + R/add_phylopic_legend.R | 84 ++++++++++++++ _pkgdown.yml | 1 + man/add_phylopic_legend.Rd | 85 ++++++++++++++ .../phylopic-base-legend-args.svg | 108 ++++++++++++++++++ .../phylopic-base-legend-default-size.svg | 108 ++++++++++++++++++ .../phylopic-base-legend.svg | 108 ++++++++++++++++++ tests/testthat/test-add_phylopic_legend.R | 43 +++++++ 9 files changed, 541 insertions(+) create mode 100644 R/add_phylopic_legend.R create mode 100644 man/add_phylopic_legend.Rd create mode 100644 tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend-args.svg create mode 100644 tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend-default-size.svg create mode 100644 tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend.svg create mode 100644 tests/testthat/test-add_phylopic_legend.R diff --git a/NAMESPACE b/NAMESPACE index 0c4e5e0b..810fa951 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index a8db0fd8..5a701bb9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # rphylopic (development version) +* Added add_phylopic_legend (#83) + # rphylopic 1.3.0 * updated citation diff --git a/R/add_phylopic_legend.R b/R/add_phylopic_legend.R new file mode 100644 index 00000000..46c55047 --- /dev/null +++ b/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) +} diff --git a/_pkgdown.yml b/_pkgdown.yml index 48374c69..29f8fd4f 100644 --- a/_pkgdown.yml +++ b/_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. diff --git a/man/add_phylopic_legend.Rd b/man/add_phylopic_legend.Rd new file mode 100644 index 00000000..998e76fe --- /dev/null +++ b/man/add_phylopic_legend.Rd @@ -0,0 +1,85 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/add_phylopic_legend.R +\name{add_phylopic_legend} +\alias{add_phylopic_legend} +\title{Add a PhyloPic legend for a base R plot} +\usage{ +add_phylopic_legend( + x, + y = NULL, + legend, + img = NULL, + name = NULL, + uuid = NULL, + ysize = NULL, + color = NA, + fill = "black", + ... +) +} +\arguments{ +\item{x}{\code{numeric or character}. Either the x coordinate to be used +to position the legend or a keyword accepted by \code{\link[=legend]{legend()}} such as +"topleft", "topright", "bottomleft", and "bottomright".} + +\item{y}{\code{numeric}. The y coordinate to be used to position the +legend. Can be \code{NULL} (default) if using keywords in \code{x}.} + +\item{legend}{\code{character}. A character vector of the labels to appear +in the legend.} + +\item{img}{A \link[grImport2:Picture-class]{Picture} or png array object, e.g., +from using \code{\link[=get_phylopic]{get_phylopic()}}.} + +\item{name}{\code{character}. A taxonomic name to be passed to \code{\link[=get_uuid]{get_uuid()}}.} + +\item{uuid}{\code{character}. A valid uuid for a PhyloPic silhouette (such as +that returned by \code{\link[=get_uuid]{get_uuid()}} or \code{\link[=pick_phylopic]{pick_phylopic()}}).} + +\item{ysize}{\code{numeric}. Height of the legend silhouette(s). The width +is determined by the aspect ratio of the original image.} + +\item{color}{\code{character}. Color of silhouette outline. If "original" or +NA is specified, the original color of the silhouette outline will be used +(usually the same as "transparent"). To remove the outline, you can set +this to "transparent".} + +\item{fill}{\code{character}. Color of silhouette. If "original" is +specified, the original color of the silhouette will be used (usually the +same as "black"). If \code{color} is specified and \code{fill} is NA, \code{color} will be +used as the fill color (for backwards compatibility). To remove the fill, +you can set this to "transparent".} + +\item{...}{Additional arguments passed to \code{\link[=legend]{legend()}}.} +} +\description{ +Specify existing images, taxonomic names, or PhyloPic uuids to add PhyloPic +silhouettes as a legend to an existing base R plot (like \code{\link[=legend]{legend()}}). +} +\details{ +This function can be used to add PhyloPic silhouettes as a legend +to a base R plot. Arguments available in \code{\link[=legend]{legend()}} can be used and +passed via \code{...}. Note that not all arguments in \code{\link[=legend]{legend()}} are +compatible with \code{\link[=add_phylopic_legend]{add_phylopic_legend()}}. These include arguments for +modifying lines (e.g. \code{lty}, \code{lwd}, \code{seg.len}), points (e.g. \code{pch}, +\code{pt.lwd}), and shading (e.g. \code{angle} and \code{density}). This is due to +\code{\link[=add_phylopic_legend]{add_phylopic_legend()}} using \code{\link[=add_phylopic_base]{add_phylopic_base()}} to generate the +legend symbols. However, arguments for adjusting the legend appearance +such as text (e.g. \code{cex}), legend box (e.g. \code{bg}), and color (e.g. +\code{border}) are compatible. +} +\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") +} diff --git a/tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend-args.svg b/tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend-args.svg new file mode 100644 index 00000000..0f47ff4a --- /dev/null +++ b/tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend-args.svg @@ -0,0 +1,108 @@ + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 +10 + + + + + + + +0 +2 +4 +6 +8 +10 + +Wolves +0:10 +0:10 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Wolf 1 +Wolf 2 + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend-default-size.svg b/tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend-default-size.svg new file mode 100644 index 00000000..69648969 --- /dev/null +++ b/tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend-default-size.svg @@ -0,0 +1,108 @@ + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 +10 + + + + + + + +0 +2 +4 +6 +8 +10 + +Wolves +0:10 +0:10 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Wolf 1 +Wolf 2 + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend.svg b/tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend.svg new file mode 100644 index 00000000..f8c7d9d3 --- /dev/null +++ b/tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend.svg @@ -0,0 +1,108 @@ + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 +10 + + + + + + + +0 +2 +4 +6 +8 +10 + +Wolves +0:10 +0:10 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Wolf 1 +Wolf 2 + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/test-add_phylopic_legend.R b/tests/testthat/test-add_phylopic_legend.R new file mode 100644 index 00000000..b66fde52 --- /dev/null +++ b/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")) + }) +})