From 7d9a3fb88a76c26d907dcdb266de4f6971f1b91b Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Mon, 19 Feb 2024 18:21:52 -0500 Subject: [PATCH] format_tt gains an i argument --- DESCRIPTION | 2 +- NEWS.md | 4 ++ R/format_tt.R | 95 ++++++++++++++++++++++++++---------------------- R/tt.R | 1 + man/format_tt.Rd | 3 ++ 5 files changed, 61 insertions(+), 44 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 972807ff..de8dc4b6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Package: tinytable Type: Package Title: Simple and Configurable Tables in 'HTML', 'LaTeX', 'Markdown', 'Word', 'PNG', 'PDF', and 'Typst' Formats Description: Create highly customized tables with this simple and dependency-free package. Data frames can be converted to 'HTML', 'LaTeX', 'Markdown', 'Word', 'PNG', 'PDF', or 'Typst' tables. The user interface is minimalist and easy to learn. The syntax concise. 'HTML' tables can be customized using the flexible 'Bootstrap' framework, and 'LaTeX' code with the 'tabularray' package. -Version: 0.0.5 +Version: 0.0.5.9000 Depends: R (>= 4.1.0) Enhances: diff --git a/NEWS.md b/NEWS.md index 92303ff1..cd4a4ca6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # News +## Development + +* `format_tt()` gains an `i` argument to format subsets of rows. + ## 0.0.5 * `format_tt()` escapes <> tags in Typst. diff --git a/R/format_tt.R b/R/format_tt.R index b718c581..f4cc2b5e 100644 --- a/R/format_tt.R +++ b/R/format_tt.R @@ -34,6 +34,7 @@ #' num_mark_big = " ") #' format_tt <- function(x, + i = NULL, j = NULL, digits = getOption("digits"), num_fmt = "significant", @@ -54,6 +55,7 @@ format_tt <- function(x, if (inherits(out, "tinytable")) { cal <- call("format_tt_lazy", + i = i, j = j, digits = digits, num_fmt = num_fmt, @@ -73,6 +75,7 @@ format_tt <- function(x, } else { out <- format_tt_lazy(out, + i = i, j = j, digits = digits, num_fmt = num_fmt, @@ -93,6 +96,7 @@ format_tt <- function(x, } format_tt_lazy <- function(x, + i = NULL, j = NULL, digits, num_fmt = "significant", @@ -118,7 +122,13 @@ format_tt_lazy <- function(x, atomic_vector <- FALSE } - out <- x + # if no other format_tt() call has been applied, we can have numeric values + ori <- meta(x, "x_original") + if (!all(sapply(x, is.character))) { + out <- meta(x, "x_character") + } else { + out <- x + } if (!inherits(x, "data.frame")) { msg <- "`x` must be a data frame or an atomic vector." @@ -127,6 +137,7 @@ format_tt_lazy <- function(x, assert_data_frame(x) assert_integerish(digits, len = 1) + assert_integerish(i, null.ok = TRUE) assert_choice(num_fmt, c("significant", "decimal", "scientific")) assert_flag(num_zero) assert_string(num_mark_big) @@ -143,72 +154,67 @@ format_tt_lazy <- function(x, # In sanity_tt(), we fill in missing NULL `j` in the format-specific versions, # because tabularray can do whole column styling. Here, we need to fill in # NULL for all formats since this is applied before creating the table. + if (is.null(i)) i <- seq_len(nrow(x)) if (is.null(j)) j <- seq_len(ncol(x)) + # format each column for (col in j) { # sprintf() is self-contained if (!is.null(sprintf)) { - out[[col]] <- base::sprintf(sprintf, out[[col]]) - + out[i, col] <- base::sprintf(sprintf, ori[i, col]) } else { - - # logical - if (is.logical(out[[col]])) { - out[[col]] <- bool(out[[col]]) + # logical + if (is.logical(ori[i, col])) { + out[i, col] <- bool(ori[i, col]) # date - } else if (inherits(out[[col]], "Date")) { - out[[col]] <- format(out[[col]], date) + } else if (inherits(ori[i, col], "Date")) { + out[i, col] <- format(ori[i, col], date) # numeric - } else if (is.numeric(out[[col]]) && !is.null(digits)) { - + } else if (is.numeric(ori[i, col]) && !is.null(digits)) { # numeric suffix if (isTRUE(num_suffix)) { - out[[col]] <- format_num_suffix(out[[col]], digits = digits, num_mark_big = num_mark_big, num_mark_dec = num_mark_dec, num_zero = num_zero) + out[i, col] <- format_num_suffix(ori[i, col], digits = digits, num_mark_big = num_mark_big, num_mark_dec = num_mark_dec, num_zero = num_zero) # non-integer numeric - } else if (is.numeric(out[[col]]) && !isTRUE(check_integerish(out[[col]]))) { + } else if (is.numeric(ori[i, col]) && !isTRUE(check_integerish(ori[i, col]))) { if (num_fmt == "significant") { - out[[col]] <- format(out[[col]], - digits = digits, drop0trailing = !num_zero, - big.mark = num_mark_big, decimal.mark = num_mark_dec, - scientific = FALSE) - + out[i, col] <- format(ori[i, col], + digits = digits, drop0trailing = !num_zero, + big.mark = num_mark_big, decimal.mark = num_mark_dec, + scientific = FALSE) } else if (num_fmt == "decimal") { - out[[col]] <- formatC(out[[col]], - digits = digits, format = "f", drop0trailing = !num_zero, - big.mark = num_mark_big, decimal.mark = num_mark_dec) + out[i, col] <- formatC(ori[i, col], + digits = digits, format = "f", drop0trailing = !num_zero, + big.mark = num_mark_big, decimal.mark = num_mark_dec) if (num_fmt == "scientific") { - out[[col]] <- formatC(out[[col]], - digits = digits, format = "e", drop0trailing = !num_zero, - big.mark = num_mark_big, decimal.mark = num_mark_dec) + out[i, col] <- formatC(ori[i, col], + digits = digits, format = "e", drop0trailing = !num_zero, + big.mark = num_mark_big, decimal.mark = num_mark_dec) } } # integer - } else if (isTRUE(check_integerish(out[[col]]))) { + } else if (isTRUE(check_integerish(ori[i, col]))) { if (num_fmt == "scientific") { - out[[col]] <- formatC(out[[col]], - digits = digits, format = "e", drop0trailing = !num_zero, - big.mark = num_mark_big, decimal.mark = num_mark_dec) + out[i, col] <- formatC(ori[i, col], + digits = digits, format = "e", drop0trailing = !num_zero, + big.mark = num_mark_big, decimal.mark = num_mark_dec) } } - } else { - out[[col]] <- other(out[[col]]) + out[i, col] <- other(ori[i, col]) } - } # replace missing values by `na` - out[, col] <- as.character(out[, col]) - out[is.na(x[, col]), col] <- replace_na - + out[i, col][is.na(ori[i, col])] <- replace_na } # loop over columns + # escape latex characters if (!isFALSE(escape)) { if (isTRUE(escape == "latex")) { @@ -225,7 +231,7 @@ format_tt_lazy <- function(x, colnames(out) <- escape_text(colnames(out), output = o) } for (col in j) { - out[[col]] <- escape_text(out[[col]], output = o) + out[i, col] <- escape_text(out[i, col], output = o) } } @@ -234,16 +240,19 @@ format_tt_lazy <- function(x, assert_dependency("markdown") for (col in j) { if (isTRUE(meta(out)$output == "html")) { - fun <- function(out) { - out <- trimws(markdown::mark_html(text = out, template = FALSE)) - out <- sub("

