如何根据 R 中每个集群的固定容量制作集群？

Question

所以我有一个包含 600 个点、它们的纬度、经度和需求的数据集。 我必须制作集群，以便每个集群的点彼此靠近，并且该集群的总容量不会超过某个限制。

问题的示例数据集：

set.seed(123)
id<- seq(1:600)
lon <- rnorm(600, 88.5, 0.125)
lat <- rnorm(600, 22.4, 0.15)
demand <- round(rnorm(600, 40, 20))

df<- data.frame(id, lon, lat, demand)

我想要的大概是：

我得到的（集群边界是近似的）：

我写的代码：

library(tidyverse)
constrained_cluster <- function(df,capacity=170){
  lon_max <- max(df$lon)
  lat_max <- max(df$lat)

#Calculating the distance between an extreme point and all other points

  df$distance<-6377.83*acos(sin(lat_max*p)*sin(df$lat*p) + cos(lat_max*p)*cos(df$lat*p) * cos((lon_max-df$lon)*p))
  df<- df[order(df$distance, decreasing = FALSE),]
  d<-0
  cluster_number<-1
  cluster_list<- c()
  i<-1
#Writing a loop to form the cluster which will fill up the cluster_list accordingly
  while (i <= length(df$distance)){
    d <- d+ df$demand[i]
    if(d<=capacity){
      cluster_list[i] <- cluster_number
      i<- i+1
    }
    else{
      cluster_number <- cluster_number+1
      d <- 0
      i<-i
    }
  }
#Return a dataframe with the list of clusters
  return(cbind(df,as.data.frame(cluster_list)))
}

df_with_cluster<- constrained_cluster(df, capacity = 1000)

Answer 1

这是一种可能的方法，我将问题直接视为优化问题。

假设您有一个可行的将行划分为组的方法。不一定是好的，但不违反约束的。对于每一个 组（集群），您计算中心。然后你 计算组中所有点到 组的中心，并将它们相加。这样，你就有了一个 衡量初始分区的质量。

现在，随机选择一行，并将其移动到另一行 团体。你得到新的解决方案。完成步骤 和以前一样，并将新解决方案的质量与 上一个。如果更好，请保留它。如果它是 更糟糕的是，继续使用旧的解决方案。现在重复这个 固定迭代次数的整个过程。

此过程称为本地搜索。当然如此 不保证它将带您达到最佳状态 解决方案。但它可能会给你一个很好的 解决方案。 （请注意，k-means 的实现是 通常也是随机的，并且没有保证 对于“最佳”分区。）

本地搜索的好处在于它提供了 你有很大的灵活性。例如，我假设你 从一个可行的解决方案开始。假设你做一个 随机移动（即将一行移动到另一个集群中）， 但现在这个新集群太大了。您现在可以简单地放弃这个新的、不可行的解决方案，并绘制一个新的解决方案。

这是一个代码示例，实际上只是一个大纲；但幸运的是它对你有用。

set.seed(123)
id<- seq(1:600)
lon <- rnorm(600, 88.5, 0.125)
lat <- rnorm(600, 22.4, 0.15)
demand <- round(rnorm(600, 40, 20))

df<- data.frame(id, lon, lat, demand)

修复多个簇，k。

k <- 5

从 kmeans 开始并绘制解。

par(mfrow = c(1, 3))
km <- kmeans(cbind(df$lat, df$lon), centers = k)

cols <- hcl.colors(n = k, "Cold")
plot(df$lon,
     df$lat,
     type = "p", pch = 19, cex = 0.5,
     main = "kmeans")
for (i in seq_len(k)) {
    lines(df$lon[km$cluster == i],
          df$lat[km$cluster == i],
          type = "p", pch = 19,
          col = cols[i])
}

现在是本地搜索。我在包NMOF（我维护）中使用了一个实现。

library("NMOF")

## a random initial solution
x0 <- sample(1:k, length(id), replace = TRUE)
X <- as.matrix(df[, 2:3])

目标函数：它采用分区 x 并计算所有集群的距离总和。

sum_diff <- function(x, X, k, ...) {
    groups <- seq_len(k)
    d_centre <- numeric(k)
    for (g in groups) {
        centre <- colMeans(X[x == g, ], )
        d <- t(X[x == g, ]) - centre
        d_centre[g] <- sum(sqrt(colSums(d * d)))
    }
    sum(d_centre)
}

邻域函数：它需要一个分区并移动 一行进入另一个集群。

nb <- function(x, k, ...) {
    groups <- seq_len(k)

    x_new <- x
    p <- sample.int(length(x), 1)
    g_ <- groups[-x_new[p]]    
    x_new[p] <- g_[sample.int(length(g_), 1)]
    x_new
}

运行本地搜索。我实际上使用了一种称为阈值接受的方法，它基于本地搜索，但可以远离局部最小值。有关该方法的参考，请参阅 ?NMOF::TAopt。

sol <- TAopt(sum_diff,
             list(x0 = x0,
                  nI = 20000,
                  neighbour = nb),
             X = as.matrix(df[, 2:3]),
             k = k)

绘制解。

plot(df$lon,
     df$lat,
     type = "p", pch = 19, cex = 0.5,
     main = "Local search")
for (i in seq_len(k)) {
    lines(df$lon[sol$xbest == i],
          df$lat[sol$xbest == i],
          type = "p", pch = 19, 
          col = cols[i])
}

现在，一种添加容量限制的方法。我们从一个可行的解决方案开始。

## CAPACITY-CONSTRAINED
max.demand <- 6600
all(tapply(df$demand, x0, sum) < max.demand)
## TRUE

约束在附近处理。如果新解决方案超出容量，则将其丢弃。

nb_constr <- function(x, k, demand, max.demand,...) {
    groups <- seq_len(k)
    x_new <- x
    p <- sample.int(length(x), 1)
    g_ <- groups[-x_new[p]]    
    x_new[p] <- g_[sample.int(length(g_), 1)]

    ## if capacity is exceeded, return
    ## original solution
    if (sum(demand[x_new == x_new[p]]) > max.demand)
        x
    else
        x_new
}

运行方法并比较结果。

sol <- TAopt(sum_diff,
             list(x0 = x0,
                  nI = 20000,
                  neighbour = nb_constr),
             X = as.matrix(df[, 2:3]),
             k = k,
             demand = df$demand,
             max.demand = max.demand)

plot(df$lon,
     df$lat,
     type = "p", pch = 19, cex = 0.5,
     main = "Local search w/ constraint")
for (i in seq_len(k)) {
    lines(df$lon[sol$xbest == i],
          df$lat[sol$xbest == i],
          type = "p", pch = 19,
          col = cols[i])
}

all(tapply(df$demand, sol$xbest, sum) < max.demand)
## TRUE

这只是一个例子，可以改进。例如，这里的目标函数重新计算所有组的距离，而它只需要查看更改后的组。

Answer 2

这样的事情可能会让你开始？

nmax <- 100
num.centers <- 1
km <- kmeans(cbind(df$lat, df$lon), centers = num.centers)
#check if there are no clusters larger than nmax
while (prod(km$size < nmax) == 0) {
  num.centers <- num.centers + 1
  km <- kmeans(cbind(df$lat, df$lon), centers = num.centers)
}
plot(df$lon, df$lat, col = km$cluster, pch = 20)