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)))
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
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
}
}
How can I simply pad (append/prepend) a slice of NA's to a (say) 3D array along (say) dimension 2?
Suppose the initial array is given as
A <- array(1:8,c(2,2,2))
I initially thought this would work:
cbind(A,NA)
but it results in an 8x2 matrix instead of a 2x3x2 array. I then tried
abind(A,NA,along=2)
but that results in an error.
I'm hoping there is a much simpler solution than
dimSlice <- dim(A)
dimSlice[2] <- 1
abind(A,array(NA,dimSlice),along=2)
Background
This padding happens as part of a "remove slice and pad opposite side" operation that shifts an array by one position along some dimension, filling in with NA elements at the vacated positions. The one-dimensional equivalent would be, for example, c(A[-1],NA) for vector A, If there is a simple way to accomplish such an operation without an explicit padding sub-operation, that would be even better.
Subsetting with NAs results in NAs (?Extract):
v = 1:3; m = matrix(1:4, 2, 2); a = array(1:6, c(2, 2, 2))
v[c(NA, 1)]
#[1] NA 1
m[, c(2, NA)]
# [,1] [,2]
#[1,] 3 NA
#[2,] 4 NA
a[, c(1, 2, NA), ]
#, , 1
#
# [,1] [,2] [,3]
#[1,] 1 3 NA
#[2,] 2 4 NA
#
#, , 2
#
# [,1] [,2] [,3]
#[1,] 5 1 NA
#[2,] 6 2 NA
So, to pad with NAs, we could subset using the appropriate indices. Putting the above in a more general function to append/prepend "n" indices with NA in dimension "k" of an array:
pad = function(x, k, n = 1L, append = TRUE)
{
dims = replicate(length(dim(x)), substitute(), simplify = FALSE)
if(append) dims[[k]] = c((n + 1):dim(x)[[k]], rep_len(NA, n))
else dims[[k]] = c(rep_len(NA, n), 1:(dim(x)[[k]] - n))
do.call("[", c(list(x), dims))
}
arr = array(1:24, c(3, 2, 2, 2))
pad(arr, 1, 2, FALSE)
pad(arr, 2)
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, "+")
I'm trying to make this operation matrices, multiplying the first column with 2, 3 and 4, the first hold value, and then multiply the second column with 3 and 4, keep the value of the third and multiply the third column with 4. I want to do this without using a "for" loop, wanted to use functions like sapply or mapply. Does anyone have an idea how to do it?
Example with one line:
a[1,1]*(a[1,2], a[1,3], a[1,4]) = 2 4 4 4
a[1,1] a[1,2]*(a[1,3], a[1,4]) = 2 4 16 16 #keep a[1,1] a[1,2]
a[1,1] a[1,2] a[1,3] a[1,3]*(a[1,4]) = 2 4 16 256 # #keep a[1,1] a[1,2] a[1,3]
Input:
> a<- matrix(2,4,4) # or any else matrix like a<- matrix(c(1,8,10,1,4,1),3,3)
> a
[,1] [,2] [,3] [,4]
[1,] 2 2 2 2
[2,] 2 2 2 2
[3,] 2 2 2 2
[4,] 2 2 2 2
Output:
> a
[,1] [,2] [,3] [,4]
[1,] 2 4 16 256
[2,] 2 4 16 256
[3,] 2 4 16 256
[4,] 2 4 16 256
EDIT: LOOP VERSION
a<- matrix(2,4,4);
ai<-a[,1,drop=F];
b<- matrix(numeric(0),nrow(a),ncol(a)-1);
i<- 1;
for ( i in 1:(ncol(a)-1)){
a<- a[,1]*a[,-1,drop=F];
b[,i]<- a[,1];
}
b<- cbind(ai[,1],b);
b
If I understand correctly, what you are trying to do is, starting with a matrix A with N columns, perform the following steps:
Step 1. Multiply columns 2 through N of A by column 1 of A. Call the resulting matrix A1.
Step 2. Multiply columns 3 through N of A1 by column 2 of A1. Call the resulting matrix A2.
...
Step (N-1). Multiply column N of A(N-2) by column (N-1) of A(N-2). This is the desired result.
If this is indeed what you are trying to do, you need to either write a double for loop (which you want to avoid, as you say) or come up with some iterative method of performing the above steps.
The double for way would look something like this
DoubleFor <- function(m) {
res <- m
for(i in 1:(ncol(res)-1)) {
for(j in (i+1):ncol(res)) {
res[, j] <- res[, i] * res[, j]
}
}
res
}
Using R's vectorized operations, you can avoid the inner for loop
SingleFor <- function(m) {
res <- m
for(i in 1:(ncol(res)-1))
res[, (i+1):ncol(res)] <- res[, i] * res[, (i+1):ncol(res)]
res
}
When it comes to iterating a procedure, you may want to define a recursive function, or use Reduce. The recursive function would be something like
RecursiveFun <- function(m, i = 1) {
if (i == ncol(m)) return(m)
n <- ncol(m)
m[, (i+1):n] <- m[, (i+1):n] * m[, i]
Recall(m, i + 1) # Thanks to #batiste for suggesting using Recall()!
}
while Reduce would use a similar function without the recursion (which is provided by Reduce)
ReduceFun <- function(m) {
Reduce(function(i, m) {
n <- ncol(m)
m[, (i+1):n] <- m[, (i+1):n] * m[, i]
m
}, c((ncol(m)-1):1, list(m)), right = T)
}
These will all produce the same result, e.g. testing on your matrix
a <- matrix(c(1, 8, 10, 1, 4, 1), 3, 3)
DoubleFor(a)
# [,1] [,2] [,3]
# [1,] 1 1 1
# [2,] 8 32 2048
# [3,] 10 10 1000
all(DoubleFor(a) == SingleFor(a) & SingleFor(a) == RecursiveFun(a) &
RecursiveFun(a) == ReduceFun(a))
# [1] TRUE
Just out of curiosity, I did a quick speed comparison, but I don't think any one of the above will be significantly faster than the others for your size of matrices, so I would just go with the one you think is more readable.
a <- matrix(rnorm(1e6), ncol = 1e3)
system.time(DoubleFor(a))
# user system elapsed
# 22.158 0.012 22.220
system.time(SingleFor(a))
# user system elapsed
# 27.349 0.004 27.415
system.time(RecursiveFun(a))
# user system elapsed
# 25.150 1.336 26.534
system.time(ReduceFun(a))
# user system elapsed
# 26.574 0.004 26.626