Linear Programs using R - r

How can we solve a linear program using R? I want to solve the following example:
min -a -2b +4c
Constraints
a + b + s1 = 5
a + 3c -s2 = 10
2b - 3c = 20
a >= 0, b >= 0, c >= 0, s1 >= 0, s2 >= 0
The equations might not make total sense. I just need to know the syntax of writing these equations in R.
I might write something like this for the above equations
require(lpSolve)
R.obj <- c(-1,-2,4)
R.con <- matrix(c(1,1,1,1,3,-1,2,-3),nrow=3,byrow=TRUE)
R.dir <- c("=","=","=")
R.rhs <- c(5,10,20)
lp("min",R.obj,R.con,R.dir,R.rhs)
Would this be correct? In the documentation, the matrix is always M*M, what if the matrix is M*N where N != M?

Your constraint matrix has 3 rows and 5 columns, but you've only provided the 8 non-zero values when building your constraint matrix. Further, you have 5 variables, so R.obj needs 5 values:
require(lpSolve)
R.obj <- c(-1, -2, 4, 0, 0)
R.con <- matrix(c(1, 1, 0, 1, 0, 2, 0, 3, -3, 1, 0, 0, 0, -1, 0), nrow=3)
R.dir <- c("=", "=", "=")
R.rhs <- c(5, 10, 20)
lp("min", R.obj, R.con, R.dir, R.rhs)
# Error: no feasible solution found
A bit of math shows that this LP is indeed infeasible. This LP is equivalent to -a - b >= -5, a + 3c >= 10, b = 10 + 1.5c. You can substitute the last equation into the first to yield -a - 1.5c >= 5 and a + 3c >= 10, and adding yields c >= 10. By your third equation, b >= 25, which means the first equation can never hold due to the non-negativity of a and s1.

Related

How to solve a system of linear inequalities in R

Suppose I have a system of linear inequalities: Ax <= b. I'm trying to figure out how to solve this in R.
I know that the eliminate function from the package lintools performs variable elimination. The output is a list of the following information:
A: the A corresponding to the system with variables eliminated.
b: the constant vector corresponding to the resulting system
neq: the number of equations
H: The memory matrix storing how each row was derived
h: The number of variables eliminated from the original system.
I wrote a loop to try to perform variable elimination. However, I am not sure how to get the final solutions from this system of linear inequalities:
library(lintools)
A <- matrix(c(
4, -5, -3, 1,
-1, 1, -1, 0,
1, 1, 2, 0,
-1, 0, 0, 0,
0, -1, 0, 0,
0, 0, -1, 0),byrow=TRUE,nrow=6)
b <- c(0,2,3,0,0,0)
L <- vector("list", length = nrow(A))
L[[1]] <- list(A = A, b = b, neq = 0, nleq = nrow(A), variable = 1)
for(i in 1:(nrow(A) - 3)){
print(i)
L[[i + 1]] <- eliminate(A = L[[i]]$A, b = L[[i]]$b, neq = L[[i]]$neq, nleq = L[[i]]$nleq, variable = i + 1)
}
Presumably you will know what to do with this (I don't):
str(L) # the last two items in L are NULL
tail(L,n=3)[[1]] #Take the first of the last three.
$A
[1,] -0.5 0 0 0
[2,] 0.5 0 0 0
[3,] -1.0 0 0 0
$b
[1] 3.5 1.5 0.0
$neq
[1] 0
$nleq
[1] 3
$H
NULL
$h
[1] 0

R solver optimization

I am new to R solver and I want to have a simple example in R for the below problem:
I have four columns which I calculate the individual sums as the illustrated sample example below:
The problem I want to solve in R:
Find the optimal lines that satisfies, simultaneously, the below statements:
For the first two columns (a, b) the individual summations to be more close to 0
The sums of (c, d) to be more close to 5
I do not have restrictions of which package solver to use. It could be helpful to have an example of R code for this!
EDIT
For the same solution I would like to apply some rules:
I want the sum(c) > sum(d) AND sum(d) < (static number, like 5)
Also, if I want the sums to fall into a range of numbers and not just static numbers, how the solution could it be written?
Using M defined reproducibly in the Note at the end we find the b which minimizes the following objective where b is a 0/1 vector:
sum((b %*% M - c(0, 0, 5, 5))^2)
1) CVXR Using the CVXR package we get a solution c(1, 0, 0, 1, 1) which means choose rows 1, 4 and 5.
library(CVXR)
n <- nrow(M)
b <- Variable(n, boolean = TRUE)
pred <- t(b) %*% M
y <- c(0, 0, 5, 5)
objective <- Minimize(sum((t(y) - pred)^2))
problem <- Problem(objective)
soln <- solve(problem)
bval <- soln$getValue(b)
zapsmall(c(bval))
## [1] 1 0 0 1 1
2) Brute Force Alternately since there are only 5 rows there are only 2^5 possible solutions so we can try them all and pick the one which minimizes the objective. First we compute a matrix solns with 2^5 columns such that each column is one possible solution. Then we compute the objective function for each column and take the one which minimizes it.
n <- nrow(M)
inverse.which <- function(ix, n) replace(integer(n), ix, 1)
L <- lapply(0:n, function(i) apply(combn(n, i), 2, inverse.which, n))
solns <- do.call(cbind, L)
pred <- t(t(solns) %*% M)
obj <- colSums((pred - c(0, 0, 5, 5))^2)
solns[, which.min(obj)]
## [1] 1 0 0 1 1
Note
M <- matrix(c(.38, -.25, .78, .83, -.65,
.24, -.35, .44, -.88, .15,
3, 5, 13, -15, 18,
18, -7, 23, -19, 7), 5)

