Shiny应用中三角形多边形区域点击选择功能异常求助

开发Shiny App实现以下功能：用户选择颜色，对三角形多边形进行分类；点击「Add selection」按钮将选中的三角形与对应颜色存入新数据框，重复操作直至所有三角形完成分类。

当前遇到的问题：点击和刷选功能异常，推测是因为三角形的顶点重叠导致。期望实现点击三角形区域即可选中整个三角形（选中时为三角形边框着色），但当前点击无法精准选中目标三角形，刷选会遗漏边缘区域。

以下是现有代码：

library(shiny)
library(tidyverse)
library(DT)
library(colourpicker)

ui = fluidPage(
  colourInput("col", "Select colour", "purple"),
  actionButton("addToDT", "Add selection", icon = icon("plus")),
  actionButton("plotSelectedButton", "Plot selection", icon = icon("chart-simple"), class = "btn btn-success"), hr(),
  plotOutput("plot", brush = "plot_brush", click = "plot_click", dblclick = "plot_reset"),
  DT::dataTableOutput('plot_DT'), hr(),
  textOutput("clickcoord")
)

server = function(input, output, session) {
  
  df = data.frame(x_axis = c(27.0, 27.0, 27.5, 26.5, 26.5, 27.0, 27.5, 27.5, 28.0, 27.0, 27.0, 26.5, 26.5, 26.5, 26.0, 27.5, 27.5, 27.0, 27.0, 27.0, 27.5, 26.5, 26.5, 27.0, 27.5, 27.5, 28.0, 26.5, 27.0, 27.0, 26.0, 26.5, 26.5, 27.0, 27.5, 27.5, 27.5, 27.5, 27.0, 27.0, 27.0, 26.5, 28.0, 28.0, 27.5, 26.5, 27.0, 26.5, 26.0, 26.5, 26.0, 27.0, 27.5, 27.0),
                  y_axis = c(-2.309401, -1.732051, -2.020726, -3.175426, -2.598076, -2.886751, -3.175426, -2.598076, -2.886751, -1.732051, -2.309401, -2.020726, -2.598076, -3.175426, -2.886751, -2.598076, -3.175426, -2.886751, -1.732051, -1.154701, -1.443376, -2.598076, -2.020726, -2.309401, -2.598076, -2.020726, -2.309401, -1.443376, -1.154701, -1.732051, -2.309401, -2.020726, -2.598076, -2.309401, -2.020726, -2.598076, -1.443376, -2.020726, -1.732051, -2.309401, -2.886751, -2.598076, -2.309401, -2.886751, -2.598076, -1.443376, -1.732051, -2.020726, -2.309401, -2.598076, -2.886751, -2.309401, -2.598076, -2.886751),
                  poly_fill = c(1.483173, 1.483173, 1.483173, 1.471993, 1.471993, 1.471993, 1.172595, 1.172595, 1.172595, 1.323123, 1.323123, 1.323123, 2.072898, 2.072898, 2.072898, 1.524850, 1.524850, 1.524850, 2.299198, 2.299198, 2.299198, 1.712300, 1.712300, 1.712300, 1.249020, 1.249020, 1.249020, 1.175852, 1.175852, 1.175852, 1.161548, 1.161548, 1.161548, 2.253344, 2.253344, 2.253344, 1.669739, 1.669739, 1.669739, 1.260699, 1.260699, 1.260699, 1.463628, 1.463628, 1.463628, 1.212740, 1.212740, 1.212740, 1.791753, 1.791753, 1.791753, 1.483173, 1.483173, 1.483173),
                  poly_id = paste0(paste0("poly_", rep(1:3, each = 3)), ".", rep(c(1,2,3,4,5,6), each = 9)))
  
  selectedPoly = reactiveVal(rep(FALSE, nrow(df)))
  
  output$plot = renderPlot({
    df$sel = selectedPoly()
    
    ggplot(df, 
           aes(x = x_axis, 
               y= y_axis, 
               group = poly_id, 
               fill = poly_fill,
               colour = sel)) + 
      geom_polygon() +
      scale_color_manual(values = c("white", input$col)) + 
      theme_bw()
  })
  
  output$clickcoord <- renderPrint({
    print(input$plot_click)
  })
  
  observeEvent(input$plot_brush, {
    brushed = brushedPoints(df, input$plot_brush, allRows = TRUE)$selected_
    selectedPoly(brushed | selectedPoly())
  })
  
  observeEvent(input$plot_click, {
    clicked = nearPoints(df, input$plot_click, allRows = TRUE)$selected_
    selectedPoly(clicked | selectedPoly())
  })
  
  observeEvent(input$plot_reset, {
    selectedPoly(rep(FALSE, nrow(df)))
  })
  
  output$plot_DT = DT::renderDataTable({
    df$sel = selectedPoly()
    df = filter(df, sel == T)
  })
}

