Issue 555

R/facet.R

@@ -311,8 +311,9 @@ draw_facet_window = function(
         # individual facet.
         xfree = if (!is.null(facet)) split(c(x, xmin, xmax), facet)[[ii]] else c(x, xmin, xmax)
         yfree = if (!is.null(facet)) split(c(y, ymin, ymax), facet)[[ii]] else c(y, ymin, ymax)
-        if (null_xlim) xlim = range(xfree, na.rm = TRUE)
-        if (null_ylim) ylim = range(yfree, na.rm = TRUE)
+        lim = calc_lim(range(xfree, na.rm = TRUE), range(yfree, na.rm = TRUE), asp)
+        if (null_xlim) xlim = lim$xlim
+        if (null_ylim) ylim = lim$ylim
         xext = extendrange(xlim, f = 0.04)
         yext = extendrange(ylim, f = 0.04)
         # We'll save this in a special .fusr env var (list) that we'll re-use

R/lim.R

@@ -47,3 +47,32 @@ lim_args = function(settings) {
     c("xlim", "ylim", "xlabs", "ylabs", "xaxb", "yaxb")
   )
 }
+
+# translated from C_plot_window function in r-source/src/library/graphics/src/plot.c
+calc_lim <- function(
+  xlim,
+  ylim,
+  asp,
+  xin = grconvertX(1, "npc", "inches"),
+  yin = grconvertY(1, "npc", "inches")
+) {
+  if (!is.null(asp) && !is.na(asp) && asp > 0) {
+    xmin = xlim[1]; xmax = xlim[2]; ymin = ylim[1]; ymax = ylim[2];
+    xdelta = abs(xmax - xmin) / asp
+    ydelta = abs(ymax - ymin)
+    if(xdelta == 0.0 && ydelta == 0.0) {
+      # Not from R source: actual zero used here
+      return(list(xlim = xlim, ylim = ylim))
+    }
+    scale = min(c(xin / xdelta, yin / ydelta))
+    xadd = .5 * (xin / scale - xdelta) * asp
+    yadd = .5 * (yin / scale - ydelta)
+    if (xmax < xmin) xadd = xadd * -1
+    if (ymax < ymin) yadd = yadd * -1
+    return(list(
+      xlim = c(xmin - xadd, xmax + xadd),
+      ylim = c(ymin - yadd, ymax + yadd)
+    ))
+  }
+  list(xlim = xlim, ylim = ylim)
+}

inst/tinytest/test-facet.R

@@ -513,6 +513,22 @@ f = function() {
 }
 expect_snapshot_plot(f, label = "facet_free_grid")
 
+f = function() {
+  tinyplot(
+    y ~ x,
+    facet = ~group,
+    facet.args = list(free = TRUE),
+    data = data.frame(
+      y = rep(c(1, 1, 2, 2, 1, 1.5, 1.5), 2),
+      x = rep(c(2, 1, 1, 2, 2, 2, 11), 2),
+      group = c(rep("A", 7), rep("B", 7))
+    ),
+    type = "l",
+    asp = 1
+  )
+}
+expect_snapshot_plot(f, label = "facet_free_asp_1")
+
 #
 # restore original par settings
 #