本地运行正常的ShinyApp部署到shinyapps.io后无法显示

我开发了一款从数据库获取NBA统计数据并生成散点图的Shiny应用，本地运行正常，但部署到shinyapps.io后，图表和表格均无法显示。该应用依赖GitHub上的两个包：nbastatR（通过devtools::install_github("abresler/nbastatR")安装）和nbaplotR（通过if (!require("pak")) install.packages("pak") pak::pak("mrcaseb/nbaplotR")安装），推测shinyapps.io服务器未正确安装这些包。

shinyapps.io默认仅从CRAN安装包，GitHub上的第三方包需要额外配置才能在部署时正确安装，以下是几种可行的解决方式：

方式1：用renv锁定环境（推荐） #

renv可以精确复刻本地包环境，避免版本不一致问题：

• 本地运行renv::init()初始化环境
• 运行renv::snapshot()保存当前所有包的版本信息
• 将生成的renv.lock文件和renv/文件夹（排除renv/library/目录）与app.R一同上传到shinyapps.io

方式2：在app.R中添加GitHub包安装逻辑 #

如果不想用renv，可以在代码开头添加判断逻辑，让服务器自动安装缺失的GitHub包：

# 安装nbastatR
if (!require("nbastatR")) {
  if (!require("devtools")) install.packages("devtools")
  devtools::install_github("abresler/nbastatR")
}
# 安装nbaplotR
if (!require("nbaplotR")) {
  if (!require("pak")) install.packages("pak")
  pak::pak("mrcaseb/nbaplotR")
}

注意：首次部署时安装包需要一定时间，若出现超时问题，优先选择renv方式。

方式3：优化数据加载逻辑 #

将数据加载放在reactive函数中，并添加错误捕获，避免应用启动时因数据加载失败直接崩溃：

team_stats_df <- reactive({
  Sys.setenv(VROOM_CONNECTION_SIZE=500072)
  tryCatch({
    team_stats_general <- unique(nbastatR::teams_players_stats(seasons = 2023, types = "team", tables = "general"))
    df <- as.data.frame(team_stats_general[[7]])
    
    Names_abbrev <- valid_team_names()
    Names_abbrev[2] <- Names_abbrev[3]
    Names_abbrev[3] <- "BKN"
    Names_abbrev[26] <- "SAC"
    Names_abbrev[27] <- "SA"
    
    df$Name_abbreviation <- Names_abbrev
    df$Name_abbreviation <- as.factor(df$Name_abbreviation)
    df[,c(10, 12:ncol(df))]
  }, error = function(e) {
    showNotification(paste("数据加载失败:", e$message), type = "error")
    return(NULL)
  })
})

# 安装依赖包
if (!require("nbastatR")) {
  if (!require("devtools")) install.packages("devtools")
  devtools::install_github("abresler/nbastatR")
}
if (!require("nbaplotR")) {
  if (!require("pak")) install.packages("pak")
  pak::pak("mrcaseb/nbaplotR")
}

library(shiny)
library(ggplot2)
library(nbastatR)
library(tidyverse)
library(nbaplotR)
library(nbapalettes)
library(forcats)
library(ggpubr)
library(DT)
library(ggpath)
library(scales) # 补充scales包，支持百分比格式转换

