Search code examples
rggplot2shinyalignmentgeom-text

align all geom_text above individual columns


I have this app, that should show the p-values stars above the columns or confidence intervals if selected. It works for one category, not another (only two of the four categories apply). How can I change my code to fix this? I'm not sure where the error lies or why it would work for Retail but not Transportation.

enter image description here

enter image description here

  ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput('cat','Select Category', unique(table_E.9_9$Ent_or_Rev)),
      checkboxInput("control_mean",label = "Show average for non-recipients", value = FALSE),
      checkboxInput("p_values",label = "Show p-value levels", value = FALSE),
      checkboxInput("error_bars",label = "Show 95% confidence intervals", value = FALSE),
      actionButton("Explain_p_values", "Explain p-values"),
      actionButton("Explain_error_bars", "Explain 95% confidence intervals")
    ),
    mainPanel(plotOutput('plot_overall'))
  )
)

server <- function(input, output, session) {
  observeEvent(input$Explain_p_values, {showModal(modalDialog(p_value_text))})
  observeEvent(input$Explain_error_bars, {showModal(modalDialog(CI_text))})
  
  output$plot_overall <- renderPlot({
    cbPalette_4 <- c("#999999",  "#F0E442", "#0072B2", "#D55E00")
    fun_select_cat <- function(table, cat) {
  table %>% 
    filter(Ent_or_Rev == cat)
}
    
     table_E.9_9_filtered <- fun_select_cat(table_E.9_9, input$cat) |> 
      ungroup()
    
     control_y <- table_E.9_9_filtered %>% pull(Control) |> unique()
     
     title <- if (input$cat == "Number of Enterprises") {
      input$cat
    } else {
      paste(input$cat, "(USD)", sep = " ")
    }

    layer_error <- if (input$error_bars) {
      geom_errorbar(aes(ymin = lower, ymax = higher), width = 0.25, position = position_dodge(width = 0.9))
    }
    
    layer_p <- if (input$p_values) {
      column_y_text <- if (input$error_bars) {   
        "higher"                                  #if p-values and error_bars checked then add stars at higher CI otherwise at the obs
      } else {                                    
        "new_est"
      }
      max_y_text <- table_E.9_9_filtered |>          # if asterisks column not NA then either put asterisks higher than error bars if error_bar checked
        filter(!is.na(Sig)) |>                   # or put it at bar height if not checked
        pull(column_y_text) |>                   # keep the height of tallest bar
        max()
      
      list(
        geom_text(aes(label = Sig, y = 1.05 * .data[[column_y_text]], group=variable), position = position_dodge(width = 0.9), na.rm = TRUE),   # asterisks go just above either bar or obs 
        if (!is.na(max_y_text)) expand_limits(y = c(0, max_y_text * 1.05))              # if tallest bar has asterisk then expand limit
      )
    }
    
    layer_control <- if (input$control_mean) {
      list(
        annotate("label",
                 x = 3.75, y = control_y,
                 label = "Control\nmean",
                 colour = "#CC79A7",
                 fontface = 2,
                 size = 4.2,
                 label.size = 0,
                 fill = NA,
                 vjust = 0
        ),
        geom_hline(aes(yintercept = Control), linetype = "dashed", col = "#CC79A7", size = 1.5),
        expand_limits(x = c(1, nlevels(table_E.9_9$Treatment) + 1.1))
      )
    }
 
 table_E.9_9_filtered |> 
  ggplot(aes(x = Treatment, y = new_est, fill = variable)) +
  geom_col(position = position_dodge(width = 0.9)) +
  scale_fill_manual(values = cbPalette_4) +
  scale_y_continuous(labels = label_comma(), expand = c(0, 0)) +
  theme_classic() +
  scale_x_discrete(drop = FALSE) +
  theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
    axis.text = element_text(size = 12),
    legend.title = element_blank(),
    legend.text = element_text(size = 12)
  ) +
  layer_p +
  layer_error +
  layer_control +
  labs(title = title, x = NULL, y = NULL)
  
  })
}
shinyApp(ui = ui, server = server)

dput(table_E.9_9):

