r Блестящий сделать textInput условным на предыдущем selectInput

Question

Здравствуйте и извините за то, что может быть основным блестящим вопросом.

В моем мини-приложении Shiny я хочу, чтобы пользователь:

1. Выберите имя из списка ранее существующих имен, используя selectInput ().

2. Только если имя, которое он / она имеет в виду, отсутствует в списке, я бы хотел, чтобы появился новый виджет, где он / она должен вводить имя с помощью textInput ().

Я застрял - мои операторы verbatimTextOutput внутри 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

Вы немного перепутали функции на стороне пользовательского интерфейса: Если вы используете renderUI() на стороне сервера, вы должны будете использовать uiOutput() на стороне пользовательского интерфейса, чтобы это работало. Также вам следует избегать использования одного и того же идентификатора дважды. Наконец, для ввода текста я добавил идентификатор и метку.

Полный код:

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 2

Обновлен код

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 3

Было несколько вещей, которые мне нужно было вырезать, чтобы это работало.Сначала была боковая панель Layout.Это могло быть с вашей главной панелью.Я уверен, что вы можете заставить это работать, просто убедитесь, что 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)

Я удалил некоторые части, которые могут быть избыточными, но сейчас это упрощено, так что вы можете добавить к ним.Если у вас есть какие-либо вопросы просто спросить.