Rshining: создание запроса с использованием динамического пользовательского интерфейса

Я создал пользовательский интерфейс с 1) радиокнопками -> при выборе генерируется 2) поле поиска -> которое генерирует 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")
        )
      )
    ))

сервер.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")
            })
          })



        })

r dynamic shiny shinysky
person JHS    schedule 15.05.2014    source источник
comment
Вы можете сохранить значения, используя reactiveValues.   -  person jdharrison    schedule 15.05.2014
comment
Можете ли вы описать на примере, пожалуйста?   -  person JHS    schedule 19.05.2014
comment
есть пример stackoverflow.com/questions/23432416/   -  person jdharrison    schedule 19.05.2014
comment
Спасибо jdharrison! вы спасли мой день :) я принял ваше предложение. я опубликую свой код здесь, как только я его изменю.   -  person JHS    schedule 20.05.2014

Ответы (2)


arrow_upward
1
arrow_downward

Обновление ответа в соответствии с предложением 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")
}

})

person JHS    schedule 20.05.2014
comment
Также вы можете использовать observeEvent. - person Artem Klevtsov; 11.01.2016

arrow_upward
-1
arrow_downward

Вот пример динамического запроса от реактивного блестящего виджета:

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

person dataphile    schedule 26.02.2017
comment
Подумайте о том, чтобы ответить на вопрос, а не указывать на URL-адрес, который может быть нарушен в будущем. - person codeepic; 26.02.2017