R Shiny应用中Boxplot无法显示且无报错的问题排查

我开发了一个R Shiny应用，想要把当前可以正常加载切换的直方图替换成并排箱线图。理想效果是：一个箱线图展示所选图层的全部数据，另一个展示用户选定种群的子集数据；x轴显示“全部数据”和随用户选择动态变化的种群名称，y轴随所选图层动态调整。但无论怎么简化箱线图代码——哪怕只做一个展示全部数据的箱线图——都无法显示，且没有任何报错信息。

完整应用代码 #

ui <- fluidPage(
  titlePanel("Remote sensing products for LCT habitat"),
  
  sidebarLayout(
    sidebarPanel(
      # Dropdown menu to select polygon layer
      selectInput("layer", "Select product:",
                  choices = c("NDVI status" = "Polygon Layer 1",
                              "NDVI trend 1985-2021" ="Polygon Layer 2",
                              "NDVI trend 2017-2021" ="Polygon Layer 3",
                              "NDVI resilience 2017-2021"="Polygon Layer 4"),
                  selected = "NDVI status"),
      # Dropdown menu to select group
      selectInput("Pop_Name", "Select population:",
                  choices = c("Andorno Creek", "Battle Creek",
                              "Colman Creek",
                              "Crowley Creek","Eightmile Creek",
                              "Falls Canyon Creek", "Jackson Creek",
                              "Sage Line and Corral Creeks",
                              "Threemile Creek",
                              "Washburn Creek"),
                  selected = "Andorno Creek"),
      # Panel for distribution plot
      plotOutput("distributionPlot")
    ),
    mainPanel(
      leafletOutput("map"),  # Output to render the leaflet map
      verbatimTextOutput("layerDescription")  # Output to display layer description
    )
  )
)

