r - 如何“徒手”绘制 Shiny 的形状？

Question

是否有功能或其他方法可以在Shiny中使用鼠标启用徒手绘制（即绘制随机形状/尺寸）？

具体来说，我希望能够通过以各种（但非均匀）方式进行标记来与renderPlot中的图进行“交互”。 -换句话说，我希望能够标记已经存在的图形。

我发现的功能缺点包括：


绘制点，线，矩形或圆形的工具对我来说不够灵活。
工具并不总是与click_plot交互类型的设置兼容。

Answer 1

这是使用shinyjs和Signature Pad的想法，使演示适用于“绘制图像”。


将signature_pad.js的副本保存在应用目录的“ wwww”子目录中（如果尚未创建，则需要创建此文件夹）。 This subdirectory is a special folder。我使用了最新版本的Signature Pad 1.5.3。
使用以下代码创建一个CSS文件，并将其放置在主应用目录中。
页面加载时，使用shinyjs运行JavaScript函数。了解有关使用shinyjs::extendShinyjs here的信息。从小插图中注意到，应安装软件包V8。


的CSS

.signature-pad {
  position: absolute;
  left: 0;
  top: 0;
  width: 600px;
  height: 400px;
}

.wrapper {
  position: relative;
  width: 600px;
  height: 400px;
  -moz-user-select: none;
  -webkit-user-select: none;
  -ms-user-select: none;
  user-select: none;
}

应用程式

library(shiny)
library(dplyr)
library(ggplot2)
library(shinyjs)

jscode <- "shinyjs.init = function() {

var signaturePad = new SignaturePad(document.getElementById('signature-pad'), {
  backgroundColor: 'rgba(255, 255, 255, 0)',
  penColor: 'rgb(0, 0, 0)'
});
var saveButton = document.getElementById('save');
var cancelButton = document.getElementById('clear');

saveButton.addEventListener('click', function (event) {
  var data = signaturePad.toDataURL('image/png');

// Send data to server instead...
  window.open(data);
});

cancelButton.addEventListener('click', function (event) {
  signaturePad.clear();
});

}"

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

  output$plot1 <- renderPlot({

    df <- sample_frac(diamonds, 0.1)

    ggplot(df, aes(x = carat, y = price, color = color)) +
      geom_point()

  })
}

ui <- fluidPage(

  includeCSS("custom.css"),
  tags$head(tags$script(src = "signature_pad.js")),

  shinyjs::useShinyjs(),
  shinyjs::extendShinyjs(text = jscode),

  h1("Draw on plot"),
  div(class="wrapper",
      plotOutput("plot1"),
      HTML("<canvas id='signature-pad' class='signature-pad' width=600 height=400></canvas>"),
      HTML("<div>
           <button id='save'>Save</button>
           <button id='clear'>Clear</button>
           </div>")

  )
)

shinyApp(ui = ui, server = server)