Add get_phylopic() option to use original source file from PhyloPic (#117)

* Add get_phylopic() option to use original source file from PhyloPic

* Fix get_phylopic() usage in pick_phylopic()

* Add tests for source files

* Add to NEWS

Author: willgearty

NAMESPACE

@@ -93,6 +93,7 @@ importFrom(rsvg,rsvg_png)
 importFrom(rsvg,rsvg_svg)
 importFrom(scales,pal_area)
 importFrom(stats,setNames)
+importFrom(tools,file_ext)
 importFrom(utils,URLdecode)
 importFrom(utils,URLencode)
 importFrom(utils,browseURL)

NEWS.md

@@ -4,6 +4,7 @@
 * Fixed a bug in add_phylopic_base() where all names were reported as not returning PhyloPic results when only a single name actually returned no PhyloPic results
 * resolve_phylopic() now will retry API calls if they fail
 * Fixed geom_phylopic() and add_phylopic() under ggplot2 4.0.0 and up (#125)
+* get_phylopic() now has a "source" argument that can be used to retrieve the original source file from the PhyloPic database (#116)
 
 # rphylopic 1.5.0
 

R/get_phylopic.R

@@ -14,6 +14,11 @@
 #' @param format \code{character}. Format of the image. To return a vectorized
 #'   image, use "vector". To return a rasterized image, use "raster" and specify
 #'   a desired `height`.
+#' @param source \code{logical}. If `FALSE` (the default), the vector file
+#'   generated by PhyloPic is used to generate the image in the desired format.
+#'   If `TRUE`, the original source file is used. Note that only PNG and SVG
+#'   source files are supported for the "raster" `format` and only SVG source
+#'   files are supported for the "vector" `format`.
 #' @param height \code{numeric}. If `format` is "raster", this is the desired
 #'   height of the raster image in pixels. This is ignored if `format` is
 #'   "vector".
@@ -25,6 +30,7 @@
 #'   included as the "uuid" and "url" attributes, respectively.
 #' @importFrom grid grid.newpage grid.raster
 #' @importFrom grImport2 grid.picture
+#' @importFrom tools file_ext
 #' @export
 #' @examples \dontrun{
 #' # uuid
@@ -34,8 +40,8 @@
 #' img_svg <- get_phylopic(uuid, format = "vector") # vector format
 #' img_png <- get_phylopic(uuid, format = "raster") # raster format
 #' }
-get_phylopic <- function(uuid = NULL, format = "vector", height = 512,
-                         preview = FALSE) {
+get_phylopic <- function(uuid = NULL, format = "vector", source = FALSE,
+                         height = 512, preview = FALSE) {
   # Error handling -------------------------------------------------------
   if (is.null(uuid)) {
     stop("A `uuid` is required (hint: use `get_uuid()`).")
@@ -60,22 +66,43 @@ get_phylopic <- function(uuid = NULL, format = "vector", height = 512,
     format <- "raster"
   }
   format <- match.arg(as.character(format), c("raster", "vector"))
+  if (!is.logical(source)) {
+    stop("`source` is not of class logical.")
+  }
   image_info <- phy_GET(file.path("images", uuid))$`_links`
   if (format == "raster") { # get raster
-    rasters <- image_info$rasterFiles
-    # check if there is an existing file with the desired height
-    ind <- grepl(paste0("x", height), rasters$sizes)
-    if (any(ind)) {
-      url <- rasters$href[ind]
-      img <- get_png(url)
+    if (source) {
+      url <- image_info$sourceFile$href
     } else {
-      url <- image_info$vectorFile$href
+      rasters <- image_info$rasterFiles
+      # check if there is an existing file with the desired height
+      ind <- grepl(paste0("x", height), rasters$sizes)
+      if (any(ind)) {
+        url <- rasters$href[ind]
+      } else {
+        url <- image_info$vectorFile$href
+      }
+    }
+    ext <- file_ext(url)
+    if (ext == "png") {
+      img <- get_png(url)
+    } else if (ext == "svg") {
       # use the svg to make a png with the desired height
       img <- make_png(url, height)
+    } else {
+      stop("Source file is not a PNG or SVG. Can not generate a raster image.")
     }
     class(img) <- c("phylopic", class(img))
   } else if (format == "vector") { # get vector
-    url <- image_info$vectorFile$href
+    if (source) {
+      url <- image_info$sourceFile$href
+      ext <- file_ext(url)
+      if (ext != "svg") { # I think this is possible now?
+        stop("Source file is not an SVG. Can not generate a vector image.")
+      }
+    } else {
+      url <- image_info$vectorFile$href
+    }
     img <- get_svg(url)
   }
   # Should the image be previewed?

R/pick_phylopic.R

@@ -124,7 +124,8 @@ pick_phylopic <- function(name = NULL, n = 5, uuid = NULL, view = 1,
     # Get image data
     height <- 1024 / ceiling(sqrt(view))
     if (view > 1 && length(uuids[[i]]) > 1) {
-      img <- pblapply(uuids[[i]], get_phylopic, format = "raster", height)
+      img <- pblapply(uuids[[i]], get_phylopic, format = "raster",
+                      height = height)
     } else {
       img <- sapply(uuids[[i]], get_phylopic)
     }

man/get_phylopic.Rd

@@ -8,6 +8,10 @@ test_that("get_phylopic works", {
   expect_true(is(get_phylopic(uuid = uuid, format = "raster"), "array"))
   expect_true(is(get_phylopic(uuid = uuid, format = "raster",
                               height = 300), "array"))
+  expect_true(is(get_phylopic(uuid = uuid, format = "vector", source = TRUE),
+                 "Picture"))
+  expect_true(is(get_phylopic(uuid = uuid, format = "raster", source = TRUE),
+                 "array"))
 
   expect_no_error(get_phylopic(uuid = uuid, preview = TRUE))