I didn't really know how to phrase the question, but hopefully it will make sense when I explain things. I have a simple Shiny App that has a main plot (bar chart) and a sub plot (bar chart). When you go to the subplot, no data pops up for Jewel for "vegetable" or "fruit". I understand why that is, but I was wondering if there's a coding solution where Jewel can have a bar that the legend just denotes as "Other". So if the filter is on "Vegetable", the bar for Jewel on the suplot will be 800 with one solid color that just says "Other".

As always, thank you for any assistance.

library(tidyverse)
library(plotly)
library(shiny)
library(shinydashboard)
library(shinyWidgets)


store_data <- tibble(
  Whole_Foods = c(1000, 500, 500, 1000, 500, 500),
  Kroger = c(700, 300, 400, 700, 300, 400),
  Jewel = c(800, 0, 0, 800, 0, 0),
  Food_Main = c("Vegetable", "Lettuce", "Potato", "Fruit", "Lemon", "Watermelon"),
  Food_Filter = c("None", "Vegetable", "Vegetable", "None", "Fruit", "Fruit")
  
)


store_data <- store_data %>%
  reshape2::melt(measure.vars = c("Whole_Foods", "Kroger", "Jewel"),
                 variable.name = "Grocery_Store") %>%
  mutate(value = value %>% as.numeric()) %>%
  rename(Sales = value)


ui <- fluidPage(
  selectInput(inputId = "store",
              label = "Grocery Store",
              multiple = TRUE,
              choices = unique(store_data$Grocery_Store),
              selected = unique(store_data$Grocery_Store)),
  selectInput(inputId = "food_subcategory",
              label = "Food Type",
              choices = c("Vegetable", "Fruit")),
  plotlyOutput("food_level", height = 200),
  plotlyOutput("filter_level", height = 200),
  uiOutput('back'),
  uiOutput("back1")
)


server <- function(input, output, session) {
  
  
  food_filter <- reactiveVal()
  type_filter <- reactiveVal()
  
  
  observeEvent(event_data("plotly_click", source = "food_level"), {
    food_filter(event_data("plotly_click", source = "food_level")$x)
    type_filter(NULL)
  })
  
  
  observeEvent(event_data("plotly_click", source = "filter_level"), {
    type_filter(
      event_data("plotly_click", source = "filter_level")$x
    )
  })
  
  
  store_reactive <- reactive({
    store_data %>%
      filter(Food_Filter ==  "None") %>%
      filter(Grocery_Store %in% input$store)
  })
  
  
  output$food_level <- renderPlotly({
    store_reactive() %>% 
      plot_ly(
        x = ~Grocery_Store,
        y = ~Sales,
        color = ~Food_Main,
        source = "food_level",
        type = "bar"
      ) %>% 
      layout(barmode = "stack", showlegend = T)
  })
  
  
  store_reactive_2 <- reactive({
    store_data %>%
      filter(Grocery_Store %in% input$store) %>%
      filter(Food_Filter %in% input$food_subcategory)
  })
  
  
  output$filter_level <- renderPlotly({
    if (is.null(food_filter())) return(NULL)
    
    store_reactive_2() %>% 
      plot_ly(
        x = ~Grocery_Store,
        y = ~Sales,
        color = ~Food_Main,
        source = "food_level",
        type = "bar"
      ) %>% 
      layout(barmode = "stack", showlegend = T)
  })
  
  
  output$back <- renderUI({
    if (!is.null(food_filter()) && is.null(type_filter())) {
      actionButton("clear", "Back", icon("chevron-left"))
    }
  })
  
  
  output$back1 <- renderUI({
    if (!is.null(type_filter())) {
      actionButton("clear1", "Back", icon("chevron-left"))
    }
  })
  
  
  observeEvent(input$clear,
               food_filter(NULL))
  observeEvent(input$clear1,
               type_filter(NULL))
  
}


shinyApp(ui, server)

CodePudding user response：

The issue is you have your totals mixed in with the granular level data. You need to separate these out and then create a bucket for "Other". Create a separate totals data set for the first plot and a modified store_data for the sub-plot.

totals <- store_data %>% 
  filter(Food_Filter == "None") %>% 
  select(-Food_Filter) 

remainder <- store_data %>% 
  filter(Food_Filter != "None") %>% 
  group_by(Food_Filter, Grocery_Store) %>% 
  summarize(accounted_for = sum(Sales), .groups = "keep") %>% 
  left_join(
    totals, 
    by = c("Food_Filter" = "Food_Main", "Grocery_Store" = "Grocery_Store")
  ) %>% 
  summarize(Sales = Sales - accounted_for) %>% 
  ungroup() %>% 
  mutate(Food_Main = "Other") 

store_data <- store_data %>% 
  filter(Food_Filter != "None") %>% 
  bind_rows(remainder) 

Then update which data set used by the reactive:

store_reactive <- reactive({
    totals %>% 
      filter(Grocery_Store %in% input$store)
  })