png serializer with dynamic image size

[logstar]

If you wish to dynamically size images, you will need render and capture the graphical output yourself and return the contents with the appropriate Content-Type header. See the existing image renderers as a model of how to do this.

-- https://www.rplumber.io/articles/rendering-output.html#customizing-image-serializers viewed on 10/18/2021

According to the above documentation, a png serializer with dynamic image sizes can be implemented with the current plumber framework. This issue is a feature request for creating a friendly and stable interface for users to directly use png serializer with dynamic image sizes.

I attempted to implement a png serializer with dynamic image sizes, dyn_param_png_serializer, which is listed below. However, is dyn_param_png_serializer properly implemented? As plumber::serializer_device apparently also supports async execution, will dyn_param_png_serializer cause async errors? Will dyn_param_png_serializer likely be supported by future plumber versions?

Additionally, expressions inside dyn_param_png_serializer cannot directly access variables in /plot endpoint function, e.g. image_width and myData, but why the passed my_plot_func can be called directly within dyn_param_png_serializer? Is there any pointers on the scope of variables in the context of plumber endpoint function definition, registration, runtime, etc?

dyn_param_png_serializer <- function(plot_func, width, height, res) {
  # print(image_width) # <simpleError in print(image_width): object 'image_width' not found>
  tmpfn <- base::tempfile()

  grDevices::png(tmpfn, width = width, height = height, res = res)
  base::on.exit({base::unlink(tmpfn)}, add = TRUE)

  device_id <- grDevices::dev.cur()

  plot_func()

  grDevices::dev.off(device_id)

  fconn <- base::file(tmpfn, "rb")
  base::on.exit({base::close(fconn)}, add = TRUE)

  img <- base::readBin(fconn, "raw", n = base::file.info(tmpfn)$size)

  return(img)
}


#* Plot out data from the iris dataset
#* @param spec If provided, filter the data to only this species (e.g. 'setosa')
#* @get /plot
#* @serializer contentType list(type="image/png")
function(spec){
  myData <- iris
  title <- "All Species"

  # Filter if the species was specified
  if (!missing(spec)){
    title <- paste0("Only the '", spec, "' Species")
    myData <- subset(iris, Species == spec)
    image_width <- 1000
  } else {
    image_width <- 2000
  }

  my_plot_func <- function() {
    plot(myData$Sepal.Length, myData$Petal.Length,
         main=title, xlab="Sepal Length", ylab="Petal Length")
  }

  img <- dyn_param_png_serializer(my_plot_func, image_width, 1000, 300)

  return(img)
}

This example is adapted from https://www.rplumber.io/articles/introduction.html and

plumber/R/serializer.R

Lines 473 to 535 in 06e46f3

	serializer_device <- function(type, dev_on, dev_off = grDevices::dev.off) {
	stopifnot(!missing(type))
	stopifnot(!missing(dev_on))
	stopifnot(is.function(dev_on))
	stopifnot(length(formals(dev_on)) > 0)
	if (!any(c("filename", "...") %in% names(formals(dev_on)))) {
	stop("`dev_on` must contain an arugment called `filename` or have `...`")
	}
	stopifnot(is.function(dev_off))
	endpoint_serializer(
	serializer = serializer_content_type(type),
	aroundexec_hook = function(..., .next) {
	tmpfile <- tempfile()
	dev_on(filename = tmpfile)
	device_id <- dev.cur()
	dev_off_once <- once(function() dev_off(device_id))
	success <- function(value) {
	dev_off_once()
	if (!file.exists(tmpfile)) {
	stop("The device output file is missing. Did you produce an image?", call. = FALSE)
	}
	con <- file(tmpfile, "rb")
	on.exit({close(con)}, add = TRUE)
	img <- readBin(con, "raw", file.info(tmpfile)$size)
	img
	}
	cleanup <- function() {
	dev_off_once()
	on.exit({
	# works even if the file does not exist
	unlink(tmpfile)
	}, add = TRUE)
	}
	# This is just a flag to ensure we don't cleanup() if the .next(...) is
	# async.
	async <- FALSE
	on.exit({
	if (!async) {
	cleanup()
	}
	}, add = TRUE)
	result <- promises::with_promise_domain(createGraphicsDevicePromiseDomain(device_id), {
	.next(...)
	})
	if (is.promising(result)) {
	async <- TRUE
	result %>% then(success) %>% finally(cleanup)
	} else {
	success(result)
	}
	}
	)
	}

