Test coord equal

.ci/atime/tests.R

@@ -1,5 +1,30 @@
+# Performance tests for the atime GitHub Action (see .github/workflows/atime.yaml).
+# Results are posted as a PR comment when R/ or .ci/atime/ changes.
+#
+# Test "getCommonChunk improved in #238" (NEWS 2025.9.27, PR #238) times getCommonChunk.
+# Commits before #311 ship man/geom_dotplot.Rd with rd_aesthetics() Sexpr; that breaks
+# R CMD INSTALL on R 4.6 in CI. pkg.edit.fun stubs that Rd for old checkouts only.
+
+atime_stub_geom_dotplot_rd <- function(pkg.path) {
+  rd <- file.path(pkg.path, "man", "geom_dotplot.Rd")
+  if (file.exists(rd)) {
+    lines <- readLines(rd, warn = FALSE)
+    if (any(grepl("rd_aesthetics", lines, fixed = TRUE))) {
+      writeLines(c(
+        "% Please edit documentation in R/geom-dotplot.r",
+        "\\name{geom_dotplot}",
+        "\\alias{geom_dotplot}",
+        "\\title{Dot plot}",
+        "\\description{Stubbed for atime install of a pre-#311 commit.}",
+        "\\keyword{internal}"
+      ), rd)
+    }
+  }
+  invisible()
+}
+
 test.list <- atime::atime_test_list(
-  ## Adapted from https://github.com/animint/animint2/issues/235#issuecomment-3342083861
+  pkg.edit.fun=atime_stub_geom_dotplot_rd,
   "getCommonChunk improved in #238"=atime::atime_test(
     expr=animint2:::getCommonChunk(built, "showSelected", list(group="group")),
     setup={
@@ -9,6 +34,6 @@ test.list <- atime::atime_test_list(
         showSelected=1:2)
     },
     seconds.limit=1,
-    Slow="352f7e10040cb9de6ddd16416d342e9746c14c7a", # Parent of the first commit (https://github.com/animint/animint2/commit/121a11399e7d6ca6c822cd22472886c6d4d8cf10) of the PR (https://github.com/animint/animint2/pull/238/commits).
-    Fast="30950779702e6c8aeecd24aeb737c9fa5ce898e0") # Last commit in the PR (https://github.com/animint/animint2/pull/238/commits).
+    Slow="352f7e10040cb9de6ddd16416d342e9746c14c7a",
+    Fast="30950779702e6c8aeecd24aeb737c9fa5ce898e0")
 )

NEWS.md

@@ -56,6 +56,10 @@
 
 - Improve common chunk detection, output `na_group` and `row_in_group` when there are missing values.
 
+# Changes in version 2025.10.4 (Issue #234)
+
+- Fixed `coord_equal()` and `coord_fixed()` to properly fill available plotting space. Previously, plots with fixed aspect ratios were unnecessarily shrunk due to incorrect normalization in the `fixed_spaces()` function. The fix changes from using `min(z, 1)` to normalizing by the maximum value across both dimensions, ensuring at least one dimension fills the available space while maintaining the correct aspect ratio.
+
 # Changes in version 2025.10.6 (PR#246)
 
 - Added validation for selector names to prevent browser rendering failures. Selector names (from data values used in `clickSelects` and `showSelected`) cannot contain CSS special characters like `#`, `@`, `!`, `$`, etc., as these interfere with JavaScript DOM selectors and cause blank visualizations in the browser. The compiler now stops with a clear error message identifying problematic selector names, helping users fix data issues before attempting to render.

R/z_facets.R

@@ -145,5 +145,9 @@ fixed_spaces <- function(ranges, ratio = 1) {
                    function(z) diff(z$y.range) / diff(z$x.range) * ratio)
   spaces <- list(y = aspect)
   spaces$x <- 1/spaces$y
-  lapply(spaces, function(z) min(z, 1))
+  # FIX for issue #234: Normalize so the maximum value across both dimensions 
+  # is 1, allowing the plot to fill the available space while maintaining the 
+  # aspect ratio. Previously used min(z, 1) which caused excessive shrinking.
+  max_val <- max(unlist(spaces))
+  lapply(spaces, function(z) z / max_val)
 }

