feat: random_image_ext() — Lorem Picsum images for Shiny prototyping (closes #8)

DESCRIPTION

@@ -27,6 +27,7 @@ Imports:
     DT,
     dygraphs,
     ggplot2 (>= 3.0.0),
+    htmltools,
     magrittr,
     plotly,
     stats,
@@ -36,4 +37,4 @@ Suggests:
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.1
+RoxygenNote: 7.3.3

NAMESPACE

@@ -7,12 +7,14 @@ export(random_dygraph)
 export(random_ggplot)
 export(random_ggplotly)
 export(random_image)
+export(random_image_ext)
 export(random_lm)
 export(random_print)
 export(random_table)
 export(random_text)
 importFrom(DT,datatable)
 importFrom(attempt,stop_if_all)
+importFrom(attempt,stop_if_not)
 importFrom(dygraphs,dygraph)
 importFrom(ggplot2,aes)
 importFrom(ggplot2,coord_flip)
@@ -42,6 +44,7 @@ importFrom(ggplot2,stat)
 importFrom(ggplot2,theme_minimal)
 importFrom(ggplot2,xlim)
 importFrom(ggplot2,ylim)
+importFrom(htmltools,img)
 importFrom(magrittr,"%>%")
 importFrom(plotly,ggplotly)
 importFrom(stats,HoltWinters)
@@ -50,3 +53,4 @@ importFrom(stats,lm)
 importFrom(stats,predict)
 importFrom(stats,rnorm)
 importFrom(stats,shapiro.test)
+importFrom(utils,URLencode)

NEWS.md

@@ -1,3 +1,6 @@
 # shinipsum 0.0.0.9000
 
+* New `random_image_ext()`: returns an `<img>` tag pointing at the
+  [Lorem Picsum](https://picsum.photos/) API, with `width` / `height` / `seed`
+  arguments, for quick Shiny UI prototyping (#8, thanks @feddelegrand7).
 * Added a `NEWS.md` file to track changes to the package.

R/random_image_ext.R

@@ -0,0 +1,49 @@
+#' A Random External Image from the Lorem Picsum API
+#'
+#' Returns an `<img>` tag pointing at a random image served by the
+#' [Lorem Picsum](https://picsum.photos/) API, ready to be dropped inside a
+#' Shiny UI for quick prototyping. No network request is performed by this
+#' function: only the URL is built, the image is fetched by the browser.
+#'
+#' @param width,height image dimensions, in pixels. Single positive
+#'   (finite, whole) numbers.
+#' @param seed optional seed making the picked image stable across calls. Any
+#'   atomic scalar; it is coerced to a string and URL-encoded. When `NULL`
+#'   (default), a fresh random image is served on every request.
+#'
+#' @importFrom htmltools img
+#' @importFrom attempt stop_if_not
+#' @importFrom utils URLencode
+#'
+#' @return an `<img>` [htmltools::tag][htmltools::tags]
+#'
+#' @export
+#'
+#' @examples
+#' random_image_ext()
+#' random_image_ext(width = 400, height = 600, seed = "caramba")
+random_image_ext <- function(width = 400, height = 400, seed = NULL) {
+  valid_dim <- function(.x) {
+    is.numeric(.x) && length(.x) == 1L && is.finite(.x) &&
+      .x >= 1 && .x == round(.x)
+  }
+  stop_if_not(width, valid_dim, "`width` must be a single positive integer")
+  stop_if_not(height, valid_dim, "`height` must be a single positive integer")
+
+  if (is.null(seed)) {
+    src <- sprintf("https://picsum.photos/%.0f/%.0f", width, height)
+  } else {
+    stop_if_not(
+      seed,
+      ~ is.atomic(.x) && length(.x) == 1L && !is.na(.x),
+      "`seed` must be a single non-missing atomic value (or NULL)"
+    )
+    src <- sprintf(
+      "https://picsum.photos/seed/%s/%.0f/%.0f",
+      URLencode(as.character(seed), reserved = TRUE),
+      width, height
+    )
+  }
+
+  img(src = src)
+}

tests/testthat/test-image-ext.R

@@ -0,0 +1,59 @@
+context("test-image-ext.R")
+
+test_that("random_image_ext returns an <img> tag pointing at picsum", {
+  i <- random_image_ext()
+  expect_is(i, "shiny.tag")
+  expect_equal(i$name, "img")
+  expect_equal(i$attribs$src, "https://picsum.photos/400/400")
+})
+
+test_that("width and height go into the URL", {
+  expect_equal(
+    random_image_ext(width = 200, height = 300)$attribs$src,
+    "https://picsum.photos/200/300"
+  )
+})
+
+test_that("seed is included and URL-encoded", {
+  expect_equal(
+    random_image_ext(seed = "caramba")$attribs$src,
+    "https://picsum.photos/seed/caramba/400/400"
+  )
+  expect_equal(
+    random_image_ext(width = 100, height = 150, seed = "a b/c")$attribs$src,
+    "https://picsum.photos/seed/a%20b%2Fc/100/150"
+  )
+})
+
+test_that("width / height are validated", {
+  expect_error(random_image_ext(width = 0), "width")
+  expect_error(random_image_ext(width = -10), "width")
+  expect_error(random_image_ext(width = 1.5), "width")
+  expect_error(random_image_ext(width = c(100, 200)), "width")
+  expect_error(random_image_ext(width = NA), "width")
+  expect_error(random_image_ext(width = "100"), "width")
+  expect_error(random_image_ext(height = 0), "height")
+  expect_error(random_image_ext(height = "x"), "height")
+  # tricky numerics fail with the friendly message, not a low-level error
+  expect_error(random_image_ext(width = Inf), "width")
+  expect_error(random_image_ext(width = NaN), "width")
+  expect_error(random_image_ext(width = 1e400), "width")
+  expect_error(random_image_ext(width = 1 + 0i), "width")
+  expect_error(random_image_ext(width = TRUE), "width")
+})
+
+test_that("seed is validated", {
+  expect_error(random_image_ext(seed = c("a", "b")), "seed")
+  expect_error(random_image_ext(seed = NA), "seed")
+  expect_error(random_image_ext(seed = character(0)), "seed")
+  expect_error(random_image_ext(seed = list("a")), "seed")
+  # numeric / other atomic scalars are coerced to character
+  expect_equal(
+    random_image_ext(seed = 42)$attribs$src,
+    "https://picsum.photos/seed/42/400/400"
+  )
+  expect_equal(
+    random_image_ext(seed = TRUE)$attribs$src,
+    "https://picsum.photos/seed/TRUE/400/400"
+  )
+})