Vectorized matrix and array multiplication in R - arrays

I could not figure out, how to write a vectorized version of the following matrix and array multiplication:
v = rep(0.1, 2)
v2 = matrix(0, nrow = 2, ncol = 3)
A = matrix(0.25, nrow = 2, ncol = 3)
R = matrix(- 1, nrow = 2, ncol = 3)
P = array(1:12, dim = c(2, 2, 3))
for (i in 1:3) {
v2[, i] = A[, i] * (R[, i] + P[, , i] %*% v)
}
v = rowSums(v2)
Can someone help?

The problem that we are faced with is that we want to do matrix multiplication over P, a 3d array. As this is not efficiently possible, it is better to transform this array to a 2d column matrix.
P <- array(1:12, dim = c(2, 2, 3))
P <- matrix(P, nrow = 2)
The A and R matrices don't have to be adjusted for this to work
A <- matrix(0.25, nrow = 2, ncol = 3)
R <- matrix(-1, nrow = 2, ncol = 3)
Matrix multiplication with the v vector can then be accomplished by transforming the column vector into a sparse block diagonal matrix with the bdiag(...) function from the Matrix package.
library(Matrix)
v <- rep(0.1, 2)
v <- bdiag(v, v, v)
## [1,] 0.1 . .
## [2,] 0.1 . .
## [3,] . 0.1 .
## [4,] . 0.1 .
## [5,] . . 0.1
## [6,] . . 0.1
This gives the same result as before, however, this time in a vectorized manner.
v <- rowSums(A * (R + (P %*% v)))
## [1] 0.15 0.30
Edit: In the above equation I use two types of multiplication: *, the dot-product, which computes the element-wise products between two matrices of equal size, and %*%, the ordinary matrix product, which computes the matrix product of two conformable matrices, or in other words, the number of columns of the first, and the number of rows of the second matrix should be equal.
Edit2: As requested I have included how to transform the given P array to a matrix.
Edit3: This method can be generalized by introducing a variable n for the number of groups. The key adjustment is in the declaration of the block diagonal matrix, as next to individual matrices, this function also takes a list of matrices as input. This results in the following solution
library(Matrix)
n <- 3
P <- array(1:12, dim = c(2, 2, n))
P <- matrix(P, nrow = 2)
A <- matrix(0.25, nrow = 2, ncol = n)
R <- matrix(-1, nrow = 2, ncol = n)
v <- rep(0.1, 2)
v <- bdiag(rep(list(v),n))
v <- rowSums(A * (R + (P %*% v)))
## [1] 0.15 0.30

Related

ValueError: shapes (3,2) and (3,) not aligned: 2 (dim 1) != 3 (dim 0)

