Question

后台：我正在构建一个与MySQL数据库连接的仪表板。用户指定粗略过滤器从数据库中提取数据并单击“提交”，数据用ggvis绘制，然后用户可以使用精细过滤器来影响绘制数据的子集。这些精细过滤器取决于从数据库中提取的数据，因此我使用uiOutput / renderUI从数据生成它们。

问题：我的挑战是我希望在更新地图之前根据数据更新UI 。否则，旧数据集中的精细过滤器将应用于新数据，这会在绘制时导致错误。

示例：以下示例使用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)

Answer 1

经过几个小时的捣乱，我发现了一个非常黑客的解决方法。我对此并不十分满意，所以我希望有人可以提供改进。

总而言之，我的意识是renderUI调用正在被执行时，即在生成情节之前。但是，renderUI并未直接更改UI中的滑块，而是向浏览器发送消息，告知其更新滑块。只有在运行所有观察者后才会执行此类消息。特别是，在运行包含对ggvis的调用的观察者之后，会发生这种情况。所以，序列似乎是

发送给浏览器以更新滑块的消息。
根据滑块中的值生成的绘图，这些值仍为旧值。
浏览器更新滑块。可悲的太晚了：（

因此，为了解决这个问题，我决定创建一个存储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)

在R Shiny中的ggvis plot之前更新UI

1 个答案: