根据 shinydashboard 中的选定选项卡更改元素的值

Question

我正在尝试使用 shinydashboard 创建一个应用程序，其中有一个反应元素会根据选择的选项卡更改值。下面是我在 app.R 文件中得到的代码。目前有一个 if/else 语句被注释掉了，我希望能够使用它。 if/else 语句将根据选择的选项卡更改 answer 的值。

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title='Title'),
  dashboardSidebar(
    sidebarMenu(
      menuItem('Models', tabName='Models',
        menuSubItem('Model1', tabName='Model1'),
        menuSubItem('Model2', tabName='Model2')
      ),
      tags$head(tags$script(HTML('$(document).ready(function() {$(".treeview-menu").css("display", "block");})')))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName='Model1',
        h1("Model 1"),
        verbatimTextOutput('out1')
      ),
      tabItem(tabName='Model2',
        h1("Model 2"),
        verbatimTextOutput('out2')
      )
    )
  )
)

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

  answer <- reactive({
    #if(selected tabName=='Model1'){
      answer <- 1
    #} else if(selected tabName=='Model2'){
      answer <- 2
    #}
    return(answer)
  })

  output$out1 <- renderPrint(answer())
  output$out2 <- renderPrint(answer())
}

shinyApp(ui, server)

Answer 1

这个问题的解决方案其实很简单也很优雅。你必须给 sidebarMenu 一个 ID，比如说，tab 和 input$tab 将报告选择了哪个选项卡。

因此，您的 if-else 语句将如下所示：

if (input$tab == 'Model1'){
      answer <- 1
    } else if (input$tab == 'Model2'){
      answer <- 2
    }

完整示例：

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title='Title'),
  dashboardSidebar(
    sidebarMenu(id = "tab", # added ID 
      menuItem('Models', tabName='Models',
               menuSubItem('Model1', tabName='Model1'),
               menuSubItem('Model2', tabName='Model2')
      ),
      tags$head(tags$script(HTML('$(document).ready(function() {$(".treeview-menu").css("display", "block");})')))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName='Model1',
              h1("Model 1"),
              verbatimTextOutput('out1')
      ),
      tabItem(tabName='Model2',
              h1("Model 2"),
              verbatimTextOutput('out2')
      )
    )
  )
)

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

  observe({
    print(input$tab)
  })

  answer <- reactive({
    if (input$tab == 'Model1'){
      answer <- 1
    } else if (input$tab == 'Model2'){
      answer <- 2
    }
    return(answer)
  })

  output$out1 <- renderPrint(answer())
  output$out2 <- renderPrint(answer())
}

shinyApp(ui, server)

根据 shinydashboard 中的选定选项卡更改元素的值

Changing value of element based on selected tab in shinydashboard

r

shiny

shinydashboard