Filter Command Not Working in a Reactive in Shiny

0
votes

I am attempting to create a data frame by filtering a variable from a different data set. The following code works properly:

devtools::install_github("meysubb/cfbscrapR")
library(cfbscrapR)
library(tidyverse)

pretend <- mutate(
    cfb_game_info(2015) %>% rename("game_id" = id) %>% filter(conference_game=="TRUE")
  )

However, when I wrap it into a reactive in Shiny, I get the following error messages:

Warning in min(x) : no non-missing arguments to min; returning Inf

Warning in max(x) : no non-missing arguments to max; returning -Inf

Here is my code in the reactive (note the packages in the previous block of working code):

games <- reactive({
    input$submit
    isolate({
      req(input$year, input$conferencegame)
      if(input$year=="2015" & input$conferencegame=="CONF"){
                  mutate(cfb_game_info(2015) %>% rename("game_id" = id) %>% filter(conference_game=="TRUE"))
      } else if(input$year=="2015" & input$conferencegame=="ALL"){ 
                  mutate(cfb_game_info(2015) %>% rename("game_id" = id))
      } else if(input$year=="2016" & input$conferencegame=="CONF"){
                  mutate(cfb_game_info(2016) %>% rename("game_id" = id) %>% filter(conference_game=="TRUE"))
      } else if(input$year=="2016" & input$conferencegame=="ALL"){
                  mutate(cfb_game_info(2016) %>% rename("game_id" = id))
      } else if(input$year=="2017" & input$conferencegame=="CONF"){
                  mutate(cfb_game_info(2017) %>% rename("game_id" = id) %>% filter(conference_game=="TRUE"))
      } else if(input$year=="2017" & input$conferencegame=="ALL"){
                  mutate(cfb_game_info(2017) %>% rename("game_id" = id))
      } else if(input$year=="2018" & input$conferencegame=="CONF"){
                  mutate(cfb_game_info(2018) %>% rename("game_id" = id) %>% filter(conference_game=="TRUE"))
      } else if(input$year=="2018" & input$conferencegame=="ALL"){
                  mutate(cfb_game_info(2018) %>% rename("game_id" = id))
      } else if(input$year=="2019" & input$conferencegame=="CONF"){
                  mutate(cfb_game_info(2019) %>% rename("game_id" = id) %>% filter(conference_game=="TRUE"))
      } else {mutate(cfb_game_info(2019) %>% rename("game_id" = id))
      }
    })
  })

Also, in case it helps, here is the ui.R section that uses the aforementioned inputs:

ui <- fluidPage(
  sidebarPanel(
    radioButtons("conferencegame", label = h4(
      "Choose All or Only Conference Games"),
      choices = list("All" = "ALL", "Conference" = "CONF")
    ),
    actionButton("submit", "Update"),
    width = 4),
mainPanel(
    selectInput("year", "Choose Year, then Click Update",
                c("2015", "2016", "2017", "2018", "2019"),
                selected = "2019"),
  )
)

As requested, a reproducible example:

devtools::install_github("meysubb/cfbscrapR")
remotes::install_github("rstudio/gt")

#Install and run the Rcpp package if not done

library(tidyverse)
library(cfbscrapR)
library(gt)
library(dplyr)
library(ggplot2)
library(DT)
library(shiny)
library(shinythemes)
library(rsconnect)
library(logger)
library(shinyjs)

######################
#Data
######################
pbp_2019 <- data.frame()
for(i in 1:15){
  data <- cfb_pbp_data(year = 2019, week = i, epa_wpa = TRUE) %>% mutate(week = i)
  df <- data.frame(data)
  pbp_2019 <- bind_rows(pbp_2019, df) %>% mutate(garbage = ifelse(period == 1 & abs(score_diff) > 43, 1, 
                                                                  ifelse(period == 2 & abs(score_diff) > 37, 1,
                                                                         ifelse(period == 3 & abs(score_diff) > 27, 1,
                                                                                ifelse(period == 4 & abs(score_diff) > 22, 1, 0)))))
}

drives_2019 <- data.frame()
for(i in 1:15){
  data <- cfb_pbp_data(year = 2019, week = i, drive = TRUE) %>% mutate(week = i)
  df <- data.frame(data)
  drives_2019 <- bind_rows(drives_2019, df)
}

