Question

我想延长线以接触多边形创建线和面线和面这是我的“拉伸和修剪”解决方案。
结果比我最初提供的第一个“解决方案”要复杂一些。我还包括了水平线和垂直线的情况。我认为我的示例涵盖了所有个案例（行的方向）
我的编码非常简单，没有做任何努力

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)

如何延长线以接触多边形？

0 个答案: