Visualizations

[andrewallenbruce]

1. {ggpointless}

Code

library(ggpointless)
cols <- c("#f4ae1b", "#d77e7b", "#a84dbd", "#311dfc")

df2 <- data.frame(
  key = c("A", "B", "B", "C", "D"),
  x = c(0, 1, 6, 5, 6),
  xend = c(5, 4, 10, 8, 10)
)

ggplot(df2, aes(x = x, xend = xend, color = key, fill = key)) +
  geom_lexis(aes(linetype = after_stat(type)), size = 2.5, shape = 21, linewidth = 1.1) +
  coord_equal() +
  scale_x_continuous(breaks = c(df2$x, df2$xend)) +
  scale_color_manual(values = cols) +
  scale_linetype_identity() +
  ggthemes::theme_fivethirtyeight(base_size = 10) +
  labs(title = NULL, x = NULL) + 
  theme(
    legend.position = "none",
    axis.text.x = element_text(size = 12, face = "bold"),
    axis.text.y = element_text(size = 12, face = "bold"),
    panel.grid.minor = element_blank()
        )

^{Created on 2024-06-06 with reprex v2.1.0}

[andrewallenbruce]

2. Bullet Chart

Code

BC = data.frame( 
  Satisfaction    = c(4.7, 4.4, 3.5, 4.25, 5), 
  "New Customers" = c(1600, 2100, 1400, 2000, 2500), 
  "Order Size"    = c(310, 550, 350, 500, 600), 
  Profit          = c(23, 26, 20, 25, 30), 
  Revenue         = c(270, 250, 150, 225, 300), 
  row.names       = c("Current", "Past", "Poor", "Satisfactory", "Good")) 
 
# units of measurement 
units = c("out of 5", "count", "US$, average", "%", "US$, in thousands") 
 
# number of tick marks 
ticks = c(6, 6, 7, 7, 7) 

# set graphic margins 
op = par(mar = c(2, 6.5, 1, 2)) 

# call new plot 
plot.new() 

# define plot window 
plot.window(xlim = c(-0.1, 10.3), 
            ylim = c(-0.2, 4.5), 
            xaxs = "i") 

# add names 
mtext(
  names(BC),
  side = 2, 
  at   = seq(0.4, 4.4, 1), 
  las  = 2, 
  cex  = 1, 
  line = 0.1) 

mtext(
  units,
  side = 2,
  at   = seq(0.2, 4.2, 1), 
  las  = 2,  
  col  = "gray50", 
  cex  = 0.8, 
  line = 0.1) 

# add rectangles 
for (i in 0:4)  
{ 
  # maximum rectangle 
  rect(0, i, 10, i + 0.5, border = NA, col = "gray95") 
  
  # add rectangles for satisfactory range 
  xright_sat = (10 * BC[4, i + 1]) / BC[5, i + 1] 
  
  rect(0, i, xright_sat, i + 0.5, border = NA, col = "gray90") 
  
  # add rectangles for poor range 
  xright_poor = (10 * BC[3, i + 1]) / BC[5, i + 1]
  
  rect(0, i, xright_poor, i + 0.5, border = NA, col = "gray80") 
  
  # add bar for current value 
  xright_cur = (10 * BC[1, i + 1]) / BC[5, i + 1]
  
  rect(0, i + 0.15, xright_cur, i + 0.35, border = NA, col = "#4689BF") 
  
  # add mark for past value 
  xpast = (10 * BC[2, i + 1]) / BC[5, i + 1]
  
  points(xpast, i + 0.25, pch = 25, bg = "white", lwd = 2, cex = 1.25) 
  
  # add tick marks below rectangles 
  text(x = seq(0, 10, length = ticks[i + 1]), 
       y = i - 0.25, 
       col = "gray20", 
       labels = seq(0, BC[5, i + 1], length = ticks[i + 1]), cex = 0.9) 
  
  points(x = seq(0, 10, length = ticks[i + 1]), 
         y = rep(i - 0.1, ticks[i + 1]),  
         pch = "|", 
         cex = 0.4) 
} 


# reset graphical parameters 
par(op)

^{Created on 2024-06-06 with reprex v2.1.0}

[andrewallenbruce]

3. {ggforce}

Code

library(tidyverse)

nm_rate <- dplyr::tibble(
  payer = c("Aetna", "BCBS", "Cigna", "United", "Humana", "Anthem", "Centene"),
  rate = c(1.31, 1.3, 1.1, 1.68, 1.66, 1.55, 1.48),
  rvus = c(8100, 6000, 5700, 4000, 1990, 1000, 799),
  desc = c(paste0(rate * 100, "%, ", format(rvus, big.mark = ","), " RVUs"))
  )