Vectorize loop with repeating indices

I have a vector of indices that contains repeating values:
IN <- c(1, 1, 2, 2, 3, 4, 5)
I would like to uses these indices to subtract two vectors:
ST <- c(0, 0, 0, 0, 0, 0, 0)
SB <- c(1, 1, 1, 1, 1, 1, 1)
However, I would like to do the subtraction in "order" such that after subtraction of the first index values (0, 1), the second substraction would "build off" the first subtraction. I would like to end up with a vector FN that looks like this:
c(-2, -2, -1, -1, -1, 0, 0)
This is easy enough to do in a for loop:
for(i in seq_along(IN)){
ST[IN[i]] <- ST[IN[i]] - SB[IN[i]]
}
But I need to run this loop many times on long vectors and this can take many hours. Is there any way to vectorize this task and avoid a for loop? Maybe using a data.table technique?
Sure, with data.table, it's
library(data.table)
DT = data.table(ST)
mDT = data.table(IN, SB)[, .(sub = sum(SB)), by=.(w = IN)]
DT[mDT$w, ST := ST - mDT$sub ]
ST
1: -2
2: -2
3: -1
4: -1
5: -1
6: 0
7: 0
Or with base R:
w = sort(unique(IN))
ST[w] <- ST[w] - tapply(SB, IN, FUN = sum)
# [1] -2 -2 -1 -1 -1 0 0
Here is an option using aggregate in base R:
ag <- aggregate(.~IN, data.frame(IN, ST[IN]-SB[IN]), sum)
replace(ST, ag[,1], ag[,2])
#[1] -2 -2 -1 -1 -1 0 0
OR using xtabs:
d <- as.data.frame(xtabs(B~A, data.frame(A=IN, B=ST[IN]-SB[IN])))
replace(ST, d[,1], d[,2])

Linear programming in R using lpsolve

