I am using shiny, plotly and shinyBS as follows to generate a modal pop up with a new plot when a plotly_click event happens on the plot. It works perfectly find when I run locally, and also in the local browser.
However, when I deploy it on the Shiny server, I get this error, and have no idea what it means. Any thoughts?
library(shiny)
library(plotly)
library(shinyBS)
df1 <- data.frame(x = 1:10, y = 1:10)
df2 <- data.frame(x = c(rep('a', 10), rep('b', 10)),
y = c(rnorm(10), rnorm(10, 3, 1)))
ui <- fluidPage(
column(6, plotlyOutput('scatter')),
bsModal('boxPopUp', '', '', plotlyOutput('box'))
)
server <- function(input, output, session) {
output$scatter <- renderPlotly({
plot_ly(df1, x = ~x, y = ~y, mode = 'markers',
type = 'scatter', source = 'scatter')
})
observeEvent(event_data("plotly_click", source = "scatter"), {
toggleModal(session, "boxPopUp", toggle = "toggle")
})
output$box <- renderPlotly({
eventdata <- event_data('plotly_click', source = 'scatter')
validate(need(!is.null(eventdata),
'Hover over the scatter plot to populate this boxplot'))
plot_ly(df2, x = ~x, y = ~y, type = 'box')
})
}
shinyApp(ui = ui, server = server)
Error message is as follows (shown in the Shiny server log for the app):
Warning: Error in event_data: attempt to apply non-function
Stack trace (innermost first):
59: event_data
58: observeEventExpr
1: runApp
This is a modified version using the modal dialog available in Shiny 0.14.
Tested in RStudio, local browser, shinyapps and on my local instalation of shiny server open source version.
This is the code:
library(shiny)
library(plotly)
library(shinyBS)
df1 <- data.frame(x = 1:10, y = 1:10)
df2 <- data.frame(x = c(rep('a', 10), rep('b', 10)),
y = c(rnorm(10), rnorm(10, 3, 1)))
ui <- fluidPage(
column(6, plotlyOutput('scatter'))
)
server <- function(input, output, session) {
output$scatter <- renderPlotly({
plot_ly(df1, x = x, y = y, mode = 'markers',
type = 'scatter', source = 'scatter')
})
observeEvent(event_data("plotly_click", source = "scatter"), {
showModal(modalDialog(
renderPlotly({
plot_ly(df2, x = x, y = y, type = 'box')
}),
easyClose = TRUE
))
})
}
shinyApp(ui = ui, server = server)
Related
I am new to shiny and plotly. What I'm trying to do is to add a trace first and then I want it to be replaced by a new one every time I click on a button.
here is my minimal example:
library(shiny)
library(plotly)
ui <- fluidPage(plotlyOutput("fig1"),
numericInput("A",
label = h5("A"),
value = "",
width = "100px"),
numericInput("B",
label = h5("B"),
value = "",
width = "100px"),
actionButton("action3", label = "Add to plot"),
actionButton("action4", label = "Remove point")
)
server <- function(input, output) {
A <- 1:5
B <- c(115, 406, 1320, 179, 440)
data <- data.frame(A, B)
fig <- plot_ly(data, x = A, y = B, type = 'scatter', mode = 'markers')
output$fig1 <- renderPlotly(fig)
observeEvent(input$action3, {
vals <- reactiveValues(A = input$A, B = input$B)
plotlyProxy("fig1") %>%
plotlyProxyInvoke("addTraces",
list(x = c(vals$A,vals$A),
y = c(vals$B,vals$B),
type = "scatter",
mode = "markers"
)
)
})
observeEvent(input$action4, {
vals <- reactiveValues(A = input$A, B = input$B)
plotlyProxy("fig1") %>%
plotlyProxyInvoke("deleteTraces")
})
}
shinyApp(ui,server)
I can add a new trace easily but they all remain on the plot.
My solution was to add a new button to delete the trace but it did not work.
I have already read this but I couldn't make it work.
Based on what you described, it sounds like you want to add a trace and remove the most recent trace added at the same time when the button is pressed. This would still leave the original plot/trace that you started with.
I tried simplifying a bit. The first plotlyProxyInvoke will remove the most recently added trace (it is zero-indexed, leaving the first plotly trace in place).
The second plotlyProxyInvoke will add the new trace. Note that the (x, y) pair is included twice based on this answer.
library(shiny)
library(plotly)
A <- 1:5
B <- c(115, 406, 1320, 179, 440)
data <- data.frame(A, B)
ui <- fluidPage(plotlyOutput("fig1"),
numericInput("A",
label = h5("A"),
value = "",
width = "100px"),
numericInput("B",
label = h5("B"),
value = "",
width = "100px"),
actionButton("action3", label = "Add to plot"),
)
server <- function(input, output, session) {
fig <- plot_ly(data, x = A, y = B, type = 'scatter', mode = 'markers')
output$fig1 <- renderPlotly(fig)
observeEvent(input$action3, {
plotlyProxy("fig1", session) %>%
plotlyProxyInvoke("deleteTraces", list(as.integer(1)))
plotlyProxy("fig1", session) %>%
plotlyProxyInvoke("addTraces",
list(x = c(input$A, input$A),
y = c(input$B, input$B),
type = 'scatter',
mode = 'markers')
)
})
}
shinyApp(ui,server)
I want a pop-up when I click over the bar chart for plotly.
library(shiny)
library(shinymaterial)
df1 <- data.frame(x = 1:10, y = 1:10)
df2 <- data.frame(x = c(rep('a', 10), rep('b', 10)),
y = c(rnorm(10), rnorm(10, 3, 1)))
ui <- material_page(title = "Material Design",
tags$br(),
font_color = "cyan darken-5",
nav_bar_color = "cyan darken-5",
plotlyOutput('scatter')
)
server <- function(input, output) {
output$scatter <- renderPlotly({
plot_ly(df1, x = df1$x, y = df1$y, type = 'bar', source = 'scatter')
})
}
shinyApp(ui = ui, server = server)
I am struck at a point where I need a help; I want a pop-up when I click
over the bar chart the respective contents to be displayed.
Please help me on the same.
You can use an observer and the event_data from your scatterchart to accomplish that. Working example below, hope this helps!
library(shiny)
library(plotly)
df1 <- data.frame(x = 1:10, y = 1:10)
df2 <- data.frame(x = c(rep('a', 10), rep('b', 10)),
y = c(rnorm(10), rnorm(10, 3, 1)))
ui <- fluidPage(
plotlyOutput('scatter')
)
server <- function(input, output) {
output$scatter <- renderPlotly({
plot_ly(df1, x = df1$x, y = df1$y, type = 'bar', source = 'scatter')
})
observeEvent(event_data("plotly_click", source = "scatter"),
{
event_data = event_data("plotly_click", source = "scatter")
showModal(modalDialog(
title = "Important message",
paste0('x: ', event_data$x, ', y: ', event_data$y)
))
}
)
}
shinyApp(ui = ui, server = server)
I have a shiny app which generates 2 plots and one table. As you will see I want to select which one of them will be displayed every time based on the radiobuttons() input. Until now I get an error object of type 'closure' is not subsettable Which object exactly is of type closure? Note that the first is a ggplot object the second is a plotly object and the third a datatable.
# ui.R
library(shiny)
library(plotly)
pageWithSidebar(
headerPanel('Iris k-means clustering'),
sidebarPanel(
uiOutput("filter_degree")
),
mainPanel(
uiOutput('plot')
)
)
#server.r
function(input, output, session) {
output$filter_degree<-renderUI({
radioButtons("rd","Select Option",choices = c("Mileage","Regression",'Table'),
selected = "Mileage")
})
output$plot <- renderUI({
if(input$rd=="Mileage"){
output$plot1<-renderUI({
# Boxplots of mpg by number of gears
# observations (points) are overlayed and jittered
qplot(gear, mpg, data=mtcars, geom=c("boxplot", "jitter"),
fill=gear, main="Mileage by Gear Number",
xlab="", ylab="Miles per Gallon")
})
}
else if(input$rd=="Regression"){
output$plot2<-renderUI({
x <- c(1:100)
random_y <- rnorm(100, mean = 0)
data <- data.frame(x, random_y)
p <- plot_ly(data, x = ~x, y = ~random_y, type = 'scatter', mode = 'lines')
})
}
else if(input$rd=="Table"){
output$tbl = DT::renderDataTable(datatable(
iris, options = list(lengthChange = FALSE,scrollY = T, scroller = TRUE, scrollX = T),selection = list(target="cell",mode="single"),rownames = F)
)
}
})
}
You need to provide the plot/table output as part of the if/then sequence (plotOutput("plot1"), etc.). Otherwise, it has nothing to render. Also, there appears to be an error in the ploty call, but I haven't fixed it for you.
library(shiny)
library(DT)
library(plotly)
ui <- pageWithSidebar(
headerPanel('Iris k-means clustering'),
sidebarPanel(
uiOutput("filter_degree")
),
mainPanel(
uiOutput('plot')
)
)
#server.r
server <- function(input, output, session) {
output$filter_degree<-renderUI({
radioButtons("rd","Select Option",choices = c("Mileage","Regression",'Table'),
selected = "Mileage")
})
output$plot <- renderUI({
if(input$rd=="Mileage"){
output$plot1<-renderPlot({
# Boxplots of mpg by number of gears
# observations (points) are overlayed and jittered
qplot(gear, mpg, data=mtcars, geom=c("boxplot", "jitter"),
fill=gear, main="Mileage by Gear Number",
xlab="", ylab="Miles per Gallon")
})
plotOutput("plot1")
}
else if(input$rd=="Regression"){
output$plot2<-renderUI({
x <- c(1:100)
random_y <- rnorm(100, mean = 0)
data <- data.frame(x, random_y)
p <- plot_ly(data, x = ~x, y = ~random_y, type = 'scatter', mode = 'lines')
})
plotlyOutput("plot2")
}
else if(input$rd=="Table"){
output$tbl = DT::renderDataTable(datatable(
iris, options = list(lengthChange = FALSE,scrollY = T, scroller = TRUE, scrollX = T),selection = list(target="cell",mode="single"),rownames = F)
)
dataTableOutput("tbl")
}
})
}
shinyApp(ui = ui, server = server)
I want a plotly plot to change an annotation if the user clicks a button in a shiny app.
I have no idea why this does not work:
library(shiny)
library(plotly)
d <- data.frame(x = c(1,2,3), y = c(9,99,999))
ui <- fluidPage(
plotlyOutput("plot"),
actionButton("button", "toggle visibility"))
server <- function(input, output) {
output$plot <- renderPlotly({
plot_ly(d)%>%
add_lines(y=d$y, x= d$x)%>%
layout(annotations = list(x = 2, y= 99 , text = "hi"))})
observeEvent(input$button, {
plotlyProxy("plot", session= shiny::getDefaultReactiveDomain()) %>%
plotlyProxyInvoke("relayout", list(annotations= list(x = 2, y= 99 ,
text = "ho")))})}
shinyApp(ui, server)
That is not the way to use relayout in plotly. See below for your example using relayout.
I prefer using native shiny buttons for this purpose because of the greater flexibility it offers. Here is how one might go about achieving the hi-ho toggle.
shiny way
library(shiny)
library(plotly)
d <- data.frame(x = c(1,2,3), y = c(9,99,999))
ui <- fluidPage(
plotlyOutput("plot"),
actionButton("button", "toggle visibility"))
server <- function(input, output) {
output$plot <- renderPlotly({
p <- plot_ly(d)%>%
add_lines(y=d$y, x= d$x)
if (is.null(input$button) | (input$button%%2 == 0)) {
p <- p %>% layout(annotations = list(x = 2, y= 99 , text = "hi"))
} else {
p <- p %>% layout(annotations = list(x = 2, y= 99 , text = "ho"))
}
p
})
}
shinyApp(ui, server)
In this case though, it is simple enough to make the relayout feature work, although it does require an extra button.
plotly relayout way
library(shiny)
library(plotly)
d <- data.frame(x = c(1,2,3), y = c(9,99,999))
ui <- fluidPage(
plotlyOutput("plot")
)
server <- function(input, output) {
output$plot <- renderPlotly({
updatemenus <- list(
list(
active = -1,
type = 'buttons',
buttons = list(
list(
label = "hi",
method = "relayout",
args = list(list(annotations = list(list(x = 2, y= 99 , text = "hi"))))),
list(
label = "ho",
method = "relayout",
args = list(list(annotations = list(list(x = 2, y= 99 , text = "ho")))))
)
)
)
p <- plot_ly(d) %>%
add_lines(y=d$y, x= d$x) %>%
layout(updatemenus = updatemenus)
p
})
}
shinyApp(ui, server)
I believe all that needs to change in your code in order to get this to work is wrapping another list around the defined annotation list in your plotly proxy relayout code. I recently discovered that this recursive list structure is all that's needed in order to manipulate annotations using relayout - you can check out my answer to another SO question related to the same issue, but with slightly different context: https://stackoverflow.com/a/70610374/17852464
library(shiny)
library(plotly)
d <- data.frame(x = c(1,2,3), y = c(9,99,999))
ui <- fluidPage(
plotlyOutput("plot"),
actionButton("button", "toggle visibility"))
server <- function(input, output) {
output$plot <- renderPlotly({
plot_ly(d)%>%
add_lines(y=d$y, x= d$x)%>%
layout(annotations = list(x = 2, y= 99 , text = "hi"))
})
observeEvent(input$button, {
plotlyProxy("plot", session= shiny::getDefaultReactiveDomain()) %>%
plotlyProxyInvoke("relayout", list(annotations= list(list(x = 2, y= 99 ,
text = "ho"))))})}
}
shinyApp(ui, server)
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)
Edit using plotlyProxy:
Update #SeGa, thanks for adding support to delete traces with duplicated names!
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.push([name=trace.name, index=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, input$TraceMapping)
traces <- matrix(input$TraceMapping, ncol = 2, byrow = TRUE)
indices <- as.integer(traces[traces[, 1] == input$TraceName, 2])
plotlyProxy("MyPlot", session) %>%
plotlyProxyInvoke("deleteTraces", indices)
})
}
shinyApp(ui, server)
Result:
Useful articles in this context:
shiny js-events
plotly addTraces
plotly deleteTraces
Solution for Shiny Modules using plotlyProxy:
library(shiny)
library(plotly)
library(htmlwidgets)
js <- "function(el, x, data){
var id = el.getAttribute('id');
var d3 = Plotly.d3;
$(document).on('shiny:inputchanged', function(event) {
if (event.name.indexOf('Remove') > -1) {
var out = [];
d3.select('#' + id + ' g.legend').selectAll('.traces').each(function(){
var trace = d3.select(this)[0][0].__data__[0].trace;
out.push([name=trace.name, index=trace.index]);
});
Shiny.setInputValue(data.ns + data.x, out);
}
});
}"
plotly_ui_mod <- function(id) {
ns <- NS(id)
tagList(
textInput(ns("TraceName"), "Trace Name"),
verbatimTextOutput(ns("PrintTraceMapping")),
actionButton(ns("Add"), "Add Trace"),
actionButton(ns("Remove"), "Remove Trace"),
plotlyOutput(ns("MyPlot"))
)
}
plotly_server_mod <- function(input, output, session) {
sessionval <- session$ns("")
output$MyPlot <- renderPlotly({
plot_ly(type = "scatter", mode = "markers") %>%
layout(showlegend = TRUE) %>% onRender(js, data = list(x = "TraceMapping",
ns = sessionval))
})
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, input$TraceMapping)
traces <- matrix(input$TraceMapping, ncol = 2, byrow = TRUE)
indices <- as.integer(traces[traces[, 1] == input$TraceName, 2])
plotlyProxy("MyPlot", session) %>%
plotlyProxyInvoke("deleteTraces", indices)
})
}
ui <- fluidPage(
plotly_ui_mod("plotly_mod")
)
server <- function(input, output, session) {
callModule(plotly_server_mod, "plotly_mod")
}
shinyApp(ui, server)
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)
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)
It appears the Plotly.D3 method has been depreciated and no longer works in the above code. I was able to replicate a simple solution with the below code.
library(shiny)
library(plotly)
library(htmlwidgets)
js <- "function(el){
$(document).on('shiny:inputchanged', function(event) {
if (event.name === 'Remove') {
var traceName = document.getElementById('TraceName').value
var plotlyData = document.getElementById('MyPlot').data
plotlyData.forEach(function (item, index) {
if (item.name === traceName){
Plotly.deleteTraces('MyPlot', index);
}
});
}
});
}"
ui <- fluidPage(
textInput("TraceName", "Trace Name"),
actionButton("Remove", "Remove Trace"),
plotlyOutput("MyPlot")
)
server <- function(input, output, session) {
output$MyPlot <- renderPlotly({
print("renderPlotlyRan")
plot_ly(type = "scatter", mode = "markers") %>%
add_markers(x = rnorm(10),y = rnorm(10), name = "Trace1") %>%
add_markers(x = rnorm(10),y = rnorm(10), name = "Trace2") %>%
add_markers(x = rnorm(10),y = rnorm(10), name = "Trace3") %>%
add_markers(x = rnorm(10),y = rnorm(10), name = "Trace4") %>%
layout(showlegend = TRUE) %>%
htmlwidgets::onRender(x = ., jsCode = js)
})
}
shinyApp(ui, server)