shinyApp(ui, server)

核心思路是基于多边形区域而非单个顶点判断选中状态，原代码的nearPoints和brushedPoints针对数据集中的单个点判断，而三角形顶点重叠会导致判断错误。我们用sf包将每个三角形转换为空间多边形，直接判断点击/刷选区域与多边形的交集，从而选中整个三角形。

修改后的完整代码 #

library(shiny)
library(tidyverse)
library(DT)
library(colourpicker)
library(sf)

ui = fluidPage(
  colourInput("col", "Select colour", "purple"),
  actionButton("addToDT", "Add selection", icon = icon("plus")),
  actionButton("plotSelectedButton", "Plot selection", icon = icon("chart-simple"), class = "btn btn-success"), hr(),
  plotOutput("plot", brush = "plot_brush", click = "plot_click", dblclick = "plot_reset"),
  DT::dataTableOutput('plot_DT'), hr(),
  textOutput("clickcoord"),
  # 新增已分类多边形绘图区域
  plotOutput("plotSelected")
)

server = function(input, output, session) {
  
  # 原始数据
  df = data.frame(x_axis = c(27.0, 27.0, 27.5, 26.5, 26.5, 27.0, 27.5, 27.5, 28.0, 27.0, 27.0, 26.5, 26.5, 26.5, 26.0, 27.5, 27.5, 27.0, 27.0, 27.0, 27.5, 26.5, 26.5, 27.0, 27.5, 27.5, 28.0, 26.5, 27.0, 27.0, 26.0, 26.5, 26.5, 27.0, 27.5, 27.5, 27.5, 27.5, 27.0, 27.0, 27.0, 26.5, 28.0, 28.0, 27.5, 26.5, 27.0, 26.5, 26.0, 26.5, 26.0, 27.0, 27.5, 27.0),
                  y_axis = c(-2.309401, -1.732051, -2.020726, -3.175426, -2.598076, -2.886751, -3.175426, -2.598076, -2.886751, -1.732051, -2.309401, -2.020726, -2.598076, -3.175426, -2.886751, -2.598076, -3.175426, -2.886751, -1.732051, -1.154701, -1.443376, -2.598076, -2.020726, -2.309401, -2.598076, -2.020726, -2.309401, -1.443376, -1.154701, -1.732051, -2.309401, -2.020726, -2.598076, -2.309401, -2.020726, -2.598076, -1.443376, -2.020726, -1.732051, -2.309401, -2.886751, -2.598076, -2.309401, -2.886751, -2.598076, -1.443376, -1.732051, -2.020726, -2.309401, -2.598076, -2.886751, -2.309401, -2.598076, -2.886751),
                  poly_fill = c(1.483173, 1.483173, 1.483173, 1.471993, 1.471993, 1.471993, 1.172595, 1.172595, 1.172595, 1.323123, 1.323123, 1.323123, 2.072898, 2.072898, 2.072898, 1.524850, 1.524850, 1.524850, 2.299198, 2.299198, 2.299198, 1.712300, 1.712300, 1.712300, 1.249020, 1.249020, 1.249020, 1.175852, 1.175852, 1.175852, 1.161548, 1.161548, 1.161548, 2.253344, 2.253344, 2.253344, 1.669739, 1.669739, 1.669739, 1.260699, 1.260699, 1.260699, 1.463628, 1.463628, 1.463628, 1.212740, 1.212740, 1.212740, 1.791753, 1.791753, 1.791753, 1.483173, 1.483173, 1.483173),
                  poly_id = paste0(paste0("poly_", rep(1:3, each = 3)), ".", rep(c(1,2,3,4,5,6), each = 9)))
  
  # 将每个poly_id转换为sf多边形对象
  poly_sf = df %>%
    group_by(poly_id) %>%
    summarise(geometry = st_sfc(st_polygon(list(cbind(x_axis, y_axis)))), .groups = "drop") %>%
    st_as_sf()
  
  # 存储选中的poly_id列表，而非单个点的布尔值
  selected_poly_ids = reactiveVal(character(0))
  
  # 生成绘图用的数据：标记每个点所属的多边形是否被选中
  plot_data = reactive({
    df %>%
      mutate(sel = poly_id %in% selected_poly_ids())
  })
  
  output$plot = renderPlot({
    ggplot(plot_data(), 
           aes(x = x_axis, 
               y= y_axis, 
               group = poly_id, 
               fill = poly_fill,
               colour = sel)) + 
      geom_polygon(linewidth = 1) +  # 加粗边框，选中时更明显
      scale_color_manual(values = c("white", input$col)) + 
      theme_bw()
  })
  
  output$clickcoord <- renderPrint({
    print(input$plot_click)
  })
  
  # 点击事件：判断点击点属于哪个多边形，支持切换选中/取消状态
  observeEvent(input$plot_click, {
    req(input$plot_click)