Выровнять весь geom_text над отдельными столбцами

У меня есть это приложение, которое должно показывать звездочки p-значений над столбцами или доверительными интервалами, если они выбраны. Это работает для одной категории, но не для другой (применяются только две из четырех категорий). Как я могу изменить свой код, чтобы исправить это? Я не уверен, в чем заключается ошибка и почему это работает для розничной торговли, но не для транспорта.

  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(таблица_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")))
label_comma() не определено. Ваша ошибка невоспроизводима.
YBS 06.04.2024 03:35

Этот фрагмент кода был предназначен только для того, чтобы остановить отображение чисел по оси Y в экспоненциальной записи. У меня это не выдает ошибку. Насколько я понимаю, label_comma() просто вставляет запятую каждые три цифры.

hks 06.04.2024 03:45

Я думаю, это функция из пакета scales.

Jon Spring 06.04.2024 06:26
Стоит ли изучать PHP в 2026-2027 годах?
Стоит ли изучать PHP в 2026-2027 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
0
3
61
2
Перейти к ответу Данный вопрос помечен как решенный

Ответы 2

Вы размещаете текст пропорционально высоте панели. Таким образом, любой короткий бар будет иметь проблему, которую вы заметили. Вместо умножения на 1,05 просто добавьте константу, скажем, 0,5.

Попробуй это

geom_text(aes(label = Sig, y = (.data[[column_y_text]] + 0.5), 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 + 0.5))  

Это имеет смысл, спасибо. К сожалению, я не могу добавить константу, потому что другой параметр в меню выбора имеет совершенно другой масштаб (в тысячах). Есть ли способ добавить предложение if, которое указывает ТОЛЬКО для добавления константы, когда выбрано «Количество предприятий» И выбран «Транспорт»?

hks 06.04.2024 04:11
Ответ принят как подходящий

Простым решением было бы переключиться на geom_label, который позволяет добавлять некоторые отступы в абсолютных единицах, независимо от масштаба ваших данных и значения точки данных, т. е. в приведенном ниже коде я добавляю отступы в 10 пунктов:

Примечание. Вы также можете добавить coord_cartesian(clip = "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
)

Стефан, куда ты добавляешь coord_cartesian(clip = "off")? Когда я добавляю его в качестве последнего слоя в код ggplot, нижняя граница Net Revenues-Services по-прежнему обрезана.

hks 07.04.2024 20:15

Неважно! Я использовал подход Layer_p, с которым вы мне помогли в другой раз, и изменил слой ошибок :)

hks 09.04.2024 03:34

Другие вопросы по теме

Похожие вопросы