2016-08-27 3 views
0

Я создал динамический пользовательский интерфейс в R, который генерирует четыре поля selectizeInput в среде с текучей средой с соответствующим набором наблюдателей, наблюдающих за вводом. Если выбрана кнопка addFilter, тогда дополнительный ряд жидкости генерируется с еще четырьмя ящиками.Последовательное создание динамического пользовательского интерфейса в Shiny, R

Моя проблема связана с сохранением ранее введенных значений. У меня есть группа реактивных значений, хранящих пользовательские входы. Эти значения затем вводятся в наблюдатели на updateselectize. Если пользователь щелкает медленно, все работает отлично. Однако, если пользователь нажимает быстро, иногда значения стираются.

Я считаю, что это происходит потому, что к моменту запуска сценария для создания нового интерфейса старый с наблюдателями не был полностью отображен; но значения были сброшены.

Ниже приведено MWE. Обратите внимание, что для запуска ошибки вам нужно дважды щелкнуть кнопку «Добавить фильтр».

Server.R:

library(shiny) 

shinyServer(function(session, input, output) { 

    rValues <- reactiveValues(filter_counter = 1, filter_counter2 = 1, filter_waiter = 1, savedFil_1 = "", savedOp_1 = "", 
          savedCrit_1 = "", savedAO_1 = "") 

    columns <- c("C1", "C2") 

    operators <- c("O1", "O2") 
    values <- c("V1", "V2") 
    andor <- c("&&", "||") 

    observeEvent(input$AddFilter,{ 
    if (rValues[['filter_waiter']] == 1) { 
     # Step 1: Store 
     lapply(1:rValues$filter_counter, function(i) { 
     rValues[[paste0("savedFil_", i)]] <- input[[paste0("fil_", i)]] 
     rValues[[paste0("savedOp_", i)]] <- input[[paste0("filOperators_", i)]] 
     rValues[[paste0("savedCrit_", i)]] <- input[[paste0("filCriteria_", i)]] 
     rValues[[paste0("savedAO_", i)]] <- input[[paste0("andor_", i)]] 
     }) 

     # Step 2: Increment counter 
     rValues$filter_counter <- rValues$filter_counter + 1 

     # Step 3: Set filter waiter 
     rValues[['filter_waiter']] <- 0 
    } 
    }) 

    output$filters <- renderUI({ 
    if (rValues[['filter_waiter']] == 1) { 
     ui <- lapply(1:rValues$filter_counter, function(i) { 
     fluidRow(
      column(4, selectizeInput(paste0("fil_", i), label = NULL, choices = NULL)), 
      column(2, selectizeInput(paste0("filOperators_", i), label = NULL, choices = NULL)), 
      column(4, selectizeInput(paste0("filCriteria_", i), label = NULL, choices = NULL)), 
      column(2, selectizeInput(paste0("andor_", i), label = NULL, choices = NULL))) 
     }) 
     return(ui) 
    } 
    }) 

    ### Create observers for filters 
    observe({ 
    lapply(1:rValues$filter_counter, function(i){ 
     # Update the Selectizes 
     updateSelectizeInput(session, paste0("fil_", i), selected = rValues[[paste0("savedFil_", i)]], choices = columns, server = TRUE) 
     updateSelectizeInput(session, paste0("filOperators_", i), selected = rValues[[paste0("savedOp_", i)]], choices = operators, server = TRUE) 
     updateSelectizeInput(session, paste0("filCriteria_", i), selected = rValues[[paste0("savedCrit_", i)]], choices = values, server = TRUE) 
     updateSelectizeInput(session, paste0("andor_", i), selected = rValues[[paste0("savedAO_", i)]], choices = c("", "&&", "||"), server = TRUE) 
    }) 

    rValues[['filter_waiter']] <- 1 
    }) 
}) 

И UI.R:

library(shiny) 

shinyUI(fluidPage(

    # Application title 
    titlePanel("Dynamic SelectizeInput UI"), 

    sidebarLayout(
    sidebarPanel(
     actionButton("AddFilter", label = "Add a Filter"), 
     uiOutput("filters") 
    ), 

    mainPanel(
     h1("") 
    ) 
) 
)) 
+0

Форматирование кода является личным предпочтением. Первое редактирование ничего не улучшило. Вернулся к оригиналу. –

+1

@ DirtySockSniffer Улучшение четкости и удобочитаемости - это хорошо установленные причины для редактирования. Возврат к предыдущему пересмотру. –

+1

@ Hack-R - Как * Я не буду форматировать свой код, как пьяную обезьяну-ревун, добавить что-нибудь полезное для этого сообщения? Кроме того, только потому, что вы пишете свои задания в строке, это не значит, что это стандарт. –

ответ

1

Ваш код может быть упрощена. Yo не нужно обновлять элементы selectizeInput, когда вы создаете новые элементы управления каждый раз, когда выбирается кнопка. У вас слишком много реактивных переменных. Я перехожу к глобальным переменным. Если вы не хотите использовать глобальные переменные, используйте реактивные переменные с изолятом.

library(shiny) 

filter_counter <- 0 
filter_values <- list() 
columns  <- c("C1", "C2") 
operators  <- c("O1", "O2") 
values   <- c("V1", "V2") 
andor   <- c("&&", "||") 

server<- shinyServer(function(session, input, output) { 

    output$filters <- renderUI({ 

     input$AddFilter 
     # Step 1: store filter values 
     if (filter_counter>0) { 
      lapply(1:filter_counter, function(i) { 
      filter_values[[paste0("savedFil_", i)]] <<- input[[paste0("fil_", i)]] 
      filter_values[[paste0("savedOp_", i)]] <<- input[[paste0("filOperators_", i)]] 
      filter_values[[paste0("savedCrit_", i)]] <<- input[[paste0("filCriteria_", i)]] 
      filter_values[[paste0("savedAO_", i)]] <<- input[[paste0("andor_", i)]] 
      }) 
     } 

     # Step 2: Increment counter 
     filter_counter <<- filter_counter + 1 

     # Step 3: generate selectInputs 
     ui <- lapply(1:filter_counter, function(i){ 
      fluidRow(
       column(4,selectizeInput(paste0("fil_", i), label= 'fil', selected = filter_values[[paste0("savedFil_", i)]], choices = columns)), 
       column(2,selectizeInput(paste0("filOperators_", i),label= 'filop', selected = filter_values[[paste0("savedOp_", i)]], choices = operators)), 
       column(4,selectizeInput(paste0("filCriteria_", i),label= 'filcri', selected = filter_values[[paste0("savedCrit_", i)]], choices = values)), 
       column(2,selectizeInput(paste0("andor_", i),label= 'andor', selected = filter_values[[paste0("savedAO_", i)]], choices = c("", "&&", "||"))) 
     ) 
     }) 

    }) 
}) 


ui <- shinyUI(fluidPage(

    # Application title 
    titlePanel("Dynamic SelectizeInput UI"), 

    sidebarLayout(
    sidebarPanel(
     actionButton("AddFilter", label = "Add a Filter"), 
     uiOutput("filters") 
    ), 

    mainPanel(
     h1("") 
    ) 
) 
)) 

shinyApp(ui , server) 
Смежные вопросы