Как остановить расчет блестящего приложения, когда открыта выпадающая кнопка? - PullRequest
0 голосов
/ 04 марта 2019

Я разрабатываю приложение Shiny для фильтрации базы данных (например, Excel), и я хотел бы остановить все вычисления приложения, когда открыта выпадающая кнопка.Вы знаете, как я мог сделать это, пожалуйста?Это мое первое приложение Shiny, так что я уверен, что допустил несколько глупых ошибок.

В моей кнопке выпадающего меню у меня есть CheckBoxGroupInput с различными вариантами выбора для одной переменной моей базы данных.Проблема: мне нужно подождать несколько секунд между каждым выбором внутри CheckBoxGroupInput, потому что приложение обновляется для каждого дополнительного выбора в CheckBox.

Пример для одной переменной:

ui:

dropdownButton(
                 label = "Country :", status = "default", width = 200, circle = FALSE,
                 actionButton(inputId = "country_all", label = "(Un)select all"),
                 uiOutput("countrybis")
               ),
               verbatimTextOutput(outputId = "country_print")

сервер:

Функция обновления каждого списка в другом CheckBox:

Function_List_Data <- function(p_type, p_processchoice, p_year, p_variable, p_product, p_country,
                                 p_item, p_season, p_region, p_calcamp){
    if(p_processchoice == "GROSSVAR"){
      data <- dataset_var[YEARBIS >= p_year[1] & YEARBIS <= p_year[2],]}
    else if(p_processchoice == "YIELD"){
      data <- dataset_rdt[YEARBIS >= p_year[1] & YEARBIS <= p_year[2],]}
    else{data <- dataset[YEARBIS >= p_year[1] & YEARBIS <= p_year[2],]}
    if (p_region == 2) {data <- data[REGION %in% list("EU-15","EU-27","EU-28")]}
    else if (p_region == 3) {data <- data[REGION %in% list("C.I.S.")]}
    if (p_calcamp == 2) {data <- data[`CAMPAIGN/CALENDAR` == "CAMPAIGN",]}
    else if (p_calcamp == 3) {data <- data[`CAMPAIGN/CALENDAR` == "CALENDAR",]}
    else if (p_calcamp == 4) {data <- data[`CAMPAIGN/CALENDAR` == "OTHERS",]}
    if (!is.null(p_variable)) {data <- data[VARIABLE %in% p_variable]}
    if (!is.null(p_product)) {data <- data[PRODUCT %in% p_product,]}
    if (!is.null(p_country)) {data <- data[COUNTRY %in% p_country,]}
    if (!is.null(p_item)) {data <- data[ITEM %in% p_item,]}
    if (!is.null(p_season)) {data <- data[SEASON %in% p_season,]}
    if(nrow(data)<1){ data <- data[1,] }
    if (p_type == "VARIABLE"){List <- unique(unlist(data$VARIABLE), use.names = FALSE)}
    else if (p_type == "PRODUCT"){List <- unique(unlist(data$PRODUCT), use.names = FALSE)}
    else if (p_type == "COUNTRY"){List <- unique(unlist(data$COUNTRY), use.names = FALSE)}
    else if (p_type == "ITEM"){List <- unique(unlist(data$ITEM), use.names = FALSE)}
    else if (p_type == "SEASON"){List <- unique(unlist(data$SEASON), use.names = FALSE)}
    return(List)
  }

Расчет для столбца Страна:

   Country_List <- reactive({
    Function_List_Data(p_type = "COUNTRY",
                       p_processchoice = input$dataprocess_choice,
                       p_year = input$year,
                       p_variable = input$variable_list,
                       p_product = input$product_list,
                       p_country = NULL,
                       p_item = input$item_list,
                       p_season = input$season_list,
                       p_region = input$region,
                       p_calcamp = input$campaign_calendar)})
  observeEvent(input$country_all, {
    if (is.null(input$country_list)) {
      updateCheckboxGroupInput(session = session, inputId = "country_list", selected = Country_List())}
    else {updateCheckboxGroupInput(session = session, inputId = "country_list", selected = "")}
  })
  output$country_print <- renderPrint({
    if(is.null(input$country_list)){"- ALL -"}
    else{as.matrix(input$country_list)}
  })
  output$countrybis <- renderUI({
    checkboxGroupInput(inputId = "country_list", label = "Choose", choices = sort(Country_List()), selected = input$country_list)
  })

РЕДАКТИРОВАТЬ: Когда я рассчитываю Country_List только когда я нажимаю на DropdownButton, он не работает, вы можете увидетьошибка на экране:

Ошибка получена: Country_List рассчитывается после печати CheckBox .

Кнопка Выбрать все / Отменить выбор всех:

observeEvent(input$country_all, {
Country_List <- Function_List_Data(p_type = "COUNTRY",
                     p_processchoice = input$dataprocess_choice,
                     p_year = input$year,
                     p_variable = input$variable_list,
                     p_product = input$product_list,
                     p_country = NULL,
                     p_item = input$item_list,
                     p_season = input$season_list,
                     p_region = input$region,
                     p_calcamp = input$campaign_calendar)
if (is.null(input$country_list)) {
  updateCheckboxGroupInput(session = session, inputId = "country_list", selected = Country_List)}
else {updateCheckboxGroupInput(session = session, inputId = "country_list", selected = "")}})

RenderPrint:

output$country_print <- renderPrint({
if(is.null(input$country_list)){"- ALL -"}
else{as.matrix(input$country_list)}})

CheckBox:

output$countrybis <- renderUI({
observeEvent(input$Country_DropDown,{
  print("bla")
  Country_List <- Function_List_Data(p_type = "COUNTRY",
                       p_processchoice = input$dataprocess_choice,
                       p_year = input$year,
                       p_variable = input$variable_list,
                       p_product = input$product_list,
                       p_country = NULL,
                       p_item = input$item_list,
                       p_season = input$season_list,
                       p_region = input$region,
                       p_calcamp = input$campaign_calendar)
})
checkboxGroupInput(inputId = "country_list", label = "Choose", choices = sort(Country_List), selected = input$country_list) })
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...