Subscripting a matrix-like object

classic Classic list List threaded Threaded
2 messages Options
Reply | Threaded
Open this post in threaded view
|

Subscripting a matrix-like object

Jeffrey J. Hallman-2
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
}

______________________________________________
[hidden email] 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.
Reply | Threaded
Open this post in threaded view
|

Re: Subscripting a matrix-like object

Jeffrey J. Hallman-2
[hidden email] 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

______________________________________________
[hidden email] 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.