diff --git a/DESCRIPTION b/DESCRIPTION index 2203c1d72..5ca8f82a3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: animint2 Title: Animated Interactive Grammar of Graphics -Version: 2026.9.28 +Version: 2026.9.5 URL: https://animint.github.io/animint2 BugReports: https://github.com/animint/animint2/issues Authors@R: c( diff --git a/NEWS.md b/NEWS.md index 3e885fc38..ec069773e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,10 +1,6 @@ -# Changes in version 2026.9.29 (PR#288) +# Changes in version 2026.7.29 (PR#253) -- Plot SVGs use `display: block` (issue #279). Each ggplot is one SVG. Browsers treat an SVG as inline and leave space under it for text descenders, which is the extra whitespace below a facet_wrap plot. That gap is under the SVG, not between facet panels. This is required; without it the rendered gap is about 5px. Thanks @ANAMASGARD. - -# Changes in version 2026.9.28 (PR#285) - -- Clearer facet error messages when a facet variable is missing from the data, or when `facet_wrap(. ~ var)` uses invalid notation (issue #168). +- Fixed `coord_equal()` and `coord_fixed()` to properly fill available plotting space. Issue #234 showed the problem when increasing plot width (800 vs default 400); the same JavaScript bug also affected tall viewports when height should fill. Previously `Math.min(1, aspect)` was applied independently to width and height proportions, shrinking both when the graph pixel aspect did not match the data aspect. The renderer now adjusts panel proportions for non-square graph cells and scale-to-fits so at least one dimension fills the available space while preserving the data aspect ratio. # Changes in version 2026.9.5 diff --git a/R/facet-layout.r b/R/facet-layout.r index 13f85b9e1..ef312b4a1 100644 --- a/R/facet-layout.r +++ b/R/facet-layout.r @@ -48,20 +48,6 @@ layout_wrap <- function(data, vars = NULL, nrow = NULL, ncol = NULL, vars <- as.quoted(vars) if (length(vars) == 0) return(layout_null()) - # Notation error only when real vars exist; otherwise layout_base reports missing columns. - if ("." %in% names(vars)) { - real_vars <- names(vars)[names(vars) != "."] - all_data_vars <- unique(unlist(lapply(data, names))) - missing_vars <- setdiff(real_vars, all_data_vars) - if (length(missing_vars) == 0) { - stop(sprintf( - "Invalid facet_wrap formula (. ~ var). Use facet_wrap(~%s) or facet_wrap(\"%s\")", - paste(real_vars, collapse = " + "), - paste(real_vars, collapse = "\", \"") - ), call. = FALSE) - } - } - base <- plyr::unrowname(layout_base(data, vars, drop = drop)) id <- plyr::id(base, drop = TRUE) @@ -107,22 +93,8 @@ layout_base <- function(data, vars = NULL, drop = TRUE) { # Form the base data frame which contains all combinations of facetting # variables that appear in the data - has_all <- unlist(lapply(values, length)) == length(vars) + has_all <- unlist(plyr::llply(values, length)) == length(vars) if (!any(has_all)) { - all_data_vars <- unique(unlist(lapply(data, names))) - missing_vars <- setdiff(names(vars)[names(vars) != "."], all_data_vars) - if (length(missing_vars) > 0) { - stop(sprintf( - "Facet variable%s not found in data: %s\nAvailable columns: %s", - if (length(missing_vars) > 1) "s" else "", - paste(missing_vars, collapse = ", "), - paste(all_data_vars, collapse = ", ") - )) - } - # Reached when all facet variables exist somewhere in the data, but no - # single layer has all of them together. For example, facet_grid(X ~ Y) - # where layer 1 only has column X and layer 2 only has column Y — neither - # layer alone satisfies all facetting variables, so has_all is FALSE for every layer. stop("At least one layer must contain all variables used for facetting") } diff --git a/R/z_facets.R b/R/z_facets.R index 01f070ae2..c4cba3ff3 100644 --- a/R/z_facets.R +++ b/R/z_facets.R @@ -150,5 +150,8 @@ 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 + # Clamp each proportion to at most 1. Desired data aspect is spaces$y/spaces$x; + # the JS renderer then scale-to-fits these proportions into the available + # (possibly non-square) graph pixel space so at least one side fills. lapply(spaces, function(z) min(z, 1)) } diff --git a/inst/htmljs/animint.js b/inst/htmljs/animint.js index 9d2158775..5bab42dc3 100644 --- a/inst/htmljs/animint.js +++ b/inst/htmljs/animint.js @@ -401,9 +401,7 @@ var setMultilineText = function(textElement, text) { var svg = tdLeft.append("svg") .attr("id", p_info.plot_id) .attr("height", p_info.options.height) - .attr("width", p_info.options.width) - // block avoids inline SVG baseline/descender gap below the plot (issue #279) - .style("display", "block"); + .attr("width", p_info.options.width); // divvy up width/height based on the panel layout var nrows = Math.max.apply(null, p_info.layout.ROW); @@ -540,6 +538,14 @@ var setMultilineText = function(textElement, text) { } return cumsum; } + function max_group_sum(group, values){ + var sums = []; + for(var i=0; i 0) { + wp = wp.map(function(x) { return x / fit_prop; }); + hp = hp.map(function(y) { return y / fit_prop; }); + } // track the proportion of the graph that should be 'blank' // this is mainly used to implement coord_fixed() diff --git a/tests/testthat/test-compiler-coord-equal-fix.R b/tests/testthat/test-compiler-coord-equal-fix.R new file mode 100644 index 000000000..9854f8d62 --- /dev/null +++ b/tests/testthat/test-compiler-coord-equal-fix.R @@ -0,0 +1,19 @@ +acontext("coord_equal fix for issue #234") + +test_that("fixed_spaces keeps at least one dimension filling 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 on a square cell) + 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) + # Data aspect y/x preserved for the JS scale-to-fit step + expect_equal(spaces$y / spaces$x, 2.5 / 6) +}) diff --git a/tests/testthat/test-compiler-ghpages.R b/tests/testthat/test-compiler-ghpages.R index 4af477d8b..70ef74125 100644 --- a/tests/testthat/test-compiler-ghpages.R +++ b/tests/testthat/test-compiler-ghpages.R @@ -51,28 +51,6 @@ reset_test_repo <- function(){ gh::gh("POST /orgs/animint-test/repos", name = test_repo_name) Sys.sleep(3) } -clone_test_repo <- function(github_url, new_clone){ - max_attempts <- 5 - wait_seconds <- 3 - last_error <- NULL - for (attempt in seq_len(max_attempts)) { - result <- tryCatch({ - clone <- gert::git_clone(github_url, new_clone) - last_error <- NULL - clone - }, error = function(err){ - last_error <<- err - NULL - }) - if (is.null(last_error)) return(result) - if (!grepl("status code: 404", conditionMessage(last_error), fixed = TRUE)) { - stop(last_error) - } - unlink(new_clone, recursive = TRUE, force = TRUE) - if (attempt < max_attempts) Sys.sleep(wait_seconds) - } - stop(last_error) -} test_that("animint2pages(chromote_sleep_seconds=3) creates Capture.PNG", { reset_test_repo() ## first run of animint2pages creates new data viz. @@ -118,7 +96,7 @@ test_that("animint2pages(chromote_sleep_seconds=NULL) does not create Capture.PN ## clone and add Capture.PNG new_clone <- tempfile() github_url <- paste0("https://github.com/", result_list$owner_repo, ".git") - clone_test_repo(github_url, new_clone) + gert::git_clone(github_url, new_clone) branch_name <- gert::git_branch(new_clone) expect_identical(branch_name, "gh-pages", info=paste(branch_name, "should be gh-pages")) cat("FOO", file=file.path(new_clone, "Capture.PNG")) diff --git a/tests/testthat/test-issue-279-facet-wrap-custom-height-spacing.R b/tests/testthat/test-issue-279-facet-wrap-custom-height-spacing.R deleted file mode 100644 index 86d8b217a..000000000 --- a/tests/testthat/test-issue-279-facet-wrap-custom-height-spacing.R +++ /dev/null @@ -1,43 +0,0 @@ -test_that("facet_wrap SVG height is proportional to theme_animint height, no excess space (#279)", { - 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)) - default_theme_height <- 400 - custom_theme_height <- 600 - svg_xpath <- "//svg[@id='plot_plot']" - svg_sel <- "svg#plot_plot" - parent_sel <- "td:has(> svg#plot_plot)" - base_plot <- ggplot() + - geom_point(aes(x, y), data = task_data) + - facet_wrap(~ task_id, ncol = 1) + - theme_bw() - viz_list <- list( - default = animint(plot = base_plot), - custom = animint(plot = base_plot + theme_animint(height = custom_theme_height)) - ) - heights <- list() - for (viz_name in names(viz_list)) { - info <- animint2HTML(viz_list[[viz_name]]) - svg_node <- getNodeSet(info$html, svg_xpath) - expect_equal(length(svg_node), 1L) - svg_attrs <- xmlAttrs(svg_node[[1]]) - display <- getStyleValue(info$html, svg_xpath, "display") - expect_equal(display, "block", - label = "plot SVG should have inline display:block to prevent whitespace below it") - svg_box <- get_element_bbox(svg_sel) - parent_box <- get_element_bbox(parent_sel) - bottom_gap <- (parent_box$top + parent_box$height) - (svg_box$top + svg_box$height) - expect_lte(bottom_gap, 1, - label = "no excess rendered gap below plot SVG (issue #279)") - heights[[viz_name]] <- as.numeric(svg_attrs[["height"]]) - } - expect_lt(heights$default, default_theme_height * n_facets) - expect_lt(heights$custom, custom_theme_height * n_facets, - label = sprintf( - "SVG height should not be %d*num_facets — regression from issue #279", - custom_theme_height)) - expect_gt(heights$custom, heights$default) -}) diff --git a/tests/testthat/test-renderer-coord_equal.R b/tests/testthat/test-renderer-coord_equal.R new file mode 100644 index 000000000..231b9f1d3 --- /dev/null +++ b/tests/testthat/test-renderer-coord_equal.R @@ -0,0 +1,49 @@ +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) + # Issue #234 acceptance: fill available space. Aspect-ratio math is covered by + # test-compiler-coord-equal-fix.R and test-renderer1-coord.R (normDiffs). +}) diff --git a/tests/testthat/test-renderer-facet-error-messages.R b/tests/testthat/test-renderer-facet-error-messages.R deleted file mode 100644 index 09805f24d..000000000 --- a/tests/testthat/test-renderer-facet-error-messages.R +++ /dev/null @@ -1,79 +0,0 @@ -acontext("Facet error messages") -missing_var_error <- paste( - "Facet variable not found in data: NonExistentColumn", - "Available columns: Sepal.Length, Sepal.Width, Petal.Length, Petal.Width, Species", - sep = "\n" -) -missing_var_string_error <- paste( - "Facet variable not found in data: MissingVar", - "Available columns: Sepal.Length, Sepal.Width, Petal.Length, Petal.Width, Species", - sep = "\n" -) -bad_notation_error <- "Invalid facet_wrap formula (. ~ var). Use facet_wrap(~Species) or facet_wrap(\"Species\")" -test_that("facet_wrap string missing variable gives clear error", { - viz <- list( - scatter = ggplot() + - facet_wrap("MissingVar") + - geom_point(aes(Sepal.Length, Petal.Length), data = iris) - ) - expect_error({ - animint2dir(viz) - }, missing_var_string_error, fixed = TRUE) -}) -test_that("facet_wrap formula with missing variable gives clear error", { - viz <- list( - scatter = ggplot() + - facet_wrap(. ~ NonExistentColumn) + - geom_point(aes(Sepal.Length, Petal.Length), data = iris) - ) - expect_error({ - animint2dir(viz) - }, missing_var_error, fixed = TRUE) -}) -test_that("facet_wrap bad notation when variable exists gives clear error", { - viz <- list( - scatter = ggplot() + - facet_wrap(. ~ Species) + - geom_point(aes(Sepal.Length, Petal.Length), data = iris) - ) - expect_error({ - animint2dir(viz) - }, bad_notation_error, fixed = TRUE) -}) -test_that("facet_grid missing variable gives clear error", { - viz <- list( - scatter = ggplot() + - facet_grid(. ~ MissingVar) + - geom_point(aes(Sepal.Length, Petal.Length), data = iris) - ) - expect_error({ - animint2dir(viz) - }, missing_var_string_error, fixed = TRUE) -}) -test_that("facet_wrap tilde notation works", { - viz <- list( - scatter = ggplot() + - facet_wrap(~Species) + - geom_point(aes(Sepal.Length, Petal.Length), data = iris) - ) - info <- animint2dir(viz, open.browser = FALSE) - expect_true(file.exists(file.path(info$out.dir, "index.html"))) -}) -test_that("facet_wrap string notation works", { - viz <- list( - scatter = ggplot() + - facet_wrap("Species") + - geom_point(aes(Sepal.Length, Petal.Length), data = iris) - ) - info <- animint2dir(viz, open.browser = FALSE) - expect_true(file.exists(file.path(info$out.dir, "index.html"))) -}) -test_that("facet_grid formula notation works", { - viz <- list( - scatter = ggplot() + - facet_grid(. ~ Species) + - geom_point(aes(Sepal.Length, Petal.Length), data = iris) - ) - info <- animint2dir(viz, open.browser = FALSE) - expect_true(file.exists(file.path(info$out.dir, "index.html"))) -}) diff --git a/tests/testthat/test-renderer1-coord.R b/tests/testthat/test-renderer1-coord.R index a4e8521f4..605ffc291 100644 --- a/tests/testthat/test-renderer1-coord.R +++ b/tests/testthat/test-renderer1-coord.R @@ -30,7 +30,43 @@ 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) + ## Round to drop SVG sub-pixel float noise (~1e-6); aspect should match. + expect_equal(round(diffs[1], 3), round(diffs[2], 3)) +}) + +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("yaxis height increases with coord_fixed", { + p_fixed <- p + coord_fixed(10) + info_default <- animint2HTML(list(plot = p_fixed)) + y.axes <- getNodeSet(info_default$html, "//g[contains(@class, 'yaxis')]") + ydiff_default <- getTickDiff(y.axes[[1]], axis = "y") + info_tall <- animint2HTML(list(plot = p_fixed + theme_animint(height = 1000))) + y.axes <- getNodeSet(info_tall$html, "//g[contains(@class, 'yaxis')]") + ydiff_tall <- getTickDiff(y.axes[[1]], axis = "y") + ratio <- ydiff_tall / ydiff_default + ## Height is the filling dimension for ratio=10; tick spacing should grow + ## substantially (width test uses expect_gt(ratio, 2) for coord_equal). + expect_gt(ratio, 1.8) +}) + +test_that("coord_equal preserves aspect on non-square viewport", { + viz <- p + coord_equal() + theme_animint(width=800, height=400) + info <- animint2HTML(list(plot = viz)) + x.axes <- getNodeSet(info$html, "//g[contains(@class, 'xaxis')]") + y.axes <- getNodeSet(info$html, "//g[contains(@class, 'yaxis')]") + xdiff <- getTickDiff(x.axes[[1]]) + ydiff <- getTickDiff(y.axes[[1]], axis = "y") + diffs <- normDiffs(xdiff, ydiff, 1) + expect_equal(round(diffs[1], 3), round(diffs[2], 3)) }) test_that("coord_fixed with shrinking x-axis", { @@ -42,5 +78,6 @@ 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) + ## Round to drop SVG sub-pixel float noise; ratio=10 values ~75px can differ by ~0.001 on CI. + expect_equal(round(diffs[1], 2), round(diffs[2], 2)) }) diff --git a/tests/testthat/test-renderer1-facet-coord.R b/tests/testthat/test-renderer1-facet-coord.R index d84691b2d..1e47f4282 100644 --- a/tests/testthat/test-renderer1-facet-coord.R +++ b/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(round(diffs[1], 3), round(diffs[2], 3)) xdiff2 <- getTickDiff(x.axes[[2]]) diffs <- normDiffs(xdiff2, ydiff, 2) - expect_equal(diffs[1], diffs[2], tolerance = 1, scale = 1) + expect_equal(round(diffs[1], 3), round(diffs[2], 3)) }) 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(round(diffs[1], 3), round(diffs[2], 3)) xdiff2 <- getTickDiff(x.axes[[2]]) diffs <- normDiffs(xdiff2, ydiff, 10) - expect_equal(diffs[1], diffs[2], tolerance = 1, scale = 1) + expect_equal(round(diffs[1], 3), round(diffs[2], 3)) }) # also test multiple row and/or facet_grid? diff --git a/tests/testthat/test-renderer3-knit-print.R b/tests/testthat/test-renderer3-knit-print.R index 7f34e2e15..e732b42c8 100644 --- a/tests/testthat/test-renderer3-knit-print.R +++ b/tests/testthat/test-renderer3-knit-print.R @@ -44,9 +44,10 @@ test_that("segments and breakpoints are rendered", { }) test_that("svg id property is unique", { - id.vec <- getPropertyValue(html, "//svg", "id") - id.counts <- table(id.vec) - expect_equal(max(id.counts), 1L) + svg.list <- getNodeSet(html, "//svg") + attr.mat <- sapply(svg.list, xmlAttrs) + id.counts <- table(attr.mat["id",]) + expect_true(all(id.counts==1)) }) all.list <- getNodeSet(html, "//*") @@ -180,7 +181,6 @@ click_center <- function(id){ ## https://github.com/rstudio/chromote/issues/32 do.call(remDr$Input$dispatchMouseEvent, L) } - Sys.sleep(1) } djs.init.list <- driverjs_get(html)