Shiny应用本地运行正常，部署时启动失败求助

AI 小北

2026-8-6

问题：Shiny应用本地运行正常，但部署失败

应用在本地计算机上运行完全正常，但无法完成部署。部署时输出如下红色警告信息：

`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  :
  pseudoinverse used at 11.985
Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  :
  neighborhood radius 1.015
Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  :
  reciprocal condition number  1.4432e-29
Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  :
  There are other near singularities as well. 1
Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x else if (is.data.frame(newdata)) as.matrix(model.frame(delete.response(terms(object)),  :
  pseudoinverse used at 11.985
Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x else if (is.data.frame(newdata)) as.matrix(model.frame(delete.response(terms(object)),  :
  neighborhood radius 1.015
Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x else if (is.data.frame(newdata)) as.matrix(model.frame(delete.response(terms(object)),  :
  reciprocal condition number  1.4432e-29
Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x else if (is.data.frame(newdata)) as.matrix(model.frame(delete.response(terms(object)),  :
  There are other near singularities as well. 1
`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

完整代码

library(ggplot2)
library(shiny)
library(shinydashboard)
library(tidyverse)
library(readr)
library(naniar)
library(rmarkdown)

# Data import
wages <- read.csv("http://murraylax.org/datasets/wage2.csv")

# Data preprocessing
na_strings <- c(".", "NA", "N A", "N / A", "N/A", "N/ A", "Not Available", "NOt available")
wages <- wages %>% replace_with_na_all(condition = ~.x %in% na_strings)
wages = as.data.frame(sapply(wages, as.numeric))

# Multi-variate choices
AttributeChoices=c("MonthlyEarnings","AveWeeklyHours","IQ","Knowledge","YearsEdu",
                   "Tenure","Age","Married", "Black", "South", "Urban",
                   "NumSiblings", "BirthOrder", "MomEdu", "DadEdu")


server <- function(input, output) {
  
  output$plot1 <- renderPlot({
    dat <- wages[1:input$myslider1,]
    ggplot(dat, aes(MonthlyEarnings)) + geom_histogram(fill="gold4")
  })
  
  
  output$plot2 <- renderPlot({
    dat <- wages[1:input$myslider1,]
    ggplot(dat, aes(IQ)) + geom_histogram(fill="cadetblue")
  })
  
  output$plot3 <- renderPlot({
    dat <- wages[1:input$myslider1,]
    ggplot(dat, aes(YearsEdu)) + geom_histogram(fill="darkgray", binwidth = 1)
  })
  
  output$plot4 <- renderPlot({
    dat <- wages[1:input$myslider1,]
    ggplot(dat, aes(YearsExperience)) + geom_histogram(fill="forestgreen", binwidth = 1)
  })
  
  
  output$myPlot1 <- 
    renderPlot({
      dat <- 
        wages |>
        filter(YearsEdu >= input$range1[1], 
               YearsEdu <= input$range1[2]) 
      
      ggplot(dat, aes(YearsEdu, MonthlyEarnings)) + geom_point(position="jitter") + stat_smooth()
    })
  
  
  output$myPlot2 <- 
    renderPlot({
      dat <- 
        wages |>
        filter(IQ >= input$range2[1], 
               IQ <= input$range2[2]) 
      
      ggplot(dat, aes(IQ, MonthlyEarnings)) + geom_point(position="jitter") + stat_smooth()
    })    
  
  
  output$myPlot3 <- 
    renderPlot({
      dat <- 
        wages |>
        filter(YearsExperience >= input$range3[1], 
               YearsExperience <= input$range3[2]) 
      
      ggplot(dat, aes(YearsExperience, MonthlyEarnings)) + geom_point(position="jitter") + stat_smooth()
    }) 
  
  
  
  output$indep <- renderUI({
    selectInput(inputId = "indep", label = "Independent Variables", 
                multiple = TRUE, choices = as.list(AttributeChoices[AttributeChoices!= input$dependent]), selected = AttributeChoices[1])
  })
  
  recipe_formula <- reactive({
    req(input$indep)
    wages %>%
      recipe() %>%
      update_role(!!!input$dependent, new_role = "outcome") %>%
      update_role(!!!input$indep, new_role = "predictor") %>%
      prep() %>% 
      formula()
  })
  
  lm_reg <- reactive(
    lm(recipe_formula(),data = wages)
  )
  
  output$RegOut = renderPrint({
    summary(lm_reg())
  })
  
  output$tableDT <- DT::renderDataTable(wages,
                                        options = list(paging=F),
                                        rownames=F,
                                        filter = "top")
  output$table <- DT::renderDataTable(DT::datatable(cust()))
  
}



