Show plots to users in a higher resolution

pkg-r/DESCRIPTION

@@ -34,6 +34,7 @@ Imports:
     jsonlite,
     knitr,
     later,
+    magick,
     processx,
     promises (>= 1.5.0),
     R6,
@@ -43,6 +44,7 @@ Imports:
     S7,
     sass,
     shinychat (> 0.4.0),
+    svglite,
     utils
 Suggests:
     bit64,
@@ -58,7 +60,6 @@ Suggests:
     pins,
     plotly,
     pkgload,
-    ragg,
     readr,
     rmarkdown,
     shiny (>= 1.11.1),

pkg-r/R/plot-output.R

@@ -4,18 +4,18 @@ is_ggplot <- function(x) {
 
 render_plot_image <- function(plot, alt) {
   dims <- plot_dimensions()
-  path <- tempfile("commons-plot-", fileext = ".png")
+  path <- tempfile("commons-plot-", fileext = ".svg")
   on.exit(unlink(path), add = TRUE)
-  render_plot_png(plot, path, dims$width, dims$height)
-  model <- ellmer::content_image_file(path, resize = "none")
+  render_plot_svg(plot, path, dims$width, dims$height)
+  model <- model_plot_image(path, dims$width, dims$height)
   list(
     model = model,
     html = sprintf(
       paste0(
         "<img class=\"commons-measure-plot\" ",
-        "src=\"data:image/png;base64,%s\" alt=\"%s\"/>"
+        "src=\"data:image/svg+xml;base64,%s\" alt=\"%s\"/>"
       ),
-      model@data,
+      plot_image_data(path),
       html_escape(alt)
     )
   )
@@ -25,18 +25,36 @@ plot_dimensions <- function() {
   list(width = 768L, height = 512L)
 }
 
-render_plot_png <- function(
+model_plot_image <- function(path, width, height) {
+  # At 72 DPI, the SVG's points map one-to-one to model image pixels.
+  image <- magick::image_read(path, density = 72, strip = TRUE)
+  image <- magick::image_resize(image, sprintf("%dx%d>", width, height))
+  data <- magick::image_write(image, format = "png")
+  ellmer::ContentImageInline("image/png", plot_base64_data(data))
+}
+
+plot_image_data <- function(path) {
+  plot_base64_data(readBin(path, "raw", file.size(path)))
+}
+
+plot_base64_data <- function(data) {
+  gsub("\n", "", jsonlite::base64_enc(data), fixed = TRUE)
+}
+
+render_plot_svg <- function(
   plot,
   path,
   width,
   height,
   call = rlang::caller_env()
 ) {
-  if (requireNamespace("ragg", quietly = TRUE)) {
-    ragg::agg_png(path, width = width, height = height, scaling = 1.5)
-  } else {
-    grDevices::png(path, width = width, height = height)
-  }
+  # svglite sizes its device in inches and writes the resulting viewBox in points.
+  svglite::svglite(
+    path,
+    width = width / 72,
+    height = height / 72,
+    scaling = 1.5
+  )
   tryCatch(
     print(plot),
     finally = grDevices::dev.off()
@@ -45,7 +63,7 @@ render_plot_png <- function(
   size <- file.size(path)
   if (is.na(size) || size == 0) {
     cli::cli_abort(
-      "Plot rendering did not produce a PNG image.",
+      "Plot rendering did not produce an SVG image.",
       call = call
     )
   }

pkg-r/R/run-r.R

@@ -184,9 +184,11 @@ run_r_value <- function(segments) {
       source = NULL,
       plot = {
         flush()
-        out[[length(out) + 1L]] <- ellmer::content_image_file(
+        dims <- plot_dimensions()
+        out[[length(out) + 1L]] <- model_plot_image(
           seg$path,
-          resize = "none"
+          dims$width,
+          dims$height
         )
       },
       warning = buffer <- c(buffer, paste0("Warning: ", seg$text)),
@@ -226,12 +228,8 @@ run_r_html <- function(code, segments) {
     }
     if (seg$type == "plot") {
       plot_html <- c(plot_html, sprintf(
-        "<img class=\"commons-run-r-plot\" src=\"data:image/png;base64,%s\" alt=\"Plot produced by R code\"/>",
-        jsonlite::base64_enc(readBin(
-          seg$path,
-          "raw",
-          file.size(seg$path)
-        ))
+        "<img class=\"commons-run-r-plot\" src=\"data:image/svg+xml;base64,%s\" alt=\"Plot produced by R code\"/>",
+        plot_image_data(seg$path)
       ))
     } else {
       output <- c(

pkg-r/inst/worker/worker.R

@@ -509,12 +509,14 @@ worker_run_code <- function(
     if (is.null(last_plot)) {
       return()
     }
-    path <- tempfile("plot-", fileext = ".png")
-    if (requireNamespace("ragg", quietly = TRUE)) {
-      ragg::agg_png(path, width = plot_width, height = plot_height, scaling = 1.5)
-    } else {
-      grDevices::png(path, width = plot_width, height = plot_height)
-    }
+    path <- tempfile("plot-", fileext = ".svg")
+    # Match the parent process's point-sized SVG device.
+    svglite::svglite(
+      path,
+      width = plot_width / 72,
+      height = plot_height / 72,
+      scaling = 1.5
+    )
     tryCatch(
       grDevices::replayPlot(last_plot),
       finally = grDevices::dev.off()

pkg-r/tests/testthat/helper-commons.R

@@ -16,6 +16,18 @@ test_sales <- function() {
   )
 }
 
+inline_image_dimensions <- function(image) {
+  info <- magick::image_info(magick::image_read(
+    jsonlite::base64_dec(image@data)
+  ))
+  unname(as.integer(info[1, c("width", "height")]))
+}
+
+html_svg_source <- function(html) {
+  data <- sub('.*data:image/svg\\+xml;base64,([^"]+)".*', "\\1", html)
+  rawToChar(jsonlite::base64_dec(data))
+}
+
 test_source <- function() {
   suppressMessages(data_source(sales = test_sales()))
 }

pkg-r/tests/testthat/test-run-r.R

@@ -122,6 +122,14 @@ test_that("run_r returns plots as images and opens the display", {
     res@value
   )
   expect_length(images, 1)
+  expect_identical(images[[1]]@type, "image/png")
+  expect_false(grepl("\n", images[[1]]@data, fixed = TRUE))
+  expect_identical(inline_image_dimensions(images[[1]]), c(768L, 512L))
+  expect_match(
+    html_svg_source(res@extra$display$html),
+    "viewBox='0 0 768.00 512.00'",
+    fixed = TRUE
+  )
   notes <- Filter(
     \(x) S7::S7_inherits(x, ellmer::ContentText),
     res@value
@@ -132,7 +140,11 @@ test_that("run_r returns plots as images and opens the display", {
     logical(1)
   )))
   expect_identical(res@extra$display$open, TRUE)
-  expect_match(res@extra$display$html, "data:image/png;base64,")
+  expect_match(
+    res@extra$display$html,
+    "data:image/svg+xml;base64,",
+    fixed = TRUE
+  )
   expect_match(res@extra$display$html, "commons-run-r-details")
   expect_match(res@extra$display$html, "commons-run-r-code", fixed = TRUE)
   expect_match(res@extra$display$html, "<summary>Details</summary>", fixed = TRUE)
@@ -159,10 +171,18 @@ test_that("run_r collapses code and output above plots", {
   expect_match(res@extra$display$html, "#&gt; private text", fixed = TRUE)
   expect_match(res@extra$display$html, "#&gt; private message", fixed = TRUE)
   expect_match(res@extra$display$html, "#&gt; private warning", fixed = TRUE)
-  expect_match(res@extra$display$html, "data:image/png;base64,")
+  expect_match(
+    res@extra$display$html,
+    "data:image/svg+xml;base64,",
+    fixed = TRUE
+  )
   expect_lt(
     as.integer(regexpr("commons-run-r-details", res@extra$display$html)),
-    as.integer(regexpr("data:image/png;base64,", res@extra$display$html))
+    as.integer(regexpr(
+      "data:image/svg+xml;base64,",
+      res@extra$display$html,
+      fixed = TRUE
+    ))
   )
 })
 

pkg-r/tests/testthat/test-tools.R

@@ -204,6 +204,14 @@ test_that("call_measure_tool shows ggplot results to the model and user", {
   )
 
   expect_length(images, 1)
+  expect_identical(images[[1]]@type, "image/png")
+  expect_false(grepl("\n", images[[1]]@data, fixed = TRUE))
+  expect_identical(inline_image_dimensions(images[[1]]), c(768L, 512L))
+  expect_match(
+    html_svg_source(res@extra$display$html),
+    "viewBox='0 0 768.00 512.00'",
+    fixed = TRUE
+  )
   notes <- Filter(
     \(x) S7::S7_inherits(x, ellmer::ContentText),
     res@value