根据 RShiny 中的多个条件增加 y 轴高度以适应 geom_text 标签

Question

我有一个应用程序，当未选择 p 值时，它看起来像这样：

选择 p 值时，y 轴会扩展，这样星号就不会被切断：

这行代码是：

{if(input$p_values) expand_limits(y= c(0, new_est_y *1.05))} +

但我想包括这样的条件：仅当最高的条形需要在其上方加星号时，y 轴才会延伸，即，对于该特定类别，if !is.na(Sig) for max(new_est)。 是否有用 Shiny 的方式传达： if(input$p_values) AND if(!is.na(Sig_y)) AND if(new_est_y ==max(new_est_y) then Expand_limits?

例如。在 Number of Enterprises 中，最高的条是 Lump Sum，如果 Sig 为 NA，我不希望延长 y 轴：

我的代码是：

cbPalette <- c("#E69F00", "#56B4E9", "#009E73") #color-blind friendly palette or "#CC79A7"?    

fun_select_cat <- function(table, cat) {
  table %>% 
    filter(variable == cat)
}


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(selectInput('cat','Select Category', c('Number of Enterprises','Assets','Costs','Net Revenues','Revenues')),
    checkboxInput("control_mean",label = "Show average for non-recipients", value = FALSE),
    checkboxInput("p_values",label = "Show p-values", value = FALSE),
    actionButton("Explain_p_values", "Explain p-values")),
    mainPanel(plotOutput('plot_overall'))
  ))

server <- function(input, output, session) {
  observeEvent(input$Explain_p_values, {showModal(modalDialog(p_value_text))})
  output$plot_overall <- renderPlot({
    control_y = fun_select_cat(table_2, input$cat) %>% pull(Control)
    Sig_height_y = fun_select_cat(table_2, input$cat) %>% pull(Sig_height)
    Sig_y = fun_select_cat(table_2, input$cat) %>% pull(Sig)
    new_est_y = fun_select_cat(table_2, input$cat) %>% pull(new_est)
    
    fun_select_cat(table_2, input$cat) %>% 
      ggplot(aes(x = Treatment, y = new_est, fill = Treatment)) +
      geom_col() + scale_fill_manual(values = cbPalette) +
      guides(fill = FALSE) +
      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)) +
      {if(input$p_values) geom_text(aes(label = Sig_y), y = Sig_height_y)} +
      {if(input$p_values) expand_limits(y= c(0, new_est_y *1.05))} +
      {if(input$control_mean) annotate("text", x = 3.6, y = 1.078 * control_y, 
           label = "Control\nmean",
           colour = "#CC79A7",
           fontface =2,
           size = 4.5)} +
      {if(input$control_mean)expand_limits(x= c(1, length(levels(table_2$Treatment)) + 0.75))} +
      {if(input$control_mean) geom_hline(aes(yintercept = Control), linetype='dashed', col = '#CC79A7', size = 1.5)} +
            if(input$cat %in% c("Number of Enterprises", "Assets")
      ) {labs(title= input$cat, x = NULL, y = NULL)
      } else{labs(title = paste(input$cat, "(USD) for the last 30 days", sep =" "), x = NULL, y = NULL)}
     
  })
}

shinyApp(ui = ui, server = server)

dput（表_2）

structure(list(Treatment = structure(c(1L, 1L, 1L, 1L, 1L, 3L, 
3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L), levels = c("Long Term", 
"Short Term", "Lump Sum"), class = "factor"), variable = c("Number of Enterprises", 
"Assets", "Costs", "Net Revenues", "Revenues", "Number of Enterprises", 
"Assets", "Costs", "Net Revenues", "Revenues", "Number of Enterprises", 
"Assets", "Costs", "Net Revenues", "Revenues"), Control = c(73.23, 
100036.59, 92636.84, 54533.59, 150207.24, 73.23, 100036.59, 92636.84, 
54533.59, 150207.24, 73.23, 100036.59, 92636.84, 54533.59, 150207.24
), Estimate = c(9.93, 36050.66, 32055.29, 28226.05, 61379.4, 
14.67, 29404.54, 71903.23, 35576.39, 107746.75, 3.39, 16441.81, 
8497.42, 14824.71, 23177.47), SE = c(3.96, 12589.11, 16478.13, 
12334.27, 24346.05, 3.92, 10977.68, 24360.84, 13382.81, 34895.03, 
3.57, 10029.27, 10462.44, 8143.69, 16080.92), Sig = c("�\u0088\u0097�\u0088\u0097", 
"�\u0088\u0097�\u0088\u0097�\u0088\u0097", "�\u0088\u0097", "�\u0088\u0097�\u0088\u0097", 
"�\u0088\u0097�\u0088\u0097", "�\u0088\u0097�\u0088\u0097�\u0088\u0097", 
"�\u0088\u0097�\u0088\u0097�\u0088\u0097", "�\u0088\u0097�\u0088\u0097�\u0088\u0097", 
"�\u0088\u0097�\u0088\u0097�\u0088\u0097", "�\u0088\u0097�\u0088\u0097�\u0088\u0097", 
NA, NA, NA, "�\u0088\u0097", NA), new_est = c(83.16, 136087.25, 
124692.13, 82759.64, 211586.64, 87.9, 129441.13, 164540.07, 90109.98, 
257953.99, 76.62, 116478.4, 101134.26, 69358.3, 173384.71), lower = c(75.3984, 
111412.5944, 92394.9952, 58584.4708, 163868.382, 80.2168, 107924.8772, 
116792.8236, 63879.6724, 189559.7312, 69.6228, 96821.0308, 80627.8776, 
53396.6676, 141866.1068), higher = c(90.9216, 160761.9056, 156989.2648, 
106934.8092, 259304.898, 95.5832, 150957.3828, 212287.3164, 116340.2876, 
326348.2488, 83.6172, 136135.7692, 121640.6424, 85319.9324, 204903.3132
), Sig_height = c(87.318, 142891.6125, 130926.7365, 86897.622, 
222165.972, 92.295, 135913.1865, 172767.0735, 94615.479, 270851.6895, 
80.451, 122302.32, 106190.973, 72826.215, 182053.9455)), class = c("grouped_df", 
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -15L), groups = structure(list(
    variable = c("Assets", "Costs", "Net Revenues", "Number of Enterprises", 
    "Revenues"), .rows = structure(list(c(2L, 7L, 12L), c(3L, 
    8L, 13L), c(4L, 9L, 14L), c(1L, 6L, 11L), c(5L, 10L, 15L)), ptype = integer(0), class = c("vctrs_list_of", 
    "vctrs_vctr", "list"))), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -5L), .drop = TRUE))

Answer 1

您可以将您当前的状况替换为

if (input$p_values & table_2 |>
    filter(new_est == max(new_est)) |>
    ungroup() |>
    select(Sig) |>
    (\(.) all(!is.na(.)))()
)

它还会检查相关变量（此时您的表已被过滤），

Sig

不是

NA

最大为

new_est

。

另请注意，这依赖于您的表格已经分组的事实，这是我假设的，因为您给定的示例就是这种情况。如果不是，您可以删除

ungroup()

。