Search code examples
rmathematical-optimizationlinear-programminglpsolve

LPSolve with R - Multiple datasets as input


I am working on LPSolve with R and my input data is in the form of multiple CSV files, each file having a table. 2 of the tables are mentioned below:

Production Data

Route Data

Description about constraints -

  • There are routes originating from each production house
  • Total outflow from a production house = Sum(Route Volumes) of routes originating from it
  • Production House Total Outflow <= Production Capacity
  • Route Volume is itself a decision variable that depends on other variables not mentioned in this post

The mathematical representation of the constraints is as follows:

`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

In reality, I have thousands of rows. I tried to write the following code for the above 2 constraints. There will be 2 constraints:

#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

I am unable to proceed further to write the constraints. Please help guys. I haven't shared the objective as it has a lot of other constraints too.


Solution

  • Here is one example that tries to evenly distribute the route volume over the production houses

    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
    

    Note that if you have thousands of routes / production houses it might be more efficient to pre-allocate the constraints in make.lp and to use set.row instead of add.constraint. Here is an example for this, and with route_volume as additional decision variable, as requested in the comment:

    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))]