[Rd] difficulties with setMethod("[" and ...

James Bullard bullard at stat.Berkeley.EDU
Tue May 18 03:48:35 CEST 2010


Apologies if I am not understanding something about how things are being
handled when using S4 methods, but I have been unable to find an answer to
my problem for some time now.

Briefly, I am associating the generic '[' with a class which I wrote
(here: myExample). The underlying back-end allows me to read contiguous
slabs, e.g., 1:10, but not c(1, 10). I want to shield the user from this
infelicity, so I grab the slab and then subset in memory. The main problem
is with datasets with dim(.) > 2. In this case, the '...' argument doesn't
seem to be in a reasonable state. When it is indeed missing then it
properly reports that fact, however, when it is not missing it reports
that it is not missing, but then the call to: list(...) throws an argument
is missing exception.

I cannot imagine that this has not occurred before, so I am expecting
someone might be able to point me to some example code. I have attached
some code demonstrating my general problem ((A) and (B) below) as well as
the outline of the sub-selection code. I have to say that coding this has
proven non-trivial and any thoughts on cleaning up the mess are welcome.

As always, thanks for the help.

Jim

require(methods)

setClass('myExample', representation = representation(x = "array"))

myExample <- function(dims = c(1,2)) {
  a <- array(rnorm(prod(dims)))
  dim(a) <- dims
  obj <- new("myExample")
  obj at x <- a
  return(obj)
}

setMethod("dim", "myExample", function(x) return(dim(x at x)))

functionThatCanOnlyGrabContiguous <- function(x, m, kall) {
  kall$x <- x at x
  for (i in 1:nrow(m)) {
    kall[[i+2]] <- seq.int(m[i,1], m[i,2])
  }
  print(as.list(kall))
  return(eval(kall))
}

setMethod("[", "myExample", function(x, i, j, ..., drop = TRUE) {
  if (missing(...)){
    print("Missing!")
  }
  e <- list(...)
  m <- matrix(nrow = length(dim(x)), ncol = 2)

  if (missing(i))
    m[1,] <- c(1, dim(x)[1])
  else
    m[1,] <- range(i)

  if (length(dim(x)) > 1) {
    if (missing(j))
      m[2,] <- c(1, dim(x)[2])
    else
      m[2,] <- range(j)

    k <- 3
    while (k <= nrow(m)) {
      if (k-2 <= length(e))
        m[k,] <- range(e[[k-2]])
      else
        m[k,] <- c(1, dim(x)[k])
      k <- k + 1
    }
  }
  kall <- match.call()
  d <- functionThatCanOnlyGrabContiguous(x, m, kall)

  kall$x <- d
  if (! missing(i)) {
    kall[[3]] <- i - min(i) + 1
  }
  if (! missing(j)) {
    kall[[4]] <- j - min(j) + 1
  } else {
    if (length(dim(x)) > 1)
      kall[[4]] <- seq.int(1, dim(x)[2])
  }
  ## XXX: Have to handle remaining dimensions, but since I can't
  ## really get a clean '...' it is on hold.

  eval(kall)
})

## ############### 1-D
m <- myExample(10)
m at x[c(1,5)] == m[c(1, 5)]

## ############### 2-D
m <- myExample(c(10, 10))
m at x[c(1,5), c(1,5)] == m[c(1,5), c(1,5)]
m at x[c(5, 2),] == m[c(5,2),]

## ############### 3-D
m <- myExample(c(1,3,4))

## (A) doesn't work
m at x[1,1:2,] == m[1,1:2,]

## (B) nor does this for different reasons.
m[1,,1]
m at x[1,,1]

> sessionInfo()
R version 2.11.0 (2010-04-22)
x86_64-pc-linux-gnu

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C
 [3] LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8
 [5] LC_MONETARY=C              LC_MESSAGES=en_US.UTF-8
 [7] LC_PAPER=en_US.UTF-8       LC_NAME=C
 [9] LC_ADDRESS=C               LC_TELEPHONE=C
[11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base

loaded via a namespace (and not attached):
[1] tools_2.11.0



More information about the R-devel mailing list