I have made a table using gt_tables and I want to save it as a .png. When I use gtsave, it always crops out half the table, even if I set the vwidth really high.
This code was working until this week. Is this due to underlying webshot2?
for (k in 1:nrow(ta)) {
A <- final_ta[[k]]
for (j in 1:max(A$id)) {
B <- A %>% filter(id == j)
gt_tables[[as.character(k)]][[as.character(j)]] <- B
gt(groupname_col = "Test", row_group_as_column = TRUE) %>% # group by test
# styling table
cols_align(align = "center") %>% # align cell text to center
tab_style(style = list(cell_text(align = "center", v_align = "middle", weight = "bold", size = px(20)), cell_fill(color = "#D5F5FF"), # style of test column,
cell_borders(sides = c("top", "right", "bottom"), color = "white", weight = px(30))),
locations = cells_row_groups()) %>%
tab_style(style = list(cell_borders(sides = c("top", "bottom"), color = "white", weight = px(30)), # style of cells - use a white border to make it look like a box inside cell
cell_borders(sides = c("right", "left"), color = "white", weight = px(50))),
locations = cells_body()) %>%
tab_style(style = list(cell_borders(sides = c("right"), color = "white", weight = px(0))), # remove padding from RHS
locations = cells_body(columns = contains("Immediate"))) %>%
tab_style(style = list(cell_text(weight = "bold", color = "white", size = px(20)), cell_fill(color = "#001E43"), # style of headers
cell_borders(sides = c("bottom"), color = "white", weight = px(10))),
locations = list(cells_column_spanners(), cells_column_labels(), cells_stubhead())) %>%
cols_width(Test~ px(340), contains("Col") ~ px(410)) %>%
}
}
current_table <- gt_tables[[1]]
gtsave(current_table, filename = "test3.png", vwidth = 1980, vheight = 1080)
The main issue was that the gt() and subsequent styling methods were not being assigned back to the table. I added a pipe (%>%) to chain these styling methods to the B dataframe:
library(gt_t)
library(dplyr)
library(webshot2)
# Sample data for ta
ta <- data.frame(
group = c("Group1", "Group2"),
stringsAsFactors = FALSE
)
# Sample data for final_ta
final_ta <- list(
# First group
data.frame(
id = c(1, 1, 2, 2),
Test = c("Test A", "Test A", "Test B", "Test B"),
Immediate_Col1 = c(10, 15, 20, 25),
Immediate_Col2 = c(5, 7, 12, 14),
stringsAsFactors = FALSE
),
# Second group
data.frame(
id = c(1, 1, 2, 2),
Test = c("Test X", "Test X", "Test Y", "Test Y"),
Immediate_Col1 = c(30, 35, 40, 45),
Immediate_Col2 = c(8, 9, 16, 17),
stringsAsFactors = FALSE
)
)
# Initialize gt_tables as a nested list structure
gt_tables <- vector("list", length(final_ta))
names(gt_tables) <- as.character(1:length(final_ta))
for (k in 1:length(final_ta)) {
gt_tables[[k]] <- vector("list", length(unique(final_ta[[k]]$id)))
names(gt_tables[[k]]) <- as.character(unique(final_ta[[k]]$id))
}
for (k in 1:nrow(ta)) {
A <- final_ta[[k]]
for (j in 1:max(A$id)) {
B <- A %>% filter(id == j)
gt_tables[[as.character(k)]][[as.character(j)]] <- B %>% # Inserted pipe operator here
gt(groupname_col = "Test", row_group_as_column = TRUE) %>% # group by test
# styling table
cols_align(align = "center") %>% # align cell text to center
tab_style(style = list(cell_text(align = "center", v_align = "middle", weight = "bold", size = px(20)), cell_fill(color = "#D5F5FF"), # style of test column,
cell_borders(sides = c("top", "right", "bottom"), color = "white", weight = px(30))),
locations = cells_row_groups()) %>%
tab_style(style = list(cell_borders(sides = c("top", "bottom"), color = "white", weight = px(30)), # style of cells - use a white border to make it look like a box inside cell
cell_borders(sides = c("right", "left"), color = "white", weight = px(50))),
locations = cells_body()) %>%
tab_style(style = list(cell_borders(sides = c("right"), color = "white", weight = px(0))), # remove padding from RHS
locations = cells_body(columns = contains("Immediate"))) %>%
tab_style(style = list(cell_text(weight = "bold", color = "white", size = px(20)), cell_fill(color = "#001E43"), # style of headers
cell_borders(sides = c("bottom"), color = "white", weight = px(10))),
locations = list(cells_column_spanners(), cells_column_labels(), cells_stubhead())) %>%
cols_width(Test~ px(340), contains("Col") ~ px(410))
}
}
# Save the first table
current_table <- gt_tables[[1]][[1]] # Assuming you want the first table from the first group
gtsave(current_table, filename = "test3.png", vwidth = 1980, vheight = 1080)
It's a more R-approach :)
# Create gt_tables in a more concise way
gt_tables <- final_ta %>%
lapply(function(df) {
df %>%
split(.$id) %>%
lapply(function(group) {
group %>%
gt(groupname_col = "Test", row_group_as_column = TRUE) %>%
cols_align(align = "center") %>%
tab_style(
style = list(
cell_text(align = "center", v_align = "middle", weight = "bold", size = px(20)),
cell_fill(color = "#D5F5FF"),
cell_borders(sides = c("top", "right", "bottom"), color = "white", weight = px(30))
),
locations = cells_row_groups()
) %>%
tab_style(style = list(cell_borders(sides = c("top", "bottom"), color = "white", weight = px(30)), # style of cells - use a white border to make it look like a box inside cell
cell_borders(sides = c("right", "left"), color = "white", weight = px(50))),
locations = cells_body()) %>%
tab_style(style = list(cell_borders(sides = c("right"), color = "white", weight = px(0))), # remove padding from RHS
locations = cells_body(columns = contains("Immediate"))) %>%
tab_style(style = list(cell_text(weight = "bold", color = "white", size = px(20)), cell_fill(color = "#001E43"), # style of headers
cell_borders(sides = c("bottom"), color = "white", weight = px(10))),
locations = list(cells_column_spanners(), cells_column_labels(), cells_stubhead())) %>%
cols_width(Test~ px(340), contains("Col") ~ px(410))
})
})