如何开发支持在栅格图像上绘制多个多边形并展示选中像素表格的Shiny应用

Got it, the issue here is that terra::draw() is built for R's base graphics interactive tools, which don’t play nice with Shiny’s browser-based plotting environment. That’s why uncommenting it breaks your app. Let’s fix this by building a custom polygon-drawing workflow using Shiny’s native interactive plot inputs instead.

Here’s a complete working implementation that lets users draw multiple polygons, confirms each one when done, and immediately displays the selected pixels in a table:

library(terra)
library(shiny)
library(sf)

# Load sample raster data
r <- rast(system.file("ex/elev.tif", package = "terra"))

ui <- fluidPage(
  titlePanel("Raster Polygon Selector"),
  sidebarLayout(
    sidebarPanel(
      h4("How to Use"),
      p("1. Click on the map to add polygon vertices"),
      p("2. Click 'Finish Polygon' when you've added all vertices"),
      p("3. Repeat to draw multiple polygons"),
      actionButton("finish_poly", "Finish Polygon"),
      actionButton("clear_all", "Clear All Polygons")
    ),
    mainPanel(
      plotOutput("map", click = "map_click"),
      h4("Selected Pixels"),
      tableOutput("chosen_pixels")
    )
  )
)

server <- function(input, output, session) {
  # Reactive values to track current polygon points and saved polygons
  current_points <- reactiveVal(data.frame(x = numeric(), y = numeric()))
  saved_polygons <- reactiveVal(list())

  # Add new vertex when user clicks the map
  observeEvent(input$map_click, {
    new_point <- data.frame(
      x = input$map_click$x,
      y = input$map_click$y
    )
    current_points(rbind(current_points(), new_point))
  })

  # Finalize current polygon and save it
  observeEvent(input$finish_poly, {
    points_df <- current_points()
    if(nrow(points_df) >= 3) { # Need at least 3 points for a valid polygon
      # Close the polygon by repeating the first point
      points_closed <- rbind(points_df, points_df[1, ])
      # Convert points to a spatial polygon (sf format)
      poly_sf <- st_polygon(list(as.matrix(points_closed))) %>%
        st_sfc(crs = crs(r)) %>%
        st_sf()
      # Add to saved polygons list
      saved_polygons(c(saved_polygons(), list(poly_sf)))
      # Reset current points for a new polygon
      current_points(data.frame(x = numeric(), y = numeric()))
    } else {
      showNotification("Need at least 3 points to create a polygon!", type = "warning")
    }
  })

  # Clear all saved polygons and reset state
  observeEvent(input$clear_all, {
    saved_polygons(list())
    current_points(data.frame(x = numeric(), y = numeric()))
  })

  # Render the map with raster, current vertices, and saved polygons
  output$map <- renderPlot({
    plot(r, main = "Click to add polygon vertices")
    # Draw current polygon's line and vertices
    points_df <- current_points()
    if(nrow(points_df) > 1) {
      lines(points_df$x, points_df$y, col = "blue", lwd = 2)
    }
    if(nrow(points_df) > 0) {
      points(points_df$x, points_df$y, pch = 16, col = "red", cex = 1.2)
    }
    # Draw all saved polygons
    lapply(saved_polygons(), function(poly) {
      plot(poly, add = TRUE, border = "green", lwd = 2)
    })
  })

  # Extract and display pixels inside saved polygons
  output$chosen_pixels <- renderTable({
    if(length(saved_polygons()) == 0) {
      return(data.frame(Message = "No polygons drawn yet"))
    }
    # Combine all saved polygons into one spatial object
    all_polygons <- do.call(rbind, saved_polygons())
    # Extract pixel values, coordinates, and cell IDs
    extracted <- extract(r, all_polygons, cells = TRUE, xy = TRUE)
    # Format into a readable table
    extracted_df <- as.data.frame(extracted)
    colnames(extracted_df) <- c("Polygon_ID", "Cell_Number", "X_Coordinate", "Y_Coordinate", "Elevation")
    extracted_df
  })
}

shinyApp(ui, server)

Key Details Explained: #

• Reactive State: We use reactiveVal to track the current polygon vertices and saved polygons—this ensures Shiny automatically updates outputs when the user interacts with the app.
• Polygon Validation: We check for at least 3 vertices before creating a polygon (a basic requirement for a closed shape).
• Spatial Handling: The sf package converts clicked points into a spatial polygon that works seamlessly with terra functions.
• Pixel Extraction: terra::extract() pulls all pixels inside the polygons, including their coordinates, cell IDs, and elevation values, which we format into a user-friendly table.
• User Feedback: Notifications warn users if they try to create an invalid polygon, and the sidebar gives clear step-by-step instructions.

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