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/All.R b/R/All.R index ad441c5..fee7826 100644 --- a/R/All.R +++ b/R/All.R @@ -1,74 +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)) - next - } else if (is.character(value)) { - if (is.function(character)) - value <- character(value) - else if (!isTRUE(character)) - next - } else if (is.logical(value)) { - if (is.function(logical)) - value <- logical(value) - else if (!isTRUE(logical)) - next - } else if (is.factor(value)) { - if (is.function(factor)) - value <- factor(value) - else if (!isTRUE(factor)) - next - } else if (is.complex(value)) { - if (is.function(complex)) - value <- complex(value) - else if (!isTRUE(complex)) - next - } else if (is.raw(value)) { - if (is.function(raw)) - value <- raw(value) - else if (!isTRUE(raw)) - next - } else { - if (is.function(other)) - value <- other(value) - else if (!isTRUE(other)) - 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 -} + } 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, ...) +}