UI 中未选择任何内容时出现反应性 ggplot 工具提示错误，

Question

我有这个使用工具提示的反应式 ggplot 闪亮示例，问题是当没有选择任何东西时，我得到了这个错误 > Error : Aesthetics must be either length 1 or the same as the data (1): x, y, colour, label and group 当我在没有绘图和工具提示的情况下尝试这段代码时，它工作正常。知道如何在 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, 1L, 2L, 2L, 2L, 3L, 3L, 3L), .Label = c("Alabama", "Alaska", "Arizona"), class = "factor"), 
                         date = structure(c(18283, 18284, 18285, 18283, 18284, 18285,18283, 18284, 18285), class = "Date"), 
                         confirmed = c(5L,10L, 7L, 20L, 4L, 1L, 3L, 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", "Select Regions:", 
                     
                     choices = c("Alabama", "Alaska", "Arizona"),
                      selected = "Alabama",
                     multiple = TRUE),
         
      )),
    mainPanel(
      
      
      
      plotOutput("distPlot"),
   
    ))
)

server <- function(input, output) {
  
  data <- structure(list(Region = structure(c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L), .Label = c("Alabama", "Alaska", "Arizona"), class = "factor"), 
                         date = structure(c(18283, 18284, 18285, 18283, 18284, 18285,18283, 18284, 18285), class = "Date"), 
                         confirmed = c(5L,10L, 7L, 20L, 4L, 1L, 3L, 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 <- renderPlot({
    ggplot(filtered_data(), aes(x = date, y = confirmed, label = Region, color = Region, group = Region)) +
      geom_line( aes(date, confirmed, 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

添加了截图错误

Answer 1

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

我重新整理了你的代码。



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

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

server <- function(input, output) {
  
  data <- structure(list(Region = structure(c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L), .Label = c("Alabama", "Alaska", "Arizona"), class = "factor"), 
                         date = structure(c(18283, 18284, 18285, 18283, 18284, 18285,18283, 18284, 18285), class = "Date"), 
                         confirmed = c(5L,10L, 7L, 20L, 4L, 1L, 3L, 40L, 8L)), row.names = c(NA, -9L), 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(), 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)

它现在也没有选择。

Answer 2

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

server <- function(input, output) {
  
  data <- structure(list(Region = structure(c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L), .Label = c("Alabama", "Alaska", "Arizona"), class = "factor"), 
                         date = structure(c(18283, 18284, 18285, 18283, 18284, 18285,18283, 18284, 18285), class = "Date"), 
                         confirmed = c(5L,10L, 7L, 20L, 4L, 1L, 3L, 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)

UI 中未选择任何内容时出现反应性 ggplot 工具提示错误，

reactive ggplot tooltip error when nothing in UI selected,

r

ggplot2

shiny

shiny-server

ggplotly