What is the general procedure in solving systems of equations using R (as opposed to manual Gauss-Jordan/Gaussian elimination)?
Must I first determine if the system is determined/under/overdetermined?
If a system is determined, I just use
solve(t(a)%*%a)%*%t(a)%*%b
to get $x$ in $Ax = b$
If it overdetermined or underdetermined, I am not quite sure what to do. I think the above sometimes gives an answer depending on the rank, but the solution is not always unique. How can I get all the solutions? I think if there's no solution, will R just give an error?
Context: I am planning to recommend to my Stochastic Calculus professor that we use R in our upcoming exam (as opposed to tedious calculators/by-hand computation) so I have a feeling only simple functions will do (e.g. solve) for over/underdetermined systems rather than lengthy programs/functions.
Edit: I tried using solve(a,b), but I think that still doesn't give me all the solutions.
Here is an underdetermined example (R cannot give an answer since a is not square):
a=matrix(c(1,1,1,3,2,1),byrow=T,nrow=2)
a
b=matrix(c(1,2),byrow=T,nrow=2)
b
solve(a,b)
The link I gave in section Matrix solution in the Wikipedia article on linear systems shows how to get what you want.
Define matrix A and vector b like this
A <- matrix(c(1,1,1,3,2,1),byrow=T,nrow=2)
A
b <- matrix(c(1,2),byrow=T,nrow=2)
b
The following code will give you the general solution to your underdetermined system
library(MASS)
Ag <- ginv(A)
Ag
xb <- Ag %*% b
xb
Aw <- diag(nrow=nrow(Ag)) - Ag %*% A
Aw
You can check that this is correct with
w <- runif(3)
z <- xb + Aw %*% w
A %*% z - b
where the vector w is any arbitrary vector.
You can simplify the solution further manually to what you gave; I leave that as an exercise for you. As far as I know you can't get that solution automatically but maybe package Ryacas can do it.
You can get what you want by using package MASS or package pracma.
E.g. with MASS:
library(MASS)
N <- Null(t(A))
Then the solution is
xb + N * q
where q is an arbitrary scalar.
With pracma:
N <- null(A) # or nullspace(A)
with the same expression as above for the solution.
Try qr.solve(A,b). That should work for both under- and over-determined systems.
Related
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.
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.
I have a question about converting a matlab function into R, and I was hoping that someone could help.
The standard QR decomposition used in both matlab and R is referred to as qr(). To my understanding, the standard way of performing a qr decomposition in both languages is:
Matlab:
[Q,R] = qr(A) satisfying QR=A
R:
z <- qr(A)
Q <- qr.Q(z)
R <- qr.R(z)
Both of which provide me with the same results, unfortunately, this is not what I need. What I need is this:
Matlab:
[Q,R,e] = qr(A,0) which produces an economy-size decomposition in which e is a permutation vector so that A(:,e) = Q*R.
R:
No clue
I have tried comparing [Q,R,E] = qr(A) with
z <- qr(A);
Q <- qr.Q(z);
R <- qr.R(z);
E <- diag(ncol(A))[z$pivot]
and results seem identical for variables Q and E (but different for R). So depending on the defined inputs/outputs there will be different results (which makes sense).
So my question is:
Is there a way in R that can mimic this [Q,R,e]=qr(A,0) in Matlab?
I have tried digging into the matlab function but it leads to a long and torturous road of endless function definitions and I was hoping for a better solution.
Any help would be much appreciated, and if I've missed something obvious, I apologize.
I think the difference comes down to the numerical library underlying the calculations. By default, R's qr function uses the (very old) LINPACK routines, but if I do
z <- qr(X,LAPACK=T)
then R uses LAPACK and the results seem to match MATLAB's (which is probably also using LAPACK underneath). Either way we see the expected relationship with X:
z <- qr(X,LAPACK=F)
all.equal(X[,z$pivot], qr.Q(z)%*%qr.R(z), check.attributes=FALSE)
# [1] TRUE
z <- qr(X,LAPACK=T)
all.equal(X[,z$pivot], qr.Q(z)%*%qr.R(z), check.attributes=FALSE)
# [1] TRUE
I want to analyse a logarithmic growth curve in more detail. Especially I would like to kow the time point when the slope becomes >0 (which is the starting point of growth after a lag phase).
Therefore I fitted a logarithmic function to my growth data with the grofit package of R. I got values for the three parameters (lambda, mu, maximal assymptote).
Now I thought, I could use the first derivative of the logarithmic growth function to put mu=0 (the slope of any time point during growth) and this way solve the equation for the time (x). I'm not sure if this is possible, since the mu=0 will be correct for a longer timespan at the beginning of the curve (and no unique timepoint). But maybe I could approximate to that point by putting mu=0.01. This should be more specific.
Anyway I used the Deriv package to find the first derivative of my logarithmic function:
Deriv(a/(1+exp(((4*b)/a)*(c-x)+2)), "x")
where a=assymptote, b=maximal slope, c=lambda.
As a result I got:
{.e2 <- exp(2 + 4 * (b * (c - x)/a))
4 * (.e2 * b/(.e2 + 1)^2)}
Or in normal writing:
f'(x)=(4*exp(2+((4b(c-x))/a))*b)/((exp(2+((4b(c-x))/a))+1)^2)
Now I would like to solve this function for x with f'(x)=0.01. Can anyone tell me, how best to do it?
Also, do you have comments on my way of thinking or the R functions I used?
Thank you.
Anne
Using a root solving function is more appropriate than using an optimization function.
I'll give an example with two packages.
It would also be a good idea to plot the function for a range of values.
Like this:
curve(fn,-.1,.1)
You can see that using the base R function uniroot will present problems since it needs function values at the endpoints of the interval to be of opposite sign.
Using package nleqslv like this
library(nleqslv)
nleqslv(1,fn)
gives
$x
[1] 0.003388598
$fvec
[1] 8.293101e-10
$termcd
[1] 1
$message
[1] "Function criterion near zero"
<more info> ......
Using function fsolve from package pracma
library(pracma)
fsolve(fn,1)
gives
$x
[1] 0.003388585
$fval
[1] 3.136539e-10
The solutions given by both packages are very close to each other.
Might not be the best approach but you can use the optim function to find the solution. Check the code below, I am basically trying to find the value of x which minimizes abs(f(x) - 0.01)
There starting seed value for x may be important, the optim function might not converge for some seeds.
fn <- function(x){
a <- 1
b<- 1
c <- 1
return( abs((4*exp(2+((4*b*(c-x))/a))*b)/ ((exp(2+((4*b*(c-x))/a))+1)^2) - 0.01) )
}
x <- optim(10,fn)
x$par
Thank you very much for your efforts. Unfortunately, none of the above solutions worked for me :-(
I figured the problem out the old fashioned way (pencil + paper + mathematics book).
Have a good day
Anne
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.