在 R 中更改链式 selectInputs 后如何保持值？

Posted 2023-03-24

技术标签:

【中文标题】在 R 中更改链式 selectInputs 后如何保持值？【英文标题】：How to keep values after changing chained selectInputs in shiny in R? 【发布时间】：2019-06-05 07:46:28 【问题描述】：

我有一个复杂的闪亮应用（这里是一个更简单的例子），看起来像这样：

该应用程序让用户可以更改四个参数 (selectInput)。较低的参数取决于较高的参数（例如，year 上的month、year 上的type 和month 等等）。一切正常，但事实是，当我更改一个参数时，另一个参数也会更改。在某些情况下需要它，但并非总是如此。当新配置中不存在之前选择的级别时需要它，但例如当我遇到以下情况时，它不应该更改。前任。我为一些year 和month 选择了'AGD' 和size 'medium' 类型，然后我展示了这个组合的奖品或其他东西。然后我想将它与type 'RTV' 中的相同size 进行比较，所以我更改了type 参数。一切正常，但 size 更改为 'big' 而我希望它仍然是 'medium'。我可以再点击一次，但有什么用？那就很不方便了……

你知道如何处理这样的问题吗？

我设法使用observe 和reactive values 为两个依赖项做到了这一点，但是对于四个依赖项它不起作用。

这是我的代码：

library("shiny")
library("plotly")
library("dplyr")

data <- data.frame(year = rep(c(rep(2018, 6), rep(2019, 11)), each = 5),
                   month = rep(c(7:12, 1:11), each = 5),
                   type = rep(c("AGD", "AGD", "AGD", "RTV", "RTV"), 6 + 11),
                   value = sample(1:100, 85),
                   size = rep(c("big", "small", "medium", "big", "miedium"), 6 + 11))

ui <- fluidPage(

    sidebarLayout(
        sidebarPanel(

            uiOutput("year"),
            uiOutput("month"),
            uiOutput("type"),
            uiOutput("size")

        ),

        mainPanel(

        )
    )
)

server <- function(input, output, session) 

    output$year <- renderUI(

        year <- data %>%
            select(year) %>%
            unique()

        selectInput("year",
                    "YEAR",
                    year$year,
                    selected = max(year$year))

    )

    output$month <- renderUI(

        month <- data %>%
            filter(year == input$year) %>%
            select(month) %>%
            unique() %>%
            arrange()

        selectInput("month",
                    "MONTH",
                    month$month,
                    selected = max(month$month))

    )

    output$type <- renderUI(

        type <- data %>%
            filter(year == input$year,
                   month == input$month) %>%
            select(type) %>%
            unique() %>%
            arrange()

        selectInput("type",
                    "TYPE",
                    type$type,
                    selected = type$type[1])

    )

    output$size <- renderUI(

        size <- data %>%
            filter(year == input$year,
                   month == input$month,
                   type == input$type) %>%
            select(size) %>%
            unique() %>%
            arrange()

        selectInput("size",
                    "SIZE",
                    size$size,
                    selected = size$size[1])

    )



shinyApp(ui = ui, server = server)

【问题讨论】：

【参考方案1】：

现有代码的问题

这里的代码有几个问题，解决方案允许我们将内存的概念引入应用程序。首先，我想立即解决两个问题。

c("big", "small", "medium", "big", "medium") 而不是c("big", "small", "medium", "big", "miedium")

uiOutput() 和 renderUI() 组合会导致服务器在每次输入更改时提供新 selectInput 按钮。相反，我们可以简单地实例化一个静态 UI 元素并使用 updateSelectInput()

解决方案

要解决这个问题，我们首先修复上面描述的 1) 和 2)。然后我们需要引入内存的概念。服务器需要知道之前选择的内容，以便我们在更新selectInput 时将其设置为默认选项。我们可以将其存储为常规列表（年、月、类型和大小的变量）或使用reactiveValues 的反应式列表。

您已经为过滤选项确定了清晰的逻辑，这很好，从年-> 月-> 类型-> 大小有一个清晰的层次结构。但是，每次更改 months 时都会为 type 和 size 生成一个新输入。

我们现在想介绍一个简单的逻辑，其中输入选择只修改内存selected_vals。然后内存的变化会触发其他输入的更新。这在下面的解决方案中得到了最好的体现。

代码解决方案

library("shiny")
library("plotly")
library("dplyr")

data <- data.frame(year = rep(c(rep(2018, 6), rep(2019, 11)), each = 5),
                   month = rep(c(7:12, 1:11), each = 5),
                   type = rep(c("AGD", "AGD", "AGD", "RTV", "RTV"), 6 + 11),
                   value = sample(1:100, 85),
                   size = rep(c("big", "small", "medium", "big", "medium"), 6 + 11))

years = data %>% arrange(year) %>% .$year %>% unique(.)
month = data %>% arrange(month) %>% .$month %>% unique(.)
type = data %>% arrange(type)%>% .$type %>% unique(.)
size = data %>% arrange(size) %>%.$size %>% unique(.)

ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(
            selectInput("year","Year",choices = years,selected = 2018),
            selectInput("month","Month",choices = month,selected = 7),
            selectInput("type","Type",choices = type,selected = "AGD"),
            selectInput("size","Size",choices = size,selected = "big") 
    ),
    mainPanel(

    )
  )
)

server <- function(input, output, session) 

  #------- Initialize the Memory ----------
  selected_vals = reactiveValues(year = 2019,month = 7, type = "AGD", size = "big")

  #------ Whenever any of the inputs are changed, it only modifies the memory----
  observe(
    req(input$year,input$month,input$type,input$size)

    selected_vals$year <- input$year
    selected_vals$month <- input$month
    selected_vals$type <- input$type
    selected_vals$size <- input$size
  )

  #------ Update all UI elements using the values stored in memory ------
  observe(
    year <- data %>%
      select(year) %>%
      unique()

    updateSelectInput(session,"year",choices = year$year,selected = selected_vals$year)

  )

  observe(

      month <- data %>%
        filter(year == selected_vals$year) %>%
        select(month) %>%
        unique() %>%
        arrange()

      #Check if the value is in memory, if not return NULL (it defaults to the first element)
      if (selected_vals$month %in% month$month) displayVal = selected_vals$month else displayVal = NULL

      updateSelectInput(session,"month",choices =  month$month,selected = displayVal)

  )

  observe(

    type <- data %>%
      filter(year == selected_vals$year,
             month == selected_vals$month) %>%
      select(type) %>%
      unique() %>%
      arrange()

    #Check if the value is in memory, if not return NULL (it defaults to the first element)
    if (selected_vals$type %in% type$type) displayVal = selected_vals$type else displayVal = NULL

    updateSelectInput(session,"type",choices = type$type,selected = displayVal)

  )

  observe(

    size <- data %>%
      filter(year == selected_vals$year,
             month == selected_vals$month,
             type == selected_vals$type) %>%
      select(size) %>%
      unique() %>%
      arrange()

    #Check if the value is in memory, if not return NULL (it defaults to the first element)
    if(selected_vals$size %in% size$size) displayVal = selected_vals$size else displayVal = NULL

    updateSelectInput(session,"size",choices = size$size,selected = displayVal)
  )




shinyApp(ui = ui, server = server)

编辑

正如下面评论中提到的，代码中有一个错误。这是因为displayVal = NULL shiny 将默认值设置为显示为数组中的第一个元素。但是我们忘记将其存储在内存中，selected_vals。下面的代码解决了这个问题。

library("shiny")
library("plotly")
library("dplyr")

data <- data.frame(year = rep(c(rep(2018, 6), rep(2019, 11)), each = 5),
                   month = rep(c(7:12, 1:11), each = 5),
                   type = rep(c("AGD", "AGD", "AGD", "RTV", "RTV"), 6 + 11),
                   value = sample(1:100, 85),
                   size = rep(c("big", "small", "medium", "big", "medium"), 6 + 11))

years = data %>% arrange(year) %>% .$year %>% unique(.)
month = data %>% arrange(month) %>% .$month %>% unique(.)
type = data %>% arrange(type)%>% .$type %>% unique(.)
size = data %>% arrange(size) %>%.$size %>% unique(.)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("year","Year",choices = years,selected = 2018),
      selectInput("month","Month",choices = month,selected = 7),
      selectInput("type","Type",choices = type,selected = "AGD"),
      selectInput("size","Size",choices = size,selected = "big") 
    ),
    mainPanel(

    )
  )
)

server <- function(input, output, session) 

  #------- Initialize the Memory ----------
  selected_vals = reactiveValues(year = 2019,month = 7, type = "AGD", size = "big")

  #------ Whenever any of the inputs are changed, it only modifies the memory----
  observe(
    req(input$year,input$month,input$type,input$size)

    selected_vals$year <- input$year
    selected_vals$month <- input$month
    selected_vals$type <- input$type
    selected_vals$size <- input$size
  )

  #------ Update all UI elements using the values stored in memory ------
  observe(
    year <- data %>%
      select(year) %>%
      unique()

    updateSelectInput(session,"year",choices = year$year,selected = selected_vals$year)

  )

  observe(

    month <- data %>%
      filter(year == selected_vals$year) %>%
      select(month) %>%
      unique() %>%
      arrange()

    #Check if the value is in memory, if not return NULL (it defaults to the first element)
    if (selected_vals$month %in% month$month)
      displayVal = selected_vals$month
    else
      displayVal = NULL
      selected_vals$month = month$month[1]
     

    updateSelectInput(session,"month",choices =  month$month,selected = displayVal)

  )

  observe(

    type <- data %>%
      filter(year == selected_vals$year,
             month == selected_vals$month) %>%
      select(type) %>%
      unique() %>%
      arrange()

    #Check if the value is in memory, if not return NULL (it defaults to the first element)
    if (selected_vals$type %in% type$type)
      displayVal = selected_vals$type
    else
      displayVal = NULL
      selected_vals$type = tpye$type[1]
    

    updateSelectInput(session,"type",choices = type$type,selected = displayVal)

  )

  observe(

    size <- data %>%
      filter(year == selected_vals$year,
             month == selected_vals$month,
             type == selected_vals$type) %>%
      select(size) %>%
      unique() %>%
      arrange()

    #Check if the value is in memory, if not return NULL (it defaults to the first element)
    if(selected_vals$size %in% size$size)
      displayVal = selected_vals$size
     else
      displayVal = NULL
      selected_vals$size = size$size[1]
     

    updateSelectInput(session,"size",choices = size$size,selected = displayVal)
  )


shinyApp(ui = ui, server = server)

【讨论】：

感谢您的解决方案 - 我会测试一下。我发现这种解决方案不起作用的一种情况（当我将month 更改为12 然后将year 更改为2019 然后type 和size 的值消失）。你知道为什么会发生这样的事情吗？感谢@Marta 的评论。是的，这个错误确实存在，我进行了修改来解决这个问题。

以上是关于在 R 中更改链式 selectInputs 后如何保持值？的主要内容，如果未能解决你的问题，请参考以下文章

未选择值时如何更改 R Shiny 'selectInput' 值选择显示空间背景颜色？

如何使用 actionButton 更改 R Shiny 中 selectInput 上的选定值？

R Shiny、Leaflet 的问题 --> SelectInput 以更改下拉菜单中的选择

R / Shiny selectInput小部件大小

如何使用 selectInput 从 R 中的数据框中选择特定列？

如何在 R Markdown 中创建条件 selectInput 小部件？