切换选项卡时保存 selectInput 的反应值

Question

我有一个 select 输入菜单，当我在 window 中打开某个选项卡时会出现该菜单。我对多个选项卡使用相同的 selectInput（在 renderMenu 内）。我想弄清楚如何保存在一个选项卡上选择的值，以便在切换选项卡时它将成为选择的值。在这里，例如，如果我选择 mtcars plots 选项卡和 select 'blue'，然后切换到 mtcars plots 2, 我希望 selected 颜色保持在 'blue' 而不是切换回红色的第一个选项。

是的，我知道我目前没有对颜色做任何事情，我会在稍后添加该用法。


library(shiny)
library(shinythemes)
library(shinydashboard)
library(tidyverse)

options(warn=-1)
data(iris)
data(mtcars)






# Define UI for application that draws a histogram
ui <- dashboardPage(

  
  dashboardHeader(),
  
  
  dashboardSidebar(
    sidebarMenu(id = "menume",

sidebarMenuOutput("colormenu"),
    menuItem("MTCARS", tabName = "mt", icon = icon("user-tie")),
    selectInput("mtvar", "Choose a variable", choices = colnames(mtcars)),
    menuItem("IRIS", icon = icon("envelope-open-text"), tabName = "ir"),
    selectInput("irvar", "Choose a variable", choices = colnames(iris))
    )
  ),
  
  dashboardBody(
    tabItems(
      tabItem("mt", uiOutput("mttabs")),
      tabItem("ir", uiOutput("irtabs"))
      )
      
    )
  )




# ui <- secure_app(ui, enable_admin = TRUE)


# Begin Server ----------------------------------------------

server <- function(input, output, session) {
  
output$colormenu = renderMenu({
  req((input$menume=="mt"& input$mtcarstabsall%in%c(2,3))||
        (input$menume=="ir"& input$iristabsall%in%c(5,6)))
  
  selectInput("colorme", "Choose a color", c("red", "yellow", "green", "blue", "black"))
  
  
  
  
})
  
  
  
  
  
  
  output$mttabs = renderUI({
  output$mtcarsplot1=renderPlot({
    
    
    ggplot(mtcars, aes_string(x = input$mtvar)) + stat_bin(nbins = 10)
    
    
  })
  
  output$mtcarsplot2=renderPlot({
    
    
    ggplot(mtcars, aes_string(x = input$mtvar)) + geom_density()
    })
 
    
  output$mtcarstable1=renderTable({
    tabme= head(mtcars, 5)
    tabme

  
  })
  
  
  
  
  tabsetPanel(id = "mtcarstabsall",
              
              
              tabPanel(id = "mttable","MTcars tables",value=1,
                       fluidRow(box(title = "Table 1",  tableOutput("mtcarstable1")))
              ),
              tabPanel(id = "mtplots","mtcars plots",value=2,
                       fluidRow(box(title = "Plot1", plotOutput("mtcarsplot1"))
                       )),
              tabPanel(id = "mtplots2","mtcars plots 2",value=3,
                       fluidRow(box(title = "Plot1", plotOutput("mtcarsplot2")))))
  
  
  })
  
  
  output$irtabs = renderUI({
  
  output$irisplot1=renderPlot({
    ggplot(iris, aes_string(x = input$irvar)) + stat_bin(nbins = 10)
    
    
  })
  
  output$irisplot2=renderPlot({
    ggplot(iris, aes_string(x = input$irvar)) + geom_density()
    
    
  })
  
  

  output$iristable1=renderTable({
    tabme = head(iris, 5)
    tabme
  })
  
  
  tabsetPanel(id = "iristabsall",
              tabPanel(id = "mttable","iris tables",value=4,
                       fluidRow(box(title = "Table 1",  tableOutput("iristable1")))
              ),
              tabPanel(id = "irisplots","iris plots",value=5,
                       fluidRow(box(title = "Plot1", plotOutput("irisplot1"))
                       )),
              tabPanel(id = "irisplots2","iris plots 2",value=6,
                       fluidRow(box(title = "Plot2", plotOutput("irisplot2"))
                       )))
  })
  
  
}

shinyApp(ui, server)

Answer 1

问题是每次切换标签时都会重新呈现颜色菜单，因此它会重置所选值。对于这样的事情，你想要做的只是 show/hide 元素而不是 add/remove 它（这是你目前正在做的 req()）。

您可以在菜单中使用 conditionalPanel 或将 shinyjs 包与下面类似的东西一起使用（记得将 shinyjs::useShinyjs() 添加到您的 ui，添加到 show/hide颜色菜单：

output$colormenu = renderMenu({
    # Remove the req
    selectInput("colorme", "Choose a color", c("red", "yellow", "green", "blue", "black"))
  })
  
observe({
    # Show/hide menu based on condition using shinyjs::toggle
    show_menu_condition <- (input$menume=="mt"& input$mtcarstabsall%in%c(2,3)) || (input$menume=="ir"& input$iristabsall%in%c(5,6))
    
    shinyjs::toggle("colormenu",
                    condition = show_menu_condition)
    
})

切换选项卡时保存 selectInput 的反应值

Save reactive value of selectInput when switching tabs

r

shiny

shinydashboard