r Shiny 使 textInput 以先前的 selectInput 为条件

Question

您好，很抱歉可能是一个基本的 Shiny 问题。

在我的迷你闪亮应用中，我希望用户：

1. 使用 selectInput() 从预先存在的名称列表中选择一个名称。

2. 仅当他/她想的名字不在列表中时，我希望在他/她应该使用 textInput() 输入名字的地方出现一个新的小部件。

   李>

我被卡住了 - 我在 UI 端的 mainPanel 中的逐字文本输出语句不起作用。

感谢您的提示！

library(shiny)

ui = shinyUI(fluidPage(

  sidebarLayout(
    sidebarPanel(
      uiOutput("chosen_name", label = h4("Select one of the names:"))
    ),
    mainPanel(                       # Just shows what was selected
      # Next two lines don't work if uncommented:
      #  verbatimTextOutput('chosen_name')
      #  verbatimTextOutput("name_openend")
    )
  )
))

server = shinyServer(function(input, output, session) {

  # A vector of pre-existing names:
  mynames <- c("John", "Mary", "Jim")

  # Allow to select a name from the list of pre-existing names:
  output$chosen_name <- renderUI({
    selectInput('chosen_name',"Select a name:",
                choices = c("Name not on our list", mynames),
                selected = "Name not on our list")
  })

  # Open end box to enter name - if the name the user wants to enter is not on the list:
  output$name_openend <- renderUI({
    if (!output$chosen_name == 'Name not on our list') return(NULL) else {
      textInput("If the name you want is not on our list, type it here:")
    }
  })

})


shinyApp(ui = ui, server = server)

Answer 1

更新代码

library(shiny)

ui = shinyUI(fluidPage(

  sidebarLayout(
    sidebarPanel(
      selectInput("chosen_name", "select name", choices = ""),
      uiOutput("new")
    ),
    mainPanel(
      textOutput("chosen")
    )
  )
))

server = shinyServer(function(input, output, session) {

  # A vector of pre-existing names:
  mynames <- c("John", "Mary", "Jim")

  observe({
    updateSelectInput(session, inputId = "chosen_name", label = "Select a name:", choices = c(mynames, "Name not on our list"))
  })

  # Open end box to enter name - if the name the user wants to enter is not on the list:
  output$new <- renderUI({
    if (!input$chosen_name == 'Name not on our list') return(NULL) else {
      textInput("Not_on_list", "If the name you want is not on our list, type it here:")
    }
  })
  #
  # 
  # Allow to select a name from the list of pre-existing names:

  output$chosen <- renderText({
    if (!input$chosen_name == 'Name not on our list') {
    return(paste("Chosen name:", input$chosen_name))
    }
    else {
      return(paste("Chosen name:", input$Not_on_list))
    }
  })

})

shinyApp(ui = ui, server = server)

Answer 2

您对 ui 端的功能有点混淆： 如果您在服务器端使用renderUI()，则必须在ui 端使用uiOutput() 才能使其正常工作。此外，您应该避免使用相同的 id 两次。最后，对于 textinput，我添加了一个 id 和一个标签。

完整代码如下：

library(shiny)

ui = shinyUI(fluidPage(

  sidebarLayout(
    sidebarPanel(
      uiOutput("chosen_nm", label = h4("Select one of the names:"))
    ),
    mainPanel(                       # Just shows what was selected
      # Next two lines don't work if uncommented:
      uiOutput("name_openend")
    )
  )
))

server = shinyServer(function(input, output, session) {

  # A vector of pre-existing names:
  mynames <- c("John", "Mary", "Jim")

  # Allow to select a name from the list of pre-existing names:
  output$chosen_nm <- renderUI({
    selectInput('chosen_name',"Select a name:",
                choices = c("Name not on our list", mynames),
                selected = "Name not on our list")
  })

  output$chosen_name2 <- renderText({
    paste("The chosen name is: ", input$chosen_name)
  })

  # Open end box to enter name - if the name the user wants to enter is not on the list:
  output$name_openend <- renderUI({
    req(input$chosen_name)
    if (input$chosen_name == 'Name not on our list'){
      textInput("newName", "If the name you want is not on our list, type it here:")
    }else{
      verbatimTextOutput('chosen_name2')
    }
  })

})


shinyApp(ui = ui, server = server)

Answer 3

为了让它发挥作用，我需要删减一些东西。首先是侧边栏布局。这可能会弄乱您的 mainPanel。我相信你可以让它工作，只要确保 mainPanel 位于正确的位置并且没有被添加到 sidebarLayout，这可能是问题所在。

还有一些其他问题，例如 renderUI 和 UIOutput。也许其他人会添加一篇关于如何使用这些功能的帖子。另外，我添加了一个反应函数，所以 textOutput 会改变。

看看我的工作原理。

mynames <- c("John", "Mary", "Jim")
ui = shinyUI(
  fluidPage(

    sidebarPanel(
      selectInput('chosen_name',"Select a name:",
                  choices = c("Name not on our list", mynames),
                  selected = "Name not on our list")
    ),
    mainPanel(   
      textOutput('chosen_name2')

    )
  )
)

server = shinyServer(function(input, output, session) {

  # A vector of pre-existing names:
  selectedchosen_name <- reactive({
    if (input$chosen_name == 'Name not on our list') {return("Pick a name")} else {
      return("If the name you want is not on our list, type it here:")
    }
  })

  # Allow to select a name from the list of pre-existing names:
  output$chosen_name2 <- renderText({
    selectedchosen_name()
  })

  # Open end box to enter name - if the name the user wants to enter is not on the list:


})

shinyApp(ui = ui, server = server)

我删除了一些可能多余的部分，但现在它已被简化，因此您可以添加它。如果你有问题，就问吧。