徒手画ggplot。如何改进 plotly 的 and/or 格式？
Freehand drawing ggplot. How to improve and/or format for plotly?
我有一个客户希望能够在 Rshiny 的 plotly (ggplot) 图形上“徒手”绘制。我说要在绘图上使用套索 select 按钮，但他们不高兴，如果你点击图表上的其他地方，它会删除第一个套索。
使用这个 post，我能够处理我可以绘制的 ggplot。但是我无法让它与 plotly 一起工作，因为我不知道下面 ui 中悬停选项的 equivalent。我很想知道如何使用 plotly 执行此操作，如何改进代码以使其更快，and/or 如何不让它从 (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)
编辑： Plotly.plot() 函数已 deprecated - 现在使用 Plotly.update() 代替：
首先，您可以通过按 shift 在 plotly 中进行多个套索选择。
以下是我的答案的修改 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以下答案可能不是 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)
我有一个客户希望能够在 Rshiny 的 plotly (ggplot) 图形上“徒手”绘制。我说要在绘图上使用套索 select 按钮，但他们不高兴，如果你点击图表上的其他地方，它会删除第一个套索。
使用这个 post，我能够处理我可以绘制的 ggplot。但是我无法让它与 plotly 一起工作，因为我不知道下面 ui 中悬停选项的 equivalent。我很想知道如何使用 plotly 执行此操作，如何改进代码以使其更快，and/or 如何不让它从 (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)
编辑： Plotly.plot() 函数已 deprecated - 现在使用 Plotly.update() 代替：
首先，您可以通过按 shift 在 plotly 中进行多个套索选择。
以下是我的答案的修改 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以下答案可能不是 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)