Merge branch 'main' into issue#340

.gitignore

@@ -51,4 +51,8 @@ tinytable_assets
 cran-comments.md
 CRAN-SUBMISSION
 
+sandbox/typst.typ
+sandbox/typst.pdf
+
+
 !_quarto/_freeze/

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 is concise. 'HTML' tables can be customized using the flexible 'Bootstrap' framework, and 'LaTeX' code with the 'tabularray' package.
-Version: 0.4.0.1
+Version: 0.4.0.4
 Imports:
     methods
 Depends:

NAMESPACE

@@ -11,6 +11,8 @@ export(theme_tt)
 export(tt)
 exportClasses(tinytable)
 exportMethods("colnames<-")
+exportMethods("names<-")
 exportMethods(colnames)
+exportMethods(names)
 exportMethods(rbind2)
 importFrom(methods,rbind2)

NEWS.md

@@ -2,7 +2,16 @@
 
 ## Development
 
+New:
+
 * The `i` argument in `style_tt()` now accepts a logical matrix of same dimensions as `x`, to style specific cells, rather than all combinations of `i` and `j` vectors. Thanks to @dhicks for the feature request #329.
+* `style_tt()` gets new `output` argument for conditional styling based on output format.
+* `names()` method now supported for both returning column names and re-assingning them. Issue #332.
+
+Typst:
+
+* Table code is much more concise and efficient.
+* Fix indexing bug for groups. Issue #323 and #343.
 
 ## 0.4.0
 

R/build_tt.R

@@ -86,13 +86,34 @@ build_tt <- function(x, output = NULL) {
     x <- eval(l)
   }
 
+  if (x@output == "typst") {
+    if (is.null(x@theme[[1]]) || is.function(x@theme[[1]]) || isTRUE(x@theme[[1]] %in% c("default", "striped"))) {
+      # reverse the order of the lines to allow overwriting defaults
+      ls <- x@lazy_style 
+      x <- style_tt(x, i = nrow(x), line = "b", line_width = 0.1)
+      if (x@nhead > 0) {
+        x <- style_tt(x, i = -x@nhead + 1, line = "t", line_width = 0.1)
+        x <- style_tt(x, i = 1, line = "t", line_width = 0.05)
+      } else {
+        x <- style_tt(x, i = 1, line = "t", line_width = 0.1)
+      }
+    }
+  }
+
   if (!x@output %in% c("markdown", "gfm", "dataframe")) {
     for (l in x@lazy_style) {
       l[["x"]] <- x
-      x <- eval(l)
+      # output-specific styling
+      if (is.null(l$output) || isTRUE(x@output == l$output)) {
+        x <- eval(l)
+      }
     }
   }
 
+  if (x@output == "typst") {
+    x <- style_apply_typst(x)
+  }
+
   x <- finalize(x)
 
   x@table_string <- lines_drop_consecutive_empty(x@table_string)

R/class.R

@@ -41,6 +41,7 @@ setClass(
         id = "character",
         bootstrap_class = "character",
         css = "data.frame",
+        style = "data.frame",
         lazy_format = "list",
         lazy_group = "list",
         lazy_style = "list",
@@ -78,6 +79,7 @@ setMethod("initialize", "tinytable", function(
   .Object@output_dir <- getwd()
   .Object@css <- data.frame(i = NA, j = NA, bootstrap = NA, id = NA)
   .Object@portable <- FALSE
+  .Object@style <- data.frame()
   # conditional: allows NULL user input
   if (!is.null(placement)) .Object@placement <- placement
   if (!is.null(caption)) .Object@caption <- caption
@@ -105,6 +107,12 @@ setMethod("ncol", "tinytable", function(x) return(x@ncol))
 #' @export
 setMethod("colnames", "tinytable", function(x) return(x@names))
 
+#' Method for a tinytable S4 object
+#' 
+#' @inheritParams tt
+#' @keywords internal
+#' @export
+setMethod("names", "tinytable", function(x) return(x@names))
 
 #' Method for a tinytable S4 object
 #' 
@@ -126,6 +134,25 @@ setReplaceMethod("colnames",
                  }
 )
 
+#' Method for a tinytable S4 object
+#' 
+#' @inheritParams tt
+#' @keywords internal
+#' @export
+setReplaceMethod("names",
+                 signature = "tinytable", 
+                 definition = function(x, value) {
+                   # Issue #306
+                   if (length(value) == 0) value <- NULL
+                   if (!is.null(value)) {
+                     assert_character(value, len = length(x@names))
+                   } else {
+                     if (x@nhead == 1) x@nhead <- 0
+                   }
+                   x@names <- value
+                   return(x)
+                 }
+)
 
 #' Dimensions a tinytable S4 object
 #' 

R/finalize_typst.R

@@ -20,6 +20,7 @@ setMethod(
   # Quarto cross-references
   if (isTRUE(check_dependency("knitr"))) {
     quarto_caption <- isTRUE(knitr::pandoc_to("typst")) &&
+                      isFALSE(getOption("tinytable_quarto_figure", default = FALSE))
                       (!is.null(knitr::opts_current$get()[["label"]]) ||
                        !is.null(knitr::opts_current$get()[["tbl-cap"]]))
     if (quarto_caption) {

R/group_typst.R

@@ -22,7 +22,7 @@ setMethod(
 group_typst_row <- function(x, i, indent, ...) {
   tab <- x@table_string
   tab <- strsplit(tab, split = "\\n")[[1]]
-  body_min <- utils::head(grep("tinytable cell content after", tab), 1) + x@nhead
+  body_min <- utils::head(grep("tinytable cell content after", tab), 1) + 1
   body_max <- utils::head(grep("end table", tab), 1) - 1
   body <- body_min:body_max
   top <- tab[1:(body_min - 1)]
@@ -38,8 +38,9 @@ group_typst_row <- function(x, i, indent, ...) {
   tab <- paste(tab, collapse = "\n")
   x@table_string <- tab
   idx_new <- i + seq_along(i) - 1
-  idx_old <- setdiff(seq_len(nrow(x)), idx_new)
-  x <- style_tt(x, idx_old, indent = indent)
+  idx_all <- seq_len(nrow(x) + length(i))
+  idx <- setdiff(idx_all, idx_new)
+  x <- style_tt(x, idx, indent = indent)
   return(x)
 }
 

R/style_tt.R

@@ -46,6 +46,7 @@
 #' @param bootstrap_css_rule String. Complete CSS rules (with curly braces, semicolon, etc.) that apply to the table class specified by the `bootstrap_class` argument.
 #' @param tabularray_inner A string that specifies the "inner" settings of a tabularray LaTeX table. 
 #' @param tabularray_outer A string that specifies the "outer" settings of a tabularray LaTeX table.
+#' @param output Apply style only to the output format specified by this argument. `NULL` means that we apply to all formats. 
 #' @param ... extra arguments are ignored
 #' @return An object of class `tt` representing the table.
 #' @template latex_preamble
@@ -144,10 +145,13 @@ style_tt <- function (x,
                       bootstrap_class = NULL,
                       bootstrap_css = NULL,
                       bootstrap_css_rule = NULL,
+                      output = NULL,
                       ...) {
 
   out <- x
 
+  assert_choice(output, c("typst", "latex", "html", "markdown", "gfm"), null.ok = TRUE)
+
   if ("width" %in% names(list(...))) {
     stop("The `width` argument is now in the `tt()` function.", call. = FALSE)
   }
@@ -181,7 +185,8 @@ style_tt <- function (x,
               tabularray_outer = tabularray_outer,
               bootstrap_class = bootstrap_class,
               bootstrap_css = bootstrap_css,
-              bootstrap_css_rule = bootstrap_css_rule)
+              bootstrap_css_rule = bootstrap_css_rule,
+              output = output)
 
   if (isTRUE(list(...)[["tt_build_now"]])) {
     out <- eval(cal)
@@ -222,7 +227,8 @@ style_tt_lazy <- function (x,
                            tabularray_outer,
                            bootstrap_class,
                            bootstrap_css,
-                           bootstrap_css_rule) {
+                           bootstrap_css_rule,
+                           output) {
 
   out <- x