在 R 中更改链式选择输入后如何保持值?

How to keep values after changing chained selectInputs in shiny in R?

我有一个复杂的闪亮应用程序(这里是一个更简单的示例),看起来像这样:

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

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

我设法使用 observereactive 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")

  2. uiOutput()renderUI() 组合导致服务器提供一个 new selectInput 按钮,每次输入是变了。相反,我们可以简单地实例化一个静态 UI 元素并使用 updateSelectInput()

  3. 更新它

解决方案

要解决这个问题,首先要解决上面描述的 1) 和 2)。那么我们就需要引入内存的概念。服务器需要知道之前选择的是什么,以便我们可以在 selectInput 更新时将其设置为默认选项。我们可以将其存储为常规列表(年、月、类型和大小的变量)或使用 reactiveValues.

的反应列表

很高兴您为过滤选项确定了清晰的逻辑,从年 -> 月 -> 类型 -> 大小有一个清晰的层次结构。但是,每次更改 months 时都会为 typesize 生成新的输入。

我们现在想介绍一个简单的逻辑,其中输入选择仅修改内存 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)

编辑

正如下面评论中提到的,代码中存在错误。这是因为 then 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)