在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