R: Fill a matrix with a covariance function - arrays

I'm experimenting with spectral simulation for generating unconditional Gaussian realizations of a spatial variable. The variable has a covariance function c(h) = exp(-h/a), where a is the range of the covariance function and h is distance. In the first step, I need to discretize the covariance function into an array/matrix. The entries in the matrix correspond to physical locations in space (i.e. the matrix indices correspond to x and y coordinates):
cov(i,j) = exp(-sqrt((i-64)^2 + (j-64)^2) / 20) for i,j = 1 to 128
I am looking to generate a matrix in R and fill it with the covariance function related to the indices of the array. As a total beginner with R, I'm a bit lost.

stuff that expression into a function:
myfun <- function(i, j) {
exp(-sqrt((i-64)^2 + (j-64)^2) / 20)
}
Then make your "matrix" of possible i, j combinations:
n <- 128
combos <- expand.grid(i=1:n, j=1:n)
Then call your function with those two vectors:
matrix(myfun(combos$i, combos$j), nrow=n)
Using a smaller number:
> n <- 5
> combos <- expand.grid(i=1:n, j=1:n)
> matrix(myfun(combos$i, combos$j), nrow=n)
[,1] [,2] [,3] [,4] [,5]
[1,] 0.01162296 0.01203954 0.01246747 0.01290681 0.01335761
[2,] 0.01203954 0.01247458 0.01292166 0.01338085 0.01385221
[3,] 0.01246747 0.01292166 0.01338860 0.01386840 0.01436113
[4,] 0.01290681 0.01338085 0.01386840 0.01436960 0.01488451
[5,] 0.01335761 0.01385221 0.01436113 0.01488451 0.01542247
>

You could also use outer:
f <- function(i, j) {
exp(-sqrt((i-64)^2 + (j-64)^2) / 20)
}
n <- 5
outer(1:n, 1:n, f)

Related

Element-wise multiplication between array and matrix

In R, I can have piece-wise multiplication between a matrix and a (conformal) vector, for example:
X <- matrix(c(1, 2, 3, 4), nrow = 2)
a <- c(0, 1)
X * a
Each row of the matrix is then multiplied with the corresponding vector element. I can also do the same for arrays of dimension bigger than 2:
XX <- array(X, dim = c(2, 2, 2))
a <- c(0, 1)
XX * a
Again each row is multiplied with the corresponding vector element. Can I do something similar for an 3d array and a 2d matrix? I just want every submatrix of the array to be element-wise multiplied with a matrix.
you cannot multiply it with 2d matrix, but you could try this
XX*c(1,2,3,4)
It is possible to achieve 'piece'-wise multiplication (or any arithmetic operation, really) by first constructing an appropriate array from the lesser-dimensional matrix and then performing the element-wise operation. In your example:
X <- 1:8
XX <- array(X, dim = c(2, 2, 2))
a <- c(0, 1)
# construct array for point-wise operation
expandeda <- array(a, dim=dim(XX))
XX * expandeda
The result of this shows that, as you said, the individual elements of a are applied row-wise (i.e. to the first dimension of the array):
, , 1
[,1] [,2]
[1,] 0 0
[2,] 2 4
, , 2
[,1] [,2]
[1,] 0 0
[2,] 6 8
Constructing an appropriate array using array(a, dim=dim(XX)) doesn't just work for 3d and 2d matrices but for any dimensionality of arrays, as long as length(a) == dim(XX)[1].

R getting indices of closest value in z direction for all x,y points in 3dim array

I'm trying to write a function in R which is given an 3dim array and a target value and returns a matrix of the indeces with the closest value to the target in z direction for every x,y point. If there is no value within a given margin of the target the matrix should be NA at that point.
I wrote a function which works but is too slow for the hundereds of data grids with dim(x) = c(586,538,100) I want to process. I don't know how to avoid the two for loops going over the arrays x,y indices.
x <- seq(6.5,13,len=90)
dim(x) <- c(3,3,10)
get.zvals <- function(dens_grid,layer,margin=0.2){
out <- dens_grid[,,1]
out[] <- NA
for(i in 1:dim(out)[1]){
for(j in 1:dim(out)[2]){
x <- dens_grid[i,j,]
if( sum(!is.na(x)) >2
& sum(x[x<(layer+margin) & x>(layer-margin)],na.rm=TRUE) >=1 ){
out[i,j] <- which.min(abs(x-layer))
}
}
}
return(out)
}
y <- get.zvals(x,12.06)
Using apply:
get.zvals <- function(dens_grid, layer, margin=0.2) {
apply(dens_grid, c(1,2), function(x) ifelse(any(abs(x-layer) < margin),
which.min(abs(x-layer)), NA))
}
> get.zvals(x,12.06)
[,1] [,2] [,3]
[1,] NA 9 9
[2,] NA 9 NA
[3,] 9 9 NA

