如何提取PNG图像中食管线条的XY坐标并在Shiny App中应用

这是《使用SliderInput在Shiny App中着色区域》的后续问题。现有含绿色食管线条的PNG图像：

我希望应用@ismirsehregal提供的解决方案，但不知道如何提取该图像中食管线条的XY坐标，参考代码如下：

library(shiny)
library(plotly)
library(shinyWidgets)

DF <- data.frame(
    x = c(cos(seq(0.01, 10, 0.01)) * 1000:1 + 1000, cos(seq(0.01, 10, 0.01)) * 1000:1 + 1500),
    y = rep(1:1000, 2),
    id = c(rep("trace_1", 1000), rep("trace_2", 1000))
  )

ui <- fluidPage(
  br(),
  column(
    2,
    noUiSliderInput(
      inputId = "noui2",
      label = "Slider vertical:",
      min = 0,
      max = 1000,
      step = 50,
      value = c(100, 400),
      margin = 100,
      orientation = "vertical",
      direction = c("rtl"),
      width = "100px",
      height = "350px"
    )
  ),
  column(4, plotlyOutput("plot")),
  verbatimTextOutput(outputId = "res2")
)

server <- function(input, output, session) {
  output$res2 <- renderPrint(input$noui2)
  
  plotDF <- reactive({
    plotDF <- DF[DF$y %in% input$noui2[1]:input$noui2[2], ]
    plotDF$id <- paste0("filtered_", plotDF$id)
    plotDF
  })
  
  output$plot <- renderPlotly({
    fig <- plot_ly(
        rbind(DF, plotDF()),
        x = ~ x,
        y = ~ y,
        split = ~ id,
        type = "scatter",
        mode = "lines",
        color = I("black"),
        fillcolor = 'red',
        showlegend = FALSE
      ) |> style(fill = 'tonexty', traces = 2)
  })
}

shinyApp(ui, server)

解决方案 #

1. 提取图像中绿色线条的XY坐标

使用magick包读取图像并筛选绿色像素，提取坐标：

library(magick)
library(dplyr)

# 读取图像
img <- image_read("https://i.sstatic.net/g1fcg.png")
# 转换为像素数据框并筛选绿色像素（根据实际图像调整RGB阈值）
img_pixels <- as.data.frame(img, wide = TRUE) %>%
  filter(red < 60, green > 190, blue < 60) %>%
  select(x, y)

# 调整Y轴方向（图像坐标系Y轴向下，Shiny绘图通常向上，需翻转）
img_pixels$y <- max(img_pixels$y) - img_pixels$y + 1

2. 适配参考代码的数据格式

如果绿色线条是食管的单侧边界，你需要生成对应的另一侧边界数据（比如基于中心线偏移）；如果图像中本身有左右两条绿色线，直接将像素分组为trace_1和trace_2，替换原代码中的DF数据框即可。

例如，若提取的像素是左右两条线，可按X值排序后拆分：

# 假设左边界X较小，右边界X较大
left_trace <- img_pixels %>% filter(x < median(x)) %>% mutate(id = "trace_1")
right_trace <- img_pixels %>% filter(x >= median(x)) %>% mutate(id = "trace_2")
DF <- rbind(left_trace, right_trace)

替换后即可复用原Shiny代码的滑块着色逻辑。

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