r - 如何获取鼠标位置像素的颜色？

Question

我在 R 中有一个 Shiny 应用程序，我正在尝试根据在应用程序中通过鼠标单击/悬停选择的颜色来更新它。

我有一组颜色，如果他们单击其中一种颜色，我希望应用程序根据该输入进行更新。为此，我试图从鼠标输入中获取像素的颜色信息。

需要明确的是，我不希望人们手动选择其他方式的颜色选择小部件。

任何指导表示赞赏！

标签： rshiny

Answer 1

这是一种方法：

library(shiny)
library(ggplot2)

js <- '
$(document).ready(function(){
  var canvas = document.createElement("canvas");
  var getPixelColor = setInterval(function(){
    var $img = $("#ggplot>img");
    if($img.length){
      clearInterval(getPixelColor);
      var img = $img[0];
      canvas.width = img.width;
      canvas.height = img.height;
      canvas.getContext("2d").drawImage(img, 0, 0, img.width, img.height);
      $img.on("click", function(e){
        var pixelData = canvas.getContext("2d").
          getImageData(e.offsetX, e.offsetY, 1, 1).data;
        Shiny.setInputValue("color", Array.prototype.slice.call(pixelData));
      })
    }
  }, 100);
})
'

ui <- fluidPage(
  tags$head(
    tags$script(HTML(js))
  ),
  br(),
  fluidRow(
    column(
      width = 9,
      plotOutput("ggplot")
    ),
    column(
      width = 3,
      h3("pixel RGBA:"),
      verbatimTextOutput("pixelRGBA"),
      br(),
      h3("pixel color:"),
      verbatimTextOutput("pixelColor")
    )
  )
)

server <- function(input, output, session){

  output[["ggplot"]] <- renderPlot({
    ggplot(iris) + 
      geom_point(aes(x = Sepal.Length, y = Sepal.Width, colour = Species), 
                 size = 3)
  })

  output[["pixelRGBA"]] <- renderPrint({
    input[["color"]]
  })

  pixelColor <- reactive({
    req(input[["color"]])
    rgba <- input[["color"]]
    rgb(rgba[1], rgba[2], rgba[3], rgba[4], maxColorValue = 255)
  })

  output[["pixelColor"]] <- renderPrint({
    pixelColor()
  })

}

shinyApp(ui, server)