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

Posted 2023-04-18

【中文标题】r Shiny 使 textInput 以先前的 selectInput 为条件

【英文标题】：r Shiny make textInput conditional on a previous selectInput

【发布时间】：2019-08-24 07:19:56

【问题描述】：

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

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

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

仅当他/她想的名字不在列表中时，我希望在他/她应该使用 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)

【参考方案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)

【讨论】：

谢谢您，Diego - 这与我正在寻找的解决方案非常非常接近！只有一个问题：是否可以在主面板上仅显示一个输出：如果名称来自列表，则显示它。但是如果输入了名称，那么显示输入的名称（但与输入框分开）？

我想你可以。您必须将用户键入的任何内容呈现回主面板。但是您希望输入框在哪里？在侧边栏面板或主面板中？

输入框的位置并不重要。侧边栏很好。

我更新了代码。我认为这可能是你想要的行为。

非常感谢，迭戈。它工作得很好！我可以问个问题吗？为什么我们必须在这里使用 updateSelectInput 而不仅仅是 SelectInput？

【参考方案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)

【讨论】：

对我来说只有一个警告，以前存在过。您可以添加 `req(input$chosen_name)` 来避免这种情况。更新后是否仍有警告/错误？

【参考方案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)

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

【讨论】：

非常感谢，Kyle，但它不起作用 - 它只显示左侧的下拉菜单，而右侧只显示文本 - 没有文本框。顺便说一句 - 控件的位置（侧边栏或主要疼痛）并不重要。

是的，我没有添加要输入的文本框。当您在框中输入内容时，您希望发生什么？您希望在输入名称后将其添加到 mynames 中吗？

如果用户想要输入的名称不在列表中的名称中，则应在用户键入名称的位置打开一个开放式框。然后应该在主面板上返回名称 - 无论该名称是如何创建的 - 使用下拉或使用打字。