ui <- fluidPage(
  titlePanel("NBA team stats"),
  sidebarLayout(
    sidebarPanel(
      selectInput("x", "X-axis stat", 
                  choices = c("gp", "pctWins", "fgm", "fga", "pctFG", 
                              "fg3m", "fg3a", "pctFG3", "pctFT", 
                              "gpRank", "pctWinsRank", "minutesRank", "fgmRank",          
                              "fgaRank", "pctFGRank", "fg3mRank", "fg3aRank",         
                              "pctFG3Rank", "pctFTRank", "fg2m", "fg2a",            
                              "pctFG2", "wins", "losses", "minutes", "ftm",
                              "fta", "oreb", "dreb", "treb", "ast", "tov", "stl",            
                              "blk", "blka", "pf", "pfd", "pts", "plusminus",
                              "winsRank", "lossesRank", "rankFTM", "rankFTA", 
                              "orebRank", "drebRank", "trebRank", "astRank",
                              "tovRank", "stlRank", "blkRank", "blkaRank", "pfRank", 
                              "pfdRank", "ptsRank", "plusminusRank",  "Name_abbreviation"),
                  selected = "fgm", 
                  multiple = FALSE
      ),
      selectInput("y", "Y-axis stat", 
                  choices = c("gp", "pctWins", "fgm", "fga", "pctFG", 
                              "fg3m", "fg3a", "pctFG3", "pctFT", 
                              "gpRank", "pctWinsRank", "minutesRank", "fgmRank",          
                              "fgaRank", "pctFGRank", "fg3mRank", "fg3aRank",         
                              "pctFG3Rank", "pctFTRank", "fg2m", "fg2a",            
                              "pctFG2", "wins", "losses", "minutes", "ftm",
                              "fta", "oreb", "dreb", "treb", "ast", "tov", "stl",            
                              "blk", "blka", "pf", "pfd", "pts", "plusminus",
                              "winsRank", "lossesRank", "rankFTM", "rankFTA", 
                              "orebRank", "drebRank", "trebRank", "astRank",
                              "tovRank", "stlRank", "blkRank", "blkaRank", "pfRank", 
                              "pfdRank", "ptsRank", "plusminusRank"), 
                  selected = "pctFG", 
                  multiple = FALSE
      ),
    ),
    mainPanel(
      plotOutput("logoscatter"),
      DT::DTOutput("Table")
    )
  )
)

server <- function(input, output) {
  
  team_stats_df <- reactive({
    Sys.setenv(VROOM_CONNECTION_SIZE=500072)
    tryCatch({
      team_stats_general <- unique(nbastatR::teams_players_stats(seasons = 2023, types = "team", tables = "general"))
      df <- as.data.frame(team_stats_general[[7]])
      
      Names_abbrev <- valid_team_names()
      Names_abbrev[2] <- Names_abbrev[3]
      Names_abbrev[3] <- "BKN"
      Names_abbrev[26] <- "SAC"
      Names_abbrev[27] <- "SA"
      
      df$Name_abbreviation <- Names_abbrev
      df$Name_abbreviation <- as.factor(df$Name_abbreviation)
      df[,c(10, 12:ncol(df))]
    }, error = function(e) {
      showNotification(paste("数据加载失败:", e$message), type = "error")
      return(NULL)
    })
  })
  
  output$logoscatter <- renderPlot({
    req(input$x, input$y, team_stats_df())
    
    plot_scale_x <- if (input$x %in% c("pctWins", "pctFG", "pctFG3", "pctFT", "pctFG2")){
      scale_x_continuous(labels = scales::percent_format(accuracy = 1))
    }else{
      scale_x_continuous()
    }
    
    plot_scale_y <- if (input$y %in% c("pctWins", "pctFG", "pctFG3", "pctFT", "pctFG2")){
      scale_y_continuous(labels = scales::percent_format(accuracy = 1))
    }else{
      scale_y_continuous()
    }
    
    p1 <- ggplot(data = team_stats_df())+
      geom_smooth(aes_string(x = input$x, y = input$y), 
                  method = "lm", se = F, color = "black", linetype = "dashed")+
      geom_nba_logos(aes_string(x = input$x, y = input$y, team_abbr = "Name_abbreviation"), 
                     width = 0.075, height = 0.075)+
      stat_cor(aes_string(x = input$x, y = input$y, label="..rr.label.."),
               label.x.npc = 0.85, label.y.npc = 0.02, size = 6)+
      plot_scale_x+
      plot_scale_y+
      ylab(input$y)+
      xlab(input$x)+
      theme_bw()+
      theme(text = element_text(size = 18))
    
    p1
  })
  
  output$Table <- renderDT({
    req(team_stats_df())
    team_stats_df()
  })
}

shinyApp(ui = ui, server = server)

内容的提问来源于stack exchange，提问作者ZT_Geo