Связанная кисть в ggvis не может работать в Shiny при изменении данных

Я хочу создать блестящее приложение, которое использует ggvis для построения интерактивной фигуры и связанный с ним кисть для выбора точек на фигуре. Данные графика изменяются в соответствии с исходными данными.

Но я получаю сообщение об ошибке, когда пытаюсь собрать все воедино.

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') %>%

в

layer_points() %>%

у меня все работает. Я думаю, эта проблема связана с "connected_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
Источник

2 ответа

Решение

У меня такая же проблема. Решил это, изменив linked_brush() включить функцию для настройки клавиш.

модифицированный linked_brush() из connected_brush.R в 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
  )
}

Теперь 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")
  })
Источник

+ Изменить

lb <- linked_brush(keys = mtc()$id, "red")

чтобы:

lb <- linked_brush(keys = 1:nrow(mtcars), "red")

Вам либо нужен ваш id переменная или создать его непосредственно в функции, как это.

РЕДАКТИРОВАТЬ

Как отметил @NicE, я не смог понять, что фильтрация также является частью проблемы. Пожалуйста, посмотрите эту суть для рабочего решения.

shiny::runGist("https://gist.github.com/cdeterman/fd6bf3955ef56fe9f38d")

Хотя создание сюжета ggvis не является наиболее привлекательным решением, я считаю, что это необходимо здесь. Если вы не включите scale_numeric сюжет рухнет, если будет только один уровень (например, фильтр на Mazda). scale_numeric позволяет точно установить диапазон оси. Чтобы изменить оси, у меня сложилось впечатление, что ggvis должен быть реактивным.

Источник
Другие вопросы по тегам