问题
I am attempting to use the plotlyProxy() functionality (Documented here) to allow users of a shiny application to add and remove traces with minimal latency.
Adding traces proves to be relatively simple, but I'm having difficulty figuring out how to remove traces by name (I'm only seeing documented examples that remove by trace number).
Is there a way to remove traces by name using plotlyProxy()?
If not, is there a way that I can parse through the output object to derive what trace numbers are associated with a given name?
I can determine the associated trace number of a given name in an interactive R session using the standard schema indices, but when I attempt to apply the same logic in a shiny application I get an error: "Error in $.shinyoutput: Reading objects from shinyoutput object not allowed."
A minimal example is below. Neither observer watching the Remove button actually works, but they should give an idea for the functionality I'm trying to achieve.
library(shiny)
library(plotly)
ui <- fluidPage(
textInput("TraceName", "Trace Name"),
actionButton("Add","Add Trace"),
actionButton("Remove","Remove Trace"),
plotlyOutput("MyPlot")
)
server <- function(input,output,session) {
## Creaing the plot
output$MyPlot <- renderPlotly({
plot_ly() %>%
layout(showlegend = TRUE)
})
## Adding traces is smooth sailing
observeEvent(input$Add,{
plotlyProxy("MyPlot", session) %>%
plotlyProxyInvoke("addTraces", list(x = rnorm(10),y = rnorm(10),
type = "scatter",mode = "markers",
name = input$TraceName))
})
## Ideal Solution (that does not work)
observeEvent(input$Remove,{
plotlyProxy("MyPlot", session) %>%
plotlyProxyInvoke("deleteTraces", input$TraceName)
})
## Trying to extract tracenames throws an error:
## Warning: Error in $.shinyoutput: Reading objects from shinyoutput object not allowed.
observeEvent(input$Remove,{
TraceNames <- unlist(lapply(seq_along(names(output$MyPlot$x$attrs)),
function(x) output$MyPlot$x$attrs[[x]][["name"]]))
ThisTrace <- which(TraceNames == input$TraceName)
plotlyProxy("MyPlot", session) %>%
plotlyProxyInvoke("deleteTraces", ThisTrace)
})
}
shinyApp(ui, server)
回答1:
Edit using plotlyProxy:
Finally, I found a solution to realize the expected behaviour by adapting this answer. I'm receiving the trace.name / trace.index mapping by using onRender from library(htmlwidgets) after the remove-button is clicked:
library(shiny)
library(plotly)
library(htmlwidgets)
js <- "function(el, x, inputName){
var id = el.getAttribute('id');
var d3 = Plotly.d3;
$(document).on('shiny:inputchanged', function(event) {
if (event.name === 'Remove') {
var out = {};
d3.select('#' + id + ' g.legend').selectAll('.traces').each(function(){
var trace = d3.select(this)[0][0].__data__[0].trace;
out[trace.name] = trace.index;
});
Shiny.setInputValue(inputName, out);
}
});
}"
ui <- fluidPage(
textInput("TraceName", "Trace Name"),
verbatimTextOutput("PrintTraceMapping"),
actionButton("Add", "Add Trace"),
actionButton("Remove", "Remove Trace"),
plotlyOutput("MyPlot")
)
server <- function(input, output, session) {
output$MyPlot <- renderPlotly({
plot_ly(type = "scatter", mode = "markers") %>%
layout(showlegend = TRUE) %>% onRender(js, data = "TraceMapping")
})
output$PrintTraceMapping <- renderPrint({unlist(input$TraceMapping)})
observeEvent(input$Add, {
req(input$TraceName)
plotlyProxy("MyPlot", session) %>%
plotlyProxyInvoke("addTraces", list(x = rnorm(10),y = rnorm(10),
type = "scatter",mode = "markers",
name = input$TraceName))
})
observeEvent(input$Remove, {
req(input$TraceName)
plotlyProxy("MyPlot", session) %>%
plotlyProxyInvoke("deleteTraces", input$TraceMapping[[input$TraceName]])
})
}
shinyApp(ui, server)
Result:
Useful article in this context: https://shiny.rstudio.com/articles/js-events.html
Previous Solution avoiding plotlyProxy:
I came here via this question.
You were explicitly asking for plotlyProxy() so I'm not sure if this is helpful to you, but here is a workaround to realize the expected behaviour via updating the data provided to plot_ly() instead of using plotlyProxy():
library(shiny)
library(plotly)
ui <- fluidPage(
selectizeInput(inputId="myTraces", label="Trace names", choices = NULL, multiple = TRUE, options = list('plugins' = list('remove_button'), 'create' = TRUE, 'persist' = TRUE, placeholder = "...add or remove traces")),
plotlyOutput("MyPlot")
)
server <- function(input, output, session){
myData <- reactiveVal()
observeEvent(input$myTraces, {
tmpList <- list()
for(myTrace in input$myTraces){
tmpList[[myTrace]] <- data.frame(name = myTrace, x = rnorm(10),y = rnorm(10))
}
myData(do.call("rbind", tmpList))
return(NULL)
}, ignoreNULL = FALSE)
output$MyPlot <- renderPlotly({
if(is.null(myData())){
plot_ly(type = "scatter", mode = "markers")
} else {
plot_ly(myData(), x = ~x, y = ~y, color = ~name, type = "scatter", mode = "markers") %>%
layout(showlegend = TRUE)
}
})
}
shinyApp(ui, server)
回答2:
I couldn't find the names attributes of the traces, and I think the deleteTrace function is not able to delete by name. Based on the reference it just deletes based on index.
I tried to implement something for Shiny, which records the added traces in a dataframe and adds an index to them. For deletion, it matches the given names with the dataframe and gives those indeces to the delete method of plotlyProxyInvoke, but it is not working correctly. Maybe someone could add some insight into why this is happening?
One problem seems to be the legend, which is showing wrong labels after deletion and I dont think that plotly and R/shiny are keeping the same indices of the traces, which leads to strange behaviour. So this code definitly needs some fixing.
--
I included a small JQuery snippet, which records all the traces of the plot and sends them to a reactiveVal(). Interestingly, it differs from the data.frame, that listens to the AddTraces event. There will always be one remaining trace in the plot.
library(shiny)
library(plotly)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
tags$head(tags$script(HTML(
"$(document).on('shiny:value', function(event) {
var a = $('.scatterlayer.mlayer').children();
if (a.length > 0) {
var text = [];
for (var i = 0; i < a.length; i++){
text += a[i].className.baseVal + '<br>';
}
Shiny.onInputChange('plotlystr', text);
}
});"
))),
textInput("TraceName", "Trace Name"),
actionButton("Add","Add Trace"),
actionButton("Remove","Remove Trace by Name"),
plotlyOutput("MyPlot"),
splitLayout(
verbatimTextOutput("printplotly"),
verbatimTextOutput("printreactive")
)
)
server <- function(input,output,session) {
## Reactive Plot
plt <- reactive({
plot_ly() %>%
layout(showlegend = T)
})
## Reactive Value for Added Traces
addedTrcs <- reactiveValues(tr = NULL, id = NULL, df = NULL)
## Creaing the plot
output$MyPlot <- renderPlotly({
plt()
})
## Adding traces is smooth sailing
observeEvent(input$Add,{
req(input$TraceName)
plotlyProxy("MyPlot", session) %>%
plotlyProxyInvoke("addTraces", list(x = rnorm(10),y = rnorm(10),
type = "scatter",mode = "markers", colors ="blue",
name = input$TraceName))
})
## Adding trace to reactive
observeEvent(input$Add, {
req(input$TraceName)
x <- input$TraceName
addedTrcs$id <- c(addedTrcs$id, length(addedTrcs$id))
addedTrcs$tr <- c(addedTrcs$tr, x)
addedTrcs$df <- data.frame(id=addedTrcs$id, tr=addedTrcs$tr, stringsAsFactors = F)
})
## Remove Trace from Proxy by NAME
observeEvent(input$Remove,{
req(input$TraceName %in% addedTrcs$tr)
ind = which(addedTrcs$df$tr == input$TraceName)
ind = addedTrcs$df[ind,"id"]
plotlyProxy("MyPlot", session) %>%
plotlyProxyInvoke("deleteTraces", as.integer(ind))
})
## Remove Trace from Reactive
observeEvent(input$Remove, {
req(input$TraceName %in% addedTrcs$df$tr)
whichInd <- which(addedTrcs$tr == input$TraceName)
addedTrcs$df <- addedTrcs$df[-whichInd,]
addedTrcs$id <- addedTrcs$id[-whichInd]
addedTrcs$tr <- addedTrcs$tr[-whichInd]
req(nrow(addedTrcs$df)!=0)
addedTrcs$df$id <- 0:(nrow(addedTrcs$df)-1)
})
tracesReact <- reactiveVal()
observe({
req(input$plotlystr)
traces <- data.frame(traces=strsplit(input$plotlystr, split = "<br>")[[1]])
tracesReact(traces)
})
output$printplotly <- renderPrint({
req(tracesReact())
tracesReact()
})
## Print Reactive Value (added traces)
output$printreactive <- renderPrint({
req(addedTrcs$df)
addedTrcs$df
})
}
shinyApp(ui, server)
来源：https://stackoverflow.com/questions/50138568/removing-traces-by-name-using-plotlyproxy-or-accessing-output-schema-in-reactiv