r - Shiny :基于先前过滤器的自动 SelectInput 值更新

Question

我正在创建一个 Shiny 的应用程序。目标是最初从数据集创建自定义过滤器。创建该过滤器后，我希望其中一列中的选项在 selectInput 选项卡中动态更改。我遇到的问题是，当我在 Shiny 应用程序的 ui 部分引用新数据集时，它无法识别该数据框。下面是我的 ui 和服务器部件，但我需要手动添加 selectInput 值。我想让它自动改变。

原始应用程序:

用户界面

# ui.R

library(shiny)
shinyUI(fluidPage(
  titlePanel("Language Selection"),
  sidebarLayout(
    sidebarPanel(
      helpText("The goal from this is to have the select tab automatically update with the language after selecting the artist"),

      helpText("Select your artist"),

      textInput("artistId", "Artist", value = "", width = NULL, 
            placeholder = NULL),

      actionButton("goButton", "Submit Artist"),

      helpText("Based on the artist you selected, now select the Language below to display the numberlist in the main panel."),

      selectInput("selectinputid", "Language to Select:", choices = c("English" = "English", "French" = "French", "German" = "German")),
      ##selectInput("selectinputid", "Language to Select:", choices = artist_filter_complete$Language),
      actionButton("goButton1", "Submit Language")),
mainPanel(
        tableOutput("result")
      )
    )
  )) 

服务器

##server
library(shiny)

Artist <- c("A1", "A1", "A1", "A1", "A1", "A1", "A1", "A1", "A1", "A1", "A1", "A1", 
            "A2", "A2", "A2", "A2", "A2", "A2", "A2", "A2", "A2", "A2", "A2", "A2", 
            "A3", "A3", "A3", "A3", "A3", "A3", "A3", "A3", "A3", "A3", "A3", "A3")

Language <- c("Spanish", "Spanish", "Spanish", "Spanish", "Spanish", "German", "German", "German", "French", "French", "French", "French",
              "Italian", "Italian", "Italian", "Italian", "Italian", "Polish", "Polish", "Polish", "Israeli", "Israeli", "Israeli", "Israeli",
              "English", "English", "English", "English", "English", "Armenian", "Armenian", "Armenian", "Bengali", "Bengali", "Bengali", "Bengali")

NumberList <- c("uno", "dos", "tres", "cuatro", "cinco", "einz", "zwei", "drei", "un", "deux", "trois", "quatre",
                "uno", "due", "tre", "quattro", "cinque", "jeden", "dwa", "trzy", "achat", "shtaim", "shalosh", "arba",
                "one", "two", "three", "four", "five", "mek", "yerku", "yerek", "shoonno", "ek", "dui", "tin")

df <- data.frame(Artist, Language, NumberList)


shinyServer(function(input, output) {
  output$result <- renderTable({
    randomVals <- eventReactive(input$goButton, input$artistId)
    artist_filter <- c(randomVals())
    artist_filter_complete <- filter(df, Artist == artist_filter)
    randomVals2 <- eventReactive(input$goButton1, input$selectinputid)
    target <- c(randomVals2())
    result_final<-filter(artist_filter_complete, Language %in% target)
    result_final
  })
}
)

这是我的输出:

如何使语言 selectInput 自动/动态更改为所有可能的语言只有我最初输入的那个艺术家？我的尝试在 ui 部分被注释掉了，但是当我运行它时调用:

##selectInput("selectinputid", "Language to Select:", choices = artist_filter_complete$Language),

它声明找不到该数据框:artist_filter_complete

Answer 1

我在这里更改了一些东西并删除了一些我认为在这里不需要的按钮，你自己看看是否对你有意义:

library(shiny)

Artist <- c("A1", "A1", "A1", "A1", "A1", "A1", "A1", "A1", "A1", "A1", "A1", "A1", 
            "A2", "A2", "A2", "A2", "A2", "A2", "A2", "A2", "A2", "A2", "A2", "A2", 
            "A3", "A3", "A3", "A3", "A3", "A3", "A3", "A3", "A3", "A3", "A3", "A3")

Language <- c("Spanish", "Spanish", "Spanish", "Spanish", "Spanish", "German", "German", "German", "French", "French", "French", "French",
              "Italian", "Italian", "Italian", "Italian", "Italian", "Polish", "Polish", "Polish", "Israeli", "Israeli", "Israeli", "Israeli",
              "English", "English", "English", "English", "English", "Armenian", "Armenian", "Armenian", "Bengali", "Bengali", "Bengali", "Bengali")

