constrained optimization in R setting up constrain

Question

I have been trying to solve a constrained optimization problem in R using constrOptim() (my first time) but am struggling to set up the constraints for my problem.

The problem is pretty straight forward and i can set up the function ok but am a bit at a loss about passing the constraints in.

e.g. problem i've defined is (am going to start with N fixed at 1000 say so i just want to solve for X ultimately i'd like to choose both N and X that max profit):

so i can set up the function as:

fun <- function(x, N, a, c, s) {   ## a profit function
    x1 <- x[1]
    x2 <- x[2]
    x3 <- x[3]    
    a1 <- a[1]
    a2 <- a[2]
    a3 <- a[3]
    c1 <- c[1]
    c2 <- c[2]
    c3 <- c[3]
    s1 <- s[1]
    s2 <- s[2]
    s3 <- s[3]  
    ((N*x1*a1*s1)-(N*x1*c1))+((N*x2*a2*s2)-(N*x2*c2))+((N*x3*a3*s3)-(N*x3*c3))
}

The constraints i need to implement are that:

x1>=0.03
x1<=0.7
x2>=0.03
x2<=0.7
x3>=0.03
x2<=0.7
x1+x2+x3=1

The X here represents buckets into which i need to optimally allocate N, so x1=pecent of N to place in bucket 1 etc. with each bucket having at least 3% but no more than 70%.

Any help much appreciated...

e.g. here is an example i used to test the function does what i want:

    fun <- function(x, N, a, c, s) {   ## profit function
        x1 <- x[1]
        x2 <- x[2]
        x3 <- x[3]    
        a1 <- a[1]
        a2 <- a[2]
        a3 <- a[3]
        c1 <- c[1]
        c2 <- c[2]
        c3 <- c[3]
        s1 <- s[1]
        s2 <- s[2]
        s3 <- s[3]  
        ((N*x1*a1*s1)-(N*x1*c1))+((N*x2*a2*s2)-(N*x2*c2))+((N*x3*a3*s3)-(N*x3*c3))
    };

    x <-matrix(c(0.5,0.25,0.25));

    a <-matrix(c(0.2,0.15,0.1));

    s <-matrix(c(100,75,50));

    c <-matrix(c(10,8,7));

    N <- 1000;

fun(x,N,a,c,s);

Answer 1

You can use The lpSolveAPI package.

## problem constants
a <- c(0.2, 0.15, 0.1)
s <- c(100, 75, 50)
c <- c(10, 8, 7)
N <- 1000


## Problem formulation
# x1          >= 0.03
# x1          <= 0.7
#     x2      >= 0.03
#     x2      <= 0.7
#          x3 >= 0.03
# x1 +x2 + x3  = 1
#N*(c1- a1*s1)* x1 + (a2*s2 - c2)* x2 + (a3*s3-  c3)* x3

library(lpSolveAPI)
my.lp <- make.lp(6, 3)

The best way to build a model in lp solve is columnwise;

#constraints by columns
set.column(my.lp, 1, c(1, 1, 0, 0, 1, 1))
set.column(my.lp, 2, c(0, 0, 1, 1, 0, 1))
set.column(my.lp, 3, c(0, 0, 0, 0, 1, 1))
#the objective function ,since we need to max I set negtive max(f) = -min(f)
set.objfn (my.lp, -N*c(c[1]- a[1]*s[1], a[2]*s[2] - c[2],a[3]*s[3]-  c[3]))
set.rhs(my.lp, c(rep(c(0.03,0.7),2),0.03,1))
#constraint types 
set.constr.type(my.lp, c(rep(c(">=","<="), 2),">=","="))

take a look at my model

my.lp
Model name: 

 Model name: 
             C1     C2     C3          
Minimize  10000  -3250   2000          
R1            1      0      0  >=  0.03
R2            1      0      0  <=   0.7
R3            0      1      0  >=  0.03
R4            0      1      0  <=   0.7
R5            1      0      1  >=  0.03
R6            1      1      1   =     1
Kind        Std    Std    Std          
Type       Real   Real   Real          
Upper       Inf    Inf    Inf          
Lower         0      0      0      
 solve(my.lp)

[1] 0    ## sucess :)

get.objective(my.lp)
[1] -1435
get.constraints(my.lp)
[1] 0.70 0.70 0.03 0.03 0.97 1.00
## the decisions variables
get.variables(my.lp)
[1] 0.03 0.70 0.27

Answer 2

Hi Just in case of use to anyone i also found an answer as below:

First of all, your objective function can be written a lot more concisely using vector operations:

> my_obj_coeffs <- function(N,a,c,s) N*(a*s-c)


> fun <- function(x,N,a,c,s) sum(my_obj_coeffs(N,a,c,s) * x)

You're trying to solve a linear program, so you can use solve it using the simplex algorithm. There's a lightweight implementation of it in the 'boot' package.

> library(boot)

> solution <- function(obj) simplex(obj, diag(3), rep(0.7,3), diag(3), rep(0.03,3), rep(1,3), 1, maxi=TRUE)

Then for the example parameters you used, you can call that solution function:

> a <- c(0.2,0.15,0.1)
> s <- c(100,75,50)
> c <- c(10,8,7)
> N <- 1000
> solution(my_obj_coeffs(N,a,c,s))

Linear Programming Results

Call : simplex(a = obj(N, a, s, c), A1 = diag(3), b1 = rep(0.7, 3), 
    A2 = diag(3), b2 = rep(0.03, 3), A3 = matrix(1, 1, 3), b3 = 1, 
    maxi = TRUE)

Maximization Problem with Objective Function Coefficients
      [,1]
[1,] 10000
[2,]  3250
[3,] -2000
attr(,"names")
[1] "x1" "x2" "x3"


Optimal solution has the following values
  x1   x2   x3 
0.70 0.27 0.03 
The optimal value of the objective  function is 7817.5.