手绘图ggplot。如何改进和/或格式化情节？

Question

我有一个客户希望能够在 Rshiny 中“徒手”绘制绘图 (ggplot) 图表。我说在绘图上使用套索选择按钮，但他们不高兴的是，如果您单击图表上的其他位置，它会删除第一个套索。

通过这篇文章，我能够制作一个可以绘制的 ggplot。然而，我无法让它与情节一起工作，因为我不知道下面用户界面中的悬停选项的等效项。我希望得到一些关于如何用绘图来做到这一点，如何改进代码以使其更快，和/或如何不让它从 (1,1) 的任意值开始的输入。

可以理解的是，只有当数据完全是数字时，这才有效。如果说数据中的第一列是 c("a","b","c") 而不是像下面那样的 c(1,2,3) ，是否有办法做到这一点。

注意：第一次单击该线从 (1,1) 开始，因为 ggplot 需要一个值来绘制图表，但反应性输入需要一个图表。为了绕过这个循环，我只是将列放在 c(1,vals$x)...希望这是有道理的。

library(shiny)
library(tidyverse)
ui <- fluidPage(
  actionButton("reset", "reset"),
  plotOutput("plot",
             hover=hoverOpts(id = "hover", delay = 300, 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({
    Data<-cbind(c(1,2,3),c(2,3,4))%>%as.data.frame()
    d<-cbind(c(1,vals$x),c(1,vals$y))%>%as.data.frame()
    ggplot(data=Data)+geom_point(data=Data,aes(x=V1,y=V2))+
    geom_path(data=d,aes(x=V1,y=V2))+xlim(c(0,15))+ylim(c(0,15))
  })
  }

shinyApp(ui, server)

Answer 1

编辑：该Plotly.plot()函数已被弃用- 现在使用Plotly.update()：

首先，您可以通过按在绘图中进行多个套索选择shift。

以下是我的答案的修改- 所以它是基于plot_ly/plotlyProxy的，修改现有的绘图对象（不重新渲染）而不使用ggplotly. 由于 GitHub问题和PR中正在进行一些相关工作，因此以下答案可能不是 100% 可靠（例如，缩放似乎会让事情变得混乱 - 您可能想要停用它）并且可能会过时。

尽管如此，请检查以下内容：

library(plotly)
library(shiny)
library(htmlwidgets)

ui <- fluidPage(
  plotlyOutput("myPlot"),
  verbatimTextOutput("click")
)

server <- function(input, output, session) {

  js <- "
    function(el, x){
      var id = el.getAttribute('id');
      var gd = document.getElementById(id);
      var d3 = Plotly.d3;
      Plotly.update(id).then(attach);
        function attach() {
          gd.addEventListener('click', function(evt) {
            var xaxis = gd._fullLayout.xaxis;
            var yaxis = gd._fullLayout.yaxis;
            var bb = evt.target.getBoundingClientRect();
            var x = xaxis.p2d(evt.clientX - bb.left);
            var y = yaxis.p2d(evt.clientY - bb.top);
            var coordinates = [x, y];
            Shiny.setInputValue('clickposition', coordinates);
          });
          gd.addEventListener('mousemove', function(evt) {
            var xaxis = gd._fullLayout.xaxis;
            var yaxis = gd._fullLayout.yaxis;
            var bb = evt.target.getBoundingClientRect();
            var x = xaxis.p2d(evt.clientX - bb.left);
            var y = yaxis.p2d(evt.clientY - bb.top);
            var coordinates = [x, y];
            Shiny.setInputValue('mouseposition', coordinates);
          });
        };
  }
  "

  output$myPlot <- renderPlotly({
    plot_ly(type = "scatter", mode = "markers") %>% layout(
      xaxis = list(range = c(0, 100)),
      yaxis = list(range = c(0, 100))) %>%
      onRender(js, data = "clickposition")
  })

  myPlotProxy <- plotlyProxy("myPlot", session)

  followMouse <- reactiveVal(FALSE)
  traceCount <- reactiveVal(0L)

  observeEvent(input$clickposition, {
    followMouse(!followMouse())

    if(followMouse()){
      plotlyProxyInvoke(myPlotProxy, "addTraces", list(x = list(input$clickposition[1]), y = list(input$clickposition[2])))
      traceCount(traceCount()+1)
    }
  })

  observe({
    if(followMouse()){
      plotlyProxyInvoke(myPlotProxy, "extendTraces", list(x = list(list(input$mouseposition[1])), y = list(list(input$mouseposition[2]))), list(traceCount()))
    }
  })

}

shinyApp(ui, server)

如果您想使用单个跟踪：

library(plotly)
library(shiny)
library(htmlwidgets)

ui <- fluidPage(
  plotlyOutput("myPlot"),
  verbatimTextOutput("click")
)

server <- function(input, output, session) {
  
  js <- "
    function(el, x){
      var id = el.getAttribute('id');
      var gd = document.getElementById(id);
      Plotly.update(id).then(attach);
        function attach() {
          gd.addEventListener('click', function(evt) {
            var xaxis = gd._fullLayout.xaxis;
            var yaxis = gd._fullLayout.yaxis;
            var bb = evt.target.getBoundingClientRect();
            var x = xaxis.p2d(evt.clientX - bb.left);
            var y = yaxis.p2d(evt.clientY - bb.top);
            var coordinates = [x, y];
            Shiny.setInputValue('clickposition', coordinates);
          });
          gd.addEventListener('mousemove', function(evt) {
            var xaxis = gd._fullLayout.xaxis;
            var yaxis = gd._fullLayout.yaxis;
            var bb = evt.target.getBoundingClientRect();
            var x = xaxis.p2d(evt.clientX - bb.left);
            var y = yaxis.p2d(evt.clientY - bb.top);
            var coordinates = [x, y];
            Shiny.setInputValue('mouseposition', coordinates);
          });
        };
  }
  "
  
  output$myPlot <- renderPlotly({
    plot_ly(type = "scatter", mode = "markers") %>% layout(
      xaxis = list(range = c(0, 100)),
      yaxis = list(range = c(0, 100))) %>%
      onRender(js, data = "clickposition")
  })
  
  myPlotProxy <- plotlyProxy("myPlot", session)

  followMouse <- reactiveVal(FALSE)
  clickCount <- reactiveVal(0L)
  
  observeEvent(input$clickposition, {
    followMouse(!followMouse())
    clickCount(clickCount()+1)
    
    if(clickCount() == 1){
      plotlyProxyInvoke(myPlotProxy, "addTraces", list(x = list(input$clickposition[1]), y = list(input$clickposition[2])))
    }
    
  })
  
  observe({
    if(followMouse()){
      plotlyProxyInvoke(myPlotProxy, "extendTraces", list(x = list(list(input$mouseposition[1])), y = list(list(input$mouseposition[2]))), list(1)) 
    } else {
      plotlyProxyInvoke(myPlotProxy, "extendTraces", list(x = list(list(NA)), y = list(list(NA))), list(1))
    }
  })

}

shinyApp(ui, server)