How to extend a line to touch a polygon? - r

Question

I would like to extend line to touch polygon
Create line and polygon line and polygon
Here is my solution to "stretch and trim".
Turned out a bit trickier than the first "solution" I offered initially.
I also included cases for horizontal and vertical lines.
My example I think covers all cases (direction of lines)
I have the coding very simple , no effort to make it more efficient
library(sf)
#
s1 <- rbind(c(1, 2), c(2, 3))
ls1 <- st_linestring(s1)
s2 <- rbind(c(2, 2), c(1, 3))
ls2 <- st_linestring(s2)
s3 <- rbind(c(2, 2), c(1, 1))
ls3 <- st_linestring(s3)
s4 <- rbind(c(1, 2), c(2, 1)) # VERTICAL LINE
ls4 <- st_linestring(s4)
vl <- rbind(c(2.5, 2), c(2.5, 3))
svl <- st_linestring(vl)
hl <- rbind(c(0.5, 0.5), c(1, 0.5))
shl <- st_linestring(hl)
line <- st_multilinestring(list(ls1, ls2, ls3, ls4, svl, shl))
p1 <- rbind(c(0, 0), c(1, 0), c(3, 2), c(2, 4), c(1, 4), c(0, 0))
pol <- st_polygon(list(p1))
#
(
plot1 <- ggplot() +
geom_sf(data = ls1, col = 'red', size = 2) +
geom_sf(data = ls2, col = 'darkred', size = 2) +
geom_sf(data = ls3, col = 'blue', size = 2) +
geom_sf(data = ls4, col = 'darkblue', size = 2) +
geom_sf(data = svl, col = 'green', size = 2) +
geom_sf(data = shl, col = 'green', size = 2) +
geom_sf(data = pol, fill = NA)
)
####################### Function
line_stretchntrim <- function(line, polygon) {
if (st_crs(line) != st_crs(polygon))
return("CRS not matching")
bb <- st_bbox(polygon)
bbdiagLength <-
as.numeric(sqrt((bb$xmin - bb$xmax) ^ 2 + (bb$ymin - bb$ymax) ^ 2))
xy <- st_coordinates(line)[, 1:2]
npairs <- nrow(xy) / 2
etline <- NULL
for (i in 1:npairs) {
ii <- (i - 1) * 2 + 1
x <- as.numeric(xy[ii:(ii + 1), 1])
y <- as.numeric(xy[ii:(ii + 1), 2])
dxline <- diff(x)
dyline <- diff(y)
d <- sqrt(dxline ^ 2 + dyline ^ 2)
scale <- abs(as.numeric(bbdiagLength)) # * extra if need be
signx <- sign(dxline)
signy <- sign(dyline)
theta <- atan(dxline / dyline)
# expand
if (signy == 1) {
dx1 <- -sin(theta) * scale #* d
dy1 <- -cos(theta) * scale #* d
dx2 <- sin(theta) * scale #* d
dy2 <- cos(theta) * scale #* d
}
if (signy == -1) {
dx1 <- sin(theta) * scale# * d
dy1 <- cos(theta) * scale# * d
dx2 <- -sin(theta) * scale# * d
dy2 <- -cos(theta) * scale# * d
}
## Cases when dxline == 0 or dyline == 0
# dxline == 0
if ((dxline == 0) * (signy == -1)) {
dx1 <- 0
dy1 <- cos(theta) * scale# * d
dx2 <- 0
dy2 <- -cos(theta) * scale# * d
}
if ((dxline == 0) * (signy == 1)) {
dx1 <- 0
dy1 <- -cos(theta) * scale# * d
dx2 <- 0
dy2 <- cos(theta) * scale# * d
}
if ((signx == 1) * (dyline == 0)) {
dx1 <- -sin(theta) * scale# * d
dy1 <- 0
dx2 <- sin(theta) * scale# * d
dy2 <- 0
}
if ((signx == -1) * (dyline == 0)) {
dx1 <- sin(theta) * scale# * d
dy1 <- 0
dx2 <- -sin(theta) * scale# * d
dy2 <- 0
}
x1 <- x[1] + dx1
y1 <- y[1] + dy1
# second point shift
x2 <- x[2] + dx2
y2 <- y[2] + dy2
# construct spatial line
sline <- st_linestring(matrix(c(x1, y1, x2, y2),
byrow = TRUE, ncol = 2))
slineSf <- st_sf(geom = st_sfc(sline), crs = st_crs(polygon))
# Now trim to polygon
stline <- st_intersection(slineSf, polygon)
etline <- if (i == 1)
stline
else
rbind(etline, stline)
}
etline
}
stretched_line <- line_stretchntrim(line, pol)
#
ggplot() +
geom_sf(data = pol, fill = NA) +
geom_sf(data = line, size = 2) +
geom_sf(data = stretched_line)