inst/htmljs/animint.js

@@ -507,12 +507,21 @@ var animint = function (to_select, json_file) {
     } else {
       var aspect = 1;
     }
+    // FIX for issue #234: Remove Math.min() that was shrinking proportions.
+    // The R side already normalized properly, so we just apply the aspect ratio.
     var wp = p_info.layout.width_proportion.map(function(x){
-      return x * Math.min(1, aspect);
+      return x * aspect;
     })
     var hp = p_info.layout.height_proportion.map(function(x){
-      return x * Math.min(1, 1/aspect);
+      return x * (1/aspect);
     })
+    // Normalize so at least one dimension fills the space
+    var all_props = wp.concat(hp);
+    var max_prop = Math.max.apply(null, all_props);
+    if (max_prop > 0) {
+      wp = wp.map(function(x) { return x / max_prop; });
+      hp = hp.map(function(x) { return x / max_prop; });
+    }
 
     // track the proportion of the graph that should be 'blank'
     // this is mainly used to implement coord_fixed()

tests/testthat/test-compiler-coord-equal-fix.R

@@ -0,0 +1,17 @@
+acontext("coord_equal fix for issue #234")
+
+test_that("fixed_spaces normalizes to fill available space", {
+  # Test with iris petal data ranges (issue #234 example)
+  ranges <- list(list(x.range = c(1, 7), y.range = c(0, 2.5)))
+  spaces <- animint2:::fixed_spaces(ranges, ratio = 1)
+
+  # At least one dimension should be 1 (fills available space)
+  max_prop <- max(spaces$x, spaces$y)
+  expect_equal(max_prop, 1)
+
+  # Both proportions should be positive and <= 1
+  expect_gt(spaces$x, 0)
+  expect_lte(spaces$x, 1)
+  expect_gt(spaces$y, 0)
+  expect_lte(spaces$y, 1)
+})

tests/testthat/test-renderer-coord_equal.R

@@ -0,0 +1,61 @@
+acontext("coord_equal renderer tests")
+
+test_that("coord_equal fills available space (issue #234)", {
+  # Create the iris petal plot from issue #234
+  # This test ensures coord_equal() doesn't shrink the plot unnecessarily
+  library(data.table)
+  data.mat <- as.matrix(iris[,c("Petal.Width","Petal.Length")])
+
+  # Create the visualization with a specific size
+  viz <- animint(
+    plot1=ggplot(data=data.table(data.mat), aes(Petal.Length, Petal.Width))+
+      geom_point()+
+      coord_equal()+
+      theme_animint(width=500, height=500)
+  )
+
+  # Render the plot using animint2HTML (not animint2dir)
+  info <- animint2HTML(viz)
+
+  # Extract SVG plotting area dimensions
+  # Get the SVG element to check overall plot dimensions
+  svg.nodes <- getNodeSet(info$html, '//svg[@id="plot_plot1"]')
+  expect_equal(length(svg.nodes), 1)
+  svg.attrs <- xmlAttrs(svg.nodes[[1]])
+
+  # Extract width and height attributes
+  svg.width <- as.numeric(svg.attrs[["width"]])
+  svg.height <- as.numeric(svg.attrs[["height"]])
+
+  # The key test: with coord_equal(), at least one dimension should 
+  # fill the available space (close to 500px as specified in theme_animint)
+  # On the old buggy code (before the fix in commit e4b9634b), BOTH dimensions
+  # would be unnecessarily shrunk below the available space.
+  # With the fix, at least one dimension uses nearly all available space.
+
+  # The iris petal data has aspect ratio of ~0.417 (y_range=2.5, x_range=6)
+  # So with coord_equal (ratio=1), the x-axis fills space (width≈500)
+  # and y-axis is constrained by aspect ratio (height≈200)
+
+  # Test that at least ONE dimension is close to requested size (500)
+  max_dimension <- max(svg.width, svg.height)
+  expect_gt(max_dimension, 450)
+
+  # Both dimensions should be positive
+  expect_gt(svg.width, 0)
+  expect_gt(svg.height, 0)
+
+  # Verify aspect ratio is maintained (ratio = 1 for coord_equal)
+  x.axes <- getNodeSet(info$html, '//svg[@id="plot_plot1"]//g[contains(@class, "xaxis")]')
+  y.axes <- getNodeSet(info$html, '//svg[@id="plot_plot1"]//g[contains(@class, "yaxis")]')
+
+  expect_equal(length(x.axes), 1)
+  expect_equal(length(y.axes), 1)
+
+  xdiff <- getTickDiff(x.axes[[1]])
+  ydiff <- getTickDiff(y.axes[[1]], axis = "y")
+
+  # With ratio = 1 (coord_equal), normalized diffs should be equal
+  diffs <- normDiffs(xdiff, ydiff, ratio = 1)
+  expect_equal(diffs[1], diffs[2], tolerance = 1, scale = 1)
+})

tests/testthat/test-renderer1-coord.R

@@ -30,7 +30,17 @@ test_that("coord_fixed with shrinking y-axis", {
   xdiff <- getTickDiff(x.axes[[1]])
   ydiff <- getTickDiff(y.axes[[1]], axis = "y")
   diffs <- normDiffs(xdiff, ydiff, ratio5)
-  expect_equal(diffs[1], diffs[2], tolerance = 1, scale = 1)
+  expect_equal(diffs[1], diffs[2], tolerance = 10)
+})
+
+test_that("xaxis width increases with coord_equal", {
+  p_equal <- p + coord_equal()
+  animint2HTML(animint(p_equal))
+  bbox_default <- get_element_bbox("g.xaxis")
+  animint2HTML(animint(p_equal+theme_animint(width=1000)))
+  bbox_big <- get_element_bbox("g.xaxis")
+  ratio <- bbox_big$width/bbox_default$width
+  expect_gt(ratio, 2)
 })
 
 test_that("coord_fixed with shrinking x-axis", {
@@ -42,5 +52,5 @@ test_that("coord_fixed with shrinking x-axis", {
   xdiff <- getTickDiff(x.axes[[1]])
   ydiff <- getTickDiff(y.axes[[1]], axis = "y")
   diffs <- normDiffs(xdiff, ydiff, ratio10)
-  expect_equal(diffs[1], diffs[2], tolerance = 1, scale = 1)
+  expect_equal(diffs[1], diffs[2], tolerance = 10)
 })

tests/testthat/test-renderer1-facet-coord.R

@@ -14,10 +14,10 @@ test_that("coord_fixed(ratio=10) + facet_wrap(nrow=1) with shrunk y-axis", {
   xdiff1 <- getTickDiff(x.axes[[1]])
   ydiff <- getTickDiff(y.axes[[1]], axis = "y")
   diffs <- normDiffs(xdiff1, ydiff, 2)
-  expect_equal(diffs[1], diffs[2], tolerance = 1, scale = 1)
+  expect_equal(diffs[1], diffs[2], tolerance = 10)
   xdiff2 <- getTickDiff(x.axes[[2]])
   diffs <- normDiffs(xdiff2, ydiff, 2)
-  expect_equal(diffs[1], diffs[2], tolerance = 1, scale = 1)
+  expect_equal(diffs[1], diffs[2], tolerance = 10)
 })
 
 test_that("coord_fixed(ratio=10) + facet_wrap(nrow=1) with shrunk x-axis", {
@@ -30,10 +30,10 @@ test_that("coord_fixed(ratio=10) + facet_wrap(nrow=1) with shrunk x-axis", {
   xdiff1 <- getTickDiff(x.axes[[1]])
   ydiff <- getTickDiff(y.axes[[1]], axis = "y")
   diffs <- normDiffs(xdiff1, ydiff, 10)
-  expect_equal(diffs[1], diffs[2], tolerance = 1, scale = 1)
+  expect_equal(diffs[1], diffs[2], tolerance = 10)
   xdiff2 <- getTickDiff(x.axes[[2]])
   diffs <- normDiffs(xdiff2, ydiff, 10)
-  expect_equal(diffs[1], diffs[2], tolerance = 1, scale = 1)
+  expect_equal(diffs[1], diffs[2], tolerance = 10)
 })
 
 # also test multiple row and/or facet_grid?