R code for finding a inverse matrix without using inbuilt function? - r

How can i write R code finding a inverse matrix without using inbuilt function? we can use "det" function.

The following function will perform any exponentiation of a matrix. The code was taken from here (link). For an inverse, set the argument EXP=-1:
#The exp.mat function performs can calculate the pseudoinverse of a matrix (EXP=-1)
#and other exponents of matrices, such as square roots (EXP=0.5) or square root of
#its inverse (EXP=-0.5).
#The function arguments are a matrix (MAT), an exponent (EXP), and a tolerance
#level for non-zero singular values.
exp.mat<-function(MAT, EXP, tol=NULL){
MAT <- as.matrix(MAT)
matdim <- dim(MAT)
if(is.null(tol)){
tol=min(1e-7, .Machine$double.eps*max(matdim)*max(MAT))
}
if(matdim[1]>=matdim[2]){
svd1 <- svd(MAT)
keep <- which(svd1$d > tol)
res <- t(svd1$u[,keep]%*%diag(svd1$d[keep]^EXP, nrow=length(keep))%*%t(svd1$v[,keep]))
}
if(matdim[1]<matdim[2]){
svd1 <- svd(t(MAT))
keep <- which(svd1$d > tol)
res <- svd1$u[,keep]%*%diag(svd1$d[keep]^EXP, nrow=length(keep))%*%t(svd1$v[,keep])
}
return(res)
}
Also, the function solve will provide the inverse:
a <- matrix(rnorm(16), 4, 4)
exp.mat(a, -1)
# [,1] [,2] [,3] [,4]
#[1,] -0.5900474 -0.3388987 0.1144450 0.38623757
#[2,] -1.0926908 -0.8692702 0.4487108 0.11958685
#[3,] 0.5967371 0.8102801 0.2292397 -0.31654754
#[4,] 0.4634810 0.4562516 -0.7958837 -0.08637801
solve(a)
# [,1] [,2] [,3] [,4]
#[1,] -0.5900474 -0.3388987 0.1144450 0.38623757
#[2,] -1.0926908 -0.8692702 0.4487108 0.11958685
#[3,] 0.5967371 0.8102801 0.2292397 -0.31654754
#[4,] 0.4634810 0.4562516 -0.7958837 -0.08637801

Related

fill a matrix in a loop by function output

A function takes two sets of values from two vectors (alpha and beta). I need to place the values of the function output in a matrix with size alpha x beta. The function calculates power values. I appreciate your help. I need a matrix 5x5. I have attempted the following code so far:
alpha = c(0.01,0.05,0.10,0.20)
beta = c(0.50,0.60,0.70,0.80,0.90)
pwrmx <- matrix(data=NA, nrow=alpha, ncol=beta)
for (a in alpha){
for (b in beta){
pwr <- power.prop.test(n=NULL, p1=0.25, p2=0.4, sig.level = a, power = b)
print(pwr$n)
}
}
you were almost there, refer the comments:
alpha = c(0.01,0.05,0.10,0.20)
beta = c(0.50,0.60,0.70,0.80,0.90)
# nrow and ncol depends on the length of alpha and beta
pwrmx <- matrix(data=NA, nrow=length(alpha), ncol=length(beta))
# iterate over the length so that you can use it to assign back at the correct index in matrix
for (i in 1:length(alpha)){
for (j in 1:length(beta)){
# as you are interested in the number n from the power analysis
pwrmx[i,j] <- (power.prop.test(n=NULL, p1=0.25, p2=0.4, sig.level = alpha[i], power = beta[j]))$n
}
}
pwrmx
# . [,1] [,2] [,3] [,4] [,5]
#[1,] 129.38048 155.72219 186.60552 226.29474 287.6656
#[2,] 74.90845 95.24355 119.70057 151.86886 202.8095
#[3,] 52.75810 70.01993 91.18885 119.50901 165.1130
#[4,] 32.02629 45.74482 63.12283 87.00637 126.4575
No need of loops, you can create a function to perform the calculation
func <- function(x, y) power.prop.test(n=NULL, p1=0.25, p2=0.4, sig.level = x, power = y)$n
and then use outer and apply the function (func) on each combination of alpha and beta
outer(alpha, beta, Vectorize(func))
# [,1] [,2] [,3] [,4] [,5]
#[1,] 129.38048 155.72219 186.60552 226.29474 287.6656
#[2,] 74.90845 95.24355 119.70057 151.86886 202.8095
#[3,] 52.75810 70.01993 91.18885 119.50901 165.1130
#[4,] 32.02629 45.74482 63.12283 87.00637 126.4575

