Search code examples
rgt

gt summary rows - position label in existing column

I have created a gt table and I want to have a row at the bottom of the table with the sum of all the columns. I want to position this so that the row label "total" sits within an existing column (the column catchment in my example) rather than out to the side. How do I do this?

enter image description here

library(gt)  # package for making tables
library(tidyverse)
library(webshot)

webshot::install_phantomjs()

Lake_name <- c("Okareka", "Okaro", "Okataina", "Rerewhakaaitu", "Rotokakahi", "Rotomahana", "Tarawera", "Tikitapu")
Lake_labels <- c("\u14ckareka", "\u14ckaro", "\u14ckataina", "Rerewhakaaitu", "Rotokakahi", "Rotomahana", "Tarawera", "Tikitapu")

#define catchment areas


LIDAR_areas <- c(19778484, 3679975, 62923350, 52941258, 19195848, 83698343, 145261086, 5728184) # m^2
White_SW_areas <- c(19963914.610, 3675087.968, 66900327.220, 54581284.030, 19207814.960, 83724917.460, 144895034.400, 5689356.743)
White_GW_areas <- c(12485786, 3675525, 70924376, 15180499, 13491567, 101632751, 159285183, 5604187)

Catchment_Areas <- as_tibble(cbind(Lake_labels, LIDAR_areas, White_SW_areas, White_GW_areas))
Catchment_Areas$LIDAR_areas <- as.numeric(Catchment_Areas$LIDAR_areas)
Catchment_Areas$White_SW_areas <- as.numeric(Catchment_Areas$White_SW_areas)
Catchment_Areas$White_GW_areas <- as.numeric(Catchment_Areas$White_GW_areas)

f <- function(x){(x/1000000)}
Catchment_Areas <- Catchment_Areas %>% mutate(across(c(LIDAR_areas, White_GW_areas, White_SW_areas), f))

Catchment_Areas_Table <-
  Catchment_Areas %>%
  gt() %>%
  tab_header(title = md("**Catchment Areas (m<sup>2</sup> x 10<sup>6</sup>)**")) %>%
  fmt_number(columns = c(LIDAR_areas, White_GW_areas, White_SW_areas), decimals = 2) %>%
  cols_align(columns = c(LIDAR_areas, White_GW_areas, White_SW_areas), align = "right") %>%
  cols_label(Lake_labels = "Catchment", LIDAR_areas = "Surface Water (LIDAR)", White_SW_areas = "Surface Water (White 2020)", White_GW_areas = "Groundwater (White 2020)") %>%
  tab_style( # add black underline
    style = list(
      cell_borders(
        sides = c("bottom"),
        color = "black",
        weight = px(2)
      )#,
      #cell_fill(color = "grey")
    ),
    locations = list(
      cells_column_labels(
        columns = gt::everything()
      )
    )
  ) %>%
  tab_style( # add black underline
    style = list(
      cell_borders(
        sides = c("top"),
        color = "black",
        weight = px(2)
      )#,
      #cell_fill(color = "grey")
    ),
    locations = list(
      cells_title()
    )
  )


