I was hoping to be able to construct a do.call
formula for subsetting without having to identify the actual range of every dimension in the input array.
The problem I'm running into is that I can't figure out how to mimic the direct function x[,,1:n,]
, where no entry in the other dimensions means "grab all elements."
Here's some sample code, which fails. So far as I can tell, either [
or do.call
replaces my NULL
list values with 1
for the index.
x<-array(1:6,c(2,3))
dimlist<-vector('list', length(dim(x)))
shortdim<-2
dimlist[[shortdim]] <- 1: (dim(x)[shortdim] -1)
flipped <- do.call(`[`,c(list(x),dimlist))
I suppose I could kludge a solution by assigning the value -2*max(dim(x))
to each element of dimlist
, but yuck.
(FWIW, I have alternate functions which do the desired job either via melt/recast
or the dreaded "build a string and then eval(parse(mystring))
, but I wanted to do it "better.")
Edit: as an aside, I ran a version of this code (with the equivalent of DWin's TRUE setup) against a function which used melt & acast
; the latter was several times slower to no real surprise.
After some poking around, alist
seems to do the trick:
x <- matrix(1:6, nrow=3)
x
[,1] [,2]
[1,] 1 4
[2,] 2 5
[3,] 3 6
# 1st row
do.call(`[`, alist(x, 1, ))
[1] 1 4
# 2nd column
do.call(`[`, alist(x, , 2))
[1] 4 5 6
From ?alist
:
‘alist’ handles its arguments as if they described function arguments. So the values are not evaluated, and tagged arguments with no value are allowed whereas ‘list’ simply ignores them. ‘alist’ is most often used in conjunction with ‘formals’.
alist
of the desired length, see here (Hadley, using bquote
) or here (using alist
).
m <- array(1:24, c(2,3,4))
ndims <- 3
a <- rep(alist(,)[1], ndims)
for(i in seq_len(ndims))
{
slice <- a
slice[[i]] <- 1
print(do.call(`[`, c(list(m), slice)))
}
[,1] [,2] [,3] [,4]
[1,] 1 7 13 19
[2,] 3 9 15 21
[3,] 5 11 17 23
[,1] [,2] [,3] [,4]
[1,] 1 7 13 19
[2,] 2 8 14 20
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6
I've always used TRUE
as a placeholder in this instance:
> x
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6
> do.call("[", list(x, TRUE,1))
[1] 1 2
Let's use a somewhat more complex x
example: x <- array(1:36, c(2,9,2)
, then if the desire is for a vector to be substituted in a list of subscripts that will recover all of the first and second dimensions and only the second "slice" of the third dimension:
shortdim <- 3
short.idx <- 2
dlist <- rep(TRUE, length(dim(x)) )
dlist <- as.list(rep(TRUE, length(dim(x)) ))
> dlist
[[1]]
[1] TRUE
[[2]]
[1] TRUE
[[3]]
[1] TRUE
> dlist[shortdim] <- 2
> do.call("[", c(list(x), dlist) )
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
[1,] 19 21 23 25 27 29 31 33 35
[2,] 20 22 24 26 28 30 32 34 36
Another point sometimes useful is that the logical indices get recycled so you can use c(TRUE,FALSE) to pick out every other item:
(x<-array(1:36, c(2,9,2)))
, , 1
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
[1,] 1 3 5 7 9 11 13 15 17
[2,] 2 4 6 8 10 12 14 16 18
, , 2
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
[1,] 19 21 23 25 27 29 31 33 35
[2,] 20 22 24 26 28 30 32 34 36
> x[TRUE,c(TRUE,FALSE), TRUE]
, , 1
[,1] [,2] [,3] [,4] [,5]
[1,] 1 5 9 13 17
[2,] 2 6 10 14 18
, , 2
[,1] [,2] [,3] [,4] [,5]
[1,] 19 23 27 31 35
[2,] 20 24 28 32 36
And further variations on every-other-item are possible. Try c(FALSE, FALSE, TRUE) to get every third item starting with item-3.
Not a straight answer, but I'll demo asub
as an alternative as I am pretty sure this is what the OP is eventually after.
library(abind)
Extract 1st row:
asub(x, idx = list(1), dims = 1)
Extract second and third column:
asub(x, idx = list(2:3), dims = 2)
Remove the last item from dimension shortdim
as the OP wanted:
asub(x, idx = list(1:(dim(x)[shortdim]-1)), dims = shortdim)
You can also use negative indexing so this will work too:
asub(x, idx = list(-dim(x)[shortdim]), dims = shortdim)
Last, I will mention that the function has a drop
option just like [
does.
Ok, here's the code for four versions, followed by microbenchmark
. The speed appears to be pretty much the same for all of these. I'd like to check all answers as accepted, but since I can't, here are the chintzy criteria used:
DWin loses because you have to enter "TRUE" for placeholders.
flodel loses because it requires a non-base library
My original loses, of course, because of eval(parse())
. So Hong Ooi wins. He advances to the next round of Who Wants to be a Chopped Idol :-)
flip1<-function(x,flipdim=1) {
if (flipdim > length(dim(x))) stop("Dimension selected exceeds dim of input")
a <-"x["
b<-paste("dim(x)[",flipdim,"]:1",collapse="")
d <-"]"
#now the trick: get the right number of commas
lead<-paste(rep(',',(flipdim-1)),collapse="")
follow <-paste(rep(',',(length(dim(x))-flipdim)),collapse="")
thestr<-paste(a,lead,b,follow,d,collapse="")
flipped<-eval(parse(text=thestr))
return(invisible(flipped))
}
flip2<-function(x,flipdim=1) {
if (flipdim > length(dim(x))) stop("Dimension selected exceeds dim of input")
dimlist<-vector('list', length(dim(x)) )
dimlist[]<-TRUE #placeholder to make do.call happy
dimlist[[flipdim]] <- dim(x)[flipdim]:1
flipped <- do.call(`[`,c(list(x),dimlist) )
return(invisible(flipped))
}
# and another...
flip3 <- function(x,flipdim=1) {
if (flipdim > length(dim(x))) stop("Dimension selected exceeds dim of input")
flipped <- asub(x, idx = list(dim(x)[flipdim]:1), dims = flipdim)
return(invisible(flipped))
}
#and finally,
flip4 <- function(x,flipdim=1) {
if (flipdim > length(dim(x))) stop("Dimension selected exceeds dim of input")
dimlist <- rep(list(bquote()), length(dim(x)))
dimlist[[flipdim]] <- dim(x)[flipdim]:1
flipped<- do.call(`[`, c(list(x), dimlist))
return(invisible(flipped))
}
Rgames> foo<-array(1:1e6,c(100,100,100))
Rgames> microbenchmark(flip1(foo),flip2(foo),flip3(foo),flip4(foo)
Unit: milliseconds
expr min lq median uq max neval
flip1(foo) 18.40221 18.47759 18.55974 18.67384 35.65597 100
flip2(foo) 21.32266 21.53074 21.76426 31.56631 76.87494 100
flip3(foo) 18.13689 18.18972 18.22697 18.28618 30.21792 100
flip4(foo) 21.17689 21.57282 21.73175 28.41672 81.60040 100
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With