"徒手"的方式画出闪亮的形状？

Question

是否有一种功能或其他方式可以使用鼠标在Shiny中实现徒手绘制(即绘制随机形状/大小)？

具体来说,我希望能够renderPlot通过以各种(但非均匀)方式标记它来与图形"交互" . - 换句话说,我希望能够标记已经存在的图形.

我的功能缺点已经发现包括:

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

Answer 1

这是一个使用shinyjs和签名板的想法,使演示适应"绘制图像".

1. 将signature_pad.js的副本保存在app目录的"wwww"子目录中(如果还没有,则需要创建此文件夹).该子目录是一个特殊文件夹.我使用了最新版本的Signature Pad,v1.5.3.
2. 使用以下代码创建一个CSS文件,并将该文件放在主app目录中.
3. 用于shinyjs在页面加载时运行JavaScript函数.阅读关于使用shinyjs::extendShinyjs 这里.请注意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这里使用基本功能,因此它反应更快.它使用的是click和hover参数plotOutput.如果你想在更复杂的预先存在的情节中进行,你可能更喜欢ggplot来更好地管理不同的图层？您还可以考虑为点添加样条平滑器.视觉:

应用程序代码(可在此处访问实时版本):

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)