I have 2 matrices of different parameters: M1and M3 with the same dimensions. I'll like to do a column wise grangertest in R.
M1<- matrix( c(2,3, 1, 4, 3, 3, 1,1, 5, 7), nrow=5, ncol=2)
M3<- matrix( c(1, 3, 1,5, 7,3, 1, 3, 3, 4), nrow=5, ncol=2)
I'll want to do a granger's causality test to determine if M2 granger causes M1. My actual Matrices contain more columns and rows but this is just an example. The original code between two vectors is below:
library(lmtest)
data(ChickEgg)
grangertest(chicken ~ egg, order = 3, data = ChickEgg)
How do I write this for a column wise analysis such that a matrix with 2 rows ( "F[2]" and "Pr(>F)[2]") and two columns is returned as results please?
Does this go into the right direction?
library(lmtest)
M1<- matrix( c(2,3, 1, 4, 3, 3, 1,1, 5, 7), nrow=5, ncol=2)
M3<- matrix( c(1, 3, 1,5, 7,3, 1, 3, 3, 4), nrow=5, ncol=2)
g <- list()
for (i in 1:ncol(M1)){
g[[i]] <- grangertest(M1[ ,i] ~ M3[ ,i])
}
foo <- function(x){
F <- x$F[2]
P <- x$`Pr(>F)`[2]
data.frame(F = F, P = P)
}
do.call(rbind, lapply(g, foo))
F P
1 0.3125000 0.6754896
2 0.1781818 0.7457180
We can use sapply
sapply(1:ncol(M1), function(i) {
m1 <- grangertest(M1[,i]~M3[,i])
data.frame(F=m1$F[2], p=m1$`Pr(>F)`[2])})
# [,1] [,2]
#F 0.3125 0.1781818
#p 0.6754896 0.745718
Related
I am trying to perform a multidimensional vectorization in R instead of using a for loop. I have two 2D matrices A and W, that I pass to crit.func(A, W).
The original for loop effectively iterates over versions of A and W:
for(current.couple in 1:nrow(couples)){
a_current <- current.rows[-which(current.rows == couples$current[current.couple])]
a_candidate <- couples$candidate[current.couple]
A <- A.use[ c(a_current, a_candidate),]
W <- W.use[ c(a_current, a_candidate), c(a_current, a_candidate)]
couples$D[ current.couple] <- crit.func(A, W)
}
What I would like to do instead for speed is create a vectorized version. My idea is to stack all versions of A and W to form two 3D arrays and then use the 3rd dimension, the depth, as the vectorized dimension. For example, let's say I have the following A and W matrices:
A1 <- matrix(c(2.4, 5.2, 8.4, 3.1, 6.05, 9.25), nrow = 2,ncol = 3, byrow = TRUE)
A2 <- matrix(c(4.5, 7.5, 10.5, 3.2, 6.2, 9.2), nrow = 2, ncol = 3, byrow = TRUE)
A3 <- matrix(c(2.1, 5, 8.2, 3.05, 6.02, 9.1), nrow = 2,ncol = 3, byrow = TRUE)
A4 <- matrix(c(4.12, 7.31, 10.3, 3.23, 6.1, 9), nrow = 2, ncol = 3, byrow = TRUE)
W1 <- matrix(c(1, 4, 2, 5), nrow = 2, ncol = 2, byrow = TRUE)
W2 <- matrix(c(9, 6, 8, 5), nrow = 2, ncol = 2, byrow = TRUE)
W3 <- matrix(c(1, 4.2, 2.2, 5.2), nrow = 2, ncol = 2, byrow = TRUE)
W4 <- matrix(c(9.05, 6.011, 8.3, 5.2), nrow = 2, ncol = 2, byrow = TRUE)
I would then form the 3D arrays with:
# Z stack all of the A options
A_append <- array(c(A1, A2, A3, A4), c(2, 3, 4))
# Z stack all of the W options
W_append <- array(c(W1, W2, A3, A4), c(2, 2, 4))
If crit.func() takes the determinant so that:
crit.func <- function( A, W){
return( det( t(A) %*% W %*% A))
}
The expected result for a vectorized solution will be:
[2.095476e-12, 0, -7.067261e-12, 7.461713e-12].
What I have tried to do is use the package multiApply
library(multiApply)
A_append <- provideDimnames(A_append ,sep = "_", base = list('row','col','lev'))
W_append <- provideDimnames(W_append ,sep = "_", base = list('row','col','lev'))
# multiApply
D <- Apply(data = list(A_append, W_append), target_dims = c(1, 2, NULL), margins = 3, fun = crit.func)$output1
but I do not get the correct output (see below). I believe that first using list(A_append, W_append) as I did is not giving the behavior I want, and I somehow have to name the dimensions in another way as I get the following warning:
"Guessed names for some unnamed dimensions of equal
length found across different inputs in 'data'. Please
check carefully the assumed names below are correct, or
provide dimension names for safety, or disable the
parameter guess_dim_names."
Input 1:
_unnamed_dim_1_ _unnamed_dim_2_ _unnamed_dim_3_
2 3 4
Input 2:
_unnamed_dim_1_ _unnamed_dim_4_ _unnamed_dim_3_
2 2 4
[1] "The output of multiApply:"
[1] 2.095476e-12 0.000000e+00 4.562232e-12 -1.450281e-11
Does anybody know of either a better way to vectorize this for loop to get the expected behavior? Or, can you see how to change the arguments I provided to multiApply's Apply() to correctly pass (A_append[, ,i], W_append[,,i]) to crit.func()?
It may be simpler to use lists to store your matrices:
A <- list(A1, A2, A3, A4)
W <- list(W1, W2, W3, W4)
mapply(crit.func, A, W)
# [1] 1.850935e-12 0.000000e+00 6.025116e-12 -8.291046e-13
These numbers do not match your expected values, but they seem to be correct for your data:
crit.func(A1, W1)
# [1] 1.850935e-12
crit.func(A2, W2)
# [1] 0
crit.func(A3, W3)
# [1] 6.025116e-12
crit.func(A4, W4)
# [1] -8.291046e-13
I have several different arrays of the same dimension. Is there a way to find the standard deviation, mean, and some percentiles of all the arrays? My final result should be one array with the same dimension as each of the individual arrays.
I tried the following it clearly doesn't work
m1 <- array(runif(8), dim = c(2, 2, 2))
m2 <- array(runif(8), dim = c(2, 2, 2))
m3 <- array(runif(8), dim = c(2, 2, 2))
sd(m1, m2, m3)
Consider creating a single array and use apply to loop over the dimensions and get the sd
out <- apply(array(c(m1, m2, m3), dim = c(2, 2, 2, 3)), c(1, 2, 3), sd)
-checking the output
> sd(c(m1[1], m2[1], m3[1]))
[1] 0.1623589
> out[1]
[1] 0.1623589
Use the same method for mean
out2 <- apply(array(c(m1, m2, m3), dim = c(2, 2, 2, 3)), c(1, 2, 3), mean)
I'd like to add toAdd to the diagonal of every element of list a. How can I do this? I tried
diag(a) = lapply(a, function(x) (toAdd + diag(x)))
but it doesn't work.
CODE:
a =list(
matrix(1:4, 2, 2),
matrix(5:8, 2, 2))
toAdd = list(
c(1, 3),
c(1, 2)
)
DESIRED OUTCOME:
out =list(
matrix(c(2, 2, 3, 5), 2, 2),
matrix(c(6, 6, 7, 9), 2, 2))
Try with Map
Map(function(x, y) {diag(y) <- x + diag(y); y}, toAdd, a)
Or use
Map(function(x, y) `diag<-`(y, diag(y) + x), toAdd, a)
I'm implementing the Jacobi iterative method to solve linear systems Ax = b
I have the following code:
data.a <- c(3, -1, 1, 3, 6, 2, 3, 3, 7)
A <- matrix(data.a, nrow = 3, ncol = 3, byrow = TRUE)
b <- c(1, 0, 4)
Xo <- c(0,0,0)
X <- c(0, 0, 0)
#A is the matrix:
#3 -1 1
#3 6 2
#3 3 7
#b is the column vector:
#[1, 0, 4]
#and Xo is the previous X computed
for(i in 1:nrow(A)){
sum = 0
for(j in 1:ncol(A)){
if(j != i){
sum = sum + A[i,j]*Xo[j]
}
}
X[i] = -(1/A[i,i])*(sum - b[i])
}
The thing is, because I only multiply and sum up the values A[i][j]*Xo[j] for j != i
I am using nested for-loops and use the auxiliar variable sum.
My question is: Could I use something like
A[i,] %*% Xo
to compute the values of the sum without the nested-for loops?
edit: I found a solution
X[i] = -(1/A[i,i])*(A[i,]%*%Xo - A[i,i]*Xo[i] - b[i])
# I subtracted the term A[i,i]*Xo[i] from the product A*Xo
You can even remove the first loop by making a matrix R, whose elements are equal to A except that diagonal elements are zeros.
update <- function(x, A, b) {
D <- diag(diag(A))
R <- A - D
sums <- R %*% x
x <- (b - sums) / diag(D)
x
}
data.a <- c(3, -1, 1, 3, 6, 2, 3, 3, 7)
A <- matrix(data.a, nrow = 3, ncol = 3, byrow = TRUE)
b <- c(1, 0, 4)
x <- c(0, 0, 0)
for (i in 1:100) x <- update(x, A, b)
x
# verify the answer is correct
solve(A, b)
I have the following code:
beta <- c(1, 2, 3)
X1 <- matrix(c(1, 1, 1, 1,
0, 1, 0, 1,
0, 0, 1, 1),
nrow = 4,
ncol = 3)
Z1 <- matrix(c(1, 1, 1, 1,
0, 1, 0, 1),
nrow = 4,
ncol = 2)
Z2 <- matrix(c(1, 1, 1, 1,
0, 1, 0, 1),
nrow = 4,
ncol = 2)
library(MASS)
S1 <- mvrnorm(70, mu = c(0,0), Sigma = matrix(c(10, 3, 3, 2), ncol = 2))
S2 <- mvrnorm(40, mu = c(0,0), Sigma = matrix(c(10, 4, 4, 2), ncol = 2))
z <- list()
y <- list()
for(j in 1:dim(S1)[1]){
for(i in 1:dim(S2)[1]){
z[[i]] <- X1 %*% beta+Z1 %*% S1[j,]+Z2 %*% S2[i,]+matrix(rnorm(4, mean = 0 , sd = 0.27), nrow = 4)
Z <- unname(do.call(rbind, z))
}
y[[j]] <- Z
Y <- unname(do.call(rbind, y))
}
X1 is a 4x3, Z1 and Z2 are 4x2 matrices. So everytime X1 %*% beta+X2 %*% S1[j,]+X2 %*% S2[i,]+matrix(rnorm(4, mean = 0 , sd = sigma), nrow = 4) is called it outputs a 4x1 matrix. So far I store all these values in the inner and outer loop in two lists and then call rbind() to transform them into a matrix. Is there a way to directly store them in matrices?
You can avoid using lists if you rely on the apply functions and on vector recycling. I broke down your equation into its parts. (I hope I interpreted it accurately!)
Mb <- as.vector(X1 %*% beta)
M1 <- apply(S1,1,function(x) Z1 %*% x )
M2 <- apply(S2,1,function(x) Z2 %*% x ) + Mb
Mout <- apply(M1,2,function(x) M2 + as.vector(x))
as.vector(Mout) + rnorm(length(Mout), mean = 0 , sd = 0.27)
because the random numbers are added after the matrix multiplication (ie are not involved in any calculation), you can just put them in on the end.
Also note that you can't add a smaller matrix to a larger one, but if you make it a vector first then R will recycle it as necessary. So when Mb (a vector of length 4) is added to a matrix with 4 rows and n columns, it is recycled n times.