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和假。然后，这会导致绘图尝试按截止值对组内的条进行排序，因为它是一个因子（具有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)

在交互式geom_bar中切换位置

1 个答案: