Line Segment/Box Intersection Test

While working with {grid} graphics I needed a way to cull some generated geometry if it didn’t lie within a given rectangular bounding box.

The following code is based upon a stackoverflow response

This code will test 100 thousand line segments against a box in about 20ms, which is fast enough for my purposes.

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Determine if line segments intersect a rectangle
#'
#' @param x1,y1,x2,y2 coordinates of line segment endpoints
#' @param xmin,ymin,xmax,ymax coordinates of lower-left and upper-right of
#'        rectangle.
#'
#' @return logical vector the same length as x1
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
line_intersects_box <- function(x1, y1, x2, y2, xmin, ymin, xmax, ymax) {

  # Returns 0/1 depending on which side of the line segment the corner lies
  left_of <- function(xcorner, ycorner) {
    ((y2 - y1) * xcorner + (x1 - x2) * ycorner + (x2 * y1 - x1 * y2)) >= 0
  }

  # test segments against each of the 4 corners of the box
  res <- list(
    left_of(xmin, ymin),
    left_of(xmin, ymax),
    left_of(xmax, ymax),
    left_of(xmax, ymin)
  )

  # if the test for each corner
  # are all of the same sign, then the segment definitely misses the box
  a_miss <- Reduce(`+`, res) %in% c(0, 4)

  # Does it miss based upon the shadow intersection test?
  b_miss <-
    (x1 > xmax & x2 > xmax) | (x1 < xmin & x2 < xmin) |
    (y1 > ymax & y2 > ymax) | (y1 < ymin & y2 < ymin)

  # a hit is if it doesn't miss!
  !(a_miss | b_miss)
}

Example

N <- 300000

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Generate lots of random lines
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
x1 <- runif(N)
y1 <- runif(N)
x2 <- runif(N)
y2 <- runif(N)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Test if the segments intersect a box
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
xmin <- 0.4
ymin <- 0.4
xmax <- 0.9
ymax <- 0.9

int1 <- line_intersects_box(x1, y1, x2, y2, xmin, ymin, xmax, ymax)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Test if the segments intersect a second box
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
xmin <- 0.1
ymin <- 0.1
xmax <- 0.9
ymax <- 0.2

int2 <- line_intersects_box(x1, y1, x2, y2, xmin, ymin, xmax, ymax)


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Plot all segments that don't intersect the boxes
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
df <- data.frame(
  x1, y1, x2, y2, int1, int2
) %>% filter(!int1, !int2)


ggplot(df) +
  geom_segment(aes(x=x1,y=y1,xend=x2,yend=y2), alpha=0.005) +
  annotate('rect', xmin=xmin, ymin=ymin, xmax=xmax,ymax=ymax, fill=NA, colour=NA) +
  theme_void()