Visualizations #4

andrewallenbruce · 2024-06-07T00:18:12Z

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 · 2024-06-07T01:07:25Z

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 · 2024-06-07T01:08:49Z

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 · 2024-06-07T01:17:06Z

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 · 2024-06-07T01:24:36Z

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 · 2024-06-07T01:28:15Z

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 · 2024-06-08T07:33:00Z

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}

andrewallenbruce self-assigned this Jun 7, 2024

andrewallenbruce changed the title ~~Visualization Possibilities~~ Visualizations Jun 10, 2024

andrewallenbruce added the documentation Improvements or additions to documentation label Dec 21, 2024

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Visualizations #4

Visualizations #4

andrewallenbruce commented Jun 7, 2024 •

edited

Loading

andrewallenbruce commented Jun 7, 2024 •

edited

Loading

andrewallenbruce commented Jun 7, 2024 •

edited

Loading

andrewallenbruce commented Jun 7, 2024 •

edited

Loading

andrewallenbruce commented Jun 7, 2024 •

edited

Loading

andrewallenbruce commented Jun 7, 2024 •

edited

Loading

andrewallenbruce commented Jun 8, 2024 •

edited

Loading

Visualizations #4

Visualizations #4

Comments

andrewallenbruce commented Jun 7, 2024 • edited Loading

1. {ggpointless}

andrewallenbruce commented Jun 7, 2024 • edited Loading

2. Bullet Chart

andrewallenbruce commented Jun 7, 2024 • edited Loading

3. {ggforce}

andrewallenbruce commented Jun 7, 2024 • edited Loading

4. {gt}

andrewallenbruce commented Jun 7, 2024 • edited Loading

5. {gt}

andrewallenbruce commented Jun 7, 2024 • edited Loading

6. {waterfalls}

andrewallenbruce commented Jun 8, 2024 • edited Loading

andrewallenbruce commented Jun 7, 2024 •

edited

Loading

andrewallenbruce commented Jun 7, 2024 •

edited

Loading

andrewallenbruce commented Jun 7, 2024 •

edited

Loading

andrewallenbruce commented Jun 7, 2024 •

edited

Loading

andrewallenbruce commented Jun 7, 2024 •

edited

Loading

andrewallenbruce commented Jun 7, 2024 •

edited

Loading

andrewallenbruce commented Jun 8, 2024 •

edited

Loading