Recreating a {gt} #1208
JanMarvin
started this conversation in
Show and tell
Recreating a {gt}
#1208
Replies: 1 comment 1 reply
-
|
This might interest you, @yannsay. I poked around with something similar to your 
|
Beta Was this translation helpful? Give feedback.
1 reply
-
|
Another version adding the row groups with a hack: # Load libraries
library(gt)
library(dplyr)
# Example data
data <- data.frame(
Name = c("Alice", "Bob", "Charlie", "Diana"),
Age = c(23, 34, 28, 19),
Score = c(85.4, 92.1, 77.5, 89.3)
)
# ---- GT Table ----
gt_table <- data %>%
gt() %>%
tab_header(
title = "Student Scores",
subtitle = "A summary of student performance"
) %>%
fmt_number(
columns = c(Score),
decimals = 1
) %>%
tab_style(
style = list(
cell_fill(color = "lightblue"),
cell_text(weight = "bold")
),
locations = cells_body(rows = Score > 90)
) %>%
tab_style(
style = cell_text(color = "red"),
locations = cells_body(columns = c(Age), rows = Age < 20)
)
library(gt)
# Define the start and end dates for the data range
start_date <- "2010-06-07"
end_date <- "2010-06-14"
# Create a gt table based on preprocessed
# `sp500` table data
# gt_table <- sp500 |>
# dplyr::filter(date >= start_date & date <= end_date) |>
# dplyr::select(-adj_close) |>
# gt() |>
# tab_header(
# title = "S&P 500",
# subtitle = glue::glue("{start_date} to {end_date}")
# ) |>
# fmt_currency() |>
# fmt_date(columns = date, date_style = "wd_m_day_year") |>
# fmt_number(columns = volume, suffixing = TRUE)
# Use dplyr functions to get the car with the best city gas mileage;
# this will be used to target the correct cell for a footnote
best_gas_mileage_city <-
gtcars |>
arrange(desc(mpg_c)) |>
slice(1) |>
mutate(car = paste(mfr, model)) |>
pull(car)
# Use dplyr functions to get the car with the highest horsepower
# this will be used to target the correct cell for a footnote
highest_horsepower <-
gtcars |>
arrange(desc(hp)) |>
slice(1) |>
mutate(car = paste(mfr, model)) |>
pull(car)
# Define our preferred order for `ctry_origin`
order_countries <- c("Germany", "Italy", "United States", "Japan")
# Create a display table with `gtcars`, using all of the previous
# statements piped together + additional `tab_footnote()` stmts
tab <-
gtcars |>
arrange(
factor(ctry_origin, levels = order_countries),
mfr, desc(msrp)
) |>
mutate(car = paste(mfr, model)) |>
select(-mfr, -model) |>
group_by(ctry_origin) |>
gt(rowname_col = "car") |>
cols_hide(columns = c(drivetrain, bdy_style)) |>
cols_move(
columns = c(trsmn, mpg_c, mpg_h),
after = trim
) |>
tab_spanner(
label = "Performance",
columns = c(mpg_c, mpg_h, hp, hp_rpm, trq, trq_rpm)
) |>
cols_merge(
columns = c(mpg_c, mpg_h),
pattern = "<<{1}c<br>{2}h>>"
) |>
cols_merge(
columns = c(hp, hp_rpm),
pattern = "{1}<br>@{2}rpm"
) |>
cols_merge(
columns = c(trq, trq_rpm),
pattern = "{1}<br>@{2}rpm"
) |>
cols_label(
mpg_c = "MPG",
hp = "HP",
trq = "Torque",
year = "Year",
trim = "Trim",
trsmn = "Transmission",
msrp = "MSRP"
) |>
fmt_currency(columns = msrp, decimals = 0) |>
cols_align(
align = "center",
columns = c(mpg_c, hp, trq)
) |>
tab_style(
style = cell_text(size = px(12)),
locations = cells_body(
columns = c(trim, trsmn, mpg_c, hp, trq)
)
) |>
text_transform(
locations = cells_body(columns = trsmn),
fn = function(x) {
speed <- substr(x, 1, 1)
type <-
dplyr::case_when(
substr(x, 2, 3) == "am" ~ "Automatic/Manual",
substr(x, 2, 2) == "m" ~ "Manual",
substr(x, 2, 2) == "a" ~ "Automatic",
substr(x, 2, 3) == "dd" ~ "Direct Drive"
)
paste(speed, " Speed<br><em>", type, "</em>")
}
) |>
tab_header(
title = md("The Cars of **gtcars**"),
subtitle = "These are some fine automobiles"
) |>
tab_source_note(
source_note = md(
"Source: Various pages within the Edmonds website."
)
) |>
tab_footnote(
footnote = md("Best gas mileage (city) of all the **gtcars**."),
locations = cells_body(
columns = mpg_c,
rows = best_gas_mileage_city
)
) |>
tab_footnote(
footnote = md("The highest horsepower of all the **gtcars**."),
locations = cells_body(
columns = hp,
rows = highest_horsepower
)
) |>
tab_footnote(
footnote = "All prices in U.S. dollars (USD).",
locations = cells_column_labels(columns = msrp)
)
# Show the table
gt_table <- tab
# gt_table <- sp500 |>
# dplyr::filter(date >= start_date & date <= end_date) |>
# dplyr::select(-adj_close) |>
# gt()
# gt_table$`_data` # raw data
# gt_table$`_boxhead` # column header
# gt_table$`_stub_df` # row header ?
# gt_table$`_spanners` # merged cells?
# gt_table$`_footnotes`
# gt_table$`_styles` # cell styles
# gt_table$`_options`
# gt_table$`_row_groups`
# gt_table$`_heading` # header
# gt_table$`_stubhead`
# gt_table$`_source_notes`
# gt_table$`_formats`
# gt_table$`_substitutions`
# gt_table$`_summary`
# gt_table$`_transforms` # transform columns
# gt_table$`_locale`
# gt_table$`_has_built`
# gt_table$`_col_merge`
parse_markdown_to_df <- function(texts, font, size) {
# Define a pattern to match bold (**text**) and italic (*text*) styles
pattern <- "(\\*\\*[^*]+\\*\\*|\\*[^*]+\\*)"
lapply(
texts,
function(text) {
# Split the text using the pattern to separate styled and unstyled parts
matches <- gregexpr(pattern, text, perl = TRUE)
styled_parts <- regmatches(text, matches)[[1]]
# Create a list to hold all parts with their start and end positions
parts <- list()
# Track the current position in the text
pos <- 1
for (match in styled_parts) {
# Add plain text before the styled match (if any)
match_start <- regexpr(match, text, fixed = TRUE)
if (pos < match_start) {
parts <- append(parts, list(
list(
text = substr(text, pos, match_start - 1),
style = "plain"
)
))
}
# Add the styled match
parts <- append(parts, list(
list(
text = gsub("\\*\\*|\\*", "", match), # Remove Markdown markers
style = ifelse(grepl("^\\*\\*.*\\*\\*$", match), "bold", "italic")
)
))
# Update the current position
pos <- match_start + nchar(match)
}
# Add any remaining plain text after the last styled match
if (pos <= nchar(text)) {
parts <- append(parts, list(
list(
text = substr(text, pos, nchar(text)),
style = "plain"
)
))
}
# Convert the parts list into a data frame
df <- do.call(rbind, lapply(parts, function(part) {
data.frame(
text = part$text,
style = part$style,
stringsAsFactors = FALSE
)
}))
tmp_str <- NULL
for (i in seq_len(nrow(df))) {
if (df$style[i] == "plain")
tmp_str <- tmp_str + fmt_txt(df$text[i], font = font, size = size)
if (df$style[i] == "bold")
tmp_str <- tmp_str + fmt_txt(df$text[i], bold = TRUE, font = font, size = size)
if (df$style[i] == "italic")
tmp_str <- tmp_str + fmt_txt(df$text[i], italic = TRUE, font = font, size = size)
}
tmp_str
})
}
# Function to parse HTML-like string into a data frame
parse_html_to_df <- function(texts, font, size) {
# Define a pattern to match <b>bold</b>, <em>italic</em>, and <br/> line breaks
pattern <- "(<b>[^<]+</b>|<em>[^<]+</em>|<br>)"
lapply(texts, function(text) {
if (is.na(text)) return(NA_character_)
# Split the string using the pattern to separate styled and unstyled parts
matches <- gregexpr(pattern, text, perl = TRUE)
styled_parts <- regmatches(text, matches)[[1]]
# Create a list to hold all parts with their start and end positions
parts <- list()
# Track the current position in the text
pos <- 1
for (match in styled_parts) {
# Add plain text before the styled match (if any)
match_start <- regexpr(match, text, fixed = TRUE)
if (pos < match_start) {
parts <- append(parts, list(
list(
text = substr(text, pos, match_start - 1),
style = "plain"
)
))
}
# Handle <b> and <em> tags, and also handle <br/> as a line break
if (grepl("<b>", match)) {
parts <- append(parts, list(
list(
text = gsub("<b>|</b>", "", match), # Remove bold tags
style = "bold"
)
))
} else if (grepl("<em>", match)) {
parts <- append(parts, list(
list(
text = gsub("<em>|</em>", "", match), # Remove italic tags
style = "italic"
)
))
} else if (grepl("<br/>|<br>", match)) {
parts <- append(parts, list(
list(
text = "Line break", # Mark the line break in the text
style = "line break"
)
))
}
# Update the current position
pos <- match_start + nchar(match)
}
# Add any remaining plain text after the last styled match
if (pos <= nchar(text)) {
parts <- append(parts, list(
list(
text = substr(text, pos, nchar(text)),
style = "plain"
)
))
}
# Convert the parts list into a data frame
df <- do.call(rbind, lapply(parts, function(part) {
data.frame(
text = part$text,
style = part$style,
stringsAsFactors = FALSE
)
}))
tmp_str <- NULL
for (i in seq_len(nrow(df))) {
if (df$style[i] == "plain")
tmp_str <- tmp_str + fmt_txt(df$text[i], font = font, size = size)
if (df$style[i] == "bold")
tmp_str <- tmp_str + fmt_txt(df$text[i], bold = TRUE, font = font, size = size)
if (df$style[i] == "italic")
tmp_str <- tmp_str + fmt_txt(df$text[i], italic = TRUE, font = font, size = size)
if (df$style[i] == "line break")
tmp_str <- tmp_str + fmt_txt("\n", italic = TRUE, font = font, size = size)
}
tmp_str
})
}
glue_cols <- function(df, pattern) {
num_blanks <- length(gregexpr("\\{\\d+\\}", pattern)[[1]])
num_cols <- ncol(df)
if (num_blanks != num_cols) {
stop("The number of placeholders in the pattern does not match the number of columns in the dataframe.")
}
all_na <- FALSE
if (grepl("<<", pattern)) all_na <- TRUE
pattern <- gsub("<<|>>", "", pattern)
formatted_strings <- rep(pattern, nrow(df))
placeholder <- paste0("{", seq_len(ncol(df)), "}")
for (i in seq_len(nrow(df))) {
if (all_na && anyNA(x = unlist(df[i, ])))
formatted_strings[i] <- NA
else
formatted_strings[i] <- stringi::stri_replace_all_fixed(formatted_strings[i], placeholder, unlist(df[i, ]), vectorize_all = FALSE)
}
formatted_strings
}
library(openxlsx2)
wb_add_gt <- function(wb, x) {
openxlsx2:::assert_class(x, "gt_tbl")
openxlsx2:::assert_workbook(wb)
wb <- wb$clone()
gt_table <- x
data <- gt_table$`_data` # raw data
head <- gt_table$`_heading`
style <- gt_table$`_styles`
footnotes <- gt_table$`_footnotes`
sourcenotes <- gt_table$`_source_notes`
data_str <- as.data.frame(data)
data_str[] <- lapply(data, as.character)
fmts <- gt_table$`_formats`
for (i in seq_along(fmts)) {
fun <- fmts[[i]]$func$default
cols <- fmts[[i]]$cols
rows <- fmts[[i]]$rows
for (col in cols) {
try({data_str[rows, col] <- fun(data[rows, col])}, silent = TRUE)
}
}
cmerge <- gt_table$`_col_merge`
for (i in seq_along(cmerge)) {
pattern <- cmerge[[i]]$pattern
df <- data[cmerge[[i]]$rows, cmerge[[i]]$vars]
data_str[cmerge[[i]]$vars[1]] <- glue_cols(df, pattern)
}
transforms <- gt_table$`_transforms`
for (i in seq_along(transforms)) {
fun <- transforms[[i]]$fn
cols <- transforms[[i]]$resolved$colnames
rows <- transforms[[i]]$resolved$rows
for (col in cols) {
try({data_str[rows, col] <- fun(data_str[rows, col])})
}
}
ops <- gt_table$`_options`
box_head <- gt_table$`_boxhead`
data_str <- data_str[, box_head$var, drop = FALSE]
font_name <- ops[ops$parameter == "table_font_names", ]$value[[1]][2]
font_size <- as.integer(gsub("\\D+", "", ops[ops$parameter == "table_font_size", ]$value[[1]]))
data_str[] <- lapply(data_str, function(x) c(do.call("rbind", parse_html_to_df(x, font = font_name, size = font_size))))
head_align <- ops[ops$parameter == "heading_align", ]$value[[1]]
font_scale <- as.integer(gsub("\\D+", "", ops[ops$parameter == "heading_title_font_size", ]$value[[1]]))/100
head_size <- as.integer(font_size * font_scale)
font_scale <- as.integer(gsub("\\D+", "", ops[ops$parameter == "heading_subtitle_font_size", ]$value[[1]]))/100
subhead_size <- as.integer(font_size * font_scale)
font_scale <- as.integer(gsub("\\D+", "", ops[ops$parameter == "footnotes_font_size", ]$value[[1]]))/100
footnote_size <- as.integer(font_size * font_scale)
font_scale <- as.integer(gsub("\\D+", "", ops[ops$parameter == "source_notes_font_size", ]$value[[1]]))/100
sourcenote_size <- as.integer(font_size * font_scale)
spanners <- gt_table$`_spanners`
data_str[which(names(data_str) %in% box_head$var[box_head$type == "hidden"])] <- NULL
w <- ncol(data_str)
if (length(gt_table$`_row_groups`)) {
mm <- as.data.frame(matrix("", nrow = length(gt_table$`_row_groups`), ncol = w))
names(mm) <- names(data_str)
mm[ , 1] <- gt_table$`_row_groups`
# n <- ncol(data_str)
data_str <- rbind(data_str, mm)
}
if (!is.null(head$title)) {
dims_title <- wb_dims(1, seq_len(w), from_dims = "B2")
} else {
dims_title <- "B2"
}
if (!is.null(head$subtitle)) {
dims_subtitle <- wb_dims(1, seq_len(w), from_dims = dims_title, below = 1)
} else {
dims_subtitle <- dims_title
}
if (nrow(spanners)) {
dims_spanners <- wb_dims(length(unique(spanners$spanner_level)), seq_len(w), from_dims = dims_subtitle, below = 1)
} else {
dims_spanners <- dims_subtitle
}
below <- 1
if (dims_title == dims_subtitle && dims_title == dims_spanners) below <- 0
dims_data <- wb_dims(x = data_str, from_dims = dims_spanners, below = below)
if (nrow(footnotes)) {
dims_footnote <- wb_dims(seq_len(nrow(footnotes)), seq_len(w), from_dims = dims_data, below = 1)
} else {
dims_footnote <- dims_data
}
if (length(sourcenotes)) {
dims_sourcenote <- wb_dims(seq_len(length(sourcenotes[[1]])), seq_len(w), from_dims = dims_footnote, below = 1)
} else {
dims_sourcenote <- dims_data
}
dims_total <- dataframe_to_dims(
dims_to_dataframe(
paste0(c(dims_title, dims_subtitle, dims_spanners, dims_data, dims_footnote, dims_sourcenote), collapse = ","),
fill = TRUE
)
)
if (!is.null(head$title))
wb$add_data(dims = dims_title, x = parse_markdown_to_df(head$title, font_name, head_size), col_names = FALSE)
if (!is.null(head$subtitle))
wb$add_data(dims = dims_subtitle, x = parse_markdown_to_df(head$subtitle, font_name, subhead_size), col_names = FALSE)
wb$add_data(dims = dims_data, x = data_str)
if (nrow(spanners)) {
for (i in seq_len(nrow(spanners))) {
vars <- spanners$vars[[i]]
vars <- vars[vars %in% names(data_str)]
dims <- wb_dims(x = data_str, cols = vars, rows = spanners$spanner_level, from_dims = dims_subtitle, below = below, col_names = FALSE)
wb$merge_cells(dims = dims)
wb$add_data(dims = dims, x = as.character(spanners$spanner_id[i]))
wb$add_cell_style(dims = dims, horizontal = "center")
}
}
# if (any(box_head$type == "hidden")) {
# offset <- col2int(dims_total)[1] - 1L
# wb$set_col_widths(cols = int2col(which(names(data_str) %in% box_head$var[box_head$type == "hidden"]) + offset), hidden = TRUE)
# }
# if (any(box_head$type == "stub")) {
# stub <- box_head$var[box_head$type == "hidden"]
# rownames(data_str) <- data_str[stub]
# data_str[stub] <- NULL
# }
split_dims <- function(dims, direction = c("row", "col")) {
if (is.numeric(direction)) {
if (direction == 1) direction <- "row"
if (direction == 2) direction <- "col"
}
df <- openxlsx2:::dims_to_dataframe(dims, fill = TRUE)
direction <- match.arg(direction)
if (direction == "row") df <- as.data.frame(t(df))
vapply(df, FUN = function(x) {
fst <- x[1]
snd <- x[length(x)]
sprintf("%s:%s", fst, snd)
}, FUN.VALUE = NA_character_)
}
if (nrow(footnotes)) {
fnt <- data.frame(foot = do.call("rbind", parse_markdown_to_df(footnotes$footnotes, font_name, footnote_size)))
dims <- split_dims(dims_footnote)
for (i in seq_along(dims)) {
footnote <- fnt$foot[i]
class(footnote) <- c("charcter", "fmt_txt")
footnote <- fmt_txt(x = i, vert_align = "superscript", font = font_name, size = footnote_size) + footnote
wb$add_data(dims = dims[i], x = footnote, col_names = FALSE)
wb$merge_cells(dims = dims[i])
}
wb$add_font(dims = dims_footnote, name = font_name, size = footnote_size)
}
if (length(sourcenotes)) {
wb$add_data(dims = dims_sourcenote, x = parse_markdown_to_df(sourcenotes[[1]], font_name, sourcenote_size))
wb$merge_cells(dims = dims_sourcenote)
wb$add_font(dims = dims_sourcenote, name = font_name, size = footnote_size)
}
# wb$set_col_widths(cols = seq_len(w), width = "auto")
wb$set_base_font(font_size = font_size, font_name = font_name)
if (!is.null(head$title)) {
wb$merge_cells(dims = dims_title)
wb$add_font(dims = dims_title, name = font_name, size = head_size)
wb$add_cell_style(dims = dims_title, horizontal = head_align)
}
if (!is.null(head$subtitle)) {
wb$merge_cells(dims = dims_subtitle)
wb$add_font(dims = dims_subtitle, name = font_name, size = subhead_size)
wb$add_cell_style(dims = dims_subtitle, horizontal = head_align)
}
top_color <- wb_color(ops[ops$parameter == "table_border_top_color", ]$value[[1]])
top_style <- ops[ops$parameter == "table_border_top_style", ]$value[[1]]
if (top_style == "solid") top_style <- "thin"
bottom_color <- wb_color(ops[ops$parameter == "table_border_bottom_color", ]$value[[1]])
bottom_style <- ops[ops$parameter == "table_border_bottom_style", ]$value[[1]]
if (bottom_style == "solid") bottom_style <- "thin"
left_color <- wb_color(ops[ops$parameter == "table_border_left_color", ]$value[[1]])
left_style <- ops[ops$parameter == "table_border_left_style", ]$value[[1]]
if (left_style == "solid") left_style <- "thin"
right_color <- wb_color(ops[ops$parameter == "table_border_right_color", ]$value[[1]])
right_style <- ops[ops$parameter == "table_border_right_style", ]$value[[1]]
if (right_style == "solid") right_style <- "thin"
wb$add_border(
dims = dims_total,
top_border = top_style, top_color = top_color,
left_border = left_style, left_color = left_color,
right_border = right_style, right_color = right_color,
bottom_border = bottom_style, bottom_color = bottom_color
)
btop_style <- ops[ops$parameter == "table_body_border_top_style", ]$value[[1]]
if (btop_style == "solid") btop_style <- "thin"
btop_color <- wb_color(ops[ops$parameter == "table_body_border_top_color", ]$value[[1]])
bbottom_style <- ops[ops$parameter == "table_body_border_bottom_style", ]$value[[1]]
if (bbottom_style == "solid") bbottom_style <- "thin"
bbottom_color <- wb_color(ops[ops$parameter == "table_body_border_bottom_color", ]$value[[1]])
hgrid_style <- ops[ops$parameter == "table_body_hlines_style", ]$value[[1]]
if (hgrid_style == "solid") hgrid_style <- "thin"
hgrid_color <- wb_color(ops[ops$parameter == "table_body_hlines_color", ]$value[[1]])
vgrid_style <- ops[ops$parameter == "table_body_vlines_style", ]$value[[1]]
if (vgrid_style == "solid") vgrid_style <- "thin"
vgrid_color <- wb_color(ops[ops$parameter == "table_body_vlines_color", ]$value[[1]])
wb$add_border(
dims = dims_data,
top_border = btop_style, top_color = btop_color,
inner_hgrid = hgrid_style, inner_hcolor = hgrid_color,
inner_vgrid = vgrid_style, inner_vcolor = vgrid_color,
left_border = left_style, left_color = left_color,
right_border = right_style, right_color = right_color,
bottom_border = bbottom_style, bottom_color = bbottom_color
)
for (i in seq_len(nrow(box_head))) {
if (box_head$type[i] == "hidden") next
dims <- wb_dims(x = data_str, select = "col_names", from_dims = dims_spanners, below = below, cols = box_head$var[i])
wb$add_data(dims = dims, x = box_head$column_label[[i]])
wb$add_cell_style(dims = dims, horizontal = box_head$column_align[i])
}
# data styling
for (i in seq_len(nrow(style))) {
snam <- style$colname[i]
srow <- style$rownum[i]
dims <- wb_dims(x = data, from_dims = dims_spanners, below = 1, cols = snam, rows = srow)
color <- style$styles[i][[1]]$cell_fill$color
if (!is.null(color))
wb$add_fill(dims = dims, color = wb_color(color))
bld <- FALSE
if (!is.null(style$styles[i][[1]]$cell_text$weight) && style$styles[i][[1]]$cell_text$weight == "bold")
bld <- TRUE
if (!is.null(style$styles[i][[1]]$cell_text$color))
color <- wb_color(hex = style$styles[i][[1]]$cell_text$color)
else
color <- wb_color(hex = "FF000000")
if (!is.null(style$styles[i][[1]]$cell_text$size))
fnt_size <- gsub("\\D+", "", style$styles[i][[1]]$cell_text$size)
else
fnt_size <- font_size
wb$add_font(dims = dims, bold = bld, color = color, name = font_name, size = fnt_size)
}
for (i in seq_len(nrow(footnotes))) {
cols <- footnotes$colname[i]
rows <- footnotes$rownum[i]
for (col in cols) {
for (row in rows) {
if (any(is.na(c(row, col)))) next
dims <- wb_dims(x = data_str, cols = col, rows = row, from_dims = dims_spanners, below = 1, col_names = TRUE)
cell <- data_str[row, col]
if (!grepl("<r>", cell)) cell <- fmt_txt(cell, font = font_name, size = font_size)
txt_w_fnote <- data_str[row, col] +
fmt_txt(x = i, vert_align = "superscript", font = font_name, size = font_size)
wb$add_data(dims = dims, x = txt_w_fnote, col_names = FALSE)
}
}
}
### dirtly little hack ###
df <- wb_to_df(wb, dims = dims_data)
group_var <- box_head$var[box_head$type == "row_group"]
sel <- is.na(df[group_var])
# Identify the rows to move and the main dataset
rows_to_move <- df[sel, ] # Rows at the end (e.g., NA rows)
main_data <- df[!sel, ] # The rest of the data
# Create the final dataframe
result <- do.call(rbind, lapply(unique(main_data[[group_var]]), function(g) {
# Extract rows for the group
group_rows <- main_data[main_data[[group_var]] == g, ]
# Extract the corresponding row from rows_to_move
additional_row <- rows_to_move[rows_to_move[[1]] == g, ]
# Bind the additional row above the group rows
rbind(additional_row, group_rows)
}))
# print(result)
fin_int <- as.integer(rownames(result))
# ord_int <- order(fin_int) + min(fin_int) - 1L
names(fin_int) <- fin_int
ord_int <- seq_along(fin_int) + min(fin_int) - 1L
names(ord_int) <- fin_int
fin_int <- ord_int
print(fin_int)
cc <- wb$worksheets[[1]]$sheet_data$cc
sel1 <- as.numeric(cc$row_r) %in% rownames(result)
row_r <- as.numeric(cc$row_r[sel1])
cc$row_r[sel1] <- ord_int[as.character(row_r)]
cc$r <- paste0(cc$c_r, cc$row_r)
wb$worksheets[[1]]$sheet_data$cc <- cc
##########################
wb
}
wb <- wb_workbook() |>
wb_add_worksheet(grid_lines = FALSE) |>
wb_add_gt(x = gt_table)
if (interactive()) wb$open() |
Beta Was this translation helpful? Give feedback.
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Uh oh!
There was an error while loading. Please reload this page.
Uh oh!
There was an error while loading. Please reload this page.
-
Spend an evening brute forcing myself into writing the output of a
{gt}table. I had hoped somebody else would create aas_flextable()function, but I couldn't find anything. The code below allows writing basic tables, titles included into a spreadsheet. There is a lot missing, because like I said, I started 3 or 4 hours ago and I know nothing about{gt}.Beta Was this translation helpful? Give feedback.
All reactions