The gtExtra package is an extension of the gt package and has a whole lot of really useful functions for creating summary tables and data visualizations. The code and video below run through a number of examples but one of my favourite ones is gt_plt_summary() which will summarize all of the variables in a dataset.
Some of the others include win-loss plots that are very useful for any kind of sports analytics (although I think there could be other commercial and dashboard uses for them too) and the ability to add images to tables to produce something like this:
Subscribe to stay up to date on my latest videos, courses, and content
library(tidyverse) library(gt) library(gtExtras) # quick summary graphs & figures gt_plt_summary(datasets::ChickWeight) # highlight a row head(mtcars[,1:5]) %>% tibble::rownames_to_column("car") %>% gt() %>% gt_highlight_rows(rows = 2, font_weight = "normal") # add images to a table teams <- "https://github.com/nflverse/nflfastR-data/raw/master/teams_colors_logos.rds" team_df <- readRDS(url(teams)) logo_table <- team_df %>% dplyr::select(team_wordmark, team_abbr, logo = team_logo_espn, team_name:team_conf) %>% head() %>% gt() %>% gt_img_rows(columns = team_wordmark, height = 25) %>% gt_img_rows(columns = logo, img_source = "web", height = 30) %>% tab_options(data_row.padding = px(1)) logo_table # win loss plots set.seed(37) data_in <- dplyr::tibble( grp = rep(c("A", "B", "C"), each = 10), wins = sample(c(0,1,.5), size = 30, prob = c(0.45, 0.45, 0.1), replace = TRUE) ) %>% dplyr::group_by(grp) %>% dplyr::summarize(wins=list(wins), .groups = "drop") data_in win_table <- data_in %>% gt() %>% gt_plt_winloss(wins) win_table # A big example library(nflreadr) games_df <- nflreadr::load_schedules() %>% filter(season == 2020, game_type == "REG") %>% select(game_id, team_home = home_team, team_away = away_team, result, week) %>% pivot_longer(contains('team'), names_to = 'home_away', values_to = 'team', names_prefix = 'team_') %>% mutate( result = ifelse(home_away == 'home', result, -result), win = ifelse(result == 0 , 0.5, ifelse(result > 0, 1, 0)) ) %>% select(week, team, win) %>% mutate( team = case_when( team == 'STL' ~ 'LA', team == 'OAK' ~ 'LV', team == 'SD' ~ 'LAC', T ~ team ) ) team_df <- nflreadr::load_teams() %>% select(team_wordmark, team_abbr, team_conf, team_division) joined_df <- games_df %>% group_by(team) %>% summarise( Wins = length(win[win==1]), Losses = length(win[win==0]), outcomes = list(win), .groups = "drop") %>% left_join(team_df, by = c("team" = "team_abbr")) %>% select(team_wordmark, team_conf, team_division, Wins:outcomes) final_df <- joined_df %>% filter(team_conf == "AFC") %>% group_by(team_division) %>% arrange(desc(Wins)) %>% ungroup() %>% arrange(team_division) final_df %>% gt(groupname_col = "team_division") %>% gt_plt_winloss(outcomes, max_wins = 16) %>% gt_img_rows(columns = team_wordmark) %>% gt_theme_538() %>% tab_header(title = "2020 Results by Division for the AFC")