NumberList <- c("uno", "dos", "tres", "cuatro", "cinco", "einz", "zwei", "drei", "un", "deux", "trois", "quatre",
                "uno", "due", "tre", "quattro", "cinque", "jeden", "dwa", "trzy", "achat", "shtaim", "shalosh", "arba",
                "one", "two", "three", "four", "five", "mek", "yerku", "yerek", "shoonno", "ek", "dui", "tin")

df <- data.frame(Artist, Language, NumberList)

ui <- shinyUI(
  fluidPage(
    titlePanel("Language Selection"),
    sidebarLayout(
      sidebarPanel(
        helpText("The goal from this is to have the select tab automatically update with the language after selecting the artist"),

        helpText("Select artistId artist"),
        selectInput("artistId", "Artist", choices = unique(df$Artist)),
        helpText("Based on the artist you selected, now select the Language below to display the numberlist in the main panel."),

        selectInput("selectinputid", "Language to Select:", choices = unique(df$Language)),
        actionButton("goButton1", "Submit Language")),
      mainPanel(
        tableOutput("result")
      )
    )
  )
)

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

  observeEvent(D1(),{
    updateSelectInput(session, "selectinputid", "Language to Select:",  choices = unique(D1()$Language),selected = unique(D1()$Language)[1])
  })

  D1  <- reactive({
    df[df$Artist %in% input$artistId,]
  })

  D2 <- eventReactive(input$goButton1,{
    D1()[D1()$Language %in% input$selectinputid,]
  })

  output$result <- renderTable({
    D2()
  })
}

shinyApp(ui, server)

编辑:修改为请求输入的文本

library(shiny)

Artist <- c("A1", "A1", "A1", "A1", "A1", "A1", "A1", "A1", "A1", "A1", "A1", "A1", 
            "A2", "A2", "A2", "A2", "A2", "A2", "A2", "A2", "A2", "A2", "A2", "A2", 
            "A3", "A3", "A3", "A3", "A3", "A3", "A3", "A3", "A3", "A3", "A3", "A3")

Language <- c("Spanish", "Spanish", "Spanish", "Spanish", "Spanish", "German", "German", "German", "French", "French", "French", "French",
              "Italian", "Italian", "Italian", "Italian", "Italian", "Polish", "Polish", "Polish", "Israeli", "Israeli", "Israeli", "Israeli",
              "English", "English", "English", "English", "English", "Armenian", "Armenian", "Armenian", "Bengali", "Bengali", "Bengali", "Bengali")

NumberList <- c("uno", "dos", "tres", "cuatro", "cinco", "einz", "zwei", "drei", "un", "deux", "trois", "quatre",
                "uno", "due", "tre", "quattro", "cinque", "jeden", "dwa", "trzy", "achat", "shtaim", "shalosh", "arba",
                "one", "two", "three", "four", "five", "mek", "yerku", "yerek", "shoonno", "ek", "dui", "tin")

df <- data.frame(Artist, Language, NumberList)

ui <- shinyUI(
        fluidPage(
                titlePanel("Language Selection"),
                sidebarLayout(
                        sidebarPanel(
                                helpText("The goal from this is to have the select tab automatically update with the language after selecting the artist"),

                                helpText("Select artistId artist"),
                                textInput("artistId", "Artist", value = "", width = NULL, placeholder = NULL),
                                helpText("Based on the artist you selected, now select the Language below to display the numberlist in the main panel."),

                                selectInput("selectinputid", "Language to Select:", choices = unique(df$Language)),
                                actionButton("goButton1", "Submit Language")),
                        mainPanel(
                                tableOutput("result")
                        )
                )
        )
)

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

        observeEvent(D1(),{
                updateSelectInput(session, "selectinputid", "Language to Select:",  choices = unique(D1()$Language),selected = unique(D1()$Language)[1])
        })

        D1  <- reactive({
                df[df$Artist %in% input$artistId,]
        })

        D2 <- eventReactive(input$goButton1,{
                D1()[D1()$Language %in% input$selectinputid,]
        })

        output$result <- renderTable({
                D2()
        })
}

shinyApp(ui, server)