ggplot - ¿Cómo dibujar formas "a mano alzada" en brillante?

shiny plot output

Question

¿Existe una función o alguna otra forma de habilitar el dibujo a mano alzada (es decir, el dibujo de formas / tamaños al azar) usando el mouse en Shiny?

Específicamente, me gustaría poder "interactuar" con un gráfico de renderPlot al marcarlo de varias maneras (pero no uniformes). - En otras palabras, quiero poder marcar gráficos ya existentes.

Las deficiencias de las funciones que he encontrado incluyen:

1. Las herramientas para dibujar puntos, líneas, rectángulos o círculos no son lo suficientemente flexibles para mí.
2. Las herramientas no siempre son compatibles con un tipo de configuración de interacción click_plot .

Answer 1

Aquí hay una idea utilizando shinyjs y Signature Pad , adaptando la demostración para "dibujar sobre una imagen".

1. Guarde una copia de signature_pad.js en el subdirectorio "wwww" de su directorio de aplicaciones (tendrá que crear esta carpeta si aún no lo ha hecho). Este subdirectorio es una carpeta especial . Utilicé la última versión de Signature Pad, v1.5.3.
2. Cree un archivo CSS con el siguiente código y coloque el archivo en el directorio principal de la aplicación.
3. Utilice shinyjs para ejecutar la función de JavaScript cuando se carga la página. Lea sobre el uso de shinyjs::extendShinyjs here . Note en la viñeta que el paquete V8 debe estar instalado.

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;
}

Aplicación

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

Pequeño ejemplo con un iframe usando las herramientas en línea 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)

Answer 3

Usando solo funcionalidades básicas y shiny , puede crear una aplicación en la que puede dibujar formas manuales en una trama simple. Utilizo la función de plot base aquí para que reaccione más rápido. Utiliza los parámetros de clic y plotOutput del plotOutput . ¿Si quieres hacerlo en una trama más compleja y preexistente, podrías preferir ggplot para administrar mejor las diferentes capas? También puede pensar en agregar una spline más suave a los puntos. Visual:

Código de la aplicación (una versión en vivo es accesible 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)

Espero eso ayude..