按R中的因子计算多边形内的点

Question

我有两个 xy 坐标数据集。第一个具有 xy 坐标加上带有我的因子水平的标签列。我打电话给data.frameqq，它看起来像这样：

structure(list(x = c(5109, 5128, 5137, 5185, 5258, 5324, 5387, 
5343, 5331, 5347, 5300, 5180, 4109, 4082, 4091, 4139, 4212, 4279, 
4291, 4297, 4285, 4301, 4254, 4181), y = c(1692, 1881, 2070, 
2119, 2144, 2065, 1987, 1813, 1705, 1649, 1631, 1654, 1847, 2015, 
2204, 2253, 2278, 2282, 2166, 1947, 1839, 1783, 1765, 1783), 
    tag = c("MPN_right", "MPN_right", "MPN_right", "MPN_right", 
    "MPN_right", "MPN_right", "MPN_right", "MPN_right", "MPN_right", 
    "MPN_right", "MPN_right", "MPN_right", "MPN_left", "MPN_left", 
    "MPN_left", "MPN_left", "MPN_left", "MPN_left", "MPN_left", 
    "MPN_left", "MPN_left", "MPN_left", "MPN_left", "MPN_left"
    )), .Names = c("x", "y", "tag"), row.names = c(NA, -24L), class = "data.frame") 

我使用qq xy 为另一个生成随机数据，这意味着sd 很大。

set.seed(123)
my_points=data.frame(x=rnorm(n =1000,mean=mean(qq$x),sd=1000),
y=rnorm(n=1000,mean=mean(qq$y),sd=1000))

如果我使用 mgcv 包中的 in.out 函数，我会得到一些我想要的。

这种方法的主要问题是我的“多边形”没有闭合，也不会被解释为 2 个多边形。该软件包建议在两者之间使用一个 NA 行，但我宁愿使用我的标签列，因为我将尝试在我的标签因子中使用超过 2 个级别，即超过 2 个多边形）。我的最终目标是制作一个包含每个点数的表格。

Answer 1

这个呢：

mysppoint <- SpatialPoints(coords = my_points)  # create spatial points
qq$tag <- as.factor(qq$tag)
polys = list()

# create one polygon for each factor level
for (lev in levels(qq$tag)){
  first_x <- qq$x[qq$tag == lev][1]
  first_y <- qq$y[qq$tag == lev][1]
  qq <- rbind(qq, data.frame(x = first_x, y = first_y, tag = lev))  # "close" the polygon by replicating the first row
  polys[[lev]] <- Polygons(list(Polygon(matrix(data = cbind(qq$x[qq$tag == lev], # transform to polygon
                                                            qq$y[qq$tag == lev]), 
                                               ncol = 2))), lev)
}

mypolys <-  SpatialPolygons(polys)   # convert to spatial polygons
inters  <-  factor(over(mysppoint, mypolys), labels = names(mypolys)) # intersect points with polygons
table(inters)

，给出：

inters
 MPN_left MPN_right 
       10        17 

这样做的好处是它为您提供了适当的空间对象来使用。例如：

plotd <- fortify(mypolys )
p <- ggplot()
p <- p + geom_point(data = my_points, aes(x = x , y = y), size = 0.2)
p <- p + geom_polygon(data = plotd, aes(x = long, y = lat, fill = id), alpha = 0.7)
p

Answer 2

我最终使用了lapply 以及split 和更多lapply 的组合。所以这里是代码，请忽略extract_coords 辅助函数，它基本上给了我一个dataframe 与x，y 和标签列。我还设法将原始 your_coords 中的点子集并计算它们（将它们作为向量而不是表格返回）。

inside_ROI = function(your_ROI_zip,your_coords){

  # Helper function will take list from zip ROIs and merge them into a df  
  qq=extract_coords(your_ROI_zip)  

  # We use tag for splitting by the region 

  lista=split(qq,qq$tag)

  # We check if they are in or out
  who_is_in = lapply(lista,function(t) in.out(cbind(t$x,t$y),x=cbind(your_coords$x,your_coords$y)))

  # We sum to get the by area countings
  region_sums = unlist(lapply(who_is_in,function(t) sum(as.numeric(t))))

  # obtain indices for subset of TRUE values
  aa=lapply(who_is_in,function(p) which(p==T))

  whos_coords=list()

for (i in aa){
  whos_coords = append(whos_coords,values=list(your_coords[i,]))
  #  whos_coords[[i]] = your_coords[i,]   
  }

  # Change names
  names(whos_coords) = names(aa)

  # Put into list for more than one output  
  out=list(region_sums,aa,whos_coords)  

  return(out)
}

Answer 3

lapply() 和sapply() 帮助您使用函数par level。

  ## a bit edited to make output clear

library(dplyr); library(mgcv)

TAG <- unique(qq$tag)

IN.OUT <- lapply(TAG, function(x) as.matrix(qq[qq$tag==x, 1:2])) %>%  # make a matrix par level
  sapply(function(x) in.out(x, as.matrix(my_points)))        # use in.out() with each matrix

colnames(IN.OUT) <- TAG

head(IN.OUT, n = 3)

#      MPN_right MPN_left
# [1,]     FALSE    FALSE
# [2,]     FALSE    FALSE
# [3,]     FALSE    FALSE

apply(IN.OUT, 2, table)

#       MPN_right MPN_left
# FALSE       983      990
# TRUE         17       10