[R] Subscripting a matrix-like object

[Jeffrey J. Hallman]

jhallman at frb.gov writes:

Answering my own question here, so you can ignore this unless you are
really interested in some fairly obscure stuff.  It turns out that this works:

singleIndex <- missing(j) && (length(sys.call()) == length(match.call()))

since sys.call() has an element for the empty argument created by

x[i,] <- value

and match.call() does not.  But it is pretty obscure.

Jeff

> I have an S3 class called "tis" (Time Indexed Series) which may or may
> not have multiple columns.  I have a function "[<-.tis" that I've
> reproduced below.  
>
> My question is this: inside of "[<-.tis", how can I distinguish between
> calls of the form 
>
> x[i] <- someValue
>
> and
>
> x[i,] <- someValue ?
>
> In either case, nargs() is 3, and looking at the values from sys.call()
> and match.call() I could not tell them apart.  Am I missing something?
>
>
> "[<-.tis" <- function(x, i, j, ..., value){
>   tif <- tif(x)
>   xStart <- start(x)
>   x <- stripTis(x)
>   if(missing(i)){
>     if(missing(j)) x[]   <- value
>     else           x[,j] <- value
>   }
>   else {
>     i <- i[!is.na(i)]
>     if(is.numeric(i)){
>       if(!is.ti(i) && couldBeTi(i, tif = tif))
>         i <- asTi(i)
>       if(is.ti(i)){
>         i <- i + 1 - xStart
>         if(any(i < 1)){
>           newRows <- 1 - min(i)
>           xStart <- xStart - newRows
>           if(is.null(m <- ncol(x)))  m <- 1
>           i <- i + newRows
>           if(is.matrix(x))
>             x <- rbind(matrix(NA, newRows, m), x)
>           else
>             x <- c(rep(NA, newRows), x)
>         }
>       }
>     }
>     else if(!is.logical(i)) stop("non-numeric, non-logical row index")
>    if(is.matrix(x)){
>       if(any(i > nrow(x))){
>         newRows <- max(i) - nrow(x)
>         x <- rbind(x, matrix(NA, newRows, ncol(x)))
>       }
>       if(missing(j)){
>         if(is.matrix(i))  x[i] <- value
>         else {
>           if(is.logical(i))
>             x[i,] <- rep(value, length = sum(i)*ncol(x))
>           else
>             x[i,] <- rep(value, length = length(i)*ncol(x))
>         }
>       }
>       else x[i,j] <- value
>     }
>     else x[i] <- value
>   }
>   start(x) <- xStart
>   class(x) <- c("tis", oldClass(x))
>   x
> }
>

-- 
Jeff