R package gtsave cropping image, despite setting vwidth

Question

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
                 
      cols_width(Test~ px(340), contains("Col") ~ px(410)) %>%
    
  }
}
  

current_table <- gt_tables[[1]]
 gtsave(current_table, filename = "test3.png", vwidth = 1980, vheight = 1080)

Answer 1

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)

Also consider using split to group by id and then lapply()

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))
      })
  })