无法使用 ggvis 进行交互式缩放答案

【问题标题】：Can't get interactive zooming to work with ggvis无法使用 ggvis 进行交互式缩放
【发布时间】：2015-09-14 16:44:51
【问题描述】：

我正在尝试让交互式缩放在 ggvis 中工作，尤其是使用画笔进行缩放。从https://github.com/rstudio/ggvis/issues/143 来看，我认为这应该可行。

我有以下闪亮的 ggvis 代码（完全可重现）：

## ui.R
library(ggvis)

shinyUI(fluidRow(
  uiOutput('ui_plot1'),
  ggvisOutput("graph_plot1")
))

## server.R
shinyServer(function(input, output, session) {
  domains <- reactiveValues(x = c(NA, NA), y = c(NA, NA))

  zoom_brush = function(items, session, page_loc, plot_loc, ...) {
    domains$x = c(200, 400)
  }

  plot = reactive({
    mtcars %>% 
      ggvis(~disp, ~mpg) %>%
      layer_points() %>%
      scale_numeric('x', domain = domains$x, clamp = TRUE) %>% 
      handle_brush(zoom_brush)
  }) %>% bind_shiny('graph_plot1', 'ui_plot1')
})

因此，一旦画了画笔，反应域就会改变，这反过来会改变 x scale_numeric 的域。如果还有以下挑战：

在zoom_brush里面我得到了画笔的坐标，但是在绘图的像素坐标系中不是域坐标系。如何将像素转换为域比例？在 d3 中，我可以简单地使用范围来缩放变换函数，但我看不出这些函数在 ggvis 中如何可用（通过 vega）。
handle_brush 函数仅支持设置on_move 事件处理程序。在这种情况下，我只想在画笔完成时触发缩放，所以画笔上下文中的 onmouseup 事件。我担心现在这根本不可能？
只有当我设置clamp = TRUE 时，我才能获得有效的缩放。否则，域外的点仍然显示，只有轴设置为新域。有一个简单的解决方法吗？或者我应该将数据集设为反应性数据集，并根据画笔设置的域对其进行子集化？

我运行以下 R 版本和包版本。

> sessionInfo()
R version 3.1.1 (2014-07-10)
Platform: x86_64-apple-darwin10.8.0 (64-bit)

locale:
[1] C

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

other attached packages:
[1] ggvis_0.4.1  shiny_0.12.0

loaded via a namespace (and not attached):
 [1] DBI_0.3.1       R6_2.0.1        Rcpp_0.11.6     assertthat_0.1  digest_0.6.8    dplyr_0.4.1     htmltools_0.2.6 httpuv_1.3.2   
 [9] jsonlite_0.9.16 lazyeval_0.1.10 magrittr_1.5    mime_0.3        parallel_3.1.1  tools_3.1.1     xtable_1.7-4

【问题讨论】：

如果你不需要依赖ggvis 或许this example 可以工作？
@jason 感谢您的反馈。我知道这个选项，这个问题专门针对 ggvis。

标签： r ggvis

【解决方案1】：

我认为您需要对数据进行子集化：ggvis 似乎还不够聪明，无法忽略超出比例的点。以下server.R 对我有用：

## server.R
shinyServer(function(input, output, session) {

  domains <- reactiveValues(x = c(NA, NA), y = c(NA, NA))

  mtcars_reactive <- reactive({
    if (anyNA(domains$x))
      mtcars
    else
      mtcars[mtcars$disp >= domains[["x"]][1] & mtcars$disp <= domains[["x"]][2], ]
  })

  zoom_brush = function(items, page_loc, session, ...) { # plot_loc
    print(items)
    message("page_loc")
    print(page_loc)
    print(session)
    domains$x = c(200, 400)
  }

  reactive({
    mtcars_reactive() %>%
      ggvis(~disp, ~mpg) %>%
      layer_points() %>%
      handle_brush(zoom_brush)
  }) %>% bind_shiny('graph_plot1', 'ui_plot1')

})

【讨论】：