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

inst/htmljs/animint.js

@@ -358,7 +358,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,28 @@
+test_that("facet_wrap 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)
+  )
+  n_facets <- length(unique(task_data$task_id))
+  base_plot <- ggplot() +
+    geom_point(aes(x, y), data = task_data) +
+    facet_wrap(~ task_id, ncol = 1) +
+    theme_bw()
+  viz_list <- list(
+    default = list(plot = base_plot),
+    custom  = list(plot = base_plot + theme_animint(height = 600))
+  )
+  info_list <- lapply(viz_list, animint2HTML)
+  h_list <- lapply(info_list, function(info) {
+    svg_node <- XML::getNodeSet(info$html, "//svg[contains(@id,'plot_plot')]")
+    expect_equal(length(svg_node), 1L)
+    as.numeric(XML::xmlAttrs(svg_node[[1]])[["height"]])
+  })
+  # SVG height must not scale as height * n_facets (regression from issue #279)
+  expect_lt(h_list$default, 400 * n_facets)
+  expect_lt(h_list$custom, 600 * n_facets,
+            label = "SVG height should not be 600*num_facets — regression from issue #279")
+  expect_gt(h_list$custom, h_list$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))
 })