Skip to content

Commit

Permalink
issue355v3
Browse files Browse the repository at this point in the history
  • Loading branch information
vincentarelbundock committed Dec 14, 2024
1 parent 33ffd6c commit 4eccfda
Show file tree
Hide file tree
Showing 5 changed files with 75 additions and 6 deletions.
4 changes: 2 additions & 2 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@
# Generated by roxygen2: do not edit by hand

S3method(knit_print,tinytable)
S3method(knitr::knit_print,tinytable)
S3method(knitr::knit_print, tinytable)
S3method(print,tinytable)
export(format_tt)
export(group_tt)
export(knit_print.tinytable)
export(plot_tt)
export(save_tt)
export(style_tt)
Expand Down
2 changes: 1 addition & 1 deletion R/print.R
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
#'
#' @keywords internal
#' @return A string with class `knit_asis` to be printed in Rmarkdown or Quarto documents.
#' @exportS3Method knitr::knit_print
#' @rawNamespace S3method(knitr::knit_print, tinytable)
#' @export
knit_print.tinytable <- function(x,
output = get_option("tinytable_print_output", default = NULL),
Expand Down
35 changes: 35 additions & 0 deletions R/sanity.R
Original file line number Diff line number Diff line change
Expand Up @@ -448,3 +448,38 @@ sanity_num_mark <- function(digits, num_mark_big, num_mark_dec) {
if (num_mark_dec != ".") stop("`num_mark_dec` requires a `digits` value.", call. = FALSE)
}
}

get_deleted_cells <- function(sty) {
# If no spanning cells, return empty data frame
if (!any(!is.na(sty$colspan) | !is.na(sty$rowspan))) {
return(data.frame(row = integer(0), col = integer(0)))
}

# Get rows with spanning cells
span_rows <- which(!is.na(sty$colspan) | !is.na(sty$rowspan))

deleted_cells <- lapply(span_rows, function(idx) {
colspan <- sty$colspan[idx]
rowspan <- sty$rowspan[idx]
row <- sty$row[idx]
col <- sty$col[idx]

# Convert NA to 1 for non-spanning dimension
colspan <- if(is.na(colspan)) 1L else as.integer(colspan)
rowspan <- if(is.na(rowspan)) 1L else as.integer(rowspan)

# Create grid of all spanned cells
grid <- expand.grid(
row = row:(row + rowspan - 1),
col = col:(col + colspan - 1)
)

# Remove the original cell
grid <- grid[!(grid$row == row & grid$col == col), ]

return(grid)
})

# Combine all deleted cells
do.call(rbind, deleted_cells)
}
38 changes: 36 additions & 2 deletions R/style_bootstrap.R
Original file line number Diff line number Diff line change
Expand Up @@ -51,13 +51,23 @@ setMethod(
)
css <- rep("", nrow(rec))

del <- get_deleted_cells(sty)
if (nrow(del) > 0) {
rec <- merge(rec, del, all.x = TRUE,sort = FALSE)
} else {
rec$tinytable_deleted_cell <- FALSE
}

for (row in seq_len(nrow(sty))) {
# index: sty vs rec
idx_i <- sty$i[row]
if (is.na(idx_i)) idx_i <- unique(rec$i)
idx_j <- sty$j[row]
if (is.na(idx_j)) idx_j <- unique(rec$j)
idx <- rec$i == idx_i & rec$j == idx_j
idx <- idx_line <- (rec$i %in% idx_i & rec$j %in% idx_j)

# deleted cells with rowspan or colspan are not styled but have lines
idx[which(rec$tinytable_deleted_cell)] <- FALSE

if (isTRUE(sty[row, "bold"])) css[idx] <- paste(css[idx], "font-weight: bold;")
if (isTRUE(sty[row, "italic"])) css[idx] <- paste(css[idx], "font-style: italic;")
Expand Down Expand Up @@ -96,7 +106,7 @@ setMethod(
if (template != "") {
lin <- paste(lin, sprintf(template, line_color, line_width))
}
css[idx] <- paste(css[idx], lin)
css[idx_line] <- paste(css[idx_line], lin)
}

css <- gsub(" +", " ", trimws(css))
Expand All @@ -106,6 +116,7 @@ setMethod(
rec$j <- rec$j - 1



# spans: before styles because we return(x) if there is no style
for (row in seq_len(nrow(sty))) {
rowspan <- if (!is.na(sty$rowspan[row])) sty$rowspan[row] else 1
Expand Down Expand Up @@ -146,3 +157,26 @@ setMethod(
return(x)
}
)




get_deleted_cells <- function(sty) {
out <- sty[which(sty$rowspan > 1 | sty$colspan > 1), ]
if (nrow(out) == 0) return(out)
out$rowspan <- ifelse(is.na(out$rowspan), 1, out$rowspan)
out$colspan <- ifelse(is.na(out$colspan), 1, out$colspan)
out <- lapply(seq_len(nrow(out)), function(k) {
row <- out[k, , drop = FALSE]
del <- expand.grid(
i = row$i:(row$i + row$rowspan - 1),
j = row$j:(row$j + row$colspan - 1)
)
del <- del[!(del$i == row$i & del$j == row$j), ]
return(del)
})
out <- do.call(rbind, out)
out$tinytable_deleted_cell <- TRUE
sty <- merge(sty, out, all.x = TRUE)
return(out)
}
2 changes: 1 addition & 1 deletion man/knit_print.tinytable.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 4eccfda

Please sign in to comment.