ggplot(nm_rate, aes(x = rvus, y = rate)) +
  ggforce::geom_mark_circle(
    aes(fill = payer, label = payer, description = desc),
    expand = -0.5,
    radius = unit(3, "mm"),
    label.buffer = unit(5, "mm"),
    con.type = "straight",
    con.cap = 0,
    label.colour = "grey30",
    con.colour = "grey30",
    colour = "grey30",
    ) +
  geom_point() +
  geom_smooth(method = lm, 
              formula = y ~ x, 
              se = FALSE, 
              color = "red", 
              linetype = "dashed", 
              linewidth = 1.5,
              alpha = 0.5) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  scale_x_continuous(labels = scales::comma) +
  ggthemes::scale_color_fivethirtyeight() +
  ggthemes::theme_fivethirtyeight(base_size = 8) +
  labs(title = "Percentage of Reimbursement Compared to RVU Volume",
       x = "RVU Volume",
       y = "Rate as A Pct% of Medicare Reimbursement") +
  theme(legend.position = "none")

^{Created on 2024-06-06 with reprex v2.1.0}

[andrewallenbruce]

4. {gt}

Code

library(tidyverse)
library(gt)
library(forager)

dar_mon <- avg_dar(
  df     = dar_ex(),
  date   = date,
  gct    = gross_charges,
  earb   = ending_ar,
  dart   = 35,
  by = "month"
)

dar_mon |>
  mutate(month = clock::date_month_factor(date), .after = date) |>
  select(month, gct, earb, earb_target, dar, dar_pass) |>
  headliner::add_headline_column(
    x = earb,
    y = earb_target,
    headline = "{delta_p}% {trend} than Target",
    trend_phrases = headliner::trend_terms(more = "HIGHER", less = "Lower"),
    n_decimal = 0) |>
  gt(rowname_col = "month") |>
  cols_label(
    gct = "Gross Charges",
    earb = "Ending AR",
    earb_target = "Target AR",
    dar = "Days in AR",
    dar_pass = "Pass",
    headline = "Ending AR Trend"
  ) |>
  tab_row_group(label = "Q4", rows = c(10:12)) |>
  tab_row_group(label = "Q3", rows = c(7:9)) |>
  tab_row_group(label = "Q2", rows = c(4:6)) |>
  tab_row_group(label = "Q1", rows = c(1:3)) |>
  fmt_number(columns = dar) |>
  fmt_currency(columns = c(gct, earb, earb_target)) |>
  tab_style(style = cell_text(font = c(
    google_font(name = "IBM Plex Mono"), default_fonts()
  )), locations = cells_body(columns = c(gct, earb, earb_target, dar))) |>
  opt_stylize(style = 6, color = "cyan") |>
  tab_header(
    title = md("Example **Days in AR Analysis** with the **{forager}** Package"),
    subtitle = md(
      "**May** saw the *highest* Days in AR of 2022 *(51.2)*. This coincided with the largest <br> month-to-month increase in AR & highest percentage over the AR Target *(46%)*."
    )
  ) |>
  opt_all_caps() |>
  grand_summary_rows(
    columns = c(gct, earb, earb_target, dar),
    fns = list(
      Mean = ~ mean(., na.rm = TRUE),
      Median = ~ median(., na.rm = TRUE)
    )
  ) |>
  opt_align_table_header(align = "left") |>
  gtExtras::gt_reprex_image()

^{Created on 2024-06-06 with reprex v2.1.0}

[andrewallenbruce]

5. {gt}

Code

library(tidyverse)
library(gt)
library(gtExtras)
library(forager)

dar_mon <- avg_dar(
  df     = dar_ex(),
  date   = date,
  gct    = gross_charges,
  earb   = ending_ar,
  dart   = 35,
  by = "month"
) |>
  mutate(month = clock::date_month_factor(date), .after = date)

dar_mon <- right_join(
  dar_mon, 
  dar_mon |> 
    transmute(month, gct_pct * 100, earb_pct * 100) |>
    pivot_longer(-month, names_to = "measure", values_to = "percentage") |>
    group_by(month) |>
    summarize(list_data = list(percentage)), 
  by = "month") |>
  mutate(target_col = earb, plot_col = earb_target)

