Removing traces by name using plotlyProxy (or accessing output schema in reactive context)
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)
How to add a new trace while removing the last one?
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)
adding/removing traces in plotly per onclick event
One can use a small javascript code to detect one click on the document, and send the result to the shiny server with Shiny.setInputValue. Then one can control the plot with the help of a reactive value.
library(shiny)
library(data.table)
library(plotly)
js <- "
$(document).ready(function(){
$(document).on('click', function(){
Shiny.setInputValue('click_on_doc', true, {priority: 'event'});
})
})"
ui <- basicPage(
tags$head(tags$script(HTML(js))),
mainPanel(
fluidRow(column(8, plotly::plotlyOutput("myplot", height = "800px")))
)
)
server <- function(input, output, session) {
testdata <- data.frame("Orga" = c("Li", "La", "Le", "Lu", "De", "Va", "Xul", "Jin"),
"Dachorga" = c("Bla", "Bla", "Blu", "Blu", "Blub", "Blub", "Lol", "Lol"),
"Umsatz.Orga" = c(20000, 10000, 12000, 3000, 100, 2400, 205000, 95000))
testdata <- data.table(testdata)
testdata_agg <- testdata[, sum(Umsatz.Orga), by=Dachorga]
plot <- testdata_agg %>%
group_by(Dachorga) %>%
plot_ly(labels = ~Dachorga, values = ~V1, hoverinfo = 'label+percent+value') %>%
add_pie(hole = 0.6) %>%
layout(title = "Donut charts using Plotly", showlegend = F,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
click <- reactiveVal(FALSE)
observe({
event <- !is.null(event_data("plotly_click"))
click(event)
})
observeEvent(input$click_on_doc, {
click(FALSE)
})
output$myplot <- renderPlotly({
if (click()) {
p <- add_pie(plot, data = testdata[Dachorga == "Bla"], labels = ~Orga,
values = ~Umsatz.Orga, hole = 0.5,
hoverinfo = 'label+percent+value', domain = list(
x = c(0.1, 0.9),
y = c(0.1, 0.9)),
marker = list(hover = list(color = "white")))
}else{
p <- plot
}
p
})
}
shinyApp(ui = ui, server = server)
I have not understood your "next problem". Perhaps open a new question and try to clarify.
Add plotly traces dynamically on shiny
Here is a solution avoiding plotlyProxy() by filtering your data.frame before passing it to plot_ly:
library(shiny)
library(shinydashboard)
library(plotly)
goals <- data.frame(Name = c("Messi", "Suarez", "Ronaldo", "Messi", "Suarez", "Ronaldo", "Messi", "Suarez", "Ronaldo" ),
Number= c(47, 35, 40, 49, 32, 31, 51, 49, 44 ),
Year = c("2018","2018","2018", "2017", "2017", "2017", "2016","2016","2016")
)
ui <- dashboardPage(dashboardHeader(),
dashboardSidebar(sidebarMenu(
menuItem(
"Search",
tabName = "Tabs",
icon = icon("object-ungroup")
)
)),
dashboardBody(tabItem(tabName = "Tabs",
fluidRow(
column(
width = 3,
box(
title = "SELECT ",
solidHeader = TRUE,
collapsible = TRUE,
width = NULL,
selectizeInput(
inputId = "Player",
selected = NULL,
multiple = TRUE,
label = " Choose Player",
choices = c("Messi", "Suarez", "Ronaldo"),
options = list('plugins' = list('remove_button'))
)
)
),
column(width = 9,
tabBox(width = "100%",
tabPanel(
"tab1",
plotlyOutput("Plot1")
)))
))))
server <- function(input, output, session) {
filteredGoals <- reactive({
goals[goals$Name %in% input$Player, ]
})
output$Plot1 <- renderPlotly({
plot_ly(filteredGoals(), x = ~Year, y = ~Number, type = 'scatter', mode = 'lines', color = ~Name)%>% layout(showlegend = TRUE) %>%
layout(title = 'Number of goals')
})
}
shinyApp(ui, server)
R plotly: how to observe whether a trace is hidden or shown through legend clicks with multiple plots
Does it help?
library(plotly)
library(shiny)
library(htmlwidgets)
js <- c(
"function(el, x){",
" el.on('plotly_legendclick', function(evtData) {",
" Shiny.setInputValue('trace', evtData.data[evtData.curveNumber].name);",
" });",
" el.on('plotly_restyle', function(evtData) {",
" Shiny.setInputValue('visibility', evtData[0].visible);",
" });",
"}")
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("legendItem")
)
server <- function(input, output, session) {
output$plot <- renderPlotly({
p <- plot_ly()
for(name in c("drat", "wt", "qsec"))
{
p = add_markers(p, x = as.numeric(mtcars$cyl), y = as.numeric(mtcars[[name]]), name = name)
}
p %>% onRender(js)
})
output$legendItem <- renderPrint({
trace <- input$trace
ifelse(is.null(trace),
"Clicked item will appear here",
paste0("Clicked: ", trace,
" --- Visibility: ", input$visibility)
)
})
}
shinyApp(ui, server)
EDIT
There's an issue with the previous solution when one double-clicks on a legend item. Here is a better solution:
library(plotly)
library(shiny)
library(htmlwidgets)
js <- c(
"function(el, x){",
" var d3 = Plotly.d3;",
" el.on('plotly_restyle', function(evtData) {",
" var out = {};",
" d3.select('g.legend').selectAll('.traces').each(function(){",
" var trace = d3.select(this)[0][0].__data__[0].trace;",
" out[trace.name] = trace.visible;",
" });",
" Shiny.setInputValue('traces', out);",
" });",
"}")
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("legendItem")
)
server <- function(input, output, session) {
output$plot <- renderPlotly({
p <- plot_ly()
for(name in c("drat", "wt", "qsec"))
{
p = add_markers(p, x = as.numeric(mtcars$cyl), y = as.numeric(mtcars[[name]]), name = name)
}
p %>% onRender(js)
})
output$legendItem <- renderPrint({
input$traces
})
}
shinyApp(ui, server)
If you have multiple plots, add the plot id in the legend selector, and use a function to generate the JavaScript code:
js <- function(i) {
c(
"function(el, x){",
" var id = el.getAttribute('id');",
" var d3 = Plotly.d3;",
" el.on('plotly_restyle', function(evtData) {",
" 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.visible;",
" });",
sprintf(" Shiny.setInputValue('traces%d', out);", i),
" });",
"}")
}
Then do p1 %>% onRender(js(1)), p2 %>% onRender(js(2)), ..., and you get the info about the traces visibility in input$traces1, input$traces2, ....
Another way is to pass the desired name in the third argument of the JavaScript function, with the help of the data argument of onRender:
js <- c(
"function(el, x, inputName){",
" var id = el.getAttribute('id');",
" var d3 = Plotly.d3;",
" el.on('plotly_restyle', function(evtData) {",
" 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.visible;",
" });",
" Shiny.setInputValue(inputName, out);",
" });",
"}")
p1 %>% onRender(js, data = "tracesPlot1")
p2 %>% onRender(js, data = "tracesPlot2")
Updating multiple data attributes with plotly
There are too many lists in your above args parameter.
Furthermore, when calling restyle without specifying the trace number you are restyling all traces.
If you want to restyle a single trace you need to provide its trace index:
library(plotly)
library(magrittr)
library(data.table)
DT <- data.table(x = c(1, 2, 10, 20), y = c(1, 1, 20, 20), z = rep(c("a", "b"), each = 2))
gg <- ggplot() + geom_point(data = DT, aes(x = x, y = y, color = z))
ggplotly(gg) %>%
layout(
updatemenus = list(
list(
buttons = list(
list(method = "restyle",
args = list(list(x = DT[z == "a", x], y = DT[z == "a", y]), 0L),
label = "a"),
list(method = "restyle",
args = list(list(x = DT[z == "b", x], y = DT[z == "b", y]), 1L),
label = "b")
)
)
)
)
I'm not sure what you are trying to achive.
If you want to show trace "a" when "a" is selected and trace "b" when "b" is selected this filter approach is problematic, as it completly removes traces (reduces the dataset) from the plot and once the trace is removed you can no longer restyle it.
If you just want to toggle the trace visibility you should use the visible parameter instead of modifying the data:
DT <- data.table(x = c(1, 2, 10, 20), y = c(1, 1, 20, 20), z = rep(c("a", "b"), each = 2))
gg <- ggplot() + geom_point(data = DT, aes(x = x, y = y, color = z))
ggplotly(gg) %>% style(visible = FALSE, traces = 2) %>%
layout(
updatemenus = list(
list(
buttons = list(
list(method = "restyle",
args = list(list(visible = c(TRUE, FALSE)), c(0, 1)),
label = "a"),
list(method = "restyle",
args = list(list(visible = c(FALSE, TRUE)), c(0, 1)),
label = "b")
)
)
)
)
PS: Plotly.restyle expects the trace count starting from 0 (JS) and style() from 1 (R)
Using addTraces/deleteTraces as done here would be another approach. However, if the data stays the same I guess toggling the visibility is less computationally intensive.
How to dynamically add AND remove overlay from plotly histogram in shiny
Edit: @FreyGeospatial clarified, that he wants to add/remove traces (I was confused of the wording using overlay).
The easiest way to dynamically add and remove traces is to create a data.frame in long format providing a category column.
In plot_ly you can use split or color to create traces based on this column.
To remove traces you can filter categories from a reactive dataset and re-render the plot:
library(shiny)
library(plotly)
DF <- data.frame(values = rnorm(2500), category = rep(LETTERS[1:5], each = 500))
ui <- fluidPage(
selectizeInput(inputId = "barmode",
label = "barmode",
choices = c("group", "overlay", "stack"),
selected = "overlay"),
selectizeInput(inputId = "category",
label = "category",
choices = unique(DF$category), selected = LETTERS[1:3], multiple = TRUE),
plotlyOutput("myPlot")
)
server <- function(input, output, session) {
filteredDF <- reactive({
DF[DF$category %in% input$category,]
})
output$myPlot <- renderPlotly({
fig <- plot_ly(data = filteredDF(), x = ~ values, split = ~ category, alpha = 0.6, type = "histogram")
fig <- fig %>% layout(barmode = input$barmode)
fig
})
}
shinyApp(ui, server)
As an alternative to re-rendering the plot you could use plotlyProxy and the addTraces JS function please see my answer here. This is faster than re-rendering but less intutive using plotly's R API.
Please run:
install.packages("listviewer")
schema()
and navigate:
object ► traces ► bar ► layoutAttributes ► barmode
To find the barmode description:
default: group
Determines how bars at the same location coordinate are displayed on
the graph. With stack, the bars are stacked on top of one another
With relative, the bars are stacked on top of one another, with
negative values below the axis, positive values above With group,
the bars are plotted next to one another centered around the shared
location. With overlay, the bars are plotted over one another, you
might need to an opacity to see multiple bars.
Related Topics
Importing Multiple Excel Files with Filenames in R
Replicate a List to Create a List-Of-Lists
List and Description of All Packages in Cran from Within R
R Cannot Allocate Memory Though Memory Seems to Be Available
User Defined Colour Palette in R and Ggpairs
How to Calculate the Distance Between Latitude and Longitude Along Rows of Columns in R
Matrix Display Without Row and Column Names
Customize Background to Highlight Ranges of Data in Ggplot
R - Delete Consecutive (Only) Duplicates
Ggplot2 and Geom_Density: How to Remove Baseline
How to Overlay an Image on to a Ggplot
How to Add Gaussian Curve to Histogram Created with Qplot
R: Why Kable Doesn't Print Inside a for Loop
How to Remove Na Data in Only One Columns
Trouble Installing and Loading Rjava on MAC El Capitan
Does Installing Blas/Atlas/Mkl/Openblas Will Speed Up R Package That Is Written in C/C++