shiny部署错误如何解决

Question

shiny部署错误如何解决
2024-09-09T04:33:29.730144+00:00 shinyapps[12644774]: Container event from container-10122526: start
2024-09-09T04:33:30.725961+00:00 shinyapps[12644774]: Running on host: 17971c66a07e
2024-09-09T04:33:30.730492+00:00 shinyapps[12644774]: Running as user: uid=10001(shiny) gid=10001(shiny) groups=10001(shiny)
2024-09-09T04:33:30.734782+00:00 shinyapps[12644774]: Connect version: 2024.05.0
2024-09-09T04:33:30.738901+00:00 shinyapps[12644774]: LANG: C.UTF-8
2024-09-09T04:33:30.742820+00:00 shinyapps[12644774]: Working directory: /srv/connect/apps/1_year_survival
2024-09-09T04:33:30.746867+00:00 shinyapps[12644774]: Using R 4.4.1
2024-09-09T04:33:30.751626+00:00 shinyapps[12644774]: R.home(): /opt/R/4.4.1/lib/R
2024-09-09T04:33:30.756944+00:00 shinyapps[12644774]: Content will use current R environment
2024-09-09T04:33:30.760988+00:00 shinyapps[12644774]: R_LIBS: (unset)
2024-09-09T04:33:30.764996+00:00 shinyapps[12644774]: .libPaths(): /usr/lib/R, /opt/R/4.4.1/lib/R/library
2024-09-09T04:33:30.769354+00:00 shinyapps[12644774]: shiny version: 1.8.1.1
2024-09-09T04:33:30.773797+00:00 shinyapps[12644774]: httpuv version: 1.6.15
2024-09-09T04:33:30.778107+00:00 shinyapps[12644774]: rmarkdown version: 2.27
2024-09-09T04:33:30.782458+00:00 shinyapps[12644774]: knitr version: 1.48
2024-09-09T04:33:30.786704+00:00 shinyapps[12644774]: jsonlite version: 1.8.8
2024-09-09T04:33:30.791092+00:00 shinyapps[12644774]: RJSONIO version: (none)
2024-09-09T04:33:30.795290+00:00 shinyapps[12644774]: htmltools version: 0.5.8.1
2024-09-09T04:33:30.799958+00:00 shinyapps[12644774]: reticulate version: (none)
2024-09-09T04:33:30.803974+00:00 shinyapps[12644774]: Using pandoc: /opt/connect/ext/pandoc/2.16
2024-09-09T04:33:30.808537+00:00 shinyapps[12644774]:
2024-09-09T04:33:30.812823+00:00 shinyapps[12644774]: Starting R with process ID: '31'
2024-09-09T04:33:30.816767+00:00 shinyapps[12644774]: Shiny application starting ...
2024-09-09T04:33:31.726768+00:00 shinyapps[12644774]:
2024-09-09T04:33:31.731345+00:00 shinyapps[12644774]: Attaching package: ‘DT’
2024-09-09T04:33:31.735997+00:00 shinyapps[12644774]:
2024-09-09T04:33:31.740182+00:00 shinyapps[12644774]: The following objects are masked from ‘package:shiny’:
2024-09-09T04:33:31.744387+00:00 shinyapps[12644774]:
2024-09-09T04:33:31.748711+00:00 shinyapps[12644774]: dataTableOutput, renderDataTable
2024-09-09T04:33:31.753053+00:00 shinyapps[12644774]:
2024-09-09T04:33:31.757730+00:00 shinyapps[12644774]:
2024-09-09T04:33:31.762043+00:00 shinyapps[12644774]: Attaching package: ‘shinydashboard’
2024-09-09T04:33:31.766360+00:00 shinyapps[12644774]:
2024-09-09T04:33:31.770719+00:00 shinyapps[12644774]: The following object is masked from ‘package:graphics’:
2024-09-09T04:33:31.775757+00:00 shinyapps[12644774]:
2024-09-09T04:33:31.779847+00:00 shinyapps[12644774]: box
2024-09-09T04:33:31.783773+00:00 shinyapps[12644774]:
2024-09-09T04:33:35.726751+00:00 shinyapps[12644774]: Error in func(fname, ...) : app.R did not return a shiny.appobj object.
2024-09-09T04:33:35.730970+00:00 shinyapps[12644774]: Calls: local ... tryCatch -> tryCatchList -> tryCatchOne ->
2024-09-09T04:33:35.735261+00:00 shinyapps[12644774]: Execution halted
2024-09-09T04:33:35.739650+00:00 shinyapps[12644774]: Shiny application exiting ...
2024-09-09T04:48:50.726107+00:00 shinyapps[12644774]: Container event from container-10122526: stop
代码如下

test_data <- read.table("data/test1.txt", header = TRUE, sep = "\t", check.names = FALSE, row.names = 1)
train_data <- read.table("data/train1.txt", header = TRUE, sep = "\t", check.names = FALSE, row.names = 1)

# Convert columns to factors with appropriate levels
test_data$Months_from_diagnosis_to_therapy <- factor(test_data$Months_from_diagnosis_to_therapy, 
                                                     levels = c("0_month",">=_1month","Unknown"))
test_data$Histologic_type <- factor(test_data$Histologic_type, 
                                    levels = c("Adenocarcinoma","intestinal type","Signet ring cell carcinoma","Other"))
test_data$Median_household_income <- factor(test_data$Median_household_income, 
                                            levels = c("<60,000$","60,000$_69,999$" ,"70,000$_79,999$","80,000$_89,999$","90,000$_99,999$","100,000$+"))
test_data$T_stage <- factor(test_data$T_stage, levels = c("T1","T2" ,"T3","T4"))
test_data$N_stage <- factor(test_data$N_stage, levels = c("N0","N1" ,"N2","N3"))
test_data$Age <- factor(test_data$Age, levels = c("<60","60-69" ,"70-79","80+"))
test_data$Marital_status <- factor(test_data$Marital_status, levels = c("Married","Single" ,"Other"))
test_data$Grade <- factor(test_data$Grade, levels = c("I-II","III-IV" ,"Unknown"))
test_data$Surgery <- factor(test_data$Surgery, levels = c("Yes","No/Unknown"))
test_data$Chemotherapy <- factor(test_data$Chemotherapy, levels = c("Yes","No/Unknown"))
test_data$Bone_metastasis <- factor(test_data$Bone_metastasis, levels = c("Yes","No/Unknown"))
test_data$Lung_metastasis <- factor(test_data$Lung_metastasis, levels = c("Yes","No/Unknown"))

# Repeat for train_data
train_data$Months_from_diagnosis_to_therapy <- factor(train_data$Months_from_diagnosis_to_therapy, 
                                                      levels = c("0_month",">=_1month","Unknown"))
train_data$Histologic_type <- factor(train_data$Histologic_type, 
                                     levels = c("Adenocarcinoma","intestinal type","Signet ring cell carcinoma","Other"))
train_data$Median_household_income <- factor(train_data$Median_household_income, 
                                             levels = c("<60,000$","60,000$_69,999$" ,"70,000$_79,999$","80,000$_89,999$","90,000$_99,999$","100,000$+"))
train_data$T_stage <- factor(train_data$T_stage, levels = c("T1","T2" ,"T3","T4"))
train_data$N_stage <- factor(train_data$N_stage, levels = c("N0","N1" ,"N2","N3"))
train_data$Age <- factor(train_data$Age, levels = c("<60","60-69" ,"70-79","80+"))
train_data$Marital_status <- factor(train_data$Marital_status, levels = c("Married","Single" ,"Other"))
train_data$Grade <- factor(train_data$Grade, levels = c("I-II","III-IV" ,"Unknown"))
train_data$Surgery <- factor(train_data$Surgery, levels = c("Yes","No/Unknown"))
train_data$Chemotherapy <- factor(train_data$Chemotherapy, levels = c("Yes","No/Unknown"))
train_data$Bone_metastasis <- factor(train_data$Bone_metastasis, levels = c("Yes","No/Unknown"))
train_data$Lung_metastasis <- factor(train_data$Lung_metastasis, levels = c("Yes","No/Unknown"))

# Define factor columns
factor_cols <- c("Age", "Median_household_income", "Grade", "Marital_status", 
                 "Histologic_type", "T_stage", "N_stage", "Surgery", 
                 "Chemotherapy", "Months_from_diagnosis_to_therapy", 
                 "Bone_metastasis", "Lung_metastasis")

# Convert the factor columns to numeric for train data
train_data[factor_cols] <- lapply(train_data[factor_cols], as.numeric)

# Prepare data for xgboost
dtrain <- xgb.DMatrix(data = as.matrix(train_data[, factor_cols]), label = train_data$status)

# Train XGBoost model
params <- list(
  objective = "binary:logistic",
  max_depth = 3, 
  eta = 0.7, 
  gamma = 0, 
  colsample_bytree = 0.4, 
  min_child_weight = 5, 
  subsample = 0.8
)
set.seed(123)
modelx <- xgb.train(params = params, data = dtrain, nrounds = 50)

