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

这个应用程序正在创建一个标准化名称的向量，我在给定一些用户输入（频道和复制的数量）的情况下创建了这个向量。给定通道数=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)

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

相反，这里的代码为每个标准名称生成一个文本输入框，并允许用户为它们输入标签。它使用
lappy
和
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)

库（闪亮）
ui谢谢Mark，但是当名称数量很大时，这个解决方案有点难看。是否有一种方法可以将其转换为2输入法，即使用标准名称和可以更改所选名称的输入法？有关在不需要列表时隐藏列表或一次只更改一个标签的方法，请参阅更新（然而，我的猜测是，如果用户想要更改一个标签，他们将需要更改很多标签，并且必须从列表中选择每个标签可能会很麻烦。）
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)