选择 selectInput 时添加标签会更改标签的 pos 和 neg 高度

Question

我有一个应用程序，可以选择将 p 值水平显示为星号，将置信区间显示为误差线。

当所有观察结果均为正值时，它会按预期工作：当仅选择 p 值框时，星号位于列的正上方；或当同时选择 p 值和 CI 框时位于误差线上方；在这两种情况下，如果最高的条带有星号，则 y 轴限制会相应延长，这样它就不会被切断。

这是执行此操作的层：

layer_p <- if (input$p_values) {
      column_y_text <- if (input$error_bars) {
        "higher"
      } else {
        "Estimate"
      }
      max_y_text <- table_9_filtered |>
        filter(!is.na(Sig)) |>
        pull(column_y_text) |>
        max()
      list(
        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
        ),
        if (!is.na(max_y_text))
          expand_limits(y = c(0, max_y_text * 1.1))
      )
    }

但是，如果观察结果是否定的，我就会遇到问题：

我如何调整layer_p代码，以便（1）当观察结果为负时，星号位于列/误差线下方，（2）如果最高的负条有星号（即不是），则ylimit向下延伸Sig 列中的 NA）？

我的代码是：

cbPalette <-  c("#E69F00", "#56B4E9", "#009E73")
fun_select_cat <- function(table, cat) {
  table %>%
    filter(variable == cat)
}
ui <- fluidPage(
  sidebarLayout(
  sidebarPanel(
    selectInput('cat', 'Select Category', unique(table_9$variable)),
    checkboxInput("p_values", label = p_value_label, value = FALSE),
    checkboxInput("error_bars", label = "Show 95% confidence intervals", value = FALSE)
  ),
  mainPanel(plotOutput('plot_overall'))
))

server <- function(input, output, session) {
        
  output$plot_overall <- renderPlot({
    table_9_filtered <- fun_select_cat(table_9, input$cat) |>
      ungroup()
    
    title <- input$cat
      
    layer_error <- if (input$error_bars) {
      lim_lower <- table_9_filtered |>
        pull(lower) |>
        min()
      lim_higher <- table_9_filtered |>
        pull(higher) |>
        max()
      list(
        geom_errorbar(
          aes(ymin = lower,
              ymax = higher),
          width = 0.25,
          position = position_dodge(width = 0.9)
        ),
        if (lim_lower < 0)
          expand_limits(y = c(lim_lower*1.1, lim_higher))
      )
    }
    
    layer_p <- if (input$p_values) {
      column_y_text <- if (input$error_bars) {
        "higher"
      } else {
        "Estimate"
      }
      max_y_text <- table_9_filtered |>
        filter(!is.na(Sig)) |>
        pull(column_y_text) |>
        max()
      list(
        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
        ),
        if (!is.na(max_y_text))
          expand_limits(y = c(0, max_y_text * 1.1))
      )
    }
    
    table_9_filtered |>
      ggplot(aes(x = Treatment, y = Estimate, fill = Treatment)) +
      geom_col() +
      scale_fill_manual(values = cbPalette) +
      scale_y_continuous(labels = label_comma(), expand = c(0, 0)) +
      theme_classic() +
      scale_x_discrete(drop = FALSE) +
      layer_p +
      layer_error +
      labs(title = title, x = NULL, y = NULL)
  })
}
shinyApp(ui = ui, server = server)

dput（表_9）：

structure(list(Treatment = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 
3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 2L), levels = c("Long Term", 
"Short Term", "Lump Sum"), class = "factor"), variable = c("Anthro. Index", 
"Domestic Violence", "KCPE Score >= 250", "Ladder: Current", 
"Mental Health Depressed (Y/N)", "Years of Schooling", "Anthro. Index", 
"Domestic Violence", "KCPE Score >= 250", "Ladder: Current", 
"Mental Health Depressed (Y/N)", "Years of Schooling", "Anthro. Index", 
"Domestic Violence", "KCPE Score >= 250", "Ladder: Current", 
"Mental Health Depressed (Y/N)", "Years of Schooling"), Estimate = c(0, 
-0.05, 0.04, 0.2, -0.08, -0.09, 0.01, -0.08, 0.08, 0.21, -0.04, 
0.01, 0.07, -0.06, 0, 0.22, -0.07, -0.01), SE = c(0.04, 0.04, 
0.04, 0.07, 0.02, 0.08, 0.04, 0.04, 0.03, 0.06, 0.02, 0.06, 0.04, 
0.04, 0.03, 0.06, 0.02, 0.07), Sig = c(NA, NA, NA, "∗∗∗", 
"∗∗∗", NA, NA, "∗∗", "∗∗∗", "∗∗∗", "∗∗", 
NA, "∗", NA, NA, "∗∗∗", "∗∗∗", NA), lower = c(-0.0784, 
-0.1284, -0.0384, 0.0628, -0.1192, -0.2468, -0.0684, -0.1584, 
0.0212, 0.0924, -0.0792, -0.1076, -0.00839999999999999, -0.1384, 
-0.0588, 0.1024, -0.1092, -0.1472), higher = c(0.0784, 0.0284, 
0.1184, 0.3372, -0.0408, 0.0668, 0.0884, -0.0016, 0.1388, 0.3276, 
-0.000800000000000002, 0.1276, 0.1484, 0.0184, 0.0588, 0.3376, 
-0.0308, 0.1272)), row.names = c(NA, -18L), class = c("data.table", 
"data.frame"), .internal.selfref = <pointer: 0x000002877bcd8b80>, sorted = c("Treatment", 
"variable"))

Answer 1

这是一种实现您所需结果的选项，使用

ifelse

有条件地设置

vjust

，并将限制扩展到包括数据的

range

，而不仅仅是

max

。

layer_p <- if (input$p_values) {
  # Add a helper column to the data
  table_9_filtered$y_text <- if (input$error_bars) {
    ifelse(
      table_9_filtered[["Estimate"]] < 0,
      table_9_filtered[["lower"]],
      table_9_filtered[["higher"]]
    )
  } else {
    table_9_filtered[["Estimate"]]
  }
  
  y_text <- table_9_filtered |>
    filter(!is.na(Sig)) |>
    pull(y_text)
  
  list(
    geom_label(
      aes(
        label = Sig,
        y = y_text,
        group = variable,
        # set vjust conditionally
        vjust = ifelse(
          y_text < 0,
          1,
          0
        ),
      ),
      fill = NA,
      label.size = 0,
      label.padding = unit(10, "pt"),
      position = position_dodge(width = 0.9),
      na.rm = TRUE
    ),
    if (any(!is.na(y_text))) {
      # Expand to include the range of the data times 1.1
      expand_limits(y = 1.1 * range(y_text))
    }
  )
}