From 818181d58a9d18aadbd476534e24861fb3cc29af Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Mon, 28 Aug 2023 21:30:39 -0400 Subject: [PATCH 1/3] Fixes issue #17 --- DESCRIPTION | 2 +- NEWS.md | 3 ++- R/deparse.R | 6 ++++++ 3 files changed, 9 insertions(+), 2 deletions(-) create mode 100644 R/deparse.R diff --git a/DESCRIPTION b/DESCRIPTION index 8ede637..5aebda6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: tables Title: Formula-Driven Table Generation -Version: 0.9.21 +Version: 0.9.22 Author: Duncan Murdoch Description: Computes and displays complex tables of summary statistics. Output may be in LaTeX, HTML, plain text, or an R diff --git a/NEWS.md b/NEWS.md index 3f8e88b..95483c3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,9 +1,10 @@ -# tables 0.9.21 +# tables 0.9.22 - `PlusMinus()` and `Paste()` didn't handle formatting properly when multiple columns were involved (issue #13). - `toLatex()` with a non-empty `file` argument didn't write to file properly. (Reported by Reinhard Kerschner and F. Hortner.) +- In some cases `All()` would give an error (issue #17). # tables 0.9.17 diff --git a/R/deparse.R b/R/deparse.R new file mode 100644 index 0000000..97b5aac --- /dev/null +++ b/R/deparse.R @@ -0,0 +1,6 @@ +# base::deparse might return more than one line; this +# replaces it with a function that chops the results + +deparse <- function(expr, width.cutoff = 500L, nlines = 1L, ...) { + base::deparse(expr, width.cutoff = width.cutoff, nlines = nlines, ...) +} From 32ba4a315cb52ca7b973ca26090a7b47e2571a19 Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Tue, 29 Aug 2023 06:04:06 -0400 Subject: [PATCH 2/3] Fix All() to use expression instead of value. --- R/All.R | 41 ++++++++++++++++++++++++----------------- 1 file changed, 24 insertions(+), 17 deletions(-) diff --git a/R/All.R b/R/All.R index ad441c5..6b52106 100644 --- a/R/All.R +++ b/R/All.R @@ -29,38 +29,45 @@ All <- function(df, numeric=TRUE, character=FALSE, logical=FALSE, factor=FALSE, if (is.numeric(value)) { if (is.function(numeric)) value <- numeric(value) - else if (!isTRUE(numeric)) - next + else if (isTRUE(numeric)) + value <- call("[[", substitute(df), i) + else next } else if (is.character(value)) { if (is.function(character)) value <- character(value) - else if (!isTRUE(character)) - next + else if (isTRUE(character)) + value <- call("[[", substitute(df), i) + else next } else if (is.logical(value)) { if (is.function(logical)) value <- logical(value) - else if (!isTRUE(logical)) - next + else if (isTRUE(logical)) + value <- call("[[", substitute(df), i) + else next } else if (is.factor(value)) { if (is.function(factor)) value <- factor(value) - else if (!isTRUE(factor)) - next + else if (isTRUE(factor)) + value <- call("[[", substitute(df), i) + else next } else if (is.complex(value)) { if (is.function(complex)) value <- complex(value) - else if (!isTRUE(complex)) - next + else if (isTRUE(complex)) + value <- call("[[", substitute(df), i) + else next } else if (is.raw(value)) { - if (is.function(raw)) - value <- raw(value) - else if (!isTRUE(raw)) - next - } else { + if (is.function(raw)) + value <- raw(value) + else if (isTRUE(raw)) + value <- call("[[", substitute(df), i) + else next + } else { if (is.function(other)) value <- other(value) - else if (!isTRUE(other)) - next + else if (isTRUE(other)) + value <- call("[[", substitute(df), i) + else next } f1 <- call("*", call("Heading", as.name(names[i])), From 17a9c4c645039cbccc334d803105f027c05616dd Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Tue, 29 Aug 2023 06:41:42 -0400 Subject: [PATCH 3/3] Remove duplication from code --- R/All.R | 117 +++++++++++++++++++++----------------------------------- 1 file changed, 43 insertions(+), 74 deletions(-) diff --git a/R/All.R b/R/All.R index 6b52106..fee7826 100644 --- a/R/All.R +++ b/R/All.R @@ -1,81 +1,50 @@ -All <- function(df, numeric=TRUE, character=FALSE, logical=FALSE, factor=FALSE, - complex=FALSE, raw=FALSE, other=FALSE, - texify=getOption("tables.texify", FALSE)) { - - if (is.character(numeric)) numeric <- get(numeric, mode="function", - envir=parent.frame()) - if (is.character(character)) character <- get(character, mode="function", - envir=parent.frame()) - if (is.character(logical)) logical <- get(logical, mode="function", - envir=parent.frame()) - if (is.character(factor)) factor <- get(factor, mode="function", - envir=parent.frame()) - if (is.character(complex)) complex <- get(complex, mode="function", - envir=parent.frame()) - if (is.character(complex)) complex <- get(complex, mode="function", - envir=parent.frame()) - if (is.character(raw)) raw <- get(raw, mode="function", - envir=parent.frame()) - if (is.character(other)) other <- get(other, mode="function", - envir=parent.frame()) - +All <- function(df, + numeric = TRUE, + character = FALSE, + logical = FALSE, + factor = FALSE, + complex = FALSE, + raw = FALSE, + other = FALSE, + texify = getOption("tables.texify", FALSE)) { names <- colnames(df) if (texify) - names <- Hmisc::latexTranslate(names) + names <- Hmisc::latexTranslate(names) f <- NULL for (i in seq_along(names)) { - value <- df[[i]] - if (is.numeric(value)) { - if (is.function(numeric)) - value <- numeric(value) - else if (isTRUE(numeric)) - value <- call("[[", substitute(df), i) - else next - } else if (is.character(value)) { - if (is.function(character)) - value <- character(value) - else if (isTRUE(character)) - value <- call("[[", substitute(df), i) - else next - } else if (is.logical(value)) { - if (is.function(logical)) - value <- logical(value) - else if (isTRUE(logical)) - value <- call("[[", substitute(df), i) - else next - } else if (is.factor(value)) { - if (is.function(factor)) - value <- factor(value) - else if (isTRUE(factor)) - value <- call("[[", substitute(df), i) - else next - } else if (is.complex(value)) { - if (is.function(complex)) - value <- complex(value) - else if (isTRUE(complex)) - value <- call("[[", substitute(df), i) - else next - } else if (is.raw(value)) { - if (is.function(raw)) - value <- raw(value) - else if (isTRUE(raw)) - value <- call("[[", substitute(df), i) - else next - } else { - if (is.function(other)) - value <- other(value) - else if (isTRUE(other)) - value <- call("[[", substitute(df), i) - else next - } - - f1 <- call("*", call("Heading", as.name(names[i])), - value) - if (is.null(f)) - f <- f1 - else - f <- call("+", f, f1) + value <- df[[i]] + if (is.numeric(value)) + sel <- numeric + else if (is.character(value)) + sel <- character + else if (is.logical(value)) + sel <- logical + else if (is.factor(value)) + sel <- factor + else if (is.complex(value)) + sel <- complex + else if (is.raw(value)) + sel <- raw + else + sel <- other + + if (is.character(sel)) + sel <- get(sel, mode = "function", envir = parent.frame()) + + if (is.function(sel)) + value <- sel(value) + else if (isTRUE(sel)) + value <- call("[[", substitute(df), i) + else + next + + f1 <- call("*", call("Heading", as.name(names[i])), + value) + if (is.null(f)) + f <- f1 + else + f <- call("+", f, f1) } f -} + }