当数据更改时，ggvis 中的 linked_brush 无法在 Shiny 中工作

我想创建一个闪亮的应用程序，它使用 ggvis 绘制交互式图形，并使用 linked_brush 选择图形中的点。绘图数据根据输入而变化。

但是当我尝试将所有内容放在一起时，我收到一条错误消息。

Error : Length of calculated column 'reactive_185425318' (0)
is not equal to 1 or the number of rows in data (32).

我尝试通过 ggvis 中的“基本”演示创建一个最小示例：

ui.R

library(ggvis)

shinyUI(pageWithSidebar(
  div(),
  sidebarPanel(
    textInput('filter', 'Filters', ''),
    uiOutput("plot_ui")
  ),
  mainPanel(
    ggvisOutput("plot")
  )
))

server.R

library(ggvis)
library(dplyr)

shinyServer(function(input, output, session) {
  # A reactive subset of mtcars
  mtc <- reactive({ 
        mtcs <- mtcars %>% 
            mutate(name = row.names(.))
        if (nchar(input$filter) > 0)
        {
            mtcs <- mtcs %>% filter(grepl(input$filter, name))
        }
        print(mtcs)
        mtcs
    })
  lb <- linked_brush(keys = mtc()$id, "red")
  mtc %>%
    ggvis(~wt, ~mpg) %>%
    layer_points(fill := lb$fill, fill.brush := 'red') %>%
    lb$input() %>%
    bind_shiny("plot", "plot_ui")
  })

如果我改变

layer_points(fill := lb$fill, fill.brush := 'red') %>%

into

layer_points() %>%

一切都对我有用。我猜这个问题与“linked_brush”有关。

我应该如何解决这个问题？感谢您的任何建议。

我的会话信息：

sessionInfo()
R version 3.1.1 (2014-07-10)
Platform: x86_64-w64-mingw32/x64 (64-bit)

locale:
[1] LC_COLLATE=English_Australia.1252  LC_CTYPE=English_Australia.1252    LC_MONETARY=English_Australia.1252 LC_NUMERIC=C                       LC_TIME=English_Australia.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] stringr_0.6.2       magrittr_1.5        dplyr_0.4.1.9000    rproject_0.1.0.4509 ggvis_0.4.0.9000    shiny_0.11.1       

loaded via a namespace (and not attached):
 [1] assertthat_0.1.0.99  DBI_0.3.1            digest_0.6.4         htmltools_0.2.6      httpuv_1.3.2         lazyeval_0.1.10.9000 mime_0.2             parallel_3.1.1       R6_2.0.1            
[10] Rcpp_0.11.3          RJSONIO_1.3-0        tools_3.1.1          xtable_1.7-4        

我有同样的问题。通过修改解决了linked_brush()包括设置按键的功能。

修改的linked_brush()来自ggvis中的linked_brush.R：

linked_brush <- function(keys, fill = "red") {
  stopifnot(is.character(fill), length(fill) == 1)

  rv <- shiny::reactiveValues(under_brush = character(), keys = character())
  rv$keys <- isolate(keys)

  input <- function(vis) {
    handle_brush(vis, fill = fill, on_move = function(items, ...) {
      rv$under_brush <- items$key__
    })
  }

  set_keys <- function(keys) {
    rv$keys <- keys
  }

  set_brush <- function(ids) {
    rv$under_brush <- ids
  }

  selected_r <- reactive(rv$keys %in% rv$under_brush)
  fill_r <- reactive(c("black", fill)[selected_r() + 1])

  list(
    input = input,
    selected = create_broker(selected_r),
    fill = create_broker(fill_r),
    set_keys = set_keys,
    set_brush = set_brush
  )
}

现在可以修改示例中的 server.R 以设置密钥mtcs变化：

library(ggvis)
library(dplyr)

shinyServer(function(input, output, session) {
  lb <- linked_brush(keys = NULL, "red")
  # A reactive subset of mtcars
  mtc <- reactive({ 
        mtcs <- mtcars %>% 
            mutate(name = row.names(.))
        if (nchar(input$filter) > 0)
        {
            mtcs <- mtcs %>% filter(grepl(input$filter, name))
        }
        print(mtcs)
        lb$set_keys(seq_len(nrow(mtcs)))
        mtcs
    })
  mtc %>%
    ggvis(~wt, ~mpg) %>%
    layer_points(fill := lb$fill, fill.brush := 'red') %>%
    lb$input() %>%
    bind_shiny("plot", "plot_ui")
  })