Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to pass "nothing" as an argument to `[` for subsetting?

Tags:

r

subset

do.call

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.

like image 771
Carl Witthoft Avatar asked Jul 19 '13 16:07

Carl Witthoft


4 Answers

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’.


A way of dynamically selecting which dimension is extracted. To create the initial 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
like image 114
Hong Ooi Avatar answered Nov 15 '22 12:11

Hong Ooi


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.

like image 41
IRTFM Avatar answered Nov 15 '22 12:11

IRTFM


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.

like image 26
flodel Avatar answered Nov 15 '22 12:11

flodel


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
like image 40
Carl Witthoft Avatar answered Nov 15 '22 13:11

Carl Witthoft