matrix addition from an array r

I have an array with 272 matrices, each one is 2 by 2. I now want to sum these matrices up using matrix addition. So I want the return to be a single 2 by 2 matrix. Here are some code I have used.
y <- as.matrix(faithful)
B <- matrix(c(0,0,0,0),nrow = 2)
sigma <- function(n = 272,u_new) {
vec = replicate(272,B)
for (i in 1:n) {
w <- (y-u_new)[i,]
x <- ptilde1[i]*(w%*%t(w))
vec[,,i][1,1] <- x[1,1]
vec[,,i][1,2] <- x[1,2]
vec[,,i][2,1] <- x[2,1]
vec[,,i][2,2] <- x[2,2]}
vec
}
Here vec is the array with 272 matrices. Thank you in advance.
Here is code which loops a number of times (272) and adds a matrix to the same list.
B <- matrix(c(0,0,0,0),nrow = 2)
list <- list(B)
for (i in 2:272) {
list[[i]] <- B
}
To add them all together, you can use the Reduce() function:
sum <- Reduce('+', list)
> sum
[,1] [,2]
[1,] 0 0
[2,] 0 0
This is a contrived example because all the matrices are the zero matrix. I will leave it to you as a homework assignment to use the matrices you actually want to sum together.

Divide every slice of a matrix in an array by its own vector?

