Question

从simplex库中使用boot时，从R: Simplex error: NAs are not allowed in subscripted assignments和A basic example of the simplex function in R with errors可以看出，在指定>=约束类型时会出现错误，但不能<=。

失败的基本示例：

library(boot)
a = c(1, 1, 1)
A2 = rbind(c(2, 7.5, 3), c(20, 5, 10))
b2 = c(10000, 30000)
simplex(a=a, A2=A2, b2=b2, maxi=FALSE)

使用任意可实现的<=约束时，它不会失败：

  library(boot)
    a = c(1, 1, 1)
    A2 = rbind(c(2, 7.5, 3), c(20, 5, 10))
    b2 = c(10000, 30000)
    simplex(a=a, A1=c(1,1,1),b1 = 1.0E+12,A2=A2, b2=b2, maxi=FALSE)

这是来自simplex的错误，还是我使用错了？

Answer 1

我终于编辑了simplex函数以添加琐碎约束a<=Inf：

simplex <- function(a,A1=NULL,b1=NULL,A2=NULL,b2=NULL,A3=NULL,b3=NULL,
                    maxi=FALSE, n.iter=n+2*m, eps=1e-10)
  #
  #   This function calculates the solution to a linear programming
  #   problem using the tableau simplex method.  The constraints are
  #   given by the matrices A1, A2, A3 and the vectors b1, b2 and b3
  #   such that A1%*%x <= b1, A2%*%x >= b2 and A3%*%x = b3.  The 2-phase
  #   Simplex method is used.
  #
{
  call <- match.call()
  if (!is.null(A1))
    if (is.matrix(A1))
      m1 <- nrow(A1)
    else    m1 <- 1
    else    {m1 <- 1
    A1=a #####HERE INSERT TRIVIAL CONSTRAINT
    b1=Inf #####HERE INSERT TRIVIAL CONSTRAINT
    }
    if (!is.null(A2))
      if (is.matrix(A2))
        m2 <- nrow(A2)
      else  m2 <- 1
      else  m2 <- 0
      if (!is.null(A3))
        if (is.matrix(A3))
          m3 <- nrow(A3)
        else    m3 <- 1
        else    m3 <- 0
        m <- m1+m2+m3
        n <- length(a)
        a.o <- a
        if (maxi) a <- -a
        if (m2+m3 == 0)
          # If there are no >= or = constraints then the origin is a feasible
          # solution, and so only the second phase is required.
          out <- simplex1(c(a,rep(0,m1)), cbind(A1,iden(m1)), b1,
                          c(rep(0,m1),b1), n+(1L:m1), eps=eps)
        else {
          if (m2 > 0)
            out1 <- simplex1(c(a,rep(0,m1+2*m2+m3)),
                             cbind(rbind(A1,A2,A3),
                                   rbind(iden(m1),zero(m2+m3,m1)),
                                   rbind(zero(m1,m2),-iden(m2),
                                         zero(m3,m2)),
                                   rbind(zero(m1,m2+m3),
                                         iden(m2+m3))),
                             c(b1,b2,b3),
                             c(rep(0,n),b1,rep(0,m2),b2,b3),
                             c(n+(1L:m1),(n+m1+m2)+(1L:(m2+m3))),
                             stage=1, n1=n+m1+m2,
                             n.iter=n.iter, eps=eps)
          else
            out1 <- simplex1(c(a,rep(0,m1+m3)),
                             cbind(rbind(A1,A3),
                                   iden(m1+m3)),
                             c(b1,b3),
                             c(rep(0,n),b1,b3),
                             n+(1L:(m1+m3)), stage=1, n1=n+m1,
                             n.iter=n.iter, eps=eps)
          #  In phase 1 use 1 artificial variable for each constraint and
          #  minimize the sum of the artificial variables.  This gives a
          #  feasible solution to the original problem as long as all
          #  artificial variables are non-basic (and hence the value of the
          #  new objective function is 0).  If this is true then optimize the
          #  original problem using the result as the original feasible solution.
          if (out1$val.aux > eps)
            out <- out1
          else  out <- simplex1(out1$a[1L:(n+m1+m2)],
                               out1$A[,1L:(n+m1+m2)],
                               out1$soln[out1$basic],
                               out1$soln[1L:(n+m1+m2)],
                               out1$basic,
                               val=out1$value, n.iter=n.iter, eps=eps)
        }
        if (maxi)
          out$value <- -out$value
        out$maxi <- maxi
        if (m1 > 0L)
          out$slack <- out$soln[n+(1L:m1)]
        if (m2 > 0L)
          out$surplus <- out$soln[n+m1+(1L:m2)]
        if (out$solved == -1)
          out$artificial <- out$soln[-(1L:n+m1+m2)]
        out$obj <- a.o
        names(out$obj) <- paste("x",seq_len(n),sep="")
        out$soln <- out$soln[seq_len(n)]
        names(out$soln) <- paste("x",seq_len(n),sep="")
        out$call <- call
        class(out) <- "simplex"
        out
}

所以

library("boot")    
a <- c(2500, 3500)
A2 <- matrix(c(50, 150, 500, 250), ncol=2, nrow=2, byrow=TRUE)
b2 <- c(900, 2500)
simplex(a,A2 = A2, b2 = b2, maxi=FALSE)

收益：

线性编程结果

调用：simplex（a = a，A2 = A2，b2 = b2，maxi = FALSE）

Minimization Problem with Objective Function Coefficients
  x1   x2 
2500 3500 


Optimal solution has the following values
 x1  x2 
2.4 5.2 
The optimal value of the objective  function is 24200.

仅使用> =约束类型时的单纯形错误

1 个答案: