CODEWITHSUNDEEP
rshiny
Canovice
Canovice

Reputation: 10163

Reactive Coding In R Shiny - what is causing these split-second error messages?

Below is a demo of the code used in my shiny app - it has all of the important elements to my full app, and most importantly, my issue is reproduced.

An important part of my shiny app is that certain widgets appear only when another widget is set to a certain value. In this case, the shotchart.input is the main widget, and then the playerseason.input and teamgame.input widgets appear only if the shotchart.input is set to a specific value. In my UI, I pass these 2nd and 3rd widgets in the uiOutput() functions.

In my Server, I have renderUI functions for each of these two widgets as well. The dropdown options for these widgets depends on a certain filtering of my main dataframe (not in my example here, but in my main app they do), so it's important that I create these widgets in the Server.

My issue is as follows - when I launch the app, for a split second there is a 'non-character argument' error. Then, when I change the value of the first widget to Shot Marker Graph (team-game), I get another split second error, this time "Result must have length 20, not 0".

I think this is because, inside of my renderPlotly() function, I have lines of code like this: 

fname <- strsplit(input$player.id, split = ' ')[[1]][1]

and for the other widget

this.t2 <- input$team.id
all.pbp <- all.pbp %>% filter(team == this.t2)

which rely on the reactive input parameters input$player.id and input$team.id. My thought is that these input parameters need ~1 second to get a value, hence these errors occur quickly when launching the app and toggling the main widget.

These errors look bad from a user experience perspective, and more importantly, make me think that I'm not using renderUI and uiOutput correctly here. Any thoughts on how to get rid of these split second error messages / better coding practice would be greatly appreciated. Thanks!

App below: 

# Pre-Processing 
all.pbp <- structure(list(team = c("BOS", "CLE", "BOS", "CLE", "BOS", "BOS", 
                                   "CLE", "CLE", "BOS", "CLE", "BOS", "CLE", "BOS", "CLE", "BOS", 
                                   "BOS", "CLE", "BOS", "BOS", "BOS"), lastname = c("Irving", "Rose", 
                                        "Hayward", "Love", "Tatum", "Horford", "Crowder", "Wade", "Brown", 
                                        "Rose", "Hayward", "Rose", "Irving", "Wade", "Irving", "Brown", 
                                        "Crowder", "Horford", "Brown", "Brown"), firstname = c("Kyrie", 
                                               "Derrick", "Gordon", "Kevin", "Jayson", "Al", "Jae", "Dwyane", 
                                               "Jaylen", "Derrick", "Gordon", "Derrick", "Kyrie", "Dwyane", 
                                               "Kyrie", "Jaylen", "Jae", "Al", "Jaylen", "Jaylen"), yloc = c(789L, 
                                                     55L, 751L, 134L, 866L, 699L, 107L, 86L, 883L, 62L, 798L, 296L, 
                                                     858L, 66L, 768L, 873L, 309L, 667L, 748L, 876L), xloc = c(251L, 
                                                          232L, 464L, 119L, 240L, 203L, 467L, 133L, 261L, 245L, 259L, 346L, 
                                                          257L, 398L, 141L, 248L, 197L, 133L, 468L, 255L)), .Names = c("team", 
                                                         "lastname", "firstname", "yloc", "xloc"), class = "data.frame", row.names = c(NA, 20L))

shotchart.types <- c('Shot Marker Graph (Player-Season)', 'Shot Marker Graph (Team-Game)')
names(shotchart.types) <- shotchart.types

# The UI
ui <- fluidPage(fluidRow(
                  column(width = 3, align = 'center',
                         h3('Chart Type'), hr(),

                         # create permanent input for shot chart type (should be 5 options)
                         selectInput(inputId = 'shotchart.input', label = 'Select Shot Chart Type:', multiple = FALSE,
                                     choices = shotchart.types, selected = 'Shot Marker Graph (Player-Season)'),

                         uiOutput('playerseason.input'),
                         uiOutput('teamgame.input')
                         ),

                  # 2.C Launch the Chart
                  # ===-===-===-===-===-===
                  column(width = 8, align = 'left',
                         plotlyOutput("shotplot")
                  )
                )
)


