Computing the pseudo inverse of a matrix in R - r

I am trying to compute the pseudo inverse of a matrix, call it M, which might look the following way:
M=matrix(c(-1,-1,1,0,0,1),nrow=2,ncol=3)
What I need is the left inverse of this matrix, such that:
M_inv_l M=I
Using the MASS package, I am able to find the right inverse:
M_inv_r=ginv(M)
Where M M_inv_r=I.
Is there a way to compute the left inverse instead of the right inverse? I haven't been able to find an answer on the forum.
Thanks

A matrix of full row rank has a left inverse:
> M %*% ginv(M)
[,1] [,2]
[1,] 1.000000e+00 -2.220446e-16
[2,] 1.110223e-16 1.000000e+00
A matrix of full column rank has a right inverse:
> ginv(t(M)) %*% t(M)
[,1] [,2]
[1,] 1.000000e+00 0
[2,] -5.551115e-17 1
See the Wikipedia article on generalized inverses.

I don't think that this is possible in general - you're trying to solve 9 linear equations with only 6 values. Specifically, look at the top row of your inverse:
-1* Minv[1,1] + -1*Minv[1,2] = 1 [1]
1* Minv[1,1] + 0*Minv[1,2] = 0 => Minv[1,1]=0 [2]
0* Minv[1,1] + 1*Minv[1,2] = 0 => Minv[1,2]=0 [3]
It should be clear that substituting [2] and [3] into [1] produces a contradiction.

Related

Is there a way to generate a matrix in R with at least some negative eigenvalues?

I want to generate a matrix with at least some negative eigenvalues? I am attempting to use the spectral decomposition of a matrix to do so but it does not guarantee at least one negative eigenvalue
Here is a simple example that may help you construct such kind of matrix
library(pracma)
N <- 3
U <- randortho(N, type = "orthonormal")
A <- diag(sample(c(-runif(1),rnorm(N-1)))) # ensure at least one negative eigenvalue
M <- U %*% A %*% t(U)
then
> M
[,1] [,2] [,3]
[1,] -0.36818879 0.02406988 0.1634275
[2,] 0.02406988 -0.72613068 -0.1872272
[3,] 0.16342748 -0.18722722 -0.3116400
To double check the eigenvalues
> eig(M)
[1] -0.1432527 -0.4484647 -0.8142421
and
> A
[,1] [,2] [,3]
[1,] -0.1432527 0.0000000 0.0000000
[2,] 0.0000000 -0.4484647 0.0000000
[3,] 0.0000000 0.0000000 -0.8142421
What if you generate a random positive definite matrix and multiply it by -1 ... ?
In this example I'll create a lower-triangular matrix with positive diagonal and multiply it by its transpose (there are lots of other ways):
set.seed(101)
m <- matrix(0,5,5)
m[lower.tri(m,diag=TRUE)] <- rnorm(15)
diag(m) <- abs(diag(m))
m2 <- m %*% t(m)
(If you only want it semidefinite you just need to make sure the diagonal is non-negative ...)
Is it pos def?
v1 <- eigen(m2)$values
## [1] 5.976142640 1.908831945 0.904991040 0.037025982 0.002181558
all(v1>0) ## TRUE
Check that evals(-m2) == -evals(m2) ...
v2 <- eigen(-m2)$values
all(v2<0) ## TRUE
all.equal(sort(v1),-v2) ## TRUE

Finding all solutions of a non-square linear system with infinitely many solutions

In this question was found a solution to find a particular solution to a non-square linear system that has infinitely many solutions. This leads to another question:
How to find all the solutions for a non-square linear system with infinitely many solutions, with R? (see below for a possible description of the infinite set of solutions)
Example: the linear system
x+y+z=1
x-y-2z=2
is equivalent to A X = B with:
A=matrix(c(1,1,1,1,-1,-2),2,3,T)
B=matrix(c(1,2),2,1,T)
A
[,1] [,2] [,3]
[1,] 1 1 1
[2,] 1 -1 -2
B
[,1]
[1,] 1
[2,] 2
We can describe the infinite set of solutions with:
x = 3/2 + (1/2) z
y = -1/2 + (-3/2) z
z in R
Thus, R could describe the set of solutions this way:
> solve2(A,B)
$principal
[1] 1 2 # this means that x and y will be described
$free
[1] 3 # this means that the 3rd variable (i.e. z) is free in the set of real numbers
$P
[1] 1.5 -0.5
$Q
[1] 0.5 -1.5
This means that every solution can be created with:
z = 236782 # any value would be ok
solve2(A,B)$P + z * solve2(A,B)$Q # this gives x and y
About the maths: there always exist such a decomposition, when the linear system has infinitely many solutions, this part is ok. The question is: is there something to do this in R?
You can solve equations like thse using the generalized inverse of A.
library(MASS)
ginv(A) %*% B
# 1.2857143
# 0.1428571
#-0.4285714
A %*% ginv(A) %*% B
# 1
# 2
So, with help from #Bhas
gen_soln <- function(vec) {
G <- ginv(A)
W <- diag(3) - G %*% A
(G %*% B + W %*% vec)
}
You can now find many solutions by providing a vector of length 3 to `gen_soln' function. For example,
one_from_inf <- gen_soln(1:3)
one_from_inf
#[1,] 1.35714286
#[2,] -0.07142857
#[3,] -0.2857142
# Test the solution.
A %*% one_from_inf
# [,1]
#[1,] 1
#[2,] 2
# Using random number generator
A %*% gen_soln(rnorm(3))
# [,1]
#[1,] 1
#[2,] 2
The general solution to
A*x = b
is
x = x0 + z
where x0 is any solution and z is in the kernel of A
As pointed out above you can find a particular solution x0 by using the generalised inverse. You can also use the SVD to find a basis for the kernel of A:
A = U*S*V'
where U and V are orthogonal and S diagonal, with, say, the last k entries on the diagonal 0 (and the others non-zero).
If follows that the last k columns of V form a basis for the kernel of A, and if we call these z1,..zk then the solutions of the original equation
are
x = x0 + c1*z1 + .. ck*zk
for any real c1..ck

Euclidean distance between data sets in R using rdist from "fields" package

I am using rdist to compute Euclidean distances between a matrix and itself:
> m = matrix(c(1,1,1,2,2,2,3,4,3),nrow=3, ncol=3)
> m
[,1] [,2] [,3]
[1,] 1 2 3
[2,] 1 2 4
[3,] 1 2 3
library(fields)
> rdist(m)
[,1] [,2] [,3]
[1,] 1e-10 1e+00 1e-10
[2,] 1e+00 1e-10 1e+00
[3,] 1e-10 1e+00 1e-10
What confuses me is that I think it should have 0s on the diagonal (surely the distance of a vector to itself is 0?), and for the same reason it should have 0s where it compares the first and third row. The value that I see instead (1e-10) looks way to big to be numerical noise. What's going wrong?
EDIT: rdist is from the package fields.
First of all 1e-10 is simply 1*10^-10 which is 0.0000000001, so numericaly very close to 0 (as it is a result of square rooting, so the actual error in the computation is of row of magnitude 1e-20). Is it "too big"? Well, library is written in fortran, and is focused on speed, so it is quite acceptable. If you analyze the exact code, you will find out how it is computed:
# fields, Tools for spatial data
# Copyright 2004-2011, Institute for Mathematics Applied Geosciences
# University Corporation for Atmospheric Research
# Licensed under the GPL -- www.gpl.org/licenses/gpl.html
"rdist" <- function(x1, x2) {
if (!is.matrix(x1))
x1 <- as.matrix(x1)
if (missing(x2))
x2 <- x1
if (!is.matrix(x2))
x2 <- as.matrix(x2)
d <- ncol(x1)
n1 <- nrow(x1)
n2 <- nrow(x2)
par <- c(1/2, 0)
temp <- .Fortran("radbas", nd = as.integer(d), x1 = as.double(x1),
n1 = as.integer(n1), x2 = as.double(x2), n2 = as.integer(n2),
par = as.double(par), k = as.double(rep(0, n1 * n2)))$k
return(matrix(temp, ncol = n2, nrow = n1))
}
And the exact answer is hidden in the fortran files (in radfun.f called from radbas.f), where you can find the line
if( dtemp.lt.1e-20) dtemp =1e-20
which treats small (even 0) values as 1e-20, which after taking square root results in 1e-10. It seems that the motivation was to speed up the process by using logarithm of the value (as a result, square rooting is simply dividing by 2), which of course is not defined for 0.

How to obtain right eigenvectors of matrix in R?

Edition : the problem in my question was I've tried to find matrix S from equation 8 but this equation have error.
How to directly obtain right eigenvectors of matrix in R ? 'eigen()' gives only left eigenvectors
Really last edition, I've made big mess here, but this question is really important for me :
eigen() provides some matrix of eigenvectors, from function help :
" If ‘r <- eigen(A)’, and ‘V <- r$vectors; lam <- r$values’, then
A = V Lmbd V^(-1)
(up to numerical fuzz), where Lmbd =diag(lam)"
that is A V = V Lmbd, where V is matrix now we check it :
set.seed(1)
A<-matrix(rnorm(16),4,4)
Lmbd=diag(eigen(A)$values)
V=eigen(A)$vectors
A%*%V
> A%*%V
[,1] [,2] [,3] [,4]
[1,] 0.0479968+0.5065111i 0.0479968-0.5065111i 0.2000725+0i 0.30290103+0i
[2,] -0.2150354+1.1746298i -0.2150354-1.1746298i -0.4751152+0i -0.76691563+0i
[3,] -0.2536875-0.2877404i -0.2536875+0.2877404i 1.3564475+0i 0.27756026+0i
[4,] 0.9537141-0.0371259i 0.9537141+0.0371259i 0.3245555+0i -0.03050335+0i
> V%*%Lmbd
[,1] [,2] [,3] [,4]
[1,] 0.0479968+0.5065111i 0.0479968-0.5065111i 0.2000725+0i 0.30290103+0i
[2,] -0.2150354+1.1746298i -0.2150354-1.1746298i -0.4751152+0i -0.76691563+0i
[3,] -0.2536875-0.2877404i -0.2536875+0.2877404i 1.3564475+0i 0.27756026+0i
[4,] 0.9537141-0.0371259i 0.9537141+0.0371259i 0.3245555+0i -0.03050335+0i
and I would like to find matrix of right eigenvectors R,
equation which define matrix of left eigenvectors L is :
L A = LambdaM L
equation which define matrix of right eigenvectors R is :
A R = LambdaM R
and eigen() provides only matrix V:
A V = V Lmbd
I would like to obtain matrix R and LambdaM for real matrix A which may be negative-definite.
A worked example.
Default (= right eigenvectors):
m <- matrix(1:9,nrow=3)
e <- eigen(m)
e1 <- e$vectors
zapsmall((m %*% e1)/e1) ## right e'vec
## [,1] [,2] [,3]
## [1,] 16.11684 -1.116844 0
## [2,] 16.11684 -1.116844 0
## [3,] 16.11684 -1.116844 0
Left eigenvectors:
eL <- eigen(t(m))
eL1 <- eL$vectors
(We have to go to a little more effort since we need
to be multiplying by row vectors on the left; if
we extracted just a single eigenvector, R's ignorance
of row/column vector distinctions would make it
"do the right thing" (i.e. (eL1[,1] %*% m)/eL1[,1]
just works).)
zapsmall(t(eL1) %*% m/(t(eL1)))
## [,1] [,2] [,3]
## [1,] 16.116844 16.116844 16.116844
## [2,] -1.116844 -1.116844 -1.116844
## [3,] 0.000000 0.000000 0.000000
This should work
Given a matrix A.
lefteigen <- function(A){
return(t(eigen(t(A))$vectors))
}
Every left eigenvector is the transpose of a right eigenvector of the transpose of a matrix

Mystified by qr.Q(): what is an orthonormal matrix in "compact" form?

R has a qr() function, which performs QR decomposition using either LINPACK or LAPACK (in my experience, the latter is 5% faster). The main object returned is a matrix "qr" that contains in the upper triangular matrix R (i.e. R=qr[upper.tri(qr)]). So far so good. The lower triangular part of qr contains Q "in compact form". One can extract Q from the qr decomposition by using qr.Q(). I would like to find the inverse of qr.Q(). In other word, I do have Q and R, and would like to put them in a "qr" object. R is trivial but Q is not. The goal is to apply to it qr.solve(), which is much faster than solve() on large systems.
Introduction
R uses the LINPACK dqrdc routine, by default, or the LAPACK DGEQP3 routine, when specified, for computing the QR decomposition. Both routines compute the decomposition using Householder reflections. An m x n matrix A is decomposed into an m x n economy-size orthogonal matrix (Q) and an n x n upper triangular matrix (R) as A = QR, where Q can be computed by the product of t Householder reflection matrices, with t being the lesser of m-1 and n: Q = H1H2...Ht.
Each reflection matrix Hi can be represented by a length-(m-i+1) vector. For example, H1 requires a length-m vector for compact storage. All but one entry of this vector is placed in the first column of the lower triangle of the input matrix (the diagonal is used by the R factor). Therefore, each reflection needs one more scalar of storage, and this is provided by an auxiliary vector (called $qraux in the result from R's qr).
The compact representation used is different between the LINPACK and LAPACK routines.
The LINPACK Way
A Householder reflection is computed as Hi = I - viviT/pi, where I is the identity matrix, pi is the corresponding entry in $qraux, and vi is as follows:
vi[1..i-1] = 0,
vi[i] = pi
vi[i+1:m] = A[i+1..m, i] (i.e., a column of the lower triangle of A after calling qr)
LINPACK Example
Let's work through the example from the QR decomposition article at Wikipedia in R.
The matrix being decomposed is
> A <- matrix(c(12, 6, -4, -51, 167, 24, 4, -68, -41), nrow=3)
> A
[,1] [,2] [,3]
[1,] 12 -51 4
[2,] 6 167 -68
[3,] -4 24 -41
We do the decomposition, and the most relevant portions of the result is shown below:
> Aqr = qr(A)
> Aqr
$qr
[,1] [,2] [,3]
[1,] -14.0000000 -21.0000000 14
[2,] 0.4285714 -175.0000000 70
[3,] -0.2857143 0.1107692 -35
[snip...]
$qraux
[1] 1.857143 1.993846 35.000000
[snip...]
This decomposition was done (under the covers) by computing two Householder reflections and multiplying them by A to get R. We will now recreate the reflections from the information in $qr.
> p = Aqr$qraux # for convenience
> v1 <- matrix(c(p[1], Aqr$qr[2:3,1]))
> v1
[,1]
[1,] 1.8571429
[2,] 0.4285714
[3,] -0.2857143
> v2 <- matrix(c(0, p[2], Aqr$qr[3,2]))
> v2
[,1]
[1,] 0.0000000
[2,] 1.9938462
[3,] 0.1107692
> I = diag(3) # identity matrix
> H1 = I - v1 %*% t(v1)/p[1] # I - v1*v1^T/p[1]
> H2 = I - v2 %*% t(v2)/p[2] # I - v2*v2^T/p[2]
> Q = H1 %*% H2
> Q
[,1] [,2] [,3]
[1,] -0.8571429 0.3942857 0.33142857
[2,] -0.4285714 -0.9028571 -0.03428571
[3,] 0.2857143 -0.1714286 0.94285714
Now let's verify the Q computed above is correct:
> qr.Q(Aqr)
[,1] [,2] [,3]
[1,] -0.8571429 0.3942857 0.33142857
[2,] -0.4285714 -0.9028571 -0.03428571
[3,] 0.2857143 -0.1714286 0.94285714
Looks good! We can also verify QR is equal to A.
> R = qr.R(Aqr) # extract R from Aqr$qr
> Q %*% R
[,1] [,2] [,3]
[1,] 12 -51 4
[2,] 6 167 -68
[3,] -4 24 -41
The LAPACK Way
A Householder reflection is computed as Hi = I - piviviT, where I is the identity matrix, pi is the corresponding entry in $qraux, and vi is as follows:
vi[1..i-1] = 0,
vi[i] = 1
vi[i+1:m] = A[i+1..m, i] (i.e., a column of the lower triangle of A after calling qr)
There is another twist when using the LAPACK routine in R: column pivoting is used, so the decomposition is solving a different, related problem: AP = QR, where P is a permutation matrix.
LAPACK Example
This section does the same example as before.
> A <- matrix(c(12, 6, -4, -51, 167, 24, 4, -68, -41), nrow=3)
> Bqr = qr(A, LAPACK=TRUE)
> Bqr
$qr
[,1] [,2] [,3]
[1,] 176.2554964 -71.1694118 1.668033
[2,] -0.7348557 35.4388886 -2.180855
[3,] -0.1056080 0.6859203 -13.728129
[snip...]
$qraux
[1] 1.289353 1.360094 0.000000
$pivot
[1] 2 3 1
attr(,"useLAPACK")
[1] TRUE
[snip...]
Notice the $pivot field; we will come back to that. Now we generate Q from the information the Aqr.
> p = Bqr$qraux # for convenience
> v1 = matrix(c(1, Bqr$qr[2:3,1]))
> v1
[,1]
[1,] 1.0000000
[2,] -0.7348557
[3,] -0.1056080
> v2 = matrix(c(0, 1, Bqr$qr[3,2]))
> v2
[,1]
[1,] 0.0000000
[2,] 1.0000000
[3,] 0.6859203
> H1 = I - p[1]*v1 %*% t(v1) # I - p[1]*v1*v1^T
> H2 = I - p[2]*v2 %*% t(v2) # I - p[2]*v2*v2^T
> Q = H1 %*% H2
[,1] [,2] [,3]
[1,] -0.2893527 -0.46821615 -0.8348944
[2,] 0.9474882 -0.01602261 -0.3193891
[3,] 0.1361660 -0.88346868 0.4482655
Once again, the Q computed above agrees with the R-provided Q.
> qr.Q(Bqr)
[,1] [,2] [,3]
[1,] -0.2893527 -0.46821615 -0.8348944
[2,] 0.9474882 -0.01602261 -0.3193891
[3,] 0.1361660 -0.88346868 0.4482655
Finally, let's compute QR.
> R = qr.R(Bqr)
> Q %*% R
[,1] [,2] [,3]
[1,] -51 4 12
[2,] 167 -68 6
[3,] 24 -41 -4
Notice the difference? QR is A with its columns permuted given the order in Bqr$pivot above.
I have researched for this same problem as the OP asks and I don't think it is possible. Basically the OP question is whether having the explicitly computed Q, one can recover the H1 H2 ... Ht. I do not think this is possible without computing the QR from scratch but I would also be very interested to know whether there is such solution.
I have a similar issue as the OP but in a different context, my iterative algorithm needs to mutate the matrix A by adding columns and/or rows. The first time, the QR is computed using DGEQRF and thus, the compact LAPACK format. After the matrix A is mutated e.g. with new rows I can quickly build a new set of reflectors or rotators that will annihilate the non-zero elements of the lowest diagonal of my existing R and build a new R but now I have a set of H1_old H2_old ... Hn_old and H1_new H2_new ... Hn_new (and similarly tau's) which can't be mixed up into a single QR compact representation. The two possibilities I have are, and maybe the OP has the same two possibilities:
Always maintain Q and R explicitly separated whether when computed the first time or after every update at the cost of extra flops but keeping the required memory well bounded.
Stick to the compact LAPACK format but then every time a new update comes in, keep a list of all these mini sets of update reflectors. At the point of solving the system one would do a big Q'*c i.e. H1_u3*H2_u3*...*Hn_u3*H1_u2*H2_u2*...*Hn_u2*H1_u1*H2_u1...*Hn_u1*H1*H2*...*Hn*c where ui is the QR update number and this is potentially a lot of multiplications to do and memory to keep track of but definitely the fastest way.
The long answer from David basically explains what the compact QR format is but not how to get to this compact QR format having the explicit computed Q and R as input.

Resources