Я создаю приложение, которое позволяет пользователю динамически добавлять и удалять следы на графическом графике с помощью selectInput.
Я попытался поиграть с plotlyProxy () и plotlyProxyInvoke () из пакета plotly, но безрезультатно.
Ниже мой элементарный код:
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)
Есть ли способ динамически использовать plotlyProxyInvoke () для добавления и удаления следов без необходимости их жесткого кодирования с помощью addTrace ()?
@SeGa Спасибо. Я проверю ваше решение.
Вот решение, позволяющее избежать plotlyProxy()
путем фильтрации файла data.frame перед его передачей в plot_ly
:
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,
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) {
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")
)
filteredGoals <- reactive({
goals[goals$Name %in% input$Player, ]
})
plot_ly(filteredGoals(), x = ~Year, y = ~Number, type = 'scatter', mode = 'lines', color = ~Name)%>% layout(showlegend = TRUE) %>%
layout(title = 'Number of goals')
})
}
shinyApp(ui, server)
Для будущих читателей: здесь - решение, использующее plotlyProxy()
Вы можете легко добавить следы, но удалить их немного сложнее, так как вы можете удалить следы только по индексам. Существует текущая проблема plotly-github, связанная с этим, которая также связана с вопрос о переполнении стека, которую я пытался решить, но она работает не так, как ожидалось.