# Shiny App UI
ui <- fluidPage(
  titlePanel("1-year Survival of GCLM Patients Prediction Using XGBoost Model"),
  sidebarLayout(
    sidebarPanel(
      selectInput("Age", "Age:", choices = c("<60", "60-69", "70-79", "80+")),
      selectInput("Marital_status", "Marital_status:", choices = c("Single", "Married", "Other")),
      selectInput("Grade", "Grade:", choices = c("I-II", "III-IV", "Unknown")),
      selectInput("Histologic_type", "Histologic_type:", choices = c("Adenocarcinoma", "intestinal type", "Signet ring cell carcinoma", "Other")),
      selectInput("T_stage", "T Stage:", choices = c("T1", "T2", "T3", "T4")),
      selectInput("N_stage", "N Stage:", choices = c("N0", "N1", "N2", "N3")),
      selectInput("Surgery", "Surgery:", choices = c("Yes", "No/Unknown")),
      selectInput("Chemotherapy", "Chemotherapy:", choices = c("Yes", "No/Unknown")),
      selectInput("Bone_metastasis", "Bone Metastasis:", choices = c("Yes", "No/Unknown")),
      selectInput("Lung_metastasis", "Lung Metastasis:", choices = c("Yes", "No/Unknown")),
      selectInput("Months_from_diagnosis_to_therapy", "Months from Diagnosis to Therapy:", choices = c("0_month", ">=_1month", "Unknown")),
      selectInput("Median_household_income", "Median_household_income:", choices = c("<60,000$", "60,000$_69,999$", "70,000$_79,999$", "80,000$_89,999$", "90,000$_99,999$", "100,000$+")),
      actionButton("predict", "Predict")
    ),
    mainPanel(
      tabBox(
        title = "Data management", height = "500px", width = NULL, 
        tabPanel("Dataview", h4("Baseline Data"),
                 dataTableOutput("data1"), # Display input data
                 htmlOutput("prediction_text") # Updated to htmlOutput
        )
      )
    )
  )
)

# Server logic
server <- function(input, output) {
  # Reactive data frame based on user input, triggered by the Predict button
  datax <- eventReactive(input$predict, {
    data.frame(
      Age = input$Age,
      Marital_status = input$Marital_status,
      Grade = input$Grade,
      Histologic_type = input$Histologic_type,
      T_stage = input$T_stage,
      N_stage = input$N_stage,
      Surgery = input$Surgery,
      Chemotherapy = input$Chemotherapy,
      Bone_metastasis = input$Bone_metastasis,
      Lung_metastasis = input$Lung_metastasis,
      Months_from_diagnosis_to_therapy = input$Months_from_diagnosis_to_therapy,
      Median_household_income = input$Median_household_income
    )
  })
  
  # Output input data to a table (show original categorical values), only updates when Predict is clicked
  output$data1 <- renderDataTable({
    datatable(datax(), options = list(pageLength = 10))
  })
  
  # Perform prediction on button click
  prediction <- eventReactive(input$predict, {
    # Convert categorical values to numeric for prediction
    new_data <- data.frame(
      Age = as.numeric(factor(input$Age, levels = c("<60", "60-69", "70-79", "80+"))),
      Marital_status = as.numeric(factor(input$Marital_status, levels = c("Single", "Married", "Other"))),
      Grade = as.numeric(factor(input$Grade, levels = c("I-II", "III-IV", "Unknown"))),
      Histologic_type = as.numeric(factor(input$Histologic_type, levels = c("Adenocarcinoma", "intestinal type", "Signet ring cell carcinoma", "Other"))),
      T_stage = as.numeric(factor(input$T_stage, levels = c("T1", "T2", "T3", "T4"))),
      N_stage = as.numeric(factor(input$N_stage, levels = c("N0", "N1", "N2", "N3"))),
      Surgery = as.numeric(factor(input$Surgery, levels = c("Yes", "No/Unknown"))),
      Chemotherapy = as.numeric(factor(input$Chemotherapy, levels = c("Yes", "No/Unknown"))),
      Bone_metastasis = as.numeric(factor(input$Bone_metastasis, levels = c("Yes", "No/Unknown"))),
      Lung_metastasis = as.numeric(factor(input$Lung_metastasis, levels = c("Yes", "No/Unknown"))),
      Months_from_diagnosis_to_therapy = as.numeric(factor(input$Months_from_diagnosis_to_therapy, levels = c("0_month", ">=_1month", "Unknown"))),
      Median_household_income = as.numeric(factor(input$Median_household_income, levels = c("<60,000$", "60,000$_69,999$", "70,000$_79,999$", "80,000$_89,999$", "90,000$_99,999$", "100,000$+")))
    )
    
    new_data_matrix <- xgb.DMatrix(data = as.matrix(new_data[, factor_cols]))
    prob <- predict(modelx, newdata = new_data_matrix)
    prob
  })
  
  # Display survival probability and status
  output$prediction_text <- renderUI({
    survival_probability <- round(prediction(), 4)
    status <- ifelse(survival_probability > 0.5, "Alive", "Dead")
    HTML(paste0(
      "<div style='font-size: 20px;'><b>Survival probability is: ", survival_probability, "</b></div>",
      "<div style='font-size: 20px;'><b>Status is: ", status, "</b></div>"
    ))
  })
}

# Run the Shiny app
shinyApp(ui = ui, server = server)
rsconnect::setAccountInfo(name='',
                          token='',
                          secret='')