Question

我研究了this question，并基于数千对经度和纬度点创建了自己的4等值线图，但是使用4个等值线中的每个等值线时，我得不到正确的点数上述问题中提到的points.in.polygon方法。

这是到目前为止使用MASS库的代码：

 # use kde2d function to create kernel density estimates 
x <- pedestrian.df$longitude
y <- pedestrian.df$latitude
dens <- kde2d(x, y, n=200)

# create the contours to plot - 70%, 50%, 25%, 10% of density contained in each contour 
prob <- c(0.7, 0.5, 0.25, 0.1)
dx <- diff(dens$x[1:4])
dy <- diff(dens$y[1:4])
sz <- sort(dens$z)
c1 <- cumsum(sz) * dx * dy 
levels <- sapply(prob, function(x) { 
    approx(c1, sz, xout = 1 - x)$y
})

#create the contour plot using smoothScatter which smooths the collisions into kernel densities 

smoothScatter(x,y) + contour(dens, levels=levels, labels=prob, col = c("green", "yellow", "orange", "red"), lwd = 1.5, add=T)

这正确地生成了我所期望的：

plot

然后，我尝试使用sp库中的points.in.polygon函数，就像上述链接问题的答案一样：

ls <- contourLines(dens, level=levels)
zone_1 <- point.in.polygon(df$longitude, df$latitude, ls[[4]]$x, ls[[4]]$y)
zone_2 <- point.in.polygon(df$longitude, df$latitude, ls[[3]]$x, ls[[3]]$y)
zone_3 <- point.in.polygon(df$longitude, df$latitude, ls[[2]]$x, ls[[2]]$y)
zone_4 <- point.in.polygon(df$longitude, df$latitude, ls[[1]]$x, ls[[1]]$y)

但这会导致每个区域或轮廓的点数不正确。我知道这是不对的，因为随着轮廓变大，每个轮廓应逐渐具有更多的点。

我尝试查看ls（一个存储多边形的所有x和y坐标的列表的列表），但是有15个级别，而不是我直觉会想到的4个级别。 15个中甚至有多个具有相同值的级别。我怀疑问题的答案在于正确地对列表列表进行细分，以正确地包含与我的4个轮廓相对应的4个级别，但是ls [[1：7]] $ x，ls [[1：7]] $ y没有不行

感谢您的帮助，让我知道是否可以澄清任何事情！

Answer 1

我认为 pedestrian是您自己的数据，而不是pkg中的数据，由于这不是问题的一部分，因此我们将使用另一种数据：

library(MASS)
library(sp)

attach(geyser)

data.frame(
  x = geyser$duration,
  y = geyser$waiting
) -> xdf

dens <- kde2d(xdf$x, xdf$y, n = 100)

prob <- c(0.7, 0.5, 0.25, 0.1)

dx <- diff(dens$x[1:4])
dy <- diff(dens$y[1:4])
sz <- sort(dens$z)
c1 <- cumsum(sz) * dx * dy 

levels <- sapply(prob, function(x) { 
  approx(c1, sz, xout = 1 - x)$y
})

smoothScatter(x,y) +
  contour(dens, levels=levels, labels=prob, col = c("green", "yellow", "orange", "red"), lwd = 1.5, add=TRUE)

“多个级别”的原因是，给定图层中的每个多边形都是独立的，因此每个级别可能> 1个：

cl <- contourLines(dens, level=levels)

sort(table(sapply(cl, `[[`, "level")))
## 0.00519851181336958 0.00765971436995347  0.0107843979424224  0.0128423136194731 
##                   2                   3                   3                   3

因此，在计算每个多边形的点数时只需考虑这一点：

setNames(
  lapply(cl, function(poly) sum(sp::point.in.polygon(xdf$x, xdf$y, poly$x, poly$y))),
  sapply(cl, `[[`, "level")
) -> level_cts

str(level_cts)
## List of 11
##  $ 0.00519851181336958: int 91
##  $ 0.00519851181336958: int 174
##  $ 0.00765971436995347: int 78
##  $ 0.00765971436995347: int 57
##  $ 0.00765971436995347: int 74
##  $ 0.0107843979424224 : int 65
##  $ 0.0107843979424224 : int 34
##  $ 0.0107843979424224 : int 33
##  $ 0.0128423136194731 : int 42
##  $ 0.0128423136194731 : int 10
##  $ 0.0128423136194731 : int 3

然后我们可以总结一下：

sapply(
  split(level_cts, names(level_cts)),
  function(level) sum(unlist(level))
) -> pt_cts

pt_cts

## 0.00519851181336958 0.00765971436995347 
##                 265                 209 
##  0.0107843979424224  0.0128423136194731 
##                 132                  55

然后，获取％：

pt_cts / nrow(xdf)
## 0.00519851181336958 0.00765971436995347 
##           0.8862876           0.6989967 
##  0.0107843979424224  0.0128423136194731 
##           0.4414716           0.1839465

更新

我们不仅可以计算百分比，还可以将级别分配给原始数据：

do.call(
  rbind.data.frame,
  lapply(cl, function(poly) { # iterate over each polygon
    # figure out which pts are in this polgyon
    which_pts <- as.logical(sp::point.in.polygon(xdf$x, xdf$y, poly$x, poly$y))
    tdf <- xdf[which_pts,] # assign them to a temp data frame
    tdf$level <- poly$level # add the level
    tdf
  })
) -> new_xdf

dplyr::glimpse(new_xdf)
## Observations: 661
## Variables: 3
## $ x     <dbl> 2.000000, 2.033333, 1.833333, 1.616667, 1.766667, 2.0000...
## $ y     <dbl> 77, 77, 81, 89, 73, 83, 84, 85, 79, 75, 91, 87, 86, 78, ...
## $ level <dbl> 0.005198512, 0.005198512, 0.005198512, 0.005198512, 0.00...

# while you likely want the level value, this adds columns for level # & prob
new_xdf$level_num <- as.integer(factor(new_xdf$level, levels, labels=1:length(levels)))
new_xdf$prob <- as.numeric(as.character(factor(new_xdf$level, levels, labels=prob)))

dplyr::glimpse(new_xdf)
## Observations: 661
## Variables: 5
## $ x         <dbl> 2.000000, 2.033333, 1.833333, 1.616667, 1.766667, 2....
## $ y         <dbl> 77, 77, 81, 89, 73, 83, 84, 85, 79, 75, 91, 87, 86, ...
## $ level     <dbl> 0.005198512, 0.005198512, 0.005198512, 0.005198512, ...
## $ level_num <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1...
## $ prob      <dbl> 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0....

dplyr::count(new_xdf, level, level_num, prob)
## # A tibble: 4 x 4
##     level level_num  prob     n
##     <dbl>     <int> <dbl> <int>
## 1 0.00520         1 0.700   265
## 2 0.00766         2 0.500   209
## 3 0.0108          3 0.250   132
## 4 0.0128          4 0.100    55

如何在R的轮廓中找到点？

1 个答案: