问题描述
说我有这个数据集，其中包含每个村庄的质心（x_cent，y_cent），以及一些非空间参数，例如总人口和小学数量，铺路和村庄规模。
set.seed(1234)
dat <-
expand.grid(
district = c(1:2),sub_district = c(1:7),sub_sub_district = c(1:19),village_id = c(1:2)
) %>%
dplyr::group_by(district,sub_district,sub_sub_district,village_id) %>%
dplyr::mutate(
# Total population
tot_pop = rnorm(n = 1,mean = 100,sd = 5000),# Number of primary schools
p_schl = rnorm(n = 1,mean = 2,sd = 6),# Paved road
p_road = sample(0:1,size = dplyr::row_number(),replace = FALSE)
) %>%
dplyr::group_by(district,village_id) %>%
dplyr::mutate(
# Size of village in hectares
town_hec = rnorm(n = 1,mean = 300,sd = 320)
) %>%
dplyr::group_by(district,village_id) %>%
dplyr::mutate(
# Coordinates
x_cent = rnorm(n = 1,mean = 99.9,sd = 0.66),y_cent = rnorm(n = 1,mean = 33.3,sd = 0.33)
) %>%
dplyr::ungroup()
我想基于空间接近度以及这些非空间参数（tot_pop，p_schl，p_road和town_hec）生成村庄集群。我还想对算法进行加权，以使空间接近度比匹配其他协变量更重要。最后，我希望能够限制每个聚类的观测数量。
我假设这将是一个分层聚类模型，但是我不确定如何在R中实现它，以及不确定是否可以在空间和非空间协变量上聚类。
提前感谢您的任何建议。
解决方法
由于分层聚类方法取决于距离矩阵，因此在某些变量上施加更多权重的简单方法是在计算距离矩阵之前，根据您希望变量具有的重要性来缩放这些变量。
,潜在的解决方案（我不想接受其他人对此的想法，所以我不会将其作为解决方案）
首先，重新缩放要包含在距离矩阵中的变量。在这种情况下，我为坐标变量（x_cent和y_cent）分配了较大的权重（10）。
dat$x_cent <- scales::rescale(dat$x_cent,to = c(0,10))
dat$y_cent <- scales::rescale(dat$y_cent,10))
dat$tot_pop <- scales::rescale(dat$tot_pop,1))
第二，对数据进行子集，使其仅包含您要计算距离的协变量：
dat <- dat[,c("x_cent","y_cent","tot_pop")]
接下来，计算距离矩阵：
dist <- distances::distances(as.data.frame(dat))
使用scclust包计算聚类并将值附加到原始数据集。该软件包可让您合并对群集大小的限制。
clust <- scclust::hierarchical_clustering(distances = dist,size_constraint = 10)
final <- dplyr::bind_cols(dat,clust) %>% dplyr::rename(block = `...4`)
您可以看到每个聚类有多少个观测值：
investigate_cluster <- dplyr::group_by(final,block) %>% dplyr::summarise(count = length(block))
head(investigate_cluster)
# A tibble: 6 x 2
block count
<scclust> <int>
1 0 10
2 1 10
3 2 10
4 3 10
5 4 10
6 5 10
轻松查看集群：
ggplot(final,mapping = aes(x = x_cent,y = y_cent,color = factor(block))) +
geom_point() +
ggConvexHull::geom_convexhull(alpha = .5,aes(fill = factor(block))) +
theme_bw() +
theme(legend.position = "none")
