时间戳

首页 > 解决方案 > 交互式 geom_bar 中的条形切换位置

r - 交互式 geom_bar 中的条形切换位置

问题描述

Pb：当我单击 geom_bar 栏时，即使我在 aes 调用中正确设置了级别，栏也会切换位置。请尝试下面我能想到的最简单的例子。它所做的只是将 alpha 添加到单击的条下方的条中。问题：单击条并查看它们的切换位置。

alpha 添加了 'type' 变量，该变量在点击事件时在 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)

标签： rggplot2shiny

解决方案

问题似乎是，因为在组 a 和 b 中，条形开始按值排序，但是当您单击条形时，截止变量的值从所有 TRUE 变为 TRUE 和 FALSE 的混合。然后，这会导致绘图尝试按截止值对组内的条进行排序，因为它是一个因素（具有 TRUE 值的条始终切换到具有 FALSE 的任何条的右侧，而 FALSE 条返回到按值排序，都在组 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)

推荐阅读