diff --git a/pkg-r/DESCRIPTION b/pkg-r/DESCRIPTION index 9b770cbf..c7d36153 100644 --- a/pkg-r/DESCRIPTION +++ b/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), diff --git a/pkg-r/R/plot-output.R b/pkg-r/R/plot-output.R index 1d17a64c..597aa360 100644 --- a/pkg-r/R/plot-output.R +++ b/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( "\"%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 ) } diff --git a/pkg-r/R/run-r.R b/pkg-r/R/run-r.R index 9e5cb5f1..cad60515 100644 --- a/pkg-r/R/run-r.R +++ b/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( - "\"Plot", - jsonlite::base64_enc(readBin( - seg$path, - "raw", - file.size(seg$path) - )) + "\"Plot", + plot_image_data(seg$path) )) } else { output <- c( diff --git a/pkg-r/inst/worker/worker.R b/pkg-r/inst/worker/worker.R index 01e5c7d7..a088b2f9 100644 --- a/pkg-r/inst/worker/worker.R +++ b/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() diff --git a/pkg-r/tests/testthat/helper-commons.R b/pkg-r/tests/testthat/helper-commons.R index 0f44f44c..76a232ef 100644 --- a/pkg-r/tests/testthat/helper-commons.R +++ b/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())) } diff --git a/pkg-r/tests/testthat/test-run-r.R b/pkg-r/tests/testthat/test-run-r.R index c1a235a9..beaed906 100644 --- a/pkg-r/tests/testthat/test-run-r.R +++ b/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, "Details", fixed = TRUE) @@ -159,10 +171,18 @@ test_that("run_r collapses code and output above plots", { expect_match(res@extra$display$html, "#> private text", fixed = TRUE) expect_match(res@extra$display$html, "#> private message", fixed = TRUE) expect_match(res@extra$display$html, "#> 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 + )) ) }) diff --git a/pkg-r/tests/testthat/test-tools.R b/pkg-r/tests/testthat/test-tools.R index a90c536b..728a8387 100644 --- a/pkg-r/tests/testthat/test-tools.R +++ b/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