How to solve multivariable nonlinear equotation systems? [R] - r

I have three equotations with 3 unknown variables like this:
Assume that the following variables are given as parameters:
Desired, not given:
What I want is that when I pass three parameters it should give me the solution of the remaining ones. What's the simpliest way to do this in R?
Because I'm a beginner I would like to have some (short) explanations. :)

Solving for sigma.eps^2 is a matter of mathematics. In the second equation you can substitute a (take the expression from the third equation). Then you can solve for sigma.eps^2. After that you can calculate a and then b:
sigma.eps2 <- (1-p^2)*sigma2^2 # sigma.eps2 stands for sigma.eps^2
sigma.eps <- sqrt(sigma.eps2)
a <- (sigma.eps / sigma1) * p / sqrt(1-p^2)
b <- mu2 - a*mu1
Eventually the second value for sigma.eps is relevant. In this case the second value is:
sigma.eps <- -sqrt(sigma.eps2)
This would also implicate other values for a and b (to compute in the same way as above).

Related

How can I “translate” a statistical model defined on paper to the computer using R?

I have initially posted this question on stats.stackexchange.com,
but it was closed due to being focused on programming. Hopefully, I
can get any help here.
I will not put many theoretical details here to make it simple, but my final goal is to implement a Hidden Markov Model using R.
Although I am fine with the theoretical model construction, when I tried to implement it, I realized that I do not know basic things about computational statistics. My question goes into this direction.
Let and be random variables such that and , with and . If denotes distribution, how can I compute
using R?
I mean, what is the exact meaning of these distributions (one discrete and one continuous) multiplication? How can I do this using R? The answer is obviously a function of , but how is it represented in my code?
Is there any change if is also discrete? For instance, , with . How it would affect the implemented code?
I know my questions are not very specific, but I am very lost on how to start. My goal with this question is understanding how I can "translate" what I have written in paper to the computer.
Translation
The equations describe how to compute the probability distribution of X given an observation of Y=y and values for parameters p and sigma. Ultimately, you want to implement a function p_X_given_Y that takes a value of Y and returns a probability distribution for X. A good place to start is to implement the two functions used in the RHS of the expression. Something like,
p_X <- function (x, p=0.5) { switch(as.character(x), "0"=p, "1"=1-p, 0) }
p_Y_given_X <- function (y, x, sigma=1) { dnorm(y, x, sd=sigma) }
Note that p and sigma are picked arbitrarily here. These functions can then be used to define the p_X_given_Y function:
p_X_given_Y <- function (y) {
# numerators: for each x \in X
ps <- sapply(c("0"=0,"1"=1),
function (x) { p_X(x) * p_Y_given_X(y, x) })
# divide out denominator
ps / sum(ps)
}
which can be used like:
> p_X_given_Y(y=0)
# 0 1
# 0.6224593 0.3775407
> p_X_given_Y(y=0.5)
# 0 1
# 0.5 0.5
> p_X_given_Y(y=2)
# 0 1
# 0.1824255 0.8175745
These numbers should make intuitive sense (given p=0.5): Y=0 is more likely to come from X=0, Y=0.5 is equally likely to be X=0 or X=1, etc.. This is only one way of implementing it, where the idea is to return the "distribution of X", which in this case is simply a named numeric vector, where the names ("0", "1") correspond to the support of X, and the values correspond to the probability masses.
Some alternative implementations might be:
a p_X_given_Y(x,y) that also takes a value for x and returns the corresponding probability mass
a p_X_given_Y(y) that returns another function that takes an x argument and returns the corresponding probability mass (i.e., the probability mass function)

How to select n objects from a set of N objects, maximizing the sum of pairwise distances between them

