如何在 R Shiny App 中保留复选框中的值？

Question

我正在尝试创建一个闪亮的应用程序。在这个特定的应用程序中，我有一组单选按钮，其中选择一个将在下面显示一组选项作为复选框，选择另一个单选按钮将选择其他选项集。请在下面找到 UI 和服务器代码。

library(shiny)
library(shinydashboard)
library(shinyWidgets)

d <-
  data.frame(
    year = c(1995, 1995, 1995, 1996, 1996, 1996, 1997, 1997, 1997),
    Product_Name = c(
      "Table",
      "Chair",
      "Bed",
      "Table",
      "Chair",
      "Bed",
      "Table",
      "Chair",
      "Bed"
    ),
    Product_desc = c("X", "X", "X", "Y", "Y", "Y", "Z", "Z", "Z"),
    Cost = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
  )

ui <- shinyUI(fluidPage(
  useShinydashboard(),
  tabPanel(
    "Plot",
    sidebarLayout(
      sidebarPanel(
        radioButtons(
          "Choose",
          "Choose One",
          c("Year" = "p", "Numbers" = "l")
        ),
        uiOutput('checkbox'),
        #width = 2,
        position = "bottom"),
      mainPanel(uiOutput("graph"))

    )
  )
))

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

  output$graph <- renderUI({
    # create tabPanel with datatable in it
    req(input$year)
    tabPanel("Plots",
             fluidRow(lapply(as.list(paste0("plot", seq_along(input$year))), plotOutput)))

  })

  output$checkbox <- renderUI({
    if (input$Choose == "p") {
      checkboxGroupInput("Cross",
                         "Year",
                         choices = (unique(d$year)))

    } else{
      checkboxGroupInput("Cross_1",
                         "Numbers",
                         choices = c("1","2","3"))
    }

  })

}

shinyApp(ui, server)

现在我面临的挑战是当我选择“Year”单选按钮时，年份值显示为复选框，当我选择复选框时，主面板中会显示相应的图形（我没有在这里给出代码）。现在，当我选择“数字”单选按钮时，将显示正确的复选框选项。但是当我回到“年份”单选按钮时。已选中的复选框值不会保留，因此用户需要再次选中复选框以获取相应的图形。

在我的例子中，CheckboxGroupInput() 中的选择是动态的。所以我将无法在 UI() 中给出这个选择。我也尝试使用失败的 updateCheckboxGroupInput()。通过再次对代码进行一些调查，我了解到问题发生的地方是代码的这一部分。

  output$checkbox <- renderUI({
    if (input$Choose == "p") {
      checkboxGroupInput("Cross",
                         "Year",
                         choices = (unique(d$year)))

    } else{
      checkboxGroupInput("Cross_1",
                         "Numbers",
                         choices = c("1","2","3"))
    }

  })

即使选择了另一个单选按钮，请建议我如何保留复选框中的值。另请注意，每个单选按钮下的复选框选项将根据用户在上一个选项卡中选择的选项而变化。所以我使用观察功能来获取相应的复选框。

Answer 1

您可以将尝试保留的年份值存储为无功值。

  global <- reactiveValues(years = NULL)

  observeEvent(input$Cross, {
    global$years <- input$Cross
  })

然后你让你的动态用户界面依赖于反应值：

checkboxGroupInput(
  "Cross",
  "Year",
  choices = (unique(d$year)),
  selected = global$years
)

可重现的例子：

library(shiny)
library(shinydashboard)
library(shinyWidgets)

d <-
  data.frame(
    year = c(1995, 1995, 1995, 1996, 1996, 1996, 1997, 1997, 1997),
    Product_Name = c(
      "Table",
      "Chair",
      "Bed",
      "Table",
      "Chair",
      "Bed",
      "Table",
      "Chair",
      "Bed"
    ),
    Product_desc = c("X", "X", "X", "Y", "Y", "Y", "Z", "Z", "Z"),
    Cost = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
  )

ui <- shinyUI(fluidPage(
  useShinydashboard(),
  tabPanel(
    "Plot",
    sidebarLayout(
      sidebarPanel(
        radioButtons(
          "Choose",
          "Choose One",
          c("Year" = "p", "Numbers" = "l")
        ),
        uiOutput('checkbox'),
        #width = 2,
        position = "bottom"),
      mainPanel(uiOutput("graph"))

    )
  )
))

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

  global <- reactiveValues(years = NULL)

  observeEvent(input$Cross, {
    global$years <- input$Cross
  })

  output$graph <- renderUI({
    # create tabPanel with datatable in it
    req(input$year)
    tabPanel("Plots",
             fluidRow(lapply(as.list(paste0("plot", seq_along(input$year))), plotOutput)))

  })

  output$checkbox <- renderUI({
    if (input$Choose == "p") {
      checkboxGroupInput("Cross",
                         "Year",
                         choices = (unique(d$year)),selected = global$years)

    } else{
      checkboxGroupInput("Cross_1",
                         "Numbers",
                         choices = c("1","2","3"))
    }

  })

}

shinyApp(ui, server)

我认为 Ash 的shinyjs 隐藏/显示变体也很有趣。我还没有测试过它，但我假设你可以用动态用户界面替换静态用户界面（？）。