pbp_2018 <- data.frame()
for(i in 1:15){
  data <- cfb_pbp_data(year = 2018, week = i, epa_wpa = TRUE) %>% mutate(week = i)
  df <- data.frame(data)
  pbp_2018 <- bind_rows(pbp_2018, df) %>% mutate(garbage = ifelse(period == 1 & abs(score_diff) > 43, 1, 
                                                                  ifelse(period == 2 & abs(score_diff) > 37, 1,
                                                                         ifelse(period == 3 & abs(score_diff) > 27, 1,
                                                                                ifelse(period == 4 & abs(score_diff) > 22, 1, 0)))))
}

drives_2018 <- data.frame()
for(i in 1:15){
  data <- cfb_pbp_data(year = 2018, week = i, epa_wpa = TRUE, drive = TRUE ) %>% mutate(week = i)
  df <- data.frame(data)
  drives_2018 <- bind_rows(drives_2018, df)
}

pbp_2017 <- data.frame()
for(i in 1:15){
  data <- cfb_pbp_data(year = 2017, week = i, epa_wpa = TRUE) %>% mutate(week = i)
  df <- data.frame(data)
  pbp_2017 <- bind_rows(pbp_2017, df) %>% mutate(garbage = ifelse(period == 1 & abs(score_diff) > 43, 1, 
                                                                  ifelse(period == 2 & abs(score_diff) > 37, 1,
                                                                         ifelse(period == 3 & abs(score_diff) > 27, 1,
                                                                                ifelse(period == 4 & abs(score_diff) > 22, 1, 0)))))
}

drives_2017 <- data.frame()
for(i in 1:15){
  data <- cfb_pbp_data(year = 2017, week = i, epa_wpa = TRUE, drive = TRUE ) %>% mutate(week = i)
  df <- data.frame(data)
  drives_2017 <- bind_rows(drives_2017, df)
}

#######
#UI
#######
ui <- fluidPage(
  titlePanel(h1("College Football Analytics")),
  sidebarPanel(
    radioButtons("conferencegame", label = h4(
      "Choose All or Only Conference Games"),
      choices = list("All" = "ALL", "Conference" = "CONF")
    ),
    radioButtons("garbagetime", label = h4(
      "Choose to Filter Garbage Time"),
      choices = list("All" = 1,
                     "Remove Garbage Time" = 0),
    ),
    actionButton("submit", "Update"),
    width = 4),
  mainPanel(
    selectInput("year", "Choose Year, then Click Update",
                c("2017", "2018", "2019"),
                selected = "2019")
    ),
  DTOutput(outputId = "example")
  )

########
#Server
########

