Visualizations

[andrewallenbruce]

1. {ggpointless}

Code

``` r 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

``` r 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

``` r 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

``` r 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
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() ```

<sup>Created on 2024-06-06 with reprex v2.1.0</sup>

[andrewallenbruce]

5. {gt}

Code

``` r 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" ) ```

<sup>Created on 2024-06-06 with reprex v2.1.0</sup>

[andrewallenbruce]

6. {waterfalls}

Code

``` r 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) ```

<sup>Created on 2024-06-06 with reprex v2.1.0</sup>

[andrewallenbruce]

Code

``` r 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) ```

<sup>Created on 2024-06-08 with reprex v2.1.0</sup>

---

Code

``` r 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) ```

<sup>Created on 2024-06-08 with reprex v2.1.0</sup>

---

Code

``` r 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) ```

<sup>Created on 2024-06-08 with reprex v2.1.0</sup>

---

Code

``` r 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)) ```

<sup>Created on 2024-06-08 with reprex v2.1.0</sup>

---

Code

``` r 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") ) ```

<sup>Created on 2024-06-08 with reprex v2.1.0</sup>