gt Tables #21

andrewallenbruce · 2023-10-17T11:29:56Z

Code

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}

andrewallenbruce · 2023-10-18T08:00:31Z

Code

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}

andrewallenbruce · 2023-10-18T08:05:44Z

Code

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}

andrewallenbruce · 2023-10-18T08:23:30Z

Code

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}

andrewallenbruce · 2023-10-18T08:33:24Z

Code

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}

andrewallenbruce · 2023-10-23T09:32:07Z

Code

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 · 2023-10-23T09:49:52Z

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

Code

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 · 2023-10-31T03:26:21Z

Code

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 · 2023-11-20T01:29:11Z

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}

andrewallenbruce added the feature 📸 feature request label Oct 17, 2023

andrewallenbruce self-assigned this Oct 17, 2023

andrewallenbruce added presentation 📊 visualization or presentation related and removed feature 📸 feature request labels Oct 17, 2023

andrewallenbruce changed the title ~~Presentation Examples~~ gt Tables Oct 18, 2023

andrewallenbruce added the visualization 🎨 label Oct 20, 2023

andrewallenbruce mentioned this issue Oct 31, 2023

Presentation Options #32

Closed

3 tasks

andrewallenbruce removed the visualization 🎨 label Oct 31, 2023

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

gt Tables #21

gt Tables #21

andrewallenbruce commented Oct 17, 2023 •

edited

andrewallenbruce commented Oct 18, 2023 •

edited

andrewallenbruce commented Oct 18, 2023 •

edited

andrewallenbruce commented Oct 18, 2023 •

edited

andrewallenbruce commented Oct 18, 2023

andrewallenbruce commented Oct 23, 2023

andrewallenbruce commented Oct 23, 2023

andrewallenbruce commented Oct 31, 2023

andrewallenbruce commented Nov 20, 2023

gt Tables #21

gt Tables #21

Comments

andrewallenbruce commented Oct 17, 2023 • edited

andrewallenbruce commented Oct 18, 2023 • edited

andrewallenbruce commented Oct 18, 2023 • edited

andrewallenbruce commented Oct 18, 2023 • edited

andrewallenbruce commented Oct 18, 2023

andrewallenbruce commented Oct 23, 2023

andrewallenbruce commented Oct 23, 2023

andrewallenbruce commented Oct 31, 2023

andrewallenbruce commented Nov 20, 2023

andrewallenbruce commented Oct 17, 2023 •

edited

andrewallenbruce commented Oct 18, 2023 •

edited

andrewallenbruce commented Oct 18, 2023 •

edited

andrewallenbruce commented Oct 18, 2023 •

edited