correlation-covariance matrix to variance-covariance matrix

Is there an easy way to convert a correlation-covariance matrix into a variance-covariance matrix? I always use nested for-loops as below, but I keep thinking there is probably a built-in function in base R.
my.matrix <- matrix(c(0.64901, 0.76519, -0.63620, -0.01923,
0.02114, 0.00118, -0.43198, 0.02480,
-0.21811, -0.00630, 0.18109, 0.05964,
-0.00710, 0.00039, 0.01162, 0.20972), nrow=4, byrow=TRUE)
new.matrix <- my.matrix
for(i in 1:nrow(my.matrix)) {
for(j in 1:ncol(my.matrix)) {
new.matrix[i,j] = ifelse(i<j, my.matrix[j,i], new.matrix[i,j])
}
}
new.matrix
# [,1] [,2] [,3] [,4]
# [1,] 0.64901 0.02114 -0.21811 -0.00710
# [2,] 0.02114 0.00118 -0.00630 0.00039
# [3,] -0.21811 -0.00630 0.18109 0.01162
# [4,] -0.00710 0.00039 0.01162 0.20972
I am aware of the lower.tri and upper.tri functions, but cannot seem to accomplish the task with a combination of them and t().
I think you might need to get the indices with which and then swap the rows and columns. Try this.
k <- which(lower.tri(my.matrix), arr.ind=TRUE)
my.matrix[k[,c(2,1)]] <- my.matrix[k]

SVD calculation in R

How do I get actual matrix using Singular value decomposition(SVD)
efficiently in R ,
cause A=svd$u %*% svd$d %*% t(svd$v) This is not an efficient way to get matrix A
Try svd(A)$u%*%diag(svd(A)$d)%*%t(svd(A)$v).
set.seed(12345)
A <- matrix(data=runif(n=9, min=1, max=9), nrow=3)
A
[,1] [,2] [,3]
[1,] 6.767231 8.088997 3.600763
[2,] 8.006186 4.651848 5.073795
[3,] 7.087859 2.330974 6.821642
s <- svd(A)
D <- diag(s$d)
s$u %*% D %*% t(s$v)
[,1] [,2] [,3]
[1,] 6.767231 8.088997 3.600763
[2,] 8.006186 4.651848 5.073795
[3,] 7.087859 2.330974 6.821642
Improving upon the answer by #MYaseen208
(s$u) %*% (t(s$v)*s$d)
This has one less matrix multiplication (which is an O(n^3) operation).

Defining a function that calculates the covariance-matrix of a correlation-matrix

