From 001340f53a396f0b50c7902cfb10d37c5179f72e Mon Sep 17 00:00:00 2001 From: "Lewis A. Jones" <41071747+LewisAJones@users.noreply.github.com> Date: Thu, 29 Jun 2023 18:14:23 +0200 Subject: [PATCH 1/5] add text argument --- NEWS.md | 2 + R/get_attribution.R | 100 +++++++++++++++++++++----- man/get_attribution.Rd | 16 ++++- tests/testthat/test-get_attribution.R | 7 +- 4 files changed, 105 insertions(+), 20 deletions(-) diff --git a/NEWS.md b/NEWS.md index 9ef5d05e..d1f34613 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,8 @@ rphylopic (development version) ============== +* added text argument to get_attribution +* get_attribution now handles multiple uuids * added functions for transforming PhyloPic silhouettes (flipping and rotating) * save_phylopic bg argument updated to be "transparent" by default * added geom_phylopic (#25) diff --git a/R/get_attribution.R b/R/get_attribution.R index 11012771..e2061bc5 100644 --- a/R/get_attribution.R +++ b/R/get_attribution.R @@ -5,19 +5,28 @@ #' #' @param uuid \code{character}. A valid uuid for a PhyloPic silhouette such #' as that returned by [get_uuid()] or [pick_phylopic()]. +#' @param text \code{logical}. Should attribution information be returned as +#' a text paragraph? Defaults to `FALSE`. #' -#' @return A \code{list} of PhyloPic attribution data for an image `uuid`. +#' @return A \code{list} of PhyloPic attribution data for an image `uuid` or +#' a text output of relevant attribution information. #' #' @details This function returns image `uuid` specific attribution data, #' including: contributor name, contributor uuid, contributor contact, -#' image uuid and license. +#' image uuid, license, and license abbreviation. If `text` is set to +#' `TRUE`, a text paragraph with the contributor name, year of contribution, +#' and license type is returned. #' @export #' @examples #' # Get valid uuid #' uuid <- get_uuid(name = "Acropora cervicornis") #' # Get attribution data for uuid #' attri <- get_attribution(uuid = uuid) -get_attribution <- function(uuid = NULL) { +#' # Get valid uuids +#' uuid <- get_uuid(name = "Scleractinia", n = 5) +#' # Get attribution data for uuid +#' get_attribution(uuid = uuid, text = TRUE) +get_attribution <- function(uuid = NULL, text = FALSE) { # Error handling ------------------------------------------------------- if (is.null(uuid)) { stop("A `uuid` is required.") @@ -25,20 +34,79 @@ get_attribution <- function(uuid = NULL) { if (!is.character(uuid)) { stop("`uuid` should be of class character.") } + if (!is.logical(text)) { + stop("`text` should be of class logical.") + } + + # Get licenses --------------------------------------------------------- + links <- c("https://creativecommons.org/publicdomain/zero/1.0/", + "https://creativecommons.org/publicdomain/mark/1.0/", + "https://creativecommons.org/licenses/by/4.0/", + "https://creativecommons.org/licenses/by-sa/3.0/", + "https://creativecommons.org/licenses/by/3.0/", + "https://creativecommons.org/licenses/by-nc-sa/3.0/", + "https://creativecommons.org/licenses/by-nc/3.0/") + abbr <- c("CC0 1.0", + "Public Domain Mark 1.0", + "CC BY 4.0", + "CC BY-SA 3.0", + "CC BY 3.0", + "CC BY-NC-SA 3.0", + "CC BY-NC 3.0") + licenses <- data.frame(links, abbr) + # API call ------------------------------------------------------------- - api_return <- phy_GET(file.path("images", uuid), - list(embed_contributor = "true")) - # Process output ------------------------------------------------------- - att <- list(contributor = api_return$`_embedded`$contributor$name, - contributor_uuid = api_return$`_embedded`$contributor$uuid, - created = substr(x = api_return$`_embedded`$contributor$created, - start = 1, - stop = 10), - contact = gsub( - "mailto:", "", - api_return$`_embedded`$contributor$`_links`$contact), - image_uuid = uuid, - license = api_return$`_links`$license$href) + if (length(uuid) > 1) { + att <- lapply(uuid, get_attribution) + names(att) <- uuid + } else { + api_return <- phy_GET(file.path("images", uuid), + list(embed_contributor = "true")) + # Process output ------------------------------------------------------- + att <- list(contributor = api_return$`_embedded`$contributor$name, + contributor_uuid = api_return$`_embedded`$contributor$uuid, + created = substr(x = api_return$`_embedded`$contributor$created, + start = 1, + stop = 10), + contact = gsub( + "mailto:", "", + api_return$`_embedded`$contributor$`_links`$contact), + image_uuid = uuid, + license = api_return$`_links`$license$href) + # Add license title + att$license_abbr <- licenses$abbr[which(licenses$links == att$license)] + } + # Format data + if (length(uuid) == 1 && text) { + # Text output desired? + if (text) { + att <- paste0("Silhouette was contributed by ", + att$contributor, ", ", + substr(att$created, start = 1, stop = 4), " ", + "(", att$license_abbr, ").") + } + } else if (length(uuid) > 1 && text) { + att <- lapply(att, function (x) { + paste0(x$contributor, ", ", + substr(x$created, start = 1, stop = 4), " ", + "(", x$license_abbr, ")") + }) + # Keep unique items + att <- unique(unlist(att)) + # Convert to string + if (length(att) > 1) { + att[length(att)] <- paste0("and ", att[length(att)]) + att <- paste0("Silhouettes were contributed by ", toString(att), ".") + } else { + att <- paste0("Silhouette was contributed by ", toString(att), ".") + } + } + if (text) { + att <- paste0("Organism silhouettes are from PhyloPic ", + "(https://www.phylopic.org/; T. Michael Keesey, 2023). ", + att) + return(message(att)) + } # Return data ---------------------------------------------------------- return(att) } diff --git a/man/get_attribution.Rd b/man/get_attribution.Rd index 1f3d503e..96bf2c33 100644 --- a/man/get_attribution.Rd +++ b/man/get_attribution.Rd @@ -4,14 +4,18 @@ \alias{get_attribution} \title{Get PhyloPic attribution data} \usage{ -get_attribution(uuid = NULL) +get_attribution(uuid = NULL, text = FALSE) } \arguments{ \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{text}{\code{logical}. Should attribution information be returned as +a text paragraph? Defaults to \code{FALSE}.} } \value{ -A \code{list} of PhyloPic attribution data for an image \code{uuid}. +A \code{list} of PhyloPic attribution data for an image \code{uuid} or +a text output of relevant attribution information. } \description{ This function provides a convenient way to obtain attribution data @@ -20,11 +24,17 @@ for PhyloPic images via an image uuid returned by \code{\link[=get_uuid]{get_uui \details{ This function returns image \code{uuid} specific attribution data, including: contributor name, contributor uuid, contributor contact, -image uuid and license. +image uuid, license, and license abbreviation. If \code{text} is set to +\code{TRUE}, a text paragraph with the contributor name, year of contribution, +and license type is returned. } \examples{ # Get valid uuid uuid <- get_uuid(name = "Acropora cervicornis") # Get attribution data for uuid attri <- get_attribution(uuid = uuid) +# Get valid uuids +uuid <- get_uuid(name = "Scleractinia", n = 5) +# Get attribution data for uuid +get_attribution(uuid = uuid, text = TRUE) } diff --git a/tests/testthat/test-get_attribution.R b/tests/testthat/test-get_attribution.R index e91cd5d9..581f9eb2 100644 --- a/tests/testthat/test-get_attribution.R +++ b/tests/testthat/test-get_attribution.R @@ -2,10 +2,15 @@ test_that("get_attribution works", { skip_if_offline(host = "api.phylopic.org") # Get valid uuid uuid <- get_uuid(name = "Acropora cervicornis") - # Expect equal + # Expect true expect_true(is.list(get_attribution(uuid = uuid))) + expect_true(is.null(get_attribution(uuid = uuid, text = TRUE))) + # Expect equal + uuid <- get_uuid(name = "Scleractinia", n = 5) + expect_equal(length(get_attribution(uuid = uuid)), 5) # Expect error expect_error(get_attribution(uuid = NULL)) expect_error(get_attribution(uuid = 1)) + expect_error(get_attribution(uuid = uuid, text = 1)) }) From c40fa7adc9bbee9f0eb5b935c2e1635a229fa893 Mon Sep 17 00:00:00 2001 From: Will Gearty Date: Fri, 14 Jul 2023 10:30:14 -0400 Subject: [PATCH 2/5] Fix NEWS --- NEWS.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index 04a93d9a..6328a4f7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # rphylopic (development version) +* added text argument to get_attribution (#56) +* get_attribution now handles multiple uuids + # rphylopic 1.1.1 * Minor fixes for Fedora @@ -7,8 +10,6 @@ # rphylopic 1.1.0 -* added text argument to get_attribution -* get_attribution now handles multiple uuids * added functions for transforming PhyloPic silhouettes (flipping and rotating) * save_phylopic bg argument updated to be "transparent" by default * added geom_phylopic (#25) From 1d29f1b235256b89666f22242931d46bd451cbd0 Mon Sep 17 00:00:00 2001 From: Will Gearty Date: Fri, 14 Jul 2023 11:00:27 -0400 Subject: [PATCH 3/5] Be more explicit in new example --- R/get_attribution.R | 8 ++++---- man/get_attribution.Rd | 8 ++++---- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/R/get_attribution.R b/R/get_attribution.R index e2061bc5..f5aedd83 100644 --- a/R/get_attribution.R +++ b/R/get_attribution.R @@ -22,10 +22,10 @@ #' uuid <- get_uuid(name = "Acropora cervicornis") #' # Get attribution data for uuid #' attri <- get_attribution(uuid = uuid) -#' # Get valid uuids -#' uuid <- get_uuid(name = "Scleractinia", n = 5) -#' # Get attribution data for uuid -#' get_attribution(uuid = uuid, text = TRUE) +#' # Get list of valid uuids +#' uuids <- get_uuid(name = "Scleractinia", n = 5) +#' # Get attribution data for uuids +#' get_attribution(uuid = uuids, text = TRUE) get_attribution <- function(uuid = NULL, text = FALSE) { # Error handling ------------------------------------------------------- if (is.null(uuid)) { diff --git a/man/get_attribution.Rd b/man/get_attribution.Rd index 96bf2c33..0fe3c838 100644 --- a/man/get_attribution.Rd +++ b/man/get_attribution.Rd @@ -33,8 +33,8 @@ and license type is returned. uuid <- get_uuid(name = "Acropora cervicornis") # Get attribution data for uuid attri <- get_attribution(uuid = uuid) -# Get valid uuids -uuid <- get_uuid(name = "Scleractinia", n = 5) -# Get attribution data for uuid -get_attribution(uuid = uuid, text = TRUE) +# Get list of valid uuids +uuids <- get_uuid(name = "Scleractinia", n = 5) +# Get attribution data for uuids +get_attribution(uuid = uuids, text = TRUE) } From 31ec8a2ed4ab7881290f2af86bf06921e0ba98ab Mon Sep 17 00:00:00 2001 From: "Lewis A. Jones" <41071747+LewisAJones@users.noreply.github.com> Date: Tue, 18 Jul 2023 21:52:04 +0200 Subject: [PATCH 4/5] Address review --- NAMESPACE | 1 + R/get_attribution.R | 7 ++++--- man/get_attribution.Rd | 4 ++-- 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index f3cd0ac5..9b5aa45a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -59,6 +59,7 @@ importFrom(grid,rasterGrob) importFrom(httr,GET) importFrom(httr,content) importFrom(jsonlite,fromJSON) +importFrom(knitr,combine_words) importFrom(methods,is) importFrom(methods,slotNames) importFrom(pbapply,pblapply) diff --git a/R/get_attribution.R b/R/get_attribution.R index f5aedd83..3c9ffb1b 100644 --- a/R/get_attribution.R +++ b/R/get_attribution.R @@ -3,8 +3,8 @@ #' This function provides a convenient way to obtain attribution data #' for PhyloPic images via an image uuid returned by [get_uuid()]. #' -#' @param uuid \code{character}. A valid uuid for a PhyloPic silhouette such -#' as that returned by [get_uuid()] or [pick_phylopic()]. +#' @param uuid \code{character}. A vector of valid uuid(s) for PhyloPic +#' silhouette(s) such as that returned by [get_uuid()] or [pick_phylopic()]. #' @param text \code{logical}. Should attribution information be returned as #' a text paragraph? Defaults to `FALSE`. #' @@ -16,6 +16,7 @@ #' image uuid, license, and license abbreviation. If `text` is set to #' `TRUE`, a text paragraph with the contributor name, year of contribution, #' and license type is returned. +#' @importFrom knitr combine_words #' @export #' @examples #' # Get valid uuid @@ -95,7 +96,7 @@ get_attribution <- function(uuid = NULL, text = FALSE) { att <- unique(unlist(att)) # Convert to string if (length(att) > 1) { - att[length(att)] <- paste0("and ", att[length(att)]) + att <- combine_words(att, oxford_comma = TRUE) att <- paste0("Silhouettes were contributed by ", toString(att), ".") } else { att <- paste0("Silhouette was contributed by ", toString(att), ".") diff --git a/man/get_attribution.Rd b/man/get_attribution.Rd index 0fe3c838..f64e515a 100644 --- a/man/get_attribution.Rd +++ b/man/get_attribution.Rd @@ -7,8 +7,8 @@ get_attribution(uuid = NULL, text = FALSE) } \arguments{ -\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{uuid}{\code{character}. A vector of valid uuid(s) for PhyloPic +silhouette(s) such as that returned by \code{\link[=get_uuid]{get_uuid()}} or \code{\link[=pick_phylopic]{pick_phylopic()}}.} \item{text}{\code{logical}. Should attribution information be returned as a text paragraph? Defaults to \code{FALSE}.} From 9e613381ae07112be5e761eb255d1a9caf317700 Mon Sep 17 00:00:00 2001 From: Will Gearty Date: Tue, 18 Jul 2023 16:12:32 -0400 Subject: [PATCH 5/5] Move knitr to imports --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f73449dc..eb9ae90e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,11 +35,11 @@ Imports: curl, methods, lifecycle, - pbapply + pbapply, + knitr Suggests: testthat (>= 3.0.0), vdiffr (>= 1.0.0), - knitr, rmarkdown, covr, phytools,