dar_gt <- dar_mon |>
  select(
    month, 
    gct, 
    earb, 
    earb_target, 
    dar, 
    dar_pass, 
    plot_col, 
    target_col, 
    list_data
  ) |>
  gt(rowname_col = "month") |>
  cols_label(
    gct      = "Gross Charges",
    earb     = "Ending AR",
    dar      = "Days in AR",
    dar_pass = "Pass",
    plot_col = "Optimal AR Threshold"
  ) |>
  cols_hide(earb_target) |>
  tab_row_group(label = "Q4", rows = c(10:12)) |>
  tab_row_group(label = "Q3", rows = c(7:9)) |>
  tab_row_group(label = "Q2", rows = c(4:6)) |>
  tab_row_group(label = "Q1", rows = c(1:3)) |>
  gt_theme_nytimes() |>
  fmt_number(columns = dar) |>
  fmt_currency(columns = c(gct, earb, earb_target), 
               decimals = 0) |>
  gt_plt_bullet(
    column  = plot_col,
    target  = target_col,
    palette = c("#8ca0aa", "black"),
    width   = 65
  ) |>
  gt_plt_bar_stack(
    list_data,
    width   = 50,
    labels  = c("Charges (%) ", " AR (%)"),
    palette = c("#2c3e50", "#8ca0aa")
  ) |>
  gt_badge(dar_pass, 
           palette = c("FALSE" = "#8ca0aa")) |>
  tab_style(
    style = cell_text(color = "#2c3e50", weight = "bolder"),
    locations = cells_body(columns = dar_pass, 
                           rows = dar_pass == "FALSE")
  ) |>
  tab_style(
    style = cell_text(color = "#8ca0aa", weight = "normal"),
    locations = cells_body(columns = dar_pass, 
                           rows = dar_pass == "TRUE")
  ) |>
  data_color(
    columns = c(gct, earb, dar),
    colors = scales::col_numeric(
      palette = c("#2c3e50", "#8ca0aa") |>
        as.character(),
      domain = NULL
    )
  ) |>
  tab_footnote(
    footnote = "Horizontal bar indicates Optimal AR, vertical bar is Actual.", 
    locations = cells_column_labels(columns = plot_col)) |>
  tab_header(title = md(
    "Example **Days in AR Analysis** with the **{forager}** Package")) |>
  tab_options(
    column_labels.font.weight         = "bold",
    column_labels.font.size           = px(16),
    column_labels.border.bottom.width = px(3),
    quarto.disable_processing         = TRUE,
    table.font.size                   = px(18),
    table.width                       = pct(65),
    heading.align                     = "left",
    heading.title.font.size           = px(24),
    heading.subtitle.font.size        = px(21),
    row_group.font.weight             = "bold"
  )

^{Created on 2024-06-06 with reprex v2.1.0}

[andrewallenbruce]

6. {waterfalls}

Code

library(tidyverse)
library(forager)

ar_ch <- avg_dar(
  df     = dar_ex(),
  date   = date,
  gct    = gross_charges,
  earb   = ending_ar,
  dart   = 35,
  by = "month"
) |> 
  dplyr::reframe(
    date = lubridate::month(date, label = TRUE, abbr = TRUE),
    change = earb - lag(earb),
    change = ifelse(is.na(change), earb, change),
    change = fuimus::roundup(change, 0)
  )
 
waterfalls::waterfall(
  ar_ch[c('change', 'date')], 
  calc_total = TRUE,
  rect_width = 1) +
  scale_y_continuous(
    labels = scales::dollar_format(scale = 0.001, suffix = "k")
    ) +
  ggthemes::scale_color_fivethirtyeight() +
  ggthemes::theme_fivethirtyeight(base_size = 10)

^{Created on 2024-06-06 with reprex v2.1.0}

[andrewallenbruce]

Code

library(forager)
library(tidyverse)

dar_mon <- avg_dar(
  df     = dar_ex(),
  date   = date,
  gct    = gross_charges,
  earb   = ending_ar,
  dart   = 35,
  by = "month"
)


dar_mon |> 
  ggplot(aes(x = date, y = dar)) +
  geom_line(group = 1, linetype = "dashed", alpha = 0.7) +
  geom_hline(yintercept = 35, color = "red") +
  labs(title = "Days in AR by Month", x = NULL, y = NULL) +
  scale_x_date(date_breaks = "1 month", date_labels = "%b") +
  ggthemes::scale_color_fivethirtyeight() +
  ggthemes::theme_fivethirtyeight(base_size = 10)

^{Created on 2024-06-08 with reprex v2.1.0}

---

Code