# The Server
server <- shinyServer(function(input, output) {

  # 3.A widgets whose appearance is conditional on another widget value
  # ===-===-===-===-===-===-===-===-===-===-===-===-===-===-===-===-===-===
  # select player for player-season graph
  output$playerseason.input <- renderUI({
    if(input$shotchart.input == 'Shot Marker Graph (Player-Season)') {

      all.players <- unique(paste(all.pbp$firstname, all.pbp$lastname))
      names(all.players) <- all.players

      selectInput(inputId = 'player.id', label = 'Select Player:', multiple = FALSE,
                  choices = all.players, selected = 'Kyrie Irving')
    } else{
      return(NULL)
    }
  })

  # select team for team-game graph
  output$teamgame.input <- renderUI({
    if(input$shotchart.input == 'Shot Marker Graph (Team-Game)') {

      all.teams <- unique(all.pbp$team)
      names(all.teams) <- all.teams

      selectInput(inputId = 'team.id', label = 'Select Team:', multiple = FALSE,
                  choices = all.teams, selected = 'BOS')

    } else{
      return(NULL)
    }
  })

  # 3.B The Plot
  # ===-===-===-===
  output$shotplot <- renderPlotly({

    # first plot, based on chart type widget
    if(input$shotchart.input == 'Shot Marker Graph (Player-Season)') {

      fname <- strsplit(input$player.id, split = ' ')[[1]][1]
      lname <- strsplit(input$player.id, split = ' ')[[1]][2]
      all.pbp <- all.pbp %>% filter(firstname == fname, lastname == lname)
      print(fname);
      print(lname);
      print(all.pbp);

      plot_ly(all.pbp) %>%
        add_trace(x = ~xloc, y = ~yloc, type = 'scatter', mode = 'markers')
    }

    # second plot, also based on chart type widget
    else if(input$shotchart.input == 'Shot Marker Graph (Team-Game)') {

      this.t2 <- input$team.id
      all.pbp <- all.pbp %>% filter(team == this.t2)      

      plot_ly(all.pbp) %>%
        add_trace(x = ~xloc, y = ~yloc, type = 'scatter', mode = 'markers')
    }

  })
})

shinyApp(ui, server)

Upvotes: 3

Views: 453

Answers (1)

Bertil Baron
Bertil Baron

Reputation: 5003

Hi these problem is comming from the dynamic rendering of the input fields. They are not initiated the first time the plot is calculated. But as soon as the are initiated the plot is recalculated and everything works fine.

Shiny has the function req just for this purpose here you can test if a variable is truthy i.e has a value. if not the calculations are canceled with a silent warning. Here is how it would work in your case. i just added the req() in two places and it works fine.

server <- shinyServer(function(input, output) {

  # 3.A widgets whose appearance is conditional on another widget value
  # ===-===-===-===-===-===-===-===-===-===-===-===-===-===-===-===-===-===
  # select player for player-season graph
  output$playerseason.input <- renderUI({
    if(input$shotchart.input == 'Shot Marker Graph (Player-Season)') {

      all.players <- unique(paste(all.pbp$firstname, all.pbp$lastname))
      names(all.players) <- all.players

      selectInput(inputId = 'player.id', label = 'Select Player:', multiple = FALSE,
                  choices = all.players, selected = 'Kyrie Irving')
    } else{
      return(NULL)
    }
  })

  # select team for team-game graph
  output$teamgame.input <- renderUI({
    if(input$shotchart.input == 'Shot Marker Graph (Team-Game)') {

      all.teams <- unique(all.pbp$team)
      names(all.teams) <- all.teams

      selectInput(inputId = 'team.id', label = 'Select Team:', multiple = FALSE,
                  choices = all.teams, selected = 'BOS')

    } else{
      return(NULL)
    }
  })

  # 3.B The Plot
  # ===-===-===-===
  output$shotplot <- renderPlotly({

    # first plot, based on chart type widget
    if(input$shotchart.input == 'Shot Marker Graph (Player-Season)') {
      req(input$player.id)
      fname <- strsplit(input$player.id, split = ' ')[[1]][1]
      lname <- strsplit(input$player.id, split = ' ')[[1]][2]
      all.pbp <- all.pbp %>% filter(firstname == fname, lastname == lname)
      print(fname);
      print(lname);
      print(all.pbp);

      plot_ly(all.pbp) %>%
        add_trace(x = ~xloc, y = ~yloc, type = 'scatter', mode = 'markers')
    }

    # second plot, also based on chart type widget
    else if(input$shotchart.input == 'Shot Marker Graph (Team-Game)') {
      req(input$team.id)

      this.t2 <- input$team.id
      all.pbp <- all.pbp %>% filter(team == this.t2)      

      plot_ly(all.pbp) %>%
        add_trace(x = ~xloc, y = ~yloc, type = 'scatter', mode = 'markers')
    }

  })
})

Upvotes: 2

Related Questions