I have some problems with the transformation of a matrix and the names of the rows and columns.
My problem is as follows:
As input-matrix I have a (symmetric) correlation matrix like this one:
The correlation-vector is given by the values of the lower triangular matrix:
Now, I want to compute the variance-covariance-matrix of the these correlations, which are approximately normally distributed with the variance-covariance-matrix:
The variances can be approximated by
-> N is the sample size (in this example N = 66)
The covariances can be approximated by
For example the covariance between r_02 and r_13 is given by
Now, I want to define a function in R which gets the correlation matrix as input and returns the variance-covariance matrix. However, I have problems to implement the calculation of the covariances. My idea is to give names to the elements of the correlation_vector as shown above (r_01, r_02...). Then I want to create the empty variance-cocariance matrix, which has the length of the correlation_vector. The rows and the columns should have the same names as the correlation_vector, so I can call them for example by [01][03]. Then I want to implement a for-loop which sets the value of i and j as well as k and l as shown in the formula for the covariance to the columns and rows of the correlations that I need as input for the covariance-formula. These must always be six different values (ij; ik; il; jk; jl; lk). This is my idea, but I don't now how to implement this in R.
This is my code (without the calculation of the covariances):
require(corpcor)
correlation_matrix_input <- matrix(data=c(1.00,0.561,0.393,0.561,0.561,1.00,0.286,0.549,0.393,0.286,1.00,0.286,0.561,0.549,0.286,1.00),ncol=4,byrow=T)
N <- 66 # Sample Size
vector_of_correlations <- sm2vec(correlation_matrix_input, diag=F) # lower triangular matrix of correlation_matrix_input
variance_covariance_matrix <- matrix(nrow = length(vector_of_correlations), ncol = length(vector_of_correlations)) # creates the empty variance-covariance matrix
# function to fill the matrix by calculating the variance and the covariances
variances_covariances <- function(vector_of_correlations_input, sample_size) {
for (i in (seq(along = vector_of_correlations_input))) {
for (j in (seq(along = vector_of_correlations_input))) {
# calculate the variances for the diagonale
if (i == j) {
variance_covariance_matrix[i,j] = ((1-vector_of_correlations_input[i]**2)**2)/sample_size
}
# calculate the covariances
if (i != j) {
variance_covariance_matrix[i,j] = ???
}
}
}
return(variance_covariance_matrix);
}
Does anyone have an idea, how to implement the calculation of the covariances using the formula shown above?
I would be grateful for any kind of help regarding this problem!!!
It's easier if you keep r as a matrix and use this helper function to make things clearer:
covr <- function(r, i, j, k, l, n){
if(i==k && j==l)
return((1-r[i,j]^2)^2/n)
( 0.5 * r[i,j]*r[k,l]*(r[i,k]^2 + r[i,l]^2 + r[j,k]^2 + r[j,l]^2) +
r[i,k]*r[j,l] + r[i,l]*r[j,k] - (r[i,j]*r[i,k]*r[i,l] +
r[j,i]*r[j,k]*r[j,l] + r[k,i]*r[k,j]*r[k,l] + r[l,i]*r[l,j]*r[l,k]) )/n
}
Now define this second function:
vcovr <- function(r, n){
p <- combn(nrow(r), 2)
q <- seq(ncol(p))
outer(q, q, Vectorize(function(x,y) covr(r, p[1,x], p[2,x], p[1,y], p[2,y], n)))
}
And voila:
> vcovr(correlation_matrix_input, 66)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0.007115262 0.001550264 0.002917481 0.003047666 0.003101602 0.001705781
[2,] 0.001550264 0.010832674 0.001550264 0.006109565 0.001127916 0.006109565
[3,] 0.002917481 0.001550264 0.007115262 0.001705781 0.003101602 0.003047666
[4,] 0.003047666 0.006109565 0.001705781 0.012774221 0.002036422 0.006625868
[5,] 0.003101602 0.001127916 0.003101602 0.002036422 0.007394554 0.002036422
[6,] 0.001705781 0.006109565 0.003047666 0.006625868 0.002036422 0.012774221
EDIT:
For the transformed Z values, as in your comment, you can use this:
covrZ <- function(r, i, j, k, l, n){
if(i==k && j==l)
return(1/(n-3))
covr(r, i, j, k, l, n) / ((1-r[i,j]^2)*(1-r[k,l]^2))
}
And simply replace it in vcovr:
vcovrZ <- function(r, n){
p <- combn(nrow(r), 2)
q <- seq(ncol(p))
outer(q, q, Vectorize(function(x,y) covrZ(r, p[1,x], p[2,x], p[1,y], p[2,y], n)))
}
New result:
> vcovrZ(correlation_matrix_input,66)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0.015873016 0.002675460 0.006212598 0.004843517 0.006478743 0.002710920
[2,] 0.002675460 0.015873016 0.002675460 0.007869213 0.001909452 0.007869213
[3,] 0.006212598 0.002675460 0.015873016 0.002710920 0.006478743 0.004843517
[4,] 0.004843517 0.007869213 0.002710920 0.015873016 0.003174685 0.007858948
[5,] 0.006478743 0.001909452 0.006478743 0.003174685 0.015873016 0.003174685
[6,] 0.002710920 0.007869213 0.004843517 0.007858948 0.003174685 0.015873016
I wrote an approach using combn and row/column indices to generate the different combinations of p.
variances_covariances <- function(m, n) {
r <- m[lower.tri(m)]
var <- (1-r^2)^2
## generate row/column indices
rowIdx <- rep(1:nrow(m), times=colSums(lower.tri(m)))
colIdx <- rep(1:ncol(m), times=rowSums(lower.tri(m)))
## generate combinations
cov <- combn(length(r), 2, FUN=function(i) {
## current row/column indices
cr <- rowIdx[i] ## i,k
cc <- colIdx[i] ## j,l
## define 6 cases
p.ij <- m[cr[1], cc[1]]
p.ik <- m[cr[1], cr[2]]
p.il <- m[cr[1], cc[2]]
p.jk <- m[cc[1], cr[2]]
p.jl <- m[cc[1], cc[2]]
p.kl <- m[cr[2], cc[2]]
## calculate covariance
co <- 0.5 * p.ij * p.kl * (p.ik^2 + p.il^2 + p.jk^2 + p.jl^2) +
p.ik * p.jl + p.il * p.jk -
(p.ij * p.ik * p.il + p.ij * p.jk * p.jl + p.ik * p.jk * p.kl + p.il * p.jl * p.kl)
return(co)
})
## create output matrix
com <- matrix(NA, ncol=length(r), nrow=length(r))
com[lower.tri(com)] <- cov
com[upper.tri(com)] <- t(com)[upper.tri(com)]
diag(com) <- var
return(com/n)
}
Output:
m <- matrix(data=c(1.000, 0.561, 0.393, 0.561,
0.561, 1.000, 0.286, 0.549,
0.393, 0.286, 1.000, 0.286,
0.561, 0.549, 0.286, 1.00), ncol=4, byrow=T)
variances_covariances(m, 66)
# [,1] [,2] [,3] [,4] [,5] [,6]
#[1,] 0.007115262 0.001550264 0.001550264 0.003101602 0.003101602 0.001705781
#[2,] 0.001550264 0.010832674 0.010832674 0.001127916 0.001127916 0.006109565
#[3,] 0.001550264 0.010832674 0.007115262 0.001127916 0.001127916 0.006109565
#[4,] 0.003101602 0.001127916 0.001127916 0.012774221 0.007394554 0.002036422
#[5,] 0.003101602 0.001127916 0.001127916 0.007394554 0.007394554 0.002036422
#[6,] 0.001705781 0.006109565 0.006109565 0.002036422 0.002036422 0.012774221
I hope, I have done everything right.
salam/hello
variance_covariance_matrix<- diag (variance vector, length (r),length (r))
pcomb <- combn(length(r), 2)
for (k in 1:length(r)){
i<- pcomb[1,k]
j<- pcomb[2,k]
variance_covariance_matrix[i,j]<- variance_covariance_matrix [j,i]<- genCorr[k] * sqrt (sig2g[i]) * sqrt (sig2g[j])
}