library(forager)
library(tidyverse)

dar_ex() |>
  ggplot() +
  geom_line(aes(x = date, y = ending_ar),
            alpha = 0.7,
            linewidth = 1.5) +
  geom_line(
    aes(x = date, y = gross_charges),
    color = "red",
    alpha = 0.7,
    linewidth = 1.5) +
  labs(title = "Gross Charges & Ending AR Balance by Month", x = NULL, y = NULL) +
  scale_y_continuous(labels = scales::dollar_format(prefix = "$", scale = 0.001, suffix = "k")) +
  scale_x_date(date_breaks = "1 month", date_labels = "%b") +
  ggthemes::scale_color_fivethirtyeight() +
  ggthemes::theme_fivethirtyeight(base_size = 10)

^{Created on 2024-06-08 with reprex v2.1.0}

---

Code

library(forager)
library(tidyverse)

dar_mon <- avg_dar(
  df     = dar_ex(),
  date   = date,
  gct    = gross_charges,
  earb   = ending_ar,
  dart   = 35,
  by = "month"
) |>
  mutate(month = clock::date_month_factor(date), .after = date)

dar_mon |> 
  ggplot(aes(x = earb, y = dar)) +
  geom_point(aes(fill = dar > 35), show.legend = FALSE, size = 5, stroke = 1, shape = 21) +
  geom_hline(yintercept = 35, color = "red", alpha = 0.5) +
  scale_x_continuous(
    labels = scales::dollar_format(scale = 0.001, suffix = "k"), 
    limits = c(0, max(dar_mon$gct))) +
  labs(title = "Days in AR by Month", x = NULL, y = NULL) +
  facet_wrap( ~ ndip) +
  # facet_grid(ndip ~ mon, margins = TRUE) +
  coord_flip() +
  ggthemes::scale_color_fivethirtyeight() +
  ggthemes::theme_fivethirtyeight(base_size = 10)

^{Created on 2024-06-08 with reprex v2.1.0}

---

Code

library(forager)
library(tidyverse)

dar_mon <- avg_dar(
  df     = dar_ex(),
  date   = date,
  gct    = gross_charges,
  earb   = ending_ar,
  dart   = 35,
  by = "month"
) |>
  mutate(month = clock::date_month_factor(date), .after = date)

# ```{r fig.height=14, fig.width=10, fig.dpi=600}
ggplot() +
  geom_abline(data = dar_mon, aes(intercept = 0, slope = ratio_ideal), color = "grey", linewidth = 1.5) +
  geom_point(data = dar_mon, aes(x = gct, y = earb_target), group = 1, color = "red", shape = 21, size = 2.5, stroke = 1) +
  geom_point(data = dar_mon, aes(x = gct, y = earb), group = 1, color = "grey40", shape = 17, size = 2.5) +
  # facet_wrap( ~ ndip) +
  facet_grid(month ~ ndip) +
  scale_y_continuous(
    labels = scales::label_currency(prefix = NULL, scale = 0.001, suffix = "k"), 
    limits = c(min(c(dar_mon$earb, dar_mon$earb_target)), max(c(dar_mon$earb, dar_mon$earb_target)) + 100000)) +
  scale_x_continuous(
    labels = scales::label_currency(scale = 0.001, suffix = "k"), 
    limits = c(min(dar_mon$gct), max(dar_mon$gct))) +
  ggthemes::theme_few(base_size = 14) +
  theme(legend.position = "none",
        strip.text.y = element_text(angle = 0))

^{Created on 2024-06-08 with reprex v2.1.0}

---

Code

library(forager)
library(tidyverse)

binned <- load_ex("aging_ex") |> 
  select(dos:ins_name) |> 
  days_between(dos) |>
  bin_aging(days_elapsed)

binned |> 
  ggplot() +
  geom_point(aes(x = dos, y = charges, colour = aging_bin), 
             size = 5, shape = "|", stroke = 5) +
  labs(x = NULL, y = NULL) +
  scale_y_continuous(
    labels = scales::label_currency(prefix = "$"),
    limits = c(min(binned$charges), max(binned$charges) + 10)) +
  scale_x_date(date_breaks = "1 week", date_labels = "%W") +
  ggthemes::theme_fivethirtyeight(base_size = 12) +
  ggthemes::scale_color_pander() +
  theme(legend.position = "top",
        axis.text.x = element_text(size = 10, face = "bold"),
        axis.text.y = element_text(size = 12, face = "bold")
  )

^{Created on 2024-06-08 with reprex v2.1.0}