首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >R-多个数据集作为输入的LPSolve

R-多个数据集作为输入的LPSolve
EN

Stack Overflow用户
提问于 2017-07-28 14:29:09
回答 1查看 1.2K关注 0票数 0

我正在使用R处理LPSolve,我的输入数据以多个CSV文件的形式出现,每个文件都有一个表。其中2份表如下:

关于约束的描述-

  • 每个生产厂都有发运路线。
  • 由生产厂流出的总流出量=源自该生产厂的路线总量(路线体积)
  • 生产厂总流出<=生产能力
  • 路由卷本身就是一个决策变量,它依赖于本文中没有提到的其他变量。

约束的数学表示如下:

代码语言:javascript
复制
`Production Total Outflow = ∑(Route Volume) where (Production House ID from table_1)==(Originating from Prod House ID from table_2)`

Production Total Outflow <= Production Capacity

在现实中,我有数千排。我试图为上面的2个约束编写以下代码。将有两个制约因素:

代码语言:javascript
复制
#Reading Data from files
routeData = read.csv("Route.csv", header = TRUE)
ProductionData = read.csv("Production.csv", header = TRUE)

#Fetching variable columns
routeID = routeData$RouteID
productionID = ProductionData$ProductionID
productionCapacity = ProductionData$Supply.Capacity

numberOfColumns = length(routeID) + length(productionID) #4+2 decision variables
model <- make.lp(nrow=0, ncol=numberOfColumns, verbose="important")

for(i in 1:length(productionID)){
  add.constraint(model, 1, "<=", productionCapacity[i]) #Something wrong here
}
#I haven't attempted to write the other constraint

我无法继续写这些限制。请帮帮伙计们。我没有分享这个目标,因为它也有很多其他的限制。

EN

回答 1

Stack Overflow用户

回答已采纳

发布于 2017-08-02 13:35:12

这里有一个例子,它试图将路线量均匀地分配到生产厂。

代码语言:javascript
复制
library(lpSolveAPI)

prodcap <- setNames(c(50,100), c(1,2))
route <- data.frame(rid=1:4, pid_from=rep(1:2, each=2))
route_volume <- 125 # example

nvars <- nrow(route)+1 # example: evenly distribute production house output relative to capacity
lprec <- make.lp(0, nvars)

set.objfn(lprec, obj=1, indices=nvars)

# capacity constraints
for (i in seq(1, length(prodcap))) {
    route_ids <- which(route[,"pid_from"]==i)
    add.constraint(lprec, xt=rep(1, length(route_ids)), type="<=", rhs=prodcap[i], indices=route_ids)
}

# total outflow constraint
add.constraint(lprec, xt=rep(1, nrow(route)), type="=", rhs=route_volume, indices=seq(1, nvars-1))

# example: define the last decision variable as maximum flow over each production house
for (i in seq(1, length(prodcap))) {
    route_ids <- which(route[,"pid_from"]==i)
    add.constraint(lprec, xt=c(rep(1/prodcap[i], length(route_ids)), -1), type="<=", rhs=0, indices=c(route_ids, nvars))
}

# solve
status <- solve(lprec)
if(status!=0) stop("no solution found, error code=", status)
get.variables(lprec)[seq(1, nrow(route))]
#[1] 41.66667  0.00000 83.33333  0.00000

请注意,如果您有数千条路线/生产场所,那么在make.lp中预先分配约束并使用set.row而不是add.constraint可能更有效。下面是一个示例,并将route_volume作为附加的决策变量,如注释中所请求的那样:

代码语言:javascript
复制
library(lpSolveAPI)

prodcap <- setNames(c(50,100), c(1,2))
route <- data.frame(rid=1:4, pid_from=rep(1:2, each=2))
route_volume <- 125 # example

# the first nrow(route) vars are the outflows, 
# then 1 variable for maximum flow (relative to capacity) over all production house
# then 1 last variable for the route volume
nvars <- nrow(route)+2 
ncons <- 2*length(prodcap)+3

# pre-allocate the constraints
lprec <- make.lp(ncons, nvars)

# set objective: minimize maximum flow relative to capacity (example)
set.objfn(lprec, obj=1, indices=nvars-1)

# capacity constraints
rownum <- 1
for (i in seq(1, length(prodcap))) {
    route_ids <- which(route[,"pid_from"]==i)
    set.row(lprec, row=rownum, xt=rep(1, length(route_ids)), indices=route_ids)
    set.rhs(lprec, prodcap[i], constraints=rownum)
    rownum <- rownum + 1
}

# total outflow constraint ("=" resolves to two constraints)
set.row(lprec, row=rownum, xt=c(rep(1, nrow(route)), -1), indices=c(seq(1, nvars-2), nvars))
set.rhs(lprec, 0, constraints=rownum)
rownum <- rownum + 1
set.row(lprec, row=rownum, xt=c(rep(-1, nrow(route)), 1), indices=c(seq(1, nvars-2), nvars))
set.rhs(lprec, 0, constraints=rownum)
rownum <- rownum + 1

# additional constraint for route volume
set.row(lprec, row=rownum, xt=-1, indices=nvars)
set.rhs(lprec, -125, constraints=rownum) #example: route_volume >= 125
rownum <- rownum + 1

# example: define the second last decision variable as maximum flow (relative to capacity) over all production houses
# rhs is 0, which is preset
for (i in seq(1, length(prodcap))) {
    route_ids <- which(route[,"pid_from"]==i)
    set.row(lprec, row=rownum, xt=c(rep(1/prodcap[i], length(route_ids)), -1), indices=c(route_ids, nvars-1))
    set.rhs(lprec, 0, constraints=rownum)
    rownum <- rownum + 1
}

# solve
status <- solve(lprec)
if(status!=0) stop("no solution found, error code=", status)
get.variables(lprec)[seq(1, nrow(route))]
票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/45376030

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档