Given an n dimensional array X, a d by d-1 dimensional matrix V and two specified dimensions (p1, p2) <= (n, n); I would like a function that preforms matrix multiplication of V along the dimensions (p1, p2) of X.
That is given X:
library(abind)
set.seed(4)
X <- matrix(runif(4), 2, 2)
X <- abind(x, x+5, along = 3)
> a
, , 1
[,1] [,2]
[1,] 1 3
[2,] 2 4
, , 2
[,1] [,2]
[1,] 6 8
[2,] 7 9
and given a matrix V
V <- matrix(c(1, 2))
[,1]
[1,] 1
[2,] 2
For example, if p1=2 and p2=1 I would like to remove the following for loop
p1 <- 1
p2 <- 2
a.out <- array(0, c(2, 1, 2))
for (i in 1:dim(a)[2]){
a.out[,,i] <- a[,,i]%*%V # note indexed along other dimension
}
> a.out
, , 1
[,1]
[1,] 7
[2,] 10
, , 2
[,1]
[1,] 22
[2,] 25
The hard part here is that I want to allow for arbitrary dimensional arrays (i.e., n could be greater than 3).
1st Edit:
This problem is not the same as Indexing slice from 3D Rcpp NumericVector as I am discussing arbitrary number of dimensions >=2 and the question is not only about indexing.
2nd Edit:
Just to be a little more clear here is another example of what I am trying to do. Here the dimension of X is 4, p1 = 2, p3=3, and the dimension of X along the p1 dimension is 12. The following code computes the desired result as X.out for random X and V.
X <- array(rnorm(672), c(4, 7, 12, 2))
V <- matrix(rnorm(132), 12, 11) # p1 = 2, p2 = 3, V is of dimension D x D-1
d <- dim(X)
X.out <- array(0, dim=c(d[1:2], d[3]-1, d[4]))
for(i in 1:d[1]){
for (j in 1:d[4]){
X.out[i,,,j] <- X[i,,,j]%*%V # p1 = 2, p2 = 3
}
}
Related
Is there a compact and elegant way to create an adjacency matrix given a vector of the form shown (see code excerpt) in base R?
I give my best attempt below. Ideally, I would like to create the already-populated adjacency matrix in a single step as opposed to having to create the matrix data structure then fill it.
p <- 25 # Cardinality of vertex set; Number of nodes
hypothesis_path <- c(17, 7, 6, 1) # path in this form
path_to_D <- function(hypothesis_path, p) {
path_len <- length(hypothesis_path) - 1
idx_path <- t(sapply(1:path_len, function(i) hypothesis_path[i:(i+1)]))
D <- matrix(0, p, p); D[idx_path] <- 1
D
}
D <- path_to_D(hypothesis_path, p)
which(D == 1, arr.ind = TRUE)
# Desired indices of adjacency matrix are populated (with ones)
# row col
# [1,] 6 1
# [2,] 7 6
# [3,] 17 7
Acceptable answers will avoid use of igraph or similar and will use the path vector in the form given. That said, advice and alternatives are of course always welcomed and appreciated.
You can use a sparse matrix from the Matrix package. It is not base R but a very common package.
library(Matrix)
hypothesis_path <- c(17, 7, 6, 1)
D <- sparseMatrix(i = hypothesis_path[-length(hypothesis_path)],
j = hypothesis_path[-1])
which(D == 1, arr.ind = TRUE)
row col
[1,] 6 1
[2,] 7 6
[3,] 17 7
You can use the powerful but little-known trick of matrix-based indexing:
index_mat <- rbind(
c(1, 2),
c(2, 3),
c(3, 1)
)
mat <- matrix(FALSE, 3, 3)
mat[index_mat] <- TRUE
mat
[,1] [,2] [,3]
[1,] FALSE TRUE FALSE
[2,] FALSE FALSE TRUE
[3,] TRUE FALSE FALSE
So do this:
path_to_D <- function (path, p) {
indices <- cbind(path[-length(path)], path[-1])
D <- matrix(0, p, p)
D[indices] <- 1
D
}
D <- path_to_D(hypothesis_path, 25)
which(D == 1, arr.ind=TRUE)
row col
[1,] 6 1
[2,] 7 6
[3,] 17 7
I have two matrices, call them A (n x 2) and B (q x 2). I'd like to get an n x q x 2 array C, such that C[1,5,] represents the difference between the first row of A and the fifth row of B, taking the subtraction of the first element in the first row of A with the first element in the fifth row of B and the second element similarly subtracted.
I'm trying to perform this function via the outer function, but it also gives me the "non-diagonal" subtractions; i.e. it will also subtract A[1,1] - B[5,2] and A[1,2] - B[5,1] which I am not interested in. Does anyone have a fast, easy way to do this?
Current code
>diffs <- outer(A,B,FUN ='-')
>diffs[1,,5,]
[,1] [,2]
[1,] **-0.3808701** 0.7591052
[2,] 0.2629293 **1.4029046**
I've added the stars to indicate what I actually want.
Thanks for any help in advance
(EDIT)
Here's a simpler case for illustrative purposes
> A <- matrix(1:10, nrow = 5, ncol = 2)
> B <- matrix(4:9, nrow = 3, ncol = 2)
> A
[,1] [,2]
[1,] 1 6
[2,] 2 7
[3,] 3 8
[4,] 4 9
[5,] 5 10
> B
[,1] [,2]
[1,] 4 7
[2,] 5 8
[3,] 6 9
>diffs <- outer(A,B,FUN ='-')
>diffs[1,,3,] == (A[1,] - B[3,])
[,1] [,2]
[1,] TRUE FALSE
[2,] FALSE TRUE
>diffs[1,,3,]
[,1] [,2]
[1,] -5 -8
[2,] 0 -3
Before worrying about the shape of the output I think we should make sure we're getting the correct values.
A <- matrix(1:10, nrow=5, ncol=2)
B <- matrix(4:9, nrow=3, ncol=2)
# long-winded method
dia_long <- c(
c(A[1,] - B[1,]),
c(A[1,] - B[2,]),
c(A[1,] - B[3,]),
c(A[2,] - B[1,]),
c(A[2,] - B[2,]),
c(A[2,] - B[3,]),
c(A[3,] - B[1,]),
c(A[3,] - B[2,]),
c(A[3,] - B[3,]),
c(A[4,] - B[1,]),
c(A[4,] - B[2,]),
c(A[4,] - B[3,]),
c(A[5,] - B[1,]),
c(A[5,] - B[2,]),
c(A[5,] - B[3,]))
# loop method
comb <- expand.grid(1:nrow(A), 1:nrow(B))
dia_loop <- list()
for (i in 1:nrow(comb)) {
dia_loop[[i]] <- A[comb[i, 1], ] - B[comb[i, 2], ]
}
dia_loop <- unlist(dia_loop)
# outer/apply method
dia_outer <- apply(outer(A, B, FUN='-'), c(3, 1), diag)
# they all return the same values
all.identical <- function(l) {
all(sapply(2:length(l), FUN=function(x) identical(l[1], l[x])))
}
all.identical(lapply(list(dia_long, dia_loop, dia_outer), sort))
# TRUE
table(dia_long)
# dia_long
# -5 -4 -3 -2 -1 0 1 2 3
# 1 2 4 5 6 5 4 2 1
Are these the values you are looking for?
My solution: use nested lapply and sapply functions to extract the diagonals. I then needed to do some post-processing (not related to this specific problem), before I then turned it into an array. Should be noted that this is a q x 2 x n array, which turned out to be better for my purposes - this could be permuted with aperm from here though to solve the original question.
A <- matrix(1:10, nrow = 5, ncol = 2)
B <- matrix(4:9, nrow = 3, ncol = 2)
diffs <- outer(A,B, FUN = '-')
diffs <- lapply(X = 1:nrow(A),FUN = function(y){
t(sapply(1:ncol(B), FUN = function(x) diag(diffs[y,,x,])))})
diffs <- array(unlist(lapply(diffs, FUN = t)), dim = c(nrow(B),2,nrow(A)))
Let's say I have a matrix that looks like this, and I convert it into a dist class object (without diagonal), and then into a vector for later purposes.
m = matrix(c(0,1,2,3, 1,0,3,4, 2,3,0,5, 3,4,5,0), nrow=4)
#m:
[,1] [,2] [,3] [,4]
[1,] 0 1 2 3
[2,] 1 0 3 4
[3,] 2 3 0 5
[4,] 3 4 5 0
md = as.dist(m, diag=F)
# md:
1 2 3
2 1
3 2 3
4 3 4 5
mdv = as.vector(md)
# 1 2 3 3 4 5
I can access the original matrix as usual with [], and I could easily access the one-dimensional index (of, for example row 3, col 2) using m[ 3+((2-1)*4) ]. The dist object (and the vector) is one-dimensional, but composes only of the lower triangle of the original matrix (and also lacks one element from each original col/row, since the diagonal was removed).
How can I later access the equivalent element in the vector mdv? So e.g. how could I access the equivalent of m[3,2] (value 3) in the object mdv? (Not by the value, since there can be duplicate values, but by the index) Related Q&A resolve similar problems with as.matrix on the dist object, but that doesn't do it for me (since I need to deal with the vector).
Having the lower.tri(, diag = FALSE) distances-vector ("mdv") you could (1) find the respective dimensions of the distances-matrix ("m") and (2) convert the i + (j - 1)*nrow indices accordingly by subtracting the equivalent missing "upper.tri".
ff = function(x, i, j)
{
#assumes that 'x' is a valid distances vector that results in correct 'n'
n = (1 + sqrt(1 + 8 * length(x))) / 2
#make sure i >= j
ii = pmax(i, j); jj = pmin(i, j)
#insert 0s to handle 'i == j'
x = c(unlist(lapply(split(x, rep(seq_len(n - 1), (n - 1):1)),
function(X) c(0, X)), FALSE, FALSE), 0)
#subtract the missing `upper.tri` elements
x[(ii + (jj - 1L) * n) - cumsum(0:(n - 1))[jj]]
}
E.g.:
n = 3
m = matrix(0, n, n); m[lower.tri(m)] = runif(choose(n, 2)); m = m + t(m); x = c(as.dist(m))
m
# [,1] [,2] [,3]
#[1,] 0.0000000 0.3796833 0.5199015
#[2,] 0.3796833 0.0000000 0.4770344
#[3,] 0.5199015 0.4770344 0.0000000
m[cbind(c(2, 2, 3, 1), c(3, 2, 1, 2))]
#[1] 0.4770344 0.0000000 0.5199015 0.3796833
ff(x, c(2, 2, 3, 1), c(3, 2, 1, 2))
#[1] 0.4770344 0.0000000 0.5199015 0.3796833
n = 23
m = matrix(0, n, n); m[lower.tri(m)] = runif(choose(n, 2)); m = m + t(m); x = c(as.dist(m))
i = sample(seq_len(n), 25, TRUE); j = sample(seq_len(n), 25, TRUE)
all.equal(m[cbind(i, j)], ff(x, i, j))
#[1] TRUE
etc...
How about this function:
fun <- function(r, c){
stopifnot(r != c)
if(r > c) (r-2)*(r-1)/2 + c
else (c-2)*(c-1)/2 + r
}
mdv[fun(1, 2)] # 1
mdv[fun(2, 3)] # 3
mdv[fun(3, 4)] # 5
mdv[fun(2, 1)] # 1
mdv[fun(3, 2)] # 3
mdv[fun(1, 1)] # stop
Cases with r == c should be handled before applying fun. For convenience, You can write another function for handling this case.
I would like to add each coefficient of a vector to each different column of a matrix. For example, if I have a vector and a matrix:
x <- c(1,2,3)
M <- matrix(c(5,6,7), nrow = 3, ncol = 3)
I would like to in my new matrix M1 1+5 in the first column, 2+6 in the second and 3+7 in the last one.
Is there any function in R that does this task?
try this:
M + rep(x, each = nrow(M))
or this:
apply(M, 1, `+`, x)
result:
[,1] [,2] [,3]
[1,] 6 7 8
[2,] 7 8 9
[3,] 8 9 10
EDIT:
akrun commented on two other great solutions:
M + x[col(M)]
and
sweep(M, 2, x, "+")
is it possible to have a matrix of matrices in R? if yes, how should I define such matrix?
for example to have a 10 x 10 matrix, and each element of this matrix contains a matrix itself.
1) list/matrix Yes, create a list and give it dimensions using matrix:
m <- matrix(1:4, 2)
M <- matrix(list(m, 2*m, 3*m, 4*m), 2)
so element 1,1 of M is m:
> M[[1,1]]
[,1] [,2]
[1,] 1 3
[2,] 2 4
2) list/dim<- This also works:
M <- list(m, 2*m, 3*m, 4*m)
dim(M) <- c(2, 2)
3) array This is not quite what you asked for but depending on your purpose it might satisfy your need:
A <- array(c(m, 2*m, 3*m, 4*m), c(2, 2, 2, 2)) # 2x2x2x2 array
so element 1,1 is:
> A[1,1,,]
[,1] [,2]
[1,] 1 3
[2,] 2 4