In JayAchar/hisreportr: hisreportr: Automating MSF OCA EMR reporting

# Narrow boundary ----
narrow <- 0.2

# remove NA
plot_data <- plot_data[! is.na(plot_data$outcome), ]

# generate simplified outcome variable
plot_data$simple_outcome <- ifelse(plot_data$outcome %in% success_levels, 0, 1)

pd_category <- dplyr::count(plot_data, outcome) 
pd_simple <- dplyr::count(plot_data, simple_outcome)

pd_simple$simple_outcome <- factor(pd_simple$simple_outcome, 
                                     levels = c(0, 1), 
                                     labels = c("Successful", "Unsuccessful"))


# Prepare data ----
  pd_simple$percent <- pd_simple$n / sum(pd_simple$n)
  pd_category$percent <- pd_category$n / sum(pd_category$n)
  pd_category$cumperc <- cumsum(pd_category$percent)



# Generate plot ---- 
  p <- ggplot() +
    # categorised treatment outcome
    geom_bar(data = pd_category,
             aes(x = 1, 
                 y = n / sum(n),
                 fill = outcome), 
             stat = "identity", 
             position = position_stack(reverse = TRUE),
             alpha = 0.8) +

    # simplified treatment outcome
    geom_bar(data = pd_simple,
             aes(x = 0,
                 y = n / sum(n),
                 fill = simple_outcome), 
             stat = "identity",
             position = position_stack(reverse = TRUE),
             alpha = 0.8) +

    # simple outcome labels
    # even distribution of outcomes
    { if(dplyr::between(pd_simple$percent[1], narrow, 1-narrow)){
      geom_text(data = pd_simple,
                aes(x = 0.35,
                    y = c(0.06, 
                          0.93),
                    label = pd_simple$simple_outcome),
                color = "white")

    } } +

    # High level of success
    { if(pd_simple$percent[1] > (1 - narrow)) {
      geom_text(aes(
        label = "Unsuccessful",
        x = - 0.8,
        y = (1 - pd_simple$percent[2] * 1.7)
      ), 
      color = "black")
    }} +

    { if(pd_simple$percent[1] > (1 - narrow)) {
      geom_curve(aes(
        x = - 0.75,
        y = (1 - pd_simple$percent[2]),
        xend = - 0.4,
        yend = (1 - pd_simple$percent[2] * 0.5)
      ), 
      color = "black",
      curvature = 0.1,
      angle = 140,
      alpha = 0.7)
    }} +

    { if(pd_simple$percent[1] > (1 - narrow)) {
      geom_text(aes(label = "Successful",
                    x = 0.35,
                    y = 0.06),
                color = "white")
    }} +

    # Low level of success
    { if(pd_simple$percent[1] < narrow) {
      geom_text(aes(
        label = "Successful",
        x = - 0.8,
        y = pd_simple$percent[1] + 0.1),
      color = "black")
    }} +

    { if(pd_simple$percent[1] < narrow) {
      geom_curve(aes(
        x = - 0.75,
        y = pd_simple$percent[1] + 0.04),
        xend = - 0.43,
        yend = pd_simple$percent[1] * 0.7,
      color = "black",
      curvature = - 0.2,
      angle = 1100,
      alpha = 0.7)
    }} +

    { if(pd_simple$percent[1] < narrow) {
      geom_text(aes(label = "Unsuccessful",
                    x = 0.35,
                    y = 0.93),
                color = "white")
    }} +

    scale_fill_manual(values = color_palette,
                      breaks = legend_labels) + 

    # success percentage label
    geom_text(data = pd_simple,
              aes(label = paste(round(n[simple_outcome == "Successful"] / sum(n) * 100, 1), "%"),
                  y = 0.05,
                  x = -0.33),
              color = "white", 
              size = 5) +
    coord_flip() +
    labs(x = "",
         y = "Proportion",
         title = plot_title,
         fill = "",
         caption = "Missing values removed from plot") +
    theme(axis.text.y = element_blank(),
          axis.ticks.y = element_blank(),
          legend.position = "top") 

p