写意图ggplot.如何改善和/或格式化? [英] Freehand drawing ggplot. How to improve and/or format for plotly?
问题描述
我有一个客户希望能够徒手画画".在Rshiny中绘制一个绘图(ggplot)图.我说过要在绘图图上使用套索选择按钮，但是他们不满意，如果您单击图形上的其他位置，它将删除第一个套索.
使用此
首先，您可以通过按 shift 来选择多个套索选择.
以下是我的答案的修改
如果您想使用单个跟踪:
库(可打印)图书馆(闪亮)图书馆(htmlwidgets)ui<-fluidPage(plotlyOutput("myPlot")，verbatimTextOutput("click"))服务器<-功能(输入，输出，会话){js<-"函数(el，x){var id = el.getAttribute('id');var gd = document.getElementById(id);Plotly.plot(id).then(attach);函数attach(){var xaxis = gd._fullLayout.xaxis;var yaxis = gd._fullLayout.yaxis;var坐标= [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坐标= [x，y];Shiny.setInputValue('clickposition'，坐标);});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坐标= [x，y];Shiny.setInputValue('mouseposition'，坐标);});};}"output $ myPlot<-renderPlotly({plot_ly(type ="scatter"，mode ="markers")％&％;％layout(xaxis = list(范围= c(0，100))，yaxis = list(范围= c(0，100)))％>％onRender(js)})myPlotProxy<-plotlyProxy("myPlot"，会话)followMouse<-reactVal(FALSE)clickCount<-reactVal(0L)watchEvent(input $ clickposition，{followMouse(！followMouse())clickCount(clickCount()+ 1)if(clickCount()== 1){plotlyProxyInvoke(myPlotProxy，"addTraces"，list(x =列表(input $ clickposition [1])，y =列表(input $ clickposition [2])))}})观察({if(followMouse()){plotlyProxyInvoke(myPlotProxy，"extendTraces"，list(x =列表(list(input $ mouseposition [1]))，y =列表(list(input $ mouseposition [2])))，list(1))} 别的 {plotlyProxyInvoke(myPlotProxy，"extendTraces"，list(x =列表(list(NA))，y =列表(list(NA)))，list(1))}})}ShinyApp(用户界面，服务器) 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)
这篇关于写意图ggplot.如何改善和/或格式化?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
