如何在Shiny中计算图像内绘制多边形的面积？

完整修改后的代码 #

library(shiny)
library(shinydashboard)
library(tibble)
library(imager)
library(purrr)
library(spatstat)
library(tidyr)
library(dplyr)

click_poly <- function(image_path = getwd()){
  # 检查路径有效性
  if(!dir.exists(image_path)){
    stop("指定的图像路径不存在，请提供有效的本地文件夹路径")
  }
  
  app <- shinyApp(
    ui <- dashboardPage(
      skin = 'purple',
      dashboardHeader(title = "ClickMetrics"),
      dashboardSidebar(disable = TRUE),
      dashboardBody(
        fluidRow(
          box(plotOutput("IMG",
                         height = 400,
                         click = "click_plot",
                         hover = "hover_plot")),
          box(selectInput("IMAGE",
                          "选择图像:",
                          choices = list.files(path = image_path,
                                               pattern = "\\.(jpg|jpeg|png)$",
                                               full.names = TRUE,
                                               include.dirs = FALSE),
                          selected = NULL))
        ),
        actionButton("clear", "清空所有多边形"),
        tableOutput("AREA_TABLE"),
        textInput("polygon_name", label = "多边形名称:", value = "多边形1")
      )
    ),
    
    server <- function(input, output, session){
      # 加载图像并存储原始尺寸信息
      img_data <- reactive({
        req(input$IMAGE)
        img <- imager::load.image(input$IMAGE)
        list(
          img = img,
          width = width(img),
          height = height(img)
        )
      })
      
      # 存储多边形的实际像素坐标
      polygons <- reactiveVal(
        value = tibble(
          x = numeric(),
          y = numeric(),
          name = character()
        )
      )
      
      # 绘图区域坐标转图像实际像素坐标
      convert_coords <- function(plot_x, plot_y, plot_dim, img_dim){
        img_width <- img_dim[1]
        img_height <- img_dim[2]
        
        # 计算缩放比例与偏移量，适配图像和绘图区域的比例差异
        plot_aspect <- plot_dim[1]/plot_dim[2]
        img_aspect <- img_width/img_height
        
        if(plot_aspect > img_aspect){
          scale_factor <- plot_dim[2]/img_height
          offset_x <- (plot_dim[1] - img_width*scale_factor)/2
          x <- (plot_x - offset_x)/scale_factor
          y <- plot_dim[2] - (plot_y)/scale_factor # 反转y轴（图像原点在左上角）
        } else {
          scale_factor <- plot_dim[1]/img_width
          offset_y <- (plot_dim[2] - img_height*scale_factor)/2
          x <- plot_x/scale_factor
          y <- plot_dim[2] - (plot_y - offset_y)/scale_factor
        }
        
        # 确保坐标在图像范围内
        x <- pmax(pmin(x, img_width), 0)
        y <- pmax(pmin(y, img_height), 0)
        list(x = x, y = y)
      }
      
      # 处理点击事件，转换坐标后存储
      observeEvent(input$click_plot, {
        req(img_data())
        plot_dim <- c(input$hover_plot$clientWidth, input$hover_plot$clientHeight)
        img_dim <- c(img_data()$width, img_data()$height)
        coords <- convert_coords(input$click_plot$x, input$click_plot$y, plot_dim, img_dim)
        
        polygons() %>%
          add_row(
            x = coords$x,
            y = coords$y,
            name = isolate(input$polygon_name)
          ) %>% polygons()
      })
      
      # 清空按钮：直接重置多边形数据，无需重启会话
      observeEvent(input$clear, {
        polygons(tibble(x = numeric(), y = numeric(), name = character()))
      })
      
      # 绘制图像与多边形
      output$IMG <- renderPlot({
        req(img_data())
        img <- img_data()$img
        par(mar = c(0.5, 0.5, 1.75, 0.5))
        plot(img, axes = FALSE)
        box(col = 'gray')
        mtext(text = basename(input$IMAGE),
              side = 3,
              line = 0.5,
              adj = 0.5,
              cex = 1.23)
        
        # 绘制所有已创建的多边形
        polygons() %>%
          nest(coords = -name) %>%
          deframe() %>%
          map(~polygon(.x$x, .x$y, border = "red", lwd = 2))
      })
      
      # 计算多边形面积与占比
      area_stats <- reactive({
        req(img_data())
        total_pixels <- img_data()$width * img_data()$height
        
        polygons() %>%
          group_by(name) %>%
          filter(n() >= 3) # 过滤无效多边形（少于3个点）
          summarise(
            pixel_area = spatstat::area.polygon(cbind(x, y)),
            area_ratio = pixel_area / total_pixels * 100,
            .groups = "drop"
          ) %>%
          mutate(
            pixel_area = round(pixel_area, 0),
            area_ratio = round(area_ratio, 2)
          ) %>%
          rename(
            多边形名称 = name,
            像素面积 = pixel_area,
            占总面积比例(%) = area_ratio
          )
      })
      
      # 输出面积统计表格
      output$AREA_TABLE <- renderTable({
        if(nrow(polygons()) < 3){
          tibble(提示 = "请绘制至少3个点构成多边形以计算面积")
        } else {
          area_stats()
        }
      })
    }
  )
  runApp(app)
}

关键修改说明 #

1. 路径适配：将默认路径改为当前工作目录getwd()，添加路径有效性检查，移除对未发布包的依赖
2. 坐标转换：解决绘图区域缩放导致的坐标偏差问题，将点击的绘图坐标转换为图像实际像素坐标，同时反转y轴适配图像原点规则
3. 面积计算修复：使用spatstat::area.polygon()计算面积，自动处理坐标顺序问题，避免出现负值；过滤少于3个点的无效多边形
4. 体验优化：清空按钮改为直接重置数据，无需重启会话；表格展示像素面积和占比，替换原始坐标列表；支持多格式图像，显示简化文件名

使用方法 #

1. 调用click_poly("你的图像文件夹路径")启动应用（不填路径则使用当前工作目录）
2. 从下拉菜单选择目标图像
3. 设置多边形名称后，点击图像绘制顶点（至少3个点构成有效多边形）
4. 点击"清空所有多边形"可重置绘图
5. 表格区域自动展示有效多边形的像素面积与占比统计

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