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?
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"))
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)
Related
I have a gt() table in a quarto document in which cells are color filled based on their value. I would like to know if it is possible to add a color legend scale, like in a ggplot.
Thanks,
Pedro
You could add a small GT table above your table that requires a legend.
{r}
library(gt)
df <- data.frame(Lessthan5 = 'Less than 5',
Equalto5 = 'Equal to 5',
GreaterThan5 = 'Grater than 5') %>%
gt() %>%
tab_style(style = cell_fill(color = '#eeca87'),
locations = cells_body(columns=c(Lessthan5),
rows = Lessthan5 == 'Less than 5')) %>%
tab_style(style = cell_fill(color = '#c5c5c5'),
locations = cells_body(columns=c(Equalto5),
rows = Equalto5 == 'Equal to 5')) %>%
tab_style(style = cell_fill(color = '#4EB89B'),
locations = cells_body(columns=c(GreaterThan5),
rows = GreaterThan5 == 'Grater than 5')) %>%
tab_options(column_labels.font.size = 0)
{r}
library(gt)
iris %>%
gt() %>%
tab_style(style = cell_fill(color = '#eeca87'),
locations = cells_body(columns=c(Sepal.Length),
rows = Sepal.Length < 5)) %>%
tab_style(style = cell_fill(color = '#c5c5c5'),
locations = cells_body(columns=c(Sepal.Length),
rows = Sepal.Length == 5)) %>%
tab_style(style = cell_fill(color = '#4EB89B'),
locations = cells_body(columns=c(Sepal.Length),
rows = Sepal.Length > 5))
Is there any way to colour individual cells in according their values using something like tidyselect syntax? Here I have some chicken_* columns and some ox_*. Right now I would colour separately in tab_style calls:
set.seed(42)
library(tibble)
library(gt)
df <- tibble(
chicken_mm = runif(10),
chicken_g = runif(10),
ox_mm = runif(10),
ox_g = runif(10)
)
df %>%
gt() %>%
tab_style(
style = cell_fill(color = "#2dc937", alpha = 0.5),
locations = cells_body(
columns = chicken_mm,
rows = chicken_g >= 0.5
)
) %>%
tab_style(
style = cell_fill(color = "#2dc937", alpha = 0.5),
locations = cells_body(
columns = ox_mm,
rows = ox_g >= 0.5
)
)
This works fine but if you have multiple columns it can get really long with a lot of manual steps. Ultimately what I am hoping for is something like this:
df %>%
gt() %>%
tab_style(
style = cell_fill(color = "#2dc937", alpha = 0.5),
locations = cells_body(
columns = ends_with("_mm"),
rows = ends_with("_g") >= 0.5
)
)
Can anyone recommend a good strategy here?
We could use a for loop and update the object
library(gt)
library(dplyr)
library(tibble)
dfgt <- df %>%
gt()
mm_cols <- grep("_mm$", names(df), value = TRUE)
g_cols <- sub("_mm", "_g", mm_cols)
for(i in seq_along(mm_cols)) {
dfgt <- dfgt %>%
tab_style(
style = cell_fill(color = "#2dc937", alpha = 0.5),
locations = cells_body(
columns = mm_cols[i],
rows = !! rlang::sym(g_cols[i]) >= 0.5
)
)
}
dfgt
-output
I have this small data set and I'd like to apply a fill and change the text colour to white in the cell with the largest value between the first (team_1) and third (team_2) columns. How can I do this in gt? For example, 25.9 should be filled blue and coloured white, while 17.6 is left alone an so on. I presume it will have something to do with tab_options(). Thanks.
library(gt)
dat <- data.frame(
team_1 = c(17.6, 33, 6),
stat = c("stat1", "stat2", "stat3"),
team_2 = c(25.9, 28, 8)
)
You can do:
library(gt)
dat %>%
gt() %>%
tab_style(
style = list(cell_fill(color = "blue"),
cell_text(color = "white")),
locations = cells_body(columns = team_1,
rows = team_1 > team_2)
) %>%
tab_style(
style = list(cell_fill(color = "blue"),
cell_text(color = "white")),
locations = cells_body(columns = team_2,
rows = team_2 > team_1)
)
This question is related to this one: How can I color the same value in the same color in the entire gt table in R?
Basically the OP asks to change the font color in an gt object conditionally:
if value == 4 -> font blue
if value == 0 -> font red
It turned out that it is not as easy as I thought. I managed to change the colors in specific columns like:
library(gt)
library(dplyr)
mtcars %>%
gt() %>%
tab_style(
style = cell_text(color = "red", weight = "bold"),
locations = cells_body(
columns = am,
rows = am == 0
)
) %>%
tab_style(
style = cell_text(color = "blue", weight = "bold"),
locations = cells_body(
columns = cyl,
rows = cyl == 4
)
)
which gives:
My question:
How can I modify my code to apply these condition to all columns!
e.g all 0 are red and all 4 are blue!
If we want only to do this on particular columns, create a vector of names ('nm1') and loop over only those columns, within the loop, get the index that meets the condition in rows
library(dplyr)
library(gt)
tbl1 <- mtcars %>%
gt()
nm1 <- c("cyl", "vs", "am", "gear", "carb")
for(i in seq_along(nm1)) {
tbl1 <- tbl1 %>%
tab_style(
style = list(
cell_text(color = "red", weight = "bold")
),
locations = cells_body(
columns = nm1[i],
rows = tbl1$`_data`[[nm1[i]]] == 0
)
) %>%
tab_style(
style = list(
cell_text(color = "blue", weight = "bold")
),
locations = cells_body(
columns = nm1[i],
rows = tbl1$`_data`[[nm1[i]]] == 4
)
)
}
-output
Another option would be to create the gt object in each column using across, store as_raw_html and then call the gt on top of the output with fmt_markdown
out <- mtcars %>%
summarise(across(everything(), ~
setNames(tibble(.x), cur_column()) %>%
gt() %>%
tab_style(
style = cell_text(color = "red", weight = "bold"),
locations = cells_body(
columns = cur_column(),
rows = .x == 0
)
) %>%
tab_style(
style = cell_text(color = "blue", weight = "bold"),
locations = cells_body(
columns = cur_column(),
rows = .x == 4
)
) %>%
as_raw_html()
))
out1 <- out %>%
gt() %>%
fmt_markdown(columns = everything())
out1
I am using GT package in R to create tables for my diploma thesis and I ran into a problem. The diploma is to be written in the czech language.
When GT draws the table it does not display the letter ě properly and shows e instead.
The code for GT table:
desc_sex[,2:ncol(desc_sex)] %>% gt(rowname_col = "sex"
) %>% tab_stubhead(
label = html("Kategorie")
) %>% cols_align(
align = "center",
columns = everything()
) %>% cols_label(
n = html("n"),
procent = html("%")
) %>% tab_row_group(
label = html("<b>Sledované regiony celkem"),
rows = 7:9
) %>% tab_row_group(
label = html("<b>Krajský soud v Ostravě"),
rows = 4:6
) %>% tab_row_group(
label = html("<b>Městský soud v Praze"),
rows = 1:3
) %>% summary_rows(
groups = T,
fns = list(
Celkem = ~sum(.)),
formatter = fmt_number,
decimals = 0
)
Here are the data in CSV compliant format:
"reg_reside","sex","n","procent","single"
"MSPH","Muž",93,46.5,52
"MSPH","Žena",83,41.5,34
"MSPH","Manželský pár",24,12,0
"KSOS","Muž",113,56.5,51
"KSOS","Žena",68,34,30
"KSOS","Manželský pár",19,9.5,0
"Celkem","Muž",206,51.5,103
"Celkem","Žena",151,37.8,64
"Celkem","Manželský pár",43,10.8,0
Here is how the output looks in GT - the mistake is in Ostrave (should be Ostravě) and Mestsky (should be Městský):
You can try using html entities like i.e. ě = ě
desc_sex[,2:ncol(desc_sex)] %>%
gt(rowname_col = "sex") %>%
tab_stubhead(label = html("Kategorie")) %>%
cols_align(align = "center",columns = everything()) %>%
cols_label(n = html("n"),
procent = html("%")) %>%
tab_row_group(label = html("<b>Sledované regiony celkem"),
rows = 7:9) %>%
tab_row_group(label = html("<b>Krajský soud v Ostravě"),
rows = 4:6) %>%
tab_row_group(label = html("<b>Městský soud v Praze"),
rows = 1:3) %>%
summary_rows(groups = T,
fns = list(Celkem = ~sum(.)),
formatter = fmt_number,
decimals = 0)