Add label to input dynamically


#1

Admittedly I am fairly novice when it comes to prototyping solutions within Shiny, but is there an input type that allows me to add an choice (via text free form) and append that to the list of already existing options dynamically?

My use case is to select text-search from a pre-defined set of labels. If my label does not exist, I want to create it on the fly and have it available for the next "refresh".

For a practical reference, Evernote web clipper lets you create a new tag on the fly. Once created, its available from that point forward.

I've attempted to roll my own, but I feel like I am re-inventing the wheel on some level.

Any guidance is much appreciated!


#2

While I'm not aware of a single input type that is exactly what you are looking for, I can recommend a combination of inputs alongside the concept of a reactive value. In the example application below, I have a simple text input that lets the user enter a new string for a label, and a button that confirms the addition. The corresponding selectInput is pre-populated with a few choices to start, but when the user hits the button to add a new choice, it is automatically refreshed to have the new item included. In a nutshell, a reactive value is an object that resembles a typical R object, but in the context of a shiny app any time it is updated, it will make sure any other reactive objects, inputs, or outputs that depend on it will also get refreshed. The UI of this app is certainly utilitarian, but hopefully it illustrates the concepts well:

library(shiny)

# create an initial list of choices for select input:
default_choices <- c("lorem", "ipsum", "funny")

# Define UI for application that draws a histogram
ui <- fluidPage(
    titlePanel("Dynamic choices"),
    fluidRow(
        column(
            width = 6,
            textInput(
                "freetext",
                "Enter new choice if not present"
            ),
            actionButton("add_btn", "Add to choices"),
            uiOutput("selector_ui")
        ),
        column(
            width = 6,
            h3("Current choices"),
            verbatimTextOutput("choices_print")
        )
    )
)

# Define server logic required to draw a histogram
server <- function(input, output, session) {
    
    # define a reactive value for the choices
    current_choices <- reactiveVal(default_choices)
    
    # process button click for adding a choice
    # if user leaves it blank, show a modal and exit out
    observeEvent(input$add_btn, {
        if (input$freetext == "") {
            showModal(
                modalDialog(
                    title = "No new label entered!",
                    "Please enter a label in the free text field",
                    easyClose = FALSE
                )
            )
            return(NULL)
        } else {
            # add the free text file to the reactive values
            new_choices <- c(current_choices(), input$freetext)
            current_choices(new_choices)
        }
    })
    
    output$selector_ui <- renderUI({
        selectInput(
            "selector",
            "Choose label",
            choices = current_choices(),
            selected = NULL,
            multiple = FALSE
        )
    })
    
    output$choices_print <- renderPrint({
        current_choices()
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

#3

This is absolutely fantastic, thanks!