From c1d231abbb577f7da4bd735e9ba721d3ac15145b Mon Sep 17 00:00:00 2001 From: "Lewis A. Jones" <41071747+LewisAJones@users.noreply.github.com> Date: Sun, 27 Aug 2023 18:53:19 +0200 Subject: [PATCH 1/9] work in progress... --- R/add_phylopic_legend.R | 69 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 69 insertions(+) create mode 100644 R/add_phylopic_legend.R diff --git a/R/add_phylopic_legend.R b/R/add_phylopic_legend.R new file mode 100644 index 0000000..f910976 --- /dev/null +++ b/R/add_phylopic_legend.R @@ -0,0 +1,69 @@ +#' 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 img A [Picture][grImport2::Picture-class] or png array object, e.g., +#' from using [get_phylopic()]. +#' @param name \code{character}. A taxonomic name to be passed to [get_uuid()]. +#' @param uuid \code{character}. A valid uuid for a PhyloPic silhouette (such as +#' that returned by [get_uuid()] or [pick_phylopic()]). +#' @param ysize \code{numeric}. Height of the silhouette(s). The width is +#' determined by the aspect ratio of the original image. +#' @param ... Additional arguments passed to [legend()]. +#' +#' @details +#' Additional details... +#' @export +#' @examples +#' +add_phylopic_legend <- function(img = NULL, name = NULL, uuid = NULL, + ysize = NULL, ...) { + leg_pos <- legend(...) + x <- leg_pos$text$x * 0.95 + y <- leg_pos$text$y + # convert x, y, to normalized device coordinates + # x <- grconvertX(x, to = "ndc") + # y <- grconvertY(y, to = "ndc") + add_phylopic_base(uuid = uuid, + x = x, + y = y, + ysize = ysize) +} + +uuids <- get_uuid(name = "Canis lupus", n = 2) + +plot(0:10, 0:10, type = "n", main = "Wolfs") +add_phylopic_base(uuid = uuids, + x = c(2.5, 7.5), y = c(2.5, 7.5), ysize = 2) +add_phylopic_legend(uuid = uuids, + x = 8, y = 8, legend = c("Wolf 1", "Wolf 2"), + ysize = 0.5) + + + + + + + +# single image +plot(1, 1, type = "n", main = "A cat") +add_phylopic_base(uuid = "23cd6aa4-9587-4a2e-8e26-de42885004c9", + x = 1, y = 1, ysize = 0.4) + +test <- legend("topright", c("Cat"), + pch = NULL) + +add_phylopic_base(uuid = "23cd6aa4-9587-4a2e-8e26-de42885004c9", + x = test$text$x/1.025, y = test$text$y, ysize = 0.05) + + +legend_phylopic <- function(img = NULL, name = NULL, uuid = NULL, size = 0.1, ...) { + leg_pos <- legend(...) + add_phylopic_base(uuid = uuid, + x = leg_pos$text$x/1.05, + y = leg_pos$text$y, + ysize = size) +} + + From 8aa8292bc3f4e1f09a407438eab0d4bc06eee687 Mon Sep 17 00:00:00 2001 From: "Lewis A. Jones" <41071747+LewisAJones@users.noreply.github.com> Date: Thu, 21 Dec 2023 13:38:43 +0100 Subject: [PATCH 2/9] Finish up function, add tests --- NAMESPACE | 2 + R/add_phylopic_legend.R | 93 +++++++-------- man/add_phylopic_legend.Rd | 68 +++++++++++ .../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 | 42 +++++++ 7 files changed, 479 insertions(+), 50 deletions(-) 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 0c4e5e0..810fa95 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/R/add_phylopic_legend.R b/R/add_phylopic_legend.R index f910976..55f3a6d 100644 --- a/R/add_phylopic_legend.R +++ b/R/add_phylopic_legend.R @@ -3,67 +3,60 @@ #' Specify existing images, taxonomic names, or PhyloPic uuids to add PhyloPic #' silhouettes as a legend to an existing base R plot (like [legend()]). #' -#' @param img A [Picture][grImport2::Picture-class] or png array object, e.g., -#' from using [get_phylopic()]. -#' @param name \code{character}. A taxonomic name to be passed to [get_uuid()]. -#' @param uuid \code{character}. A valid uuid for a PhyloPic silhouette (such as -#' that returned by [get_uuid()] or [pick_phylopic()]). -#' @param ysize \code{numeric}. Height of the silhouette(s). The width is +#' @param ysize \code{numeric}. Height of the silhouette. The width is #' determined by the aspect ratio of the original image. +#' @inheritParams add_phylopic_base #' @param ... Additional arguments passed to [legend()]. #' -#' @details -#' Additional details... +#' @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()], such as `pch`. However, in general, +#' arguments for adjusting the legend appearance (not silhouettes) such as +#' text, legend box, etc. are. +#' @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 = "Wolfs") +#' # 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(img = NULL, name = NULL, uuid = NULL, - ysize = NULL, ...) { + ysize = NULL, color = NA, fill = "black", + ...) { + # inherit leg_pos <- legend(...) + # Extract arguments if provided via legend + args <- list(...) + # color values + col <- args[["col"]] + if (!is.null(col)) color <- col + # 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 * 0.95 y <- leg_pos$text$y - # convert x, y, to normalized device coordinates - # x <- grconvertX(x, to = "ndc") - # y <- grconvertY(y, to = "ndc") + # Plot add_phylopic_base(uuid = uuid, x = x, y = y, + color = color, + fill = fill, ysize = ysize) } - -uuids <- get_uuid(name = "Canis lupus", n = 2) - -plot(0:10, 0:10, type = "n", main = "Wolfs") -add_phylopic_base(uuid = uuids, - x = c(2.5, 7.5), y = c(2.5, 7.5), ysize = 2) -add_phylopic_legend(uuid = uuids, - x = 8, y = 8, legend = c("Wolf 1", "Wolf 2"), - ysize = 0.5) - - - - - - - -# single image -plot(1, 1, type = "n", main = "A cat") -add_phylopic_base(uuid = "23cd6aa4-9587-4a2e-8e26-de42885004c9", - x = 1, y = 1, ysize = 0.4) - -test <- legend("topright", c("Cat"), - pch = NULL) - -add_phylopic_base(uuid = "23cd6aa4-9587-4a2e-8e26-de42885004c9", - x = test$text$x/1.025, y = test$text$y, ysize = 0.05) - - -legend_phylopic <- function(img = NULL, name = NULL, uuid = NULL, size = 0.1, ...) { - leg_pos <- legend(...) - add_phylopic_base(uuid = uuid, - x = leg_pos$text$x/1.05, - y = leg_pos$text$y, - ysize = size) -} - - diff --git a/man/add_phylopic_legend.Rd b/man/add_phylopic_legend.Rd new file mode 100644 index 0000000..0b4e6a5 --- /dev/null +++ b/man/add_phylopic_legend.Rd @@ -0,0 +1,68 @@ +% 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( + img = NULL, + name = NULL, + uuid = NULL, + ysize = NULL, + color = NA, + fill = "black", + ... +) +} +\arguments{ +\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 silhouette. 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()}}, such as \code{pch}. However, in general, +arguments for adjusting the legend appearance (not silhouettes) such as +text, legend box, etc. are. +} +\examples{ +# Get UUIDs +uuids <- get_uuid(name = "Canis lupus", n = 2) +# Generate empty plot +plot(0:10, 0:10, type = "n", main = "Wolfs") +# 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 0000000..f4fb985 --- /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 + +Wolfs +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 0000000..6f75548 --- /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 + +Wolfs +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 0000000..6090809 --- /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 + +Wolfs +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 0000000..5dfa8e2 --- /dev/null +++ b/tests/testthat/test-add_phylopic_legend.R @@ -0,0 +1,42 @@ +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 = "Wolfs") + 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.5, 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 = "Wolfs") + 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.5) + }) + + # PhyloPic base R legend with default ysize + expect_doppelganger("PhyloPic base legend default size", function() { + plot(0:10, 0:10, type = "n", main = "Wolfs") + 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")) + }) +}) From 1ded6c12b20c7c82a84c9a8c09a8bb0a0ca97e4c Mon Sep 17 00:00:00 2001 From: "Lewis A. Jones" <41071747+LewisAJones@users.noreply.github.com> Date: Thu, 21 Dec 2023 17:29:34 +0100 Subject: [PATCH 3/9] filter problematic args --- R/add_phylopic_legend.R | 20 ++++++++++++++------ man/add_phylopic_legend.Rd | 6 +++--- 2 files changed, 17 insertions(+), 9 deletions(-) diff --git a/R/add_phylopic_legend.R b/R/add_phylopic_legend.R index 55f3a6d..13cd562 100644 --- a/R/add_phylopic_legend.R +++ b/R/add_phylopic_legend.R @@ -11,9 +11,9 @@ #' @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()], such as `pch`. However, in general, -#' arguments for adjusting the legend appearance (not silhouettes) such as -#' text, legend box, etc. are. +#' with [add_phylopic_legend()], such as `pch` and `lwd`. However, in general, +#' arguments for adjusting the legend appearance such as text (e.g. `cex`), +#' legend box (e.g. `bg`), and color (e.g. `border`) are. #' @importFrom graphics legend #' @export #' @examples @@ -33,13 +33,21 @@ add_phylopic_legend <- function(img = NULL, name = NULL, uuid = NULL, ysize = NULL, color = NA, fill = "black", ...) { - # inherit - leg_pos <- legend(...) - # Extract arguments if provided via legend + # Get supplied arguments args <- list(...) + # Filter unrequired arguments + dump <- c("lty", "lwd", "pch", "angle", "density", "pt.lwd", "merge") + if (any(names(args) %in% dump)) { + args <- args[-which(names(args) %in% dump)] + } + # Do call + leg_pos <- do.call(legend, 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 diff --git a/man/add_phylopic_legend.Rd b/man/add_phylopic_legend.Rd index 0b4e6a5..62256a1 100644 --- a/man/add_phylopic_legend.Rd +++ b/man/add_phylopic_legend.Rd @@ -47,9 +47,9 @@ silhouettes as a legend to an existing base R plot (like \code{\link[=legend]{le 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()}}, such as \code{pch}. However, in general, -arguments for adjusting the legend appearance (not silhouettes) such as -text, legend box, etc. are. +with \code{\link[=add_phylopic_legend]{add_phylopic_legend()}}, such as \code{pch} and \code{lwd}. However, in general, +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. } \examples{ # Get UUIDs From 355332aa396176028a14c0d6c32594e57a8043a6 Mon Sep 17 00:00:00 2001 From: "Lewis A. Jones" <41071747+LewisAJones@users.noreply.github.com> Date: Thu, 21 Dec 2023 17:32:02 +0100 Subject: [PATCH 4/9] Update NEWS.md --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index a8db0fd..09949f8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,6 +9,7 @@ * pick_phylopic now accepts a list of uuids via the uuid argument (#95) * fixed check behavior on CRAN (all tests and examples are now skipped) * caught a rare error when nothing matched `filter` +* Added add_phylopic_legend (#83) # rphylopic 1.2.2 From ecb00d9ddd3a622a8d461f8f9ec7f7fba80ffab8 Mon Sep 17 00:00:00 2001 From: "Lewis A. Jones" <41071747+LewisAJones@users.noreply.github.com> Date: Thu, 21 Dec 2023 17:45:25 +0100 Subject: [PATCH 5/9] reduce x-axis shift --- R/add_phylopic_legend.R | 2 +- .../phylopic-base-legend-args.svg | 22 +++++++++---------- .../phylopic-base-legend-default-size.svg | 22 +++++++++---------- .../phylopic-base-legend.svg | 22 +++++++++---------- tests/testthat/test-add_phylopic_legend.R | 5 +++-- 5 files changed, 37 insertions(+), 36 deletions(-) diff --git a/R/add_phylopic_legend.R b/R/add_phylopic_legend.R index 13cd562..971748a 100644 --- a/R/add_phylopic_legend.R +++ b/R/add_phylopic_legend.R @@ -58,7 +58,7 @@ add_phylopic_legend <- function(img = NULL, name = NULL, uuid = NULL, 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 * 0.95 + x <- leg_pos$text$x * 0.98 y <- leg_pos$text$y # Plot add_phylopic_base(uuid = uuid, 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 index f4fb985..5343012 100644 --- a/tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend-args.svg +++ b/tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend-args.svg @@ -83,25 +83,25 @@ 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 index 6f75548..dad669a 100644 --- 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 @@ -83,25 +83,25 @@ 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 index 6090809..98d6a0b 100644 --- a/tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend.svg +++ b/tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend.svg @@ -83,25 +83,25 @@ Wolf 2 - - + + - - - - + + + + - - + + - - - + + + diff --git a/tests/testthat/test-add_phylopic_legend.R b/tests/testthat/test-add_phylopic_legend.R index 5dfa8e2..d699247 100644 --- a/tests/testthat/test-add_phylopic_legend.R +++ b/tests/testthat/test-add_phylopic_legend.R @@ -12,7 +12,8 @@ test_that("add_phylopic_legend works", { 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.5, color = "black", fill = c("blue", "green"), + ysize = 0.25, color = "black", + fill = c("blue", "green"), x = "bottomright", legend = c("Wolf 1", "Wolf 2"), bg = "lightgrey") }) @@ -26,7 +27,7 @@ test_that("add_phylopic_legend works", { add_phylopic_legend(uuid = uuids, x = "bottomright", legend = c("Wolf 1", "Wolf 2"), col = "black", pt.bg = c("blue", "green"), - pt.cex = 0.5) + pt.cex = 0.25) }) # PhyloPic base R legend with default ysize From a26f1e80196f9dc90e9096639d5628e0623152a9 Mon Sep 17 00:00:00 2001 From: William Gearty Date: Thu, 21 Dec 2023 15:25:31 -0500 Subject: [PATCH 6/9] Add to pkgdown index --- _pkgdown.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index 48374c6..29f8fd4 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. From ee9c56602779186866d6428090eb6ca9cb446487 Mon Sep 17 00:00:00 2001 From: William Gearty Date: Thu, 21 Dec 2023 15:29:45 -0500 Subject: [PATCH 7/9] Move news --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 09949f8..5a701bb 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 @@ -9,7 +11,6 @@ * pick_phylopic now accepts a list of uuids via the uuid argument (#95) * fixed check behavior on CRAN (all tests and examples are now skipped) * caught a rare error when nothing matched `filter` -* Added add_phylopic_legend (#83) # rphylopic 1.2.2 From 03f2f0ea5cc331c86eeb491e6cdb207bfb9802c0 Mon Sep 17 00:00:00 2001 From: "Lewis A. Jones" <41071747+LewisAJones@users.noreply.github.com> Date: Fri, 22 Dec 2023 20:40:53 +0100 Subject: [PATCH 8/9] Address review --- R/add_phylopic_legend.R | 42 ++++++++++++------- man/add_phylopic_legend.Rd | 35 ++++++++++++---- .../phylopic-base-legend-args.svg | 24 +++++------ .../phylopic-base-legend-default-size.svg | 24 +++++------ .../phylopic-base-legend.svg | 24 +++++------ tests/testthat/test-add_phylopic_legend.R | 6 +-- 6 files changed, 93 insertions(+), 62 deletions(-) diff --git a/R/add_phylopic_legend.R b/R/add_phylopic_legend.R index 971748a..d395081 100644 --- a/R/add_phylopic_legend.R +++ b/R/add_phylopic_legend.R @@ -3,24 +3,35 @@ #' Specify existing images, taxonomic names, or PhyloPic uuids to add PhyloPic #' silhouettes as a legend to an existing base R plot (like [legend()]). #' -#' @param ysize \code{numeric}. Height of the silhouette. The width is -#' determined by the aspect ratio of the original image. +#' @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()], such as `pch` and `lwd`. However, in general, -#' arguments for adjusting the legend appearance such as text (e.g. `cex`), -#' legend box (e.g. `bg`), and color (e.g. `border`) are. +#' @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 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 = "Wolfs") +#' plot(0:10, 0:10, type = "n", main = "Wolves") #' # Add data points #' add_phylopic_base(uuid = uuids, #' color = "black", fill = c("blue", "green"), @@ -30,18 +41,21 @@ #' ysize = 0.5, color = "black", fill = c("blue", "green"), #' x = "bottomright", legend = c("Wolf 1", "Wolf 2"), #' bg = "lightgrey") -add_phylopic_legend <- function(img = NULL, name = NULL, uuid = NULL, +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(...) + 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", "pch", "angle", "density", "pt.lwd", "merge") + 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(legend, args) + leg_pos <- do.call(what = legend, args = args) # Extract arguments if provided via legend for plotting # color values col <- args[["col"]] @@ -58,7 +72,7 @@ add_phylopic_legend <- function(img = NULL, name = NULL, uuid = NULL, 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 * 0.98 + x <- (leg_pos$text$x + leg_pos$rect$left) / 2 y <- leg_pos$text$y # Plot add_phylopic_base(uuid = uuid, diff --git a/man/add_phylopic_legend.Rd b/man/add_phylopic_legend.Rd index 62256a1..db7aed4 100644 --- a/man/add_phylopic_legend.Rd +++ b/man/add_phylopic_legend.Rd @@ -5,6 +5,9 @@ \title{Add a PhyloPic legend for a base R plot} \usage{ add_phylopic_legend( + x, + y = NULL, + legend, img = NULL, name = NULL, uuid = NULL, @@ -15,6 +18,16 @@ add_phylopic_legend( ) } \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()}}.} @@ -23,8 +36,8 @@ from using \code{\link[=get_phylopic]{get_phylopic()}}.} \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 silhouette. The width is -determined by the aspect ratio of the original image.} +\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 @@ -44,18 +57,22 @@ 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()}}, such as \code{pch} and \code{lwd}. However, in general, -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. +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 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 = "Wolfs") +plot(0:10, 0:10, type = "n", main = "Wolves") # Add data points add_phylopic_base(uuid = uuids, color = "black", fill = c("blue", "green"), 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 index 5343012..0f47ff4 100644 --- a/tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend-args.svg +++ b/tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend-args.svg @@ -45,7 +45,7 @@ 8 10 -Wolfs +Wolves 0:10 0:10 @@ -83,25 +83,25 @@ 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 index dad669a..6964896 100644 --- 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 @@ -45,7 +45,7 @@ 8 10 -Wolfs +Wolves 0:10 0:10 @@ -83,25 +83,25 @@ 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 index 98d6a0b..f8c7d9d 100644 --- a/tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend.svg +++ b/tests/testthat/_snaps/add_phylopic_legend/phylopic-base-legend.svg @@ -45,7 +45,7 @@ 8 10 -Wolfs +Wolves 0:10 0:10 @@ -83,25 +83,25 @@ Wolf 2 - - + + - - - - + + + + - - + + - - - + + + diff --git a/tests/testthat/test-add_phylopic_legend.R b/tests/testthat/test-add_phylopic_legend.R index d699247..b66fde5 100644 --- a/tests/testthat/test-add_phylopic_legend.R +++ b/tests/testthat/test-add_phylopic_legend.R @@ -7,7 +7,7 @@ test_that("add_phylopic_legend works", { # PhyloPic base R legend expect_doppelganger("PhyloPic base legend", function() { - plot(0:10, 0:10, type = "n", main = "Wolfs") + 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) @@ -20,7 +20,7 @@ test_that("add_phylopic_legend works", { # PhyloPic base R legend with legend arguments expect_doppelganger("PhyloPic base legend args", function() { - plot(0:10, 0:10, type = "n", main = "Wolfs") + 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) @@ -32,7 +32,7 @@ test_that("add_phylopic_legend works", { # PhyloPic base R legend with default ysize expect_doppelganger("PhyloPic base legend default size", function() { - plot(0:10, 0:10, type = "n", main = "Wolfs") + 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) From f538f5cb4222d2df26b3edcae0cd9c0e54fc7b31 Mon Sep 17 00:00:00 2001 From: William Gearty Date: Wed, 3 Jan 2024 11:31:47 -0500 Subject: [PATCH 9/9] typo --- R/add_phylopic_legend.R | 2 +- man/add_phylopic_legend.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/add_phylopic_legend.R b/R/add_phylopic_legend.R index d395081..46c5504 100644 --- a/R/add_phylopic_legend.R +++ b/R/add_phylopic_legend.R @@ -20,7 +20,7 @@ #' 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 to +#' `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. diff --git a/man/add_phylopic_legend.Rd b/man/add_phylopic_legend.Rd index db7aed4..998e76f 100644 --- a/man/add_phylopic_legend.Rd +++ b/man/add_phylopic_legend.Rd @@ -62,7 +62,7 @@ to a base R plot. Arguments available in \code{\link[=legend]{legend()}} can be 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 to +\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.