You have a set of N=400 objects, each having its own coordinates in a, say, 19-dimensional space.
You calculate the (Euclidean) distance matrix (all pairwise distances).
Now you want to select n=50 objects, such that the sum of all pairwise distances between the selected objects is maximal.
I devised a way to solve this by linear programming (code below, for a smaller example), but it seems inefficient to me, because I am using N*(N-1)/2 binary variables, corresponding to all the non-redundant elements of the distance matrix, and then a lot of constraints to ensure self-consistency of the solution vector.
I suspect there must be a simpler approach, where only N variables are used, but I can't immediately think of one.
This post briefly mentions some 'Bron–Kerbosch' algorithm, which apparently addresses the distance sum part.
But in that example the sum of distances is a specific number, so I don't see a direct application to my case.
I had a brief look at quadratic programming, but again I could not see the immediate parallel with my case, although the 'b %*% bT' matrix, where b is the (column) binary solution vector, could in theory be used to multiply the distance matrix, etc.; but I'm really not familiar with this technique.
Could anyone please advise (/point me to other posts explaining) if and how this kind of problem can be solved by linear programming using only N binary variables?
Or provide any other advice on how to tackle the problem more efficiently?
Thanks!
PS: here's the code I referred to above.
require(Matrix)
#distmat defined manually for this example as a sparseMatrix
distmat <- sparseMatrix(i=c(rep(1,4),rep(2,3),rep(3,2),rep(4,1)),j=c(2:5,3:5,4:5,5:5),x=c(0.3,0.2,0.9,0.5,0.1,0.8,0.75,0.6,0.6,0.15))
N = 5
n = 3
distmat_summary <- summary(distmat)
distmat_summary["ID"] <- 1:NROW(distmat_summary)
i.mat <- xtabs(~i+ID,distmat_summary,sparse=T)
j.mat <- xtabs(~j+ID,distmat_summary,sparse=T)
ij.mat <- rbind(i.mat,"5"=rep(0,10))+rbind("1"=rep(0,10),j.mat)
ij.mat.rowSums <- rowSums(ij.mat)
ij.diag.mat <- .sparseDiagonal(n=length(ij.mat.rowSums),-ij.mat.rowSums)
colnames(ij.diag.mat) <- dimnames(ij.mat)[[1]]
mat <- rbind(cbind(ij.mat,ij.diag.mat),cbind(ij.mat,ij.diag.mat),c(rep(0,NCOL(ij.mat)),rep(1,NROW(ij.mat)) ))
dir <- c(rep("<=",NROW(ij.mat)),rep(">=",NROW(ij.mat)),"==")
rhs <- c(rep(0,NROW(ij.mat)),1-unname(ij.mat.rowSums),n)
obj <- xtabs(x~ID,distmat_summary)
obj <- c(obj,setNames(rep(0, NROW(ij.mat)), dimnames(ij.mat)[[1]]))
if (length(find.package(package="Rsymphony",quiet=TRUE))==0) install.packages("Rsymphony")
require(Rsymphony)
LP.sol <- Rsymphony_solve_LP(obj,mat,dir,rhs,types="B",max=TRUE)
items.sol <- (names(obj)[(1+NCOL(ij.mat)):(NCOL(ij.mat)+NROW(ij.mat))])[as.logical(LP.sol$solution[(1+NCOL(ij.mat)):(NCOL(ij.mat)+NROW(ij.mat))])]
items.sol
ID.sol <- names(obj)[1:NCOL(ij.mat)][as.logical(LP.sol$solution[1:NCOL(ij.mat)])]
as.data.frame(distmat_summary[distmat_summary$ID %in% ID.sol,])
This problem is called the p-dispersion-sum problem. It can be formulated using N binary variables, but using quadratic terms. As far as I know, it is not possible to formulate it with only N binary variables in a linear program.
This paper by Pisinger gives the quadratic formulation and discusses bounds and a branch-and-bound algorithm.
Hope this helps.

Solving system of ODEs in vector/matrix form in R (with deSolve?)

So I want to ask whether there's any way to define and solve a system of differential equations in R using matrix notation.
I know usually you do something like
lotka-volterra <- function(t,a,b,c,d,x,y){
dx <- ax + bxy
dy <- dxy - cy
return(list(c(dx,dy)))
}
But I want to do
lotka-volterra <- function(t,M,v,x){
dx <- x * M%*% x + v * x
return(list(dx))
}
where x is a vector of length 2, M is a 2*2 matrix and v is a vector of length 2. I.e. I want to define the system of differential equations using matrix/vector notation.
This is important because my system is significantly more complex, and I don't want to define 11 different differential equations with 100+ parameters rather than 1 differential equation with 1 matrix of interaction parameters and 1 vector of growth parameters.
I can define the function as above, but when it comes to using ode function from deSolve, there is an expectation of parms which should be passed as a named vector of parameters, which of course does not accept non-scalar values.
Is this at all possible in R with deSolve, or another package? If not I'll look into perhaps using MATLAB or Python, though I don't know how it's done in either of those languages either at present.
Many thanks,
H
With my low reputation (points), I apologize for posting this as an answer which supposedly should be just a comment. Going back, have you tried this link? In addition, in an attempt to find an alternative solution to your problem, have you tried MANOPT, a toolbox of MATLAB? It's actually open source just like R. I encountered MANOPT on a paper whose problem boils down to solving a system of ODEs involving purely matrices.

