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
Related
Suppose I have a vector
vec <- c(0, 1, 0, 0, 0, 1, 1, 1, 1, 2)
How do I random sample a nonzero element and turn other elements into 0?
Suppose the element sampled was vec[2], then the resulting vector would be
vec <- c(0, 1, 0, 0, 0, 0, 0, 0, 0, 0)
I know that I can sample the indice of one nonzero element by sample(which(vec != 0), 1), but I am not sure how to proceed from that. Thanks!
You can try the code below
> replace(0 * vec, sample(which(vec != 0), 1), 1)
[1] 0 0 0 0 0 0 0 1 0 0
where
which returns the indices of non-zero values
sample gives a random index
replace replaces the value to 1 at the specific index
Watch out for sample's behavior if which returns only 1 value:
> vec <- c(rep(0, 9), 1)
> sample(which(vec != 0), 1)
[1] 4
This preserves the vector value (instead of turning it to 1) and guards against vectors with only one nonzero value using rep to guarantee sample gets a vector with more than one element:
vec[-sample(rep(which(vec != 0), 2), 1)] <- 0
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 4 years ago.
Improve this question
I am trying out R studio myself and have a question.
I have a vector
vec <- c(1, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1)
I want to make a function to do the following: if the distance between two subsequences of 1's less then 5, then it is going to show 0. But if it is more than 5 it will show 1.
So, if looking at
vec <- c(1, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1)
the output is going to be:
0 0 1
I understand how I can find a position of 1:
function_start_of_seq <- function(x) {
one_pos<-which(rle(x)$values==1 %in% TRUE)
And I know that I need to use diff function and cumsum, but I don't know how...
Perhaps an approach regarding rather the 0s than the 1s is more appropriate. In the next line you can check the lengths of the rle() output which distance (i.e. number of 0s between the 1s) exceeds the 5. Just convert it into 0-1 with as.numeric()at the end.
fun1 <- function(x) {
null_pos <- which(rle(x)$values == 0)
tf <- rle(x)$lengths[null_pos] > 5
return(as.numeric(tf))
}
> fun1(vec)
[1] 0 0 1
Does that make sense?
In case you want a one-liner, just do
> as.numeric(rle(vec)$lengths[which(rle(vec)$values == 0)] > 5)
[1] 0 0 1
The part which(rle(vec)$values == 0) selects the positions with distance between 1s sequences (i.e. the output of rle() regarding the 0s) is greater than 5.
as.numeric() then "translates" the output into the 0-1 - form you desire.
An uncool, non-obfuscated, only-calling-rle-once, no-use-of-which answer:
vec <- c(1, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1)
r <- rle(vec)
r
## Run Length Encoding
## lengths: int [1:7] 1 2 2 4 1 6 1
## values : num [1:7] 1 0 1 0 1 0 1
So it seems the distance between the 1 sequences is what you're after. We'll assume you know you always have 0's and 1's.
r$values == 0 will return a vector with TRUE or FALSE for the result of each positional evalution. We can use that directly in r$lengths.
rl <- r$lengths[r$values == 0]
rl
## [1] 2 4 6
Since it's just 0 and 1, we don't need a double. integers will do just fine:
as.integer(rl > 5)
## [1] 0 0 1
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])
I have a task that I am doing with an ordinary for loop. I think it can be done by one of apply functions but can't find a way to do it. Can you please if it is possible to apply apply to the problem or if there is more efficient way of solving it ?
I am aware that I can make udf and do.call() but I think it would be the same as for loop.
The problem:
I have two matrices a and b, both (m x n) and a vector of length n. I want to create third matrix (m x n) which would recieve columns from a or b based on the values of a vector.
For example:
a=
[0, 0, 0, 0]
[0, 0, 0, 0]
[0, 0, 0, 0]
[0, 0, 0, 0]
b=
[1, 1, 1, 1]
[1, 1, 1, 1]
[1, 1, 1, 1]
[1, 1, 1, 1]
x=
[-1, -1, 1, 1]
if x[k] is -1, c recieves column from a, if x[k] is 1 then c recieves column from b, which yields:
c=
[0, 0, 1, 0]
[0, 0, 1, 0]
[0, 0, 1, 0]
[0, 0, 1, 0]
Reproducible example:
a <- matrix(rep(0, 16), nrow = 4, ncol = 4)
b <- matrix(rep(1, 16), nrow = 4, ncol = 4)
x <- c(-1,-1, 1,-1)
c <- matrix(NA, nrow = 4, ncol = 4)
for (i in 1:length(x)){
if (x[[i]] < 0){
c[,i] <- a[,i]
} else {
c[,i] <- b[,i]
}
}
Is there any more efficient solution ?
Regards,
P.
We can either use ifelse after making the 'x' as the same length as 'a/b' by replicating each of the 'x' elements. The col is a convenient function to do that.
c <- a
c[] <- ifelse(x[col(a)]==-1, a, b)
Or as in the previous step, we create a logical vector (x==1), coerce to binary with +, make the length the same as 'a', specify the ncol in the matrix.
matrix(+(x==1)[col(a)], ncol=ncol(a))
# [,1] [,2] [,3] [,4]
#[1,] 0 0 1 0
#[2,] 0 0 1 0
#[3,] 0 0 1 0
#[4,] 0 0 1 0
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.