Бар переключения позиций в интерактивном geom_bar

Question

Pb: когда я нажимаю на панель geom_bar, бары меняются местами, даже если я правильно установил уровни в вызове aes.Пожалуйста, попробуйте ниже простейший пример, который я мог придумать.Все, что он делает, это добавляет альфу к столбцам ниже кликаемого.Проблема: щелкайте по барам и смотрите, как они меняют положение.

В альфа добавлена ​​переменная 'type', которая обновляется в dat () при событии щелчка.Если я деактивирую вызов aes в geom_bar, проблема не возникнет.Также не произойдет, если я поместу альфу в главном aes (), а не в geom_bar.

Тип реактивного dat () неизменен, поэтому, даже если столбцы переключают положение, для логики щелчка онине надо (вы можете проверить это, дважды щелкнув по одному и тому же месту: на первом баре поменяется положение, а не на втором).

library(shiny); library(tidyverse)
ui <- function() {
      plotOutput(outputId = "bar",click = "click")
}

server <- function(input, output, session) {

      dat <- reactiveVal(
            tibble(value = 1:4,
                   name = c("a", "b", "a", "b"),
                   type = c("small", "small", "big", "big"),
                   cut_off = TRUE )
      )

      last_click <- reactiveVal(NULL)

      observeEvent(input$click, {
            if (!is.null(input$click)) last_click(input$click)
      })

      clicked_sample <- eventReactive(last_click(), {
            if (is.null(last_click())) return(NULL)

            click_x <- last_click()$x
            splits <- seq(1/4, 1 - 1/4, 1/2)

            sample_lvls <- dat()$name %>%
                  as_factor() %>% 
                  levels()

            clicked_sample_name <- sample_lvls[round(click_x)]

            types <- dat()$type %>% unique() %>% sort()

            x <- click_x - round(click_x) + 1/2

            clicked_type <- types[which.min(abs(splits - x))]

            dat() %>%
                  filter(type == clicked_type & name == clicked_sample_name)

      }, ignoreNULL = FALSE)

      observeEvent(clicked_sample(), {
            dat(
                  dat() %>%
                        mutate(cut_off = if_else(
                              value >= clicked_sample()$value,
                              TRUE,
                              FALSE,
                              missing = FALSE)
                        )
            )
      })

      output$bar <- renderPlot({
            g <- ggplot(dat()) +
                  aes(x = name, y = value, 
                      fill = factor(type, 
                                    levels = type %>%
                                               as.character() %>%
                                               unique() %>% 
                                               sort())) +
                  geom_bar(
                        aes(alpha = cut_off %>% factor(levels = c(FALSE, TRUE))),
                        position = "dodge",
                        stat = "identity"
                  ) +
                  scale_alpha_discrete(guide = "none", drop = FALSE)

            if (!is.null(clicked_sample()$value)) {
                  g + geom_hline(yintercept = clicked_sample()$value)
            } else {
                  g
            }
      })
}

shinyApp(ui, server)

Answer 1

Проблемы заключаются в том, что, поскольку бары начинаются с упорядочения по значению в группах a и b, однако, когда вы нажимаете на бары, значения вашей переменной отсечки изменяются со всех ИСТИНА на смесь ИСТИНЫ иЛОЖНЫЙ.Это приводит к тому, что график пытается отсортировать столбцы внутри групп по значению отсечки, поскольку это фактор (столбцы со значением ИСТИНА всегда переключаются вправо от любого бара с ЛОЖЬЮ, тогда как столбцы ЛОЖЬ возвращаются ксортируются по значению, все в группах а и б).Чтобы этого не происходило, вы можете включить все свои aes в geom_bar, чтобы ваша функция графика была такой:

g <- ggplot(dat()) +
  geom_bar(
    aes(x = name, y = value, 
        fill = factor(type, 
                      levels = type %>%
                        as.character() %>%
                        unique() %>% 
                        sort()),
        alpha = cut_off %>% factor(levels = c(FALSE, TRUE))),
    position = "dodge",
    stat = "identity"
  ) +
  scale_alpha_discrete(guide = "none", drop = FALSE)