andrewallenbruce / provider

Public Healthcare Provider APIs :stethoscope:
https://andrewallenbruce.github.io/provider/
Other
18 stars 2 forks source link

gt Tables #21

Open andrewallenbruce opened 8 months ago

andrewallenbruce commented 8 months ago
Code

``` r library(provider) library(tidyverse) library(gt) val <- map_dfr(pop_years(), ~by_provider(year = .x, city = "Valdosta", state = "GA")) val |> group_by(year) |> summarise( hcpcs = mean(tot_hcpcs), benes = mean(tot_benes), srvcs = mean(tot_srvcs), charges = mean(tot_charges), allowed = mean(tot_allowed), payment = mean(tot_payment), hcc = mean(hcc_risk_avg)) |> change(!c('year')) |> select(year, 'HCC RISK AVG' = hcc_chg, HCPCS = hcpcs_chg, SERVICES = srvcs_chg, CHARGES = charges_chg, ALLOWED = allowed_chg, PAYMENT = payment_chg) |> pivot_longer(cols = !year, names_to = "metric", values_to = "value") |> filter(year != 2013) |> pivot_wider(names_from = year, values_from = value) |> gt(rowname_col = "metric") |> fmt_number(columns = contains('20'), decimals = 2, sep_mark = "", force_sign = TRUE, suffixing = TRUE) |> opt_table_font(font = google_font(name = "Kanit")) |> cols_hide(columns = contains('20')) |> cols_nanoplot( columns = starts_with("20"), plot_type = "bar", plot_height = "4.5em", new_col_name = "change", new_col_label = "change", missing_vals = "remove", options = nanoplot_options( show_data_line = FALSE, show_data_area = FALSE, data_bar_stroke_color = "transparent", data_bar_negative_stroke_color = "transparent", data_bar_fill_color = "grey", data_bar_negative_fill_color = "red")) |> cols_move_to_start(change) |> cols_align(columns = change, align = "center") |> tab_options(table.width = px(500), column_labels.hidden = TRUE) |> opt_stylize(color = "red", add_row_striping = FALSE) ```

Created on 2023-10-17 with reprex v2.0.2

valdosta

andrewallenbruce commented 8 months ago
Code

``` r library(tictoc) library(provider) library(tidyverse) library(gt) tic() ind <- map_dfr(pop_years(), ~by_provider(year = .x, npi = 1043245657)) #> ✖ No results for year = 2013 and npi = 1043245657 check_xmark <- function(gt_tbl, cols) { gt_tbl |> gt::text_case_when( x == TRUE ~ gt::html( fontawesome::fa("check", prefer_type = "solid", fill = "black")), x == FALSE ~ gt::html( fontawesome::fa("xmark", prefer_type = "solid", fill = "red")), .default = NA, .locations = gt::cells_body( columns = {{ cols }})) } gt <- select(ind, year, tot_benes, demographics) |> unnest(demographics) |> select(-contains("race")) |> mutate(across(c(bene_age_lt65:bene_ndual), \(x) coalesce(x, 0))) |> rowwise() |> mutate(tot_bene_age = sum(c_across(bene_age_lt65:bene_age_gt84), na.rm = TRUE), tot_bene_gen = sum(c_across(bene_gen_female:bene_gen_male), na.rm = TRUE), tot_bene_dual = sum(c_across(bene_dual:bene_ndual), na.rm = TRUE), tot_age_eq = if_else(tot_benes == tot_bene_age, TRUE, FALSE), tot_gen_eq = if_else(tot_benes == tot_bene_gen, TRUE, FALSE), tot_dual_eq = if_else(tot_benes == tot_bene_dual, TRUE, FALSE), verdict = if_else(isTRUE(tot_age_eq) && isTRUE(tot_gen_eq) && isTRUE(tot_dual_eq), TRUE, FALSE), .after = tot_benes) |> select(year, tot_benes, tot_bene_age, tot_age_eq, tot_bene_gen, tot_gen_eq, tot_bene_dual, tot_dual_eq, verdict, bene_age_avg:bene_ndual) |> gt(rowname_col = "year") |> cols_label( tot_benes = "Total", tot_bene_age = "A", tot_age_eq = "", tot_bene_gen = "G", tot_gen_eq = "", tot_bene_dual = "D", tot_dual_eq = "", bene_age_avg = "Avg", bene_age_lt65 = "<65", bene_age_65_74 = "65-74", bene_age_75_84 = "75-84", bene_age_gt84 = ">84", bene_gen_male = "M", bene_gen_female = "F", bene_dual = "1", bene_ndual = "2") |> tab_spanner(label = "Age", columns = c(bene_age_lt65, bene_age_65_74, bene_age_75_84, bene_age_gt84)) |> tab_spanner(label = "Gender", columns = c(bene_gen_male, bene_gen_female)) |> tab_spanner(label = "Dual Status", columns = c(bene_dual, bene_ndual)) |> opt_table_font(font = google_font(name = "JetBrains Mono")) |> sub_missing(missing_text = "") |> sub_zero(zero_text = "") |> opt_all_caps() |> check_xmark(cols = c(tot_age_eq, tot_gen_eq, tot_dual_eq, verdict)) |> opt_stylize(color = "gray") |> tab_header(title = md("**Medicare Part B** Utilization"), subtitle = md("Beneficiary Demographics, 2013-2019")) toc() #> 17.67 sec elapsed ```