I have a matrix A
A= np.array([[1,2,3],[2,1,1]])
I want to calculate vector v based on
I have calculated the inverse of A by using linalg.pinv
inverse= np.linalg.pinv(A)
How can I calculate v?
I have tried using np.dot(inverse, np.array([1,1,1]), but it returns the ValueError: shapes (3,2) and (3,) not aligned: 2 (dim 1) != 3 (dim 0)
You are using the wrong shape for (1 1 1): it is a column vector, not a row one.
Try this:
import numpy as np
A = np.array([[1,2,3],[2,1,1]])
one_array = np.ones((3, 1))
A_inv = np.linalg.pinv(A)
v = np.dot(A_inv, np.dot(A, one_array))
If you print the shape of one_array, it is:
print(one_array.shape)
(3, 1)
while if you define it as np.array([1, 1, 1]) the shape is (3,), i.e. a row vector.
v will be:
[[1.02857143]
[0.85714286]
[1.08571429]]

Filling Array with 2d function values in Julia

I am wondering if there is a 1 liner to do this assignment in the array in Julia:
h = .1
L = 1
x = 0:h:L
n = length(x)
discretized = zeros(n,n)
#really any old function
f(x,y) = x*y + cos(x) + sin(y)
for i in 1:n
for j in 1:n
discretized[i, j] = f(x[i], x[j])
end
end
Or do I explicitly have to write out the loops?
You could broadcast the function over an array an its transpose - julia will return the result as a 2d Array:
x = 0:0.1:1
f(x,y) = x*y + cos(x) + sin(y)
A = f.(x,x') # the `.` before the bracket broadcasts the dimensions
# 11×11 Array{Float64,2}
or if have more complicated expressions or functions and don't want to write out lots of dots use the #. macro, e.g:
A = #. f(x,x') + x^2
Once A already exists, you can also do
#. A = f(x,x') + x^2
which uses .= to write the result locally to each element of A, and hence is non-allocating.
Broadcasting goes much further than this easy extension of scalar functions to arrays, allowing "fusion" of multiple calculations into a single fast operation https://julialang.org/blog/2017/01/moredots
You could do:
discretized = [f(i, j) for i in x, j in x]
For more information, see https://docs.julialang.org/en/v1/manual/arrays/#Comprehensions-1
Edit: Based on the comments, here's a brief overview of what the : operator does in indexing:
julia> a = [1, 2, 3]
3-element Array{Int64,1}:
1
2
3
julia> a[:]
3-element Array{Int64,1}:
1
2
3
julia> ans === a
false
julia> a[:] .= [2, 3, 4]
3-element view(::Array{Int64,1}, :) with eltype Int64:
2
3
4
julia> a
3-element Array{Int64,1}:
2
3
4

Apply a replacement to each 3rd dimension of a 3D array

I have an mxnxp (3D) array A. I have a 2D matrix B with values ranging from 1:m in the first column and 1:n in the second column. What I'd like to do is NA out the indices that correspond to those given by B in each of the third dimension (heights?). So,
for (i in 1:p) {
A[,,i][B] = NA
}
Is there a way to do this without a for loop? I was thinking something like
A_NA = apply(A,3,function(x) x[B] = NA)
But that doesn't work.
We need to return the x and then assign it back to 'A'
A[] <- apply(A,3,function(x) { x[B] = NA; x})
Checking with the OP's solution
for (i in 1:p) {
A1[,,i][B] = NA
}
identical(A, A1)
#[1] TRUE
data
A <- array(1:40, c(5, 4, 2) )
B <- cbind(c(1, 2, 3, 4), c(2, 3, 1, 1))
p <- 2
A1 <- A

Using a subscript within a for loop to store output in an array in R

I want to run a simulation with varying standard deviation (SD) values and store each simulation results along the rows using the following nested for loop. I am also using a user defined function QR to extract coefficients from results of Quanile Regression.
QR <- function(varname, data){
y <- data[, varname]
q <- summary(rq(y ~ x, taus), se = "boot")
z <- rbind(q[[1]]$coef, q[[2]]$coef, q[[3]]$coef, q[[4]]$coef)
}
taus <- c(.05, .1, .25, .75, .90, .95) # Quantiles to be extracted
nsim <- 10 # No of simulations
SD <- c(1, 3, 5) # Varying SD
res <- array(NA, dim = c(nsim, 10, 3)) # Empty array to store the results
for (i in 1:3){
for (j in 1:nsim){
x <- rnorm(SS[i], 10, 1);
eN <- rnorm(SS[i], 0, 1);
eLN1 <- rlnorm(SS[i], 0, 0.25);
data <- data.frame(cbind(y1 <- 1 + (2 * x) + eN,
y2 <- 1 + (2 * x) + eLN1,
x))
colnames(data) <- c("y1", "y2", "x")
listQR <- lapply(names(data)[1:2], function(x) QR(x, data))
res[j, 1, i] <- SS[i];
res[j, 2, i] <- SS[j];
res[j, 3, i] <- listQR[[1]][1, 1];
res[j, 4, i] <- listQR[[1]][1, 2];
res[j, 5, i] <- listQR[[1]][2, 1];
res[j, 6, i] <- listQR[[1]][2, 2];
res[j, 7, i] <- listQR[[2]][1, 1];
res[j, 8, i] <- listQR[[2]][1, 2];
res[j, 9, i] <- listQR[[2]][2, 1];
res[j, 10, i] <- listQR[[2]][2, 2];
write.csv(res, file = "test.csv");
}
}
I also have several other values to be extracted from listQR and store it the same way, in which case I have to write several other line of codes for them. My question is, can I use some subscript within the loop for listQR/modify the code so that I end up writing lesser line of codes? Something like,
res[j, k, i] <- listQR[[k]] # Tried this, end up overwriting the values
I have found a solution by customizing QR function to give relevant coefficients in a matrix format instead of extracting them within the loop. I used the following code.
QR <- function(varname, data){
y<-data[,varname]
q<-summary(rq(y~x, taus),se="boot")
z<-cbind(q[[1]]$coef[1,1], q[[2]]$coef[1,1],
q[[3]]$coef[1,1], q[[4]]$coef[1,1])
return(z)
}
taus <- c(.05,.1,.25,.75,.90,.95)
nsim<-10
SD<-c(1,3,5)
res<-array(NA,dim=c(nsim,10,3))
for (i in 1:3){
for (j in 1:nsim){
x<-rnorm(50,10,SD[i]); eN<-rnorm(50,0,SD[i]); eLN1<-rlnorm(50,0,SD[i]);
data<-data.frame(cbind(y1<-1+(2*x)+eN, y2<-1+(2*x)+eLN1, x))
colnames(data)<-c("y1", "y2","x")
listQR<-lapply(names(data)[1:2], function(x) QR(x, data))
write.csv(res, file="test.csv");
}
}

R: outer on array in first dimension

outer in R gives outer product of arrays. For example, for matrix A with dimension c(2, 3),
A <- matrix(1:6, 2, 3)
B <- outer(A, A, function(x,y) x + y)
B has dimension c(2, 3, 2, 3). But can I define a function myouter in a concise way to apply outer only in the first dimension, to get a matrix C?
C <- myouter(A, A, function(x,y) sum(x) + sum(y))
C can be obtained by the following tedious code.
C <- matrix(nrow = 2, ncol = 2)
for (i in 1:2) {
for (j in 1:2) {
C[i, j] <- sum(A[i, ])+ sum(A[j, ])
}
}

Resources