R/solveGP.R

In goalp: Weighted and Lexicographic Goal Programming Interface

#' Solves a weighted Linear Goal Programming problem
#'
#' Does not perform any check. It receives set of matrices and vectors
#' describing the original problem, and expands them adding the
#' corresponding deviations. It omits deviations with weight equal to NA.
#'
#' @param A Numeric matrix of coefficients of the goals (left-hand-side).
#' @param b Numerical vector. Right hand-side of the goals.
#' @param w Numerical matrix of the weights of the constrains. As many rows
#'          as goals, and two columns (positive and negative deviations).
#' @param varType Character vector. Type of each variable ("i", "c" or "b" for
#'                integer, continuous or binary, respectively). Must have as
#'                many elements as columns in \code{A}.
#' @param silent Logical. TRUE to prevent the function writing anything
#'               to the console (or the default output). Default is FALSE.
#' @return An lp object, generated by the lpSolve package, which in turn calls
#'         the lp_solve C package.
#' @importFrom stats setNames
solveGP <- function(A, b, w, varType, silent=FALSE){
  ### Set-up
  nC <- nrow(A)
  nV <- ncol(A)
  nD <- sum(!is.na(w))
  w_ <- rep(-1, nD)
  A_ <- matrix(0, nrow=nC, ncol=nD, dimnames=list(rownames(A), rep("", nD)))
  k  <- 1
  for(i in 1:nC) for(j in 1:2) if(!is.na(w[i,j])){
    colnames(A_)[k] <- paste0(rownames(A)[i], ifelse(j==1, "-", "+"))
    A_[i,k]         <- ifelse(j==1, 1, -1)
    w_[  k]         <- w[i,j]
    k               <- k + 1
  }; rm(i,j,k)
  A_ <- cbind(A, A_)
  w_ <- setNames(c(rep(0, nV), w_), colnames(A_))

  #print(rbind(A_, weight=w_)) ### DEBUG

  ### Solve
  lp <- lpSolve::lp(direction="min", objective.in=w_,
                    const.mat=A_, const.dir="=", const.rhs=b,
                    int.vec=which(varType=="i"), binary.vec=which(varType=="b"),
                    compute.sens=0, scale = 196)
  if(lp$status==2){
    if(!silent) msg("No feasible solution found for the underlying ",
                    "linear optimisation problem.")
    if(is.null(lp$solution)) lp$solution <- setNames(rep(NA, length(w_)),
                                                     names(w_))
  }

  ### Return
  return(lp)
}