Created on 2023-10-18 with reprex v2.0.2

demographics

andrewallenbruce commented 8 months ago
Code

``` r library(tictoc) library(provider) library(tidyverse) library(gt) tic() ind <- map_dfr(pop_years(), ~by_provider(year = .x, npi = 1043245657)) #> ✖ No results for year = 2013 and npi = 1043245657 gt <- select(ind, year, Beneficiaries = tot_benes, Services = tot_srvcs, Charges = tot_charges, Allowed = tot_allowed, Payment = tot_payment) |> pivot_longer(cols = c(Beneficiaries, Services, Charges, Allowed, Payment), names_to = "Type", values_to = "Amount") |> pivot_wider(names_from = year, values_from = Amount) |> gt(rowname_col = "Type") |> cols_hide(columns = contains("20")) |> cols_nanoplot( columns = contains("20"), new_col_name = "nanoplots", new_col_label = md("*TREND*"), reference_line = "mean", plot_height = "3em", options = nanoplot_options( data_line_stroke_color = "black", show_reference_line = TRUE, show_reference_area = FALSE)) |> opt_table_font(font = google_font(name = "JetBrains Mono")) |> tab_header(title = md("**Medicare Part B** Utilization"), subtitle = md("Trends, 2014-2021")) |> opt_horizontal_padding(scale = 2) |> tab_options(table.width = pct(25), column_labels.font.weight = "bold", row_group.font.weight = "bold", heading.background.color = "black", heading.align = "left") toc() #> 15.39 sec elapsed ```

Created on 2023-10-18 with reprex v2.0.2

trend

andrewallenbruce commented 8 months ago
Code

``` r library(tictoc) library(provider) library(tidyverse) library(gt) tic() ind <- map_dfr(pop_years(), ~by_provider(year = .x, npi = 1043245657)) #> ✖ No results for year = 2013 and npi = 1043245657 chronic <- compare_conditions(ind) gt <- gt(chronic, rowname_col = "condition") |> cols_nanoplot( columns = contains("Provider"), reference_line = "mean", new_col_name = "provider_plot", new_col_label = md("*Provider*"), missing_vals = "zero", plot_height = "3em", options = nanoplot_options( data_line_stroke_color = "black", show_reference_line = TRUE, show_reference_area = FALSE)) |> cols_nanoplot( columns = contains("State"), reference_line = "mean", new_col_name = "state_plot", new_col_label = md("*State*"), missing_vals = "zero", plot_height = "3em", options = nanoplot_options( data_line_stroke_color = "black", show_reference_line = TRUE, show_reference_area = FALSE)) |> cols_nanoplot( columns = contains("National"), reference_line = "mean", new_col_name = "national_plot", new_col_label = md("*National*"), missing_vals = "zero", plot_height = "3em", options = nanoplot_options( data_line_stroke_color = "black", show_reference_line = TRUE, show_reference_area = FALSE)) |> cols_hide(columns = contains("20")) |> opt_table_font(font = google_font(name = "JetBrains Mono")) |> tab_header(title = md("**Medicare Part B** Utilization"), subtitle = md("**Chronic Conditions Prevalence** Comparison, 2013-2018")) |> opt_horizontal_padding(scale = 2) |> tab_options(table.width = pct(50), column_labels.font.weight = "bold", row_group.font.weight = "bold", heading.background.color = "black", heading.align = "left") |> opt_all_caps() toc() #> 98.81 sec elapsed ```

Created on 2023-10-18 with reprex v2.0.2

