Clipping in geom_abline()

R/geom-abline.R

@@ -132,12 +132,16 @@ GeomAbline <- ggproto("GeomAbline", Geom,
       # Ensure the line extends well outside the panel to avoid visible line
       # ending for thick lines
       ranges$x <- ranges$x + c(-1, 1) * diff(ranges$x)
+      ranges$y <- ranges$y + c(-1, 1) * diff(ranges$y)
     }
 
-    data$x    <- ranges$x[1]
-    data$xend <- ranges$x[2]
-    data$y    <- ranges$x[1] * data$slope + data$intercept
-    data$yend <- ranges$x[2] * data$slope + data$intercept
+    # Restrict 'x' to where 'y' is in range: x = (y - intercept) / slope
+    x <- sweep(outer(ranges$y, data$intercept, FUN = "-"), 2, data$slope, FUN = "/")
+
+    data$x    <- pmax(ranges$x[1], pmin(x[1, ], x[2, ]))
+    data$xend <- pmin(ranges$x[2], pmax(x[1, ], x[2, ]))
+    data$y    <- data$x    * data$slope + data$intercept
+    data$yend <- data$xend * data$slope + data$intercept
 
     GeomSegment$draw_panel(unique0(data), panel_params, coord, lineend = lineend)
   },

tests/testthat/test-geom-hline-vline-abline.R

@@ -43,6 +43,25 @@ test_that("curved lines in map projections", {
   )
 })
 
+test_that("geom_abline is clipped to x/y ranges", {
+
+  df <- data.frame(slope = c(-0.2, -1, -5, 5, 1, 0.2))
+
+  p <- ggplot(df) +
+    geom_abline(aes(slope = slope, intercept = 0)) +
+    scale_x_continuous(limits = c(-1, 1), expand = FALSE) +
+    scale_y_continuous(limits = c(-1, 1), expand = FALSE) +
+    coord_cartesian(clip = "off")
+
+  data <- layer_grob(p)[[1]]
+
+  x <- c(as.numeric(data$x0), as.numeric(data$x1))
+  expect_true(all(x >= 0 & x <= 1))
+
+  y <- c(as.numeric(data$y0), as.numeric(data$y1))
+  expect_true(all(y >= 0 & y <= 1))
+})
+
 # Warning tests ------------------------------------------------------------
 
 test_that("warnings are thrown when parameters cause mapping and data to be ignored", {