Ändern des Werts des Elements basierend auf der ausgewählten Registerkarte in Shinydashboard

Question

Ich versuche, eine App mit shinydashboard zu erstellen, in der ein reaktives Element vorhanden ist, das den Wert basierend auf der ausgewählten Registerkarte ändert. Unten ist der Code, den ich in einer App.R-Datei habe. Es gibt eine if/else-Anweisung, die momentan auskommentiert ist und die ich verwenden möchte. Die if/else-Anweisung würde den Wert answer basierend auf der ausgewählten Registerkarte ändern.

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

Die Lösung dazu ist eigentlich sehr einfach und ziemlich elegant. Sie müssen sidebarMenu ein ID geben, sagen tab und input$tab wird berichten, welche Registerkarte ausgewählt ist.

Also, Ihre if-else Anweisung wie folgt aussehen wird:

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

---

Voll Beispiel:

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)