Plotly 图表未随着日期 slider 输入 r Z531704A02607A16646EFCF4C1FAEEE1 更新

Question

I'm not getting any error message, so I'm kind of stuck here. Everything seems to be working fine, but when I move the slider widget in the app, the dates don't update on the plotly graph. Something tells me I'm missing something in my ggplot (related to xlim?) but everything I try breaks the app. I've attached the code below, as well as a sample of my dataset.

rm(list=ls())

#Libraries
library(shiny)
library(shinyWidgets)
library(ggplot2)
library(dplyr)
library(readxl)
library(scales)
library(ggthemes)
library (plotly)
library(shinythemes)

#Load Data
data<-read_excel("C:/Users/Kanew/OneDrive/Desktop/RApp/Unemployment2.xlsx")
data$Date<-as.Date(data$Date)


ui<-fluidPage(
    
    theme = shinytheme("cerulean"),
    
    tabsetPanel(
        
        tabPanel("Welcome",
                 
                 HTML(paste(
                     
                     h1("Welcome!"),
                     
                     p("Welcome to the Unemployment Exploration Application. In this application you will find tabs,
                            located at the top of your screen, for data visualization and data table exploration."), '<br/>',
                     
                     p("The data visualization tab includes functionality to visualize the unemployment rate by various 
                            racial/ethnic categories of your choice. The graph includes functions for magnification, panning, 
                            and observing individual data points at your choice (by hovering over data points)."), '<br/>',
                     
                     p(" The data table tab is a searchable data table that allows you to search the dataset and download the 
                             dataset if you'd like."),'<br/>',
                     
                     p("Enjoy!")))),
        
        
        tabPanel("Data Visualization",
                 
                sidebarLayout(
                    sidebarPanel(
                        sliderInput(inputId = "Date",
                                    label = "Dates:",
                                    min = as.Date("2010-01-01", "%Y-%m-%d"),
                                    max = as.Date("2021-02-01","%Y-%m-%d"),
                                    value = as.Date("2010-01-01"), timeFormat = "%Y-%m-%d",
                                    step = 1, animate = animationOptions(interval = 1800))),
                    
                mainPanel(h1("National Unemployment Rate by Racial/Ethnic Category"),
                           plotlyOutput("plot", height = 'auto', width = 'auto'),
                              
                              
                            selectInput(
                                inputId = "Category",
                                label = "Select Race or National Rate",
                                choices = c("All",unique(data$Category)),
                                selected = "All")))),

        
        tabPanel("Data Table",
                 
                 h1("Data Table"),
                 
                 DT::dataTableOutput("data"))
        
        
    ))

server<-function(input, output){
    
    output$plot <- renderPlotly({
        data %>%
            filter(Category == input$Category | input$Category == "All" | Date == input$Date) %>%
            ggplot(data, mapping = aes(x=Date, y = Rate, colour = Category)) +
            geom_line() + 
            xlab("Year") + ylab("Unemployment Rate (%)") +
            scale_y_continuous(breaks=c(0, 2, 4, 6, 8, 10, 12, 14, 16, 18))+
            scale_x_date(date_breaks = "years" , date_labels = "%Y")+
            theme(axis.text.x = element_text(angle = 45, hjust = 1))+
            theme_economist() +
            scale_fill_economist()})
    
    
    output$data <- DT::renderDataTable({DT::datatable(data)})
    
    
}

shinyApp(ui = ui, server = server)

> head(data)
# A tibble: 6 x 3
  Date       Category  Rate
  <date>     <chr>    <dbl>
1 2010-01-01 National   9.8
2 2010-02-01 National   9.8
3 2010-03-01 National   9.9
4 2010-04-01 National   9.9
5 2010-05-01 National   9.6
6 2010-06-01 National   9.4
> head(data, 20)
# A tibble: 20 x 3
   Date       Category  Rate
   <date>     <chr>    <dbl>
 1 2010-01-01 National   9.8
 2 2010-02-01 National   9.8
 3 2010-03-01 National   9.9
 4 2010-04-01 National   9.9
 5 2010-05-01 National   9.6
 6 2010-06-01 National   9.4
 7 2010-07-01 National   9.4
 8 2010-08-01 National   9.5
 9 2010-09-01 National   9.5
10 2010-10-01 National   9.4
11 2010-11-01 National   9.8
12 2010-12-01 National   9.3
13 2011-01-01 National   9.1
14 2011-02-01 National   9  
15 2011-03-01 National   9  
16 2011-04-01 National   9.1
17 2011-05-01 National   9  
18 2011-06-01 National   9.1
19 2011-07-01 National   9  
20 2011-08-01 National   9  

Updated code per ismirsehregal's solution:

rm(list=ls())

#Libraries
library(shiny)
library(shinyWidgets)
library(ggplot2)
library(dplyr)
library(readxl)
library(scales)
library(ggthemes)
library (plotly)
library(shinythemes)

#Load Data
data<-read_excel("C:/Users/Kanew/OneDrive/Desktop/RApp/Unemployment2.xlsx")
uniqueCats <- unique(data$Category)
data$Date <- as.Date(data$Date)



ui<-fluidPage(
    
    theme = shinytheme("cerulean"),
    
    tabsetPanel(
        
        tabPanel("Welcome",
                 
                 HTML(paste(
                     
                     h1("Welcome!"),
                     
                     p("Welcome to the Unemployment Exploration Application. In this application you will find tabs,
                            located at the top of your screen, for data visualization and data table exploration."), '<br/>',
                     
                     p("The data visualization tab includes functionality to visualize the unemployment rate by various 
                            racial/ethnic categories of your choice. The graph includes functions for magnification, panning, 
                            and observing individual data points at your choice (by hovering over data points)."), '<br/>',
                     
                     p(" The data table tab is a searchable data table that allows you to search the dataset and download the 
                             dataset if you'd like."),'<br/>',
                     
                     p("Enjoy!")))),
        
        
        tabPanel("Data Visualization",
                 
                 sidebarLayout(
                     sidebarPanel(
                         sliderInput(inputId = "Date",
                                     label = "Dates:",
                                     min = min(data$Date),
                                     max = max(data$Date),
                                     value = min(data$Date),
                                     timeFormat = "%Y-%m-%d",
                                     step = 1,
                                     animate = animationOptions(interval = 300))),
                     
                     mainPanel(h1("National Unemployment Rate by Racial/Ethnic Category"),
                               plotlyOutput("plot", height = 'auto', width = 'auto'),
                               
                               
                               selectInput(
                                   inputId = "Category",
                                   label = "Select Race or National Rate",
                                   choices = c("All", unique(data$Category)),
                                   selected = "All")))),
        
        
        tabPanel("Data Table",
                 
                 h1("Data Table"),
                 
                 DT::dataTableOutput("myDataTable"))
        
        
    ))

server<-function(input, output){
    
    output$plot <- renderPlotly({
        
        if(input$Category == "All"){
            catFilter<-uniqueCats
        } else{
            catFilter<-input$Category
        }
        
        filteredData <- filter(data, Category %in% catFilter & Date <= input$Date)
        req(nrow(filteredData) > 0)
        
        myGGPlot <- ggplot(filteredData, mapping = aes(x = Date, y = Rate, colour = Category),
                        geom_line() +
                        geom_point() +
                        xlab("Year") + ylab("Unemployment Rate (%)") +
                        scale_y_continuous(breaks=c(0, 2, 4, 6, 8, 10, 12, 14, 16, 18))+
                        scale_x_date(date_breaks = "years" , date_labels = "%Y")+
                        theme(axis.text.x = element_text(angle = 45, hjust = 1))+
                        theme_economist()+
                        scale_fill_economist(),
                        
                        ggplotly(myGGPlot))
                        
                        })
        
    
    
    output$myDataTable <- DT::renderDataTable({
        DT::datatable(data)
        })
    
    
}

shinyApp(ui = ui, server = server)

Answer 1

There are a few things going wrong in your above code.

First of all renderPlotly expects a plotly-object. Accordingly you need ggplotly to convert your ggplot to a plotly object.

Furthermore, your filter statements were faulty.

Please check the following:

#Libraries
library(shiny)
library(shinyWidgets)
library(ggplot2)
library(dplyr)
# library(readxl)
library(scales)
library(ggthemes)
library(plotly)
library(shinythemes)

#Load Data
# myData <- read_excel("C:/Users/Kanew/OneDrive/Desktop/RApp/Unemployment2.xlsx")
myData <- data.frame(
  stringsAsFactors = FALSE,
  Date = c("2010-01-01","2010-02-01",
           "2010-03-01","2010-04-01","2010-05-01","2010-06-01",
           "2010-07-01","2010-08-01","2010-09-01","2010-10-01",
           "2010-11-01","2010-12-01","2011-01-01","2011-02-01",
           "2011-03-01","2011-04-01","2011-05-01","2011-06-01",
           "2011-07-01","2011-08-01"),
  Category = c("National","National",
               "National","National","TestCategory","National","National",
               "National","National","National","National","National",
               "National","National","TestCategory","National","National",
               "National","TestCategory","National"),
  Rate = c(9.8,9.8,9.9,9.9,9.6,9.4,
           9.4,9.5,9.5,9.4,9.8,9.3,9.1,9,9,9.1,9,9.1,9,9)
)
uniqueCats <- unique(myData$Category)
myData$Date <- as.Date(myData$Date)

ui <- fluidPage(theme = shinytheme("cerulean"),
                tabsetPanel(
                  tabPanel("Welcome",
                           HTML(
                             paste(
                               h1("Welcome!"),
                               p(
                                 "Welcome to the Unemployment Exploration Application. In this application you will find tabs,
                            located at the top of your screen, for data visualization and data table exploration."
                               ),
                               '<br/>',
                               p(
                                 "The data visualization tab includes functionality to visualize the unemployment rate by various
                            racial/ethnic categories of your choice. The graph includes functions for magnification, panning,
                            and observing individual data points at your choice (by hovering over data points)."
                               ),
                               '<br/>',
                               p(
                                 " The data table tab is a searchable data table that allows you to search the dataset and download the
                             dataset if you'd like."
                               ),
                               '<br/>',
                               p("Enjoy!")
                             )
                           )),
                  tabPanel(
                    "Data Visualization",
                    sidebarLayout(
                      sidebarPanel(
                        sliderInput(
                          inputId = "Date",
                          label = "Dates:",
                          min = min(myData$Date),
                          max = max(myData$Date),
                          value = min(myData$Date),
                          timeFormat = "%Y-%m-%d",
                          step = 1,
                          animate = animationOptions(interval = 300)
                        )
                      ),
                      mainPanel(
                        h1("National Unemployment Rate by Racial/Ethnic Category"),
                        plotlyOutput("plot"), # , height = 'auto', width = 'auto'
                        selectInput(
                          inputId = "Category",
                          label = "Select Race or National Rate",
                          choices = c("All", unique(myData$Category)),
                          selected = "All"
                        )
                      )
                    )
                  ),
                  tabPanel("Data Table",
                           h1("Data Table"),
                           DT::dataTableOutput("myDataTable"))
                ))

server <- function(input, output) {
  output$plot <- renderPlotly({
    
    if(input$Category == "All"){
      catFilter <- uniqueCats
    } else {
      catFilter <- input$Category
    }

    filteredData <- filter(myData, Category %in% catFilter & Date <= input$Date)
    req(nrow(filteredData) > 0)
    
    myGGPlot <- ggplot(filteredData, mapping = aes(x = Date, y = Rate, colour = Category)) +
      geom_line() +
      geom_point() +
      xlab("Year") + ylab("Unemployment Rate (%)") +
      scale_y_continuous(breaks = c(0, 2, 4, 6, 8, 10, 12, 14, 16, 18)) +
      scale_x_date(date_breaks = "years" , date_labels = "%Y") +
      theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
      theme_economist() +
      scale_fill_economist()
    
      ggplotly(myGGPlot)
  })
  
  output$myDataTable <- DT::renderDataTable({
    DT::datatable(data)
  })
}

shinyApp(ui = ui, server = server)