.

[meztez]

I did an example over stackoverflow

https://stackoverflow.com/questions/65098103/plumber-r-render-a-svg-file/65101289#65101289

library(plumber)

device_size <- function() {
  h_ <- 7
  w_ <- 7
  list(
    h = function() h_,
    w = function() w_,
    set_h = function(h) if (!is.null(h)) {h_ <<- as.numeric(h)},
    set_w = function(w) if (!is.null(w)) {w_ <<- as.numeric(w)}
  )
}

output_size <- device_size()

serializer_dynamic_svg <- function(..., type = "image/svg+xml") {
  serializer_device(
    type = type,
    dev_on = function(filename) {
      grDevices::svg(filename,
                     width = output_size$w(),
                     height = output_size$h())
    }
  )
}
register_serializer("svg", serializer_dynamic_svg)

#* @filter dynamic_size
function(req) {
  if (req$PATH_INFO == "/plot") {
    output_size$set_w(req$args$width)
    output_size$set_h(req$args$height)
  }
  plumber::forward()
}

Will revisit

[schloerke]

This is a great solution given the tools available, @meztez !

[schloerke]

@logstar Dynamic sizes is a difficult thing to implement as plumber has to assume that once the endpoint has started running, images are being created. @meztez has skirted around not being able to use the route definition by using a filter to set size information that is later used in the image serialization. This solution still allows for the device to be opened before the route execution begins and for the device to be closed once the route function ends.

However, is dyn_param_png_serializer properly implemented?

I believe so!

Minor adjustments:

• Move the tmp file deletion up to be absolutely sure it leaves no footprint
• Move the graphics device off to an on.exit
• No need for using a file connection to read the binary file. Just use the temp filename as is.

dyn_param_png_serializer <- function(plot_func, width, height, res) {
  tmpfn <- base::tempfile()
  base::on.exit({
    if (file.exists(tmpfn)) {
      unlink(tmpfn)
    }
  }, add = TRUE)

  grDevices::png(tmpfn, width = width, height = height, res = res)
  device_id <- grDevices::dev.cur()
  on.exit({
    grDevices::dev.off(device_id)
  }, add = TRUE)

  plot_func()

  img <- base::readBin(tmpfn, "raw", n = base::file.info(tmpfn)$size)

  return(img)
}

As plumber::serializer_device apparently also supports async execution, will dyn_param_png_serializer cause async errors?
No. (yay!) Once dyn_param_png_serializer() begins its execution, it will not stop. So async code is not allowed to run as the main R session is not free.

Will dyn_param_png_serializer likely be supported by future plumber versions?

I would like to make this experience better. I don't know if it will be this function directly or through something similar to @meztez 's filter solution.

why the passed my_plot_func can be called directly within dyn_param_png_serializer? Is there any pointers on the scope of variables in the context of plumber endpoint function definition, registration, runtime, etc?

Check out https://adv-r.hadley.nz/functions.html?q=lexi#lexical-scoping . The whole book is a great resource for learning the nitty gritty details about R!

Here is a good example from https://prl.ccs.neu.edu/blog/2019/09/10/scoping-in-r/:

x <- 1
f <- function() {
  x
}
g <- function() {
  x <- 2
  f()
}
g() # What does this return?

[zq2323]

I did an example over stackoverflow

https://stackoverflow.com/questions/65098103/plumber-r-render-a-svg-file/65101289#65101289

library(plumber)

device_size <- function() {
  h_ <- 7
  w_ <- 7
  list(
    h = function() h_,
    w = function() w_,
    set_h = function(h) if (!is.null(h)) {h_ <<- as.numeric(h)},
    set_w = function(w) if (!is.null(w)) {w_ <<- as.numeric(w)}
  )
}

