如何从 png 图像的一行获取 xy 坐标并在闪亮的应用程序中使用它

Question

这是此Color an area with a sliderInput in a闪亮应用程序的后续问题

假设我有这个图像：

我如何将@ismirsehregal 的解决方案应用于这张图片。我想我必须把食道的x和y放到代码中，但我不知道如何获取食道的x和y（图中绿色）：

来自在闪亮的应用程序中使用滑块输入对区域进行着色的代码

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)

Answer 1

以下方法不符合您的问题的标题，但它显示了我在上一篇文章中提到的过程。

您需要将修改后的 png 文件（透明食道 - 使用gimp的“模糊选择工具”编辑）保存在您的应用程序www文件夹中才能正常工作（请在下面找到它）。

我现在用来plotlyProxyInvoke更新数据而不重新渲染绘图：

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

slider_min <- 0
slider_max <- 45
lower_slider_value <- 5
upper_slider_value <- 18
x_position_trace_1 <- 40
x_position_trace_2 <- 50

DF <- data.frame(
  x = c(rep(x_position_trace_1, 2), rep(x_position_trace_2, 2)),
  y = rep(c(lower_slider_value, upper_slider_value), 2),
  id = c(rep("trace_1", 2), rep("trace_2", 2))
)

ui <- fluidPage(
  br(),
  column(
    2,
    noUiSliderInput(
      inputId = "noui2",
      label = "Slider vertical:",
      min = slider_min,
      max = slider_max,
      step = 1L,
      value = c(lower_slider_value, upper_slider_value),
      margin = 1,
      orientation = "vertical",
      width = "100px",
      height = "350px"
    )
  ),
  column(4, plotlyOutput("myPlot", height = "800px")),
  verbatimTextOutput(outputId = "res2")
)

server <- function(input, output, session) {
  output$res2 <- renderPrint(input$noui2)
  
  output$myPlot <- renderPlotly({
    fig <- plot_ly(
      DF,
      x = ~ x,
      y = ~ y,
      split = ~ id,
      type = "scatter",
      mode = "lines",
      color = I("white"),
      fillcolor = 'red',
      showlegend = FALSE
    ) |> layout(
      images = list(
        list(
          source =  "/esophagus.png",
          xref = "x",
          yref = "y",
          x = 0,
          y = -16,
          sizex = 93,
          sizey = 93,
          sizing = "stretch",
          opacity = 1,
          layer = "above"
        )
      ),
      plot_bgcolor  = "rgba(0, 0, 0, 0)",
      paper_bgcolor = "rgba(0, 0, 0, 0)",
      xaxis = list(
        zerolinecolor = '#ffff',  
        zerolinewidth = 2,  
        gridcolor = 'ffff',
        range = list(0, 100)),  
      yaxis = list(
        zerolinecolor = '#ffff',  
        zerolinewidth = 2,  
        gridcolor = 'ffff',
        range = list(80, -20)
        # or autorange = "reversed"
        )  
    ) |> style(fill = 'tonexty', traces = 2)
  })
  
  myPlotProxy <- plotlyProxy("myPlot", session)
  
  observe({
    plotlyProxyInvoke(myPlotProxy, "restyle", list(x = list(rep(x_position_trace_1, 2), rep(x_position_trace_2, 2)), y = list(input$noui2, input$noui2)), list(0, 1))
  })
}

shinyApp(ui, server)

文件夹的图像www- 另存为“esophagus.png”。

要可视化透明区域（灰色），请在新的浏览器选项卡（chrome）中打开图像：

编辑：这是另一种不使用 {plotly} 的轻量级方法。

这还没有完全一致，使用 wit 而不是 可能更有意义%，px但它显示了原理：

我们可以简单地为食道图像提供红色背景图像并修改 cssbackground-size属性background-position-y：

library(shiny)
library(shinyjs)
library(shinyWidgets)

ui <- fluidPage(
  useShinyjs(),
  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,
    tags$img(
      id = "esophagus",
      height = 1000,
      width = "100%",
      src = "/esophagus.png",
      style = "background-image: url(red_background.png); background-repeat: no-repeat; background-size: 100% 30%; background-position-y: 40%;"
    )
  ),
  verbatimTextOutput(outputId = "res2")
)

server <- function(input, output, session) {
  output$res2 <- renderPrint(input$noui2)
  
  observeEvent(input$noui2, {
    runjs(paste0('$("#esophagus").css("background-size", "100% ', input$noui2[2] - input$noui2[1], 'px");'))
    runjs(paste0('$("#esophagus").css("background-position-y", "', 1000 - input$noui2[2], 'px");'))
  })
}

shinyApp(ui, server)

在文件夹中另存为“red_background.png” www：