I'm trying to solve a linear programming problem in R using lpsolve package.
Here is the problem:
Here is the sample in R for reproducible example:
library("lpSolve")
a <- matrix(c(1,2,5,
1/2,1,3,
1/5,1/3,1),nrow=3,byrow=T)
#
f.obj <- c(1,0,0,0)
f.con <- matrix (c(
1,1,-a[1,2],0, #Contraint 1 for a12
1,-1,a[1,2],0, #Contraint 2 for a12
1,1,0,-a[1,3], #Contraint 1 for a13
1,-1,0,a[1,3], #Contraint 2 for a13
1,0,1,-a[2,3], #Contraint 1 for a23
1,0,-1,a[2,3], #Contraint 2 for a23
0,1,1,1, #Contraint 3
0,1,0,0, #Constraint 4
0,0,1,0, #Constraint 4
0,0,0,1 #Constraint 4
), nrow=10, byrow=TRUE)
f.dir <- c(rep("<=",6), "=",rep(">",3))
f.rhs <- c(rep(1,6),1,rep(0,3))
g <- lp ("max", f.obj, f.con, f.dir, f.rhs)
g$solution
I'm able to solve this manually for a small problem, what if I had a 7 X 7 or a n x n matrix a. How would I specify the constraint 1 and 2, especially I'm struggling to define the constraint as it relates to a[i,j]?
a = matrix(
c(1,4,9,6,6,5,5,
1/4,1,7,5,5,3,4,
1/9,1/7,1,1/5,1/5,1/7,1/5,
1/6,1/5,5,1,1,1/3,1/3,
1/6,1/5,5,1,1,1/3,1/3,
1/5,1/3,7,3,3,1,2,
1/5,1/4,5,3,3,1/2,1
),nrow = 7,byrow =T)
the solution to the above matrix is 0.986 0.501 0.160 0.043 0.060 0.060 0.1 0.075 Any help would be greatly appreciated.
Have updated to incorporate revised constraint 4 and have made some minor code improvements.
Assuming the constraint matrix in the question is correct, this uses combn to iterate over all i < j setting the appropriate elements. Note that x[1] is the value of i and x[2] is the value of j in f. make_cons returns the constraint matrix in the same order as shown in the question but the rbind line in make_cons could be simplified to rbind(cons1, cons2, cons3, cons4) if it were OK to use such order.
make_cons <- function(a) {
n <- nrow(a)
f <- function(x) replace(numeric(n), x, c(1, -a[x[1], x[2]]))
cons1 <- cbind(1, t(combn(1:n, 2, f)))
cons2 <- cbind(1, -cons1[, -1])
cons3 <- c(0, rep(1, n))
cons4 <- cbind(0, diag(n))
rbind(t(matrix(rbind(t(cons1), t(cons2)), ncol(cons1))), cons3, cons4)
}
# test
# a and f.con from question
a <- matrix(c(1, 0.5, 0.2, 2, 1, 0.333333333333333, 5, 3, 1), 3)
f.con <- matrix(c(1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, -1, 1, -1, 0, 0,
1, 1, 0, 0, -2, 2, 0, 0, 1, -1, 1, 0, 1, 0, 0, 0, -5, 5, -3,
3, 1, 0, 0, 1), 10)
all.equal(f.con, make_cons(a), check.attributes = FALSE)
## [1] TRUE
here is one possibility which uses for loops.
As I mentioned in the commenst, I think that you got condition (4) wrong. Here is my suggestion.
My idea is to first set up a matrix for constraints (4), then for constraint (3)
and then add constraints (2) and (1) in a loop. Note that, in the beginning, I do not consider the column corresponding to \mu. I will add this column in the end.
n<- nrow(a)
f.cons<- diag(n)
f.cons<- rbind(f.cons, rep(1,n))
This sets up a matrix corresponding to constraints (4) (first n rows) and constraint (3). Now I add rows to this matrix, using loops and the command rbind.
for(i in 1:(n-1)){
for(j in (i+1): n){
x<- rep(0, n)
x[i]<- 1 #x corresponds to (1)
x[j]<- -a[i,j]
y<- -x #y corresponds to (2)
f.cons<- rbind(f.cons, rbind(x, y))
}
}
So far, I have ignored the first column, which corresponds to \mu.
I add it with these two simple lines:
f.cons<- cbind(rep(1, nrow(f.cons)), f.cons)
f.cons[1:(n+1), 1]=0
Note that in my matrix f.cond the first n+1 lines correspond to constraints (3) and (4)!

Vectorized replacement of a subset of a vector

Simple question: I've got two vectors of 0's and 1's, a and b. The b vector has as many entries as there are 1's in a. I would like to replace the 1's in a with the entries from b. Of course I can do this in a for loop, but is there a nice vectorized way to do this?
From
a <- c(0, 1, 1, 0, 1)
b <- c(1, 0, 1)
create
c <- c(0, 1, 0, 0, 1)
This is pretty simple: a[a == 1] <- b

Resources