Изменение значения элемента на основе выбранной вкладки в 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

Решение на самом деле очень просто и довольно элегантно. Вы должны дать a 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)