chronic

andrewallenbruce commented 8 months ago
Code

``` r library(tictoc) library(provider) library(tidyverse) library(gt) tic() ind <- map_dfr(pop_years(), ~by_provider(year = .x, npi = 1043245657)) #> ✖ No results for year = 2013 and npi = 1043245657 gt <- select(ind, year, starts_with("tot_")) |> select(-tot_hcpcs, -tot_std_pymt) |> change(starts_with("tot_")) |> select(-ends_with("_cum")) |> gt(rowname_col = "year") |> fmt_integer(columns = c(tot_benes, tot_srvcs, tot_benes_chg, tot_srvcs_chg, tot_charges_chg, tot_allowed_chg, tot_payment_chg), suffixing = TRUE) |> fmt_currency(columns = c(tot_charges, tot_allowed, tot_payment), decimals = 0, suffixing = TRUE) |> fmt_percent(columns = contains("pct"), decimals = 0, force_sign = TRUE) |> sub_zero(zero_text = "") |> grand_summary_rows(columns = c(tot_benes_chg, tot_srvcs_chg, tot_charges_chg, tot_allowed_chg, tot_payment_chg), fns = list(label = md("**Sum**"), id = "sum", fn = "sum"), fmt = ~ fmt_integer(., suffixing = TRUE), missing_text = "") |> grand_summary_rows(columns = c(tot_benes_pct, tot_srvcs_pct, tot_charges_pct, tot_allowed_pct, tot_payment_pct), fns = list(label = md("**Sum**"), id = "sum", fn = "sum"), fmt = ~ fmt_percent(., decimals = 0, force_sign = TRUE), missing_text = "") |> tab_spanner(label = "Beneficiaries",columns = contains("bene")) |> tab_spanner(label = "Services", columns = contains("srvcs")) |> tab_spanner(label = "Charges", columns = contains("charges")) |> tab_spanner(label = "Allowed", columns = contains("allowed")) |> tab_spanner(label = "Payment", columns = contains("payment")) |> cols_label( tot_benes = ("Tot"), tot_benes_chg = ("YoY"), tot_benes_pct = ("(%)"), tot_srvcs = ("Tot"), tot_srvcs_chg = ("YoY"), tot_srvcs_pct = ("(%)"), tot_charges = ("Tot"), tot_charges_chg = ("YoY"), tot_charges_pct = ("(%)"), tot_allowed = ("Tot"), tot_allowed_chg = ("YoY"), tot_allowed_pct = ("(%)"), tot_payment = ("Tot"), tot_payment_chg = ("YoY"), tot_payment_pct = ("(%)")) |> cols_hide(columns = ends_with("_chg")) |> opt_table_font(font = google_font(name = "JetBrains Mono")) |> tab_header(title = md("**Medicare Part B** Utilization"), subtitle = md("Counts & Amounts, 2013-2019")) |> data_color(columns = c(tot_benes, tot_srvcs, tot_charges, tot_allowed, tot_payment), method = "numeric", palette = "Reds") |> data_color(columns = c(tot_benes_chg, tot_benes_pct), rows = tot_benes_chg < 0, method = "numeric", palette = "red2", apply_to = "text") |> data_color(columns = c(tot_benes_chg, tot_benes_pct), rows = tot_benes_chg > 0, method = "numeric", palette = "gray90", apply_to = "fill") |> data_color(columns = c(tot_srvcs_chg, tot_srvcs_pct), rows = tot_srvcs_chg < 0, method = "numeric", palette = "red2", apply_to = "text") |> data_color(columns = c(tot_srvcs_chg, tot_srvcs_pct), rows = tot_srvcs_chg > 0, method = "numeric", palette = "gray90", apply_to = "fill") |> data_color(columns = c(tot_charges_chg, tot_charges_pct), rows = tot_charges_chg < 0, method = "numeric", palette = "red2", apply_to = "text") |> data_color(columns = c(tot_charges_chg, tot_charges_pct), rows = tot_charges_chg > 0, method = "numeric", palette = "gray90", apply_to = "fill") |> data_color(columns = c(tot_allowed_chg, tot_allowed_pct), rows = tot_allowed_chg < 0, method = "numeric", palette = "red2", apply_to = "text") |> data_color(columns = c(tot_allowed_chg, tot_allowed_pct), rows = tot_allowed_chg > 0, method = "numeric", palette = "gray90", apply_to = "fill") |> data_color(columns = c(tot_payment_chg, tot_payment_pct), rows = tot_payment_chg < 0, method = "numeric", palette = "red2", apply_to = "text") |> data_color(columns = c(tot_payment_chg, tot_payment_pct), rows = tot_payment_chg > 0, method = "numeric", palette = "gray90", apply_to = "fill") |> tab_options(table.width = pct(75), column_labels.font.weight = "bold", row_group.font.weight = "bold", heading.background.color = "black", heading.align = "left") |> opt_all_caps() toc() #> 12.09 sec elapsed ```