output_size <- device_size()

serializer_dynamic_svg <- function(..., type = "image/svg+xml") {
  serializer_device(
    type = type,
    dev_on = function(filename) {
      grDevices::svg(filename,
                     width = output_size$w(),
                     height = output_size$h())
    }
  )
}
register_serializer("svg", serializer_dynamic_svg)

#* @filter dynamic_size
function(req) {
  if (req$PATH_INFO == "/plot") {
    output_size$set_w(req$args$width)
    output_size$set_h(req$args$height)
  }
  plumber::forward()
}

Will revisit

Hi @meztez ,

Thanks for the tips to overwrite the 'png'. I just have one question for the req$args. how can I set values of the width and height in the request. I'm new to the plumber. I try to add them in the endpoint but failed.

here is my code:

#* @parser json
#* @parser multi
#* @serializer png list(width = 600, height = 800)
#* @param width
#* @param height
#* @post /plot
function(req, res,  width, height){
  df <- data.frame(
  gp = factor(rep(letters[1:3], each = 10)),
  y = rnorm(30)
)
ds <- do.call(rbind, lapply(split(df, df$gp), function(d) {
  data.frame(mean = mean(d$y), sd = sd(d$y), gp = d$gp)
}))
p <- ggplot2::ggplot(df, ggplot2::aes(gp, y)) +
  ggplot2::geom_point() +
  ggplot2::geom_point(data = ds, ggplot2::aes(y = mean), colour = 'red', size = 3)

print(p)
}

r <- httr::POST(
  "host://0.0.0.0/plot",
  httr::accept_json(),
  body = list(
    width = jsonlite::toJSON(list(width = 600)) ,
    height = jsonlite::toJSON(list(height = 800))
  ),
  httr::write_disk("test.png"), overwrite = TRUE)

)

[meztez]

http://0.0.0.0/plot?width=100&height=100

[slodge]

Will dyn_param_png_serializer likely be supported by future plumber versions?

I'd love to see this (or the filter version) inside the library. Anything I (or others) can assist with?

---

In addition to the ideas above, I'm wondering about whether to make the content-type itself dynamic - switching between jpeg, png and svg on client demand

[schloerke]

@slodge

This provides a way forward without adding new serializer methods...

• req and res should be added to dev_on() and dev_off()
• dev_on() should accept req and res.
  • Let's keep dev_off() as is unless we see a need to pass in req/res
• Legacy args should be handled for dev_on().
  • Something like if (length(formals(dev_on)) > 1) dev_on(filename, req = req, res = res) else dev_on(filename)
  • If length(formals(dev_on)) > 1 validate that there is req, res, and ....
    • Give error message about ... is for future parameter expansion
  • Please handle this before the call to endpoint_serializer() so that it is O(1) given many route calls
• Any serializer methods that call serializer_device() should be upgraded to handle both the plumber doc args and the appropriate dynamic args.
  • Ex: (untested)

serializer_png <- function(..., type = "image/png") {
  doc_args <- list(...)
  serializer_device(
    type = type,
    dev_on = function(filename, ..., req, res) {
      # Overwrite args that can be dynamic (Possibly more args exist)
      doc_args$width <- req$args$width %||% doc_args$width
      doc_args$height <- req$args$height %||% doc_args$height 
      
      # Open device
      rlang::exec(grDevices::png, filename, !!!doc_args)
    }
  )
}

• Add Breaking changes news entry that parameters like width and height are now dynamic and will effect the image size. To get around this, please change your parameter name.
• Please adjust docs
• Tests for new params

Thank you!

[slodge]

Start of a PR is in.... there is lots of testing and documentation needed if anyone else wants to contribute 👍

Going to need to get the other PRs #889 #891 #892 out of the way before this one can be merged - as there will be merge conflicts around the endpoint, parameter and open api code...

Small nudge: could do with RStudio making decisions on these PRs. Delays will cause extra work ... my memory is fading... making changes gets harder every day :)

[slodge]

PR Redone with personal email... and might have to do it again yet... I have too many email addresses ...