最优方式为图添加孤立顶点：带预算约束的乡镇联网规划

现有1000个乡镇，其中700个已联网，300个未联网，未联网乡镇分为2个地理集群，数据生成代码如下：

set.seed(123)
n_vill <- 1000
connected <- 700
disconnected <- n_vill-connected

df_connected <- data.frame(id = 1:connected,
                 x = runif(connected,17,20),
                 y = runif(connected,46,49),
                 has_int = 1,
                 pop = round(rexp(connected,0.002)))

df_disconnected <- data.frame(id = 701:n_vill,
                              x = c(runif(disconnected/2,17,18),runif(disconnected/2,19,20)),
                              y = c(runif(disconnected/2,46,47),runif(disconnected/2,48,49)),
                              has_int = 0,
                              pop = round(rexp(disconnected,0.005)))

df <- rbind(df_connected,df_disconnected) 

任务要求：以最优方式将未联网乡镇接入已联网网络，连接成本为乡镇间距离，收益为接入乡镇的人口。存在预算约束，需优先连接人口多、距离近的乡镇；同时若路径上有小型乡镇，应一并纳入以低成本提升覆盖人口。

当前尝试用最小生成树（MST）实现，但MST仅最小化总连接距离，会连接所有乡镇，未考虑人口权重、预算约束及连接优先级，因此需要更优且简便的方法，优先用R语言实现。

当前使用的代码如下：

library(igraph)
require(leaflet)
require(geosphere)
require(tidyverse)
require(sp)
rm(list = ls())

mat2list <- function(D) {
    n = dim(D)[1]
    k <- 1
    e <- matrix(ncol = 3,nrow = n*(n-1)/2)
    for (i in 1:(n-1)) {
        for (j in (i+1):n) {
            e[k,] = c(rownames(D)[i],colnames(D)[j],as.numeric(D[i,j]))
            k<-k+1
        }
    }
    return(as.data.frame(e))
}
get_coords <- function(x){
    xy1 <- as.numeric(df[df$id==x[1],2:3])
    xy2 <- as.numeric(df[df$id==x[2],2:3])
    
    has_int1 <- as.numeric(as.character(df$has_int[df$id==x[1]]))
    has_int2 <- as.numeric(as.character(df$has_int[df$id==x[2]]))
    
    col_ciara <-  ifelse(sum(has_int1,has_int2)<2,'red','green')
    
    return(list(coords = c(xy1[1],xy2[1],xy1[2],xy2[2]), color = col_ciara))
} 

dist_mat <-  distm(x = df[,c('x','y')], y = df[,c('x','y')], fun=distHaversine) 
rownames(dist_mat)<- df$id
colnames(dist_mat) <- df$id

ed <- mat2list(dist_mat/1000)
ed$V3 <- as.numeric(ed$V3)

beatCol <- colorFactor(palette = c('red','green'), df$has_int)

df2 <- df
coordinates(df2) <- ~x+y

map1 <- leaflet(df2)%>% 
    addCircleMarkers(label=df2$id,color = ~beatCol(has_int),radius =~log(pop, base=2),fillColor = ~beatCol(has_int),
                     fillOpacity = 0.5,opacity = 1) %>% 
    addTiles()

net <- graph.data.frame(ed[,1:2],directed = FALSE)
E(net)$weight <- as.numeric(ed[,3])
mst <- minimum.spanning.tree(net)
me <- get.edges(mst, 1:ecount(mst))

for(i in 1:nrow(me)){
    map1 <- addPolylines(map1, lat = as.numeric(get_coords(me[i,])$coords[3:4]), 
                         lng = as.numeric(get_coords(me[i,])$coords[1:2]),
                         color = get_coords(me[i,])$color)
}
map1

针对需求，推荐以下几种兼顾预算约束、人口收益和连接成本的方法：

1. 基于人口-成本比的贪心优先连接策略 #

核心思路：计算每个未联网乡镇的「单位距离覆盖人口」（pop / 到最近已联网乡镇的距离），按该值从高到低排序，优先连接比值高的乡镇；连接某乡镇时，若路径上有未联网小型乡镇，直接纳入连接以共享线路成本。

R实现代码 #

library(igraph)
library(geosphere)
library(tidyverse)
library(leaflet)
library(sp)

# 加载数据
set.seed(123)
n_vill <- 1000
connected <- 700
disconnected <- n_vill-connected

df_connected <- data.frame(id = 1:connected,
                 x = runif(connected,17,20),
                 y = runif(connected,46,49),
                 has_int = 1,
                 pop = round(rexp(connected,0.002)))

df_disconnected <- data.frame(id = 701:n_vill,
                              x = c(runif(disconnected/2,17,18),runif(disconnected/2,19,20)),
                              y = c(runif(disconnected/2,46,47),runif(disconnected/2,48,49)),
                              has_int = 0,
                              pop = round(rexp(disconnected,0.005)))

df <- rbind(df_connected,df_disconnected)

# 计算未联网乡镇的人口-距离比并排序
connected_coords <- df %>% filter(has_int == 1) %>% select(x, y)
disconnected_df <- df %>% filter(has_int == 0) %>% rowwise() %>%
  mutate(min_dist = min(distm(c(x, y), connected_coords, fun = distHaversine)/1000),
         pop_dist_ratio = pop / min_dist) %>%
  arrange(desc(pop_dist_ratio))

# 设定预算（示例：总连接距离不超过200公里）
budget <- 200
total_cost <- 0
connected_ids <- df$id[df$has_int == 1]
selected_edges <- data.frame(from = integer(), to = integer(), cost = numeric())

# 贪心选择过程
for (i in 1:nrow(disconnected_df)) {
  vill_id <- disconnected_df$id[i]
  vill_coords <- df %>% filter(id == vill_id) %>% select(x, y)
  
  # 找到离该乡镇最近的已连接节点（含已接入的未联网乡镇）
  connected_coords_sub <- df %>% filter(id %in% connected_ids) %>% select(x, y)
  dists <- distm(vill_coords, connected_coords_sub, fun = distHaversine)/1000
  closest_id <- connected_ids[which.min(dists)]
  min_dist <- min(dists)
  
  if (total_cost + min_dist <= budget) {
    total_cost <- total_cost + min_dist
    selected_edges <- rbind(selected_edges, data.frame(from = vill_id, to = closest_id, cost = min_dist))
    connected_ids <- c(connected_ids, vill_id)
  } else {
    break
  }
}

# 可视化结果
beatCol <- colorFactor(palette = c('red','green'), df$has_int)
df$has_int[df$id %in% connected_ids] <- 1  # 更新联网状态
df2 <- df
coordinates(df2) <- ~x+y

map2 <- leaflet(df2)%>% 
  addCircleMarkers(label=df2$id,color = ~beatCol(has_int),radius =~log(pop, base=2),fillColor = ~beatCol(has_int),
                   fillOpacity = 0.5,opacity = 1) %>% 
  addTiles()

# 添加选中的连接线路
for (i in 1:nrow(selected_edges)) {
  from_coords <- df %>% filter(id == selected_edges$from[i]) %>% select(x, y)
  to_coords <- df %>% filter(id == selected_edges$to[i]) %>% select(x, y)
  map2 <- addPolylines(map2, lat = c(from_coords$y, to_coords$y), 
                       lng = c(from_coords$x, to_coords$x),
                       color = 'blue', weight = 2)
}

map2

2. 带权重的最小生成树（调整权重为「成本/收益」） #

将MST的边权重改为距离 / 两端节点的总人口，这样MST会优先选择「单位人口覆盖成本低」的连接；生成树后，按边权重从小到大累加成本，直到达到预算，保留对应边和节点即可。

3. Steiner树（适配集群式未联网区域） #

Steiner树可在给定终端节点（已联网乡镇）和非终端节点（未联网乡镇）中，找到最小成本连接树，允许通过非终端节点中转，恰好符合「路径上纳入小型乡镇」的需求。

简化实现示例 #

# 构建图，已联网节点为终端节点
dist_mat <- distm(df[,c('x','y')], df[,c('x','y')], fun=distHaversine)/1000
rownames(dist_mat) <- df$id
colnames(dist_mat) <- df$id
ed <- mat2list(dist_mat)
ed$V3 <- as.numeric(ed$V3)

terminal_nodes <- df$id[df$has_int == 1]
net <- graph.data.frame(ed[,1:2], directed = FALSE)
E(net)$weight <- as.numeric(ed$V3)

# 生成Steiner树
steiner <- steiner_tree(net, terminal_nodes)

# 根据预算截断边
edges_sorted <- E(steiner)[order(weight)]
total_cost <- 0
selected_steiner_edges <- c()
budget <- 200
for (e in edges_sorted) {
  if (total_cost + e$weight <= budget) {
    total_cost <- total_cost + e$weight
    selected_steiner_edges <- c(selected_steiner_edges, e)
  } else {
    break
  }
}

# 提取选中的子图并可视化（复用之前leaflet逻辑即可）
selected_steiner_graph <- subgraph.edges(steiner, selected_steiner_edges)

内容的提问来源于stack exchange，提问作者PK1998