注:第一次单击时,该行从(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) 解决方案首先,您可以通过按shift键在多个套索选择中进行选择.以下是我的答案的修改此处-因此它是基于plot_ly/plotlyProxy的,不使用ggplotly修改现有的绘图对象(无需重新渲染).由于GitHub中正在进行一些相关工作,因此 issue 和 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); Plotly.plot(id).then(attach); function attach() { var xaxis = gd._fullLayout.xaxis; var yaxis = gd._fullLayout.yaxis; var coordinates = [null, null] gd.addEventListener('click', function(evt) { 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 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) }) 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.plot(id).then(attach); function attach() { var xaxis = gd._fullLayout.xaxis; var yaxis = gd._fullLayout.yaxis; var coordinates = [null, null] gd.addEventListener('click', function(evt) { 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 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) }) 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)I have a client that wants to be able to "freehand" draw on a plotly (ggplot) graph in Rshiny. I said to use the lasso select button on plotly graphs, but they were not happy that if you click somewhere else on the graph it removes the first lasso. Using this post, I was able to workup a ggplot that I could draw on. I cannot however get it to work with plotly as I do not know the equivalent of the hover options in the ui below. I would love some input on how to do this with plotly, how to improve the code to make it faster, and/or how to not have it start at the arbitrary value of (1,1). Understandably, this only works if the data is completely numeric. Would there be a way to do this if say the first column in data was c("a","b","c") instead of c(1,2,3) like I have below.Note: The line starts at (1,1) for the first click because ggplot needed a value to graph, but the reactive inputs needed a graph. To get around this loop I just put the columns at c(1,vals$x)... hope that made sense.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) 解决方案 First of all you can have multiple lasso selections in plotly via pressing shift.The following is a modification of my answer here - so it's plot_ly / plotlyProxy based, modifying the existing plotly object (without re-rendering) not using ggplotly. As there is some related work going on in a GitHub issue and PR the below answer might not be 100% reliable (e.g. zooming seems to mess things up - you might want to deactivate it) and may become obsolete.Nevertheless, please check the following: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.plot(id).then(attach); function attach() { var xaxis = gd._fullLayout.xaxis; var yaxis = gd._fullLayout.yaxis; var coordinates = [null, null] gd.addEventListener('click', function(evt) { 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 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) }) 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)If you rather want to work with a single trace: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.plot(id).then(attach); function attach() { var xaxis = gd._fullLayout.xaxis; var yaxis = gd._fullLayout.yaxis; var coordinates = [null, null] gd.addEventListener('click', function(evt) { 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 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) }) 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) 这篇关于R闪亮:徒手绘制的ggplot.如何改善和/或格式化?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!
09-27 16:48