how - title in ggplot2 r




Способ «от руки» рисовать фигуры в блестящем? (2)

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

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

К недостаткам функций, которые я обнаружил, относятся:

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

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

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


Используя только базовые функциональные возможности, вы можете создать приложение, в котором вы сможете рисовать ручные фигуры на простом графике. Я использую здесь функцию базового plot чтобы она реагировала быстрее. Он использует параметры click и hover для 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)

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





rendering