test: add regression tests for issue #279 (facet_wrap spacing with custom height)

inst/htmljs/animint.js

@@ -283,7 +283,8 @@ var animint = function (to_select, json_file) {
     var svg = tdLeft.append("svg")
       .attr("id", p_info.plot_id)
       .attr("height", p_info.options.height)
-      .attr("width", p_info.options.width);
+      .attr("width", p_info.options.width)
+      .style("display", "block");
 
     // divvy up width/height based on the panel layout
     var nrows = Math.max.apply(null, p_info.layout.ROW);

tests/testthat/test-issue-279-facet-wrap-custom-height-spacing.R

@@ -0,0 +1,42 @@
+acontext("Issue #279: facet_grid spacing with custom height")
+
+test_that("facet_grid SVG height is proportional to theme_animint height, no excess space (#279)", {
+  skip_on_cran()
+
+  task_data <- data.frame(
+    x = rep(1:5, 5),
+    y = rep(1:5, 5),
+    task_id = rep(c("sonar", "spam", "vowel", "waveform", "zip"), each = 5)
+  )
+
+  viz_default <- list(
+    plot = ggplot() +
+      geom_point(aes(x, y), data = task_data) +
+      facet_grid(task_id ~ .) +
+      theme_bw()
+  )
+
+  viz_custom <- list(
+    plot = ggplot() +
+      geom_point(aes(x, y), data = task_data) +
+      facet_grid(task_id ~ .) +
+      theme_bw() +
+      theme_animint(height = 600)
+  )
+
+  info_default <- animint2HTML(viz_default)
+  info_custom  <- animint2HTML(viz_custom)
+
+  svg_default <- XML::getNodeSet(info_default$html, "//svg[contains(@id,'plot_plot')]")
+  expect_equal(length(svg_default), 1L)
+  h_default <- as.numeric(XML::xmlAttrs(svg_default[[1]])[["height"]])
+  expect_lt(h_default, 400 * 2)
+
+  svg_custom <- XML::getNodeSet(info_custom$html, "//svg[contains(@id,'plot_plot')]")
+  expect_equal(length(svg_custom), 1L)
+  h_custom <- as.numeric(XML::xmlAttrs(svg_custom[[1]])[["height"]])
+
+  expect_lt(h_custom, 600 * 2,
+            label = "SVG height should not be 600*num_facets — regression from issue #279")
+  expect_gt(h_custom, h_default)
+})

tests/testthat/test-renderer3-knit-print.R

@@ -45,8 +45,9 @@ test_that("segments and breakpoints are rendered", {
 
 test_that("svg id property is unique", {
   svg.list <- getNodeSet(html, "//svg")
-  attr.mat <- sapply(svg.list, xmlAttrs)
-  id.counts <- table(attr.mat["id",])
+  attr.list <- lapply(svg.list, xmlAttrs)
+  id.vec <- sapply(attr.list, function(a) a[["id"]])
+  id.counts <- table(id.vec)
   expect_true(all(id.counts==1))
 })