# Define server logic
server <- function(input, output) {
  
  # Define the descriptions for each layer
  layer_descriptions <- c("Polygon Layer 1" = "NDVI status: this layer reflects the mean near difference vegetation index (NDVI)
 value from August 2020 within a valley bottom
 (floodplain) unit. The lower the value, the less riparian
 vegetation in the valley bottom unit, the higher the value,
 the more riparian vegetation in the valley bottom unit. We are 
using NDVI within the valley bottom as a proxy for floodplain 
connection: the more green, the more likely the active channel is 
connected to the floodplain.",
                          "Polygon Layer 2" = "NDVI trend 1985-2021: this layer reflects the mean Sen's Slope among August near
 difference vegetation index (NDVI)
 from 1985-2021. This shows the relative increase or decrease
 in vegetation greenness over time within the valley bottom
 (floodplain) unit. We are using an increase in greenness as 
 a proxy for an increase in floodplain connection. A decrease
 would indicate a decrease in floodplain connection during 1985-2021.",
                          "Polygon Layer 3" = "NDVI trend 2017-2021: this layer reflects the mean Sen's Slope among August
 near difference vegetation index (NDVI)
 from 1985-2022. This shows the relative increase or decrease
 in vegetation greenness over time within the valley bottom
 (floodplain) unit. We are using an increase in greenness as 
 a proxy for an increase in floodplain connection. A decrease
 would indicate a decrease in floodplain connection during 2017-2021.",
                          "Polygon Layer 4" = "NDVI resilience 2017-2022: this layer reflects the correlation of 
near difference vegetation index (NDVI)
 and the standardized precipitation evapotranspiration index (SPEI; a drought
 index) from 2017-2022. We are using this as a proxy for resilience to drought.
 If the correlation value is low, than the greenness in the valley bottom unit is not
 affected by drought, and therefore, is resilient. If the correlation value is high,
 than the greenness in the valley bottom unit is affected by drought,
and therefore, is less resilient.")
    # Create a function to assign colors based on cutoffs
    assign_colors <- function(data, cutoffs, colors) {
      data$color_group <- cut(data$column, breaks = cutoffs, labels = FALSE)
      data$fillColor <- colors[data$color_group]
      return(data)
    }
    
    # Function to render leaflet map
    output$map <- renderLeaflet({
      # Define cutoffs and corresponding colors for each layer
      
##Layer 1- Mean august NDVI 2019-2022
      cutoffs_layer1 <- c(0,0.3,0.5,0.7)
      colors_layer1 <- c("#d2cdb3", "lightgreen", "darkgreen")
##Layer 2- trend 1985-2021    
      cutoffs_layer2 <- c(-0.0047, -0.0027,-0.0007,0,
                          0.0033,0.0053,0.0073)
      colors_layer2 <- c("#a6611a", "#d4af69", "#ece1c5",
                         "#c6e5e0","#67bfb1","#018571")
##Layer 3- trend 2017-2021
      cutoffs_layer3 <- c(-0.0468010,-0.037,-0.027,
                          0.0,0.002,0.005,0.013)
      colors_layer3 <- c("#a6611a", "#d4af69", "#ece1c5",
                         "#c6e5e0","#67bfb1","#018571")
##Layer 4-resilience  
      cutoffs_layer4 <- c(0,0.3,0.5,0.7,1) 
      colors_layer4 <- c("#b5b645", "#d2cdb3", 
                         "#a4968f","#7a5822")
      

      
      data <- switch(input$layer,
                     "Polygon Layer 1" = ndvi_status,
                     "Polygon Layer 2" = trend_8522,
                     "Polygon Layer 3" = trend_1322,
                     "Polygon Layer 4" = resilience_1322)
      
      # Define breaks and colors for the selected layer
      breaks <- switch(input$layer,
                       "Polygon Layer 1" = cutoffs_layer1,
                       "Polygon Layer 2" = cutoffs_layer2,
                       "Polygon Layer 3" = cutoffs_layer3,
                       "Polygon Layer 4" = cutoffs_layer4)
      colors <- switch(input$layer,
                       "Polygon Layer 1" = colors_layer1,
                       "Polygon Layer 2" = colors_layer2,
                       "Polygon Layer 3" = colors_layer3,
                       "Polygon Layer 4" = colors_layer4)
      label_layer <- switch(input$layer,
             "Polygon Layer 1" = c("0.0-0.3",
                                   "0.3-0.5",
                                   "0.5-0.7"),
  "Polygon Layer 2" = c("Most negative NDVI trend: -0.005 - -0.003",
                        "-0.003 - -0.001",
                        "-0.001 - 0.000",
                        "0.000 - 0.003",
                        "0.003 - 0.005",
                        "Most positive NDVI trend: 0.005 - 0.007"),
  "Polygon Layer 3" = c("Most negative NDVI trend: -0.047 - -0.037",
                        "-0.037 - -0.027",
                        "-0.027 - 0.00",
                        "0.000 - 0.002",
                        "0.002 - 0.005",
                        "Most positive NDVI trend: 0.005 - 0.013"),
             "Polygon Layer 4" = c("Most resilient: 0.0-0.3",
                                   "Resilient: 0.3-0.5",
                                  "Slightly not resilient: 0.5-0.7",
                                   "Not resilient: 0.7-1.0"))
      


      # Render the leaflet map
    leaflet() %>%
      addTiles() %>%  # Add base tiles
      
      ## Add background polygons
      addPolygons(data = PRU,
                  fillOpacity = 0.5,
                  color = "black",
                  weight = 1,
                  popup = ~Pop_Name,
                  fillColor = "yellow") %>%
      
      # Add polygons based on the selected layer
      addPolygons(data = switch(input$layer,
           "Polygon Layer 1" = assign_colors(ndvi_status, cutoffs_layer1, colors_layer1),
           "Polygon Layer 2" = assign_colors(trend_8522, cutoffs_layer2, colors_layer2),
           "Polygon Layer 3" = assign_colors(trend_1322, cutoffs_layer3, colors_layer3),
           "Polygon Layer 4" = assign_colors(resilience_1322, cutoffs_layer4, colors_layer4)),
                  fillOpacity = 0.8,
                  color = "black",
                  weight = 1,
                  popup = ~paste("Value:", column),
                  fillColor = ~fillColor) %>%
      
    
    # Add legend dynamically
    addLegend(position = "bottomright", 
              colors = colors,
              labels = label_layer,
              title = "Legend",
              opacity = 1)
    
  }) 
    
    # Render the layer description based on selected layer
    output$layerDescription <- renderText({
      selected_layer <- input$layer
      layer_descriptions[selected_layer]
    })

    # Render distribution plot based on selected layer
    output$distributionPlot <- renderPlot({
      data <- switch(input$layer,
                     "Polygon Layer 1" = ndvi_status,
                     "Polygon Layer 2" = trend_8522,
                     "Polygon Layer 3" = trend_1322,
                     "Polygon Layer 4" = resilience_1322)

      ggplot(data, aes(x = column)) +
        geom_histogram(aes(fill = ifelse(Pop_Name == input$Pop_Name, "Selected Group", "All Data")),
                       color = "black", bins = 30, alpha = 0.6) +
        labs(title = "Histogram Plot",
             x = "Column Name",
             fill = "Population") +
        theme_minimal() +
        xlim(range(data$column)) +  # Set x-axis limits based on the range of data$column
        scale_fill_manual(values = c("skyblue", "green"),
                          labels = c("All Data", input$Pop_Name))
    })


    
}

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

测试用箱线图代码片段 #

# Render grouped boxplot based on selected layer
output$groupedBoxplot <- renderPlot({
  data <- switch(input$layer,
                 "Polygon Layer 1" = ndvi_status,
                 "Polygon Layer 2" = trend_8522,
                 "Polygon Layer 3" = trend_1322,
                 "Polygon Layer 4" = resilience_1322)
  
  # Create a grouped boxplot
  ggplot(data, aes(x = Pop_Name, y = column, fill = Pop_Name)) +
    geom_boxplot() +
    labs(title = "Grouped Boxplot",
         x = "Pop_Name",
         y = "Value",
         fill = "Pop_Name") +
    theme(axis.text.x = element_text(angle = 45, hjust = 1))
})

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