From 02c78d1f7506aacc01e61774407e1dc73b9c4ab3 Mon Sep 17 00:00:00 2001
From: "Lewis A. Jones" <41071747+LewisAJones@users.noreply.github.com>
Date: Mon, 11 Mar 2024 17:56:45 +0100
Subject: [PATCH 1/4] Fix #104
---
DESCRIPTION | 2 +-
R/pick_phylopic.R | 3 +++
.../_snaps/geom_phylopic/phylopic-key-glyph-with-img.svg | 2 --
.../geom_phylopic/phylopic-key-glyph-with-larger-glyphs.svg | 4 +---
.../_snaps/geom_phylopic/phylopic-key-glyph-with-uuid.svg | 2 --
tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph.svg | 2 --
6 files changed, 5 insertions(+), 10 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index cebe8443..1d3ed2d5 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -20,7 +20,7 @@ Encoding: UTF-8
LazyData: true
biocViews:
Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
Depends:
R (>= 4.0)
Imports:
diff --git a/R/pick_phylopic.R b/R/pick_phylopic.R
index 889c7119..2cb67db9 100644
--- a/R/pick_phylopic.R
+++ b/R/pick_phylopic.R
@@ -75,8 +75,10 @@ pick_phylopic <- function(name = NULL, n = 5, uuid = NULL, view = 1,
grid.newpage()
grid.picture(img)
# Add text for attribution
+ att <- att[[1]][[1]]
att_string <- paste0("Contributor: ", att$contributor, "\n",
"Created: ", att$created, "\n",
+ "Attribution: ", att$attribution, "\n",
"License: ", att$license)
grid.text(label = att_string,
x = 0.96, y = 0.92,
@@ -126,6 +128,7 @@ pick_phylopic <- function(name = NULL, n = 5, uuid = NULL, view = 1,
}
# Get attribution data
att <- lapply(uuids[[i]], get_attribution)
+ att <- lapply(att, function(x) x[[1]][[1]])
# Attribution text
n_spaces <- 3 + floor(log10(length(att) + 1))
att_string <- lapply(att, function(x) {
diff --git a/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-img.svg b/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-img.svg
index 04689c4e..8f31e562 100644
--- a/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-img.svg
+++ b/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-img.svg
@@ -69,7 +69,6 @@
y
name
-
@@ -81,7 +80,6 @@
-
diff --git a/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-larger-glyphs.svg b/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-larger-glyphs.svg
index d2dc1267..88c3c815 100644
--- a/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-larger-glyphs.svg
+++ b/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-larger-glyphs.svg
@@ -18,7 +18,7 @@
-
+
@@ -69,7 +69,6 @@
y
name
-
@@ -81,7 +80,6 @@
-
diff --git a/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-uuid.svg b/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-uuid.svg
index 8bc4ada0..1a5bfd14 100644
--- a/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-uuid.svg
+++ b/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-uuid.svg
@@ -69,7 +69,6 @@
y
name
-
@@ -81,7 +80,6 @@
-
diff --git a/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph.svg b/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph.svg
index f2f40d6d..9a96168a 100644
--- a/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph.svg
+++ b/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph.svg
@@ -69,7 +69,6 @@
y
name
-
@@ -81,7 +80,6 @@
-
From d9707e2c844f6c8398e6c7de6d276119ea552448 Mon Sep 17 00:00:00 2001
From: "Lewis A. Jones" <41071747+LewisAJones@users.noreply.github.com>
Date: Tue, 12 Mar 2024 08:49:13 +0100
Subject: [PATCH 2/4] add attribution test
---
R/pick_phylopic.R | 13 +++++++++----
man/pick_phylopic.Rd | 6 ++++--
.../geom_phylopic/phylopic-key-glyph-with-img.svg | 2 ++
.../phylopic-key-glyph-with-larger-glyphs.svg | 4 +++-
.../geom_phylopic/phylopic-key-glyph-with-uuid.svg | 2 ++
.../_snaps/geom_phylopic/phylopic-key-glyph.svg | 2 ++
tests/testthat/test-pick_phylo.R | 5 +++++
7 files changed, 27 insertions(+), 7 deletions(-)
diff --git a/R/pick_phylopic.R b/R/pick_phylopic.R
index 2cb67db9..744b4245 100644
--- a/R/pick_phylopic.R
+++ b/R/pick_phylopic.R
@@ -28,8 +28,10 @@ utils::globalVariables(c("x", "y", "uuid", "label"))
#' @param auto \code{numeric}. This argument allows the user to automate input
#' into the menu choice. If the input value is `1`, the first returned image
#' will be selected. If the input value is `2`, requested images will be
-#' automatically cycled through with the final image returned. If `NULL`
-#' (default), the user must interactively respond to the called menu.
+#' automatically cycled through with the final image returned. If the input
+#' value is `3`, a list of attribution information for each image is
+#' returned (this functionality is principally intended for testing). If
+#' `NULL` (default), the user must interactively respond to the called menu.
#'
#' @return A [Picture][grImport2::Picture-class] object is returned. The uuid of
#' the selected image is saved as the "uuid" attribute of the returned object
@@ -60,8 +62,8 @@ utils::globalVariables(c("x", "y", "uuid", "label"))
pick_phylopic <- function(name = NULL, n = 5, uuid = NULL, view = 1,
filter = NULL, auto = NULL) {
# Error handling
- if (!is.null(auto) && !auto %in% c(1, 2)) {
- stop("`auto` must be of value: NULL, 1, or 2")
+ if (!is.null(auto) && !auto %in% c(1, 2, 3)) {
+ stop("`auto` must be of value: NULL, 1, 2, or 3")
}
if (!is.numeric(view)) {
stop("`view` must be of class numeric.")
@@ -177,6 +179,9 @@ pick_phylopic <- function(name = NULL, n = 5, uuid = NULL, view = 1,
m <- n_plotted + 1
} else if (auto == 1) {
m <- 1
+ } else if (auto == 3) {
+ names(att) <- sapply(att, function(x) x$image_uuid)
+ return(att)
}
}
diff --git a/man/pick_phylopic.Rd b/man/pick_phylopic.Rd
index c99c6774..7c7160ee 100644
--- a/man/pick_phylopic.Rd
+++ b/man/pick_phylopic.Rd
@@ -38,8 +38,10 @@ relevant if \code{name} supplied.}
\item{auto}{\code{numeric}. This argument allows the user to automate input
into the menu choice. If the input value is \code{1}, the first returned image
will be selected. If the input value is \code{2}, requested images will be
-automatically cycled through with the final image returned. If \code{NULL}
-(default), the user must interactively respond to the called menu.}
+automatically cycled through with the final image returned. If the input
+value is \code{3}, a list of attribution information for each image is
+returned (this functionality is principally intended for testing). If
+\code{NULL} (default), the user must interactively respond to the called menu.}
}
\value{
A \link[grImport2:Picture-class]{Picture} object is returned. The uuid of
diff --git a/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-img.svg b/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-img.svg
index 8f31e562..04689c4e 100644
--- a/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-img.svg
+++ b/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-img.svg
@@ -69,6 +69,7 @@
y
name
+
@@ -80,6 +81,7 @@
+
diff --git a/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-larger-glyphs.svg b/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-larger-glyphs.svg
index 88c3c815..d2dc1267 100644
--- a/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-larger-glyphs.svg
+++ b/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-larger-glyphs.svg
@@ -18,7 +18,7 @@
-
+
@@ -69,6 +69,7 @@
y
name
+
@@ -80,6 +81,7 @@
+
diff --git a/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-uuid.svg b/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-uuid.svg
index 1a5bfd14..8bc4ada0 100644
--- a/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-uuid.svg
+++ b/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph-with-uuid.svg
@@ -69,6 +69,7 @@
y
name
+
@@ -80,6 +81,7 @@
+
diff --git a/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph.svg b/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph.svg
index 9a96168a..f2f40d6d 100644
--- a/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph.svg
+++ b/tests/testthat/_snaps/geom_phylopic/phylopic-key-glyph.svg
@@ -69,6 +69,7 @@
y
name
+
@@ -80,6 +81,7 @@
+
diff --git a/tests/testthat/test-pick_phylo.R b/tests/testthat/test-pick_phylo.R
index 42e3d07d..220403de 100644
--- a/tests/testthat/test-pick_phylo.R
+++ b/tests/testthat/test-pick_phylo.R
@@ -11,6 +11,11 @@ test_that("pick_phylopic works", {
expect_true(is(pick_phylopic(name = "Bacteria", n = 13,
view = 5, auto = 2),
"Picture"))
+
+ # Test attribution information
+ expect_equal(
+ length(pick_phylopic(name = "Scleractinia", n = 4, view = 4, auto = 3)),
+ 4)
# Expect warning
expect_warning(pick_phylopic(name = "Acropora cervicornis", n = 10))
From d4556e40a9b203ee5020e48470242d62de786f7e Mon Sep 17 00:00:00 2001
From: "Lewis A. Jones" <41071747+LewisAJones@users.noreply.github.com>
Date: Tue, 12 Mar 2024 08:54:02 +0100
Subject: [PATCH 3/4] Update NEWS.md
---
NEWS.md | 1 +
1 file changed, 1 insertion(+)
diff --git a/NEWS.md b/NEWS.md
index c02d2188..bde7db1c 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,6 +2,7 @@
* Added add_phylopic_legend (#83)
* Added permalink generation option to get_attribution (#81)
+* Fix pick_phylopic attribution display bug (#104)
# rphylopic 1.3.0
From 5fd75621d5263c910513380c151f44334032d4c2 Mon Sep 17 00:00:00 2001
From: "Lewis A. Jones" <41071747+LewisAJones@users.noreply.github.com>
Date: Tue, 12 Mar 2024 18:03:44 +0100
Subject: [PATCH 4/4] Update NEWS.md
---
NEWS.md | 1 -
1 file changed, 1 deletion(-)
diff --git a/NEWS.md b/NEWS.md
index bde7db1c..c02d2188 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,7 +2,6 @@
* Added add_phylopic_legend (#83)
* Added permalink generation option to get_attribution (#81)
-* Fix pick_phylopic attribution display bug (#104)
# rphylopic 1.3.0