Блог

Это приложение создает вектор стандартизированных имен, которые я создаю с учетом некоторого пользовательского ввода (количество каналов и повторов). Пример стандартных имен с учетом количества каналов = 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)
  

Есть ли какая-то опция, которую я могу передать в разделах параметров, которые позволят это?

С 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)
  

Если вы хотите скрыть список, если пользователь не хочет добавлять метки, вы можете использовать простой флажок, подобный этому, который скрывает список создания меток, пока use не установит флажок, чтобы показать его.

 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)