1

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

在此处输入图像描述

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

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

我设法使用observeand为两个依赖项做到了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)
4

1 回答 1

3

现有代码的问题

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

  1. c("big", "small", "medium", "big", "medium")并不是c("big", "small", "medium", "big", "miedium")

  2. 每次输入更改时，anduiOutput()组合都会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 = NULLShiny 将默认值设置为显示为数组中的第一个元素。但是我们忘记将其存储在内存中，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)
于 2019-01-10T18:11:07.907 回答