过滤器命令在 Shiny 中无法响应

Question

我试图通过过滤来自不同数据集的变量来创建数据框。 以下代码正常工作：

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

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

但是，当我将它包装到 Shiny 中的反应式中时，我收到以下错误消息：

min(x) 中的警告：没有非缺失 arguments 到 min； 返回 Inf

最大值（x）中的警告：没有非缺失 arguments 到最大值； 返回 -Inf

这是我在响应式中的代码（注意上一个工作代码块中的包）：

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

此外，如果有帮助，这里是使用上述输入的 ui.R 部分：

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"),
  )
)

根据要求，一个可重现的例子：

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)

Answer 1

您可以在下面找到一个工作示例。 这里的问题是您的 data.frame 包含 2 个列表列（ away_line_scores和home_line_scores ）。 显然， renderTable不能处理列表列。 因此我使用了强制列表的DT 。 或者，您可以省略这两列（请参阅评论）。

但是，您的代码还有一些问题

• 创建新的 data.frame 时，您不需要将mutate包裹在其他命令周围
• 您可以直接在dplyr中使用input$变量，不需要if/else
• 如果要根据按钮更新表达式，则应使用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)

编辑

所示解决方案适用于先前提供的代码/数据示例，没有完整的服务器 function。