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)
Related
I am trying to construct an arbitrage portfolio x such that Sx = 0 and Ax>=0, where A is the payoff matrix at t=1 and S is the price at t=0. I was not able to do it manually, so I tried using functions contained in the limSolve and lpSolve packages in R with no success, as I keep getting the zero-vector (I need nontrivial solutions). I am not sure how to code it up myself either. Any help or hints on how to proceed would be much appreciated. Thanks!
A = data.frame(
cbind(
c(2,1,0),
c(1,1,1),
c(0,1,2),
c(3,2,1),
c(1,1,0)
)
) %>% as.matrix()
f.con = A
S = data.frame(
cbind(
c(1,1,1,2,1/3)
)
) %>% as.matrix()
f.obj = c(t(S))
# Set unequality signs
f.dir <- c(">",
">",
">")
# Set right hand side coefficients
f.rhs <- c(0,
0,
0)
# Final value
lp("min", f.obj, f.con, f.dir, f.rhs)$solution
# Variables final values
lp("max", f.obj, f.con, f.dir, f.rhs)$solution
We first explain why the code in the question got the results that it did.
Note that there is an implicit constraint of x >= 0.
Regarding the subject that refers to a equality constraint there are no equality constraints in the code shown in the question.
Regarding the minimum, in the lp arguments > means >= so clearly x=0 is feasible. Given that all components of the objective vector are positive it leads to a minimum of 0. From ?lp
const.dir: Vector of character strings giving the direction of the
constraint: each value should be one of "<," "<=," "=," "==,"
">," or ">=". (In each pair the two values are identical.)
Regarding the maximum, there are no upper bound constraints on the solution and the objective vector's components are all positive so there is no finite solution. Whether the linear program was successful or not should always be shown prior to displaying the solution and if it was unsuccessful then the solution should not be displayed since it has no meaning.
Regarding the code, cbind already produces a matrix so it is pointless to convert it to a data frame and then back to a matrix. Also the objective can be expressed as a plain vector and the rhs of the constraints can be written as a scalar which will be recycled to the appropriate length. We can write the code in the question equivalently as:
library(lpSolve)
A <- cbind(2:0, 1, 0:2, 3:1, c(1, 1, 0))
S <- c(1, 1, 1, 2, 1/3)
res1 <- lp("min", S, A, ">=", 0)
res1
## Success: the objective function is 0
res1$solution
## [1] 0 0 0 0 0
res2 <- lp("max", S, A, ">=", 0)
res2
## Error: status 3
CVXR
It is easier to formulate this using CVXR as shown below.
Find a vector x which satisfies Ax >= 0 and Sx == 0. (A and S are from above.) We add constraints -1 <= x <= 1 to keep the solution within bounds and use an arbitrary objective sum(x) since we are only looking for any feasible solution.
library(CVXR)
x <- Variable(5)
objective <- Maximize(sum(x)) # arbitrary objective
constraints <- list(A %*% x >= 0, sum(S*x) == 0, x >= -1, x <= 1)
problem <- Problem(objective, constraints)
soln <- solve(problem)
giving:
> soln$status
[1] "optimal"
> soln$value
[1] 1.66666
> soln$getValue(x)
[,1]
[1,] 0.8788689
[2,] 0.4790521
[3,] 0.3087133
[4,] -0.9999857
[5,] 1.0000113
lpSolve again
To do this using lpSolve make the change of variables
x = 2*y-1
or equivalently
y = (x+1)/2
which converts
Ax >= 0
Sx == 0
-1 <= x <= 1
to
2Ay >= A1
2Sy >= S'1
0 <= y <= 1
so we write:
f.con <- rbind(2*A, 2*S, diag(5))
f.dir <- c(rep(">=",3), "=", rep("<=", 5))
f.rhs <- c(rowSums(A), sum(S), rep(1, 5))
res3 <- lp("max", rep(1, 5), f.con, f.dir, f.rhs)
res3
## Success: the objective function is 3.333333
2*res3$solution-1
## [1] 1.000000e+00 -4.966028e-13 6.666667e-01 -1.000000e+00 1.000000e+00
Consider the Markov chain with state space S = {1, 2}, transition matrix
and initial distribution α = (1/2, 1/2).
Simulate 5 steps of the Markov chain (that is, simulate X0, X1, . . . , X5). Repeat the simulation 100
times. Use the results of your simulations to solve the following problems.
Estimate P(X1 = 1|X0 = 1). Compare your result with the exact probability.
My solution:
# returns Xn
func2 <- function(alpha1, mat1, n1)
{
xn <- alpha1 %*% matrixpower(mat1, n1+1)
return (xn)
}
alpha <- c(0.5, 0.5)
mat <- matrix(c(0.5, 0.5, 0, 1), nrow=2, ncol=2)
n <- 10
for (variable in 1:100)
{
print(func2(alpha, mat, n))
}
What is the difference if I run this code once or 100 times (as is said in the problem-statement)?
How can I find the conditional probability from here on?
Let
alpha <- c(1, 1) / 2
mat <- matrix(c(1 / 2, 0, 1 / 2, 1), nrow = 2, ncol = 2) # Different than yours
be the initial distribution and the transition matrix. Your func2 only finds n-th step distribution, which isn't needed, and doesn't simulate anything. Instead we may use
chainSim <- function(alpha, mat, n) {
out <- numeric(n)
out[1] <- sample(1:2, 1, prob = alpha)
for(i in 2:n)
out[i] <- sample(1:2, 1, prob = mat[out[i - 1], ])
out
}
where out[1] is generated using only the initial distribution and then for subsequent terms we use the transition matrix.
Then we have
set.seed(1)
# Doing once
chainSim(alpha, mat, 1 + 5)
# [1] 2 2 2 2 2 2
so that the chain initiated at 2 and got stuck there due to the specified transition probabilities.
Doing it for 100 times we have
# Doing 100 times
sim <- replicate(chainSim(alpha, mat, 1 + 5), n = 100)
rowMeans(sim - 1)
# [1] 0.52 0.78 0.87 0.94 0.99 1.00
where the last line shows how often we ended up in state 2 rather than 1. That gives one (out of many) reasons why 100 repetitions are more informative: we got stuck at state 2 doing just a single simulation, while repeating it for 100 times we explored more possible paths.
Then the conditional probability can be found with
mean(sim[2, sim[1, ] == 1] == 1)
# [1] 0.4583333
while the true probability is 0.5 (given by the upper left entry of the transition matrix).
I have been trying to write a generalized function that multiplies each value in each row of a matrix by the corresponding value of a vector in terms of their position (i.e. matrix[1,1]*vector[1], matrix[1,2]*vector[2], etc) and then sum them together. It is important to note that the lengths of the vector and the rows of the matrix are always the same, which means that in each row the first value of the vector is multiplied with the first value of the matrix row. Also important to note, I think, is that the rows and columns of the matrix are of equal length. The end sum for each row should be assigned to different existing vector, the length of which is equal to the number of rows.
This is the matrix and vector:
a <- c(4, -9, 2, -1)
b <- c(-1, 3, -8, 2)
c <- c(5, 2, 6, 3)
d <- c(7, 9, -2, 5)
matrix <- cbind(a,b,c,d)
a b c d
[1,] 4 -1 5 7
[2,] -9 3 2 9
[3,] 2 -8 6 -2
[4,] -1 2 3 5
vector <- c(1, 2, 3, 4)
These are the basic functions that I have to generalize for the rows and columns of matrix and a vector of lenghts "n":
f.1 <- function() {
(matrix[1,1]*vector[1]
+ matrix[1,2]*vector[2]
+ matrix[1,3]*vector[3]
+ matrix[1,4]*vector[4])
}
f.2 <- function() {
(matrix[2,1]*vector[1]
+ matrix[2,2]*vector[2]
+ matrix[2,3]*vector[3]
+ matrix[2,4]*vector[4])
}
and so on...
This is the function I have written:
ncells = 4
f = function(x) {
i = x
result = 0
for(j in 1:ncells) {
result = result + vector[j] * matrix[i][j]
}
return(result)
}
Calling the function:
result.cell = function() {
for(i in 1:ncells) {
new.vector[i] = f(i)
}
}
The vector to which this result should be assigned (i.e. new.vector) has been defined beforehand:
new.vector <- c()
I expected that the end sum for each row will be assigned to the vector in a corresponding manner (e.g. if the sums for all rows were 1, 2, 3, 4, etc. then new.vector(1, 2, 3, 4, etc) but it did not happen.
(Edit) When I do this with the basic functions, the assignment works:
new.vector[1] <- f.1()
new.vector[2] <- f.2()
This does not however work with the generalized function:
new.vector[1:ncells] <- result cell[1:ncells]
(End Edit)
I have also tried setting the length for the the new.vector to be equal to ncells but I don't think it did any good:
length(new.vector) = ncells
My question is how can I make the new vector take the resulting sums of the multiplied elements of a row of a matrix by the corresponding value of a vector.
I hope I have been clear and thanks in advance!
There is no need for a loop here, we can use R's power of matrix multiplication and then sum the rows with rowSums. Note that m and v are used as names for matrix and vector to avoid conflict with those function names.
nr <- nrow(m)
rowSums(m * matrix(rep(v, nr), nr, byrow = TRUE))
# [1] 45 39 -4 32
However, if the vector v is always going to be the column number, we can simply use the col function as our multiplier.
rowSums(m * col(m))
# [1] 45 39 -4 32
Data:
a <- c(4, -9, 2, -1)
b <- c(-1, 3, -8, 2)
c <- c(5, 2, 6, 3)
d <- c(7, 9, -2, 5)
m <- cbind(a, b, c, d)
v <- 1:4
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)!
I am trying to find the dot product of two matrices in R. In the q matrix, which must be transposed, I have three different q values that I randomly generated earlier, and in the z matrix three randomly generated z values that serve as coordinates of a random point i. I have:
z0= NULL
for (i in 1:100){
z0[i]= 1
}
z1= runif(100, min=0, max= 20)
z2= runif(100, min=0, max=20)
q0= runif(1, 0, 1)
q1= runif(1, 0, 1)
q2= runif(1, 0, 1)
i= runif(1, 1, 101)
i= ceiling(i-1)
q= matrix(c(q0,q1,q2), ncol=3)
z= matrix(c(z0[i],z1[i],z2[i]), ncol=3)
s[i]= t(q)*z
However, when I try to calculate s[i], I get Error in t(q) * z : non-conformable arrays. I am not sure why this would be as I they seem to both have the same length.
This is my first time using R so I am not really sure what is going on.
Thanks!
Without using matrices or any special libraries:
The dot product of two vectors can be calulated by multiplying them element-wise with * then summing the result.
a <- c(1,2,3)
b <- c(4,5,6)
sum(a*b)
As Pascal says, dot product in R is %*%. I am able to use this successfully on your sample data:
> z0= NULL
> for (i in 1:100){
+ z0[i]= 1
+ }
> z1= runif(100, min=0, max= 20)
> z2= runif(100, min=0, max=20)
> q0= runif(1, 0, 1)
> q1= runif(1, 0, 1)
> q2= runif(1, 0, 1)
> i= runif(1, 1, 101)
> i= ceiling(i-1)
> q= matrix(c(q0,q1,q2), ncol=3)
> z= matrix(c(z0[i],z1[i],z2[i]), ncol=3)
> t(q)%*%z
[,1] [,2] [,3]
[1,] 0.3597998 3.227388 2.960053
[2,] 0.3544622 3.179510 2.916141
[3,] 0.3550781 3.185035 2.921208
> z%*%t(q)
[,1]
[1,] 4.340265
Sample Answer:
library(geometry)
dot(A,B)
Since it seems like others have tackled your issue, I'll just add on to say that if you want a special dot product function, you can write one yourself:
dot <- function(x, y){ # x and y can be vectors or matrices
result <- t(x)%*%y # %*% is the matrix multiplication operator
print(result) # t(x) denotes the transpose of x
}
Or, as #user3503711 says in his answer, you can just use the dot() function from the geometry library.