From 7a041cbfd81043986495a6328c2c836ca000345a Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Sat, 24 Aug 2024 10:36:53 -0400 Subject: [PATCH 1/4] Better fix for issue #30. --- R/tabular.R | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/R/tabular.R b/R/tabular.R index 16aedd9..d8293a7 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. + + 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 - withTableFns <- new.env(parent = if (is.environment(data)) data else environment(table)) - withTableFns$labelSubset <- labelSubset if (is.null(data)) data <- withTableFns else if (is.list(data)) - data <- list2env(data, parent=withTableFns) + data <- list2env(data, parent = withTableFns) else if (!is.environment(data)) stop("'data' must be a dataframe, list or environment") From 8774121f12dcaaa6d5306bdc0d3456b349e37e20 Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Thu, 29 Aug 2024 05:07:35 -0400 Subject: [PATCH 2/4] Even better solution to issue #30. --- R/RowFactor.R | 6 ++++-- R/tabular.R | 15 ++------------- 2 files changed, 6 insertions(+), 15 deletions(-) diff --git a/R/RowFactor.R b/R/RowFactor.R index b1f497b..d29e5f1 100644 --- a/R/RowFactor.R +++ b/R/RowFactor.R @@ -57,9 +57,11 @@ 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", + + # labelSubset is local; can't use call() here; see issue #30 + test <- as.call(list(labelSubset, subset = call("==", call("as.integer", call("as.factor", expr)), i), - label = deparse(expr)) + label = deparse(expr))) term <- call("*", call("Heading", makeName(catname)), test) if (i == 1) diff --git a/R/tabular.R b/R/tabular.R index d8293a7..03198f7 100644 --- a/R/tabular.R +++ b/R/tabular.R @@ -629,21 +629,10 @@ 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 in future) - # when evaluating a table expression (issue #30), but we don't want - # to mask the user's copy. - - 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)) - data <- withTableFns + data <- environment(table) 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") From 81049330475afb57ac2333e7a18d86399d2b9843 Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Thu, 29 Aug 2024 08:35:22 -0400 Subject: [PATCH 3/4] Another fix. --- R/tabular.R | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/R/tabular.R b/R/tabular.R index 03198f7..a42a6e2 100644 --- a/R/tabular.R +++ b/R/tabular.R @@ -629,8 +629,19 @@ tabular.formula <- function(table, data=NULL, n, suppressLabels=0, ...) { if (missing(n) && inherits(data, "data.frame")) n <- nrow(data) - if (is.null(data)) - data <- environment(table) + # 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. + + 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 = environment(table)) else if (!is.environment(data)) From 79bddd2a15c819259491248199954bced2e50495 Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Thu, 29 Aug 2024 08:32:56 -0400 Subject: [PATCH 4/4] Another fix --- R/RowFactor.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/RowFactor.R b/R/RowFactor.R index d29e5f1..98456c1 100644 --- a/R/RowFactor.R +++ b/R/RowFactor.R @@ -58,10 +58,9 @@ RowFactor <- function(x, name = deparse(expr), levelnames=levels(x), catname <- paste(insert, levelnames[i], sep="") test <- i # Work around a bug in R 2.12.x! - # labelSubset is local; can't use call() here; see issue #30 - test <- as.call(list(labelSubset, + test <- call("labelSubset", subset = call("==", call("as.integer", call("as.factor", expr)), i), - label = deparse(expr))) + label = deparse(expr)) term <- call("*", call("Heading", makeName(catname)), test) if (i == 1)