Как создать динамический номер наблюдаемого события в другом наблюдаемом событии? - PullRequest
0 голосов
/ 22 января 2019

Здесь Я задал похожий вопрос и получил рабочий ответ. Но решение не работает, если «actionButton» подсегмента заменяется на «selectInput». На каждый выбор selectInput создает два выхода. Пожалуйста, помогите .. Спасибо ....

library(shiny)

ui <- fluidPage(
  verbatimTextOutput("txt",placeholder = T), #"It is Created for Testing"
  actionButton("addSeg", "Add a Segment"),
  uiOutput("myUI")
)

server <- function(input, output, session) {
  alld <- reactiveValues()
  alld$ui <- list()

  # Action to add new Segment
  observeEvent(input$addSeg,{
    new_id <- length(alld$ui) + 1
    sub_name <- paste0("addSub_", new_id)

    alld$ui[[new_id]] <- list(selectInput(sub_name,"Add a variable", choices = c("V1","V2"), selected  = NULL))

    observeEvent(input[[sub_name]], {
      new_text_id <- length(alld$ui[[new_id]]) + 1
      alld$ui[[new_id]][[new_text_id]] <- HTML(paste0("Variable ",input[[sub_name]]," added<br>"))
    }, ignoreInit = TRUE)
  })

  output$myUI <- renderUI({alld$ui})

  output$txt <- renderText({class(alld$ui)})
}

shinyApp(ui, server)

enter image description here

1 Ответ

0 голосов
/ 22 января 2019

Это происходит потому, что пользовательский элемент пользовательского интерфейса перерисовывается каждый раз, когда новый элемент добавляется в список.После того, как вы нажмете «V2» и добавите новый текстовый элемент, selectInput перерисовывается и сбрасывается до V1, что замечает созданный вами наблюдатель.

Следующее может быть решениемдля вас:

  observeEvent(input$addSeg,{
    new_id <- length(alld$ui) + 1
    sub_name <- paste0("addSub_", new_id)

    alld$ui[[new_id]] <- list(
      selectInput(sub_name,
                  "Add a variable",
                  choices = c("", "V1","V2"),
                  selected  = "")
      )

    observeEvent(input[[sub_name]], {
      if (input[[sub_name]] == "") return()
      new_text_id <- length(alld$ui[[new_id]]) + 1
      alld$ui[[new_id]][[new_text_id]] <- HTML(paste0("Variable ",input[[sub_name]]," added<br>"))
    }, ignoreInit = TRUE)
  })

То, что я сделал здесь, это добавление пустой опции к вашим selectInput s и условие для соответствующего наблюдателя, что он не должен ничего делать, если ввод пуст.Таким образом, я использую поведение «сброса», чтобы оно было полезным вместо раздражающего.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...