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

First, We need to translate the problem in a mathematical way.

  • \(W\) is the area of wheat per acres
  • \(B\) is the area of barley per acres

Now, we would like to maximize the profit. So, we have to set our objective function as follows:

  • The profit of each bushel of wheat(W) is \(\$143\)
  • The profit of each bushel of barley(B) is \(\$60\)

\(profit(W,B)=(110)(1.3)W+(30)(2)B\)

\(P=143W+60B\)

The constraints can be set in the following ways:

  1. Production Cost
  • \(120W+210B\le15000\)
  1. Total Area in Acres
  • \(W+B\le75\)
  1. Storage Space
  • \(110W+30B\le4000\)
  • \(W\ge0\)
  • \(B\ge0\)

Solution with lpSolve

library(lpSolve)

# Set the coefficients of the objective function
obj.func <- c(143, 60)

# Create constraint matrix
constr <- matrix(c(120,210,
                   110,30,
                   1,1,
                   1,0,
                   0,1),
                 nrow = 5,
                 byrow = TRUE)

# Create right hand side or the result for the constraints
rhs <- c(15000, 4000, 75, 0, 0)

# Create the direction of the constraints
direc <- c("<=","<=","<=",">=",">=")

# Find the optimum solution
optimum <- lp(direction="max",
              objective.in = obj.func,
              const.mat = constr,
              const.dir = direc,
              const.rhs = rhs,
              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 W and B
solution <- optimum$solution
names(solution) <- c("W","B")
print(solution)
##  W  B 
## 22 52
# Check the value of objective function at optimum point
print(paste("Total Profit: ",
            optimum$objval,
            sep = ""))
## [1] "Total Profit: 6266"

So, the farmer should plant 22 bushels of wheat and 52 bushels of barley to maximize the profit. The profit is $6266.

# Disconnect from the model and the optimum solution
rm(optimum, direc, solution)

Solution with lpSolveAPI

library(lpSolveAPI)

# Set 5 constraints and 2 decision variables
lprec <- make.lp(nrow = 0,
                 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 obj.func
set.objfn(lprec,
          obj.func)

# Add constraints
add.constraint(lprec, constr[1,], "<=", rhs[1])
add.constraint(lprec, constr[2,], "<=", rhs[2])
add.constraint(lprec, constr[3,], "<=", rhs[3])
add.constraint(lprec, constr[4,], ">=", rhs[4])
add.constraint(lprec, constr[5,], ">=", rhs[5])

# Display the matrix
lprec
## Model name: 
##            C1   C2           
## Maximize  143   60           
## R1        120  210  <=  15000
## R2        110   30  <=   4000
## R3          1    1  <=     75
## R4          1    0  >=      0
## R5          0    1  >=      0
## Kind      Std  Std           
## Type      Int  Int           
## Upper     Inf  Inf           
## Lower       0    0
# Solve problem
solve(lprec)
## [1] 0
# Get the wheat and barley variables value
get.variables(lprec)
## [1] 22 52
# Get the maximum profit
get.objective(lprec)
## [1] 6266
# Note that the default boundaries on the decision variables are c(0, 0) and c(Inf, Inf)
get.bounds(lprec)
## $lower
## [1] 0 0
## 
## $upper
## [1] Inf Inf
# Boundaries can be set with following function
lpSolveAPI::set.bounds(lprec)

So, the farmer should plant 22 bushels of wheat and 52 bushels of barley to maximize the profit. The profit is $6266.

LS0tDQp0aXRsZTogIkxhYjM6IExpbmVhciBQcm9ncmFtbWluZyBNb2RlbGluZyINCmF1dGhvcjogIkp1ZW56eSBIb2Rhd3lhIg0KZGF0ZTogImByIGZvcm1hdChTeXMuRGF0ZSgpLCAnJUIgJWQsICVZJylgIg0Kb3V0cHV0OiBvcGVuaW50cm86OmxhYl9yZXBvcnQNCg0KLS0tDQoNCmBgYHtyIExvZ28sIGVjaG89RkFMU0UsZmlnLmFsaWduPSdjZW50ZXInLCBvdXQud2lkdGggPSAnNDAlJ30NCmtuaXRyOjppbmNsdWRlX2dyYXBoaWNzKCJodHRwczovL2dpdGh1Yi5jb20vQmFrdGktU2lyZWdhci9pbWFnZXMvYmxvYi9tYXN0ZXIvbG9nby5wbmc/cmF3PXRydWUiKQ0KYGBgDQoNCiMgQ2FzZSBTdHVkeSAxDQoNCmBgYA0KU3VwcG9zZSBhIGZhcm1lciBoYXMgNzUgYWNyZXMgb24gd2hpY2ggdG8gcGxhbnQgdHdvIGNyb3BzOiB3aGVhdCBhbmQgYmFybGV5LiBUbyBwcm9kdWNlIHRoZXNlIGNyb3BzLCBpdCBjb3N0cyB0aGUgZmFybWVyIChmb3Igc2VlZCwgZmVydGlsaXplciwgZXRjLikgJDEyMCBwZXIgYWNyZSBmb3IgdGhlIHdoZWF0IGFuZCAkMjEwIHBlciBhY3JlIGZvciB0aGUgYmFybGV5LiBUaGUgZmFybWVyIGhhcyAkMTUwMDAgYXZhaWxhYmxlIGZvciBleHBlbnNlcy4gQnV0IGFmdGVyIHRoZSBoYXJ2ZXN0LCB0aGUgZmFybWVyIG11c3Qgc3RvcmUgdGhlIGNyb3BzIHdoaWxlIGF3YWl0aW5nIGF2b3VyYWJsZSBtYXJrZXQgY29uZGl0aW9ucy4gVGhlIGZhcm1lciBoYXMgc3RvcmFnZSBzcGFjZSBmb3IgNDAwMCBidXNoZWxzLiBFYWNoIGFjcmUgeWllbGRzIGFuIGF2ZXJhZ2Ugb2YgMTEwIGJ1c2hlbHMgb2Ygd2hlYXQgb3IgMzAgYnVzaGVscyBvZiBiYXJsZXkuIElmIHRoZSBuZXQgcHJvZml0IHBlciBidXNoZWwgb2Ygd2hlYXQgKGFmdGVyIGFsbCBleHBlbnNlcyBoYXZlIGJlZW4gc3VidHJhY3RlZCkgaXMgJDEuMzAgYW5kIGZvciBiYXJsZXkgaXMgJDIuMDAsIGhvdyBzaG91bGQgdGhlIGZhcm1lciBwbGFudCB0aGUgNzUgYWNyZXMgdG8gbWF4aW1pemUgcHJvZml0Pw0KYGBgDQoNCiMjIFByb2JsZW0gRGVmaW5pdGlvbg0KDQpGaXJzdCwgV2UgbmVlZCB0byB0cmFuc2xhdGUgdGhlIHByb2JsZW0gaW4gYSBtYXRoZW1hdGljYWwgd2F5Lg0KDQoqICRXJCBpcyB0aGUgYXJlYSBvZiB3aGVhdCBwZXIgYWNyZXMNCiogJEIkIGlzIHRoZSBhcmVhIG9mIGJhcmxleSBwZXIgYWNyZXMNCg0KTm93LCB3ZSB3b3VsZCBsaWtlIHRvIG1heGltaXplIHRoZSBwcm9maXQuIFNvLCB3ZSBoYXZlIHRvIHNldCBvdXIgb2JqZWN0aXZlIGZ1bmN0aW9uIGFzIGZvbGxvd3M6DQoNCiogVGhlIHByb2ZpdCBvZiBlYWNoIGJ1c2hlbCBvZiB3aGVhdChXKSBpcyAkXCQxNDMkDQoqIFRoZSBwcm9maXQgb2YgZWFjaCBidXNoZWwgb2YgYmFybGV5KEIpIGlzICRcJDYwJA0KDQokcHJvZml0KFcsQik9KDExMCkoMS4zKVcrKDMwKSgyKUIkDQoNCiRQPTE0M1crNjBCJA0KDQpUaGUgY29uc3RyYWludHMgY2FuIGJlIHNldCBpbiB0aGUgZm9sbG93aW5nIHdheXM6DQoNCjEuIFByb2R1Y3Rpb24gQ29zdA0KLSAkMTIwVysyMTBCXGxlMTUwMDAkDQoNCjIuIFRvdGFsIEFyZWEgaW4gQWNyZXMNCi0gJFcrQlxsZTc1JA0KDQozLiBTdG9yYWdlIFNwYWNlDQotICQxMTBXKzMwQlxsZTQwMDAkDQotICRXXGdlMCQNCi0gJEJcZ2UwJA0KDQojIyBTb2x1dGlvbiB3aXRoIGBscFNvbHZlYA0KYGBge3J9DQpsaWJyYXJ5KGxwU29sdmUpDQoNCiMgU2V0IHRoZSBjb2VmZmljaWVudHMgb2YgdGhlIG9iamVjdGl2ZSBmdW5jdGlvbg0Kb2JqLmZ1bmMgPC0gYygxNDMsIDYwKQ0KDQojIENyZWF0ZSBjb25zdHJhaW50IG1hdHJpeA0KY29uc3RyIDwtIG1hdHJpeChjKDEyMCwyMTAsDQogICAgICAgICAgICAgICAgICAgMTEwLDMwLA0KICAgICAgICAgICAgICAgICAgIDEsMSwNCiAgICAgICAgICAgICAgICAgICAxLDAsDQogICAgICAgICAgICAgICAgICAgMCwxKSwNCiAgICAgICAgICAgICAgICAgbnJvdyA9IDUsDQogICAgICAgICAgICAgICAgIGJ5cm93ID0gVFJVRSkNCg0KIyBDcmVhdGUgcmlnaHQgaGFuZCBzaWRlIG9yIHRoZSByZXN1bHQgZm9yIHRoZSBjb25zdHJhaW50cw0KcmhzIDwtIGMoMTUwMDAsIDQwMDAsIDc1LCAwLCAwKQ0KDQojIENyZWF0ZSB0aGUgZGlyZWN0aW9uIG9mIHRoZSBjb25zdHJhaW50cw0KZGlyZWMgPC0gYygiPD0iLCI8PSIsIjw9IiwiPj0iLCI+PSIpDQoNCiMgRmluZCB0aGUgb3B0aW11bSBzb2x1dGlvbg0Kb3B0aW11bSA8LSBscChkaXJlY3Rpb249Im1heCIsDQogICAgICAgICAgICAgIG9iamVjdGl2ZS5pbiA9IG9iai5mdW5jLA0KICAgICAgICAgICAgICBjb25zdC5tYXQgPSBjb25zdHIsDQogICAgICAgICAgICAgIGNvbnN0LmRpciA9IGRpcmVjLA0KICAgICAgICAgICAgICBjb25zdC5yaHMgPSByaHMsDQogICAgICAgICAgICAgIGFsbC5pbnQgPSBUKQ0Kc3RyKG9wdGltdW0pDQoNCiMgUHJpbnQgc3RhdHVzOiAwID0gc3VjY2VzcywgMiA9IG5vIGZlYXNpYmxlIHNvbHV0aW9uDQpwcmludChvcHRpbXVtJHN0YXR1cykNCg0KIyBEaXNwbGF5IHRoZSBvcHRpbXVtIHZhbHVlcyBmb3IgVyBhbmQgQg0Kc29sdXRpb24gPC0gb3B0aW11bSRzb2x1dGlvbg0KbmFtZXMoc29sdXRpb24pIDwtIGMoIlciLCJCIikNCnByaW50KHNvbHV0aW9uKQ0KDQojIENoZWNrIHRoZSB2YWx1ZSBvZiBvYmplY3RpdmUgZnVuY3Rpb24gYXQgb3B0aW11bSBwb2ludA0KcHJpbnQocGFzdGUoIlRvdGFsIFByb2ZpdDogIiwNCiAgICAgICAgICAgIG9wdGltdW0kb2JqdmFsLA0KICAgICAgICAgICAgc2VwID0gIiIpKQ0KYGBgDQoNClNvLCB0aGUgZmFybWVyIHNob3VsZCBwbGFudCAyMiBidXNoZWxzIG9mIHdoZWF0IGFuZCA1MiBidXNoZWxzIG9mIGJhcmxleSB0byBtYXhpbWl6ZSB0aGUgcHJvZml0LiBUaGUgcHJvZml0IGlzICQ2MjY2Lg0KDQpgYGB7cn0NCiMgRGlzY29ubmVjdCBmcm9tIHRoZSBtb2RlbCBhbmQgdGhlIG9wdGltdW0gc29sdXRpb24NCnJtKG9wdGltdW0sIGRpcmVjLCBzb2x1dGlvbikNCmBgYA0KDQojIyBTb2x1dGlvbiB3aXRoIGBscFNvbHZlQVBJYA0KYGBge3J9DQpsaWJyYXJ5KGxwU29sdmVBUEkpDQoNCiMgU2V0IDUgY29uc3RyYWludHMgYW5kIDIgZGVjaXNpb24gdmFyaWFibGVzDQpscHJlYyA8LSBtYWtlLmxwKG5yb3cgPSAwLA0KICAgICAgICAgICAgICAgICBuY29sID0gMikNCg0KIyBTZXQgdGhlIHR5cGUgb2YgcHJvYmxlbSB3ZSBhcmUgdHJ5aW5nIHRvIHNvbHZlDQpscC5jb250cm9sKGxwcmVjLA0KICAgICAgICAgICBzZW5zZSA9ICJtYXgiKQ0KDQojIFNldCB0eXBlIG9mIGRlY2lzaW9uIHZhcmlhYmxlcw0Kc2V0LnR5cGUobHByZWMsDQogICAgICAgICAxOjIsDQogICAgICAgICB0eXBlID0gYygiaW50ZWdlciIpKQ0KDQojIFNldCBvYmplY3RpdmUgZnVuY3Rpb24gY29lZmZpY2llbnRzIHZlY3RvciBvYmouZnVuYw0Kc2V0Lm9iamZuKGxwcmVjLA0KICAgICAgICAgIG9iai5mdW5jKQ0KDQojIEFkZCBjb25zdHJhaW50cw0KYWRkLmNvbnN0cmFpbnQobHByZWMsIGNvbnN0clsxLF0sICI8PSIsIHJoc1sxXSkNCmFkZC5jb25zdHJhaW50KGxwcmVjLCBjb25zdHJbMixdLCAiPD0iLCByaHNbMl0pDQphZGQuY29uc3RyYWludChscHJlYywgY29uc3RyWzMsXSwgIjw9IiwgcmhzWzNdKQ0KYWRkLmNvbnN0cmFpbnQobHByZWMsIGNvbnN0cls0LF0sICI+PSIsIHJoc1s0XSkNCmFkZC5jb25zdHJhaW50KGxwcmVjLCBjb25zdHJbNSxdLCAiPj0iLCByaHNbNV0pDQoNCiMgRGlzcGxheSB0aGUgbWF0cml4DQpscHJlYw0KDQojIFNvbHZlIHByb2JsZW0NCnNvbHZlKGxwcmVjKQ0KDQojIEdldCB0aGUgd2hlYXQgYW5kIGJhcmxleSB2YXJpYWJsZXMgdmFsdWUNCmdldC52YXJpYWJsZXMobHByZWMpDQoNCiMgR2V0IHRoZSBtYXhpbXVtIHByb2ZpdA0KZ2V0Lm9iamVjdGl2ZShscHJlYykNCg0KIyBOb3RlIHRoYXQgdGhlIGRlZmF1bHQgYm91bmRhcmllcyBvbiB0aGUgZGVjaXNpb24gdmFyaWFibGVzIGFyZSBjKDAsIDApIGFuZCBjKEluZiwgSW5mKQ0KZ2V0LmJvdW5kcyhscHJlYykNCg0KIyBCb3VuZGFyaWVzIGNhbiBiZSBzZXQgd2l0aCBmb2xsb3dpbmcgZnVuY3Rpb24NCmxwU29sdmVBUEk6OnNldC5ib3VuZHMobHByZWMpDQpgYGANCg0KU28sIHRoZSBmYXJtZXIgc2hvdWxkIHBsYW50IDIyIGJ1c2hlbHMgb2Ygd2hlYXQgYW5kIDUyIGJ1c2hlbHMgb2YgYmFybGV5IHRvIG1heGltaXplIHRoZSBwcm9maXQuIFRoZSBwcm9maXQgaXMgJDYyNjYu