R语言求解跨类别跨区域人员重新分配的最小成本方案

这个问题属于典型的线性规划最小成本运输问题，你提到的20个类别、30个区域的规模很小，用通用线性规划工具即可快速求解。

依赖包安装 #

你需要先安装以下依赖包：

install.packages(c("tidyverse", "ompr", "ompr.roi", "ROI.plugin.glpk"))

完整实现代码 #

library(tidyverse)
library(ompr)
library(ompr.roi)
library(ROI.plugin.glpk)

# 1. 加载原始数据
population_and_demand_by_category_and_zone <- tibble::tribble(
  ~category, ~zone, ~population, ~demand,
  "A",     1,         115,     138,
  "A",     2,         121,     145,
  "A",     3,         112,     134,
  "A",     4,          76,      91,
  "B",     1,          70,      99,
  "B",     2,          59,      83,
  "B",     3,          86,     121,
  "B",     4,         139,     196,
  "C",     1,         142,     160,
  "C",     2,          72,      81,
  "C",     3,          29,      33,
  "C",     4,          58,      66,
  "D",     1,          22,      47,
  "D",     2,          23,      49,
  "D",     3,          16,      34,
  "D",     4,          45,      96
)

demand_and_capacity_by_zone <- tibble::tribble(
  ~zone, ~demand, ~capacity, ~capacity_exceeded,
  1,     444,       465,              FALSE,
  2,     358,       393,              FALSE,
  3,     322,       500,              FALSE,
  4,     449,       331,               TRUE
)

costs <- tibble::tribble(
  ~category, ~zone, ~cost,
  "A",     1,   0.1,
  "A",     2,   0.1,
  "A",     3,   0.1,
  "A",     4,   1.3,
  "B",     1,  16.2,
  "B",     2,  38.1,
  "B",     3,   1.5,
  "B",     4,   0.1,
  "C",     1,   0.1,
  "C",     2,  12.7,
  "C",     3,  97.7,
  "C",     4,  46.3,
  "D",     1,  25.3,
  "D",     2,   7.7,
  "D",     3,  67.3,
  "D",     4,   0.1
)

# 2. 预处理参数
categories <- unique(population_and_demand_by_category_and_zone$category)
n_category <- length(categories)
zones <- unique(population_and_demand_by_category_and_zone$zone)
n_zone <- length(zones)
# 各类别总需求
total_demand_by_cat <- population_and_demand_by_category_and_zone %>%
  group_by(category) %>%
  summarise(total_demand = sum(demand), .groups = "drop")
# 各区域承载力
capacity_by_zone <- demand_and_capacity_by_zone %>% select(zone, capacity)
# 成本矩阵
cost_matrix <- costs %>%
  arrange(category, zone) %>%
  pivot_wider(names_from = zone, values_from = cost) %>%
  select(-category) %>%
  as.matrix()

# 3. 构建线性规划模型
model <- MIPModel() %>%
  # 定义变量：x[i,j] 为第i类人员在第j区的最终人口
  add_variable(x[i, j], i = 1:n_category, j = 1:n_zone, type = "continuous", lb = 0) %>%
  # 目标函数：总调配成本最小
  set_objective(sum_expr(cost_matrix[i, j] * x[i, j], i = 1:n_category, j = 1:n_zone), "min") %>%
  # 约束1：每个类别的总人数等于该类总需求
  add_constraint(sum_expr(x[i, j], j = 1:n_zone) == total_demand_by_cat$total_demand[i], i = 1:n_category) %>%
  # 约束2：每个区域的总人数不超过区域承载力
  add_constraint(sum_expr(x[i, j], i = 1:n_category) <= capacity_by_zone$capacity[j], j = 1:n_zone)

# 4. 求解模型
result <- solve_model(model, with_ROI(solver = "glpk", verbose = FALSE))

# 5. 提取结果合并到原表
solution <- result %>%
  get_solution(x[i, j]) %>%
  mutate(
    category = categories[i],
    zone = zones[j],
    new_population = value
  ) %>%
  select(category, zone, new_population)

final_result <- population_and_demand_by_category_and_zone %>%
  left_join(solution, by = c("category", "zone"))

输出说明 #

final_result就是你需要的最终表，已经新增了new_population列存储各类别各区域的最优人口分布。
示例输出的前几行如下：

本方案可以直接扩展到20类30区的业务场景，运行效率足够。

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