在R中使用lpsolve进行线性编程

Question

我在使用lpsolve包来解决R中的线性编程问题。

这里的问题是：

下面是重复的例子，在R上的样本：

library("lpSolve") 
a <- matrix(c(1,2,5, 
       1/2,1,3, 
       1/5,1/3,1),nrow=3,byrow=T) 

# 
f.obj <- c(1,0,0,0) 

f.con <- matrix (c(
    1,1,-a[1,2],0, #Contraint 1 for a12 
    1,-1,a[1,2],0, #Contraint 2 for a12 
    1,1,0,-a[1,3], #Contraint 1 for a13 
    1,-1,0,a[1,3], #Contraint 2 for a13 
    1,0,1,-a[2,3], #Contraint 1 for a23 
    1,0,-1,a[2,3], #Contraint 2 for a23 
    0,1,1,1, #Contraint 3 
    0,1,0,0, #Constraint 4 
    0,0,1,0, #Constraint 4 
    0,0,0,1 #Constraint 4 

), nrow=10, byrow=TRUE) 

f.dir <- c(rep("<=",6), "=",rep(">",3)) 

f.rhs <- c(rep(1,6),1,rep(0,3)) 

g <- lp ("max", f.obj, f.con, f.dir, f.rhs) 
g$solution 

我能如果什么手动解决这个问题的一个小问题，我有一个7 X 7或n x n矩阵a。我如何指定约束1和2，特别是我正在努力定义与[i，j]相关的约束？

a = matrix( 
    c(1,4,9,6,6,5,5, 
    1/4,1,7,5,5,3,4, 
    1/9,1/7,1,1/5,1/5,1/7,1/5, 
    1/6,1/5,5,1,1,1/3,1/3, 
    1/6,1/5,5,1,1,1/3,1/3, 
    1/5,1/3,7,3,3,1,2, 
    1/5,1/4,5,3,3,1/2,1 
),nrow = 7,byrow =T) 

上述矩阵的解决方案是0.986 0.501 0.160 0.043 0.060 0.060 0.1 0.075任何帮助将不胜感激。

Answer 1

这里有一种使用for循环的可能性。

正如我在评论中提到的那样，我认为你的条件（4）是错误的。这是我的建议。 我的想法是首先为约束（4）设置矩阵，然后为约束（3） 设置矩阵，然后在循环中添加约束（2）和（1）。请注意，在开始时，我不认为与\ mu对应的列。我将在最后添加此列。

n<- nrow(a) 
f.cons<- diag(n) 
f.cons<- rbind(f.cons, rep(1,n)) 

这设定了对应于约束（4）（前n行）和约束（3）的矩阵。现在我使用循环和命令rbind将行添加到此矩阵。

for(i in 1:(n-1)){ 
    for(j in (i+1): n){ 
    x<- rep(0, n) 
    x[i]<- 1 #x corresponds to (1) 
    x[j]<- -a[i,j] 
    y<- -x #y corresponds to (2) 
    f.cons<- rbind(f.cons, rbind(x, y)) 
} 

}

到目前为止，我已经忽略了第一列，其对应于\亩。 我与这两个简单的线条添加：

f.cons<- cbind(rep(1, nrow(f.cons)), f.cons) 
f.cons[1:(n+1), 1]=0 

注意，在我的矩阵f.cond第一n + 1行对应于约束（3）和（4）！

Answer 2

已更新以纳入修订约束条件4，并对代码进行了一些小改进。

假设问题中的约束矩阵是正确的，则使用combn遍历设置适当元素的所有i。请注意，x[1]是i的值，而x[2]是j的值在f中的值。 make_cons以与问题中所示相同的顺序返回约束矩阵，但如果可以使用此类顺序，make_cons中的rbind行可简化为rbind(cons1, cons2, cons3, cons4)。

make_cons <- function(a) { 
    n <- nrow(a) 
    f <- function(x) replace(numeric(n), x, c(1, -a[x[1], x[2]])) 
    cons1 <- cbind(1, t(combn(1:n, 2, f))) 
    cons2 <- cbind(1, -cons1[, -1]) 
    cons3 <- c(0, rep(1, n)) 
    cons4 <- cbind(0, diag(n)) 
    rbind(t(matrix(rbind(t(cons1), t(cons2)), ncol(cons1))), cons3, cons4) 
} 

# test 

# a and f.con from question 

a <- matrix(c(1, 0.5, 0.2, 2, 1, 0.333333333333333, 5, 3, 1), 3) 
f.con <- matrix(c(1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, -1, 1, -1, 0, 0, 
    1, 1, 0, 0, -2, 2, 0, 0, 1, -1, 1, 0, 1, 0, 0, 0, -5, 5, -3, 
    3, 1, 0, 0, 1), 10) 

all.equal(f.con, make_cons(a), check.attributes = FALSE) 
## [1] TRUE