Created on 2023-10-18 with reprex v2.0.2

counts

andrewallenbruce commented 8 months ago
Code

``` r library(provider) library(tidyverse) library(gt) library(gtExtras) val <- map_dfr(pop_years(), ~by_provider(year = .x, city = "Valdosta", state = "GA")) val |> unnest(demographics) |> mutate(year = as.integer(year)) |> select(year, entity_type, gender, specialty, tot_hcpcs:bene_age_avg) |> group_by(year, entity_type) |> summarise( providers = n(), benes = mean(tot_benes, na.rm = TRUE), srvcs = mean(tot_srvcs, na.rm = TRUE), allowed = mean(tot_allowed, na.rm = TRUE), payment = mean(tot_payment, na.rm = TRUE)) |> ungroup() |> group_by(entity_type) |> gt(rowname_col = "year") |> gt_plt_dumbbell(benes, srvcs, label = "Beneficiaries : Services", text_size = 3, width = 80) |> gt_plt_dumbbell(allowed, payment, label = "Allowed : Payment", text_size = 2, text_args = list(accuracy = 100), width = 85) |> opt_table_font(font = google_font(name = "JetBrains Mono")) |> opt_all_caps() |> opt_stylize(add_row_striping = FALSE, color = "gray") |> opt_horizontal_padding(scale = 2) |> tab_options(table.width = pct(100), column_labels.font.weight = "bold", row_group.font.weight = "bold", heading.background.color = "black", heading.align = "left") |> gt_reprex_image() ```

Created on 2023-10-23 with reprex v2.0.2

andrewallenbruce commented 8 months ago

Code Created on 2023-10-18 with reprex v2.0.2

counts

Code

