Способ "свободной руки" рисовать фигуры в блестящей форме?

Есть ли функция или какой-либо другой способ включения свободного рисования (т.е. рисования случайных форм/размеров) с помощью мыши в Shiny?

В частности, я хотел бы иметь возможность "взаимодействовать" с графиком из renderPlot, отмечая его различными (но неравномерными) способами. - Другими словами, я хочу иметь возможность разметки уже существующей графики.

Недостатки найденных функций включают:

Инструменты для рисования точек, линий, прямоугольников или кругов не являются достаточно гибкими для меня.
Инструменты не всегда совместимы с настройкой взаимодействия click_plot.

Ответ 1

Вот идея, использующая shinyjs и Signature Pad, адаптируя демо для "рисования изображения".

Сохраните копию signature_pad.js в подкаталоге "wwww" вашего каталога приложений (вам нужно создать эту папку если вы еще этого не сделали). Этот подкаталог представляет собой специальную папку. Я использовал последнюю версию Signature Pad, v1.5.3.
Создайте файл CSS с приведенным ниже кодом и поместите файл в основной каталог приложения.
Используйте 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)

Ответ 2

Небольшой пример с 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)

Ответ 3

Используя только базовые функциональные функции 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)

Надеюсь, что это поможет.