ui <- dashboardPage(
  dashboardHeader(title = "Analysis of Income"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Histogram", tabName = "histogram", icon = icon("calendar")),
      menuItem("Range control", tabName = "control", icon = icon("dashboard")),
      menuItem("Regression", tabName = "regression", icon = icon("th")),
      menuItem("Dataset", tabName = "dtset", icon = icon("table"))
    )
  ),
  dashboardBody(
    tabItems(
      # First tab content
      tabItem(tabName = "histogram",
              h1("Variables affecting monthly earnings: data from 1980 for 935 individuals"),
              fluidRow(
                box(plotOutput("plot1", height = 250)),
                box(plotOutput("plot2", height = 250)),
                box(plotOutput("plot3", height = 250)),
                box(plotOutput("plot4", height = 250)),
                
                box(
                  title = "Controls",
                  sliderInput("myslider1", "Sample Size:", 1, 935, 400)
                )
              )
      ),
      
      # Second tab content
      tabItem(tabName = "control",
              h1("Set the range of predictors about Monthly Earnings"),
              fluidRow(
                sliderInput(inputId = "range1", 
                            label = h2("YearsEdu Vs. Earning"), 
                            min = 9,
                            max = 18,
                            value = c(12, 15)),
                
                plotOutput(outputId = "myPlot1", height = 250),
                
                sliderInput(inputId = "range2", 
                            label = h2("IQ Vs. Earning"), 
                            min = 50,
                            max = 150,
                            value = c(80, 120)),
                
                plotOutput(outputId = "myPlot2", height = 250),
                
                
                sliderInput(inputId = "range3", 
                            label = h2("YearsExperience Vs. Earning"), 
                            min = 1,
                            max = 23,
                            value = c(8, 15)),
                
                plotOutput(outputId = "myPlot3", height = 250)
              )
      ),
      
      # third tab content
      tabItem(tabName = "regression",
              h1("Choose your dependent and indenpendent variables for regression"),
              selectInput(inputId="dependent", label = "Dependent Variables",
                          choices = as.list(AttributeChoices)),
              uiOutput("indep"),
              verbatimTextOutput(outputId = "RegOut")
      ), 
      
      # fourth tab content
      tabItem(tabName = "dtset",
              h1("Original dataset"),
                DT::dataTableOutput("tableDT"))
              )
      
    )
  )



shinyApp(ui, server)

问题根源与修复方案

1. 致命错误：未定义函数`cust()`

代码中output$table <- DT::renderDataTable(DT::datatable(cust()))调用了未定义的cust()函数，本地运行时若未触发该输出则不会报错，但部署时会执行所有代码逻辑，导致部署失败。直接删除该行无效代码即可解决核心部署问题。

2. 解决`stat_bin()`警告

geom_histogram未指定binwidth时，ggplot默认使用bins=30并抛出警告，手动设置合理的binwidth参数消除警告：

plot1修改：ggplot(dat, aes(MonthlyEarnings)) + geom_histogram(fill="gold4", binwidth=50)
plot2修改：ggplot(dat, aes(IQ)) + geom_histogram(fill="cadetblue", binwidth=5)

3. 解决loess拟合奇异值警告

当滑块选择的数据范围过窄时，loess拟合会因数据稀疏出现奇异值问题，可通过以下两种方式解决：

改用线性回归拟合：将stat_smooth()改为stat_smooth(method="lm")，稳定性更强
调整loess参数：设置span参数增强拟合鲁棒性，比如stat_smooth(span=0.75)

4. 代码优化与一致性修复

数据类型转换改用tidyverse风格：wages <- wages %>% mutate(across(everything(), as.numeric))，避免sapply带来的潜在类型问题

变量列表补全：AttributeChoices中缺失YearsExperience，将其加入列表，避免后续变量选择逻辑出错：

AttributeChoices=c("MonthlyEarnings","AveWeeklyHours","IQ","Knowledge","YearsEdu",
                   "Tenure","Age","Married", "Black", "South", "Urban",
                   "NumSiblings", "BirthOrder", "MomEdu", "DadEdu", "YearsExperience")

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

Shiny应用本地运行正常，部署时启动失败求助

完整代码 #

问题根源与修复方案 #

1. 致命错误：未定义函数cust() #

2. 解决stat_bin()警告 #

3. 解决loess拟合奇异值警告 #