``` r library(provider) library(tidyverse) library(gt) library(gtExtras) ind1 <- map_dfr(pop_years(), ~by_provider(year = .x, npi = 1043245657)) #> ✖ No results for year = 2013 and npi = 1043245657 pal <- c("#FEC1A5FF", "lightgrey", "#BF714DFF") ind1 |> select(year, starts_with("tot_")) |> select(-tot_hcpcs, -tot_std_pymt) |> change(starts_with("tot_")) |> select(-ends_with("_csm")) |> gt(rowname_col = "year") |> gt_duplicate_column(tot_benes_pct, after = tot_benes_pct_ror, dupe_name = "benes_pct") |> gt_fa_rank_change( benes_pct, font_color = "match", show_text = FALSE, palette = pal ) |> gt_duplicate_column(tot_srvcs_pct, after = tot_srvcs, dupe_name = "srvcs_pct") |> gt_fa_rank_change( srvcs_pct, font_color = "match", show_text = FALSE, palette = pal ) |> gt_duplicate_column(tot_charges_pct, after = tot_charges, dupe_name = "charges_pct") |> gt_fa_rank_change( charges_pct, font_color = "match", show_text = FALSE, palette = pal ) |> gt_duplicate_column(tot_allowed_pct, after = tot_allowed, dupe_name = "allowed_pct") |> gt_fa_rank_change( allowed_pct, font_color = "match", show_text = FALSE, palette = pal ) |> gt_duplicate_column(tot_payment_pct, after = tot_payment, dupe_name = "payment_pct") |> gt_fa_rank_change( payment_pct, font_color = "match", show_text = FALSE, palette = pal ) |> fmt_percent(columns = ends_with("_pct_ror"), decimals = 0) |> fmt_percent(columns = ends_with("_pct"), decimals = 0, force_sign = TRUE) |> fmt_integer( columns = c( tot_benes, tot_srvcs, tot_benes_chg, tot_srvcs_chg, tot_charges_chg, tot_allowed_chg, tot_payment_chg ), suffixing = TRUE ) |> fmt_currency( columns = c(tot_charges, tot_allowed, tot_payment), decimals = 0, suffixing = TRUE ) |> sub_zero(zero_text = "") |> grand_summary_rows( columns = ends_with("_pct_ror"), fns = list( label = md("**GEO MEAN**"), id = "mean", fn = "provider::geomean" ), fmt = ~ fmt_percent(., decimals = 0), missing_text = "" ) |> grand_summary_rows( columns = c( tot_benes_pct, tot_srvcs_pct, tot_charges_pct, tot_allowed_pct, tot_payment_pct ), fns = list( label = md("CUSUM"), id = "sum", fn = "sum" ), fmt = ~ fmt_percent(., decimals = 0, force_sign = TRUE), missing_text = "" ) |> tab_spanner(label = "Beneficiaries", columns = contains("benes")) |> tab_spanner(label = "Services", columns = contains("srvcs")) |> tab_spanner(label = "Charges", columns = contains("charges")) |> tab_spanner(label = "Allowed", columns = contains("allowed")) |> tab_spanner(label = "Payment", columns = contains("payment")) |> cols_label( benes_pct = "", srvcs_pct = "", charges_pct = "", allowed_pct = "", payment_pct = "", tot_benes_pct_ror = "RoR", tot_srvcs_pct_ror = "RoR", tot_charges_pct_ror = "RoR", tot_allowed_pct_ror = "RoR", tot_payment_pct_ror = "RoR", tot_benes = ("Tot"), tot_benes_pct = ("(%)"), tot_srvcs = ("Tot"), tot_srvcs_pct = ("(%)"), tot_charges = ("Tot"), tot_charges_pct = ("(%)"), tot_allowed = ("Tot"), tot_allowed_pct = ("(%)"), tot_payment = ("Tot"), tot_payment_pct = ("(%)") ) |> cols_move(columns = c(benes_pct), after = tot_benes) |> cols_move(columns = c(srvcs_pct), after = tot_srvcs) |> cols_move(columns = c(charges_pct), after = tot_charges) |> cols_move(columns = c(allowed_pct), after = tot_allowed) |> cols_move(columns = c(payment_pct), after = tot_payment) |> cols_hide(columns = ends_with("_chg")) |> opt_table_font(font = google_font(name = "JetBrains Mono")) |> tab_header( title = md("**Medicare Part B** Utilization"), subtitle = md("Counts & Amounts, 2013-2019") ) |> data_color( columns = c(tot_benes, tot_srvcs, tot_charges, tot_allowed, tot_payment), method = "numeric", palette = "Reds" ) |> data_color( columns = c(tot_benes_chg, tot_benes_pct), rows = tot_benes_chg < 0, method = "numeric", palette = "red2", apply_to = "text" ) |> data_color( columns = c(tot_benes_chg, tot_benes_pct), rows = tot_benes_chg > 0, method = "numeric", palette = "gray90", apply_to = "fill" ) |> data_color( columns = c(tot_srvcs_chg, tot_srvcs_pct), rows = tot_srvcs_chg < 0, method = "numeric", palette = "red2", apply_to = "text" ) |> data_color( columns = c(tot_srvcs_chg, tot_srvcs_pct), rows = tot_srvcs_chg > 0, method = "numeric", palette = "gray90", apply_to = "fill" ) |> data_color( columns = c(tot_charges_chg, tot_charges_pct), rows = tot_charges_chg < 0, method = "numeric", palette = "red2", apply_to = "text" ) |> data_color( columns = c(tot_charges_chg, tot_charges_pct), rows = tot_charges_chg > 0, method = "numeric", palette = "gray90", apply_to = "fill" ) |> data_color( columns = c(tot_allowed_chg, tot_allowed_pct), rows = tot_allowed_chg < 0, method = "numeric", palette = "red2", apply_to = "text" ) |> data_color( columns = c(tot_allowed_chg, tot_allowed_pct), rows = tot_allowed_chg > 0, method = "numeric", palette = "gray90", apply_to = "fill" ) |> data_color( columns = c(tot_payment_chg, tot_payment_pct), rows = tot_payment_chg < 0, method = "numeric", palette = "red2", apply_to = "text" ) |> data_color( columns = c(tot_payment_chg, tot_payment_pct), rows = tot_payment_chg > 0, method = "numeric", palette = "gray90", apply_to = "fill" ) |> tab_options( table.width = pct(100), column_labels.font.weight = "bold", row_group.font.weight = "bold", heading.background.color = "black", heading.align = "left" ) |> tab_header(title = md("**Medicare Part B** Utilization")) |> opt_horizontal_padding(scale = 2) |> tab_options( table.width = pct(50), column_labels.font.weight = "bold", row_group.font.weight = "bold", heading.background.color = "black", heading.align = "left" ) |> opt_all_caps() |> gt_reprex_image() ```