Suppose I have two arrays (or tensors if tensor package is needed)
dim(Xbeta)
products draws Households
13 20 10
dim(denom)
1 20 10
set.seed(1)
Xbeta=array(rnorm(13*20*10,0,1),dim=c(13,20,10))
denom=array(rnorm(1*20*10,0,1),dim=c(1,20,10))
Without looping, I want to do the following:
for(i in 1:10){
Xbeta[,,i]=t(t(Xbeta[,,i]) / denom[,,i])
}
I want to to divide each column in Xbeta[,,i] slice by each corresponding number in denom[,,i].
For example...Xbeta[,1,i]/denom[,1,i]...etc
You can avoid looping and replication by (1) 3-dimensionally transposing the numerator array and (2) flattening the denominator array to a vector, such that the division operation will naturally cycle the incomplete denominator vector across the entirety of the transposed numerator array in such a way that the data lines up the way you want. You then must 3-dimensionally "untranspose" the result to get back the original transposition.
aperm(aperm(Xbeta,c(2,3,1))/c(denom),c(3,1,2));
The first call to aperm() transposes columns to rows, z-slices to columns, and rows to z-slices. The c() call on denom flattens the denominator array to a vector, because when cycling, we don't care about dimensionality. The final call to aperm() reverses the original transposition.
To go into more detail about the logic of this solution, what you have with your inputs is basically a vector of divisors per z-slice of the numerator array, and you want to apply each divisor to every row of the corresponding z-slice and column. This means the vector of divisors must be applied across columns, first-and-foremost, and then, as each denominator z-slice is exhausted, applied across numerator z-slices. After a complete row (covering all z-slices in the row) of the numerator array has been exhausted, the entirety of the denominator vector has been exhausted, causing it to be cycled back to the beginning for the next row of the numerator array.
See https://stat.ethz.ch/R-manual/R-devel/library/base/html/aperm.html.
For a rough idea on performance:
r> set.seed(1);
r> Xbeta <- array(rnorm(13*20*10,0,1), dim=c(13,20,10) );
r> denom <- array(rnorm(1*20*10,0,1), dim=c(1,20,10) );
r> robert <- function() { result <- array(NA, dim=c(13,20,10) ); for (i in 1:10) { result[,,i] <- t(t(Xbeta[,,i]) / denom[,,i]); }; };
r> andre <- function() { denom_myVersion <- array(rep(c(denom), each=13 ), c(13,20,10) ); result <- Xbeta / denom_myVersion; };
r> bgoldst <- function() { result <- aperm(aperm(Xbeta,c(2,3,1))/c(denom),c(3,1,2)); };
r> N <- 99999;
r> system.time({ replicate(N, robert() ); });
user system elapsed
25.421 0.000 25.440
r> system.time({ replicate(N, andre() ); });
user system elapsed
12.578 0.594 13.283
r> system.time({ replicate(N, bgoldst() ); });
user system elapsed
8.484 0.594 9.142
Also, as a general recommendation, it is helpful (for both questioners and answerers) to present these kinds of problems using minimal sample input, e.g.:
r> n <- array(1:12,dim=c(2,3,2)); n;
, , 1
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6
, , 2
[,1] [,2] [,3]
[1,] 7 9 11
[2,] 8 10 12
r> d <- array(1:6,dim=c(1,3,2)); d;
, , 1
[,1] [,2] [,3]
[1,] 1 2 3
, , 2
[,1] [,2] [,3]
[1,] 4 5 6
r> aperm(aperm(n,c(2,3,1))/c(d),c(3,1,2));
, , 1
[,1] [,2] [,3]
[1,] 1 1.5 1.666667
[2,] 2 2.0 2.000000
, , 2
[,1] [,2] [,3]
[1,] 1.75 1.8 1.833333
[2,] 2.00 2.0 2.000000
# Is this what you're looking for?
Xbeta <- array(rnorm(13*20*10,0,1),dim=c(13,20,10))
denom <- array(rnorm(1*20*10,0,1),dim=c(1,20,10))
div.list <- sapply(1:10, FUN = function(x) t(Xbeta[,,x]) / denom[,,x], simplify = FALSE)
result <- array(do.call(c, div.list), dim = dim(Xbeta)[c(2,1,3)])
I'm not sure why you choose a 3-dimensional array for the denon. Anyway, this can be done by paying close attention to how these numbers are stored in memory. In an array the first dimensions "moves the fastest". By replicating the denom values 13 times "each" then you create an array with the exact same dimensions as your numerator.
So, let's test it out:
Let's save the ramdom values so we can use them for both methods:
set.seed(1)
Num_2600 <- rnorm(13*20*10,0,1)
Denom_200 <- rnorm(20*10,0,1)
Xbeta=array(Num_2600,dim=c(13,20,10))
denom=array(Denom_200,dim=c(1,20,10))
Your_result <- array(NA, dim=c(13,20,10))
Your code gives:
for(i in 1:10){
Your_result[,,i] <- t(t(Xbeta[,,i]) / denom[,,i])
}
My code:
denom_myVersion <- array(rep( Denom_200 , each=13), c(13,20,10))
> all(Your_result == Xbeta / denom_myVersion)
[1] TRUE
>
So we get the same results. The hard part is how to decide how to replicate so the numbers fall in the right spot. Notice:
denom_myVersion <- array(rep( Denom_200 , times=13), c(13,20,10))
> all(Your_result == Xbeta / denom_myVersion)
[1] FALSE
>
With 'each' as a parameter in rep each element is repeated 13 times before going to the next element. With times, the whole vector is repeated 13 times. Compare:
> rep(1:3, each =3)
[1] 1 1 1 2 2 2 3 3 3
> rep(1:3, times=3)
[1] 1 2 3 1 2 3 1 2 3

Using double loop to fill a matrix in R

I am using double loop to fill in the matrix using following code.
mat<-matrix(NA, nrow=2, ncol=2)
for (i in 1:2){
for (j in 3:4){
mat[i,j]<-c(i,j)
}
}
mat
The error I am getting is:
Error in '[<-'('*tmp*', i, j, value = c(3L, 1L)) :
subscript out of bounds
What am I doing wrong?
So there are two problems here. First your inner for(...) loop references columns 3:4, but there are only 2 columns.
Second, you are defining the matrix to have to have single values in the elements, but then you attempt to set each element to a vector.
If you really want a matrix of vectors, you can do it this way.
mat<-matrix(list(c(NA,NA)), nrow=2, ncol=2)
for (i in 1:2){
for (j in 1:2){
mat[i,j][[1]]<-c(i,j)
}
}
mat
# [,1] [,2]
# [1,] Integer,2 Integer,2
# [2,] Integer,2 Integer,2
mat[1,1]
# [[1]]
# [1] 1 1

Resources