2016-12-07 11 views
3

Я пытаюсь решить проблему линейного программирования в R с использованием пакета lpsolve.Линейное программирование в R с использованием lpsolve

Вот проблема:

enter image description here

Вот пример в 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 Любая помощь будет высоко оценили.

+0

Привет, Я думаю, вы последняя строка в определении f.con не представляющих ограничение 4: 0,1,1,1 соответствует w_1 + w_2 + w_3. вместо этого он должен быть 0,1,0,0, [w_1> 0] \\ 0,0,1,0 [w_2> 0] \\ 0,0,0,1 [w_3> 0] – Cettt

+0

Hi @Cettt да, я получил свое условие 4 неправильно, спасибо, указав это. – forecaster

ответ

1

здесь есть одна возможность, которая используется для петель.

Как я упоминал в commenst, я думаю, что у вас есть условие (4) неправильно. Вот мое предложение. Моя идея - сначала установить матрицу для ограничений (4), затем для ограничения (3) , а затем добавить ограничения (2) и (1) в цикле. Обратите внимание, что в начале я не рассматриваю столбец, соответствующий \ mu. Я добавлю этот столбец в конце.

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

Это создает матрицу, соответствующие ограничения (4) (первые п строк) и ограничение (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 первых п + 1 строк соответствуют ограничениям (3) и (4)!

+0

Когда я запускаю первое прошлое вашего кода, я получаю 'Ошибка в rep (1, n): недопустимый аргумент« times »не уверен, что здесь не так. – forecaster

+0

Извините, первая строка должна быть: n <- nrow (a) not n <- dim (a), глупая ошибка – Cettt

+0

Спасибо. Он работает сейчас. +1 – forecaster

3

Обновлены, чтобы включить исправленное ограничение 4 и сделали некоторые незначительные улучшения кода.

Предполагая, что матрица ограничений в вопросе верна, это использует combn для перебора всех i < j, устанавливая соответствующие элементы. Обратите внимание, что x[1] является значением i и x[2] является значением j в f. make_cons возвращает матрицу ограничений в том же порядке, что и в вопросе, но строка rbind в make_cons может быть упрощена до 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 
+0

+1 очень эффективный код. Я сделал ошибку в ограничении 4, которое я теперь изменил в своем вопросе/примере. cons4 - 'cons4 <- cbind (0, diag (n))'. Еще раз спасибо – forecaster

+0

Спасибо за ответ, у меня очень похожий вопрос http://stackoverflow.com/questions/41027092/linear-goal-programming-in-r-unable-to-find-solutions. Буду признателен за ваш ответ. – forecaster