server.R

Question

我创建了用户界面1）单选按钮 - ＆gt;在选择时生成2）搜索框 - ＆gt;它产生3）多选组件。在此之后我有一个动作按钮（添加）点击哪个应该显示（4）文本框中的项目从（3）中选择但是当我改变（1）或（2）时，文本消失了。我需要将文本保留在（4）中，以便用户可以使用（1），（2）和（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")
            })
          })



        })

Answer 1

根据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")
}

}）

Answer 2

以下是来自反应性闪亮小部件的动态查询示例：

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

R shiny：使用动态UI构建查询

server.R

2 个答案: