diff --git a/R/RowFactor.R b/R/RowFactor.R index b1f497b..98456c1 100644 --- a/R/RowFactor.R +++ b/R/RowFactor.R @@ -57,6 +57,7 @@ RowFactor <- function(x, name = deparse(expr), levelnames=levels(x), else insert <- nopagebreak catname <- paste(insert, levelnames[i], sep="") test <- i # Work around a bug in R 2.12.x! + test <- call("labelSubset", subset = call("==", call("as.integer", call("as.factor", expr)), i), label = deparse(expr)) diff --git a/R/tabular.R b/R/tabular.R index 16aedd9..a42a6e2 100644 --- a/R/tabular.R +++ b/R/tabular.R @@ -629,15 +629,21 @@ tabular.formula <- function(table, data=NULL, n, suppressLabels=0, ...) { if (missing(n) && inherits(data, "data.frame")) n <- nrow(data) - # We need access to labelSubset() (and perhaps other functions) - # when evaluating a table expression. (Issue #30) + # We need access to labelSubset() (and perhaps other functions in future) + # when evaluating a table expression (issue #30), but we don't want + # to mask the user's copy. - withTableFns <- new.env(parent = if (is.environment(data)) data else environment(table)) - withTableFns$labelSubset <- labelSubset - if (is.null(data)) + parent <- if (is.environment(data)) data else environment(table) + if (!exists("labelSubset", envir = parent)) { + withTableFns <- new.env(parent = parent) + withTableFns$labelSubset <- labelSubset + } else + withTableFns <- parent + + if (is.null(data) || is.environment(data)) data <- withTableFns else if (is.list(data)) - data <- list2env(data, parent=withTableFns) + data <- list2env(data, parent = environment(table)) else if (!is.environment(data)) stop("'data' must be a dataframe, list or environment")