Choleski Decomposition in R to get the inverse when pivot = TRUE

I am using the choleski decomposition to compute the inverse of a matrix that is positive semidefinite. However, when my matrix becomes extremely large and has zeros in it I have that my matrix is no longer (numerically from the computers point of view) positive definite. So to get around this problem I use the pivot = TRUE option in the choleski command in R. However, (as you will see below) the two return the same output but with the rows and columns or the matrix rearranged. I am trying to figure out is there a way (or transformation) to make them the same. Here is my code:
X = matrix(rnorm(9),nrow=3)
A = X%*%t(X)
inv1 = function(A){
Q = chol(A)
L = t(Q)
inverse = solve(Q)%*%solve(L)
return(inverse)
}
inv2 = function(A){
Q = chol(A,pivot=TRUE)
L = t(Q)
inverse = solve(Q)%*%solve(L)
return(inverse)
}
Which when run results in:
> inv1(A)
[,1] [,2] [,3]
[1,] 9.956119 -8.187262 -4.320911
[2,] -8.187262 7.469862 3.756087
[3,] -4.320911 3.756087 3.813175
>
> inv2(A)
[,1] [,2] [,3]
[1,] 7.469862 3.756087 -8.187262
[2,] 3.756087 3.813175 -4.320911
[3,] -8.187262 -4.320911 9.956119
Is there a way to get the two answers to match? I want inv2() to return the answer from inv1().
That is explained in ?chol: the column permutation is returned as an attribute.
inv2 <- function(A){
Q <- chol(A,pivot=TRUE)
Q <- Q[, order(attr(Q,"pivot"))]
Qi <- solve(Q)
Qi %*% t(Qi)
}
inv2(A)
solve(A) # Identical
Typically
M = matrix(rnorm(9),3)
M
[,1] [,2] [,3]
[1,] 1.2109251 -0.58668426 -0.4311855
[2,] -0.8574944 0.07003322 -0.6112794
[3,] 0.4660271 -0.47364400 -1.6554356
library(Matrix)
pm1 <- as(as.integer(c(2,3,1)), "pMatrix")
M %*% pm1
[,1] [,2] [,3]
[1,] -0.4311855 1.2109251 -0.58668426
[2,] -0.6112794 -0.8574944 0.07003322
[3,] -1.6554356 0.4660271 -0.47364400

Resources