server <- function(input, output, session) {
  cfb.table2 <- reactive({
    input$submit
    isolate({
      if(input$year=="2017"){
        pbp_2017
      } else if(input$year=="2018"){
        pbp_2018
      } else {
        pbp_2019
      }
    })})
  
  game_numbers <- reactive({cfb.table2() %>% group_by(offense_play, game_id) %>% mutate(num=1) %>% summarise(game.n = mean(num)) %>% ungroup() %>% group_by(offense_play) %>% mutate(game.number = cumsum(game.n)) %>% select(-game.n)})
  
  plays <- reactive({cfb.table2() %>% filter(rush == 1 | pass == 1) %>% left_join(game_numbers(), by=c("game_id","offense_play"))})
  
  offense <- reactive({plays() %>% group_by(offense_play) %>% summarise(ypa = mean(yards_gained[pass==1]), ypr = mean(yards_gained[rush==1]), num.plays = n()) %>% filter(num.plays > 300)})
  offense <- reactive({plays() %>% group_by(offense_play) %>% summarise(epa.pass.off = mean(EPA[pass==1]), success.rate = mean(success), epa.rush.off = mean(EPA[rush==1]), num.plays = n()) %>% filter(num.plays > 300)})
  defense <- reactive({plays() %>% group_by(defense_play) %>% summarise(epa.pass.def = mean(EPA[pass==1]), epa.rush.def = mean(EPA[rush==1]), num.plays = n()) %>% filter(num.plays > 300)})
  update.epa <- reactive({left_join(offense(), defense(), by = c("offense_play" = "defense_play"))})
  plays.garbage <- reactive({plays() %>% mutate(drive_id=as.character(drive_id)) %>% group_by(game_id, drive_id) %>% summarise(garbage = max(garbage))})
  
  drives.table2 <- reactive({
    input$submit
    isolate({
      if(input$year=="2017"){
        drives_2017
      } else if(input$year=="2018"){
        drives_2018
      } else{
        drives_2019
      }
    })
  })  
  
  games <- reactive({
    input$submit
    isolate({
      if(input$year=="2017" & input$conferencegame=="CONF"){
        cfb_game_info(2017) %>% rename("game_id" = id) %>% filter(conference_game=="TRUE")
      } else if(input$year=="2017" & input$conferencegame=="ALL"){
        cfb_game_info(2017) %>% rename("game_id" = id)
      } else if(input$year=="2018" & input$conferencegame=="CONF"){
        cfb_game_info(2018) %>% rename("game_id" = id) %>% filter(conference_game=="TRUE")
      } else if(input$year=="2018" & input$conferencegame=="ALL"){
        cfb_game_info(2018) %>% rename("game_id" = id)
      } else if(input$year=="2019" & input$conferencegame=="CONF"){
        cfb_game_info(2019) %>% rename("game_id" = id) %>% filter(conference_game=="TRUE")
      } else {cfb_game_info(2019) %>% rename("game_id" = id)
      }
    })
  })
  
  drives.off.tmp <- reactive({
    input$submit
    isolate({
      if (input$garbagetime==0) {
        drives.table2() %>% left_join(games(), by = c("game_id")) %>% 
          left_join(plays.garbage(), by = c("game_id", "id"="drive_id")) %>% filter(garbage==0)
      } else {
        drives.table2() %>% left_join(games(), by = c("game_id"))
      }
    })
  })
  
  drives.off <- reactive({drives.off.tmp() %>%
      mutate(
        adj_start_yardline = ifelse(offense == away_team, 100-start_yardline, start_yardline), 
        success = ifelse(drive_result %in% c("TD", "FG"), 1, 0),
        drive.pts = ifelse(drive_result == "TD", 6, ifelse(drive_result == "FG", 3, 0))) %>%
      group_by(offense, offense_conference) %>% 
      summarise(
        fp = mean(adj_start_yardline[adj_start_yardline > 10 & adj_start_yardline <40]), 
        srate = mean(success),
        drives = n(),
        drives.pts = sum(drive.pts))
  })
  
  output$example <- renderDT({
    drives.off()
  })
}
  
#Run the application
shinyApp(ui = ui, server = server)
1
rfiltershiny
Please provide a minimal reproducible example, so please include some example data and a short running app – starja
My apologies, just added the packages needed for the dataset – Edward Egros
Thanks, and please also add a complete server function, not only your games function – starja
Those errors I would expect to come from code trying to draw a plot, but there's no plotting code here. Is there something you've left out? – MrFlick
Just added entire server.R – Edward Egros

1 Answers

0
votes

Below you find a working example. The problem here was that your data.frame contains 2 list columns (away_line_scores and home_line_scores). Apparently, renderTable cannot deal with list columns. Therefore I used DT which coerces the list. Alternatively, you could leave out the two columns (see the comment).

However, your code has some more issues

  • you don't need to wrap mutate around your other commands when creating a new data.frame
  • you can use the input$ variables directly in dplyr, no need for if/else
  • if you want to update an expression based on a button, you should use eventReactive
library(dplyr)
library(shiny)
library(cfbscrapR)
library(DT)

ui <- fluidPage(
  sidebarPanel(
    radioButtons("conferencegame", label = h4(
      "Choose All or Only Conference Games"),
      choices = list("All" = "ALL", "Conference" = "CONF")
    ),
    actionButton("submit", "Update"),
    width = 4),
  mainPanel(
    selectInput("year", "Choose Year, then Click Update",
                c(2015, 2016, 2017, 2018, 2019),
                selected = 2019),
    DTOutput(outputId = "example")
  )
)

server <- function(input, output, session) {
  games <- eventReactive(input$submit, {
    
    pretend <- cfb_game_info(as.numeric(input$year)) %>%
                        rename("game_id" = id)
    if (input$conferencegame == "CONF") {
      pretend <- pretend %>% 
        filter(conference_game == TRUE)
    }
    
    pretend
                      
  })
  
  output$example <- renderDT({
    games() # %>% select(-c(away_line_scores, home_line_scores))
  })
}

shinyApp(ui = ui, server = server)

Edit

The shown solution is for a previously provided code/data example without the complete server function.