linked_brush in ggvis cannot work in Shiny when data change

Question

I want to create a Shiny APP which uses ggvis to plot a interactive figure and linked_brush to select points in the figure. The plot data are changed according to inputs.

But I get an error message when I try to put all thing together.

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

I try to create a minimum example through the "basic" demo in 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")
  })

If I change

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

into

layer_points() %>%

everything is working for me. I guess this problem is related with "linked_brush".

How should I fix this problem? Thanks for any suggestions.

My session info:

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        

Answer 1

I had the same problem. Solved it by modifying linked_brush() to include a function for setting the keys.

Modified linked_brush() from linked_brush.R in ggvis:

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
  )
}

Now server.R from your example can be modified to set the keys when mtcs changes:

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")
  })