如何在R Shiny中创建Plotly过渡式钻取条形图？

已创建基础Shiny App和Plotly钻取条形图，但希望点击钻取后当前图表直接切换为下一层级内容，而非在原图表下方生成新图表，需要修改实现该过渡效果。

修改后的完整代码 #

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

full_data <- tibble(
  State = c("IL", "IL", "IL", "IL", "IL", "IL", "IN", "IN", "IN", "IN", "IN", "IN"),
  City = c("Chicago", "Rockford", "Naperville", "Chicago", "Rockford", "Naperville","Fort Wayne", "Indianapolis", "Bloomington", "Fort Wayne", "Indianapolis", "Bloomington"),
  Year = c("2008", "2008", "2008", "2009", "2009", "2009", "2008", "2008", "2008", "2009", "2009", "2009"),
  GDP = c(200, 300, 350, 400, 450, 250, 600, 400, 300, 800, 520, 375)
)

ui <- fluidPage(
  selectInput(inputId = "year",
              label = "Year",
              multiple = TRUE,
              choices = unique(full_data$Year),
              selected = unique(full_data$Year)),
  selectInput(inputId = "state",
              label = "State",
              choices = unique(full_data$State)),
  # 仅保留一个Plotly容器用于动态切换图表
  plotlyOutput("drilldown_plot", height = 200),
  # 统一返回按钮的UI输出
  uiOutput('back_button')
)

server <- function(input, output, session) {
  
  # 跟踪当前钻取层级与选中对象
  current_level <- reactiveVal("state") # 默认显示州层级
  selected_state <- reactiveVal(NULL)
  
  # 州层级图表点击事件：切换到城市层级并记录选中州
  observeEvent(event_data("plotly_click", source = "state_level"), {
    clicked_state <- event_data("plotly_click", source = "state_level")$x
    selected_state(clicked_state)
    current_level("city")
  })
  
  # 返回按钮事件：回到上一层级
  observeEvent(input$go_back, {
    if(current_level() == "city"){
      current_level("state")
      selected_state(NULL)
    }
  })
  
  # 动态过滤数据：根据当前层级匹配对应维度
  filtered_data <- reactive({
    data <- full_data %>% filter(Year %in% input$year)
    
    if(current_level() == "state"){
      data %>% filter(State %in% input$state)
    } else if(current_level() == "city"){
      data %>% filter(State == selected_state())
    }
  })
  
  # 动态渲染当前层级的图表
  output$drilldown_plot <- renderPlotly({
    if(current_level() == "state"){
      filtered_data() %>% 
        plot_ly(
          x = ~Year,
          y = ~GDP,
          color = ~City,
          source = "state_level",
          type = "bar"
        ) %>% 
        layout(barmode = "stack", showlegend = TRUE, title = "州层级GDP")
    } else if(current_level() == "city"){
      filtered_data() %>% 
        plot_ly(
          x = ~City,
          y = ~GDP,
          color = ~Year,
          source = "city_level",
          type = "bar"
        ) %>% 
        layout(barmode = "stack", showlegend = TRUE, title = paste0(selected_state(), "州 - 城市层级GDP"))
    }
  })
  
  # 控制返回按钮的显示/隐藏
  output$back_button <- renderUI({
    if(current_level() != "state"){
      actionButton("go_back", "返回上一层", icon("chevron-left"))
    }
  })
  
}

shinyApp(ui, server)

关键改动说明 #

• UI层简化：移除原有的两个独立Plotly输出，仅保留一个容器用于动态切换不同层级的图表
• 层级状态管理：新增current_level响应式变量跟踪当前显示层级，selected_state记录钻取时选中的州
• 数据动态过滤：根据当前层级自动匹配对应的过滤规则，确保展示内容与层级对应
• 图表动态渲染：在renderPlotly中根据当前层级判断渲染逻辑，包括坐标轴维度、分组规则和标题的调整
• 统一返回控制：用单个返回按钮替代原有的两个按钮，根据当前层级自动控制显示状态，点击后回到上一层级

内容的提问来源于stack exchange，提问作者Harry Kalsted