CODEWITHSUNDEEP
rggplot2shiny
Ploulack
Ploulack

Reputation: 337

Bar switching positions in interactive geom_bar

Pb: when I click on the geom_bar bar, the bars switch positions even though I properly set the levels in the aes call. Please try below the simplest example I could come up with. All it does is add alpha to the bars below the clicked one. Problem: click bars and see them switching position.

The alpha is added with the 'type' variable that is updated in dat() on click event. If I deactivate the aes call in geom_bar the problem doesn't occur. Nor does it happen if I place the alpha in the main aes() rather than geom_bar's one.

The reactiveVal dat()'s type is unchanged, so even though the bars switch position, for the click logic they do not (you can test this by clicking on the same spot twice: on the first bar will switch position, not in the second).

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)

Upvotes: 2

Views: 106

Answers (1)

Amanda
Amanda

Reputation: 536

The issues appears to be that as it is the bars start off being ordered by value within the groups a and b, however as you click the bars the values of your cutoff variable change from all TRUE to being a mixture of TRUE and FALSE. This then causes the plot to try to sort the bars within the groups by the cutoff value since it is a factor (the bars with a TRUE value are always switched to the right of any bar with a FALSE, while the FALSE bars go back to being sorted by value, all within the groups a and b). To avoid this from happening, you can include all of your aes within the geom_bar, so your plot function would be like this:

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)

Upvotes: 1

Related Questions