Search code examples
rshinyplotlyr-plotly

plotly graph in shinyapp isn't reactive to input


I'm trying to set up a shinyapp with a plotly linegraph that is reactive to the input. I am using plot_ly for the graph and my ideal graph would have as many lines as are selected in the checkboxGroupInput. My problem is that the graph isn't reacting to the input, it's plotting either all of the choices or won't plot more than one but I can't figure out to code it the way I want. It has worked with ggplot, but I have to use plotly for other reasons, so I would like to stick with that. I have tried to filter my data or to make a reactive variable ->col(), but that didn't work. Another problem is that the sliderInput with the date-variable doesn't work (or the graph isn't reacting accordingly).

If you have any suggestions or tipps, I would be really thankful!

Here is my code so far:

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)

with this code I get the Error message : "Warning: Error in : Tibble columns must have compatible sizes" if I select more than one choice.


Solution

  • 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)