Render SVG cells as images in as_gtable() output.

[teunbrand]

Summary

This PR aims to fix #1652.

Briefly, in the as_gtable() approach, it renders cells with the <svg> tags using {rsvg} into raster images. It uses a regex pattern to recognise the tag and switches from a 'render plain text' mode to 'render svg' mode via a new internal function render_grid_svg(). Most of this function's body is just trying to parse dimensions from the svg string.

Related GitHub Issues and PRs

• Ref: Feature request: render SVG cells in as_gtable() output #1652

Checklist

• I understand and agree to the Code of Conduct.
• I have listed any major changes in the NEWS.
• I have added testthat unit tests to tests/testthat for any new functionality.

[CLAassistant]

All committers have signed the CLA.

[teunbrand]

Here are some example of flags and nanoplots.
The images are not always amazing due to anti-aliasing artefacts (see striping in 2nd example), but it is an improvement over showing svg strings over plain text.

library(gt)

countrypops |>
  dplyr::filter(year == 2021) |>
  dplyr::filter(grepl("^S", country_name)) |>
  dplyr::arrange(country_name) |>
  dplyr::select(-country_code_3, -year) |>
  dplyr::slice_head(n = 10) |>
  gt() |>
  cols_move_to_start(columns = country_code_2) |>
  fmt_flag(columns = country_code_2) |>
  as_gtable(plot = TRUE) |>
  invisible()

illness |>
  dplyr::slice_head(n = 10) |>
  gt(rowname_col = "test") |>
  tab_header("Partial summary of daily tests performed on YF patient") |>
  cols_hide(columns = c(starts_with("norm"), units)) |>
  cols_nanoplot(
    columns = starts_with("day"),
    new_col_name = "nanoplots",
    new_col_label = "Progression"
  ) |>
  cols_align(align = "center", columns = nanoplots) |>
  as_gtable(plot = TRUE) |>
  invisible()

sza |>
  dplyr::filter(latitude == 20 & tst <= "1200") |>
  dplyr::select(-latitude) |>
  dplyr::filter(!is.na(sza)) |>
  dplyr::mutate(saa = 90 - sza) |>
  dplyr::select(-sza) |>
  tidyr::pivot_wider(
    names_from = tst,
    values_from = saa,
    names_sort = TRUE
  ) |>
  gt(rowname_col = "month") |>
  tab_header(
    title = "Solar Altitude Angles",
    subtitle = "Average values every half hour from 05:30 to 12:00"
  ) |>
  cols_nanoplot(
    columns = matches("0"),
    plot_type = "bar",
    missing_vals = "zero",
    new_col_name = "saa",
    plot_height = "2.5em",
    options = nanoplot_options(
      data_bar_stroke_color = "GoldenRod",
      data_bar_fill_color = "DarkOrange",
      y_val_fmt_fn = function(x) paste0(vec_fmt_number(x, decimals = 1), "\u00b0") 
    )
  ) |>
  tab_options(
    table.width = px(400),
    column_labels.hidden = TRUE
  ) |>
  cols_align(
    align = "center",
    columns = everything()
  ) |>
  as_gtable(plot = TRUE) |>
  invisible()

^{Created on 2024-05-08 with reprex v2.1.0}

[rich-iannone]

LGTM!

[rich-iannone]

Thank you @teunbrand for contributing this!