R Optimize linear equations coefficients with constraints - r

Say I have n linear equations of the form:
ax1 + bx2 + cx3 = y1
-ax1 + bx2 + cx3 = y2
-ax1 -bx2 + cx3 = y3
Here is n=3 and a,b,c are known and fixed.
I'm looking for the optimal values for x1,x2,x3 such that their ranges are within [-r,r] for some positive r and the sum sum(y1,y2,y3) is maximized.
Is there a package for R which can handle such optimization problems?

You can use the optim in R function for this purpose.
If you are trying to maximize sum(y1,y2,y3), this actually simplifies the problem to maximize (ax1 + bx2 + 3*cx3) such that x1,x2,x3 ∈ [-r,r]
You can use below code to find the optimal values. Note that the optim function minimizes by default, so I am returning the negative value of the sum in the function.
max_sum <- function(x){
a <- 2; b<- -3; c<-2;
y <- a*x[1]+b*x[2]+3*c*x[3]
return( -1*y ) }
r <- 5
optim(par=c(0,0,0), max_sum,lower= (-1*r),upper = r)
$par
[1] 5 -5 5

Related

Evaluate the Binomial polynomial expression in R

I need to calculate the binomial polynomial expression in r. I can calculate the polynomial expression using polynomial() function in r. But on top of evaluating the expression in polynomial, I want the expression must hold the binomial expression as well.
For example: in binomial,
we know
1+1 = 0, which is also 1 XOR 1 = 0,
Now, if we do the same in polynomial expressions, it can be done in the following way:
(1+x) + x = 1
Here we suppose,
x + x is similar to 1 + 1 which is equal to zero. Or in other words x XOR x = 0.
Before, I have added the whole of the code in R, maybe there were few people who did not understand the question, so they might thought it is better to close the question.
I need to know how to implement the XOR operation in binomial polynomial expression in R.
Need to apply in following manner:
let f(x) = (1 + x + x^3) and g(x) = (x + x^3),
Therefore for the sum of f(x) and g(x), I need to do the following:
f(x) + g(x) = (1 + x + x^3) + (x + x^3)
= 1 + (1 + 1)x + (1 + 1)x^3 (using addition modulo 2 in Z2)
= 1 + (0)x + (0)x^3
= 1.
I hope, this time I more clear of what exactly I want and my question is more understandable.
Thanks in Advance
XOR <- function(x,y) (x+y) %% 2
would give you an XOR function fitting your definition.
Adding a solution to my own question.
Basically we need to first calculate the polynomial. Simply how we do. That is a first step. For example for adding f(x) and g(x), create a function like below
bPolynomial<-function(f, g){
K <- polynomial()
K <- (1 + x + x^3) + (x + x^3) # where f is (1 + x + x^3), and g is (x + x^3)
}
Then second is, extract the coefficients from the above polynomial and reduce them to modulo 2, using below code:
coeff <- coefficients(C_D) %% 2
print(coeff)
C_D <- polynomial(c(coeff))
That is it. You will get the desired result. I do feel stupid for getting stuck on something which is very basic. But implementation with mathematics computation sometimes make people confuse, same happened with me..!!
Hope it will be helpful to other people. Thanks.

Syntax for "is distributed as" in R

When specifying a model in JAGS/BUGS, the "is distributed as" symbol ~ is very useful. How to do this in R when using MCMC methods which require me to specify the likelihood?
Let's say, I want to estimate three parameters which are multivariate normally distributed.
In JAGS, I would do this by specifying pars[1:n] ~ dmnorm(mu[1:3], sigma[1:3, 1:3]). If everything is specified correctly, JAGS would go on to estimate these parameters under the given distribution.
In R, there are similar functions, like the dmvnorm() function, from the mvtnorm package. However, I'm not sure how to use these. I have to provide the data to get the probability density, whereas in JAGS, I only have to provide the parameters of the distribution like mu and sigma. What is the R equivalent to the ~ syntax in JAGS?
Here's some random data:
set.seed(123)
y = rbinom(10, 1, 0.2)
y
> y
[1] 0 0 0 1 1 0 0 1 0 0
So we know that the value of p that generated this data is 0.2. Let's see how we could try and recover that information (assuming we didn't know it). In JAGS I would write the following model:
model{
for(i in 1:10){
y[i] ~ dbern(p)
}
p ~ dunif(0, 1)
}
So I have said that the data is generated using (or sampled from) a Bernoulli distribution with parameter p, and that the prior for p is a Beta(1,1) which is equivalent to a uniform distribution.
So let's (initially) forget the Bayesian part. You have asked how to compute the likelihood. The likelihood for a parameter theta given independent and identically distributed data y = (y_1, ..., y_N) is
L(theta | y) = product(f(y_i | theta), i = 1,...,N)
In our example, the pdf f(y_i | theta) is p^y_i * (1 - p)^(1 - y_i). I know this just simplifies to p if y_i is 1, or (1 - p) if y_i is zero, but let's assume we don't know this and we are just using the Binomial probability function with parameters n = 1, and p to compute this, then you could get the likelihood like this:
Like = function(p){
prod(dbinom(y, 1, p))
}
This is a pretty simple function that only works for single values of p, but it works, e.g.
> Like(0.1)
[1] 0.0004782969
> Like(0.2)
[1] 0.001677722
> Like(0.3)
[1] 0.002223566
>
We can make it work for a whole range of values of p by using sapply
Like = function(p){
sapply(p, function(p.i)prod(dbinom(y, 1, p.i)))
}
So now, for example I could calculate the likelihood of values of p ranging from 0.01 to 0.99 in steps of 0.01 by
p = seq(0.01, 0.99, by = 0.01)
l = Like(p)
And I could plot them
plot(p, l, type = "l")
You can see from the plot that the likelihood is maximized at 0.3, so this is the MLE of p based on this data.
Going back to the Bayesian problem, here's an implementation of Metropolis-Hastings (uncommented sorry):
MH = function(N = 1000, p0 = runif(1)){
log.like = function(p){
sum(dbinom(y, size = 1, p, log = TRUE))
}
ll0 = log.like(p0)
r = c(p0, rep(0, N))
for(i in 1:N){
p1 = runif(1)
ll1 = log.like(p1)
if(ll1 > ll0 || log(runif(1)) < ll1 - ll0){
p0 = p1
ll0 = ll1
}
r[i + 1] = p0
}
return(r)
}
Now we take a sample of size 10,000 from this, with
set.seed(123)
p = MH(10000)
plot(density(p))
abline(v = c(mean(p), mean(p) + c(-1,1)*qnorm(0.975)*sd(p)))
and plot the KDE of the sample (plus some credible intervals)
And see that the Metropolis-Hastings has worked -- the intervals are wide because the sample size is small.

How can I code this equation with double summation in R?

So I'm having hard time coding the above equation, mainly the part which contains that double sum over i's and over j.
I'n my case, my n = 200 and p = 15. My yi:s are in a vector Y = (y1,y2,...yn) that is vector of length 200 and Xij:s are in a matrix which has 15 columns and 200 rows. Bj:s are in a vector of length 15.
My own solution, which I'm fairly certain is wrong, is this:
b0 <- 1/200 * sum(Y - sum(matr*b))
And here is code which you can use to reproduce my vectors and matrix:
matr <- t(mvrnorm(15,mu= rep(0,200),diag(1,nrow = 200)))
Y <- rnorm(n = 200)
b <- rnorm(n = 15)
Use matrix multiplication:
mean(y - x %*% b)
Note that if y and x are known and b is the least squares regression estimate of the coefficients then we can write it as:
fm <- lm(y ~ x + 0)
mean(resid(fm))
and that necessarily equals 0 if there is an intercept, i.e. a constant column in x, since the residual vector must be orthogonal to the range of x and taking the mean is the same as taking the inner product of the residuals and a vector whose elements are all the same (and equal to 1/n).

GRG Non-Linear Least Squares (Optimization)

I am trying to convert an Excel spreadsheet that involves the solver function, using GRG Non-Linear to optimize 2 variables that return the lowest sum of squared errors. I have 4 known times (B) at 4 known distances(A). I need to create an optimization function to find what interaction of values for Vmax and Tau produce the lowest sum of squared errors. I have looked at the nls function and nloptr package but can't quite seem to piece them together. Current values for Vmax and Tau are what was determined via the excel solver function, just need to replicate in R. Any and all help would be greatly appreciated. Thank you.
A <- c(0,10, 20, 40)
B <- c(0,1.51, 2.51, 4.32)
Measured <- as.data.frame(cbind(A, B))
Corrected <- Measured
Corrected$B <- Corrected$B + .2
colnames(Corrected) <- c("Distance (yds)", "Time (s)")
Corrected$`X (m)` <- Corrected$`Distance (yds)`*.9144
Vmax = 10.460615006988
Tau = 1.03682513806393
Predicted_X <- c(Vmax * (Corrected$`Time (s)`[1] - Tau + Tau*exp(-Corrected$`Time (s)`[1]/Tau)),
Vmax * (Corrected$`Time (s)`[2] - Tau + Tau*exp(-Corrected$`Time (s)`[2]/Tau)),
Vmax * (Corrected$`Time (s)`[3] - Tau + Tau*exp(-Corrected$`Time (s)`[3]/Tau)),
Vmax * (Corrected$`Time (s)`[4] - Tau + Tau*exp(-Corrected$`Time (s)`[4]/Tau)))
Corrected$`Predicted X (m)` <- Predicted_X
Corrected$`Squared Error` <- (Corrected$`X (m)`-Corrected$`Predicted X (m)`)^2
#Sum_Squared_Error <- sum(Corrected$`Squared Error`)
is your issue still unsolved?
I'm working on a similar problem and I think I could help.
First you have to define a function that will be the sum of the errors, which has for variables Vmax and Tau.
Then you can call an optimisation algorithm that will change these variables and look for a minimum of your function. optim() might be sufficient for your application, but here is the documentation for nloptr:
https://www.rdocumentation.org/packages/nloptr/versions/1.0.4/topics/nloptr
and here is a list of optimisation packages in R:
https://cran.r-project.org/web/views/Optimization.html
Edit:
I quickly recoded the way I would do it. I'm a beginner, so it's probably not the best way but it still works.
A <- c(0,10, 20, 40)
B <- c(0,1.51, 2.51, 4.32)
Measured <- as.data.frame(cbind(A, B))
Corrected <- Measured
Corrected$B <- Corrected$B + .2
colnames(Corrected) <- c("Distance (yds)", "Time (s)")
Corrected$`X (m)` <- Corrected$`Distance (yds)`*.9144
#initialize values
Vmax0 = 15
Tau0 = 5
x0 = c(Vmax0,Tau0)
#define function to optimise: optim will minimize the output
f <- function(x) {
y=0
#variables will be optimise to find the minimum value of f
Vmax = x[1]
Tau = x[2]
Predicted_X <- Vmax * (Corrected$`Time (s)` - Tau + Tau*exp(-Corrected$`Time (s)`/Tau))
y = sum((Predicted_X - Corrected$`X (m)`)^2)
return(y)
}
#call optim: results will be available in variable Y
Y<-optim(x0,f)
If you type Y into the console, you will find that the solver finds the same values as Excel, and convergence is achieved.
In R, there is no need to define columns in data frames with brackets as you did, instead use vectors. You should probably follow a tutorial about this first.
Also it is misleading that you set inital values as values that were already the optimal ones. If you do this then optim() will not optimise further.
Here is the documentation for optim:
https://stat.ethz.ch/R-manual/R-devel/library/stats/html/optim.html
and a tutorial on how to use functions:
https://www.datacamp.com/community/tutorials/functions-in-r-a-tutorial
Cheers

How to do ma and loess normalization in R?

Attempting to do loess on two variables x and y in R using MA normalization (http://en.wikipedia.org/wiki/MA_plot) like this:
> x = rnorm(100) + 5
> y = x + 0.6 + rnorm(100)*0.8
> m = log2(x/y)
> a = 0.5*log(x*y)
I want to normalize x and y in such a way that the average m is 0, as in standard MA normalization, and then back-calculate the correct x and y values. First running loess on MA:
> l = loess(m ~ a)
What is the way to get corrected m values then? Is this correct?
> mc <- predict(l, a)
# original MA plot
> plot(a,m)
# corrected MA plot
> plot(a,m-mc)
not clear to me what predict actually does in the case of loess objects and how it's different from using l$residuals in the object l returned by loess - can someone explain?
finally, how can I back calculate new x and y values based on this correction?
First, yes, your proposed method gets the corrected m values.
Regarding the predict function: yes, l$residuals , m - fitted(l) , and m -
predict(l) all give the same result: the corrected m values. However, the predict function is more general: it will take any new values as input. This is useful if you want to use only a subset of the data to fit the loess, and then predict on the totality of the data (for example, when using spiked-in standards).
Finally, how can you back calculate new x and y values based on this correction? If you transform your data into log-space, by creating two new variables x1 <- log2(x) and y1 <- log2(y), it becomes easier to see. Since we're in log-space, calculating m and a is simpler:
m <- x1 - y1
a <- (x1 + y1)/2
Now, for correcting your data based on the fitted loess model, instead of updating the m variable by your mc correction, you can update x1 and y1 instead. Set:
x1 <- x1 - mc / 2
y1 <- y1 + mc / 2
This update has the same effect as updating m <- m - mc (because m will be recomputed as the difference between the updated x1 and y1) and has no effect on the a value.
To get your corrected data out, transform them by returning 2^x1 and 2^y1.
This is the method as used by the authors of the normalize.loess function in affy package, as originally described here (and includes the capability to cyclically look at all pairs of variables as opposed to a single pair in this case): http://web.mit.edu/~r/current/arch/i386_linux26/lib/R/library/limma/html/normalizeCyclicLoess.html

Resources