不再工作的闪亮应用程序

Question

我有一个 Shiny 应用程序，其原始版本确实发布到了 shinyapps.io。然后我尝试了同一应用程序的更复杂版本，但它不起作用，所以我尝试返回原始版本，但现在简单版本不再起作用。日志显示：

强制错误（ui）：找不到对象“ui”。

然后，traceback() 给了我这个：

16: execCallbacks(timeoutSecs, all, loop$id)
15: force(expr)
14: with_loop(loop, invisible(execCallbacks(timeoutSecs, all, loop$id)))
13: run_now(timeoutMs/1000, all = FALSE)
12: service(timeout)
11: serviceApp()
10: ..stacktracefloor..(serviceApp())
9: withCallingHandlers(expr, error = doCaptureStack)
8: domain$wrapSync(expr)
7: promises::with_promise_domain(createStackTracePromiseDomain(), 
       expr)
6: captureStackTraces({
       while (!.globals$stopped) {
           ..stacktracefloor..(serviceApp())
       }
   })
5: ..stacktraceoff..(captureStackTraces({
       while (!.globals$stopped) {
           ..stacktracefloor..(serviceApp())
       }
   }))
4: runApp(x)
3: do.call("runApp", args)
2: print.shiny.appobj(x)
1: (function (x, ...) 
   UseMethod("print"))(x)*

代码如下：

ui.R

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

###Now create the ui function

ui <- fluidPage(
  titlePanel(h1("College Football Analytics")),
  sidebarPanel(
    checkboxGroupInput("selections", label = h2(
      "Choose Weeks to Analyze"),
      choices = list("Week 1" = 1, "Week 2" = 2,
                     "Week 3" = 3, "Week 4" = 4,
                     "Week 5" = 5, "Week 6" = 6,
                     "Week 7" = 7, "Week 8" = 8,
                     "Week 9" = 9, "Week 10" = 10,
                     "Week 11" = 11, "Week 12" = 12,
                     "Week 13" = 13, "Week 14" = 14,
                     "Week 15" = 15),
      selected = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11",
                   "12", "13", "14", "15")),
    actionButton("submit", "Update")
  ),
  mainPanel(
    h2("2019 Season"),
    DT::dataTableOutput("table"),
    theme = shinytheme("cerulean")
  )
)

服务器.R

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

pbp_2019 <- read.csv("pbp_2019.csv")
drives_2019 <- read.csv("drives_2019.csv")


#Define server logic
server <- function(input, output, session) {
  cfb.table2 <- reactive({
    input$submit
    isolate({
      req(input$selections)
      new.pbp_2019 <- subset(pbp_2019, week %in% input$selections)})
  })
  plays <- reactive({cfb.table2() %>% filter(rush == 1 | pass == 1)})
  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"))})
  drives.table2 <- reactive({
    input$submit
    isolate({
      req(input$selections)
      new.drives_2019 <- subset(drives_2019, week %in% input$selections)})
  })
  games <- cfb_game_info(2019) %>% rename("game_id" = id)
  drives.off <- reactive({drives.table2() %>% left_join(games, by = c("game_id")) %>%
      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) %>% 
      summarise(
        fp = mean(adj_start_yardline[adj_start_yardline > 10 & adj_start_yardline <40]), 
        srate = mean(success),
        drives = n(),
        drives.pts = sum(drive.pts))
  })
  drive.update.epa <- reactive({left_join(update.epa(), drives.off(), by=c("offense_play"="offense")) %>%
      mutate(pts.per.drive = drives.pts / drives)})
  cfb.table3 <- reactive({data.frame(drive.update.epa() %>% 
                                       select(offense_play, success.rate, epa.pass.off, epa.rush.off, epa.pass.def, epa.rush.def, fp, drives, pts.per.drive) %>% gt() %>%
                                       tab_header(title = "2019 Season"))})
  output$table = DT::renderDataTable({
    datatable(cfb.table3(),
              rownames = FALSE, 
              class = 'cell-border stripe',
              colnames = c('Team', 'Success Rate',
                           'Pass EPA', 'Run EPA',
                           'Pass EPA Def.',
                           'Run EPA Def.',
                           'Avg. Field Position',
                           'Drives',
                           'Points Per Drive'),
              list(pageLength = 25)) %>%
      formatPercentage(c('success.rate'),1) %>%
      formatRound(c('epa.pass.off'),3) %>%
      formatRound(c('epa.rush.off'),3) %>%
      formatRound(c('epa.pass.def'),3) %>%
      formatRound(c('epa.rush.def'),3) %>%
      formatRound(c('fp'),1) %>%
      formatRound(c('pts.per.drive'),3)
  })
}

app.R

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

# load ui elements
source("ui.R")
# load server function
source("server.R")

# Run the application 
shinyApp(ui = ui, server = server)

不管怎样，我在控制台中收到了新消息： summarise() 取消分组输出（用 .groups 参数覆盖） summarise() 取消分组输出（用 .groups 参数覆盖） summarise() 取消分组输出（用 .groups 参数覆盖）

谢谢。

Answer 1

通过将文件合并到 app.R 而不是拆分 ui.R 和 server.R，应用能够发布。

https://insidesportsanalytics.shinyapps.io/CollegeFootballScrapR/