通过“徒手”绘制闪亮形状的方式？

Question

是否有功能或其他方式在Shiny中使用鼠标启用徒手绘制（即绘制随机形状/大小）？

具体来说，我希望通过以各种（但非均匀）的方式标记renderPlot的情节来与之交互。 - 换句话说，我希望能够标记现有的图形。

我 找到的函数的缺点包括：

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

Answer 1

这是一个使用shinyjs和Signature Pad的想法，让演示适应＆＃34;绘制图像＆＃34;。

1. 将signature_pad.js的副本保存在＆＃34; wwww＆＃34;您的应用目录的子目录（如果您还没有，则需要创建此文件夹）。 This subdirectory is a special folder。我使用了最新版本的Signature Pad，v1.5.3。
2. 使用以下代码创建一个CSS文件，并将该文件放在主app目录中。
3. 使用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)

Answer 2

仅使用基本shiny功能，您可以构建一个应用程序，您可以在简单的绘图上绘制手动形状。我在这里使用基本plot函数，因此它反应更快。它使用plotOutput的点击和悬停参数。如果你想在更复杂的预先存在的情节中进行，你可能更喜欢ggplot来更好地管理不同的图层？您还可以考虑为点添加样条平滑器。视觉：

应用代码（可以访问实时版本here）：

library(shiny)
ui <- fluidPage(
  h4("Click on plot to start drawing, click again to pause"),
  sliderInput("mywidth", "width of the pencil", min=1, max=30, step=1, value=10),
  actionButton("reset", "reset"),
  plotOutput("plot", width = "500px", height = "500px",
             hover=hoverOpts(id = "hover", delay = 100, delayType = "throttle", clip = TRUE, nullOutside = TRUE),
             click="click"))
server <- function(input, output, session) {
  vals = reactiveValues(x=NULL, y=NULL)
  draw = reactiveVal(FALSE)
  observeEvent(input$click, handlerExpr = {
    temp <- draw(); draw(!temp)
    if(!draw()) {
      vals$x <- c(vals$x, NA)
      vals$y <- c(vals$y, NA)
    }})
  observeEvent(input$reset, handlerExpr = {
    vals$x <- NULL; vals$y <- NULL
  })
  observeEvent(input$hover, {
    if (draw()) {
      vals$x <- c(vals$x, input$hover$x)
      vals$y <- c(vals$y, input$hover$y)
    }})
  output$plot= renderPlot({
    plot(x=vals$x, y=vals$y, xlim=c(0, 28), ylim=c(0, 28), ylab="y", xlab="x", type="l", lwd=input$mywidth)
  })}
shinyApp(ui, server)

希望有所帮助......

Answer 3

iframe使用draw.io在线工具

的小例子

#rm(list = ls())
library(shiny)

ui <- fluidPage(titlePanel("Getting Started with draw.io"), htmlOutput("frame"))

server <- function(input, output) {
  output$frame <- renderUI({
    tags$iframe(src="https://www.draw.io", height=1000, width=1400)
  })
}

shinyApp(ui, server)