R可视化:地图上合理的排斥点(beeswarm?)

Question

我正在尝试复制类似这样的地图。

​

它描绘了分布在一个地区的少量项目(学校)。对于输入，我有一个区域地图，每个区域都有一个编号。我想把它放在这个区域周围的很多点上。如果它们不会扩散到区域边界，那就更好了，但简单地分布它们就足够了。区域内的一些漂亮的拒绝点可能会起作用。

蜂群图做了非常类似的事情，这可以在地图上做吗？奖金问题-事实上，我一直在寻找动画，但只能想到非常复杂的方法来做到这一点，以便添加新的点数增加的总和nrs的时间。

下面的代码将点放置在地图上的质心上，并将数字作为大小。(我无法将地图正确导出为单个文件，因此坐标有点混乱，但原理是相同的。)

places = st_read("https://gist.githubusercontent.com/peeter-t2/9646a4169e993948fa97f6f503a0688b/raw/cb4e910bf153e51e3727dc9d1c73dd9ef86d2556/kih1897m.geojson", stringsAsFactors = FALSE)

schools <- read_tsv("https://gist.github.com/peeter-t2/34467636b3c1017e89f33284d7907b42/raw/6ea7dd6c005ef8577b36f5e84338afcb6c76b707/school_nums.tsv")
schools_geo <- merge(places,schools,by.x="KIHELKOND",by.y="Kihelkond") #94 matches

p<- schools_geo %>% 
  ggplot()+
  geom_sf(data=schools_geo)+
  geom_sf(data=st_centroid(schools_geo),aes(size=value))+
  theme_bw()
p

谢谢!

Answer 1

正如我在注释中指出的，当我读入文件时，它将crs设置为经度/经度(epsg: 4326)，而geometry列是一个不同的crs。我猜测正确的crs是espg: 3301，并在此基础上继续进行，这似乎工作得很好。

st_crs(schools_geo) <- 3301

我们可以使用st_sample来获取多边形中与我们的'value‘列相关的点的样本：

# we can set type = 'hexagonal', 'regular' or 'random'
school_pts <- schools_geo %>% st_sample(size = .$value, type = 'hexagonal')


schools_geo %>% 
  ggplot()+
  geom_sf()+
  geom_sf(data=school_pts, size = .8)+
  theme_bw()

这产生了下面的图，我认为这看起来很混乱，因为st_sample将点分散到多边形的范围内。

​

​

让点在每个多边形中居中可能看起来更好，如您发布的示例中所示。要做到这一点，我们可以根据想要在多边形中绘制的点数来重新缩放多边形。在下面的代码中，如果多边形内部的点最少(1)，我将多边形缩小90%，如果多边形的点最多(27)，我将多边形缩小20%。

# put values on scale between 0 and 1
scale_fact <- (max(schools_geo$value) -  schools_geo$value) / (max(schools_geo$value) - min(schools_geo$value)) 
# re-scale between 0.2 and 0.9
scale_fact <- scale_fact * (0.9 - 0.2) + 0.2
# reverse the scale 
scale_fact <-  max(scale_fact) + min(scale_fact) - scale_fact 

# apply the scale factor
schools_centroid <- st_geometry(st_centroid(schools_geo))
schools_geo_rescaled <- (st_geometry(schools_geo) - schools_centroid) * scale_fact + schools_centroid

school_pts <- schools_geo_rescaled %>% 
  st_sf(crs = 3301) %>% 
  bind_cols(value = schools_geo$value) %>%
  st_sample(size = .$value, type = 'hexagonal')


# plot
schools_geo %>% 
  ggplot()+
  geom_sf()+
  geom_sf(data=school_pts, size = .8)+
  theme_bw()

​

​

Answer 2

这不是一个简单的问题。我决定简化它，只选择一个领域，而不是所有领域。从理论上讲，该解决方案在您的所有领域都是可重现的。

我们首先导入我们的库

library(rgdal)
library(sf)
library(readr)
library(ggplot2)

我们使用建议的数据：

places <- st_read("https://gist.githubusercontent.com/peeter-t2/9646a4169e993948fa97f6f503a0688b/raw/cb4e910bf153e51e3727dc9d1c73dd9ef86d2556/kih1897m.geojson", stringsAsFactors = FALSE)

schools <- read_tsv("https://gist.github.com/peeter-t2/34467636b3c1017e89f33284d7907b42/raw/6ea7dd6c005ef8577b36f5e84338afcb6c76b707/school_nums.tsv")
schools_geo <- merge(places,schools,by.x="KIHELKOND",by.y="Kihelkond") #94 matches

我们选择一种状态

one <- places$geometry[[1]]

我们将多边形分割成几个子多边形，这要归功于网格

grid <- st_make_grid(one, n = c(10, 10))
area <- st_area(grid)
grid <- st_as_sf(data.frame(ID=c(1:length(area)),
                            area=area,
                            geometry=grid))
tmp <- st_intersection(grid, one)
tmp$area <- st_area(tmp)

我们显示由小方块构成的网格的所有质心。

plot(st_geometry(tmp['area']))
plot(st_geometry(st_centroid(tmp['area'])),
     pch = 16, col = 'red', add = TRUE)

最后，我们希望只保留您想要的点数，即nbr，与示例中的值(学校数量)相等。

nbr <- 20
plot(st_geometry(one))
plot(st_geometry(st_centroid(tmp[order(tmp$area, decreasing = T),][1:nbr,])),
     pch = 16, col = 'red', add = TRUE)

我希望它能对你有所帮助。

​