Created on 2023-10-23 with reprex v2.0.2

andrewallenbruce commented 8 months ago
Code

``` r library(provider) library(tidyverse) library(gt) library(gtExtras) val <- map_dfr(util_years(), ~utilization(year = .x, city = "Valdosta", state = "GA", type = "provider")) gt <- val |> unnest(performance) |> group_by(year) |> summarise( provs = n(), benes = sum(tot_benes), srvcs = sum(tot_srvcs), pymt = sum(tot_payment), .groups = "drop") |> change(!year) |> select(year, provs, provs_chg, provs_pct, provs_ror = provs_pct_ror, benes, benes_chg, benes_pct, benes_ror = benes_pct_ror, srvcs, srvcs_chg, srvcs_pct, srvcs_ror = srvcs_pct_ror, pymt, pymt_chg, pymt_pct, pymt_ror = pymt_pct_ror) |> gt(rowname_col = "year") |> sub_zero(zero_text = "") |> sub_missing(missing_text = "") |> fmt_integer(columns = c(provs, benes, srvcs, pymt), sep_mark = ",", suffixing = TRUE) |> fmt_integer(columns = ends_with("chg"), force_sign = TRUE, sep_mark = ",", suffixing = TRUE) |> fmt_percent(columns = ends_with("pct"), force_sign = TRUE, decimals = 1) |> fmt_percent(columns = ends_with("ror"), decimals = 1) |> cols_label( provs = "Tot", provs_chg = "Abs", provs_ror = "RoR", provs_pct = "%", benes = "Tot", benes_chg = "Abs", benes_ror = "RoR", benes_pct = "%", srvcs = "Tot", srvcs_chg = "Abs", srvcs_ror = "RoR", srvcs_pct = "%", pymt = "Tot", pymt_chg = "Abs", pymt_ror = "RoR", pymt_pct = "%") |> cols_hide(columns = c(benes, srvcs, pymt)) |> tab_spanner(label = "Providers", columns = c(provs, provs_chg, provs_ror, provs_pct)) |> tab_spanner(label = "Payment", columns = c(pymt, pymt_chg, pymt_ror, pymt_pct)) |> tab_spanner(label = "Beneficiaries", columns = c(benes, benes_chg, benes_ror, benes_pct)) |> tab_spanner(label = "Services", columns = c(srvcs, srvcs_chg, srvcs_ror, srvcs_pct)) |> opt_table_font(font = google_font(name = "JetBrains Mono")) |> opt_all_caps() |> opt_stylize(color = "red") gt_reprex_image(gt) ```

Created on 2023-10-30 with reprex v2.0.2

andrewallenbruce commented 7 months ago
library(provider)
library(tidyverse)
library(gt)
library(gtExtras)

ex <- beneficiaries(year = 2022, 
                    period = "Year") |> 
  select(-c(state_name, fips)) |> 
  filter(state %in% c("US", "AL"))

state_total <- ex[2, ]$bene_total

`%notin%` <- Negate(`%in%`)

fin <- ex |> 
  filter(county %notin% c("Total", "Unknown")) |> 
  select(-c("period", "level")) |> 
  mutate(bene_tstate = state_total, 
         .before     = bene_total) |> 
  group_by(year, state, county) |> 
  summarise(total    = bene_total / bene_tstate,
            original = bene_orig / bene_total,
            med_adv  = bene_ma_oth / bene_total,
            aged     = bene_total_aged / bene_total,
            disabled = bene_total_dsb / bene_total,
            part_d   = bene_total_rx / bene_total) |> 
  ungroup()

fin |> 
  gt(rowname_col = "county") |> 
  cols_hide(c(year, state)) |> 
  fmt_percent(decimals = 2) |> 
  tab_header(md("Medicare Beneficiaries: *Alabama 2022*")) |> 
  opt_table_font(font = google_font(name = "JetBrains Mono")) |> 
  cols_label(
    total = "% (State)",
    med_adv = html("Med.<br>Adv."),
    part_d = "Part D") |> 
  opt_all_caps() |> 
  tab_options(table.width = pct(40),
              column_labels.font.weight = "bold",
              row_group.font.weight = "bold",
              heading.background.color = "black",
              heading.align = "left")

Created on 2023-11-19 with reprex v2.0.2

tab_1