shinyapp 中的绘图对输入没有反应

Posted 2023-02-18

【中文标题】shinyapp 中的绘图对输入没有反应

【英文标题】：plotly graph in shinyapp isn't reactive to input

【发布时间】：2021-11-09 15:47:25

【问题描述】：

我正在尝试使用对输入做出反应的曲线图来设置闪亮应用。我正在使用 plot_ly 作为图表，我的理想图表将具有与 checkboxGroupInput 中选择的一样多的线。我的问题是图表没有对输入做出反应，它正在绘制所有选项或者不会绘制多个选项，但我无法弄清楚以我想要的方式对其进行编码。它已与 ggplot 一起使用，但由于其他原因我必须使用 plotly，所以我想坚持下去。我试图过滤我的数据或创建一个反应变量 ->col()，但这没有用。另一个问题是带有日期变量的 sliderInput 不起作用（或者图表没有相应地做出反应）。

如果您有任何建议或提示，我将非常感谢！

到目前为止，这是我的代码：

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

# 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(
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) 
  
  y <- reactive(data[,input$art3])
  # col <- reactive(data[input$bl3,]) # i tried to make the land-variable reactive but that didn't work 
  
output$plot3 <- renderPlotly( 
  validate(
    need(input$bl3, 
         message = "select something first."
    )) 
  
  
  data_filtered <- filter(data, date >= input$time3[1], 
                          date <= input$time3[2])
  
 
  
  plot_ly(data_filtered, 
          x=~date, color = ~input$bl3, mode= "lines+markers") %>% 
    add_lines(y= y())
)


shinyApp(ui, server)

使用此代码，如果我选择多个选项，我会收到错误消息：“警告：错误：Tibble 列必须具有兼容的大小”。

【问题讨论】：

得到一个错误：Error in tagAssert(header, type = "header", class = "main-header") : Expected tag to be of type header

【参考方案1】：

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

# 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 <- filter(
      data, 
      date >= input$time3[1], 
      date <= input$time3[2],
      land %in% input$bl3) # filter land as well
    
    
    
    plot_ly(data_filtered, 
            x=~date, color = ~land, mode= "lines+markers") %>% 
      add_lines(y= ~ .data[[input$art3]])
  )


shinyApp(ui, server)

【讨论】：

感谢您的代码！我更新了我的，但如果我选择多个状态，我仍然会收到相同的错误：“警告：错误：Tibble 列必须具有兼容的大小。* 大小 2：列 color。* 大小 7：列 x 和 @ 987654324@.i 只有大小为 1 的值被回收。"

@HaHa 您是否逐字复制了我的代码？它有效。