R shiny: building query using dynamic UI

1.3k views Asked by At

I have created User interface with 1) Radio buttons -> upon selection generates 2) search box -> which generates 3) multiple selection component. After this i have an Action button(Add) clicking which should display the items in (4) text box selected from (3) but when i change (1) or (2) the text disappears. I need the text to be retained in (4) so users can build query with multiple combinations of (1), (2) and (3)

#UI.R

        library(shiny)
        library(shinysky)

        #header page includes a panel.
        shinyUI(fluidPage(  
        #title
        headerPanel("my tool"),

        #create a sidebar layout
        column(3,wellPanel(
        #Radio option to select search type
        radioButtons("search_option", label = h3("Search by"),
                     c("method1" = "m1",
                       "method2" = "m2",
                       "method3" = "m3",
                       "method4" = "m4",
                       "Keyword" = "keyword")),
         #typeahead
        uiOutput("searchBox"),   

        # Dynamically rendered select box for selecting child terms  
        uiOutput("select_child_terms"),

        #show text input box if option is keyword search
        conditionalPanel(
          condition = "input.search_option == 'keyword'",
          textInput("search_term", label = "kwrd")
        ),

        #Action button to build query
        actionButton("add_button", label = "Add"),

        #text display
        verbatimTextOutput("dynamic_value")
        #textInput("dynamic_value",label=""),
        #shinyalert("dynamic_value",click.hide=FALSE),

    #    checkboxInput("list_option", label="Enter your own gene list?",value=FALSE)

    #    conditionalPanel(
    #     condition = "input.list_option == 'TRUE'",
    #      textInput(inputId="list",label="name list")
    #     ),

        #Submit button
        #submitButton(text="Submit")
        )
      )
    ))

server.R

        source("ontology.R")

        options(shiny.trace = F)  # change to T for trace
        require(shiny)
        require(shinysky)


        shinyServer(function(input, output, session) {
        output$searchBox <- renderUI({
          if (is.null(input$search_option))
            return()
          # Depending on input$search_option, we'll generate a different search box with ontology
          # UI component and send it to the client.
          switch(input$search_option,
                 "m1" = textInput.typeahead(id="thti",placeholder="type and select",local = to[,c(1,2)],valueKey = "Parent_Term", tokens = c(1:nrow(to)),template = HTML("<p class='repo-language'>{{Parent_Term}}</p> <p class='repo-name'>{{Ontology_ID}}</p> <p class='repo-description'></p>")),
                 "m2" = textInput.typeahead(id="thti",placeholder="type and select",local = bp[,c(1,2)],valueKey = "Parent_Term", tokens = c(1:nrow(bp)),template = HTML("<p class='repo-language'>{{Parent_Term}}</p> <p class='repo-name'>{{Ontology_ID}}</p> <p class='repo-description'></p>")),
                 "m3" = textInput.typeahead(id="thti",placeholder="type and select",local = mf[,c(1,2)],valueKey = "Parent_Term", tokens = c(1:nrow(mf)),template = HTML("<p class='repo-language'>{{Parent_Term}}</p> <p class='repo-name'>{{Ontology_ID}}</p> <p class='repo-description'></p>")),
                 "m4" = textInput.typeahead(id="thti",placeholder="type and select",local = cc[,c(1,2)],valueKey = "Parent_Term", tokens = c(1:nrow(cc)),template = HTML("<p class='repo-language'>{{Parent_Term}}</p> <p class='repo-name'>{{Ontology_ID}}</p> <p class='repo-description'></p>")),
          })

          observe({
            input$thti
            input$search_option
            output$select_child_terms <- renderUI({
              selectizeInput("select_child_terms", label = h3("Select related terms"),
                  choices = unlist(getchildterms(input$thti,input$search_option)), multiple = TRUE)
              })
          })

          output$dynamic_value <- renderText({
            input$add_button
            isolate({
              #str(input$select_child_terms)
              paste(input$dynamic_value, input$select_child_terms, collapse = ",")
              #showshinyalert(session,"dynamic_value", paste(input$select_child_terms, collapse = ","), "info")
            })
          })



        })
2

There are 2 answers

1
JHS On BEST ANSWER

Updating answer according to suggestion from jdharrison

 #show selected terms
 myValues <- reactiveValues()
 observe({
if(input$add_button > 0){
  isolate({
    onto <- input$search_option
    values <-input$select_child_terms
    if(!is.null(myValues$names)){
      myValues$names<-append(myValues$names,values)
    }
    else{
      myValues$names<-values
    }
    #print(values)
    output$dynamic_value <- renderText({
      paste0(myValues$names, collapse=",")
      })
  })
  updateSelectInput(session,"select_child_terms","Select related terms")
}

})

1
dataphile On

Here's an example of a dynamic query from a reactive shiny widget :

https://github.com/victor-geere/R