Question

我正在尝试动态更新闪亮应用程序的下拉列表中的值。因此，如果在下拉列表中选择了值，则应该更新产品系列下拉列表中的值。我在下面的代码中缺少什么。它似乎确实在拾取任何值，并且仅从else条件获取值。

library(shiny)
library(shinyWidgets)

# Define the UI
ui <- bootstrapPage(
  column(3, uiOutput("class_level")),
  column(3,uiOutput("product"))
)


# Define the server code
server <- function(input, output) {

  output$class_level <- renderUI({
    selectInput(
      "selected_class",
      label = h4("Classification Level"),
      choices = list(
        "Brand" = "Brand",
        "Brand1" = "Brand1",
        "Brand2" = "Brand2"
      ),
      selected = "Brand"
    )
  })


  getFlavor <- reactive({

    if (input$selected_class =="Brand") {
      c( "a " = "a",
         "b" = "b",
         "c" = "c"
        )
    }
    else if  (input$selected_class =="Brand1")
    {
      c(
        "1" = "1",
        "2" = "2",
        "3" = "3"
      )
    }
    else   (input$selected_class =="Brand2")
    {
      c(
        "x" = "x",
        "y" = "y",
        "z" = "z"
      )
    }

  })

  output$product <- renderUI({
    pickerInput(
      "selected_product",
      label = h4("Product Family"),
      choices = as.list(getFlavor()),
      selected = as.list(getFlavor()),
      options = list(
        `deselect-all-text` = "None",
        `select-all-text` = "Total",
        `actions-box` = TRUE
      ),
      multiple = F,
      width = "100%"
    )
  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server)

Answer 1

您需要返回if语句中的内容。您可以使用return

library(shiny)
library(shinyWidgets)

# Define the UI
ui <- bootstrapPage(
  column(3, uiOutput("class_level")),
  column(3,uiOutput("product"))
)


# Define the server code
server <- function(input, output) {

  output$class_level <- renderUI({
    selectInput(
      "selected_class",
      label = h4("Classification Level"),
      choices = list(
        "Brand" = "Brand",
        "Brand1" = "Brand1",
        "Brand2" = "Brand2"
      ),
      selected = "Brand"
    )
  })


  getFlavor <- reactive({

    if (input$selected_class =="Brand") {
      return(c( "a " = "a",
         "b" = "b",
         "c" = "c"
        ))
    }
    else if  (input$selected_class =="Brand1")
    {
      return(c(
        "1" = "1",
        "2" = "2",
        "3" = "3"
      ))
    }
    else   (input$selected_class =="Brand2")
    {
      return(
      c(
        "x" = "x",
        "y" = "y",
        "z" = "z"
      ))
    }

  })

  output$product <- renderUI({
    pickerInput(
      "selected_product",
      label = h4("Product Family"),
      choices = as.list(getFlavor()),
      selected = as.list(getFlavor()),
      options = list(
        `deselect-all-text` = "None",
        `select-all-text` = "Total",
        `actions-box` = TRUE
      ),
      multiple = F,
      width = "100%"
    )
  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server)

Answer 2

您的方法有些复杂，updatePickerInput将使您的工作更轻松。这是一种可能的实现方式：

library(shiny)
library(shinyWidgets)

ui <- bootstrapPage(

  column(
    width = 3, 
    selectInput(
      inputId = "selected_class",
      label = h4("Classification Level"),
      choices = c("Brand", "Brand1", "Brand2"),
      selected = "Brand"
    )
  ),
  column(
    width = 3, 
    pickerInput(
      inputId = "selected_product",
      label = h4("Product Family"),
      choices = c("a", "b", "c"),
      options = list(
        `deselect-all-text` = "None",
        `select-all-text` = "Total",
        `actions-box` = TRUE
      ),
      width = "100%"
    )
  )
)

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

  observeEvent(input$selected_class, {
    if(input$selected_class =="Brand") {
      choices <- c("a", "b", "c")
    } else if(input$selected_class =="Brand1") {
      choices <- c("1", "2", "3")
    } else {
      choices <- c("x", "y", "z")
    }
    updatePickerInput(
      session,
      inputId = "selected_product",
      choices = choices
    )
  })

}

shinyApp(ui = ui, server = server)

动态更新R Shiny中的下拉列表值

2 个答案: