8wDlpd.png
8wDFp9.png
8wDEOx.png
8wDMfH.png
8wDKte.png

如果中心不重叠,则保留重叠的椭圆

Ulises CT 1月前

19 0

以下代码用于创建主轴长度为 1400 米、侧轴长度为 1000 米的椭圆。每个椭圆都分配有一个 ID。library(sf)library(ggplot2)library(dplyr)# 坐标数据...

以下代码创建了主轴长 1400 米、侧轴长 1000 米的椭圆。每个椭圆都分配有一个 ID。

library(sf)
library(ggplot2)
library(dplyr)

# coordinate data
x <- c(611547.6411, 589547.6411, 611447.6411, 609847.6411, 606347.6411, 611447.6411, 613547.6411,642747.6411, 589647.6411, 606447.6411, 613547.6411, 640347.6411, 642847.6411, 612147.6411, 613847.6411, 640247.6411, 642947.6411, 584347.6411, 587747.6411, 606447.6411, 614247.6411, 640447.6411, 642747.6411, 584447.6411, 608647.6411, 612047.6411, 612747.6411,
       613847.6411, 643147.6411, 583147.6411, 608747.6411, 611847.6411, 609647.6411, 610047.6411, 613747.6411, 586247.6411, 588647.6411, 643147.6411, 584347.6411, 606447.6411, 610147.6411, 613347.6411, 614647.6411, 586047.6411, 587247.6411, 611547.6411, 640347.6411, 643147.6411, 587147.6411, 583047.6411, 608747.6411, 612047.6411, 613947.6411, 587647.6411, 588547.6411, 586847.6411, 611247.6411, 643247.6411, 587247.6411, 590347.6411, 582947.6411, 608947.6411, 611847.6411, 613447.6411, 614647.6411, 585147.6411, 587647.6411, 588547.6411, 586947.6411, 611247.6411, 643047.6411, 587147.6411, 583947.6411, 587747.6411, 608547.6411, 611747.6411, 614047.6411, 585247.6411, 586247.6411, 588447.6411, 589147.6411, 611347.6411, 642447.6411, 586947.6411, 585847.6411, 587747.6411, 581447.6411, 612447.6411, 611947.6411, 600547.6411,
       612047.6411, 610347.6411, 614147.6411, 582847.6411, 588547.6411, 589247.6411, 611247.6411, 638147.6411, 640547.6411, 642947.6411, 587047.6411, 585947.6411, 587647.6411, 600447.6411, 611347.6411, 612347.6411, 610347.6411, 587747.6411, 579747.6411, 583847.6411, 586847.6411, 588447.6411, 589347.6411, 643347.6411, 589347.6411, 586947.6411, 588247.6411, 588847.6411, 585847.6411, 590847.6411, 589447.6411, 590947.6411, 581347.6411, 611847.6411, 600647.6411, 610347.6411, 615947.6411, 613947.6411, 586347.6411, 579647.6411, 584047.6411, 586347.6411, 587747.6411, 587947.6411, 586547.6411, 587647.6411, 614047.6411, 643047.6411, 587947.6411, 585747.6411, 584947.6411, 600547.6411, 611947.6411, 606847.6411, 600847.6411, 612847.6411, 615747.6411, 620747.6411, 614047.6411, 632947.6411, 588147.6411, 579747.6411, 582747.6411)

y <- c(5272140.5728, 5271740.5728, 5271640.5728, 5267440.5728, 5271540.5728, 5272040.5728, 5272340.5728, 5268540.5728, 5271240.5728, 5271640.5728, 5272140.5728, 5272240.5728, 5272240.5728, 5277940.5728, 5278040.5728, 5278040.5728, 5266940.5728, 5267040.5728, 5267440.5728, 5268140.5728, 5268640.5728, 5271140.5728, 5271740.5728, 5271740.5728, 5271940.5728, 5272140.5728, 5272240.5728, 5272040.5728, 5272140.5728, 5272140.5728, 5272140.5728, 5272240.5728, 5272340.5728, 5277240.5728, 5278040.5728, 5268540.5728, 5271240.5728, 5271340.5728, 5272240.5728, 5271940.5728, 5271940.5728, 5272040.5728, 5272040.5728, 5272040.5728, 5272040.5728, 5272040.5728, 5272140.5728, 5272140.5728,
       5272140.5728, 5272240.5728, 5272240.5728, 5277240.5728, 5278040.5728, 5278140.5728, 5278140.5728, 5265540.5728, 5266840.5728, 5266940.5728, 5267040.5728, 5268540.5728, 5272240.5728, 5272340.5728, 5272040.5728, 5272040.5728, 5277340.5728, 5278140.5728, 5278140.5728, 5265640.5728, 5266840.5728, 5267240.5728, 5268440.5728, 5271540.5728, 5272140.5728, 5271840.5728, 5271940.5728, 5271940.5728, 5271940.5728, 5272040.5728, 5272040.5728, 5272140.5728, 5272140.5728, 5272140.5728, 5272340.5728, 5277140.5728, 5277240.5728, 5277340.5728, 5277740.5728, 5277740.5728, 5278040.5728, 5278140.5728, 5278140.5728, 5278240.5728, 5278240.5728, 5264940.5728, 5265040.5728, 5265140.5728, 5266740.5728, 5266840.5728, 5266940.5728, 5267040.5728, 5267140.5728, 5267340.5728, 5267440.5728, 5268340.5728,
       5271240.5728, 5271840.5728, 5271940.5728, 5272040.5728, 5272040.5728, 5272340.5728, 5271840.5728, 5271840.5728, 5272140.5728, 5272140.5728, 5272240.5728, 5272240.5728, 5272340.5728, 5274340.5728, 5274440.5728, 5274640.5728, 5285140.5728, 5285240.5728, 5277340.5728, 5277540.5728, 5277840.5728, 5278040.5728, 5278040.5728, 5278140.5728, 5278140.5728, 5265540.5728, 5265640.5728, 5266740.5728, 5266740.5728, 5266940.5728, 5268340.5728, 5268440.5728, 5271440.5728, 5271540.5728, 5271540.5728, 5271740.5728, 5272040.5728, 5272340.5728, 5271740.5728, 5272240.5728, 5272240.5728, 5274540.5728, 5275040.5728, 5275340.5728, 5284840.5728, 5284940.5728, 5284940.5728, 5285040.5728, 5285040.5728)

# create data frame
coordinates.df <- data.frame(x = x, y = y)

# add ID column
coordinates.df$ID <- 1:nrow(coordinates.df)
coordinates.df <- coordinates.df[c(3,1:2)]

# convert data frame to sf object
coordinates.sf <- st_as_sf(coordinates.df, coords = c("x", "y"), crs = 25832)

# function for creating ellipses
create_ellipse <- function(center, a = 1400, b = 1000, angle = 225, n = 100) {
  angle_rad <- angle * pi / 180
  angles <- seq(0, 2 * pi, length.out = n)
  ellipse_coords <- cbind(a * cos(angles), b * sin(angles))
  rotation_matrix <- matrix(c(cos(angle_rad), -sin(angle_rad), 
                              sin(angle_rad),  cos(angle_rad)), 
                            nrow = 2)
  rotated_ellipse <- as.matrix(ellipse_coords) %*% rotation_matrix
  x_center <- center[1]
  y_center <- center[2]
  rotated_ellipse <- rotated_ellipse + matrix(c(x_center, y_center), nrow = n, ncol = 2, byrow = TRUE)
  rotated_ellipse <- rbind(rotated_ellipse, rotated_ellipse[1, ])
  st_polygon(list(rotated_ellipse))
}

# create ellipses
ellipses <- st_coordinates(coordinates.sf) %>%
  apply(1, function(p) create_ellipse(p)) %>%
  st_sfc(crs = st_crs(coordinates.sf))

# convert ellipses into sf objects
ellipses.sf <- st_sf(geometry = ellipses)

# plot
ggplot() +
  geom_sf(data = coordinates.sf, color = "black", size = 2) +
  geom_sf(data = ellipses.sf, fill = "blue", alpha = 0.2) +
  theme_minimal() +
  labs(x = "Easting", y = "Northing")

最终结果如下:

很明显,椭圆是重叠的。只要椭圆的中心不重叠,重叠是可以的。我希望这些图有助于更清楚地说明:

在第一种情况下,上椭圆不与下椭圆的中心重叠,这是可以的。在这种情况下,两个椭圆都应该保留。在第二种情况下,上椭圆与下椭圆(包括其中心)重叠,这是不行的。在这些情况下,应该删除 ID 较高的椭圆,只 留下 ID 较低的椭圆 。完全不接触的单个椭圆当然也应该保留。

有人知道如何实现这个吗?

如果有任何问题或不确定性,请随时发表评论。

帖子版权声明 1、本帖标题:如果中心不重叠,则保留重叠的椭圆
    本站网址:http://xjnalaquan.com/
2、本网站的资源部分来源于网络,如有侵权,请联系站长进行删除处理。
3、会员发帖仅代表会员个人观点,并不代表本站赞同其观点和对其真实性负责。
4、本站一律禁止以任何方式发布或转载任何违法的相关信息,访客发现请向站长举报
5、站长邮箱:yeweds@126.com 除非注明,本帖由Ulises CT在本站《r》版块原创发布, 转载请注明出处!
最新回复 (0)
  • 如果在带有绿色对勾的图中,ID6 被旋转,使得它与 ID4 的中心重叠,但 ID4 不与 ID6 的中心重叠(或反之亦然),会怎样?

  • 此情况下不允许旋转,所有椭圆必须具有相同的方向。一般情况下,如果一个中心重叠,则需要删除 ID 较大的椭圆。

  • 我认为这就是你想要的。我 data.table 出于习惯使用,但可以适应 dplyr 或作为基础。本质上,这只是使用, sf::st_intersects() 但在我看来,它变成了更可用的东西。

    library(data.table)
    
    # intersects
    i <- sf::st_intersects(coordinates.sf, ellipses.sf)
    i <- as.matrix(i)
    rownames(i) <- seq_len(nrow(i))
    colnames(i) <- seq_len(ncol(i))
    i <- i |>
        as.data.frame.table(stringsAsFactors = FALSE) |>
        data.table::as.data.table() |>
        data.table::setnames(c("I1", "I2", "Intersect")) |>
        _[Intersect == TRUE] |>
        _[, c("I1", "I2") := lapply(.SD, as.integer), .SDcols = c("I1", "I2")] |>
        _[order(I1, I2)]
    
    # remove identity
    i <- i[I1 != I2]
    
    # ensure that I2 > I1
    # if 1 intersects 3 then 3 intersects 1
    # this makes sure that only polygon 3 is removed, keeping polygon 1
    i <- i[I2 > I1]
    
    # now subset ellipses
    ellipses.sf.subset <- ellipses.sf[!seq_len(nrow(ellipses.sf)) %in% i$I2, ]
    
    # plot
    ggplot() +
        geom_sf(data = coordinates.sf, color = "black", size = 2) +
        geom_sf(data = ellipses.sf.subset, fill = "blue", alpha = 0.2) +
        theme_minimal() +
        labs(x = "Easting", y = "Northing")
    

    ggplot2

    用来 mapview::mapview 验证红色圈出的可疑内容。

    verification

    编辑

    经过进一步调查,发现这不太可行。 i[I2 > I1] 删除了一些不应该删除的省略号。我知道这太简单了……如果一个省略号被之前应该删除的省略号删除,则它会失败。代码现在变得更加糟糕(并且可能会被彻底清理),但我相信这会产生实际的期望结果。

    # ensure that I2 > I1
    # if 1 intersects 3 then 3 intersects 1
    # this makes sure that only polygon 3 is removed, keeping 1
    rm <- c()
    for (ix in unique(i$I1)) {
        x <- i[I1 == ix & I2 > I1 & !I1 %in% rm, I2]
        x <- x[!x %in% rm]
        if (length(x) > 0) {
            rm <- c(rm, x)
        }
    }
    
    # now subset ellipses
    ellipses.sf.subset <- ellipses.sf[!seq_len(nrow(ellipses.sf)) %in% rm, ]
    

    这里的红色圆圈表示第一种方法中不应该删除但是却删除了的椭圆。

    approach 2

返回
作者最近主题: