Case Study 1

Suppose a farmer has 75 acres on which to plant two crops: wheat and barley. To produce these crops, it costs the farmer (for seed, fertilizer, etc.) $120 per acre for the wheat and $210 per acre for the barley. The farmer has $15000 available for expenses. But after the harvest, the farmer must store the crops while awaiting avourable market conditions. The farmer has storage space for 4000 bushels. Each acre yields an average of 110 bushels of wheat or 30 bushels of barley. If the net profit per bushel of wheat (after all expenses have been subtracted) is $1.30 and for barley is $2.00, how should the farmer plant the 75 acres to maximize profit?

Problem definition

LPSOLVE

First, we need to translate the problem in a mathematical way. Let’s define the following variables

  • \(X\) is the number of acress allotted to wheat.
  • \(Y\) is the number of acress allotted to barley.

Now we can define \(\hat X = \begin{pmatrix} X \\ Y\end{pmatrix}\) as the decision variable vector. Note that it must be \(\hat X \geq 0\).

We would like to maximize the total profit so we must set our objective function as follows

\[profit(X,Y)= (110*1.30)X+ (30*2.00)Y = MAX(profit) \] Then, the expression is like \[profit(X,Y)= 143X+ 60Y = MAX(profit) \] The constraints can be set in the following ways like: 1.Cost \[120X +210Y\leq 15000\] 2.Storage space \[110X+30Y\leq4000\] 3.Area \[X+Y\leq 75\] 4.Acres allotted to X or wheat \[X \geq 0 \] 5.Acres allotted to Y or barley \[Y \geq 0 \] which means that \[A = \begin{pmatrix} 120 & 210 \\ 110 & 30 \\ 1 & 1 \\ -1 & 0 \\ 0 & -1 \end{pmatrix}\], and \[B = \begin{pmatrix}15000 \\ 4000 \\ 75 \\ 0 \\ 0 \end{pmatrix}\].

# install.packages("lpSolve")
library(lpSolve)

Objective Function

Here are the coefficients of the decision variables:

  • The net profit of \(X\) is \(\1.30\)
  • The net profit of \(Y\) is \(\2.00\)

Therefore, the obj function is:

\[profit(X,Y)= (110*1.30)X + (30*2.00)Y\]

\[profit(X,Y)= 143X+ 60Y\]

# Set the coefficients of the decision variables -> C
C <- c(143,60)        
C
## [1] 143  60

##CONSTRAINT MATRIX The constraints can be set in the following ways like: Row: 1.Cost 2.Storage space 3.Area 4.Acres allotted to X or wheat 5.Acres allotted to Y or barley

# Create constraint martix B
A <- matrix(c(120,210,
              110,30,
              1,1,
              1,0,
              0,1), nrow=5, byrow=TRUE)
A
##      [,1] [,2]
## [1,]  120  210
## [2,]  110   30
## [3,]    1    1
## [4,]    1    0
## [5,]    0    1
# Right  side for the constraints
B <- c(15000,4000,75,0,0)
B
## [1] 15000  4000    75     0     0
# Direction of the constraints
constranints_direction  <- c("<=", "<=", "<=", ">=",">=")
constranints_direction
## [1] "<=" "<=" "<=" ">=" ">="

The Optimum Result

# Find the optimal solution
optimum <-  lp(direction="max",
               objective.in = C,
               const.mat = A,
               const.dir = constranints_direction,
               const.rhs = B,
               all.int = T)

str(optimum)
## List of 28
##  $ direction       : int 1
##  $ x.count         : int 2
##  $ objective       : num [1:2] 143 60
##  $ const.count     : int 5
##  $ constraints     : num [1:4, 1:5] 120 210 1 15000 110 30 1 4000 1 1 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:4] "" "" "const.dir.num" "const.rhs"
##   .. ..$ : NULL
##  $ int.count       : int 2
##  $ int.vec         : int [1:2] 1 2
##  $ bin.count       : int 0
##  $ binary.vec      : int 0
##  $ num.bin.solns   : int 1
##  $ objval          : num 6266
##  $ solution        : num [1:2] 22 52
##  $ presolve        : int 0
##  $ compute.sens    : int 0
##  $ sens.coef.from  : num 0
##  $ sens.coef.to    : num 0
##  $ duals           : num 0
##  $ duals.from      : num 0
##  $ duals.to        : num 0
##  $ scale           : int 196
##  $ use.dense       : int 0
##  $ dense.col       : int 0
##  $ dense.val       : num 0
##  $ dense.const.nrow: int 0
##  $ dense.ctr       : num 0
##  $ use.rw          : int 0
##  $ tmp             : chr "Nobody will ever look at this"
##  $ status          : int 0
##  - attr(*, "class")= chr "lp"
# Print status: 0 = success, 2 = no feasible solution
print(optimum$status)
## [1] 0
# Display the optimum values for X, Y
best_sol <- optimum$solution
names(best_sol) <- c("X", "Y") 
print(best_sol)
##  X  Y 
## 22 52
# Check the value of objective function at optimal point
print(paste("Total profit: ", optimum$objval, sep=""))
## [1] "Total profit: 6266"
# Disconnect from the model and the optimum solution
rm(optimum, constranints_direction, best_sol)

Solve the problem again using lpSolveAPI

# install.packages("lpSolveAPI")
library(lpSolveAPI)
# Set 5 constraints and 2 decision variables
lprec <- make.lp(nrow = 5, ncol = 2)
# Set the type of problem we are trying to solve
lp.control(lprec, sense="max")
## $anti.degen
## [1] "fixedvars" "stalling" 
## 
## $basis.crash
## [1] "none"
## 
## $bb.depthlimit
## [1] -50
## 
## $bb.floorfirst
## [1] "automatic"
## 
## $bb.rule
## [1] "pseudononint" "greedy"       "dynamic"      "rcostfixing" 
## 
## $break.at.first
## [1] FALSE
## 
## $break.at.value
## [1] 1e+30
## 
## $epsilon
##       epsb       epsd      epsel     epsint epsperturb   epspivot 
##      1e-10      1e-09      1e-12      1e-07      1e-05      2e-07 
## 
## $improve
## [1] "dualfeas" "thetagap"
## 
## $infinite
## [1] 1e+30
## 
## $maxpivot
## [1] 250
## 
## $mip.gap
## absolute relative 
##    1e-11    1e-11 
## 
## $negrange
## [1] -1e+06
## 
## $obj.in.basis
## [1] TRUE
## 
## $pivoting
## [1] "devex"    "adaptive"
## 
## $presolve
## [1] "none"
## 
## $scalelimit
## [1] 5
## 
## $scaling
## [1] "geometric"   "equilibrate" "integers"   
## 
## $sense
## [1] "maximize"
## 
## $simplextype
## [1] "dual"   "primal"
## 
## $timeout
## [1] 0
## 
## $verbose
## [1] "neutral"
# Set type of decision variables
set.type(lprec, 1:2, type=c("integer"))
# Set objective function coefficients vector C
set.objfn(lprec, C)
# Add constraints
add.constraint(lprec, A[1, ], "<=", B[1])
add.constraint(lprec, A[2, ], "<=", B[2])
add.constraint(lprec, A[3, ], "<=", B[3])
add.constraint(lprec, A[4, ], ">=", B[4])
add.constraint(lprec, A[5, ], ">=", B[5])
# Display the LPsolve matrix
lprec
## Model name: 
##            C1   C2             
## Maximize  143   60             
## R1          0    0  free      0
## R2          0    0  free      0
## R3          0    0  free      0
## R4          0    0  free      0
## R5          0    0  free      0
## R6        120  210    <=  15000
## R7        110   30    <=   4000
## R8          1    1    <=     75
## R9          1    0    >=      0
## R10         0    1    >=      0
## Kind      Std  Std             
## Type      Int  Int             
## Upper     Inf  Inf             
## Lower       0    0
# Solve problem
solve(lprec)
## [1] 0
# Get the decision variables values
get.variables(lprec)
## [1] 22 52
# Get the value of the objective function
get.objective(lprec)
## [1] 6266
# Note that the default boundaries on the decision variable are c(0, 0, 0) and c(Inf, Inf, Inf)
get.bounds(lprec)
## $lower
## [1] 0 0
## 
## $upper
## [1] Inf Inf
# Boundaries can be set with following function
lpSolveAPI::set.bounds(lprec)
LS0tDQp0aXRsZTogIkxhYjM6IExpbmVhciBQcm9ncmFtbWluZyBNb2RlbGluZyINCmF1dGhvcjogIllvbmF0aGFuIEFOZ2dyYWl3YW4iDQpkYXRlOiAiYHIgZm9ybWF0KFN5cy5EYXRlKCksICclQiAlZCwgJVknKWAiDQpvdXRwdXQ6IG9wZW5pbnRybzo6bGFiX3JlcG9ydA0KDQotLS0NCg0KYGBge3IgTG9nbyxlY2hvPUZBTFNFLGZpZy5hbGlnbj0nY2VudGVyJywgb3V0LndpZHRoID0gJzQwJSd9DQoNCmtuaXRyOjppbmNsdWRlX2dyYXBoaWNzKCJDOi9Vc2Vycy9Zb25hdGhhbi9Eb3dubG9hZHMvbG9nb21hdGFuYS5qcGciKQ0KYGBgDQoNCiMgQ2FzZSBTdHVkeSAxDQoNCmBgYA0KU3VwcG9zZSBhIGZhcm1lciBoYXMgNzUgYWNyZXMgb24gd2hpY2ggdG8gcGxhbnQgdHdvIGNyb3BzOiB3aGVhdCBhbmQgYmFybGV5LiBUbyBwcm9kdWNlIHRoZXNlIGNyb3BzLCBpdCBjb3N0cyB0aGUgZmFybWVyIChmb3Igc2VlZCwgZmVydGlsaXplciwgZXRjLikgJDEyMCBwZXIgYWNyZSBmb3IgdGhlIHdoZWF0IGFuZCAkMjEwIHBlciBhY3JlIGZvciB0aGUgYmFybGV5LiBUaGUgZmFybWVyIGhhcyAkMTUwMDAgYXZhaWxhYmxlIGZvciBleHBlbnNlcy4gQnV0IGFmdGVyIHRoZSBoYXJ2ZXN0LCB0aGUgZmFybWVyIG11c3Qgc3RvcmUgdGhlIGNyb3BzIHdoaWxlIGF3YWl0aW5nIGF2b3VyYWJsZSBtYXJrZXQgY29uZGl0aW9ucy4gVGhlIGZhcm1lciBoYXMgc3RvcmFnZSBzcGFjZSBmb3IgNDAwMCBidXNoZWxzLiBFYWNoIGFjcmUgeWllbGRzIGFuIGF2ZXJhZ2Ugb2YgMTEwIGJ1c2hlbHMgb2Ygd2hlYXQgb3IgMzAgYnVzaGVscyBvZiBiYXJsZXkuIElmIHRoZSBuZXQgcHJvZml0IHBlciBidXNoZWwgb2Ygd2hlYXQgKGFmdGVyIGFsbCBleHBlbnNlcyBoYXZlIGJlZW4gc3VidHJhY3RlZCkgaXMgJDEuMzAgYW5kIGZvciBiYXJsZXkgaXMgJDIuMDAsIGhvdyBzaG91bGQgdGhlIGZhcm1lciBwbGFudCB0aGUgNzUgYWNyZXMgdG8gbWF4aW1pemUgcHJvZml0Pw0KYGBgDQojIyBQcm9ibGVtIGRlZmluaXRpb24NCkxQU09MVkUNCg0KRmlyc3QsIHdlIG5lZWQgdG8gdHJhbnNsYXRlIHRoZSBwcm9ibGVtIGluIGEgbWF0aGVtYXRpY2FsIHdheS4gTGV04oCZcyBkZWZpbmUgdGhlIGZvbGxvd2luZyB2YXJpYWJsZXMNCg0KKiAkWCQgaXMgdGhlIG51bWJlciBvZiBhY3Jlc3MgYWxsb3R0ZWQgdG8gd2hlYXQuDQoqICRZJCBpcyB0aGUgbnVtYmVyIG9mIGFjcmVzcyBhbGxvdHRlZCB0byBiYXJsZXkuDQoNCk5vdyB3ZSBjYW4gZGVmaW5lICRcaGF0IFggPSBcYmVnaW57cG1hdHJpeH0gWCBcXCBZXGVuZHtwbWF0cml4fSQgYXMgdGhlIGRlY2lzaW9uIHZhcmlhYmxlIHZlY3Rvci4gTm90ZSB0aGF0IGl0IG11c3QgYmUgJFxoYXQgWCBcZ2VxIDAkLg0KDQpXZSB3b3VsZCBsaWtlIHRvIG1heGltaXplIHRoZSB0b3RhbCBwcm9maXQgc28gd2UgbXVzdCBzZXQgb3VyIG9iamVjdGl2ZSBmdW5jdGlvbiBhcyBmb2xsb3dzDQoNCiQkcHJvZml0KFgsWSk9ICgxMTAqMS4zMClYKyAoMzAqMi4wMClZID0gIE1BWChwcm9maXQpICQkDQpUaGVuLCB0aGUgZXhwcmVzc2lvbiBpcyBsaWtlDQokJHByb2ZpdChYLFkpPSAxNDNYKyA2MFkgPSAgTUFYKHByb2ZpdCkgJCQNClRoZSBjb25zdHJhaW50cyBjYW4gYmUgc2V0IGluIHRoZSBmb2xsb3dpbmcgd2F5cyBsaWtlOg0KMS5Db3N0ICQkMTIwWCArMjEwWVxsZXEgMTUwMDAkJA0KMi5TdG9yYWdlIHNwYWNlICQkMTEwWCszMFlcbGVxNDAwMCQkDQozLkFyZWEgJCRYK1lcbGVxIDc1JCQNCjQuQWNyZXMgYWxsb3R0ZWQgdG8gWCBvciB3aGVhdCAkJFggXGdlcSAwICQkDQo1LkFjcmVzIGFsbG90dGVkIHRvIFkgb3IgYmFybGV5ICQkWSBcZ2VxIDAgJCQNCndoaWNoIG1lYW5zIHRoYXQgXFtBID0gXGJlZ2lue3BtYXRyaXh9IDEyMCAmIDIxMCBcXA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgMTEwICYgMzAgIFxcDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAxICYgMSBcXA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgLTEgJiAwIFxcDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAwICYgLTENCiAgICAgICAgICAgICAgICAgICAgICAgICAgICBcZW5ke3BtYXRyaXh9XF0sIGFuZA0KICAgICAgICAgICAgICAgICAgXFtCID0gXGJlZ2lue3BtYXRyaXh9MTUwMDAgXFwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIDQwMDAgIFxcDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICA3NSBcXA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgMCBcXA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgMA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgIFxlbmR7cG1hdHJpeH1cXS4NCg0KYGBge3J9DQojIGluc3RhbGwucGFja2FnZXMoImxwU29sdmUiKQ0KbGlicmFyeShscFNvbHZlKQ0KYGBgDQoNCg0KIyMjIE9iamVjdGl2ZSBGdW5jdGlvbg0KDQpIZXJlIGFyZSB0aGUgY29lZmZpY2llbnRzIG9mIHRoZSBkZWNpc2lvbiB2YXJpYWJsZXM6DQoNCiogVGhlIG5ldCBwcm9maXQgb2YgJFgkIGlzICRcMS4zMCQNCiogVGhlIG5ldCBwcm9maXQgb2YgJFkkIGlzICRcMi4wMCQNCg0KVGhlcmVmb3JlLCB0aGUgb2JqIGZ1bmN0aW9uIGlzOg0KDQokJHByb2ZpdChYLFkpPSAoMTEwKjEuMzApWCArICgzMCoyLjAwKVkkJA0KDQokJHByb2ZpdChYLFkpPSAxNDNYKyA2MFkkJA0KDQpgYGB7cn0NCiMgU2V0IHRoZSBjb2VmZmljaWVudHMgb2YgdGhlIGRlY2lzaW9uIHZhcmlhYmxlcyAtPiBDDQpDIDwtIGMoMTQzLDYwKSAgICAgICAgDQpDDQpgYGANCiMjQ09OU1RSQUlOVCBNQVRSSVgNClRoZSBjb25zdHJhaW50cyBjYW4gYmUgc2V0IGluIHRoZSBmb2xsb3dpbmcgd2F5cyBsaWtlOg0KUm93Og0KMS5Db3N0DQoyLlN0b3JhZ2Ugc3BhY2UNCjMuQXJlYSANCjQuQWNyZXMgYWxsb3R0ZWQgdG8gWCBvciB3aGVhdCANCjUuQWNyZXMgYWxsb3R0ZWQgdG8gWSBvciBiYXJsZXkNCmBgYHtyfQ0KIyBDcmVhdGUgY29uc3RyYWludCBtYXJ0aXggQg0KQSA8LSBtYXRyaXgoYygxMjAsMjEwLA0KICAgICAgICAgICAgICAxMTAsMzAsDQogICAgICAgICAgICAgIDEsMSwNCiAgICAgICAgICAgICAgMSwwLA0KICAgICAgICAgICAgICAwLDEpLCBucm93PTUsIGJ5cm93PVRSVUUpDQpBDQoNCiMgUmlnaHQgIHNpZGUgZm9yIHRoZSBjb25zdHJhaW50cw0KQiA8LSBjKDE1MDAwLDQwMDAsNzUsMCwwKQ0KQg0KYGBgDQpgYGB7cn0NCiMgRGlyZWN0aW9uIG9mIHRoZSBjb25zdHJhaW50cw0KY29uc3RyYW5pbnRzX2RpcmVjdGlvbiAgPC0gYygiPD0iLCAiPD0iLCAiPD0iLCAiPj0iLCI+PSIpDQpjb25zdHJhbmludHNfZGlyZWN0aW9uDQpgYGANCg0KIyMjIFRoZSBPcHRpbXVtIFJlc3VsdA0KDQpgYGB7cn0NCiMgRmluZCB0aGUgb3B0aW1hbCBzb2x1dGlvbg0Kb3B0aW11bSA8LSAgbHAoZGlyZWN0aW9uPSJtYXgiLA0KICAgICAgICAgICAgICAgb2JqZWN0aXZlLmluID0gQywNCiAgICAgICAgICAgICAgIGNvbnN0Lm1hdCA9IEEsDQogICAgICAgICAgICAgICBjb25zdC5kaXIgPSBjb25zdHJhbmludHNfZGlyZWN0aW9uLA0KICAgICAgICAgICAgICAgY29uc3QucmhzID0gQiwNCiAgICAgICAgICAgICAgIGFsbC5pbnQgPSBUKQ0KDQpzdHIob3B0aW11bSkNCmBgYA0KDQoNCmBgYHtyfQ0KIyBQcmludCBzdGF0dXM6IDAgPSBzdWNjZXNzLCAyID0gbm8gZmVhc2libGUgc29sdXRpb24NCnByaW50KG9wdGltdW0kc3RhdHVzKQ0KYGBgDQpgYGB7cn0NCiMgRGlzcGxheSB0aGUgb3B0aW11bSB2YWx1ZXMgZm9yIFgsIFkNCmJlc3Rfc29sIDwtIG9wdGltdW0kc29sdXRpb24NCm5hbWVzKGJlc3Rfc29sKSA8LSBjKCJYIiwgIlkiKSANCnByaW50KGJlc3Rfc29sKQ0KYGBgDQoNCmBgYHtyfQ0KIyBDaGVjayB0aGUgdmFsdWUgb2Ygb2JqZWN0aXZlIGZ1bmN0aW9uIGF0IG9wdGltYWwgcG9pbnQNCnByaW50KHBhc3RlKCJUb3RhbCBwcm9maXQ6ICIsIG9wdGltdW0kb2JqdmFsLCBzZXA9IiIpKQ0KYGBgDQoNCmBgYHtyfQ0KIyBEaXNjb25uZWN0IGZyb20gdGhlIG1vZGVsIGFuZCB0aGUgb3B0aW11bSBzb2x1dGlvbg0Kcm0ob3B0aW11bSwgY29uc3RyYW5pbnRzX2RpcmVjdGlvbiwgYmVzdF9zb2wpDQpgYGANCg0KDQoNClNvbHZlIHRoZSBwcm9ibGVtIGFnYWluIHVzaW5nIGBscFNvbHZlQVBJYA0KYGBge3J9DQojIGluc3RhbGwucGFja2FnZXMoImxwU29sdmVBUEkiKQ0KbGlicmFyeShscFNvbHZlQVBJKQ0KYGBgDQoNCg0KDQpgYGB7cn0NCiMgU2V0IDUgY29uc3RyYWludHMgYW5kIDIgZGVjaXNpb24gdmFyaWFibGVzDQpscHJlYyA8LSBtYWtlLmxwKG5yb3cgPSA1LCBuY29sID0gMikNCiMgU2V0IHRoZSB0eXBlIG9mIHByb2JsZW0gd2UgYXJlIHRyeWluZyB0byBzb2x2ZQ0KbHAuY29udHJvbChscHJlYywgc2Vuc2U9Im1heCIpDQojIFNldCB0eXBlIG9mIGRlY2lzaW9uIHZhcmlhYmxlcw0Kc2V0LnR5cGUobHByZWMsIDE6MiwgdHlwZT1jKCJpbnRlZ2VyIikpDQpgYGANCg0KYGBge3J9DQojIFNldCBvYmplY3RpdmUgZnVuY3Rpb24gY29lZmZpY2llbnRzIHZlY3RvciBDDQpzZXQub2JqZm4obHByZWMsIEMpDQpgYGANCg0KYGBge3J9DQojIEFkZCBjb25zdHJhaW50cw0KYWRkLmNvbnN0cmFpbnQobHByZWMsIEFbMSwgXSwgIjw9IiwgQlsxXSkNCmFkZC5jb25zdHJhaW50KGxwcmVjLCBBWzIsIF0sICI8PSIsIEJbMl0pDQphZGQuY29uc3RyYWludChscHJlYywgQVszLCBdLCAiPD0iLCBCWzNdKQ0KYWRkLmNvbnN0cmFpbnQobHByZWMsIEFbNCwgXSwgIj49IiwgQls0XSkNCmFkZC5jb25zdHJhaW50KGxwcmVjLCBBWzUsIF0sICI+PSIsIEJbNV0pDQpgYGANCg0KYGBge3J9DQojIERpc3BsYXkgdGhlIExQc29sdmUgbWF0cml4DQpscHJlYw0KYGBgDQoNCmBgYHtyfQ0KIyBTb2x2ZSBwcm9ibGVtDQpzb2x2ZShscHJlYykNCmBgYA0KYGBge3J9DQojIEdldCB0aGUgZGVjaXNpb24gdmFyaWFibGVzIHZhbHVlcw0KZ2V0LnZhcmlhYmxlcyhscHJlYykNCmBgYA0KDQpgYGB7cn0NCiMgR2V0IHRoZSB2YWx1ZSBvZiB0aGUgb2JqZWN0aXZlIGZ1bmN0aW9uDQpnZXQub2JqZWN0aXZlKGxwcmVjKQ0KYGBgDQoNCmBgYHtyfQ0KIyBOb3RlIHRoYXQgdGhlIGRlZmF1bHQgYm91bmRhcmllcyBvbiB0aGUgZGVjaXNpb24gdmFyaWFibGUgYXJlIGMoMCwgMCwgMCkgYW5kIGMoSW5mLCBJbmYsIEluZikNCmdldC5ib3VuZHMobHByZWMpDQpgYGANCg0KYGBge3J9DQojIEJvdW5kYXJpZXMgY2FuIGJlIHNldCB3aXRoIGZvbGxvd2luZyBmdW5jdGlvbg0KbHBTb2x2ZUFQSTo6c2V0LmJvdW5kcyhscHJlYykNCmBgYA0KDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg==