存在现有代码

Question

我有一个复杂的闪亮应用程序（下面是一个简单的示例），它看起来像这样：

该应用程序使用户可以更改四个参数（selectInput）。较低的参数取决于较高的参数（例如month上的year，type和year上的month等）。一切正常，但事实是，当我更改一个参数时，另一个也会更改。在某些情况下需要它，但并非总是如此。如果先前选择的级别在新配置中不存在，则需要它，例如，当我遇到以下情况时，不应更改它。例如我为'AGD'和size选择了'medium'和year month类型，我展示了这种组合的奖品或其他内容。然后，我想将其与size type中的相同'RTV'进行比较，因此我更改了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)

Answer 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闪亮设置默认值以显示为数组中的第一个元素。但是，我们忘记将其存储在内存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)

在R中闪亮地更改链接的selectInputs后如何保持值？

1 个答案:

存在现有代码

解决方案

代码解决方案

编辑