", "", out, fixed = TRUE) - out <- sub("

", "", out, fixed = TRUE) - return(out) + fun <- function(x, i) { + x[i] <- trimws(markdown::mark_html(text = x[i], template = FALSE)) + x[i] <- sub("

", "", x[i], fixed = TRUE) + x[i] <- sub("

", "", x[i], fixed = TRUE) + return(x) } - out[, col] <- sapply(out[, col], fun) + out[, col] <- sapply(out[, col], function(x) fun(x, i)) } else if (isTRUE(meta(out)$output == "latex")) { - fun <- function(out) trimws(markdown::mark_latex(text = out, template = FALSE)) - out[, col] <- sapply(out[, col], fun) + fun <- function(x, i) { + x[i] <- trimws(markdown::mark_latex(text = x[i], template = FALSE)) + return(x) + } + out[, col] <- sapply(out[, col], function(x) fun(x, i)) } } } diff --git a/R/tt.R b/R/tt.R index 897e6d28..5a211b30 100644 --- a/R/tt.R +++ b/R/tt.R @@ -69,6 +69,7 @@ tt <- function(x, # before style_tt() call for align out <- x out <- meta(out, "x_character", data.frame(lapply(x, as.character))) + out <- meta(out, "x_original", x) out <- meta(out, "output", sanitize_output(output)) out <- meta(out, "output_dir", getwd()) out <- meta(out, "colnames", names(x)) diff --git a/man/format_tt.Rd b/man/format_tt.Rd index db76650e..0d4bbcc6 100644 --- a/man/format_tt.Rd +++ b/man/format_tt.Rd @@ -6,6 +6,7 @@ \usage{ format_tt( x, + i = NULL, j = NULL, digits = getOption("digits"), num_fmt = "significant", @@ -25,6 +26,8 @@ format_tt( \arguments{ \item{x}{A data frame or a vector to be formatted.} +\item{i}{Row indices where the styling should be applied. Can be a single value or a vector. \code{i=0} is the header, and negative values are higher level headers. If \code{colspan} is used, \code{i} must be of length 1.} + \item{j}{Column indices where the styling should be applied. Can be: \itemize{ \item Integer vectors indicating column positions.