Finding x-value at intersection between a linear and nonlinear equation in R

I have two functions: one for a line (y) and another for a curve (hnc). I would like to determine the one x-value at which the two functions intersect
sigma = 0.075
mu = 0
r=0.226
theta=0.908
H=0.16
hnc <- function(x) (1/(sigma*sqrt(2*pi)))*(exp(-(x^2)/(2*(sigma^2))))
y <- function(x) 2*pi*x+(pi*r^2/((360/theta)/H))
curve(hnc,0,r,n=100,col="blue")
plot(y,0,r,add=T,col="red")
I have tried using the nleqslv package, but this results in two separate x-values that do not agree (perhaps because I am using it incorrectly)
int <- function(x){
z <- numeric(2)
z[1] <- (1/(sigma*sqrt(2*pi)))*(exp(-(x[1]^2)/(2*(sigma^2))))
z[2] <- 2*pi*x[2]+(pi*r^2/((360/theta)/H))
z}
nleqslv(c(0.14,0.14),int,method="Broyden")
Any help would be much appreciated!
Thanks,
Eric
Using optimize here to find the minimum of a function if a single variable seems to work well
xx <- optimize(function(x) abs(hnc(x)-y(x)), c(.10,.20))$minimum
abline(v=xx, lty=2)
You are not using nleqslv in the correct way. It is meant for solving a system of non linear equations with as many variables as there are equations.
You have two functions and you want to determine the intersection which in your case consists of a single value for x.
You need to define a new function like this
g <- function(x) hnc(x) - y(x)
Then you can use uniroot to find a zero of g(x) like this:
uniroot(g,c(0,1))
The root found will be 0.1417802 which corresponds with the graph in the first answer.
Minimizing won't always work to find a point of intersection; if there is no point of intersection you will get misleading results.

Find the coefficients of a polynomial given its roots (zeros) in Prolog

How I can implement in Prolog program that find coefficients of the polynomial if I know its roots.
for example:
input data (2;-1)
output (1;-1;2)
Multiplying together the first-degree factors for given roots will form an expanded polynomial. This is a natural fit with an "accumulator" design pattern in Prolog.
That is, we'll introduce an auxiliary argument to remember the product of factors "so far" dealt with. Once the list of specified roots has been emptied, then we will have the desired polynomial expansion:
/* polynomialFromListofRoots(ListofRoots,[1],Polynomial) */
polynomialFromListofRoots([ ],Poly,Poly).
polynomialFromListofRoots([R|Roots],Pnow,Poly) :-
polyMultiplyRootFactor(R,Pnow,Pnew),
polynomialFromListofRoots(Roots,Pnew,Poly).
/* polyMultiplyRootFactor(R,Poly,ProductXminusR) */
polyMultiplyRootFactor(R,Poly,Prod) :-
polyMultiplyRootFactorAux(R,0,Poly,Prod).
/* polyMultiplyRootFactorAux(R,Aux,Poly,Product) */
polyMultiplyRootFactorAux(R,A,[ ],[B]) :-
B is -R*A.
polyMultiplyRootFactorAux(R,A,[P|Ps],[RP|RPs]) :-
RP is P - R*A,
polyMultiplyRootFactorAux(R,P,Ps,RPs).
Using the example in the Question:
?- polynomialFromListofRoots([2,-1],[1],Poly).
Poly = [1, -1, -2]
yes
Note that this corrects the output claimed in the Question.
Sorry misread question.
a^2x + bx +c = 0
Take the sum of the roots x1 + x2 this is equal to -b/a.
Take the product of the roots x1*x2 this is equal to c/a.
Now solve the resulting system of linear equations to find a b and c.
Edit:
The above solution works if you set the parameter of a = 1. You see when your given the roots you'll end up with two equations and three unknowns so you'll have to set a fixed value on one of the parameters and the above solutions fixes a = 1.
So given 2 roots you can't get back a specific polynomial because theres no unique answer theres an infinte number of answers

Resources