R devel - May 2010 - Subscripting a matrix-like object

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
}

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

> -----Original Message-----
> From: r-help-bounces at r-project.org 
> [mailto:r-help-bounces at r-project.org] On Behalf Of Jeffrey J. Hallman
> Sent: Friday, May 14, 2010 9:17 AM
> To: r-help at stat.math.ethz.ch
> Subject: Re: [R] Subscripting a matrix-like object
> 
> 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.
I was curious about this because in the version of R
I'm using (2.11.0, 2010-04-22), nargs() does distinguish
between x[i] and x[i,].  E.g., with the following
replacement function
  `[<-.foo` <- function (x, i, j, ..., value)
  {
      cat("[<-.foo: nargs=", nargs(), "\n", sep =
"")
      cat("         sys.call()=", deparse(sys.call()), "\n",
sep = "")
      cat("         missing(i)=", missing(i), "\n", sep =
"")
      cat("         missing(j)=", missing(j), "\n", sep =
"")
      x
  }
I get
  > fooObject <- structure(1:4, class="foo")
  > fooObject[1] <- 12
  [<-.foo: nargs=3
           sys.call()=`[<-.foo`(`*tmp*`, 1, value = 12)
           missing(i)=FALSE
           missing(j)=TRUE
  > fooObject[1,] <- 12
  [<-.foo: nargs=4
           sys.call()=`[<-.foo`(`*tmp*`, 1, , value = 12)
           missing(i)=FALSE
           missing(j)=TRUE
  > fooObject[,1] <- 12
  [<-.foo: nargs=4
           sys.call()=`[<-.foo`(`*tmp*`, , 1, value = 12)
           missing(i)=TRUE
           missing(j)=FALSE
  
Is this a bug in nargs() that was recently fixed?

sys.call() and especially match.call() are
fairly expensive functions to call so it would be nice
to be able to avoid them.

Bill Dunlap
Spotfire, TIBCO Software
wdunlap tibco.com  
> 
> 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
> 
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide 
> http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>