linprog/0000755000176200001440000000000014212213660011721 5ustar liggesuserslinprog/NAMESPACE0000644000176200001440000000030414212153473013142 0ustar liggesusersexport( "readMps" ) export( "solveLP" ) export( "writeMps" ) importFrom( "lpSolve", "lp" ) S3method( "print", "solveLP" ) S3method( "print", "summary.solveLP" ) S3method( "summary", "solveLP" ) linprog/man/0000755000176200001440000000000012272451536012506 5ustar liggesuserslinprog/man/solveLP.Rd0000644000176200001440000001753414212160354014362 0ustar liggesusers\name{solveLP} \alias{solveLP} \title{Solve Linear Programming / Optimization Problems} \description{ Minimizes (or maximizes) \eqn{c'x}, subject to \eqn{A x <= b} and \eqn{x >= 0}. Note that the inequality signs \code{<=} of the individual linear constraints in \eqn{A x <= b} can be changed with argument \code{const.dir}. } \usage{ solveLP( cvec, bvec, Amat, maximum = FALSE, const.dir = rep( "<=", length( bvec ) ), maxiter = 1000, zero = 1e-9, tol = 1e-6, dualtol = tol, lpSolve = FALSE, solve.dual = FALSE, verbose = 0 ) } \arguments{ \item{cvec}{vector \eqn{c} (containing \eqn{n} elements).} \item{bvec}{vector \eqn{b} (containing \eqn{m} elements).} \item{Amat}{matrix A (of dimension \eqn{m \times n}).} \item{maximum}{logical. Should we maximize or minimize (the default)?} \item{const.dir}{vector of character strings giving the directions of the constraints: each value should be one of "<," "<=," "=," "==," ">," or ">=". (In each pair the two values are identical.)} \item{maxiter}{maximum number of iterations.} \item{zero}{numbers smaller than this value (in absolute terms) are set to zero.} \item{tol}{if the constraints are violated by more than this number, the returned component \code{status} is set to \code{3}.} \item{dualtol}{if the constraints in the dual problem are violated by more than this number, the returned status is non-zero.} \item{lpSolve}{logical. Should the package 'lpSolve' be used to solve the LP problem?} \item{solve.dual}{logical value indicating if the dual problem should also be solved.} \item{verbose}{an optional integer variable to indicate how many intermediate results should be printed (0 = no output; 4 = maximum output).} } \details{ This function uses the Simplex algorithm of George B. Dantzig (1947) and provides detailed results (e.g. dual prices, sensitivity analysis and stability analysis).\cr If the solution \eqn{x=0} is not feasible, a 2-phase procedure is applied.\cr Values of the simplex tableau that are actually zero might get small (positive or negative) numbers due to rounding errors, which might lead to artificial restrictions. Therefore, all values that are smaller (in absolute terms) than the value of \code{zero} (default is 1e-10) are set to 0.\cr Solving the Linear Programming problem by the package \code{lpSolve} (of course) requires the installation of this package, which is available on CRAN (\url{https://cran.r-project.org/package=lpSolve}). Since the \code{lpSolve} package uses C-code and this (\code{linprog}) package is not optimized for speed, the former is much faster. However, this package provides more detailed results (e.g. dual values, stability and sensitivity analysis).\cr This function has not been tested extensively and might not solve all feasible problems (or might even lead to wrong results). However, you can export your LP to a standard MPS file via \code{\link{writeMps}} and check it with other software (e.g. \code{lp_solve}, see \url{http://lpsolve.sourceforge.net/5.5/}).\cr Equality constraints are not implemented yet. } \value{ \code{solveLP} returns a list of the class \code{solveLP} containing following objects: \item{opt}{optimal value (minimum or maximum) of the objective function.} \item{solution}{vector of optimal values of the variables.} \item{iter1}{iterations of Simplex algorithm in phase 1.} \item{iter2}{iterations of Simplex algorithm in phase 2.} \item{basvar}{vector of basic (=non-zero) variables (at optimum).} \item{con}{matrix of results regarding the constraints:\cr 1st column = maximum values (=vector \eqn{b});\cr 2nd column = actual values;\cr 3rd column = differences between maximum and actual values;\cr 4th column = dual prices (shadow prices);\cr 5th column = valid region for dual prices.} \item{allvar}{matrix of results regarding all variables (including slack variables):\cr 1st column = optimal values;\cr 2nd column = values of vector \eqn{c};\cr 3rd column = minimum of vector \eqn{c} that does \emph{not} change the solution;\cr 4th column = maximum of vector \eqn{c} that does \emph{not} change the solution;\cr 5th column = derivatives to the objective function;\cr 6th column = valid region for these derivatives.} \item{status}{numeric. Indicates if the optimization did succeed:\cr 0 = success; 1 = lpSolve did not succeed; 2 = solving the dual problem did not succeed; 3 = constraints are violated at the solution (internal error or large rounding errors); 4 = simplex algorithm phase 1 did not find a solution within the number of iterations specified by argument \code{maxiter}; 5 = simplex algorithm phase 2 did not find the optimal solution within the number of iterations specified by argument \code{maxiter}.} \item{lpStatus}{numeric. Return code of \code{\link[lpSolve]{lp}} (only if argument \code{lpSolve} is \code{TRUE}).} \item{dualStatus}{numeric. Return code from solving the dual problem (only if argument \code{solve.dual} is \code{TRUE}).} \item{maximum}{logical. Indicates whether the objective function was maximized or minimized.} \item{Tab}{final 'Tableau' of the Simplex algorith.} \item{lpSolve}{logical. Has the package 'lpSolve' been used to solve the LP problem.} \item{solve.dual}{logical. Argument \code{solve.dual}.} \item{maxiter}{numeric. Argument \code{maxiter}.} } \references{ Dantzig, George B. (1951), \emph{Maximization of a linear function of variables subject to linear inequalities}, in Koopmans, T.C. (ed.), Activity analysis of production and allocation, John Wiley \& Sons, New York, p. 339-347. Steinhauser, Hugo; Cay Langbehn and Uwe Peters (1992), Einfuehrung in die landwirtschaftliche Betriebslehre. Allgemeiner Teil, 5th ed., Ulmer, Stuttgart. Witte, Thomas; Joerg-Frieder Deppe and Axel Born (1975), Lineare Programmierung. Einfuehrung fuer Wirtschaftswissenschaftler, Gabler-Verlag, Wiesbaden. } \author{ Arne Henningsen } \seealso{ \code{\link{readMps}} and \code{\link{writeMps}} } \examples{ ## example of Steinhauser, Langbehn and Peters (1992) ## Production activities cvec <- c(1800, 600, 600) # gross margins names(cvec) <- c("Cows","Bulls","Pigs") ## Constraints (quasi-fix factors) bvec <- c(40, 90, 2500) # endowment names(bvec) <- c("Land","Stable","Labor") ## Needs of Production activities Amat <- rbind( c( 0.7, 0.35, 0 ), c( 1.5, 1, 3 ), c( 50, 12.5, 20 ) ) ## Maximize the gross margin solveLP( cvec, bvec, Amat, TRUE ) ## example 1.1.3 of Witte, Deppe and Born (1975) ## Two types of Feed cvec <- c(2.5, 2 ) # prices of feed names(cvec) <- c("Feed1","Feed2") ## Constraints (minimum (<0) and maximum (>0) contents) bvec <- c(-10, -1.5, 12) names(bvec) <- c("Protein","Fat","Fibre") ## Matrix A Amat <- rbind( c( -1.6, -2.4 ), c( -0.5, -0.2 ), c( 2.0, 2.0 ) ) ## Minimize the cost solveLP( cvec, bvec, Amat ) # the same optimisation using argument const.dir solveLP( cvec, abs( bvec ), abs( Amat ), const.dir = c( ">=", ">=", "<=" ) ) ## There are also several other ways to put the data into the arrays, e.g.: bvec <- c( Protein = -10.0, Fat = -1.5, Fibre = 12.0 ) cvec <- c( Feed1 = 2.5, Feed2 = 2.0 ) Amat <- matrix( 0, length(bvec), length(cvec) ) rownames(Amat) <- names(bvec) colnames(Amat) <- names(cvec) Amat[ "Protein", "Feed1" ] <- -1.6 Amat[ "Fat", "Feed1" ] <- -0.5 Amat[ "Fibre", "Feed1" ] <- 2.0 Amat[ "Protein", "Feed2" ] <- -2.4 Amat[ "Fat", "Feed2" ] <- -0.2 Amat[ "Fibre", "Feed2" ] <- 2.0 solveLP( cvec, bvec, Amat ) } \keyword{optimize} linprog/man/readMps.Rd0000644000176200001440000000342314212155700014360 0ustar liggesusers\name{readMps} \alias{readMps} \title{Read MPS Files} \description{ This function reads MPS files - the standard format for Linear Programming problems. } \usage{ readMps( file, solve=FALSE, maximum=FALSE ) } \arguments{ \item{file}{a character string naming the file to read.} \item{solve}{logical. Should the problem be solved after reading it from the file (using \code{\link{solveLP}})?} \item{maximum}{logical. Should we maximize or minimize (the default)?} } \details{ Equality constraints and 'greater than'-bounds are not implemented yet. } \value{ \code{readMps} returns a list containing following objects: \item{name}{the name of the Linear Programming problem.} \item{cvec}{vector \eqn{c}.} \item{bvec}{vector \eqn{b}.} \item{Amat}{matrix \eqn{A}.} \item{res}{if \code{solve} is TRUE, it contains the results of the solving process (an object of class \code{\link{solveLP}}).} } \author{ Arne Henningsen } \seealso{ \code{\link{solveLP}}, \code{\link{writeMps}} } \examples{ ## example of Steinhauser, Langbehn and Peters (1992) ## Production activities cvec <- c(1800, 600, 600) # gross margins names(cvec) <- c("Cows","Bulls","Pigs") ## Constraints (quasi-fix factors) bvec <- c(40, 90, 2500) # endowment names(bvec) <- c("Land","Stable","Labor") ## Needs of Production activities Amat <- rbind( c( 0.7, 0.35, 0 ), c( 1.5, 1, 3 ), c( 50, 12.5, 20 ) ) ## Write to MPS file writeMps( "steinh.mps", cvec, bvec, Amat, "Steinhauser" ) ## delete all LP objects rm( cvec, bvec, Amat ) ## Read LP data from MPS file and solve it. lp <- readMps( "steinh.mps", TRUE, TRUE ) ## Print the results lp$res ## remove the MPS file file.remove( "steinh.mps" ) } \keyword{ optimize } linprog/man/writeMps.Rd0000644000176200001440000000243114212160375014601 0ustar liggesusers\name{writeMps} \alias{writeMps} \title{Write MPS Files} \description{ This function writes MPS files - the standard format for Linear Programming problems. } \usage{ writeMps( file, cvec, bvec, Amat, name="LP" ) } \arguments{ \item{file}{a character string naming the file to write.} \item{cvec}{vector \eqn{c}.} \item{bvec}{vector \eqn{b}.} \item{Amat}{matrix \eqn{A}.} \item{name}{an optional name for the Linear Programming problem.} } \details{ The exported LP can be solved by running other software on this MPS file (e.g. \code{lp_solve}, see \url{http://lpsolve.sourceforge.net/5.5/}). } \author{Arne Henningsen} \seealso{\code{\link{solveLP}}, \code{\link{readMps}} } \examples{ ## example of Steinhauser, Langbehn and Peters (1992) ## Production activities cvec <- c(1800, 600, 600) # gross margins names(cvec) <- c("Cows","Bulls","Pigs") ## Constraints (quasi-fix factors) bvec <- c(40, 90, 2500) # endowment names(bvec) <- c("Land","Stable","Labor") ## Needs of Production activities Amat <- rbind( c( 0.7, 0.35, 0 ), c( 1.5, 1, 3 ), c( 50, 12.5, 20 ) ) ## Write to MPS file writeMps( "steinh.mps", cvec, bvec, Amat, "Steinhauser" ) ## remove the MPS file file.remove( "steinh.mps" ) } \keyword{ optimize } linprog/man/summary.solveLP.Rd0000644000176200001440000000265411364313275016062 0ustar liggesusers\name{summary.solveLP} \alias{summary.solveLP} \alias{print.summary.solveLP} \title{Summary Results for Objects of Class solveLP} \description{ These methods prepare and print summary results of the Linear Programming algorithm. } \usage{ \method{summary}{solveLP}(object,...) \method{print}{summary.solveLP}(x,...) } \arguments{ \item{object}{an object returned by \code{\link{solveLP}}.} \item{x}{an object returned by \code{summary.solveLP}.} \item{...}{currently ignored.} } \value{ \code{summary.solveLP} returns an object of class \code{summary.solveLP}. \code{print.summary.solveLP} invisibly returns the object given in argument \code{x}. } \author{ Arne Henningsen } \seealso{ \code{\link{solveLP}}, \code{\link{print.solveLP}}, \code{\link{readMps}}, \code{\link{writeMps}} } \examples{ ## example of Steinhauser, Langbehn and Peters (1992) \dontrun{library( linprog )} ## Production activities cvec <- c(1800, 600, 600) # gross margins names(cvec) <- c("Milk","Bulls","Pigs") ## Constraints (quasi-fix factors) bvec <- c(40, 90, 2500) # endowment names(bvec) <- c("Land","Stable","Labor") ## Needs of Production activities Amat <- rbind( c( 0.7, 0.35, 0 ), c( 1.5, 1, 3 ), c( 50, 12.5, 20 ) ) ## Maximize the gross margin res <- solveLP( cvec, bvec, Amat, TRUE ) ## prepare and print the summary results summary( res ) } \keyword{ optimize } linprog/man/print.solveLP.Rd0000644000176200001440000000230411364313275015511 0ustar liggesusers\name{print.solveLP} \alias{print.solveLP} \title{Print Objects of Class solveLP} \description{ This method prints the results of the Linear Programming algorithm. } \usage{ \method{print}{solveLP}( x, digits=6, ...) } \arguments{ \item{x}{an object returned by \code{\link{solveLP}}.} \item{digits}{number of digits to print.} \item{...}{currently ignored.} } \value{ \code{print.solveLP} invisibly returns the object given in argument \code{x}. } \author{ Arne Henningsen } \seealso{ \code{\link{solveLP}}, \code{\link{summary.solveLP}}, \code{\link{readMps}}, \code{\link{writeMps}} } \examples{ ## example of Steinhauser, Langbehn and Peters (1992) \dontrun{library( linprog )} ## Production activities cvec <- c(1800, 600, 600) # gross margins names(cvec) <- c("Milk","Bulls","Pigs") ## Constraints (quasi-fix factors) bvec <- c(40, 90, 2500) # endowment names(bvec) <- c("Land","Stable","Labor") ## Needs of Production activities Amat <- rbind( c( 0.7, 0.35, 0 ), c( 1.5, 1, 3 ), c( 50, 12.5, 20 ) ) ## Maximize the gross margin res <- solveLP( cvec, bvec, Amat, TRUE ) ## print the results print( res ) } \keyword{ optimize } linprog/DESCRIPTION0000644000176200001440000000077114212213660013434 0ustar liggesusersPackage: linprog Version: 0.9-4 Date: 2022-03-09 Title: Linear Programming / Optimization Author: Arne Henningsen Maintainer: Arne Henningsen Depends: R (>= 2.4.0), lpSolve Description: Can be used to solve Linear Programming / Linear Optimization problems by using the simplex algorithm. License: GPL (>= 2) URL: http://linprog.r-forge.r-project.org/ NeedsCompilation: no Packaged: 2022-03-09 17:21:04 UTC; gsl324 Repository: CRAN Date/Publication: 2022-03-09 21:10:08 UTC linprog/tests/0000755000176200001440000000000012272451536013075 5ustar liggesuserslinprog/tests/MpsTests.Rout.save0000644000176200001440000001552511364313275016475 0ustar liggesusers R version 2.10.1 (2009-12-14) Copyright (C) 2009 The R Foundation for Statistical Computing ISBN 3-900051-07-0 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library( linprog ) Loading required package: lpSolve > > ## example of Steinhauser, Langbehn and Peters (1992) > ## Production activities > cvec <- c(1800, 600, 600) # gross margins > names(cvec) <- c("Cows","Bulls","Pigs") > > ## Constraints (quasi-fix factors) > bvec <- c(40, 90, 2500) # endowment > names(bvec) <- c("Land","Stable","Labor") > > ## Needs of Production activities > Amat <- rbind( c( 0.7, 0.35, 0 ), + c( 1.5, 1, 3 ), + c( 50, 12.5, 20 ) ) > > ## solve the model > result1a <- solveLP( cvec, bvec, Amat, TRUE ) > > ## Write to a (virtual) MPS file > mpsFile <- file() > writeMps( mpsFile, cvec, bvec, Amat, "Steinhauser" ) > > ## write the lines of this file to the output file > mpsLines <- readLines( mpsFile ) > close( mpsFile ) > print( mpsLines ) [1] "NAME Steinhauser" [2] "ROWS" [3] " N obj" [4] " L Land" [5] " L Stable" [6] " L Labor" [7] "COLUMNS" [8] " Cows obj 1800" [9] " Cows Land 0.7" [10] " Cows Stable 1.5" [11] " Cows Labor 50" [12] " Bulls obj 600" [13] " Bulls Land 0.35" [14] " Bulls Stable 1" [15] " Bulls Labor 12.5" [16] " Pigs obj 600" [17] " Pigs Stable 3" [18] " Pigs Labor 20" [19] "RHS" [20] " RHS Land 40" [21] " RHS Stable 90" [22] " RHS Labor 2500" [23] "ENDATA" > > ## Write to a (virtual) MPS file again (for readMps) > mpsFile <- file() > writeMps( mpsFile, cvec, bvec, Amat, "Steinhauser" ) > > ## delete all LP objects > rm( cvec, bvec, Amat ) > > ## Read LP data from MPS file and solve it. > lpModel <- readMps( mpsFile, TRUE, TRUE ) > close( mpsFile ) > > ## Print the model and its result > lpModel $name [1] "Steinhauser" $cvec Cows Bulls Pigs 1800 600 600 $bvec Land Stable Labor 40 90 2500 $Amat Cows Bulls Pigs Land 0.7 0.35 0 Stable 1.5 1.00 3 Labor 50.0 12.50 20 $res Results of Linear Programming / Linear Optimization Objective function (Maximum): 93600 Iterations in phase 1: 0 Iterations in phase 2: 2 Solution opt Cows 44 Bulls 24 Pigs 0 Basic Variables opt Cows 44.0 Bulls 24.0 S Land 0.8 Constraints actual dir bvec free dual dual.reg Land 39.2 <= 40 0.8 0.0 0.8 Stable 90.0 <= 90 0.0 240.0 15.0 Labor 2500.0 <= 2500 0.0 28.8 1375.0 All Variables (including slack variables) opt cvec min.c max.c marg marg.reg Cows 44.0 1800 900 2400.000 NA NA Bulls 24.0 600 450 1200.000 NA NA Pigs 0.0 600 -Inf 1296.000 -696.0 6.25 S Land 0.8 0 NA 731.092 0.0 NA S Stable 0.0 0 -Inf 240.000 -240.0 15.00 S Labor 0.0 0 -Inf 28.800 -28.8 1375.00 > all.equal( result1a, lpModel$res ) [1] TRUE > > > ## example 1.1.3 of Witte, Deppe and Born (1975) > ## Two types of Feed > cvec <- c(2.5, 2 ) # prices of feed > names(cvec) <- c("Feed1","Feed2") > > ## Constraints (minimum (<0) and maximum (>0) contents) > bvec <- c(-10, -1.5, 12) > names(bvec) <- c("Protein","Fat","Fibre") > > ## Matrix A > Amat <- rbind( c( -1.6, -2.4 ), + c( -0.5, -0.2 ), + c( 2.0, 2.0 ) ) > > ## solve the model > result2a <- solveLP( cvec, bvec, Amat ) > > ## Write to a (virtual) MPS file > mpsFile <- file() > writeMps( mpsFile, cvec, bvec, Amat, "Steinhauser" ) > > ## write the lines of this file to the output file > mpsLines <- readLines( mpsFile ) > close( mpsFile ) > print( mpsLines ) [1] "NAME Steinhauser" [2] "ROWS" [3] " N obj" [4] " L Protein" [5] " L Fat" [6] " L Fibre" [7] "COLUMNS" [8] " Feed1 obj 2.5" [9] " Feed1 Protein -1.6" [10] " Feed1 Fat -0.5" [11] " Feed1 Fibre 2" [12] " Feed2 obj 2" [13] " Feed2 Protein -2.4" [14] " Feed2 Fat -0.2" [15] " Feed2 Fibre 2" [16] "RHS" [17] " RHS Protein -10" [18] " RHS Fat -1.5" [19] " RHS Fibre 12" [20] "ENDATA" > > ## Write to a (virtual) MPS file again (for readMps) > mpsFile <- file() > writeMps( mpsFile, cvec, bvec, Amat, "Steinhauser" ) > > ## delete all LP objects > rm( cvec, bvec, Amat ) > > ## Read LP data from MPS file and solve it. > lpModel <- readMps( mpsFile, TRUE ) > close( mpsFile ) > > ## Print the model and its result > lpModel $name [1] "Steinhauser" $cvec Feed1 Feed2 2.5 2.0 $bvec Protein Fat Fibre -10.0 -1.5 12.0 $Amat Feed1 Feed2 Protein -1.6 -2.4 Fat -0.5 -0.2 Fibre 2.0 2.0 $res Results of Linear Programming / Linear Optimization Objective function (Minimum): 10.4545 Iterations in phase 1: 2 Iterations in phase 2: 0 Solution opt Feed1 1.81818 Feed2 2.95455 Basic Variables opt Feed1 1.81818 Feed2 2.95455 S Fibre 2.45455 Constraints actual dir bvec free dual dual.reg Protein -10.00000 <= -10.0 0.00000 0.568182 3.60000 Fat -1.50000 <= -1.5 0.00000 3.181818 1.35000 Fibre 9.54545 <= 12.0 2.45455 0.000000 2.45455 All Variables (including slack variables) opt cvec min.c max.c marg marg.reg Feed1 1.81818 2.5 -3.666667 5.000000 NA NA Feed2 2.95455 2.0 -3.000000 3.750000 NA NA S Protein 0.00000 0.0 -0.568182 Inf 0.568182 3.60 S Fat 0.00000 0.0 -3.181818 Inf 3.181818 1.35 S Fibre 2.45455 0.0 NA 0.833333 0.000000 NA > all.equal( result2a, lpModel$res ) [1] TRUE > linprog/tests/equality_test.Rout.save0000644000176200001440000000701312037467513017603 0ustar liggesusers R version 2.15.1 (2012-06-22) -- "Roasted Marshmallows" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library( "linprog" ) Loading required package: lpSolve > > # min x1 + x2, s.t. x1 + 0.5 * x2 = 2 > cvec <- c( 1, 1 ) > Amat <- matrix( c( 1, 0.5 ), nrow = 1 ) > bvec <- 2 > a1 <- solveLP( cvec, bvec, Amat, const.dir = "=" ) Warning message: In solveLP(cvec, bvec, Amat, const.dir = "=") : solveLP() might return incorrect results if the model includes equality constraints and argument 'lpSolve' is 'FALSE'; please check if solveLP() returns the same results with argument 'lpSolve' equal to 'TRUE'; more information on this bug available at linprog's R-Forge site > print( a1 ) Results of Linear Programming / Linear Optimization Objective function (Minimum): 0 Iterations in phase 1: 0 Iterations in phase 2: 0 Solution opt 1 0 2 0 Basic Variables opt S 1 0 Constraints actual dir bvec free dual dual.reg 1 2 = 2 0 0 NA All Variables (including slack variables) opt cvec min.c max.c marg marg.reg 1 0 1 99 77 1 Inf 2 0 1 99 77 1 Inf S 1 0 0 NA NA 0 NA > > a2 <- solveLP( cvec, bvec, Amat, const.dir = "=", lpSolve = TRUE ) > print( a2 ) Results of Linear Programming / Linear Optimization (using lpSolve) Objective function (Minimum): 2 Solution opt 1 2 2 0 Constraints actual dir bvec free 1 2 = 2 0 > > # max 27 * x1 + 9 * x2 > # s.t. x1 - x2 = 8 & x1 + x2 <= 74 > cvec <- c( 27, 9 ) > bvec <- c( 8, 74 ) > Amat <- matrix( c( 1, 1, -1, 1 ), nrow = 2 ) > b1 <- solveLP( cvec, bvec, Amat, maximum = TRUE, const.dir = c( "==", "<=" ) ) Warning message: In solveLP(cvec, bvec, Amat, maximum = TRUE, const.dir = c("==", : solveLP() might return incorrect results if the model includes equality constraints and argument 'lpSolve' is 'FALSE'; please check if solveLP() returns the same results with argument 'lpSolve' equal to 'TRUE'; more information on this bug available at linprog's R-Forge site > print( b1 ) Results of Linear Programming / Linear Optimization Objective function (Maximum): 1998 Iterations in phase 1: 0 Iterations in phase 2: 1 Solution opt 1 74 2 0 Basic Variables opt 1 74 S 1 0 Constraints actual dir bvec free dual dual.reg 1 8 == 8 0 0 NA 2 74 <= 74 0 27 74 All Variables (including slack variables) opt cvec min.c max.c marg marg.reg 1 74 27 9 Inf NA NA 2 0 9 -Inf 27 -18 74 S 1 0 0 -Inf Inf 0 NA S 2 0 0 -Inf 27 -27 74 > > b2 <- solveLP( cvec, bvec, Amat, maximum = TRUE, const.dir = c( "==", "<=" ), + lpSolve = TRUE ) > print( b2 ) Results of Linear Programming / Linear Optimization (using lpSolve) Objective function (Maximum): 1404 Solution opt 1 41 2 33 Constraints actual dir bvec free 1 8 == 8 0 2 74 <= 74 0 > > proc.time() user system elapsed 0.152 0.032 0.170 linprog/tests/equality_test.R0000644000176200001440000000115212037467421016112 0ustar liggesuserslibrary( "linprog" ) # min x1 + x2, s.t. x1 + 0.5 * x2 = 2 cvec <- c( 1, 1 ) Amat <- matrix( c( 1, 0.5 ), nrow = 1 ) bvec <- 2 a1 <- solveLP( cvec, bvec, Amat, const.dir = "=" ) print( a1 ) a2 <- solveLP( cvec, bvec, Amat, const.dir = "=", lpSolve = TRUE ) print( a2 ) # max 27 * x1 + 9 * x2 # s.t. x1 - x2 = 8 & x1 + x2 <= 74 cvec <- c( 27, 9 ) bvec <- c( 8, 74 ) Amat <- matrix( c( 1, 1, -1, 1 ), nrow = 2 ) b1 <- solveLP( cvec, bvec, Amat, maximum = TRUE, const.dir = c( "==", "<=" ) ) print( b1 ) b2 <- solveLP( cvec, bvec, Amat, maximum = TRUE, const.dir = c( "==", "<=" ), lpSolve = TRUE ) print( b2 ) linprog/tests/linprog_tests.Rout.save0000644000176200001440000006400514212154560017577 0ustar liggesusers R version 4.1.2 (2021-11-01) -- "Bird Hippie" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library( linprog ) Loading required package: lpSolve > > ## Example 1 > ## Steinhauser, Langbehn and Peters (1992) > cvec <- c(1800, 600, 600) # gross margins > names(cvec) <- c("Cows","Bulls","Pigs") > bvec <- c(40, 90, 2500) # endowment > names(bvec) <- c("Land","Stable","Labor") > Amat <- rbind( c( 0.7, 0.35, 0 ), + c( 1.5, 1, 3 ), + c( 50, 12.5, 20 ) ) > result1a <- solveLP( cvec, bvec, Amat, TRUE, verbose = 1 ) > print( result1a ) Results of Linear Programming / Linear Optimization Objective function (Maximum): 93600 Iterations in phase 1: 0 Iterations in phase 2: 2 Solution opt Cows 44 Bulls 24 Pigs 0 Basic Variables opt Cows 44.0 Bulls 24.0 S Land 0.8 Constraints actual dir bvec free dual dual.reg Land 39.2 <= 40 0.8 0.0 0.8 Stable 90.0 <= 90 0.0 240.0 15.0 Labor 2500.0 <= 2500 0.0 28.8 1375.0 All Variables (including slack variables) opt cvec min.c max.c marg marg.reg Cows 44.0 1800 900 2400.000 NA NA Bulls 24.0 600 450 1200.000 NA NA Pigs 0.0 600 -Inf 1296.000 -696.0 6.25 S Land 0.8 0 NA 731.092 0.0 NA S Stable 0.0 0 -Inf 240.000 -240.0 15.00 S Labor 0.0 0 -Inf 28.800 -28.8 1375.00 > # print summary results > summary( result1a ) Results of Linear Programming / Linear Optimization Objective function (Maximum): 93600 Solution opt Cows 44 Bulls 24 Pigs 0 > # print all elements of the returned object > print.default( result1a ) $status [1] 0 $opt [1] 93600 $iter1 [1] 0 $iter2 [1] 2 $allvar opt cvec min.c max.c marg marg.reg Cows 44.0 1800 900 2400.0000 NA NA Bulls 24.0 600 450 1200.0000 NA NA Pigs 0.0 600 -Inf 1296.0000 -696.0 6.25 S Land 0.8 0 NA 731.0924 0.0 NA S Stable 0.0 0 -Inf 240.0000 -240.0 15.00 S Labor 0.0 0 -Inf 28.8000 -28.8 1375.00 $basvar opt Cows 44.0 Bulls 24.0 S Land 0.8 $solution Cows Bulls Pigs 44 24 0 $con actual dir bvec free dual dual.reg Land 39.2 <= 40 0.8 0.0 0.8 Stable 90.0 <= 90 0.0 240.0 15.0 Labor 2500.0 <= 2500 0.0 28.8 1375.0 $Tab Cows Bulls Pigs S Land S Stable S Labor P0 Land 0 0 -0.952 1 -0.28 -0.0056 0.8 Bulls 0 1 3.840 0 1.60 -0.0480 24.0 Cows 1 0 -0.560 0 -0.40 0.0320 44.0 Z-C 0 0 696.000 0 240.00 28.8000 93600.0 $maximum [1] TRUE $lpSolve [1] FALSE $solve.dual [1] FALSE $maxiter [1] 1000 attr(,"class") [1] "solveLP" > # also estimate the dual problem > result1aD <- solveLP( cvec, bvec, Amat, TRUE, verbose = 1, solve.dual = TRUE ) > result1aD$con actual dir bvec free dual dual.reg dual.p Land 39.2 <= 40 0.8 0.0 0.8 0.0 Stable 90.0 <= 90 0.0 240.0 15.0 240.0 Labor 2500.0 <= 2500 0.0 28.8 1375.0 28.8 > all.equal( result1a[-c(8,12)], result1aD[-c(8,10,13)] ) [1] TRUE > > # estimation with verbose = TRUE > result1b <- solveLP( cvec, bvec, Amat, TRUE, verbose = 4 ) [1] "initial Tableau" Cows Bulls Pigs S Land S Stable S Labor P0 Land 0.7 0.35 0 1 0 0 40 Stable 1.5 1.00 3 0 1 0 90 Labor 50.0 12.50 20 0 0 1 2500 Z-C -1800.0 -600.00 -600 0 0 0 0 Pivot Column: 1 ( Cows ) Pivot Row: 3 ( Labor ) Cows Bulls Pigs S Land S Stable S Labor P0 Land 0 0.175 -0.28 1 0 -0.014 5 Stable 0 0.625 2.40 0 1 -0.030 15 Cows 1 0.250 0.40 0 0 0.020 50 Z-C 0 -150.000 120.00 0 0 36.000 90000 Pivot Column: 2 ( Bulls ) Pivot Row: 2 ( Stable ) Cows Bulls Pigs S Land S Stable S Labor P0 Land 0 0 -0.952 1 -0.28 -0.0056 0.8 Bulls 0 1 3.840 0 1.60 -0.0480 24.0 Cows 1 0 -0.560 0 -0.40 0.0320 44.0 Z-C 0 0 696.000 0 240.00 28.8000 93600.0 > all.equal( result1a, result1b ) [1] TRUE > # also estimate the dual problem > result1bD <- solveLP( cvec, bvec, Amat, TRUE, verbose = 4, solve.dual = TRUE ) [1] "initial Tableau" Cows Bulls Pigs S Land S Stable S Labor P0 Land 0.7 0.35 0 1 0 0 40 Stable 1.5 1.00 3 0 1 0 90 Labor 50.0 12.50 20 0 0 1 2500 Z-C -1800.0 -600.00 -600 0 0 0 0 Pivot Column: 1 ( Cows ) Pivot Row: 3 ( Labor ) Cows Bulls Pigs S Land S Stable S Labor P0 Land 0 0.175 -0.28 1 0 -0.014 5 Stable 0 0.625 2.40 0 1 -0.030 15 Cows 1 0.250 0.40 0 0 0.020 50 Z-C 0 -150.000 120.00 0 0 36.000 90000 Pivot Column: 2 ( Bulls ) Pivot Row: 2 ( Stable ) Cows Bulls Pigs S Land S Stable S Labor P0 Land 0 0 -0.952 1 -0.28 -0.0056 0.8 Bulls 0 1 3.840 0 1.60 -0.0480 24.0 Cows 1 0 -0.560 0 -0.40 0.0320 44.0 Z-C 0 0 696.000 0 240.00 28.8000 93600.0 [1] "initial Tableau" Land Stable Labor S Cows S Bulls S Pigs P0 Cows -0.70 -1.5 -50.0 1 0 0 -1800 Bulls -0.35 -1.0 -12.5 0 1 0 -600 Pigs 0.00 -3.0 -20.0 0 0 1 -600 Z-C 40.00 90.0 2500.0 0 0 0 0 [1] "initial Tableau for Phase 1" Land Stable Labor S Cows S Bulls S Pigs M Cows M Bulls M Pigs P0 M Cows 0.70 1.5 50.0 -1 0 0 1 0 0 1800 M Bulls 0.35 1.0 12.5 0 -1 0 0 1 0 600 M Pigs 0.00 3.0 20.0 0 0 -1 0 0 1 600 Z-C 40.00 90.0 2500.0 0 0 0 0 0 0 0 M Z-C -1.05 -5.5 -82.5 1 1 1 0 0 0 -3000 Pivot Column: 3 ( Labor ) Pivot Row: 3 ( M Pigs ) Land Stable Labor S Cows S Bulls S Pigs M Cows M Bulls M Pigs M Cows 0.70 -6.000 0 -1 0 2.500 1 0 -2.500 M Bulls 0.35 -0.875 0 0 -1 0.625 0 1 -0.625 Labor 0.00 0.150 1 0 0 -0.050 0 0 0.050 Z-C 40.00 -285.000 0 0 0 125.000 0 0 -125.000 M Z-C -1.05 6.875 0 1 1 -3.125 0 0 4.125 P0 M Cows 300 M Bulls 225 Labor 30 Z-C -75000 M Z-C -525 Pivot Column: 1 ( Land ) Pivot Row: 1 ( M Cows ) Land Stable Labor S Cows S Bulls S Pigs M Cows M Bulls Land 1 -8.571429 0 -1.428571 0 3.571429 1.428571 0 M Bulls 0 2.125000 0 0.500000 -1 -0.625000 -0.500000 1 Labor 0 0.150000 1 0.000000 0 -0.050000 0.000000 0 Z-C 0 57.857143 0 57.142857 0 -17.857143 -57.142857 0 M Z-C 0 -2.125000 0 -0.500000 1 0.625000 1.500000 0 M Pigs P0 Land -3.571429 428.5714 M Bulls 0.625000 75.0000 Labor 0.050000 30.0000 Z-C 17.857143 -92142.8571 M Z-C 0.375000 -75.0000 Pivot Column: 4 ( S Cows ) Pivot Row: 2 ( M Bulls ) Land Stable Labor S Cows S Bulls S Pigs M Cows Land 1 -2.500000e+00 0 0 -2.857143e+00 1.785714e+00 0 S Cows 0 4.250000e+00 0 1 -2.000000e+00 -1.250000e+00 -1 Labor 0 1.500000e-01 1 0 0.000000e+00 -5.000000e-02 0 Z-C 0 -1.850000e+02 0 0 1.142857e+02 5.357143e+01 0 M Z-C 0 4.440892e-16 0 0 4.440892e-16 -2.220446e-16 1 M Bulls M Pigs P0 Land 2.857143 -1.785714 6.428571e+02 S Cows 2.000000 1.250000 1.500000e+02 Labor 0.000000 0.050000 3.000000e+01 Z-C -114.285714 -53.571429 -1.007143e+05 M Z-C 1.000000 1.000000 -8.526513e-14 [1] "New starting Tableau for Phase II" Land Stable Labor S Cows S Bulls S Pigs Land 1 -2.50 0 0 -2.857143 1.785714 642.8571 S Cows 0 4.25 0 1 -2.000000 -1.250000 150.0000 Labor 0 0.15 1 0 0.000000 -0.050000 30.0000 Z-C 0 -185.00 0 0 114.285714 53.571429 -100714.2857 Pivot Column: 2 ( Stable ) Pivot Row: 2 ( S Cows ) Land Stable Labor S Cows S Bulls S Pigs Land 1 0 0 0.58823529 -4.03361345 1.050420168 731.09244 Stable 0 1 0 0.23529412 -0.47058824 -0.294117647 35.29412 Labor 0 0 1 -0.03529412 0.07058824 -0.005882353 24.70588 Z-C 0 0 0 43.52941176 27.22689076 -0.840336134 -94184.87395 Pivot Column: 6 ( S Pigs ) Pivot Row: 1 ( Land ) Land Stable Labor S Cows S Bulls S Pigs S Pigs 0.9520 0 0 0.560 -3.840 1 696.0 Stable 0.2800 1 0 0.400 -1.600 0 240.0 Labor 0.0056 0 1 -0.032 0.048 0 28.8 Z-C 0.8000 0 0 44.000 24.000 0 -93600.0 > all.equal( result1aD, result1bD ) [1] TRUE > > # estimation with lpSolve > result1c <- solveLP( cvec, bvec, Amat, TRUE, lpSolve = TRUE, verbose = 4 ) > print( result1c ) Results of Linear Programming / Linear Optimization (using lpSolve) Objective function (Maximum): 93600 Solution opt Cows 44 Bulls 24 Pigs 0 Constraints actual dir bvec free Land 39.2 <= 40 0.8 Stable 90.0 <= 90 0.0 Labor 2500.0 <= 2500 0.0 > # print summary results > summary( result1c ) Results of Linear Programming / Linear Optimization Objective function (Maximum): 93600 Solution opt Cows 44 Bulls 24 Pigs 0 > # print all elements of the returned object > print.default( result1c ) $status [1] 0 $lpStatus [1] 0 $solution Cows Bulls Pigs 44 24 0 $opt [1] 93600 $con actual dir bvec free Land 39.2 <= 40 0.8 Stable 90.0 <= 90 0.0 Labor 2500.0 <= 2500 0.0 $maximum [1] TRUE $lpSolve [1] TRUE $solve.dual [1] FALSE $maxiter [1] 1000 attr(,"class") [1] "solveLP" > # also estimate the dual problem > result1cD <- solveLP( cvec, bvec, Amat, TRUE, lpSolve = TRUE, solve.dual = TRUE ) > result1cD$con actual dir bvec free dual Land 39.2 <= 40 0.8 0.0 Stable 90.0 <= 90 0.0 240.0 Labor 2500.0 <= 2500 0.0 28.8 > all.equal( result1c[-c(5,8)], result1cD[-c(5,6,9)] ) [1] TRUE > > # using argument const.dir > const.dir <- c( ">=", ">=", ">=" ) > result1d <- solveLP( cvec, -bvec, -Amat, maximum = TRUE, verbose = 1, + const.dir = const.dir ) > print( result1d ) Results of Linear Programming / Linear Optimization Objective function (Maximum): 93600 Iterations in phase 1: 0 Iterations in phase 2: 2 Solution opt Cows 44 Bulls 24 Pigs 0 Basic Variables opt Cows 44.0 Bulls 24.0 S Land 0.8 Constraints actual dir bvec free dual dual.reg Land -39.2 >= -40 0.8 0.0 0.8 Stable -90.0 >= -90 0.0 240.0 15.0 Labor -2500.0 >= -2500 0.0 28.8 1375.0 All Variables (including slack variables) opt cvec min.c max.c marg marg.reg Cows 44.0 1800 900 2400.000 NA NA Bulls 24.0 600 450 1200.000 NA NA Pigs 0.0 600 -Inf 1296.000 -696.0 6.25 S Land 0.8 0 NA 731.092 0.0 NA S Stable 0.0 0 -Inf 240.000 -240.0 15.00 S Labor 0.0 0 -Inf 28.800 -28.8 1375.00 > all.equal( result1a[-8], result1d[-8] ) [1] TRUE > # also estimate the dual problem > result1dD <- solveLP( cvec, -bvec, -Amat, TRUE, verbose = 1, + const.dir = const.dir, solve.dual = TRUE ) > result1dD$con actual dir bvec free dual dual.reg dual.p Land -39.2 >= -40 0.8 0.0 0.8 0.0 Stable -90.0 >= -90 0.0 240.0 15.0 240.0 Labor -2500.0 >= -2500 0.0 28.8 1375.0 28.8 > all.equal( result1aD[-8], result1dD[-8] ) [1] TRUE > > # using argument const.dir and lpSolve > result1e <-solveLP( cvec, -bvec, -Amat, maximum = TRUE, verbose = 1, + const.dir = const.dir, lpSolve = TRUE ) > print( result1e ) Results of Linear Programming / Linear Optimization (using lpSolve) Objective function (Maximum): 93600 Solution opt Cows 44 Bulls 24 Pigs 0 Constraints actual dir bvec free Land -39.2 >= -40 0.8 Stable -90.0 >= -90 0.0 Labor -2500.0 >= -2500 0.0 > all.equal( result1c[-5], result1e[-5] ) [1] TRUE > # also estimate the dual problem > result1eD <- solveLP( cvec, -bvec, -Amat, TRUE, verbose = 1, + const.dir = const.dir, lpSolve = TRUE, solve.dual = TRUE ) > result1eD$con actual dir bvec free dual Land -39.2 >= -40 0.8 0.0 Stable -90.0 >= -90 0.0 240.0 Labor -2500.0 >= -2500 0.0 28.8 > all.equal( result1cD[-5], result1eD[-5] ) [1] TRUE > > > ## Example 2 > ## example 1.1.3 of Witte, Deppe and Born (1975) > cvec <- c(2.5, 2 ) # prices of feed > names(cvec) <- c("Feed1","Feed2") > bvec <- c( -10, -1.5, 12) > names(bvec) <- c("Protein","Fat","Fibre") > Amat <- rbind( c(-1.6,-2.4 ), + c(-0.5,-0.2 ), + c( 2.0, 2.0 ) ) > result2a <- solveLP( cvec, bvec, Amat, verbose = 1 ) > print( result2a ) Results of Linear Programming / Linear Optimization Objective function (Minimum): 10.4545 Iterations in phase 1: 2 Iterations in phase 2: 0 Solution opt Feed1 1.81818 Feed2 2.95455 Basic Variables opt Feed1 1.81818 Feed2 2.95455 S Fibre 2.45455 Constraints actual dir bvec free dual dual.reg Protein -10.00000 <= -10.0 0.00000 0.568182 3.60000 Fat -1.50000 <= -1.5 0.00000 3.181818 1.35000 Fibre 9.54545 <= 12.0 2.45455 0.000000 2.45455 All Variables (including slack variables) opt cvec min.c max.c marg marg.reg Feed1 1.81818 2.5 -3.666667 5.000000 NA NA Feed2 2.95455 2.0 -3.000000 3.750000 NA NA S Protein 0.00000 0.0 -0.568182 Inf 0.568182 3.60 S Fat 0.00000 0.0 -3.181818 Inf 3.181818 1.35 S Fibre 2.45455 0.0 NA 0.833333 0.000000 NA > # print summary results > summary( result2a ) Results of Linear Programming / Linear Optimization Objective function (Minimum): 10.45455 Solution opt Feed1 1.818182 Feed2 2.954545 > # print all elements of the returned object > print.default( result2a ) $status [1] 0 $opt [1] 10.45455 $iter1 [1] 2 $iter2 [1] 0 $allvar opt cvec min.c max.c marg marg.reg Feed1 1.818182 2.5 -3.6666667 5.0000000 NA NA Feed2 2.954545 2.0 -3.0000000 3.7500000 NA NA S Protein 0.000000 0.0 -0.5681818 Inf 0.5681818 3.60 S Fat 0.000000 0.0 -3.1818182 Inf 3.1818182 1.35 S Fibre 2.454545 0.0 NA 0.8333333 0.0000000 NA $basvar opt Feed1 1.818182 Feed2 2.954545 S Fibre 2.454545 $solution Feed1 Feed2 1.818182 2.954545 $con actual dir bvec free dual dual.reg Protein -10.000000 <= -10.0 0.000000 0.5681818 3.600000 Fat -1.500000 <= -1.5 0.000000 3.1818182 1.350000 Fibre 9.545455 <= 12.0 2.454545 0.0000000 2.454545 $Tab Feed1 Feed2 S Protein S Fat S Fibre Feed2 0 1 -0.5681818 1.818182 0 2.954545 Feed1 1 0 0.2272727 -2.727273 0 1.818182 Fibre 0 0 0.6818182 1.818182 1 2.454545 Z-C 0 0 0.5681818 3.181818 0 -10.454545 $maximum [1] FALSE $lpSolve [1] FALSE $solve.dual [1] FALSE $maxiter [1] 1000 attr(,"class") [1] "solveLP" > # also estimate the dual problem > result2aD <- solveLP( cvec, bvec, Amat, verbose = 1, solve.dual = TRUE ) > result2aD$con actual dir bvec free dual dual.reg dual.p Protein -10.000000 <= -10.0 0.000000 0.5681818 3.600000 0.5681818 Fat -1.500000 <= -1.5 0.000000 3.1818182 1.350000 3.1818182 Fibre 9.545455 <= 12.0 2.454545 0.0000000 2.454545 0.0000000 > all.equal( result2a[-c(8,12)], result2aD[-c(8,10,13)] ) [1] TRUE > > # estimation with verbose = TRUE > result2b <- solveLP( cvec, bvec, Amat, verbose = 4 ) [1] "initial Tableau" Feed1 Feed2 S Protein S Fat S Fibre P0 Protein -1.6 -2.4 1 0 0 -10.0 Fat -0.5 -0.2 0 1 0 -1.5 Fibre 2.0 2.0 0 0 1 12.0 Z-C 2.5 2.0 0 0 0 0.0 [1] "initial Tableau for Phase 1" Feed1 Feed2 S Protein S Fat S Fibre M Protein M Fat P0 M Protein 1.6 2.4 -1 0 0 1 0 10.0 M Fat 0.5 0.2 0 -1 0 0 1 1.5 Fibre 2.0 2.0 0 0 1 0 0 12.0 Z-C 2.5 2.0 0 0 0 0 0 0.0 M Z-C -2.1 -2.6 1 1 0 0 0 -11.5 Pivot Column: 2 ( Feed2 ) Pivot Row: 1 ( M Protein ) Feed1 Feed2 S Protein S Fat S Fibre M Protein M Fat P0 Feed2 0.6666667 1 -0.41666667 0 0 0.41666667 0 4.1666667 M Fat 0.3666667 0 0.08333333 -1 0 -0.08333333 1 0.6666667 Fibre 0.6666667 0 0.83333333 0 1 -0.83333333 0 3.6666667 Z-C 1.1666667 0 0.83333333 0 0 -0.83333333 0 -8.3333333 M Z-C -0.3666667 0 -0.08333333 1 0 1.08333333 0 -0.6666667 Pivot Column: 1 ( Feed1 ) Pivot Row: 2 ( M Fat ) Feed1 Feed2 S Protein S Fat S Fibre M Protein M Fat Feed2 0 1 -5.681818e-01 1.818182e+00 0 0.5681818 -1.818182 Feed1 1 0 2.272727e-01 -2.727273e+00 0 -0.2272727 2.727273 Fibre 0 0 6.818182e-01 1.818182e+00 1 -0.6818182 -1.818182 Z-C 0 0 5.681818e-01 3.181818e+00 0 -0.5681818 -3.181818 M Z-C 0 0 -1.804112e-16 4.440892e-16 0 1.0000000 1.000000 P0 Feed2 2.954545e+00 Feed1 1.818182e+00 Fibre 2.454545e+00 Z-C -1.045455e+01 M Z-C 1.110223e-16 [1] "New starting Tableau for Phase II" Feed1 Feed2 S Protein S Fat S Fibre Feed2 0 1 -0.5681818 1.818182 0 2.954545 Feed1 1 0 0.2272727 -2.727273 0 1.818182 Fibre 0 0 0.6818182 1.818182 1 2.454545 Z-C 0 0 0.5681818 3.181818 0 -10.454545 > all.equal( result1a, result1b ) [1] TRUE > # also estimate the dual problem > result2bD <- solveLP( cvec, bvec, Amat, verbose = 4, solve.dual = TRUE ) [1] "initial Tableau" Feed1 Feed2 S Protein S Fat S Fibre P0 Protein -1.6 -2.4 1 0 0 -10.0 Fat -0.5 -0.2 0 1 0 -1.5 Fibre 2.0 2.0 0 0 1 12.0 Z-C 2.5 2.0 0 0 0 0.0 [1] "initial Tableau for Phase 1" Feed1 Feed2 S Protein S Fat S Fibre M Protein M Fat P0 M Protein 1.6 2.4 -1 0 0 1 0 10.0 M Fat 0.5 0.2 0 -1 0 0 1 1.5 Fibre 2.0 2.0 0 0 1 0 0 12.0 Z-C 2.5 2.0 0 0 0 0 0 0.0 M Z-C -2.1 -2.6 1 1 0 0 0 -11.5 Pivot Column: 2 ( Feed2 ) Pivot Row: 1 ( M Protein ) Feed1 Feed2 S Protein S Fat S Fibre M Protein M Fat P0 Feed2 0.6666667 1 -0.41666667 0 0 0.41666667 0 4.1666667 M Fat 0.3666667 0 0.08333333 -1 0 -0.08333333 1 0.6666667 Fibre 0.6666667 0 0.83333333 0 1 -0.83333333 0 3.6666667 Z-C 1.1666667 0 0.83333333 0 0 -0.83333333 0 -8.3333333 M Z-C -0.3666667 0 -0.08333333 1 0 1.08333333 0 -0.6666667 Pivot Column: 1 ( Feed1 ) Pivot Row: 2 ( M Fat ) Feed1 Feed2 S Protein S Fat S Fibre M Protein M Fat Feed2 0 1 -5.681818e-01 1.818182e+00 0 0.5681818 -1.818182 Feed1 1 0 2.272727e-01 -2.727273e+00 0 -0.2272727 2.727273 Fibre 0 0 6.818182e-01 1.818182e+00 1 -0.6818182 -1.818182 Z-C 0 0 5.681818e-01 3.181818e+00 0 -0.5681818 -3.181818 M Z-C 0 0 -1.804112e-16 4.440892e-16 0 1.0000000 1.000000 P0 Feed2 2.954545e+00 Feed1 1.818182e+00 Fibre 2.454545e+00 Z-C -1.045455e+01 M Z-C 1.110223e-16 [1] "New starting Tableau for Phase II" Feed1 Feed2 S Protein S Fat S Fibre Feed2 0 1 -0.5681818 1.818182 0 2.954545 Feed1 1 0 0.2272727 -2.727273 0 1.818182 Fibre 0 0 0.6818182 1.818182 1 2.454545 Z-C 0 0 0.5681818 3.181818 0 -10.454545 [1] "initial Tableau" Protein Fat Fibre S Feed1 S Feed2 P0 Feed1 1.6 0.5 -2 1 0 2.5 Feed2 2.4 0.2 -2 0 1 2.0 Z-C -10.0 -1.5 12 0 0 0.0 Pivot Column: 1 ( Protein ) Pivot Row: 2 ( Feed2 ) Protein Fat Fibre S Feed1 S Feed2 P0 Feed1 0 0.36666667 -0.6666667 1 -0.6666667 1.1666667 Protein 1 0.08333333 -0.8333333 0 0.4166667 0.8333333 Z-C 0 -0.66666667 3.6666667 0 4.1666667 8.3333333 Pivot Column: 2 ( Fat ) Pivot Row: 1 ( Feed1 ) Protein Fat Fibre S Feed1 S Feed2 P0 Fat 0 1 -1.8181818 2.7272727 -1.8181818 3.1818182 Protein 1 0 -0.6818182 -0.2272727 0.5681818 0.5681818 Z-C 0 0 2.4545455 1.8181818 2.9545455 10.4545455 > all.equal( result2aD, result2bD ) [1] TRUE > > # estimation with lpSolve > result2c <- solveLP( cvec, bvec, Amat, lpSolve = TRUE, verbose = 4 ) > print( result2c ) Results of Linear Programming / Linear Optimization (using lpSolve) Objective function (Minimum): 10.4545 Solution opt Feed1 1.81818 Feed2 2.95455 Constraints actual dir bvec free Protein -10.00000 <= -10.0 0.00000 Fat -1.50000 <= -1.5 0.00000 Fibre 9.54545 <= 12.0 2.45455 > # print summary results > summary( result2c ) Results of Linear Programming / Linear Optimization Objective function (Minimum): 10.45455 Solution opt Feed1 1.818182 Feed2 2.954545 > # print all elements of the returned object > print.default( result2c ) $status [1] 0 $lpStatus [1] 0 $solution Feed1 Feed2 1.818182 2.954545 $opt [1] 10.45455 $con actual dir bvec free Protein -10.000000 <= -10.0 0.000000 Fat -1.500000 <= -1.5 0.000000 Fibre 9.545455 <= 12.0 2.454545 $maximum [1] FALSE $lpSolve [1] TRUE $solve.dual [1] FALSE $maxiter [1] 1000 attr(,"class") [1] "solveLP" > # also estimate the dual problem > result2cD <- solveLP( cvec, bvec, Amat, lpSolve = TRUE, verbose = 4, + solve.dual = TRUE ) > result2cD$con actual dir bvec free dual Protein -10.000000 <= -10.0 0.000000 0.5681818 Fat -1.500000 <= -1.5 0.000000 3.1818182 Fibre 9.545455 <= 12.0 2.454545 0.0000000 > all.equal( result2c[-c(5,8)], result2cD[-c(5,6,9)] ) [1] TRUE > > # using argument const.dir > const.dir <- c( ">=", ">=", "<=" ) > result2d <- solveLP( cvec, abs( bvec ), abs( Amat ), verbose = 1, + const.dir = const.dir ) > print( result2d ) Results of Linear Programming / Linear Optimization Objective function (Minimum): 10.4545 Iterations in phase 1: 2 Iterations in phase 2: 0 Solution opt Feed1 1.81818 Feed2 2.95455 Basic Variables opt Feed1 1.81818 Feed2 2.95455 S Fibre 2.45455 Constraints actual dir bvec free dual dual.reg Protein 10.00000 >= 10.0 0.00000 0.568182 3.60000 Fat 1.50000 >= 1.5 0.00000 3.181818 1.35000 Fibre 9.54545 <= 12.0 2.45455 0.000000 2.45455 All Variables (including slack variables) opt cvec min.c max.c marg marg.reg Feed1 1.81818 2.5 -3.666667 5.000000 NA NA Feed2 2.95455 2.0 -3.000000 3.750000 NA NA S Protein 0.00000 0.0 -0.568182 Inf 0.568182 3.60 S Fat 0.00000 0.0 -3.181818 Inf 3.181818 1.35 S Fibre 2.45455 0.0 NA 0.833333 0.000000 NA > all.equal( result2a[-8], result2d[-8] ) [1] TRUE > # also estimate the dual problem > result2dD <- solveLP( cvec, abs( bvec ), abs( Amat ), verbose = 1, + const.dir = const.dir, solve.dual = TRUE ) > result2dD$con actual dir bvec free dual dual.reg dual.p Protein 10.000000 >= 10.0 0.000000 0.5681818 3.600000 0.5681818 Fat 1.500000 >= 1.5 0.000000 3.1818182 1.350000 3.1818182 Fibre 9.545455 <= 12.0 2.454545 0.0000000 2.454545 0.0000000 > all.equal( result2aD[-8], result2dD[-8] ) [1] TRUE > > # using argument const.dir and lpSolve > result2e <- solveLP( cvec, abs( bvec ), abs( Amat ), verbose = 1, + const.dir = const.dir, lpSolve = TRUE ) > print( result2e ) Results of Linear Programming / Linear Optimization (using lpSolve) Objective function (Minimum): 10.4545 Solution opt Feed1 1.81818 Feed2 2.95455 Constraints actual dir bvec free Protein 10.00000 >= 10.0 0.00000 Fat 1.50000 >= 1.5 0.00000 Fibre 9.54545 <= 12.0 2.45455 > all.equal( result2c[-5], result2e[-5] ) [1] TRUE > # also estimate the dual problem > result2eD <- solveLP( cvec, abs( bvec ), abs( Amat ), verbose = 1, + const.dir = const.dir, lpSolve = TRUE, solve.dual = TRUE ) > result2eD$con actual dir bvec free dual Protein 10.000000 >= 10.0 0.000000 0.5681818 Fat 1.500000 >= 1.5 0.000000 3.1818182 Fibre 9.545455 <= 12.0 2.454545 0.0000000 > all.equal( result2cD[-5], result2eD[-5] ) [1] TRUE > > > > proc.time() user system elapsed 0.206 0.017 0.214 linprog/tests/MpsTests.R0000644000176200001440000000410011364313275014773 0ustar liggesuserslibrary( linprog ) ## example of Steinhauser, Langbehn and Peters (1992) ## Production activities cvec <- c(1800, 600, 600) # gross margins names(cvec) <- c("Cows","Bulls","Pigs") ## Constraints (quasi-fix factors) bvec <- c(40, 90, 2500) # endowment names(bvec) <- c("Land","Stable","Labor") ## Needs of Production activities Amat <- rbind( c( 0.7, 0.35, 0 ), c( 1.5, 1, 3 ), c( 50, 12.5, 20 ) ) ## solve the model result1a <- solveLP( cvec, bvec, Amat, TRUE ) ## Write to a (virtual) MPS file mpsFile <- file() writeMps( mpsFile, cvec, bvec, Amat, "Steinhauser" ) ## write the lines of this file to the output file mpsLines <- readLines( mpsFile ) close( mpsFile ) print( mpsLines ) ## Write to a (virtual) MPS file again (for readMps) mpsFile <- file() writeMps( mpsFile, cvec, bvec, Amat, "Steinhauser" ) ## delete all LP objects rm( cvec, bvec, Amat ) ## Read LP data from MPS file and solve it. lpModel <- readMps( mpsFile, TRUE, TRUE ) close( mpsFile ) ## Print the model and its result lpModel all.equal( result1a, lpModel$res ) ## example 1.1.3 of Witte, Deppe and Born (1975) ## Two types of Feed cvec <- c(2.5, 2 ) # prices of feed names(cvec) <- c("Feed1","Feed2") ## Constraints (minimum (<0) and maximum (>0) contents) bvec <- c(-10, -1.5, 12) names(bvec) <- c("Protein","Fat","Fibre") ## Matrix A Amat <- rbind( c( -1.6, -2.4 ), c( -0.5, -0.2 ), c( 2.0, 2.0 ) ) ## solve the model result2a <- solveLP( cvec, bvec, Amat ) ## Write to a (virtual) MPS file mpsFile <- file() writeMps( mpsFile, cvec, bvec, Amat, "Steinhauser" ) ## write the lines of this file to the output file mpsLines <- readLines( mpsFile ) close( mpsFile ) print( mpsLines ) ## Write to a (virtual) MPS file again (for readMps) mpsFile <- file() writeMps( mpsFile, cvec, bvec, Amat, "Steinhauser" ) ## delete all LP objects rm( cvec, bvec, Amat ) ## Read LP data from MPS file and solve it. lpModel <- readMps( mpsFile, TRUE ) close( mpsFile ) ## Print the model and its result lpModel all.equal( result2a, lpModel$res ) linprog/tests/linprog_tests.R0000644000176200001440000001051514212154517016111 0ustar liggesuserslibrary( linprog ) ## Example 1 ## Steinhauser, Langbehn and Peters (1992) cvec <- c(1800, 600, 600) # gross margins names(cvec) <- c("Cows","Bulls","Pigs") bvec <- c(40, 90, 2500) # endowment names(bvec) <- c("Land","Stable","Labor") Amat <- rbind( c( 0.7, 0.35, 0 ), c( 1.5, 1, 3 ), c( 50, 12.5, 20 ) ) result1a <- solveLP( cvec, bvec, Amat, TRUE, verbose = 1 ) print( result1a ) # print summary results summary( result1a ) # print all elements of the returned object print.default( result1a ) # also estimate the dual problem result1aD <- solveLP( cvec, bvec, Amat, TRUE, verbose = 1, solve.dual = TRUE ) result1aD$con all.equal( result1a[-c(8,12)], result1aD[-c(8,10,13)] ) # estimation with verbose = TRUE result1b <- solveLP( cvec, bvec, Amat, TRUE, verbose = 4 ) all.equal( result1a, result1b ) # also estimate the dual problem result1bD <- solveLP( cvec, bvec, Amat, TRUE, verbose = 4, solve.dual = TRUE ) all.equal( result1aD, result1bD ) # estimation with lpSolve result1c <- solveLP( cvec, bvec, Amat, TRUE, lpSolve = TRUE, verbose = 4 ) print( result1c ) # print summary results summary( result1c ) # print all elements of the returned object print.default( result1c ) # also estimate the dual problem result1cD <- solveLP( cvec, bvec, Amat, TRUE, lpSolve = TRUE, solve.dual = TRUE ) result1cD$con all.equal( result1c[-c(5,8)], result1cD[-c(5,6,9)] ) # using argument const.dir const.dir <- c( ">=", ">=", ">=" ) result1d <- solveLP( cvec, -bvec, -Amat, maximum = TRUE, verbose = 1, const.dir = const.dir ) print( result1d ) all.equal( result1a[-8], result1d[-8] ) # also estimate the dual problem result1dD <- solveLP( cvec, -bvec, -Amat, TRUE, verbose = 1, const.dir = const.dir, solve.dual = TRUE ) result1dD$con all.equal( result1aD[-8], result1dD[-8] ) # using argument const.dir and lpSolve result1e <-solveLP( cvec, -bvec, -Amat, maximum = TRUE, verbose = 1, const.dir = const.dir, lpSolve = TRUE ) print( result1e ) all.equal( result1c[-5], result1e[-5] ) # also estimate the dual problem result1eD <- solveLP( cvec, -bvec, -Amat, TRUE, verbose = 1, const.dir = const.dir, lpSolve = TRUE, solve.dual = TRUE ) result1eD$con all.equal( result1cD[-5], result1eD[-5] ) ## Example 2 ## example 1.1.3 of Witte, Deppe and Born (1975) cvec <- c(2.5, 2 ) # prices of feed names(cvec) <- c("Feed1","Feed2") bvec <- c( -10, -1.5, 12) names(bvec) <- c("Protein","Fat","Fibre") Amat <- rbind( c(-1.6,-2.4 ), c(-0.5,-0.2 ), c( 2.0, 2.0 ) ) result2a <- solveLP( cvec, bvec, Amat, verbose = 1 ) print( result2a ) # print summary results summary( result2a ) # print all elements of the returned object print.default( result2a ) # also estimate the dual problem result2aD <- solveLP( cvec, bvec, Amat, verbose = 1, solve.dual = TRUE ) result2aD$con all.equal( result2a[-c(8,12)], result2aD[-c(8,10,13)] ) # estimation with verbose = TRUE result2b <- solveLP( cvec, bvec, Amat, verbose = 4 ) all.equal( result1a, result1b ) # also estimate the dual problem result2bD <- solveLP( cvec, bvec, Amat, verbose = 4, solve.dual = TRUE ) all.equal( result2aD, result2bD ) # estimation with lpSolve result2c <- solveLP( cvec, bvec, Amat, lpSolve = TRUE, verbose = 4 ) print( result2c ) # print summary results summary( result2c ) # print all elements of the returned object print.default( result2c ) # also estimate the dual problem result2cD <- solveLP( cvec, bvec, Amat, lpSolve = TRUE, verbose = 4, solve.dual = TRUE ) result2cD$con all.equal( result2c[-c(5,8)], result2cD[-c(5,6,9)] ) # using argument const.dir const.dir <- c( ">=", ">=", "<=" ) result2d <- solveLP( cvec, abs( bvec ), abs( Amat ), verbose = 1, const.dir = const.dir ) print( result2d ) all.equal( result2a[-8], result2d[-8] ) # also estimate the dual problem result2dD <- solveLP( cvec, abs( bvec ), abs( Amat ), verbose = 1, const.dir = const.dir, solve.dual = TRUE ) result2dD$con all.equal( result2aD[-8], result2dD[-8] ) # using argument const.dir and lpSolve result2e <- solveLP( cvec, abs( bvec ), abs( Amat ), verbose = 1, const.dir = const.dir, lpSolve = TRUE ) print( result2e ) all.equal( result2c[-5], result2e[-5] ) # also estimate the dual problem result2eD <- solveLP( cvec, abs( bvec ), abs( Amat ), verbose = 1, const.dir = const.dir, lpSolve = TRUE, solve.dual = TRUE ) result2eD$con all.equal( result2cD[-5], result2eD[-5] ) linprog/R/0000755000176200001440000000000012272451536012134 5ustar liggesuserslinprog/R/linprog.R0000644000176200001440000004011614212152772013727 0ustar liggesuserssolveLP <- function( cvec, bvec, Amat, maximum=FALSE, const.dir = rep( "<=", length( bvec ) ), maxiter=1000, zero=1e-9, tol=1e-6, dualtol = tol, lpSolve=FALSE, solve.dual=FALSE, verbose = 0 ) { result <- list() # list for results that will be returned result$status <- 0 rdigits <- -round( log10( zero ) ) nVar <- length(cvec) # number of variables nCon <- length(bvec) # number of constraints if( !all.equal( dim( Amat ), c( nCon, nVar ) ) == TRUE ) { stop( paste( "Matrix A must have as many rows as constraints (=elements", "of vector b) and as many columns as variables (=elements of vector c).\n" ) ) } if( length( const.dir ) != nCon ) { stop( paste( "'const.dir' must have as the elements as constraints", "(=elements of vector b).\n" ) ) } if( sum( const.dir == ">=" | const.dir == ">" | const.dir == "=" | const.dir == "==" | const.dir == "<=" | const.dir == "<" ) < nCon ) { stop( "'const.dir' may only contain '>=', '>', '=', '==', '<=' or '<'" ) } if( any( const.dir %in% c( "=", "==" ) ) && ( ! lpSolve ) ) { warning( "solveLP() might return incorrect results", " if the model includes equality constraints", " and argument 'lpSolve' is 'FALSE';", " please check if solveLP() returns the same results", " with argument 'lpSolve' equal to 'TRUE';", " more information on this bug available at", " linprog's R-Forge site" ) } ## Labels if( is.null(names(cvec))) { clab <- as.character(1:nVar) } else { clab <- names(cvec) } if( is.null(names(bvec))) { blab <- as.character(1:nCon) } else { blab <- names(bvec) } const.dir2 <- rep( 0, nCon ) const.dir2[ const.dir == ">=" | const.dir == ">" ] <- 1 const.dir2[ const.dir == "<=" | const.dir == "<" ] <- -1 ## lpSolve if( lpSolve ) { if( maximum ) { direction <- "max" } else { direction <- "min" } lpres <- lp( direction = direction, cvec, Amat, const.dir, bvec ) result$lpStatus <- lpres$status if( result$lpStatus == 0 ) { if( min( lpres$solution ) < -tol ) { result$lpStatus <- 7 } else if( max( ( bvec - c( Amat %*% lpres$solution ) ) * const.dir2 ) > tol ) { result$lpStatus <- 3 } } if( result$lpStatus != 0 ) { result$status <- 1 } else { result$solution <- lpres$solution names( result$solution ) <- clab result$opt <- lpres$objval ## Results: Constraints result$con <- data.frame( actual=NA, dir=const.dir, bvec=bvec, free=NA ) result$con$actual <- round( c( Amat %*% result$solution ), digits=rdigits ) names( result$con$actual ) <- blab result$con$free <- round( result$con$bvec - result$con$actual, digits=rdigits ) result$con$free[ const.dir2 == 1 ] <- -result$con$free[ const.dir2 == 1 ] result$con$free[ const.dir2 == 0 ] <- -abs( result$con$free[ const.dir2 == 0 ] ) } } else { ## Simplex algorithm iter1 <- 0 iter2 <- 0 ## Slack Variables for(i in 1:nCon) clab <- c( clab, paste("S", blab[i] ) ) cvec2 <- c( cvec, rep( 0, nCon ) ) ## Tableau ( Basic Variables, Slack,Variables, P0, Z-C ) Tab <- rbind( cbind( -Amat * const.dir2, diag( 1, nCon, nCon ), -bvec * const.dir2 ), c( cvec2 * (-1)^maximum, 0 ) ) rownames(Tab) <- c( blab, "Z-C" ) colnames(Tab) <- c( clab, "P0" ) if( verbose >= 3 ) { print("initial Tableau") print(Tab) } ## searching for feasible solution for starting # basis: Zero Solution ( Basic Variables = Slack Variables ) basis <- c( (nVar+1) : (nVar+nCon) ) if(min(Tab[ 1:nCon, nVar+nCon+1]) < 0 ) { Tab2 <- Tab Tab2 <- rbind( Tab2, rep(0, ncol(Tab2) ) ) rownames(Tab2)[nCon+2] <- "M Z-C" # additional artificial 'Z-C' row basis2 <- basis nArt <- 0 # number of artificial variables for(i in 1:nCon) { if(Tab[ i, nVar+nCon+1] < 0 ) { Tab2[ i, ] <- -Tab2[ i, ] Tab2 <- cbind( Tab2[ , 1:(nVar+nCon+nArt) ], rep(0,nCon+2), Tab2[ , (nVar+nCon+nArt+1)] ) nArt <- nArt + 1 colnames(Tab2)[ nVar+nCon+nArt ] <- paste("M", rownames(Tab2)[i] ) Tab2[ i, nVar+nCon+nArt ] <- 1 Tab2[ nCon+2, nVar+nCon+nArt ] <- 1 # put artificial variables in basis rownames(Tab2)[ i ] <- paste("M", rownames(Tab2)[i] ) basis2[i] <- nVar+nCon+nArt } } for(i in 1:nCon) { # artificial objective function (Z-C) if(Tab[ i, nVar+nCon+1] < 0 ) { Tab2[nCon+2, 1:(nVar+nCon+nArt)] <- Tab2[nCon+2, 1:(nVar+nCon+nArt)] - Tab2[ i , 1:(nVar+nCon+nArt)] } } for(i in 1:nCon) { # value of artificial objective function Tab2[nCon+2, nVar+nCon+nArt+1 ] <- Tab2[nCon+2, nVar+nCon+nArt+1 ] - Tab2[i, nVar+nCon+nArt+1] * Tab2[nCon+2, basis[i] ] } colnames(Tab2)[ nVar+nCon+nArt+1 ] <- "P0" if( verbose >= 3 ) { print("initial Tableau for Phase 1") print(Tab2) } ## Simplex algorithm (Phase 1) while( min( Tab2[ nCon+2, 1:(nVar+nCon+nArt) ] ) < -zero & iter1 < maxiter) { iter1 <- iter1 + 1 ## Pivot Tab[ abs(Tab) < zero ] <- 0 # pcolumn <- which.min( Tab2[ nCon+2, 1:(nVar+nCon+nArt) ]) # Pivot column decval <- array( NA, nVar+nCon ) for( pcolumnt in 1:(nVar+nCon+nArt) ) { if( Tab2[ nCon+2, pcolumnt ] < 0 ) { rwerte <- Tab2[ 1:nCon, nVar+nCon+nArt+1 ] / Tab2[ 1:nCon , pcolumnt ] # R-values rwerte[ Tab2[1:nCon, pcolumnt ] <= 0 ] <- max(rwerte,na.rm=TRUE)+1 prow <- which.min( rwerte ) # Pivot row if( length( rwerte[ !is.na(rwerte) & is.finite(rwerte) ] ) >= 1 ) { decval[ pcolumnt ] <- Tab2[ nCon+2, pcolumnt ] * min( rwerte[ !is.na(rwerte) & is.finite(rwerte) ] ) } } } if( min( decval, na.rm=TRUE ) < -zero ) { pcolumn <- which.min( decval ) # Pivot column } else { pcolumn <- which.min( Tab2[ nCon+2, 1:(nVar+nCon+nArt) ]) # Pivot column } rwerte <- Tab2[ 1:nCon , nVar+nCon+nArt+1 ] / Tab2[ 1:nCon , pcolumn ] # R-values rwerte[ Tab2[1:nCon, pcolumn ] <= 0 ] <- max(rwerte, na.rm=TRUE)+1 prow <- which.min( rwerte ) # Pivot row if( verbose >=2 ) { cat( paste( "\nPivot Column:", as.character(pcolumn), "(",colnames(Tab2)[pcolumn],")\n" ) ) cat( paste( "Pivot Row:", as.character( prow ), "(", rownames(Tab2)[prow], ")\n\n" ) ) } ## New Basis basis[prow] <- pcolumn rownames(Tab2)[prow] <- colnames(Tab2)[pcolumn] ## New Tableau Tab2[ prow, ] <- Tab2[ prow, ] / Tab2[ prow, pcolumn ] for( i in 1:(nCon+2) ) { if( i != prow ) { Tab2[ i, ] <- Tab2[ i, ] - Tab2[ prow, ] * Tab2[ i, pcolumn ] } } if( verbose >= 4 ) print(Tab2) } if(iter1 >= maxiter ) warning("Simplex algorithm (phase 1) did not reach optimum.") Tab <- cbind( Tab2[ 1:(nCon+1), 1:(nCon+nVar) ], Tab2[ 1:(nCon+1), nVar+nCon+nArt+1 ] ) if( verbose >= 3 ) { print("New starting Tableau for Phase II") print(Tab) } } ## Simplex algorithm (Phase 2) while( min( Tab[ nCon+1, 1:(nVar+nCon) ] ) < -zero & iter2 < maxiter ) { iter2 <- iter2 + 1 ## Pivot Tab[ abs(Tab) < zero ] <- 0 # pcolumn <- which.min( Tab[ nCon+1, 1:(nVar+nCon) ]) # Pivot column decval <- array( NA, nVar+nCon ) for( pcolumnt in 1:(nVar+nCon) ) { if( Tab[ nCon+1, pcolumnt ] < 0 ) { rwerte <- Tab[ 1:nCon , nVar+nCon+1 ] / Tab[ 1:nCon , pcolumnt ] # R-values rwerte[ Tab[1:nCon, pcolumnt ] <= 0 ] <- max(rwerte,na.rm=TRUE)+1 prow <- which.min( rwerte ) # Pivot row if( length( rwerte[ !is.na(rwerte) & is.finite(rwerte) ] ) >= 1 ) { decval[ pcolumnt ] <- Tab[ nCon+1, pcolumnt ] * min( rwerte[ !is.na(rwerte) & is.finite(rwerte) ] ) } } } if( min( decval, na.rm=TRUE ) < -zero ) { pcolumn <- which.min( decval ) # Pivot column } else { pcolumn <- which.min( Tab[ nCon+1, 1:(nVar+nCon) ]) # Pivot column } rwerte <- Tab[ 1:nCon , nVar+nCon+1 ] / Tab[ 1:nCon , pcolumn ] # R-values rwerte[ Tab[1:nCon, pcolumn ] <= 0 ] <- max(rwerte,na.rm=TRUE)+1 prow <- which.min( rwerte ) # Pivot row if( verbose >= 2 ) { cat( paste( "\nPivot Column:", as.character(pcolumn), "(",colnames(Tab)[pcolumn],")\n" ) ) cat( paste( "Pivot Row:", as.character( prow ) , "(",rownames(Tab)[prow],")\n\n") ) } ## New Basis basis[prow] <- pcolumn rownames(Tab)[prow] <- colnames(Tab)[pcolumn] ## New Tableau Tab[ prow, ] <- Tab[ prow, ] / Tab[ prow, pcolumn ] for( i in 1:(nCon+1) ) { if( i != prow ) { Tab[ i, ] <- Tab[ i, ] - Tab[ prow, ] * Tab[ i, pcolumn ] } } if( verbose >= 4 ) print(Tab) } if(iter2 >= maxiter ) warning("Simplex algorithm (phase 2) did not reach optimum.") ## Results: Basic Variables basvar <- matrix( NA, nCon, 1 ) colnames(basvar) <- c("opt") rownames(basvar) <- rep("a",nCon) for( i in 1:nCon ) { rownames(basvar)[i] <- clab[sort(basis)[i]] basvar[i,1] <- Tab[ which(basis==sort(basis)[i]), nVar+nCon+1 ] } ## Results: All Variables (Including Slack Variables) allvar <- data.frame( opt=rep( NA, nVar+nCon ), cvec=cvec2, min.c=NA, max.c=NA, marg=NA, marg.reg=NA ) rownames(allvar) <- clab for( i in 1:(nVar+nCon) ) { if(i %in% basis ) { allvar$opt[ i ] <- Tab[ which(basis==i), nVar+nCon+1 ] ## Stability of Basic Variables quot <- Tab[ nCon+1, 1:(nVar+nCon) ] / Tab[ which(basis==i), 1:(nVar+nCon) ] if( maximum ) { if(max(quot[!is.na(quot)]) > 0 ) { suppressWarnings( allvar$min.c[ i ] <- cvec2[ i ] - min(quot[quot>0 & !is.na(quot)]) ) } if(min(quot[!is.na(quot) & is.finite(quot)]) < 0 ) { if(max(quot[quot<0 & !is.na(quot)]) > -1e14 ) { allvar$max.c[ i ] <- cvec2[ i ] - max(quot[quot<0 & !is.na(quot)]) } else { allvar$max.c[ i ] <- Inf } } else { allvar$max.c[ i ] <- Inf } } else { if(max(quot[!is.na(quot)]) > 0 ) { suppressWarnings( allvar$max.c[ i ] <- cvec2[ i ] + min(quot[quot>0 & !is.na(quot)]) ) } if(min(quot[!is.na(quot)]) < 0 ) { if(max(quot[quot<0 & !is.na(quot)]) > -1e14 ){ allvar$min.c[ i ] <- -cvec2[ i ] + max(quot[quot<0 & !is.na(quot)]) } else { allvar$min.c[ i ] <- NA } } else { allvar$min.c[ i ] <- NA } } } else { allvar$opt[ i ] <- 0 if( i <= nVar ) { if( maximum ) { allvar$min.c[ i ] <- -Inf allvar$max.c[ i ] <- Tab[ nCon+1, i ] + cvec2[i] } else { allvar$min.c[ i ] <- 99#-Tab[ nCon+1, i ] - cvec2[i] allvar$max.c[ i ] <- 77#Inf } } } allvar$cvec[ i ] <- cvec2[ i ] # marginal contribution to objective function (Shadow prices) if( !( ( i %in% basis ) & ( i <= nVar ) ) ) { allvar$marg[ i ] <- Tab[ nCon+1, i ] * (-1)^maximum if( !( i %in% basis ) & ( i > nVar ) ) { if( maximum ) { allvar$max.c[ i ] <- Tab[ nCon+1, i ] #* (-1)^maximum allvar$min.c[ i ] <- -Inf } else { allvar$min.c[ i ] <- -Tab[ nCon+1, i ] allvar$max.c[ i ] <- Inf } } quot <- Tab[ 1:nCon , nVar+nCon+1 ] / Tab[ 1:nCon, i ] suppressWarnings( if( !( i %in% basis) ) { allvar$marg.reg[ i ] <- min(quot[quot>0 & !is.na(quot)]) } else { allvar$marg.reg[ i ] <- NA } ) } } allvar$min.c[ allvar$min.c > 1e16 ] <- Inf allvar$min.c[ allvar$min.c < -1e16 ] <- -Inf ## Results: Constraints con <- data.frame( actual=NA, dir=const.dir, bvec=bvec, free=NA, dual=NA, dual.reg=NA ) names( con$actual ) <- blab for(i in 1: nCon) { if( (i+nVar) %in% basis ) { con$actual[ i ] <- round( bvec[i] + Tab[ which((i+nVar)==basis), nVar+nCon+1 ] * const.dir2[ i ], digits=rdigits ) } else { con$actual[ i ] <- round( bvec[i], digits=rdigits ) } if( -allvar$opt[ i+nVar ] == 0 ) { con$dual[ i ] <- allvar$marg[ i+nVar ] * (-1)^maximum con$dual.reg[ i ] <- allvar$marg.reg[ i+nVar ] } else { con$dual[ i ] <- 0 con$dual.reg[ i ] <- allvar$opt[ i+nVar ] } } con$free <- round( con$bvec - con$actual, digits=rdigits ) con$free[ const.dir2 == 1 ] <- -con$free[ const.dir2 == 1 ] con$free[ const.dir2 == 0 ] <- -abs( con$free[ const.dir2 == 0 ] ) result$opt <- round( -Tab[ nCon+1, nCon+nVar+1 ], digits=rdigits ) * (-1)^maximum result$iter1 <- iter1 result$iter2 <- iter2 result$allvar <- round( allvar, digits=rdigits ) result$basvar <- round( basvar, digits=rdigits ) result$solution <- result$allvar$opt[ 1 : nVar ] names( result$solution ) <- clab[ 1: nVar ] result$con <- con if( verbose >= 1 ) result$Tab <- Tab if( iter1 >= maxiter ) result$status <- 4 if( iter2 >= maxiter ) result$status <- 5 } if( result$status == 0 ) { if( min ( result$con$free ) < - tol ) { result$status <- 3 } } ## solving the dual problem if( solve.dual && result$status == 0 ) { if( any( const.dir2 == 0 ) ) { stop( paste( "At the moment the dual problem can not be solved", "with equality constraints" ) ) } if( maximum ) { const.dir.dual <- rep(">=",nVar) } else { const.dir.dual <- rep("<=",nVar) } result$con$dual.p <- result$con$dual dualres <- solveLP( cvec = bvec * const.dir2 * (-1)^maximum, bvec = cvec, Amat = t( Amat * const.dir2 ) * (-1)^maximum, maximum = !maximum, const.dir = const.dir.dual, maxiter = maxiter, zero = zero, tol = dualtol, lpSolve = lpSolve, verbose = verbose ) result$dualStatus <- dualres$status if( result$dualStatus == 0 ) { result$con$dual <- dualres$solution } else { result$status <- 2 } } ## List of Results result$maximum <- maximum result$lpSolve <- lpSolve result$solve.dual <- solve.dual result$maxiter <- maxiter class(result) <- "solveLP" result } linprog/R/summary.solveLP.R0000644000176200001440000000023411364313275015334 0ustar liggesusers## create the summary results summary.solveLP <- function(object,...) { class( object ) <- c( "summary.solveLP", class( object ) ) return( object ) } linprog/R/print.summary.solveLP.R0000644000176200001440000000075211364313275016474 0ustar liggesusers## print the summary results print.summary.solveLP <- function( x, ... ) { object <- x cat("\n\nResults of Linear Programming / Linear Optimization\n") cat("\nObjective function") if( object$maximum ) { cat(" (Maximum): ") } else { cat(" (Minimum): ") } cat( object$opt, "\n" ) cat("\nSolution\n") object$solution <- as.matrix(object$solution) colnames( object$solution ) <- c("opt") print( object$solution ) cat("\n") invisible( x ) } linprog/R/print.solveLP.R0000644000176200001440000000445111364313275015000 0ustar liggesusers## print the results print.solveLP <- function( x, digits=6,... ) { object <- x save.digits <- unlist(options(digits=digits)) on.exit(options(digits=save.digits)) cat("\n\nResults of Linear Programming / Linear Optimization\n") if( object$lpSolve ) cat("(using lpSolve)\n") if( object$status %in% c( 0, 2, 3, 4, 5 ) ) { cat("\nObjective function") if( object$maximum ) { cat(" (Maximum): ") } else { cat(" (Minimum): ") } cat( object$opt, "\n" ) if( !is.null( object$iter1 ) ) { cat("\nIterations in phase 1: ") cat( object$iter1 ) if( object$iter1 >= object$maxiter ) { cat(" (equals 'maxiter' !!!)") } cat("\nIterations in phase 2: ") cat( object$iter2 ) if( object$iter2 >= object$maxiter ) { cat(" (equals 'maxiter' !!!)") } } cat("\nSolution\n") object$solution <- as.matrix(object$solution) colnames( object$solution ) <- c("opt") print( object$solution ) if( !is.null( object$basvar ) ) { cat("\nBasic Variables\n") print( object$basvar ) } cat("\nConstraints\n") print( object$con ) if( !is.null( object$allvar ) ) { cat("\nAll Variables (including slack variables)\n") print( object$allvar ) } if( object$status == 2 ) { cat( "lpSolve for the dual problem did not succeed but returned", " status code '", object$dualStatus, "'", sep = "" ) } else if( object$status == 3 ) { print( object$con[ 1: 4 ] ) cat( "The Constraints are violated. This is most likely due to rounding errors" ) } else if( object$status == 4 ) { cat( "Simplex algorithm phase 1 did not find a solution within", "the number of iterations specified by argument 'maxiter'" ) } else if( object$status == 5 ) { cat( "Simplex algorithm phase 2 did not find the optimal solution within", "the number of iterations specified by argument 'maxiter'" ) } } else if( object$status == 1 ) { cat( "lpSolve returned error code '", object$lpStatus, "'", sep = "" ) } else { cat( "unknown status code '", object$status, "'", sep = "" ) } cat("\n") invisible( x ) } linprog/R/readMps.R0000644000176200001440000001153311364313275013653 0ustar liggesusersreadMps <- function( file, solve=FALSE, maximum=FALSE ) { mps <- readLines(file) i <- 1 ## Name while( substr( mps[i], 1, 4 ) != "NAME" & i < length(mps) ) { i <- i + 1 } if( substr( mps[i], 1, 4 ) == "NAME" ) { name <- substr( mps[i], 15, nchar( mps[i] ) ) } else { stop( "MPS file must have a line starting with 'NAME'" ) } ## Rows / Constraints while( substr( mps[i], 1, 4 ) != "ROWS" & i < length(mps) ) { i <- i + 1 } if( substr( mps[i], 1, 4 ) != "ROWS" ) stop( "MPS file must have a line starting with 'ROWS'" ) objname <- NULL bvec <- NULL # constraints svec <- NULL # sign of the constraints i <- i + 1 while( substr( mps[i], 1, 7 ) != "COLUMNS" & i < length(mps)) { sign <- substr( mps[i], 2,2 ) if( sign == "E" ) stop("Equaltity constraints are not implemented yet.") if( !( sign %in% c("E", "L", "G", "N" ) ) ) { sign <- substr( mps[i], 3,3 ) } if( sign %in% c("E", "L", "G" ) ) { rname <- strsplit( mps[i], " " )[[1]][length( strsplit( mps[i], " " )[[1]] )] bvec <- c( bvec, 0 ) svec <- c( svec, sign ) names(bvec)[length( bvec ) ] <- rname names(svec)[length( svec ) ] <- rname } else { if( sign == "N" ) { if( is.null( objname ) ) { objname <- strsplit( mps[i], " " )[[1]][length( strsplit( mps[i], " " )[[1]] )] } } else { stop("the 2nd or 3rd column of the rows section must be 'N', 'E', 'L' or 'G'") } } i <- i + 1 } ## Columns if( substr( mps[i], 1, 7 ) != "COLUMNS" ) stop( "MPS file must have a line starting with 'COLUMS'" ) cvec <- NULL Amat <- matrix(0, length(bvec), 0 ) rownames(Amat) <- names(bvec) i <- i + 1 while( substr( mps[i], 1, 3 ) != "RHS" & i < length(mps)) { temp <- strsplit( mps[i], " " )[[1]] temp <- temp[ temp != "" ] if( !(temp[1] %in% colnames(Amat) ) ) { cvec <- c( cvec, 0 ) Amat <- cbind( Amat, rep( 0, nrow(Amat) ) ) names(cvec)[length(cvec)] <- temp[1] colnames(Amat)[ncol(Amat)] <- temp[1] } for( j in 1:((length(temp)-1)/2) ) { if( temp[ 2*j ] == objname ) { cvec[ temp[ 1 ] ] <- as.numeric( temp[ 2*j + 1 ] ) } else { if( temp[ 2*j ] %in% names(bvec) ) { Amat[ temp[ 2*j ], temp[ 1 ] ] <- as.numeric( temp[ 2*j + 1 ] ) } else { stop( paste( "Constraint name '",temp[ 2*j ],"' is not defined", sep="") ) } } } i <- i + 1 } ## Restriction values if( substr( mps[i], 1, 3 ) != "RHS" ) stop( "MPS file must have a line starting with 'RHS'" ) i <- i + 1 while( substr( mps[i], 1, 6 ) != "BOUNDS" & substr( mps[i], 1, 6 ) != "ENDATA" & i < length(mps)) { temp <- strsplit( mps[i], " " )[[1]] temp <- temp[ temp != "" ] for( j in 1:((length(temp)-1)/2) ) { if( temp[ 2*j ] %in% names(bvec) ) { bvec[ temp[ 2*j ] ] <- as.numeric( temp[ 2*j + 1 ] ) } else { stop( paste( "Constraint name '",temp[ 2*j ],"' is not defined", sep="") ) } } i <- i + 1 } ## Bounds if( substr( mps[i], 1, 6 ) == "BOUNDS" ) { i <- i + 1 while( substr( mps[i], 1, 6 ) != "ENDATA" & i <= length(mps)) { temp <- strsplit( mps[i], " " )[[1]] temp <- temp[ temp != "" ] if( temp[ 3 ] %in% colnames(Amat) ) { if(temp[1] == "UP") { svec <- c( svec, "L" ) bvec <- c( bvec, as.numeric(temp[ 4 ]) ) Amat <- rbind( Amat, rep( 0, ncol(Amat) ) ) Amat[ nrow(Amat), temp[3] ] <- 1 names( svec )[length(svec)] <- paste(temp[1], temp[3], sep="" ) names( bvec )[length(bvec)] <- paste(temp[1], temp[3], sep="" ) rownames( Amat )[nrow(Amat)] <- paste(temp[1], temp[3], sep="" ) } else { if( temp[1] %in% c("LO","FX","FR") ) { stop("'LO', 'FX', and 'FR' Bounds are not implemented yet") } else { stop(" A 'BOUND' line must start with 'UP', 'LO', 'FX' or 'FR'") } } } else { stop( paste( "Variable name '",temp[ 3 ],"' is not defined", sep="") ) } i <- i + 1 } } if( substr( mps[i], 1, 6 ) != "ENDATA" ) stop( "MPS file must have a line starting with 'ENDDATA'" ) ## Changing 'Greater' constraints to 'Lower' constraints for( j in 1:length(svec) ) { if(svec[j] == "G" ) { bvec[ j ] <- - bvec[ j ] Amat[ j, ] <- - Amat[ j, ] } } res <- NULL if(solve) { res <- solveLP(cvec,bvec,Amat,maximum) } result <- list( name=name, cvec=cvec, bvec=bvec, Amat=Amat, res=res ) return( result ) } linprog/R/writeMps.R0000644000176200001440000000545211364313275014075 0ustar liggesuserswriteMps <- function( file, cvec, bvec, Amat, name="LP" ) { nCon <- length(bvec) nVar <- length(cvec) if( is.null( names(bvec) ) ) { blab <- rep("",nCon) for(i in 1:nCon) { blab[i] <- paste("R_",as.character(i)) } } else { blab <- names(bvec) for(i in 1:nCon) { blab[i] <- gsub(" ","",blab[i]) if( nchar( blab[i] ) > 8 ) { blab[i] <- substr( blab[i], 1, 8 ) } j <- 2 while( i>1 & blab[i] %in% blab[1:(i-1)]) { blab[i] <- paste( substr(blab[i], 1, 7-nchar(as.character(j))), "_", as.character(j), sep="" ) j <- j+1 } } } if( is.null( names(cvec) ) ) { clab <- rep("",nVar) for(i in 1:nVar) { clab[i] <- paste("C_",as.character(i)) } } else { clab <- names(cvec) for(i in 1:nVar) { clab[i] <- gsub(" ","",clab[i]) if( nchar( clab[i] ) > 8 ) { clab[i] <- substr( clab[i], 1, 8 ) } j <- 2 while( i>1 & clab[i] %in% clab[1:(i-1)]) { clab[i] <- paste( substr(clab[i], 1, 7-nchar(as.character(j))), "_", as.character(j), sep="" ) j <- j+1 } } } write( paste("NAME ",name,sep=""), file ) write( "ROWS", file, append=TRUE ) write( " N obj", file, append=TRUE ) for(i in 1:nCon) { write( paste(" L ",blab[i],sep="" ), file, append=TRUE ) } write( "COLUMNS", file, append=TRUE ) for(i in 1:nVar) { line <- paste(" ",clab[i], sep="" ) line <- paste( line, paste( rep( " ", 14-nchar(line)), collapse=""), "obj", sep="") line <- paste( line, paste( rep( " ", 36-nchar(line) - nchar( as.character( signif( cvec[i], 10 )))), collapse=""), as.character( signif( cvec[i], 10)), sep="") write( line, file, append=TRUE ) for(j in 1:nCon) { if( Amat[j,i] != 0 ) { line <- paste(" ",clab[i], sep="" ) line <- paste( line, paste( rep( " ", 14-nchar(line)),collapse=""), blab[j], sep="") line <- paste( line, paste( rep( " ", 36 - nchar(line) - nchar( as.character( signif( Amat[j,i], 10 )))), collapse=""), as.character( signif( Amat[j,i], 10 )), sep="") write( line, file, append=TRUE ) } } } write( "RHS", file, append=TRUE ) for(i in 1:nCon) { line <- paste(" RHS ",blab[i], sep="" ) line <- paste( line, paste( rep( " ", 36-nchar(line) - nchar( as.character( signif( bvec[i], 10 )))), collapse=""), as.character( signif( bvec[i], 10 )), sep="") write( line, file, append=TRUE ) } write( "ENDATA", file, append=TRUE ) } linprog/MD50000644000176200001440000000202514212213660012230 0ustar liggesuserscb8f758a15e0687153ba27c4ae0a538c *DESCRIPTION 6854497bbf102965e3911db0bc23f215 *INDEX 93bd2d802a75fdfbcdfb0b73b5a6b5d8 *NAMESPACE 7e4fd6ff0b1c89c3013fd3b0514fe3d3 *R/linprog.R 3a2eb8e2cb7ad4746844a22482cf9019 *R/print.solveLP.R 10f421e198ad84d650a02db70bc8571c *R/print.summary.solveLP.R 05180c6998c99215c8b452cd624d838e *R/readMps.R b37208a446cda55cd2176fa54b0e0a38 *R/summary.solveLP.R 5f951774b3a4f4c1328201590641a13d *R/writeMps.R 832097113d04d0afe1d35b6c144ff74e *man/print.solveLP.Rd f6c657f428d78336458cf416acb8d819 *man/readMps.Rd a86c4448106ccf1bbd6768e81f065765 *man/solveLP.Rd 80ebeabdea2f68c81e9f04a7f177c628 *man/summary.solveLP.Rd 49c4385ae57e014eb51430ea57cb48c2 *man/writeMps.Rd cda192552886c7ba71b851d523bac599 *tests/MpsTests.R 91638e86f1a552741c3d7571026f16a4 *tests/MpsTests.Rout.save 0f153e46a08f5cb0d8ccf434f34681c0 *tests/equality_test.R 247ca8c11f46a3f1844fa8b5b44b54a6 *tests/equality_test.Rout.save 446cd1df7600f673d5fc5518fe383cfa *tests/linprog_tests.R e9bb3736143f055b55b20bf6c847cba0 *tests/linprog_tests.Rout.save linprog/INDEX0000644000176200001440000000045411364313275012526 0ustar liggesusersprint.solveLP Print Objects of Class solveLP readMps Read MPS Files solveLP Solve Linear Programming / Optimization Problems summary.solveLP Summary Results for Objects of Class solveLP writeMps Write MPS Files