Add img argument to get_

NEWS.md

@@ -5,6 +5,7 @@
 * added browse_phylopic function (#60)
 * added preview argument to get_phylopic (#59)
 * switched to {maps} package in base R advanced vignette
+* added img argument to get_uuid and get_attribution
 
 # rphylopic 1.1.1
 

R/get_attribution.R

@@ -5,6 +5,9 @@
 #'
 #' @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 img A [Picture][grImport2::Picture-class] or png array object from 
+#'   [get_phylopic()]. A list of these objects can also be supplied. If `img`
+#'   is supplied, `uuid` is ignored. Defaults to NULL.
 #' @param text \code{logical}. Should attribution information be returned as 
 #' a text paragraph? Defaults to `FALSE`.
 #'
@@ -27,18 +30,28 @@
 #' 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) {
+get_attribution <- function(uuid = NULL, img = NULL, text = FALSE) {
+  # Handle img -----------------------------------------------------------
+  if (!is.null(img)) {
+    if (is.list(img)) {
+      uuid <- sapply(img, function(x) attr(x, "uuid"))
+    } else {
+      uuid <- attr(img, "uuid")
+    }
+    if (any(is.null(uuid))) {
+      stop("uuid not available. Check `img` is from get_phylopic.")
+    }
+  }
   # Error handling -------------------------------------------------------
   if (is.null(uuid)) {
-    stop("A `uuid` is required.")
+    stop("A `uuid` or `img` 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/",

R/get_uuid.R

@@ -7,6 +7,9 @@
 #' @param name \code{character}. A taxonomic name. Various taxonomic levels
 #'   are supported (e.g. species, genus, family). NULL can also be supplied
 #'   which will skip the taxonomic filtering of the PhyloPic database.
+#' @param img A [Picture][grImport2::Picture-class] or png array object from 
+#'   [get_phylopic()]. A list of these objects can also be supplied. If `img`
+#'   is supplied, `name` and `n` are ignored. Defaults to NULL.
 #' @param n \code{numeric}. How many uuids should be returned? Depending on
 #'   the requested `name`, multiple silhouettes might exist. If `n` exceeds
 #'   the number of available images, all available uuids will be returned.
@@ -26,7 +29,26 @@
 #' @examples
 #' uuid <- get_uuid(name = "Acropora cervicornis")
 #' uuid <- get_uuid(name = "Dinosauria", n = 5, url = TRUE)
-get_uuid <- function(name = NULL, n = 1, url = FALSE) {
+get_uuid <- function(name = NULL, img = NULL, n = 1, url = FALSE) {
+  # Handle img -----------------------------------------------------------
+  if (!is.null(img)) {
+    if (is.list(img)) {
+      uuid <- sapply(img, function(x) attr(x, "uuid"))
+    } else {
+      uuid <- attr(img, "uuid")
+    }
+    if (any(is.null(uuid))) {
+      stop("uuid not available. Check `img` is from get_phylopic.")
+    }
+    if (url) {
+      if (is.list(img)) {
+        uuid <- sapply(img, function(x) attr(x, "url"))
+      } else {
+        uuid <- attr(img, "url")
+      }
+    }
+    return(uuid)
+  }
   # Error handling -------------------------------------------------------
   if (!is.null(name) && !is.character(name)) {
     stop("`name` should be `NULL` or of class character.")

tests/testthat/test-get_attribution.R

@@ -8,9 +8,14 @@ test_that("get_attribution works", {
   # Expect equal
   uuid <- get_uuid(name = "Scleractinia", n = 5)
   expect_equal(length(get_attribution(uuid = uuid)), 5)
+  expect_message(get_attribution(uuid = uuid, text = TRUE))
+  # Check img arg
+  img <- get_phylopic(uuid = uuid[1])
+  expect_true(is.list(get_attribution(img = img)))
 
   # Expect error
   expect_error(get_attribution(uuid = NULL))
   expect_error(get_attribution(uuid = 1))
   expect_error(get_attribution(uuid = uuid, text = 1))
+  expect_error(get_attribution(img = 1))
 })

tests/testthat/test-get_uuid.R

@@ -6,10 +6,15 @@ test_that("get_uuid works", {
   expect_true(is.character(get_uuid(name = "Acropora", n = 1, url = TRUE)))
   expect_true(length(get_uuid(name = NULL, n = 100)) == 100)
   expect_true(length(get_uuid(name = NULL, n = 100, url = TRUE)) == 100)
+  uuid <- get_uuid(name = "Scleractinia")
+  img <- get_phylopic(uuid = uuid)
+  expect_equal(length(get_uuid(img = img)), 1)
+  expect_equal(length(get_uuid(img = img, url = TRUE)), 1)
   # Expect warnings
   expect_warning(is.character(get_uuid(name = "Acropora", n = 50, url = TRUE)))
   # Expect errors
   expect_error(get_uuid(name = 1))
   expect_error(get_uuid(name = "Acropora cervicornis", url = 1))
   expect_error(get_uuid(name = "Acropora cervicornis", n = "5"))
+  expect_error(get_uuid(img = "5d646d5a-b2dd-49cd-b450-4132827ef25e"))
 })