r - 使用 ggvis 显示纵向数据，其中 slider 控制年份

Question

我正在尝试使用 slider 来控制纵向空间数据集中的年份，本质上是一组散点图。我不知道如何将 slider 分配给这个变量——你能在 ggvis 中做到这一点吗？

一个简化的数据集:

data <- data.frame(year=rep(2000:2002, each=23), 
                   x=rnorm(23*3,10), y=rnorm(23*3,10),
                   count=c(rnorm(23,2), rnorm(23,4), rnorm(23,6)))

我试过的:

### This is what is looks like in ggplot2, I'm aiming to be able to toggle 
### between these panels
ggplot(data, aes(x, y, size=count)) + geom_point() + facet_grid(~year)

### Here is where I'm at with ggvis
data %>% 
   ggvis(~x, ~y, size=~count) %>% 
   layer_points() 
# I'm not sure how to assign a variable (year) to a slider, I've been trying 
# within the layer_points() function

### I also tried using the props() function, but I don't fully understand 
### how to use it.
data %>% 
    ggvis(~x, ~y, size=~count) %>% 
    layer_points() %>% 
    props(prop("fill", input_slider(min(data$year), max(data$year)))) #error message

任何帮助表示赞赏!

Answer 1

我不确定您是否要使用 slider 到 filter数据点(即仅显示 slider 上所选年份的那些点)，或根据 slider 的值以不同颜色显示年份。

案例1(仅显示特定年份的积分)

data %>% 
  ggvis(~x, ~y, size=~count) %>% 
  layer_points(opacity=input_slider(min(data$year), max(data$year), step=1, 
                                 map=function(x) ifelse(data$year == x, 1, 0)))

案例 2(突出显示选定的年份)

data %>% 
  ggvis(~x, ~y, size=~count) %>% 
  layer_points(fill=input_slider(min(data$year), max(data$year), step=1, 
                                 map=function(x) factor(x == data$year)))

EDIT2:如何简单地包装 left_right()功能。

在第一次编辑中，我提出了一个未被正确视为包装的解决方案。
我有兴趣为 left_right() 返回的 react 对象创建一个包装器。 ，避免修改 create_keyboard_event全部一起。

看完 ggvis的源码更彻底和更多关于 R 中的 S4 对象，
我意识到是的，你可以简单地包装一个 react 对象，只要你保留 broker类及其 broker属性适当。

这使我们可以编写更优雅的代码，例如:

year_lr <- left_right(1997, 2002, value=2000, step=1)
year_wrapper <- reactive({
  as.numeric(year_lr() == data$year) 
})

class(year_wrapper) <- c("broker", class(year_wrapper))
attr(year_wrapper, "broker") <- attr(year_lr, "broker")

data %>% 
  ggvis(~x, ~y, size=~count) %>% 
  layer_points(opacity:=year_wrapper)

编辑:如何创建自己的(修改) left_right()功能

user3389288 问了我一个很好的问题，因为你没有 map left_right() 的参数函数，你怎么能真正绑定(bind)键盘事件来生成自定义参数。例如，在这个问题的上下文中，我们如何定制 left_right()作为年份过滤器？

如果你深入研究 ggvis 的源代码, 你可以看到 left_right()只是一个调用 create_keyboard_event 的瘦包装函数.

因此我们可以创建自己的 left_right() 版本。 , 甚至 h_j_k_l()说如果你对 Vi 很狂热。
但是，这是一个很大的问题，如果您进一步挖掘一层以查看 create_keyboard_event 的实现，你会发现它不太适合我们的任务。

这是因为为了显示一些点，同时隐藏其他点，我们必须让 left_right返回 vector (等于 data 中的行数)。
然而， left_right和 create_keyboard_event假设返回值(也是 value 由左/右键修改的当前状态)是一个标量。

为了将返回值(向量)与缓存的当前状态(标量，即年份)分开，我们必须创建 left_right() 的略微修改版本和 create_keyboard_event .

下面是可以工作的源代码。

