add text argument

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,

NAMESPACE

@@ -60,6 +60,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)

NEWS.md

@@ -1,5 +1,7 @@
 # rphylopic (development version)
 
+* added text argument to get_attribution (#56)
+* get_attribution now handles multiple uuids
 * added browse_phylopic function (#60)
 * added preview argument to get_phylopic (#59)
 

R/get_attribution.R

@@ -3,42 +3,111 @@
 #' 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`.
 #'
-#' @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.
+#' @importFrom knitr combine_words
 #' @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 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)) {
     stop("A `uuid` is required.")
   }
   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 <- combine_words(att, oxford_comma = TRUE)
+      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)
 }

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))
 })