Catchment_Areas_Table %>% summary_rows(columns = c(LIDAR_areas, White_GW_areas, White_SW_areas), fns = list(Total = "sum"))
Solution

  • Option 1: Move your "Catchment"/Lake_labels column into `gt(rowname_col = "Lake_labels"), this moves them into the "stub" and aligns with the summary calculations.

    Option 2: Pre-calculate the summary rows ahead of time. This means you can treat the summary row as another other cell value.

    Reprex below (note that I converted your dataframe to a tribble so it's more compact to reprex, datapasta::tribble_paste() is amazing for this):

    library(gt) # package for making tables
library(tidyverse)
library(webshot)

Catchment_Areas <- tibble::tribble(
  ~Lake_labels, ~LIDAR_areas, ~White_SW_areas, ~White_GW_areas,
  "Ōkareka",    19.778484,     19.96391461,       12.485786,
  "Ōkaro",     3.679975,     3.675087968,        3.675525,
  "Ōkataina",     62.92335,     66.90032722,       70.924376,
  "Rerewhakaaitu",    52.941258,     54.58128403,       15.180499,
  "Rotokakahi",    19.195848,     19.20781496,       13.491567,
  "Rotomahana",    83.698343,     83.72491746,      101.632751,
  "Tarawera",   145.261086,     144.8950344,      159.285183,
  "Tikitapu",     5.728184,     5.689356743,        5.604187
)


### Option 1
Catchment_Areas_Table <-
  Catchment_Areas %>%
  gt(rowname_col = "Lake_labels") %>%
  tab_header(title = md("**Catchment Areas (m<sup>2</sup> x 10<sup>6</sup>)**")) %>%
  fmt_number(columns = c(LIDAR_areas, White_GW_areas, White_SW_areas), decimals = 2) %>%
  cols_align(columns = c(LIDAR_areas, White_GW_areas, White_SW_areas), align = "right") %>%
  cols_label(Lake_labels = "Catchment", LIDAR_areas = "Surface Water (LIDAR)", 
             White_SW_areas = "Surface Water (White 2020)", White_GW_areas = "Groundwater (White 2020)") %>%
  tab_style( # add black underline
    style = list(
      cell_borders(
        sides = c("bottom"),
        color = "black",
        weight = px(2)
      ) # ,
      # cell_fill(color = "grey")
    ),
    locations = list(
      cells_column_labels(
        columns = gt::everything()
      )
    )
  ) %>%
  tab_style( # add black underline
    style = list(
      cell_borders(
        sides = c("top"),
        color = "black",
        weight = px(2)
      ) 
    ),
    locations = list(
      cells_title(),
      cells_stub(rows = 1)
    )
  ) %>%
  summary_rows(
    columns = c(LIDAR_areas, White_GW_areas, White_SW_areas), 
    fns = list(Total = "sum")
  )
#> Warning in if ((loc$groups %>% rlang::eval_tidy()) == "title") {: the condition
#> has length > 1 and only the first element will be used

gtsave(Catchment_Areas_Table, "rowname_tab.png")


    ### Option 2

# Create summary ahead of time, add to bottom of the existing df.
Catchment_Areas_Sum <- Catchment_Areas %>% 
  add_row(
    Catchment_Areas %>% 
      summarise(across(LIDAR_areas:last_col(), sum)) %>% 
      mutate(Lake_labels = "Total")
  ) 

Catchment_Areas_Table_Sum <-
  Catchment_Areas_Sum %>%
  gt() %>%
  tab_header(title = md("**Catchment Areas (m<sup>2</sup> x 10<sup>6</sup>)**")) %>%
  fmt_number(columns = c(LIDAR_areas, White_GW_areas, White_SW_areas), decimals = 2) %>%
  cols_align(columns = c(LIDAR_areas, White_GW_areas, White_SW_areas), align = "right") %>%
  cols_label(Lake_labels = "Catchment", LIDAR_areas = "Surface Water (LIDAR)", 
             White_SW_areas = "Surface Water (White 2020)", White_GW_areas = "Groundwater (White 2020)") %>%
  tab_style( # add black underline
    style = list(
      cell_borders(
        sides = c("bottom"),
        color = "black",
        weight = px(2)
      ) 
    ),
    locations = list(
      cells_column_labels(
        columns = gt::everything()
      )
    )
  ) %>%
  tab_style( # add black underline
    style = list(
      cell_borders(
        sides = c("top"),
        color = "black",
        weight = px(2)
      ) 
    ),
    locations = list(
      cells_title()
    )
  ) %>% 
  tab_style(
    style = cell_borders(
      sides = c("top"), color = "black", weight = px(2)
    ),
    locations = list(
      cells_body(rows = Lake_labels == "Total")
    )
  )
#> Warning in if ((loc$groups %>% rlang::eval_tidy()) == "title") {: the condition
#> has length > 1 and only the first element will be used

gtsave(Catchment_Areas_Table_Sum, "pre_sum_tab.png")

    Created on 2021-10-29 by the reprex package (v2.0.1)