How to use `[` without evaluating the arguments.

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

How to use `[` without evaluating the arguments.

Eeles, Christopher
Hello R-devel,

I am currently attempting to implement an API similar to data.table wherein single bracket subsetting can accept an unquoted expression to be evaluated in the context of my object.

A simple example from the data.table package looks like this:


DT <- data.table(col1 = c('a', 'b', 'c'), col2 = c('x', 'y', 'z'))
DT[col1 == 'a']

Where the expression i in DT[i, j] is captured with substitute then evaluated inside the DT object.

Reviewing the source code from data.table, it seems that they implemented this feature simple by defining a new S3 method on `[` called `[.data.table`. I tried to replicate this API as follows.

I have defined an S4 which contains an S3 class as follows:


#' Define an S3 Class
#'
#' Allows use of S3 methods with new S4 class. This is required to overcome
#' limitations of the `[` S4 method.
#'
setOldClass('long.table')

#' LongTable class definition
#'
#' Define a private constructor method to be used to build a `LongTable` object.
#'
#' @param drugs [`data.table`]
#' @param cells [`data.table`]
#' @param assays [`list`]
#' @param metadata [`list`]
#'
#'
#' @return [`LongTable`] object containing the assay data from a
#'
#' @import data.table
#' @keywords internal
.LongTable <- setClass("LongTable",
                       slots=list(rowData='data.table',
                                  colData='data.table',
                                  assays='list',
                                  metadata='list',
                                  .intern='environment'),
                       contains='long.table')

#' LongTable constructor method
#'
#' @param rowData [`data.table`, `data.frame`, `matrix`] A table like object
#'   coercible to a `data.table` containing the a unique `rowID` column which
#'   is used to key assays, as well as additional row metadata to subset on.
#' @param rowIDs [`character`, `integer`] A vector specifying
#'   the names or integer indexes of the row data identifier columns. These
#'   columns will be pasted together to make up the row.names of the
#'   `LongTable` object.
#' @param colData [`data.table`, `data.frame`, `matrix`] A table like object
#'   coercible to a `data.table` containing the a unique `colID` column which
#'   is used to key assays, as well as additional column metadata to subset on.
#' @param colIDs [`character`, `integer`] A vector specifying
#'   the names or integer indexes of the col data identifier columns. These
#'   columns will be pasted together to make up the col.names of the
#'   `LongTable` object.
#' @param assays A [`list`] containing one or more objects coercible to a
#'   `data.table`, and keyed by rowID and colID corresponding to the rowID and
#'   colID columns in colData and rowData.
#' @param metadata A [`list`] of metadata associated with the `LongTable`
#'   object being constructed
#' @param keep.rownames [`logical` or `character`] Logical: whether rownames
#'   should be added as a column if coercing to a `data.table`, default is FALSE.
#'   If TRUE, rownames are added to the column 'rn'. Character: specify a custom
#'   column name to store the rownames in.
#'
#' @return [`LongTable`] object
#'
#' @import data.table
#' @export
LongTable <- function(rowData, rowIDs, colData, colIDs, assays,
                      metadata=list(), keep.rownames=FALSE) {

    ## TODO:: Handle missing parameters

    if (!is(colData, 'data.table')) {
        colData <- data.table(colData, keep.rownames=keep.rownames)
    }

    if (!is(rowData, 'data.table')) {
        rowData <- data.table(rowData, keep.rownames=keep.rownames)
    }

    if (!all(vapply(assays, FUN=is.data.table, FUN.VALUE=logical(1)))) {
        tryCatch({
            assays <- lapply(assays, FUN=data.table, keep.rownames=keep.rownames)
        }, warning = function(w) {
            warning(w)
        }, error = function(e, assays) {
            message(e)
            types <- lapply(assays, typeof)
            stop(paste0('List items are types: ',
                        paste0(types, collapse=', '),
                        '\nPlease ensure all items in the assays list are
                        coerced to data.tables!'))
        })
    }

    # Initialize the .internals object to store private metadata for a LongTable
    internals <- new.env()

    ## TODO:: Implement error handling
    internals$rowIDs <-
        if (is.numeric(rowIDs) && max(rowIDs) < ncol(rowData))
            rowIDs
        else
            which(colnames(rowData) %in% rowIDs)
    lockBinding('rowIDs', internals)

    internals$colIDs <-
        if (is.numeric(colIDs) && max(colIDs) < ncol(colData))
            colIDs
        else
            which(colnames(colData) %in% colIDs)
    lockBinding('colIDs', internals)

    # Assemble the pseudo row and column names for the LongTable
    .pasteColons <- function(...) paste(..., collapse=':')
    rowData[, `:=`(.rownames=mapply(.pasteColons, transpose(.SD))), .SDcols=internals$rowIDs]
    colData[, `:=`(.colnames=mapply(.pasteColons, transpose(.SD))), .SDcols=internals$colIDs]

    return(.LongTable(rowData=rowData, colData=colData,
                      assays=assays, metadata=metadata,
                      .intern=internals))
}

I have also defined a subset method as an S3 and S4 generic:


#' Subset method for a LongTable object.
#'
#' Allows use of the colData and rowData `data.table` objects to query based on
#'  rowID and colID, which is then used to subset all value data.tables stored
#'  in the dataList slot.
#'
#' This function is endomorphic, it always returns a LongTable object.
#'
#' @param x [`LongTable`] The object to subset.
#' @param rowQuery [`character`, `numeric`, `logical` or `expression`]
#'  Character: pass in a character vector of drug names, which will subset the
#'      object on all row id columns matching the vector.
#'
#'  Numeric or Logical: these select based on the rowKey from the `rowData`
#'      method for the `LongTable`.
#'
#'  Expression: Accepts valid query statements to the `data.table` i parameter,
#'      this can be used to make complex queries using the `data.table` API
#'      for the `rowData` data.table.
#'
#' @param columnQuery [`character`, `numeric`, `logical` or `expression`]
#'  Character: pass in a character vector of drug names, which will subset the
#'      object on all drug id columns matching the vector.
#'
#'  Numeric or Logical: these select base don the rowID from the `rowData`
#'      method for the `LongTable`.
#'
#'  Expression: Accepts valid query statements to the `data.table` i parameter,
#'      this can be used to make complex queries using the `data.table` API
#'      for the `rowData` data.table.
#'
#' @param values [`character`, `numeric` or `logical`] Optional list of value
#'      names to subset. Can be used to subset the dataList column further,
#'      returning only the selected items in the new LongTable.
#'
#' @return [`LongTable`] A new `LongTable` object subset based on the specified
#'      parameters.
#'
#' @importMethodsFrom BiocGenerics subset
#' @import data.table
#' @export
subset.long.table <- function(x, rowQuery, columnQuery, assays) {

    longTable <- x
    rm(x)

    if (!missing(rowQuery)) {
        if (tryCatch(is.character(rowQuery), error=function(e) FALSE)) {
            select <- grep('^cellLine[:digit:]*', colnames(rowData(longTable)), value=TRUE)
            rowQueryString <- paste0(paste0(select, ' %in% ', .variableToCodeString(rowQuery)), collapse=' | ')
            rowQuery <- str2lang(rowQueryString)
        } else {
            rowQuery <- substitute(rowQuery)
        }
        rowDataSubset <- rowData(longTable)[eval(rowQuery), ]
    } else {
        rowDataSubset <- rowData(longTable)
    }

    if (!missing(columnQuery)) {
        if (tryCatch(is.character(columnQuery), error=function(e) FALSE)) {
            select <- grep('^drug[:digit:]*', colnames(colData(longTable)), value=TRUE)
            columnQueryString <- paste0(paste0(select, ' %in% ', .variableToCodeString(columnQuery)), collapse=' | ')
            columnQuery <- str2lang(columnQueryString)
        } else {
            columnQuery <- substitute(columnQuery)
        }
        colDataSubset <- colData(longTable)[eval(columnQuery), ]
    } else {
        colDataSubset <- colData(longTable)
    }

    rowKeys <- rowDataSubset$rowKey
    colKeys <- colDataSubset$colKey

    if (missing(assays)) { assays <- assayNames(longTable) }
    keepAssays <- assayNames(longTable) %in% assays

    assayData <- lapply(assays(longTable)[keepAssays],
                     FUN=.filterLongDataTable,
                     indexList=list(rowKeys, colKeys))

    return(LongTable(colData=colDataSubset, colIDs=longTable@.intern$colIDs ,
                     rowData=rowDataSubset, rowIDs=longTable@.intern$rowIDs,
                     assays=assayData, metadata=metadata(longTable)))
}

setMethod('subset', 'LongTable', subset.long.table)

Everything behaves as I expect when calling the subset function. For example

subset(longTable, cellLine1 == 'VCAP)

Successfully returns while also working with character, integer or boolean based indexing.

The issue arises when I try to implement the '[' method. I have tried a number of different approaches, but none of them has been successful. My current approach is as follows:


`[.long.table` <- function(x, i, j) eval(substitute(subset(x, i, j)))

This function works as expected in most cases, for example.


longTable[c(1,2,3), c(1,2,3,]
`[.long.table`(longTable, cellLine1 == 'VCAP')

Both work normally.

However, when I try using `[` like an operator:

longTable[cellLine1 == 'VCAP', ]

I get the error 'Error: object 'cellLine1' not found'.

This suggests to me that instead of passing the expression into the function `[`, it is trying to evaluate the expression before dispatching a method.

Given that similar syntax works fine with data.table, and I believe also in the tibble tidyverse package, I am quite confused.

If you have any recommendations on how I can prevent evaluation prior to method dispatch, or of a work around that would produce the same API using a different approach, it would be appreciated.

Thanks for  your assistance.


Best,

---
Christopher Eeles
Software Developer
BHK Laboratory<http://www.bhklab.ca/>
Princess Margaret Cancer Centre<https://www.pmgenomics.ca/pmgenomics/>
University Health Network<http://www.uhn.ca/>




This e-mail may contain confidential and/or privileged i...{{dropped:22}}

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
Reply | Threaded
Open this post in threaded view
|

Re: How to use `[` without evaluating the arguments.

Hugh Parsonage
This works as expected:

"[.foo" <- function(x, i, j) {
  sx <- substitute(x)
  si <- substitute(i)
  sj <- substitute(j)
  100 * length(sx) + 10 * length(si) + length(sj)
}

x <- 1:10
class(x) <- "foo"
x[y == z, a(x)]
#> [1] 132

Note in your implementation you ask the function evaluate the
expression. You may have been intending to recompose the calls from
the substituted values of x, i, j and evaluate this new call.

On Fri, 25 Sep 2020 at 20:02, Eeles, Christopher
<[hidden email]> wrote:

>
> Hello R-devel,
>
> I am currently attempting to implement an API similar to data.table wherein single bracket subsetting can accept an unquoted expression to be evaluated in the context of my object.
>
> A simple example from the data.table package looks like this:
>
>
> DT <- data.table(col1 = c('a', 'b', 'c'), col2 = c('x', 'y', 'z'))
> DT[col1 == 'a']
>
> Where the expression i in DT[i, j] is captured with substitute then evaluated inside the DT object.
>
> Reviewing the source code from data.table, it seems that they implemented this feature simple by defining a new S3 method on `[` called `[.data.table`. I tried to replicate this API as follows.
>
> I have defined an S4 which contains an S3 class as follows:
>
>
> #' Define an S3 Class
> #'
> #' Allows use of S3 methods with new S4 class. This is required to overcome
> #' limitations of the `[` S4 method.
> #'
> setOldClass('long.table')
>
> #' LongTable class definition
> #'
> #' Define a private constructor method to be used to build a `LongTable` object.
> #'
> #' @param drugs [`data.table`]
> #' @param cells [`data.table`]
> #' @param assays [`list`]
> #' @param metadata [`list`]
> #'
> #'
> #' @return [`LongTable`] object containing the assay data from a
> #'
> #' @import data.table
> #' @keywords internal
> .LongTable <- setClass("LongTable",
>                        slots=list(rowData='data.table',
>                                   colData='data.table',
>                                   assays='list',
>                                   metadata='list',
>                                   .intern='environment'),
>                        contains='long.table')
>
> #' LongTable constructor method
> #'
> #' @param rowData [`data.table`, `data.frame`, `matrix`] A table like object
> #'   coercible to a `data.table` containing the a unique `rowID` column which
> #'   is used to key assays, as well as additional row metadata to subset on.
> #' @param rowIDs [`character`, `integer`] A vector specifying
> #'   the names or integer indexes of the row data identifier columns. These
> #'   columns will be pasted together to make up the row.names of the
> #'   `LongTable` object.
> #' @param colData [`data.table`, `data.frame`, `matrix`] A table like object
> #'   coercible to a `data.table` containing the a unique `colID` column which
> #'   is used to key assays, as well as additional column metadata to subset on.
> #' @param colIDs [`character`, `integer`] A vector specifying
> #'   the names or integer indexes of the col data identifier columns. These
> #'   columns will be pasted together to make up the col.names of the
> #'   `LongTable` object.
> #' @param assays A [`list`] containing one or more objects coercible to a
> #'   `data.table`, and keyed by rowID and colID corresponding to the rowID and
> #'   colID columns in colData and rowData.
> #' @param metadata A [`list`] of metadata associated with the `LongTable`
> #'   object being constructed
> #' @param keep.rownames [`logical` or `character`] Logical: whether rownames
> #'   should be added as a column if coercing to a `data.table`, default is FALSE.
> #'   If TRUE, rownames are added to the column 'rn'. Character: specify a custom
> #'   column name to store the rownames in.
> #'
> #' @return [`LongTable`] object
> #'
> #' @import data.table
> #' @export
> LongTable <- function(rowData, rowIDs, colData, colIDs, assays,
>                       metadata=list(), keep.rownames=FALSE) {
>
>     ## TODO:: Handle missing parameters
>
>     if (!is(colData, 'data.table')) {
>         colData <- data.table(colData, keep.rownames=keep.rownames)
>     }
>
>     if (!is(rowData, 'data.table')) {
>         rowData <- data.table(rowData, keep.rownames=keep.rownames)
>     }
>
>     if (!all(vapply(assays, FUN=is.data.table, FUN.VALUE=logical(1)))) {
>         tryCatch({
>             assays <- lapply(assays, FUN=data.table, keep.rownames=keep.rownames)
>         }, warning = function(w) {
>             warning(w)
>         }, error = function(e, assays) {
>             message(e)
>             types <- lapply(assays, typeof)
>             stop(paste0('List items are types: ',
>                         paste0(types, collapse=', '),
>                         '\nPlease ensure all items in the assays list are
>                         coerced to data.tables!'))
>         })
>     }
>
>     # Initialize the .internals object to store private metadata for a LongTable
>     internals <- new.env()
>
>     ## TODO:: Implement error handling
>     internals$rowIDs <-
>         if (is.numeric(rowIDs) && max(rowIDs) < ncol(rowData))
>             rowIDs
>         else
>             which(colnames(rowData) %in% rowIDs)
>     lockBinding('rowIDs', internals)
>
>     internals$colIDs <-
>         if (is.numeric(colIDs) && max(colIDs) < ncol(colData))
>             colIDs
>         else
>             which(colnames(colData) %in% colIDs)
>     lockBinding('colIDs', internals)
>
>     # Assemble the pseudo row and column names for the LongTable
>     .pasteColons <- function(...) paste(..., collapse=':')
>     rowData[, `:=`(.rownames=mapply(.pasteColons, transpose(.SD))), .SDcols=internals$rowIDs]
>     colData[, `:=`(.colnames=mapply(.pasteColons, transpose(.SD))), .SDcols=internals$colIDs]
>
>     return(.LongTable(rowData=rowData, colData=colData,
>                       assays=assays, metadata=metadata,
>                       .intern=internals))
> }
>
> I have also defined a subset method as an S3 and S4 generic:
>
>
> #' Subset method for a LongTable object.
> #'
> #' Allows use of the colData and rowData `data.table` objects to query based on
> #'  rowID and colID, which is then used to subset all value data.tables stored
> #'  in the dataList slot.
> #'
> #' This function is endomorphic, it always returns a LongTable object.
> #'
> #' @param x [`LongTable`] The object to subset.
> #' @param rowQuery [`character`, `numeric`, `logical` or `expression`]
> #'  Character: pass in a character vector of drug names, which will subset the
> #'      object on all row id columns matching the vector.
> #'
> #'  Numeric or Logical: these select based on the rowKey from the `rowData`
> #'      method for the `LongTable`.
> #'
> #'  Expression: Accepts valid query statements to the `data.table` i parameter,
> #'      this can be used to make complex queries using the `data.table` API
> #'      for the `rowData` data.table.
> #'
> #' @param columnQuery [`character`, `numeric`, `logical` or `expression`]
> #'  Character: pass in a character vector of drug names, which will subset the
> #'      object on all drug id columns matching the vector.
> #'
> #'  Numeric or Logical: these select base don the rowID from the `rowData`
> #'      method for the `LongTable`.
> #'
> #'  Expression: Accepts valid query statements to the `data.table` i parameter,
> #'      this can be used to make complex queries using the `data.table` API
> #'      for the `rowData` data.table.
> #'
> #' @param values [`character`, `numeric` or `logical`] Optional list of value
> #'      names to subset. Can be used to subset the dataList column further,
> #'      returning only the selected items in the new LongTable.
> #'
> #' @return [`LongTable`] A new `LongTable` object subset based on the specified
> #'      parameters.
> #'
> #' @importMethodsFrom BiocGenerics subset
> #' @import data.table
> #' @export
> subset.long.table <- function(x, rowQuery, columnQuery, assays) {
>
>     longTable <- x
>     rm(x)
>
>     if (!missing(rowQuery)) {
>         if (tryCatch(is.character(rowQuery), error=function(e) FALSE)) {
>             select <- grep('^cellLine[:digit:]*', colnames(rowData(longTable)), value=TRUE)
>             rowQueryString <- paste0(paste0(select, ' %in% ', .variableToCodeString(rowQuery)), collapse=' | ')
>             rowQuery <- str2lang(rowQueryString)
>         } else {
>             rowQuery <- substitute(rowQuery)
>         }
>         rowDataSubset <- rowData(longTable)[eval(rowQuery), ]
>     } else {
>         rowDataSubset <- rowData(longTable)
>     }
>
>     if (!missing(columnQuery)) {
>         if (tryCatch(is.character(columnQuery), error=function(e) FALSE)) {
>             select <- grep('^drug[:digit:]*', colnames(colData(longTable)), value=TRUE)
>             columnQueryString <- paste0(paste0(select, ' %in% ', .variableToCodeString(columnQuery)), collapse=' | ')
>             columnQuery <- str2lang(columnQueryString)
>         } else {
>             columnQuery <- substitute(columnQuery)
>         }
>         colDataSubset <- colData(longTable)[eval(columnQuery), ]
>     } else {
>         colDataSubset <- colData(longTable)
>     }
>
>     rowKeys <- rowDataSubset$rowKey
>     colKeys <- colDataSubset$colKey
>
>     if (missing(assays)) { assays <- assayNames(longTable) }
>     keepAssays <- assayNames(longTable) %in% assays
>
>     assayData <- lapply(assays(longTable)[keepAssays],
>                      FUN=.filterLongDataTable,
>                      indexList=list(rowKeys, colKeys))
>
>     return(LongTable(colData=colDataSubset, colIDs=longTable@.intern$colIDs ,
>                      rowData=rowDataSubset, rowIDs=longTable@.intern$rowIDs,
>                      assays=assayData, metadata=metadata(longTable)))
> }
>
> setMethod('subset', 'LongTable', subset.long.table)
>
> Everything behaves as I expect when calling the subset function. For example
>
> subset(longTable, cellLine1 == 'VCAP)
>
> Successfully returns while also working with character, integer or boolean based indexing.
>
> The issue arises when I try to implement the '[' method. I have tried a number of different approaches, but none of them has been successful. My current approach is as follows:
>
>
> `[.long.table` <- function(x, i, j) eval(substitute(subset(x, i, j)))
>
> This function works as expected in most cases, for example.
>
>
> longTable[c(1,2,3), c(1,2,3,]
> `[.long.table`(longTable, cellLine1 == 'VCAP')
>
> Both work normally.
>
> However, when I try using `[` like an operator:
>
> longTable[cellLine1 == 'VCAP', ]
>
> I get the error 'Error: object 'cellLine1' not found'.
>
> This suggests to me that instead of passing the expression into the function `[`, it is trying to evaluate the expression before dispatching a method.
>
> Given that similar syntax works fine with data.table, and I believe also in the tibble tidyverse package, I am quite confused.
>
> If you have any recommendations on how I can prevent evaluation prior to method dispatch, or of a work around that would produce the same API using a different approach, it would be appreciated.
>
> Thanks for  your assistance.
>
>
> Best,
>
> ---
> Christopher Eeles
> Software Developer
> BHK Laboratory<http://www.bhklab.ca/>
> Princess Margaret Cancer Centre<https://www.pmgenomics.ca/pmgenomics/>
> University Health Network<http://www.uhn.ca/>
>
>
>
>
> This e-mail may contain confidential and/or privileged i...{{dropped:22}}
>
> ______________________________________________
> [hidden email] mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel