I am building an app that allows a user to dynamically add and remove traces on a plotly graph using selectInput.
I have tried to play around with plotlyProxy () and plotlyProxyInvoke () from plotly package to no avail.
Below is my rudimental code :
library(shiny)
library(shinydashboard)
library(plotly)
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,
selectInput(
inputId="Player",
selected = NULL, multiple = TRUE,
label=" Choose Player",
choices=c("Messi", "Suarez", "Ronaldo" )),
selectInput(
inputId="Delete",
selected = NULL, multiple = TRUE,
label=" Choose Player",
choices=c("Messi", "Suarez", "Ronaldo" )),
submitButton("Select")
)
),
column( width=9,
tabBox(
width="100%",
tabPanel("tab1",
plotlyOutput("Plot1")
)))))))
server <- function(input, output, session) {
output$Plot1 <- renderPlotly({
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")
)
plot_ly(goals, x = ~Year, y = ~Number, type = 'scatter', mode = 'lines', color = ~input$Player )%>% layout(showlegend = TRUE)%>%
layout(title = 'Number of goals')
})
# plotly.addTraces
observeEvent(input$Player, {
plotlyProxy("Plot1", session) %>%
plotlyProxyInvoke("addTraces", list(x = ~Year,
y = ~Number,
type = 'scatter',
mode = 'lines'))
})
# plotly.deleteTraces
observeEvent(input$Delete, {
plotlyProxy("Plot1", session) %>%
plotlyProxyInvoke("deleteTraces")
})
}
shinyApp(ui, server)
Is there a way to use the plotlyProxyInvoke() dynamically to add and remove traces without having to hardcode the traces using addTrace() ?
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)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With