当 UI 中没有选择任何内容时，反应性 ggplot 工具提示错误，

问题描述

我有这个使用工具提示的反应式 ggplot 闪亮示例， 问题是当没有选择任何东西时，我收到了这个错误> Error : Aesthetics must be either length 1 or the same as the data (1): x,y,colour,label and group 当我在没有 plottly 和工具提示的情况下尝试此代码时，它工作正常。 知道如何在 ggplotly 和 tooltip 中解决这个问题吗？ 我发布了两个版本的 app.R

app.R（ggplotly 版本在未选择任何内容时出错）

library(shiny)
library(ggplot2)
library(plotly)

ui <- fluidPage(
  
  sidebarLayout(
    position='right',sidebarPanel(
      
      selectInput("region_input","Select Regions:",choices = c("Alabama","Alaska","Arizona"),selected = "Alabama",multiple = TRUE),),mainPanel(
      plotlyOutput("distPlot"),))
)

server <- function(input,output) {
  
  data <- structure(list(Region = structure(c(1L,1L,2L,3L,3L),.Label = c("Alabama",class = "factor"),date = structure(c(18283,18284,18285,18283,18285),class = "Date"),confirmed = c(5L,10L,7L,20L,4L,40L,8L)),row.names = c(NA,-9L),class = "data.frame")
  
  filtered_data <- reactive( {
    
    
    filtered_data <- data %>%
      filter(Region %in% input$region_input)
    return(filtered_data)
  })
  
  output$distPlot <- renderPlotly({
    ggplotly(
      ggplot(filtered_data(),aes(x = date,y = confirmed,label = Region,color = Region,group = Region,text=paste(date,"\n",Region," ",confirmed  ))) +
        geom_line( aes(date,confirmed,color = Region)),tooltip = ("text")
    ) 
    
  })
}

shinyApp(ui = ui,server = server)

app.R 工作版本只有 ggplot，没有工具提示

library(shiny)
library(ggplot2)


ui <- fluidPage(
  
  sidebarLayout(
    position='right',sidebarPanel(
      
      h4(selectInput("region_input",)),mainPanel(
      
      
      
      plotOutput("distPlot"),class = "data.frame")
  
    filtered_data <- reactive( {
      filtered_data <- data %>%
      filter(Region %in% input$region_input)
    return(filtered_data)
  })
  
  output$distPlot <- renderPlot({
    ggplot(filtered_data(),group = Region)) +
      geom_line( aes(date,color = Region))

  })
}


shinyApp(ui = ui,server = server)

数据框>

> data
   Region       date confirmed
1 Alabama 2020-01-22         5
2 Alabama 2020-01-23        10
3 Alabama 2020-01-24         7
4  Alaska 2020-01-22        20
5  Alaska 2020-01-23         4
6  Alaska 2020-01-24         1
7 Arizona 2020-01-22         3
8 Arizona 2020-01-23        40
9 Arizona 2020-01-24         8

添加了屏幕截图错误

解决方法

当没有选择任何内容时，您需要考虑 NULL。试试这个

server <- function(input,output) {
  
  data <- structure(list(Region = structure(c(1L,1L,2L,3L,3L),.Label = c("Alabama","Alaska","Arizona"),class = "factor"),date = structure(c(18283,18284,18285,18283,18285),class = "Date"),confirmed = c(5L,10L,7L,20L,4L,40L,8L)),row.names = c(NA,-9L),class = "data.frame")
  
  filtered_data <- reactive( {
    if (is.null(input$region_input)) {
      filtered_data <- NULL
    }else {
      filtered_data <- data %>%
        filter(Region %in% input$region_input)
    }
    
    return(filtered_data)
  })
  
  output$distPlot <- renderPlotly({
    if (!is.null(filtered_data())) {
      ggplotly(
        ggplot(filtered_data(),aes(x = date,y = confirmed,label = Region,color = Region,group = Region,text=paste(date,"\n",Region," ",confirmed  ))) +
          geom_line( aes(date,confirmed,color = Region)),tooltip = ("text")
      ) 
    }else return(NULL)
  })
}

shinyApp(ui = ui,server = server)

,

工具提示在这里工作正常。

我稍微重新排列了您的代码。

library(shiny)
library(ggplot2)
library(plotly)

ui <- fluidPage(
  
  sidebarLayout(
    sidebarPanel(
      
      selectInput("region_input","Select Regions:",choices = c("Alabama",selected = "Alabama",multiple = TRUE)
      
    ),mainPanel(
      plotlyOutput("distPlot")
    ),position='right')
)

server <- function(input,class = "data.frame")
  
  filtered_data <- reactive( {
    
    if (length(input$region_input) > 0){
    filtered_data <- data %>%
      filter(Region %in% input$region_input)
    return(filtered_data)}
    else{
      return(data)
    }
  })
  
  output$distPlot <- renderPlotly({
    ggplotly(
      ggplot(filtered_data(),confirmed  ))) +
        geom_line( aes(date,tooltip = ("text")
    ) 
    
  })
}

shinyApp(ui = ui,server = server)

它现在也没有选择。