交互式geom_bar中的条形开关位置

Question

Pb:当我单击geom_bar栏时，尽管我正确地设置了aes调用中的级别，但这些条形仍会切换位置。下面是我能想到的最简单的例子。它所做的就是将alpha添加到单击栏下面的栏中。问题:单击条形图并看到它们切换的位置。

alpha是用“type”变量添加的，该变量在click事件的dat()中更新。如果我在geom_bar中禁用aes调用，问题就不会发生。如果我将alpha放在主aes()中而不是geom_bar的一个中，也不会发生这种情况。

reactiveVal 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中的值排序的，但是，当您单击栏时，截止变量的值将从所有TRUE变为TRUE和FALSE的混合体。这将导致图解试图按照截止值对组内的条形图进行排序，因为它是一个因素(具有真值的条形图总是切换到任何带FALSE的条形图的右边，而假条则返回到按值排序，所有这些值都在组a和b中)。为了避免这种情况发生，您可以在geom_bar中包含所有的aes，因此您的绘图函数如下所示：

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)