Droga do "wolnej ręki" rysuje kształty w połysku?

Question

Czy istnieje funkcja lub inny sposób włączania rysowania swobodnego (tj. Rysowania losowych kształtów/rozmiarów) za pomocą myszy w trybie Shiny?

W szczególności chciałbym móc "współdziałać" z działką od renderPlot, zaznaczając ją na różne (ale niejednolite) sposoby. - Innymi słowy, chcę mieć możliwość zaznaczania już istniejących grafik.

Braki funkcji mam znaleziono obejmują:

1. Narzędzia do rysowania punktów, linii, prostokątów, czy koła nie są wystarczająco elastyczne dla mnie.
2. Narzędzia nie zawsze są kompatybilne z konfiguracją typu interakcji click_plot.

Answer 1

mały przykład z iframe użyciu draw.io narzędzi online

#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 2

Oto pomysł z wykorzystaniem shinyjs i Signature Pad, dostosowując demo dla "rysunek na obrazku".

1. Zapisz kopię signature_pad.js w „wwww” podkatalogu katalogu aplikacji (trzeba utworzyć ten folder, jeśli jeszcze tego nie zrobiłeś). This subdirectory is a special folder. Użyłem najnowszej wersji Signature Pad, v1.5.3.
2. Utwórz plik CSS z poniższym kodem i umieść plik w głównym katalogu aplikacji.
3. Użyj funkcji shinyjs, aby uruchomić funkcję JavaScript po załadowaniu strony. Przeczytaj o użyciu shinyjs::extendShinyjshere. Z winiety należy zauważyć, że należy zainstalować pakiet 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; 
} 

App

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 3

Korzystanie tylko podstawowe shiny functionnalities, można zbudować aplikację, gdzie można wyciągnąć instrukcja kształtuje się na prostej fabule. Używam tutaj funkcji bazy plot, aby szybciej reagowała. Używa on zarówno parametrów kliknięcia, jak i hover z plotOutput. Jeśli chcesz zrobić to na bardziej złożonej, wstępnie istniejącej fabule, możesz lepiej wybrać ggplot, aby lepiej zarządzać różnymi warstwami? Możesz także pomyśleć o dodaniu splajnu gładzącego do punktów. Wizualny:

Kod aplikacji:

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) 

Nadzieja to pomaga ..