Allow User to change input selection in selectizeInput - shiny

Question

This app is creating a vector of standardised names which I create given some user input (number of channels and replicates). An example of the standard names given the number of channels = 4 and and replicates = 1 is as follows:
c("rep1_C0","rep1_C1","rep1_C2","rep1_C3")
I would like to allow the user to replace the value of the selection with their own custom value. For example to change the input "rep1_C0" to "Control_rep1". And then for it to then update the reactive vector in question. Here is my code:
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)
Is there some kind of option I can pass in the options sections that will allow this?

Answer 1

With selectizeInput you can set options = list(create = TRUE) to allow the user to add levels to the selection list, but I don't think that is what you want.
Instead, here is code that generates a text input box for each of the standard names, and allows the user to enter a label for them. It uses lapply and sapply to loop over each value and generate/read the inputs.
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)
If you want to hide the list unless the user wants to add labels, you can use a simple checkbox, like this, which hides the label making list until the use checks the box to show it.
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)
Alternatively, if you think the user may want to only change one or a small number of labels, here is a way to allow them to choose which standard name they are applying a label to:
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)