Question

我有一个闪亮的应用程序，我希望捕获用户点击哪个栏并将该值存储在反应表达式中，以便在其他地方引用以进行过滤。问题是当我切换标签时反应表达式重新运行，因此值不会在两个标签之间同步。

我有一个可重复的例子如下。

当你加载应用程序并单击山羊栏时，底部的选择会变为“山羊”，但如果你将标签更改为Bar2，则反应表达式会重新运行，因此会再次返回长颈鹿。因此，我最终为不同选项卡中的反应式表达式提供了两个单独的值。如果我在第一个选项卡上选择Goats，我希望在切换到Bar2选项卡时保留它，并且仅在我再次单击时更新。

请注意，我意识到我可以通过从event_data函数中删除source参数来解决此问题，但在我的应用程序中我有其他图表，我不希望用户能够点击这样我需要设置只有这些图表的来源。

library(shiny)
library(plotly)
library(ggplot2)
library(shinydashboard)

df_test <- data.frame(c("Giraffes","Goats"),c(1,4))
df_test <- setNames(df_test,c("species","amount"))

ui <- dashboardPage(

  dashboardHeader(title = "Click Example",
                  titleWidth = 300),
  dashboardSidebar(
    width = 300,
    sidebarMenu(
      menuItem("Tab", tabName = "tab")
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "tab",
              fluidRow(
                column(12, tabBox(
                  title = "",
                  id = "tabSet",
                  width = 12,
                  height = 500,
                  tabPanel("Bar1", plotlyOutput(outputId="bar_one")),
                  tabPanel("Bar2", plotlyOutput(outputId="bar_two"))
                )
                ),
                column(12,textOutput(outputId = "selection")))
      )
    )
  )
)

server <- function(input, output, session) {

  click_reactive = reactive({
    d <- event_data("plotly_click",source=input$tabSet)
    if (length(d) == 0) {species = as.vector(df_test$species[1])}
    else {species = as.character(d[4])}
    return(species)
  })

  output$bar_one <- renderPlotly({
    p <- plot_ly(data = df_test, x = ~amount, y = ~species, type = 'bar', orientation = 'h', source = "Bar1")
  })

  output$bar_two <- renderPlotly({
    p <- plot_ly(data = df_test, x = ~amount, y = ~species, type = 'bar', orientation = 'h', source = "Bar2")
  })


  output$selection <- renderText({
    species <- click_reactive()
    return(species)
  })

}

shinyApp(ui, server)

Answer 1

您需要将source更改为一个名称：

library(shiny)
library(plotly)
library(ggplot2)
library(shinydashboard)

df_test <- data.frame(c("Giraffes","Goats"),c(1,4))
df_test <- setNames(df_test,c("species","amount"))

ui <- dashboardPage(

  dashboardHeader(title = "Click Example",
                  titleWidth = 300),
  dashboardSidebar(
    width = 300,
    sidebarMenu(
      menuItem("Tab", tabName = "tab")
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "tab",
              fluidRow(
                column(12, tabBox(
                  title = "",
                  id = "tabSet",
                  width = 12,
                  height = 500,
                  tabPanel("Bar1", plotlyOutput(outputId="bar_one")),
                  tabPanel("Bar2", plotlyOutput(outputId="bar_two"))
                )
                ),
                column(12,textOutput(outputId = "selection")))
      )
    )
  )
)

server <- function(input, output, session) {

  v <- reactiveValues()

  observe({
    d <- event_data("plotly_click",source="Bar1")
    if (length(d) == 0) {species = as.vector(df_test$species[1])}
    else {species = as.character(d[4])}
    v$click <- species
  })

  output$bar_one <- renderPlotly({
    p <- plot_ly(data = df_test, x = ~amount, y = ~species, type = 'bar', orientation = 'h', source = "Bar1")
  })

  output$bar_two <- renderPlotly({
    p <- plot_ly(data = df_test, x = ~amount, y = ~species, type = 'bar', orientation = 'h', source = "Bar1")
  })

  output$selection <- renderText({
    v$click
  })

}

shinyApp(ui, server)

如何在Shiny中跨标签保持event_data？

1 个答案: