允许用户在 selectizeInput 中更改输入选择

Question

这个应用程序正在创建一个标准化名称的向量，我在给定一些用户输入（通道数和复制数）的情况下创建该向量。给定通道数 = 4 且重复次数 = 1 的标准名称示例如下：

c("rep1_C0","rep1_C1","rep1_C2","rep1_C3")

我想允许用户用他们自己的自定义值替换选择的值。例如，将输入“rep1_C0”更改为“Control_rep1”。然后让它更新有问题的反应向量。这是我的代码：

library(shiny)

ui <- shinyUI(fluidPage(


   sidebarLayout(
      sidebarPanel(
        fluidRow(column(5, numericInput("chans","# Channels",value = 4, min = 1)),
                 column(5, numericInput("reps","# Replicates",value = 1,min = 1))
        ),
        uiOutput("selectnames")
      ),

      mainPanel(
         tableOutput("testcols")
      )
   )
))

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



    standardNames <- reactive({ 
      paste("rep",rep(1:input$reps,each = input$chans),"_",
                           rep(paste("C",0:(input$chans - 1), sep = ""),input$reps),sep = "")
    })

    output$selectnames <- renderUI({
        selectizeInput("selectnames", "Change Names", choices = standardNames(),
                       options = list(maxOptions = input$reps * input$chans))
})

    ## output 

   output$testcols <-  renderTable({
      standardNames()
    })

})

shinyApp(ui = ui, server = server)

我可以在选项部分中传递某种选项来允许这样做吗？

Answer 1

使用selectizeInput，您可以设置options = list(create = TRUE) 以允许用户向选择列表添加级别，但我认为这不是您想要的。

相反，这里的代码为每个标准名称生成一个文本输入框，并允许用户为它们输入一个标签。它使用lapply 和sapply 循环每个值并生成/读取输入。

library(shiny)

ui <- shinyUI(fluidPage(


  sidebarLayout(
    sidebarPanel(
      fluidRow(column(5, numericInput("chans","# Channels",value = 4, min = 1)),
               column(5, numericInput("reps","# Replicates",value = 1,min = 1))
      ),
      uiOutput("setNames")
    ),

    mainPanel(
      tableOutput("testcols")
    )
  )
))

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



  standardNames <- reactive({ 
    paste("rep",rep(1:input$reps,each = input$chans),"_",
          rep(paste("C",0:(input$chans - 1), sep = ""),input$reps),sep = "")
  })

  output$setNames <- renderUI({

    lapply(standardNames(), function(thisName){
      textInput(paste0("stdName_", thisName)
                , thisName
                , thisName)
    })

  })

  labelNames <- reactive({
    sapply(standardNames()
           , function(thisName){
             input[[paste0("stdName_", thisName)]]
           })
  })

  ## output 

  output$testcols <-  renderTable({
    data.frame(
      stdName = standardNames()
      , label = labelNames()
    )
  })

})

shinyApp(ui = ui, server = server)

如果你想隐藏列表，除非用户想要添加标签，你可以使用一个简单的复选框，就像这样，它隐藏标签制作列表，直到用户选中该框以显示它。

library(shiny)

ui <- shinyUI(fluidPage(


  sidebarLayout(
    sidebarPanel(
      fluidRow(column(5, numericInput("chans","# Channels",value = 4, min = 1)),
               column(5, numericInput("reps","# Replicates",value = 1,min = 1))
      )
      , checkboxInput("customNames", "Customize names?")
      , uiOutput("setNames")
    ),

    mainPanel(
      tableOutput("testcols")
    )
  )
))

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



  standardNames <- reactive({ 
    paste("rep",rep(1:input$reps,each = input$chans),"_",
          rep(paste("C",0:(input$chans - 1), sep = ""),input$reps),sep = "")
  })

  output$setNames <- renderUI({

    if(!input$customNames){
      return(NULL)
    }

    lapply(standardNames(), function(thisName){
      textInput(paste0("stdName_", thisName)
                , thisName
                , thisName)
    })

  })

  labelNames <- reactive({

    if(!input$customNames){
      return(standardNames())
    }

    sapply(standardNames()
           , function(thisName){
             input[[paste0("stdName_", thisName)]]
           })
  })

  ## output 

  output$testcols <-  renderTable({
    data.frame(
      stdName = standardNames()
      , label = labelNames()
    )
  })

})

shinyApp(ui = ui, server = server)

或者，如果您认为用户可能只想更改一个或少数几个标签，这里有一种方法可以让他们选择将标签应用于哪个标准名称：

library(shiny)

ui <- shinyUI(fluidPage(


  sidebarLayout(
    sidebarPanel(
      fluidRow(column(5, numericInput("chans","# Channels",value = 4, min = 1)),
               column(5, numericInput("reps","# Replicates",value = 1,min = 1))
      )
      , uiOutput("setNames")
    ),

    mainPanel(
      tableOutput("testcols")
    )
  )
))

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

  vals <- reactiveValues(
    labelNames = character()
  )


  standardNames <- reactive({ 
    out <- paste("rep",rep(1:input$reps,each = input$chans),"_",
                 rep(paste("C",0:(input$chans - 1), sep = ""),input$reps),sep = "")
    vals$labelNames = setNames(out, out)

    return(out)
  })

  output$setNames <- renderUI({

    list(
      h4("Add labels")
      , selectInput("nameToChange", "Standard name to label"
                    , names(vals$labelNames))
      , textInput("labelToAdd", "Label to apply")
      , actionButton("makeLabel", "Set label")
    )

  })

  observeEvent(input$makeLabel, {
    vals$labelNames[input$nameToChange] <- input$labelToAdd
  })

  ## output 

  output$testcols <-  renderTable({
    data.frame(
      stdName = standardNames()
      , label = vals$labelNames
    )
  })

})

shinyApp(ui = ui, server = server)