structure(list(Treatment = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L), levels = c("Long Term", "Short Term", "Lump Sum"), class = "factor"), 
    variable = c("Manufacturing", "Manufacturing", "Retail Trade", 
    "Retail Trade", "Services", "Services", "Transportation", 
    "Transportation", "Manufacturing", "Manufacturing", "Retail Trade", 
    "Retail Trade", "Services", "Services", "Transportation", 
    "Transportation", "Manufacturing", "Manufacturing", "Retail Trade", 
    "Retail Trade", "Services", "Services", "Transportation", 
    "Transportation"), Control = c(0.89, 185.99, 11.05, 1356.55, 
    1.56, 233.14, 0.94, 136.04, 0.89, 185.99, 11.05, 1356.55, 
    1.56, 233.14, 0.94, 136.04, 0.89, 185.99, 11.05, 1356.55, 
    1.56, 233.14, 0.94, 136.04), Estimate = c(0.02, 51.9, 3.89, 
    1601.42, 0.23, 198.64, 0.53, 100.76, 0.28, 254.11, 4.24, 
    770.01, 0.45, 718.68, 0.38, 101, 0.03, 17.82, 2.34, 464.6, 
    -0.04, 70.95, -0.12, -3.85), SE = c(0.27, 120.79, 1.28, 824.74, 
    0.33, 205.6, 0.29, 85.37, 0.23, 221.06, 1.03, 338.12, 0.38, 
    440.08, 0.29, 61.26, 0.21, 133.58, 0.95, 273.59, 0.29, 218.2, 
    0.18, 48.33), Sig = c(NA, NA, "�\u0088\u0097�\u0088\u0097�\u0088\u0097", 
    "�\u0088\u0097", NA, NA, "�\u0088\u0097", NA, NA, NA, "�\u0088\u0097�\u0088\u0097�\u0088\u0097", 
    "�\u0088\u0097�\u0088\u0097", NA, NA, NA, NA, NA, NA, "�\u0088\u0097�\u0088\u0097", 
    "�\u0088\u0097", NA, NA, NA, NA), Ent_or_Rev = c("Number of Enterprises", 
    "Net Revenues", "Number of Enterprises", "Net Revenues", 
    "Number of Enterprises", "Net Revenues", "Number of Enterprises", 
    "Net Revenues", "Number of Enterprises", "Net Revenues", 
    "Number of Enterprises", "Net Revenues", "Number of Enterprises", 
    "Net Revenues", "Number of Enterprises", "Net Revenues", 
    "Number of Enterprises", "Net Revenues", "Number of Enterprises", 
    "Net Revenues", "Number of Enterprises", "Net Revenues", 
    "Number of Enterprises", "Net Revenues"), new_est = c(0.91, 
    237.89, 14.94, 2957.97, 1.79, 431.78, 1.47, 236.8, 1.17, 
    440.1, 15.29, 2126.56, 2.01, 951.82, 1.32, 237.04, 0.92, 
    203.81, 13.39, 1821.15, 1.52, 304.09, 0.82, 132.19), lower = c(0.3808, 
    1.14160000000001, 12.4312, 1341.4796, 1.1432, 28.804, 0.9016, 
    69.4748, 0.7192, 6.82240000000002, 13.2712, 1463.8448, 1.2652, 
    89.2632, 0.7516, 116.9704, 0.5084, -58.0068, 11.528, 1284.9136, 
    0.9516, -123.582, 0.4672, 37.4632), higher = c(1.4392, 474.6384, 
    17.4488, 4574.4604, 2.4368, 834.756, 2.0384, 404.1252, 1.6208, 
    873.3776, 17.3088, 2789.2752, 2.7548, 1814.3768, 1.8884, 
    357.1096, 1.3316, 465.6268, 15.252, 2357.3864, 2.0884, 731.762, 
    1.1728, 226.9168)), class = c("grouped_df", "tbl_df", "tbl", 
"data.frame"), row.names = c(NA, -24L), groups = structure(list(
    Ent_or_Rev = c("Net Revenues", "Net Revenues", "Net Revenues", 
    "Net Revenues", "Number of Enterprises", "Number of Enterprises", 
    "Number of Enterprises", "Number of Enterprises"), variable = c("Manufacturing", 
    "Retail Trade", "Services", "Transportation", "Manufacturing", 
    "Retail Trade", "Services", "Transportation"), .rows = structure(list(
        c(2L, 10L, 18L), c(4L, 12L, 20L), c(6L, 14L, 22L), c(8L, 
        16L, 24L), c(1L, 9L, 17L), c(3L, 11L, 19L), c(5L, 13L, 
        21L), c(7L, 15L, 23L)), ptype = integer(0), class = c("vctrs_list_of", 
    "vctrs_vctr", "list"))), row.names = c(NA, -8L), .drop = TRUE, class = c("tbl_df", 
"tbl", "data.frame")))

Solution

  • An easy fix would be to switch to geom_label which does allow to add some padding in absolute units independent of the scale of your data and the value of the data point, i.e. in the code below I add some padding of 10 points:

    Note: You might also consider adding coord_cartesian(clip="off") to prevent extreme labels from being clipped off.

    geom_label(
      aes(
        label = Sig,
        y = .data[[column_y_text]], group = variable
      ),
      vjust = 0,
      fill = NA,
      label.size = 0,
      label.padding = unit(10, "pt"),
      position = position_dodge(width = 0.9),
      na.rm = TRUE
    )
    

    enter image description here