Build a square-ish matrix with a specified number of cells - r

I would like to write a function that transforms an integer, n, (specifying the number of cells in a matrix) into a square-ish matrix that contain the sequence 1:n. The goal is to make the matrix as "square" as possible.
This involves a couple of considerations:
How to maximize "square"-ness? I was thinking of a penalty equal to the difference in the dimensions of the matrix, e.g. penalty <- abs(dim(mat)[1]-dim(mat)[2]), such that penalty==0 when the matrix is square and is positive otherwise. Ideally this would then, e.g., for n==12 lead to a preference for a 3x4 rather than 2x6 matrix. But I'm not sure the best way to do this.
Account for odd-numbered values of n. Odd-numbered values of n do not necessarily produce an obvious choice of matrix (unless they have an integer square root, like n==9. I thought about simply adding 1 to n, and then handling as an even number and allowing for one blank cell, but I'm not sure if this is the best approach. I imagine it might be possible to obtain a more square matrix (by the definition in 1) by adding more than 1 to n.
Allow the function to trade-off squareness (as described in #1) and the number of blank cells (as described in #2), so the function should have some kind of parameter(s) to address this trade-off. For example, for n==11, a 3x4 matrix is pretty square but not as square as a 4x4, but the 4x4 would have many more blank cells than the 3x4.
The function needs to optionally produce wider or taller matrices, so that n==12 can produce either a 3x4 or a 4x3 matrix. But this would be easy to handle with a t() of the resulting matrix.
Here's some intended output:
> makemat(2)
[,1]
[1,] 1
[2,] 2
> makemat(3)
[,1] [,2]
[1,] 1 3
[2,] 2 4
> makemat(9)
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
[3,] 3 6 9
> makemat(11)
[,1] [,2] [,3] [,4]
[1,] 1 4 7 10
[2,] 2 5 8 11
[3,] 3 6 9 12
Here's basically a really terrible start to this problem.
makemat <- function(n) {
n <- abs(as.integer(n))
d <- seq_len(n)
out <- d[n %% d == 0]
if(length(out)<2)
stop('n has fewer than two factors')
dim1a <- out[length(out)-1]
m <- matrix(1:n, ncol=dim1a)
m
}
As you'll see I haven't really been able to account for odd-numbered values of n (look at the output of makemat(7) or makemat(11) as described in #2, or enforce the "squareness" rule described in #1, or the trade-off between them as described in #3.

I think the logic you want is already in the utility function n2mfrow(), which as its name suggests is for creating input to the mfrow graphical parameter and takes an integer input and returns the number of panels in rows and columns to split the display into:
> n2mfrow(11)
[1] 4 3
It favours tall layouts over wide ones, but that is easily fixed via rev() on the output or t() on a matrix produced from the results of n2mfrow().
makemat <- function(n, wide = FALSE) {
if(isTRUE(all.equal(n, 3))) {
dims <- c(2,2)
} else {
dims <- n2mfrow(n)
}
if(wide)
dims <- rev(dims)
m <- matrix(seq_len(prod(dims)), nrow = dims[1], ncol = dims[2])
m
}
Notice I have to special-case n = 3 as we are abusing a function intended for another use and a 3x1 layout on a plot makes more sense than a 2x2 with an empty space.
In use we have:
> makemat(2)
[,1]
[1,] 1
[2,] 2
> makemat(3)
[,1] [,2]
[1,] 1 3
[2,] 2 4
> makemat(9)
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
[3,] 3 6 9
> makemat(11)
[,1] [,2] [,3]
[1,] 1 5 9
[2,] 2 6 10
[3,] 3 7 11
[4,] 4 8 12
> makemat(11, wide = TRUE)
[,1] [,2] [,3] [,4]
[1,] 1 4 7 10
[2,] 2 5 8 11
[3,] 3 6 9 12
Edit:
The original function padded seq_len(n) with NA, but I realised the OP wanted to have a sequence from 1 to prod(nrows, ncols), which is what the version above does. The one below pads with NA.
makemat <- function(n, wide = FALSE) {
if(isTRUE(all.equal(n, 3))) {
dims <- c(2,2)
} else {
dims <- n2mfrow(n)
}
if(wide)
dims <- rev(dims)
s <- rep(NA, prod(dims))
ind <- seq_len(n)
s[ind] <- ind
m <- matrix(s, nrow = dims[1], ncol = dims[2])
m
}

I think this function implicitly satisfies your constraints. The parameter can range from 0 to Inf. The function always returns either a square matrix with sides of ceiling(sqrt(n)), or a (maybe) rectangular matrix with rows floor(sqrt(n)) and just enough columns to "fill it out". The parameter trades off the selection between the two: if it is less than 1, then the second, more rectangular matrices are preferred, and if greater than 1, the first, always square matrices are preferred. A param of 1 weights them equally.
makemat<-function(n,param=1,wide=TRUE){
if (n<1) stop('n must be positive')
s<-sqrt(n)
bottom<-n-(floor(s)^2)
top<-(ceiling(s)^2)-n
if((bottom*param)<top) {
rows<-floor(s)
cols<-rows + ceiling(bottom / rows)
} else {
cols<-rows<-ceiling(s)
}
if(!wide) {
hold<-rows
rows<-cols
cols<-hold
}
m<-seq.int(rows*cols)
dim(m)<-c(rows,cols)
m
}
Here is an example where the parameter is set to default, and equally trades off the distance equally:
lapply(c(2,3,9,11),makemat)
# [[1]]
# [,1] [,2]
# [1,] 1 2
#
# [[2]]
# [,1] [,2]
# [1,] 1 3
# [2,] 2 4
#
# [[3]]
# [,1] [,2] [,3]
# [1,] 1 4 7
# [2,] 2 5 8
# [3,] 3 6 9
#
# [[4]]
# [,1] [,2] [,3] [,4]
# [1,] 1 4 7 10
# [2,] 2 5 8 11
# [3,] 3 6 9 12
Here is an example of using the param with 11, to get a 4x4 matrix.
makemat(11,3)
# [,1] [,2] [,3] [,4]
# [1,] 1 5 9 13
# [2,] 2 6 10 14
# [3,] 3 7 11 15
# [4,] 4 8 12 16

What about something fairly simple and you can handle the exceptions and other requests in a wrapper?
library(taRifx)
neven <- 8
nodd <- 11
nsquareodd <- 9
nsquareeven <- 16
makemat <- function(n) {
s <- seq(n)
if( odd(n) ) {
s[ length(s)+1 ] <- NA
n <- n+1
}
sq <- sqrt( n )
dimx <- ceiling( sq )
dimy <- floor( sq )
if( dimx*dimy < length(s) ) dimy <- ceiling( sq )
l <- dimx*dimy
ldiff <- l - length(s)
stopifnot( ldiff >= 0 )
if( ldiff > 0 ) s[ seq( length(s) + 1, length(s) + ldiff ) ] <- NA
matrix( s, nrow = dimx, ncol = dimy )
}
> makemat(neven)
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
[3,] 3 6 NA
> makemat(nodd)
[,1] [,2] [,3]
[1,] 1 5 9
[2,] 2 6 10
[3,] 3 7 11
[4,] 4 8 NA
> makemat(nsquareodd)
[,1] [,2] [,3]
[1,] 1 5 9
[2,] 2 6 NA
[3,] 3 7 NA
[4,] 4 8 NA
> makemat(nsquareeven)
[,1] [,2] [,3] [,4]
[1,] 1 5 9 13
[2,] 2 6 10 14
[3,] 3 7 11 15
[4,] 4 8 12 16

Related

Split a matrix in blocks of size n with offset i (vectorized method)

I want to split matrices of size k x l into blocks of size n x n considering an ofset o (Like Mathematica's Partition function does).
For example, given a matrix A like
A <- matrix(seq(1:16), nrow = 4, ncol = 4)
[,1] [,2] [,3] [,4]
[1,] 1 5 9 13
[2,] 2 6 10 14
[3,] 3 7 11 15
[4,] 4 8 12 16
and block size = 3, offset = 1, I want as output the four submatrices that I'd get from
A[1:3, 1:3]
A[1:3, 2:4]
A[2:4, 1:3]
A[2:4, 2:4]
If offset were equal to 2 or 3, the output for this example should be only the submatrix that I get from
A[1:3, 1:3]
How can I vectorize this?
There might be a more elegant way. Here is how I'd do it by writing a myPartition function which simulates the mathematica Partition function. Firstly use Map to construct possible index along the row and column axis where we use seq to take offset into consideration, and then use cross2 from purrr to construct a list of all possible combinations of the subset index. Finally use lapply to subset the matrix and return a list of subset matrix;
The testing results on offset 1, 2 and 3 are as follows which seems to behave as expected:
library(purrr)
ind <- function(k, n, o) Map(`:`, seq(1, k-n+1, by = o), seq(n, k, by = o))
# this is a little helper function that generates subset index according to dimension of the
# matrix, the first sequence construct the starting point of the subset index with an interval
# of o which is the offset while the second sequence construct the ending point of the subset index
# use Map to construct vector from start to end which in OP's case will be 1:3 and 2:4.
myPartition <- function(mat, n, o) {
lapply(cross2(ind(nrow(mat),n,o), ind(ncol(mat),n,o)), function(i) mat[i[[1]], i[[2]]])
}
# This is basically an lapply. we use cross2 to construct combinations of all subset index
# which will be 1:3 and 1:3, 1:3 and 2:4, 2:4 and 1:3 and 2:4 and 2:4 in OP's case. Use lapply
# to loop through the index and subset.
# Testing case for offset = 1
myPartition(A, 3, 1)
# [[1]]
# [,1] [,2] [,3]
# [1,] 1 5 9
# [2,] 2 6 10
# [3,] 3 7 11
# [[2]]
# [,1] [,2] [,3]
# [1,] 2 6 10
# [2,] 3 7 11
# [3,] 4 8 12
# [[3]]
# [,1] [,2] [,3]
# [1,] 5 9 13
# [2,] 6 10 14
# [3,] 7 11 15
# [[4]]
# [,1] [,2] [,3]
# [1,] 6 10 14
# [2,] 7 11 15
# [3,] 8 12 16
# Testing case for offset = 2
myPartition(A, 3, 2)
# [[1]]
# [,1] [,2] [,3]
# [1,] 1 5 9
# [2,] 2 6 10
# [3,] 3 7 11
# Testing case for offset = 3
myPartition(A, 3, 3)
# [[1]]
# [,1] [,2] [,3]
# [1,] 1 5 9
# [2,] 2 6 10
# [3,] 3 7 11
How about this using base R, the idea is to generate all possible windows (i.e. winds) of size n*n while taking into account the offset. Then print all possible permutations of winds's elements in matrix A (i.e. perms). It works for any A of size k*l.
A <- matrix(seq(1:16), nrow = 4, ncol = 4)
c <- ncol(A); r <- nrow(A)
offset <- 1; size <- 3
sq <- seq(1, max(r,c), offset)
winds <- t(sapply(sq, function(x) c(x,(x+size-1))))
winds <- winds[winds[,2]<=max(r, c),] # check the range
if (is.vector(winds)) dim(winds) <- c(1,2) # vector to matrix
perms <- expand.grid(list(1:nrow(winds), 1:nrow(winds)))
out=apply(perms, 1, function(x) {
a11 <- winds[x[1],1];a12 <- winds[x[1],2];a21 <- winds[x[2],1];a22 <- winds[x[2],2]
if (ifelse(r<c, a12<=r, a22<=c)) { # check the range
cat("A[", a11, ":", a12, ", ", a21, ":", a22, "]", sep="", "\n")
print(A[a11:a12, a21:a22])
}
})
# A[1:3, 1:3]
# [,1] [,2] [,3]
# [1,] 1 5 9
# [2,] 2 6 10
# [3,] 3 7 11
# A[2:4, 1:3]
# [,1] [,2] [,3]
# [1,] 2 6 10
# [2,] 3 7 11
# [3,] 4 8 12
# A[1:3, 2:4]
# [,1] [,2] [,3]
# [1,] 5 9 13
# [2,] 6 10 14
# [3,] 7 11 15
# A[2:4, 2:4]
# [,1] [,2] [,3]
# [1,] 6 10 14
# [2,] 7 11 15
# [3,] 8 12 16
For size=3 and offset=2 or offset=3:
# A[1:3, 1:3]
# [,1] [,2] [,3]
# [1,] 1 5 9
# [2,] 2 6 10
# [3,] 3 7 11
For offset=2 and size=2:
# A[1:2, 1:2]
# [,1] [,2]
# [1,] 1 5
# [2,] 2 6
# A[3:4, 1:2]
# [,1] [,2]
# [1,] 3 7
# [2,] 4 8
# A[1:2, 3:4]
# [,1] [,2]
# [1,] 9 13
# [2,] 10 14
# A[3:4, 3:4]
# [,1] [,2]
# [1,] 11 15
# [2,] 12 16

How to slice a n dimensional array with a m*(n-i) dimensional matrix?

If i have a n dimensional array it can be sliced by a m * n matrix like this
a <- array(1:27,c(3,3,3))
b <- matrix(rep(1:3,3),3)
# This will return the index a[1,1,1] a[2,2,2] and a[3,3,3]
a[b]
# Output
[1] 1 14 27
Is there any "effective and easy" way to do a similar slice but to keep some dimensions free?
That is slice a n dimensional array with a m * (n-i) dimensional array and
get a i+1 dimensional array as result.
a <- array(1:27,c(3,3,3))
b <- matrix(rep(1:2,2),2)
# This will return a vector of the index a[1] a[2] a[1] and a[2]
a[b]
# Output
[1] 1 2 1 2
# This will return the indexes of the cartesian product between the vectors,
# that is a array consisting of a[1,,1] a[1,,2] a[2,,1] and a[2,,2]
a[c(1,2),,c(1,2)]
# Output
, , 1
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
, , 2
[,1] [,2] [,3]
[1,] 10 13 16
[2,] 11 14 17
The desired result should be if the last command returned an array
with a[1,,1] and a[2,,2].
For now I solve this the problem with a for loop and abind but I'm sure there must be a better way.
# Desired functionality
a <- array(1:27,c(3,3,3))
b <- array(c(c(1,2),c(1,2)),c(2,2))
sliceem(a,b,freeDimension=2)
# Desired output (In this case rbind(a[1,,1],a[2,,2]) )
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 11 14 17
I think this is the cleanest way -- making a separate function:
slicem <- function(a,idx,drop=FALSE) do.call(`[`,c(list(a),idx,list(drop=drop)))
# usage for OP's example
a <- array(1:27, c(3,3,3))
idx <- list(1:2, TRUE, 1:2)
slicem(a,idx)
which gives
, , 1
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
, , 2
[,1] [,2] [,3]
[1,] 10 13 16
[2,] 11 14 17
You have to write TRUE for each dimension that you aren't selecting from.
Following the OP's new expectations...
library(abind)
nistfun <- function(a,list_o_idx,drop=FALSE){
lens <- lengths(list_o_idx)
do.call(abind, lapply(seq.int(max(lens)), function(i)
slicem(a, mapply(`[`, list_o_idx, pmin(lens,i), SIMPLIFY=FALSE), drop=drop)
))
}
# usage for OP's new example
nistfun(a, idx)
# , , 1
#
# [,1] [,2] [,3]
# [1,] 1 4 7
#
# , , 2
#
# [,1] [,2] [,3]
# [1,] 11 14 17
Now, any non-TRUE indices must have the same length, since they will be matched up.
abind is used here instead of rbind (see an earlier edit on this answer) because it is the only sensible general way to think about slicing up an array. If you really want to drop dimensions, it's quite ambiguous which should be dropped and how, so the vector alone is returned:
nistfun(a, idx, drop=TRUE)
# [1] 1 4 7 11 14 17
If you want to throw this back into an array of some sort, you can do that after the fact:
matrix( nistfun(a, idx), max(lengths(idx)), dim(a)[sapply(idx,isTRUE)]), byrow=TRUE)
# [,1] [,2] [,3]
# [1,] 1 4 7
# [2,] 11 14 17

Nested for loop for evaluating surrounding cells of matrix in R

I have a 7x7 matrix:
Mat<-matrix(nrow=7,ncol=7)
With certain elements:
Mat[2,2]<-37
Mat[2,4]<-39
Mat[2,6]<-24
Mat[4,2]<-35
Mat[4,4]<-36
Mat[4,6]<-26
Mat[6,2]<-26
Mat[6,4]<-31
Mat[6,6]<-39
I am generating random elements and want to test if they add up to the specified values
I have written the following code:
TF<-c()
TF[1]<-isTRUE(Mat[2,2]==sum(Mat[1,1],Mat[1,2],Mat[1,3],Mat[2,1],Mat[2,3],Mat[3,1],Mat[3,2],Mat[3,3]))
TF[2]<-isTRUE(Mat[2,4]==sum(Mat[1,3],Mat[1,4],Mat[1,5],Mat[2,3],Mat[2,5],Mat[3,3],Mat[3,4],Mat[3,5]))
TF[3]<-isTRUE(Mat[2,6]==sum(Mat[1,5],Mat[1,6],Mat[1,7],Mat[2,5],Mat[2,7],Mat[3,5],Mat[3,6],Mat[3,7]))
TF[4]<-isTRUE(Mat[4,2]==sum(Mat[3,1],Mat[3,2],Mat[3,3],Mat[4,3],Mat[4,5],Mat[5,1],Mat[5,2],Mat[5,3]))
TF[5]<-isTRUE(Mat[4,4]==sum(Mat[3,3],Mat[3,4],Mat[3,5],Mat[4,3],Mat[4,5],Mat[5,3],Mat[5,4],Mat[5,5]))
TF[6]<-isTRUE(Mat[4,6]==sum(Mat[3,5],Mat[3,6],Mat[3,7],Mat[4,5],Mat[4,7],Mat[5,5],Mat[5,6],Mat[5,7]))
TF[7]<-isTRUE(Mat[6,2]==sum(Mat[5,1],Mat[5,2],Mat[5,3],Mat[6,1],Mat[6,3],Mat[7,1],Mat[7,2],Mat[7,3]))
TF[8]<-isTRUE(Mat[6,4]==sum(Mat[5,3],Mat[5,4],Mat[5,5],Mat[6,3],Mat[6,5],Mat[7,3],Mat[7,4],Mat[7,5]))
TF[9]<-isTRUE(Mat[6,6]==sum(Mat[5,5],Mat[5,6],Mat[5,7],Mat[6,5],Mat[6,7],Mat[7,5],Mat[7,6],Mat[7,7]))
Now i am trying to make it more efficient with a nested for loop:
O<-c(2,4,6)
for (G in O)
{
for (H in O)
{
TF[]<-isTRUE(Mat[G,H]==sum(Mat[G-1,H-1],Mat[G-1,H],Mat[G-1,H+1],Mat[G,H-1],Mat[G,H+1],Mat[G+1,H-1],Mat[G+1,H],Mat[G+1,H+1]))
}
}
The problem is that the vector element will be overwritten and it does not make any sense to add another for loop.
I also have problem to find a way to rerun the simulation if one false is found.
Let's start first by answering the following question:
How do you compute the sum of every surrounding cell for each cell in a matrix?
This is actually not trivial as far as I can tell (curious to see if anyone else comes up with something cool). Here is a potential solution, though not even close to being succinct. Let's start by seeing the results of the function. Here we will create matrices of only 1 so we can check that the results make sense (corners should add to 3 since there are only three contiguous cells, insides to 8, etc.):
> compute_neighb_sum(matrix(1, nrow=3, ncol=3))
[,1] [,2] [,3]
[1,] 3 5 3
[2,] 5 8 5
[3,] 3 5 3
> compute_neighb_sum(matrix(1, nrow=3, ncol=5))
[,1] [,2] [,3] [,4] [,5]
[1,] 3 5 5 5 3
[2,] 5 8 8 8 5
[3,] 3 5 5 5 3
> compute_neighb_sum(matrix(1, nrow=7, ncol=7))
[,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,] 3 5 5 5 5 5 3
[2,] 5 8 8 8 8 8 5
[3,] 5 8 8 8 8 8 5
[4,] 5 8 8 8 8 8 5
[5,] 5 8 8 8 8 8 5
[6,] 5 8 8 8 8 8 5
[7,] 3 5 5 5 5 5 3
This works!
Now, let's answer your actual question:
compute_neighb_sum(mx) == mx
and this should return TRUE for all cells that are equal to the sum of their surroundings. Lets confirm:
mx <- matrix(1, nrow=7, ncol=7)
mx[cbind(c(3, 6), c(3, 6))] <- 8 # make two interior cells equal two 8, which will be equal to sum of surroundings
which(compute_neighb_sum(mx) == mx, arr.ind=T) # you should look at `mx` to see what's going on
Sure enough, we get back the coordinates that we expect:
row col
[1,] 3 3
[2,] 6 6
Now, here is the function:
compute_neighb_sum <- function(mx) {
mx.ind <- cbind( # create a 2 wide matrix of all possible indices in input
rep(seq.int(nrow(mx)), ncol(mx)),
rep(seq.int(ncol(mx)), each=nrow(mx))
)
sum_neighb_each <- function(x) {
near.ind <- cbind( # for each x, y coord, create an index of all surrounding values
rep(x[[1]] + -1:1, 3),
rep(x[[2]] + -1:1, each=3)
)
near.ind.val <- near.ind[ # eliminate out of bound values, or the actual x,y coord itself
!(
near.ind[, 1] < 1 | near.ind[, 1] > nrow(mx) |
near.ind[, 2] < 1 | near.ind[, 2] > ncol(mx) |
(near.ind[, 1] == x[[1]] & near.ind[, 2] == x[[2]])
),
]
sum(mx[near.ind.val]) # Now sum the surrounding cell values
}
`dim<-`( # this is just to return in same matrix format as input
sapply(
split(mx.ind, row(mx.ind)), # For each x, y coordinate in input mx
sum_neighb_each # compute the neighbor sum
),
c(nrow(mx), ncol(mx)) # dimensions of input
)
}

Blockwise sum of matrix elements

I want to go from something like this:
1> a = matrix(c(1,4,2,5,2,5,2,1,4,4,3,2,1,6,7,4),4)
1> a
[,1] [,2] [,3] [,4]
[1,] 1 2 4 1
[2,] 4 5 4 6
[3,] 2 2 3 7
[4,] 5 1 2 4
To something like this:
[,1] [,2]
[1,] 12 15
[2,] 10 16
...without using for-loops, plyr, or otherwise without looping. Possible? I'm trying to shrink a geographic lat/long dataset from 5 arc-minutes to half-degree, and I've got an ascii grid. A little function where I specify blocksize would be great. I've got hundreds of such files, so things that allow me to do it quickly without parallelization/supercomputers would be much appreciated.
You can use matrix multiplication for this.
# Computation matrix:
mat <- function(n, r) {
suppressWarnings(matrix(c(rep(1, r), rep(0, n)), n, n/r))
}
Square-matrix example, uses a matrix and its transpose on each side of a:
# Reduce a 4x4 matrix by a factor of 2:
x <- mat(4, 2)
x
## [,1] [,2]
## [1,] 1 0
## [2,] 1 0
## [3,] 0 1
## [4,] 0 1
t(x) %*% a %*% x
## [,1] [,2]
## [1,] 12 15
## [2,] 10 16
Non-square example:
b <- matrix(1:24, 4 ,6)
t(mat(4, 2)) %*% b %*% mat(6, 2)
## [,1] [,2] [,3]
## [1,] 14 46 78
## [2,] 22 54 86
tapply(a, list((row(a) + 1L) %/% 2L, (col(a) + 1L) %/% 2L), sum)
# 1 2
# 1 12 15
# 2 10 16
I used 1L and 2L instead of 1 and 2 so indices remain integers (as opposed to numerics) and it should run faster that way.
I guess that might help you, but still it uses sapply which can be considered as loop-ish tool.
a <- matrix(c(1,4,2,5,2,5,2,1,4,4,3,2,1,6,7,4),4)
block.step <- 2
res <- sapply(seq(1, nrow(a), by=block.step), function(x)
sapply(seq(1, nrow(a), by=block.step), function(y)
sum(a[x:(x+block.step-1), y:(y+block.step-1)])
)
)
res
Is it anyhow helpful ?

Form matrix from rows in 3-dimensional array

I have X, a three-dimensional array in R. I want to take a vector of indices indx (length equal to dim(X)[1]) and form a matrix where the first row is the first row of X[ , , indx[1]], the second row is the second row of X[ , , indx[2]], and so on.
For example, I have:
R> X <- array(1:18, dim = c(3, 2, 3))
R> X
, , 1
[,1] [,2]
[1,] 1 4
[2,] 2 5
[3,] 3 6
, , 2
[,1] [,2]
[1,] 7 10
[2,] 8 11
[3,] 9 12
, , 3
[,1] [,2]
[1,] 13 16
[2,] 14 17
[3,] 15 18
R> indx <- c(2, 3, 1)
My desired output is
R> rbind(X[1, , 2], X[2, , 3], X[3, , 1])
[,1] [,2]
[1,] 7 10
[2,] 14 17
[3,] 3 6
As of now I'm using the inelegant (and slow) sapply(1:dim(X)[2], function(x) X[cbind(1:3, x, indx)]). Is there any way to do this using the built-in indexing functions? I had no luck experimenting with the matrix indexing methods described in ?Extract, but I may just be doing it wrong.
Maybe like this:
t(sapply(1:3,function(x) X[,,idx][x,,x]))
I may be answering the wrong question (I can't reconcile your first description and your sample output)... This produces your sample output, but I can't say that it's much faster without running it on your data.
do.call(rbind, lapply(1:dim(X)[1], function(i) X[i, , indx[i]]))
Matrix indexing to the rescue! No applys needed.
Figure out which indices you want:
n <- dim(X)[2]
foo <- cbind(rep(seq_along(indx),n),
rep(seq.int(n), each=length(indx)),
rep(indx,n))
(the result is this)
[,1] [,2] [,3]
[1,] 1 1 2
[2,] 2 1 3
[3,] 3 1 1
[4,] 1 2 2
[5,] 2 2 3
[6,] 3 2 1
and use it as index, converting back to a matrix to make it look like your output.
> matrix(X[foo],ncol=n)
[,1] [,2]
[1,] 7 10
[2,] 14 17
[3,] 3 6

Resources