Обновите пользовательский интерфейс до сюжета ggvis в R Shiny

Предыстория: я создаю панель мониторинга, которая взаимодействует с базой данных MySQL. Пользователь указывает грубый фильтр для извлечения данных из базы данных и нажимает «Отправить», данные отображаются с помощью ggvis, затем пользователь может играть с тонкими фильтрами, чтобы повлиять на то, какое подмножество данных отображается. Эти тонкие фильтры зависят от данных, извлеченных из базы данных, поэтому я генерирую их из данных, используя uiOutput/renderUI.

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

Пример. Следующий пример примерно воспроизводит проблему с использованием mtcars. Чтобы получить ошибку, выберите 4 цилиндра, нажмите «Отправить», затем выберите 6 цилиндров и снова нажмите «Отправить». В этом случае, когда фильтр тонкой очистки с 4 цилиндрами применяется к набору данных с 6 цилиндрами, возвращается только одна точка, что вызывает ошибку при попытке применить сглаживание в ggvis. Не та же ошибка, что и у меня, но достаточно близко.

library(shiny)
library(dplyr)
library(ggvis)

ui <- fluidPage(
  headerPanel("Example"),
  sidebarPanel(
    h2("Course Filter:"),
    selectInput("cyl_input", "Cylinders", c(4, 6)),
    actionButton("submit", "Submit"),
    conditionalPanel(condition = "input.submit > 0",
      h2("Fine Filter: "),
      uiOutput("mpg_input")
    )
  ),
  mainPanel(
    ggvisOutput("mtcars_plot")
  )
)

server <- function(input, output) {
  mycars <- eventReactive(input$submit, {
    filter(mtcars, cyl == input$cyl_input)
  })
  output$mpg_input <- renderUI({
    mpg_range <- range(mycars()$mpg)
    sliderInput("mpg_input", "MPG: ",
                min = mpg_range[1], max = mpg_range[2],
                value = mpg_range,
                step = 0.1)
  })
  observe({
    if (!is.null(input$mpg_input)) {
      mycars() %>%
        filter(mpg >= input$mpg_input[1],
               mpg <= input$mpg_input[2]) %>% 
        ggvis(~mpg, ~wt) %>%
        layer_points() %>%
        layer_smooths() %>% 
        bind_shiny("mtcars_plot")
    }
  })
}

shinyApp(ui = ui, server = server)

r shiny ggvis
person Matt SM    schedule 01.08.2016    source источник
comment
Аналогично этому вопросу, на который нет ответа: stackoverflow.com/questions/24010346/   -  person Matt SM    schedule 02.08.2016
comment
Если это поможет, вы можете установить задержки, используя shinyjs::delay()   -  person Dambo    schedule 02.08.2016

Ответы (1)


arrow_upward
2
arrow_downward

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

Подводя итог, я понял, что вызов renderUI выполнялся, когда это должно было быть, то есть до создания графика. Однако renderUI не изменяет ползунок в пользовательском интерфейсе напрямую, а отправляет сообщение в браузер с указанием обновить ползунок. Такие сообщения выполняются только после запуска всех наблюдателей. В частности, это происходит после запуска наблюдателя, обертывающего вызов ggvis. Итак, последовательность, кажется,

  1. Сообщение отправлено в браузер для обновления слайдера.
  2. График создан на основе значений в ползунке, которые все еще являются старыми значениями.
  3. Ползунок обновлений браузера. К сожалению поздно :(

Итак, чтобы обойти это, я решил создать новую реактивную переменную, хранящую диапазон значений MPG. Сразу после применения грубого фильтра и перед обновлением ползунка в браузере эта переменная напрямую ссылается на новый фрейм данных. Впоследствии, при игре непосредственно с ползунком, эта реактивная переменная ссылается на ползунок. Для этого просто необходимо установить флаг, указывающий, следует ли ссылаться на фрейм данных или ползунок, а затем перевернуть флаг в разумном месте.

Вот код:

library(shiny)
library(dplyr)
library(ggvis)

ui <- fluidPage(
  headerPanel("Example"),
  sidebarPanel(
    h2("Course Filter:"),
    selectInput("cyl_input", "Cylinders", c(4, 6)),
    actionButton("submit", "Submit"),
    conditionalPanel(condition = "input.submit > 0",
                     h2("Fine Filter: "),
                     uiOutput("mpg_input")
    )
  ),
  mainPanel(
    ggvisOutput("mtcars_plot")
  )
)
server <- function(input, output) {
  # create variable to keep track of whether data was just updated
  fresh_data <- TRUE
  mycars <- eventReactive(input$submit, {
    # data have just been refreshed
    fresh_data <<- TRUE
    filter(mtcars, cyl == input$cyl_input)
  })
  output$mpg_input <- renderUI({
    mpgs <- range(mycars()$mpg)
    sliderInput("mpg_input", "MPG: ",
                min = mpgs[1], max = mpgs[2],
                value = mpgs,
                step = 0.1)
  })
  # make filtering criterion a reactive expression
  # required because web page inputs not updated until after everything else
  mpg_range <- reactive({
    # these next two lines are required though them seem to do nothing
    # from what I can tell they ensure that mpg_range depends reactively on
    # these variables. Apparently, the reference to these variables in the
    # if statement is not enough.
    input$mpg_input
    mycars()
    # if new data have just been pulled reference data frame directly
    if (fresh_data) {
      mpgs <- range(mycars()$mpg)
    # otherwise reference web inputs
    } else if (!is.null(input$mpg_input)) {
      mpgs <- input$mpg_input
    } else {
      mpgs <- NULL
    }
    return(mpgs)
  })
  observe({
    if (!is.null(mpg_range())) {
      mycars() %>%
        filter(mpg >= mpg_range()[1],
               mpg <= mpg_range()[2]) %>% 
        ggvis(~mpg, ~wt) %>%
        layer_points() %>%
        layer_smooths() %>% 
        bind_shiny("mtcars_plot")
    }
    # ui now updated, data no longer fresh
    fresh_data <<- FALSE
  })
}

shinyApp(ui = ui, server = server)
person Matt SM    schedule 02.08.2016