Shiny应用中Plotly折线图不响应输入及日期滑块失效问题求助

错误根因 #

• 数据集过滤逻辑不完整：仅过滤了日期范围，未按checkbox选中的州筛选数据，同时y轴取值直接取自全量数据集，和过滤后的数据集行数不匹配，触发「Tibble columns must have compatible sizes」报错
• Plotly字段映射错误：color参数直接绑定input$bl3输入向量，未映射到数据集的land分组字段，无法按选中的州生成对应数量的折线
• 动态列名取值逻辑错误：未将选中的犯罪类型和过滤后数据集关联，导致数据联动失效
• 基础UI结构缺失：原代码中dashboardPage未传入必填的头部、侧边栏参数，会直接引发运行错误

修正后可运行完整代码 #

library(shiny)
library(shinydashboard)
library(plotly)
library(dplyr)

# data frame
land <- c("BW", "BW", "BW", 
          "MV", "MV", "MV", "MV",
          "SH", "SH", "SH")

total <- c(1, 5, 3, 
           7, 4, 2, 4, 
           7, 2, 6)

gewalt <- c(1, 1, 2, 
            2, 2, 0, 1, 
            4, 0, 3)

sonst <- c(0, 4, 1, 
           5, 2, 2, 3, 
           3, 2, 3)

date <- c("2001-12-31", "2003-06-30", "2006-11-30",
          "2001-12-31", "2006-11-30", "2008-09-30", "2010-02-28",
          "2001-12-31", "2003-06-30", "2006-11-30")

data <- data.frame(cbind(land, total, gewalt, sonst, date))

data$land <- as.factor(data$land)
data$total <- as.numeric(data$total)
data$gewalt <- as.numeric(data$gewalt)
data$sonst <- as.numeric(data$sonst)
data$date <- as.Date(data$date)

# user interface
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(
      box(
        selectInput("art3", "select what kind of crime:",
                    choices = c("Insgesamt"= "total",
                                "Gewalttaten"= "gewalt", 
                                "Straftaten"= "sonst")),
        
        sliderInput("time3", "select the time frame",
                    min(data$date), max(data$date),
                    value = c(min(data$date), max(data$date)), timeFormat = "%b %Y"),
        
        checkboxGroupInput("bl3", "select the state:",
                           choices= levels(data$land)),
        
        width = 4),
      
      box(plotlyOutput("plot3"),
          width = 8)
    )))

# server
server <- function(input, output, session) {
  output$plot3 <- renderPlotly({ 
    validate(
      need(input$bl3, message = "select something first.")
    ) 
    # 同时按日期、选中的州过滤数据
    data_filtered <- data %>%
      filter(date >= input$time3[1], 
             date <= input$time3[2],
             land %in% input$bl3)
    # 动态取选中的犯罪类型列，按land分组着色
    plot_ly(data_filtered, 
            x = ~date, 
            y = ~.data[[input$art3]],
            color = ~land, 
            mode = "lines+markers") %>%
      add_lines()
  })
}

shinyApp(ui, server)

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