data <- data.frame(year=rep(1997:2002, each=12), 
                   x=rnorm(24*3,10), y=rnorm(24*3,10),
                   count=c(rnorm(24,2), rnorm(24,4), rnorm(24,6)))

create_keyboard_event2 <- function(map, default.x = NULL, default.res = NULL) {
  # A different version of ggvis::create_keyboard_event function:
  # the major different is that the map function returns a list,
  # list$x is the current value and list$res the result (returned to a ggvis prop).

  # this seperation allows us to return a vector of different
  # values instead of a single scalar variable.

  if (!is.function(map)) stop("map must be a function")

  vals <- shiny::reactiveValues()
  vals$x <- default.x
  vals$res <- default.res

  # A reactive to wrap the reactive value
  res <- reactive({
    vals$res
  })

  # This function is run at render time.
  connect <- function(session, plot_id) {
    key_press_id  <- paste0(plot_id, "_key_press")

    shiny::observe({
      key_press <- session$input[[key_press_id]]

      if (!is.null(key_press)) {
        # Get the current value of the reactive, without taking a dependency
        current_value <- shiny::isolate(vals$x)

        updated <- map(key_press, current_value)

        vals$x <- updated$x
        vals$res <- updated$res
      }

    })
  }
  ggvis:::connector_label(connect) <- "key_press"

  spec <- list(type = "keyboard")
  ggvis:::create_broker(res, connect = connect, spec = spec)
}

# a modified version of left_right. this closure encapsulates the
# data "year", allowing us to perform comparison of the current state of
# left_right (numeric year number) to the year vector.

left_right_year <- function(min, max, value = (min + max) / 2,
                       step = (max - min) / 40, year) {

  # Given the key_press object and current value, return the next value
  map <- function(key_press, current_value) {
    key <- key_press$value

    print(current_value)

    if (key == "left") {
      new_value <- pmax(min, current_value - step)

    } else if (key == "right") {
      new_value <- pmin(max, current_value + step)

    } else {
      new_value = current_value
    }

    list(x=new_value, res=as.numeric(year == new_value))

  }

  create_keyboard_event2(map, value, as.numeric(value==year))
}

# now with an additional argument, the data$year
alpha_by_year <- left_right_year(1997, 2002, value=2000, step=1, data$year)

data %>% 
  ggvis(~x, ~y, size=~count) %>% 
  layer_points(opacity:=alpha_by_year) # if you let left_right_year return
  # a factor vector, you can use fill:=... as well

你可以比较 left_right_year和 create_keyboard_event2与他们的 Vanilla 版本同行。

比如原来的 create_keyboard_event是:

create_keyboard_event <- function(map, default = NULL) {
  if (!is.function(map)) stop("map must be a function")

  vals <- shiny::reactiveValues()
  vals$x <- default

  # A reactive to wrap the reactive value
  res <- reactive({
    vals$x
  })

  # This function is run at render time.
  connect <- function(session, plot_id) {
    key_press_id  <- paste0(plot_id, "_key_press")

    shiny::observe({
      key_press <- session$input[[key_press_id]]

      if (!is.null(key_press)) {
        # Get the current value of the reactive, without taking a dependency
        current_value <- shiny::isolate(vals$x)

        vals$x <- map(key_press, current_value)
      }

    })
  }
  connector_label(connect) <- "key_press"

  spec <- list(type = "keyboard")
  create_broker(res, connect = connect, spec = spec)
}

可以看到我们修改后的版本不仅会缓存当前状态 vals$x , 还有返回向量 vals$res .

变量 vals是 react 值 .这个概念是从 Shiny 那里借来的。您可以查看 this document关于 react 性值(value)和一般 react 性的高级概述。

一个尚未回答的问题

由于 vals$x本身就是一个 react 值。直觉上，如果

x <- left_right(1, 100, value=20, step=10)

然后

y <- reactive(x() * 2)

应该允许我们快速实现 map功能。

但是它没有按预期工作。我还没有弄清楚为什么。如果你知道答案，请告诉我!

更新:c.f.编辑2